pax_global_header00006660000000000000000000000064131635543130014516gustar00rootroot0000000000000052 comment=59f1096238e6c30303a6fe9fc1c635f49e5946c6 circe-2.6/000077500000000000000000000000001316355431300124525ustar00rootroot00000000000000circe-2.6/.bumpversion.cfg000066400000000000000000000002361316355431300155630ustar00rootroot00000000000000[bumpversion] current_version = 2.6 parse = (?P\d+)\.(?P.*) serialize = {major}.{minor} files = circe.el circe-pkg.el commit = True tag = True circe-2.6/.gitignore000066400000000000000000000000331316355431300144360ustar00rootroot00000000000000/dist /release *.elc .cask circe-2.6/.travis.yml000066400000000000000000000006231316355431300145640ustar00rootroot00000000000000language: emacs-lisp sudo: no env: - EVM_EMACS=emacs-24.3-travis - EVM_EMACS=emacs-24.4-travis - EVM_EMACS=emacs-24.5-travis - EVM_EMACS=emacs-25.1-travis - EVM_EMACS=emacs-25.2-travis before_install: - curl -fsSkL https://gist.github.com/rejeep/ebcd57c3af83b049833b/raw > travis.sh && source ./travis.sh - evm install $EVM_EMACS --use --skip - cask script: - cask exec buttercup -L . circe-2.6/AUTHORS.md000066400000000000000000000003411316355431300141170ustar00rootroot00000000000000The following people have contributed non-trivial parts of code to Circe. This project would not be where it is now without them. - Jorgen Schaefer - John Foerch - Vasilij Schneidermann - Taylan Ulrich Bayırlı/Kammer - Pi circe-2.6/CONTRIBUTING.md000066400000000000000000000021511316355431300147020ustar00rootroot00000000000000We welcome patches to improve Circe. This file will help you set up a local development environment. ## Preparation You will need the following software installed: - [Cask](https://github.com/cask/cask) Once you have that, you can clone the repository locally: ``` git clone https://github.com/jorgenschaefer/circe ``` In the repository, run the setup script to create your development environment: ``` cd .../circe ./scripts/setup ``` ## Running Tests Now, every time you change code, you can run the tests: ``` ./scripts/test ``` There’s also a `test-full` to run the tests in all supported Emacs versions. Use the normal `test` script during development and for TDD. Use `test-full` before submitting patches. ## Coding Style - Do adhere to normal Emacs Lisp coding conventions as in the rest of Circe - Do write tests if at all possible. Changes to `irc.el` MUST be accompanied by a test. - Do feel free to use `cl-lib` - Do not add further external requirements (outside of the standard Emacs distribution) without talking with us first ## Discussions Join us in `#emacs-circe` on `irc.freenode.net`! circe-2.6/Cask000066400000000000000000000003171316355431300132570ustar00rootroot00000000000000(source gnu) (source melpa) (depends-on "cl-lib" "0.5") (development (depends-on "buttercup" :git "https://github.com/jorgenschaefer/emacs-buttercup.git" :files ("*.el" "bin"))) circe-2.6/LICENSE000066400000000000000000001045131316355431300134630ustar00rootroot00000000000000 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 . circe-2.6/NEWS.md000066400000000000000000000057241316355431300135600ustar00rootroot00000000000000# New in 2.6 - No new features, but some bug fixes. # New in 2.5 - Update the openssl invocation to current versions of openssl. For some reason, they just remove a command line argument. - Some other bug fixes. # New in 2.4 - `circe-server-killed-confirmation` now can kill every buffer even without asking (thanks to Rudi Grinberg) - lui has been improved to know about past messages to facilitate editing and deletion of old messages, primarily for protocols like Slack (thanks to Tom Willemse) - Lots of bug fixes # New in 2.3 - Circe (Lui) now has a track bar. Use `(enable-lui-track-bar)` to get a bar where you stopped reading when you did hide a buffer. - Buffers are now by default limited to 100k, as large buffers cause unreasonable slowdown in Emacs. - Autopaste now defaults to ix.io and also knows about ptpb.pw. - A number of faces have been updated to be nicer to the eye. - Improve compatibility with the Slack IRC gateway. - Lots of bug fixes. # New in 2.2 - Server configuration now accepts the `:reduce-lurker-spam` keyword to set that variable. - Lui now supports inline markup with `*bold*` and similar. Customize `lui-formatting-list` for this. - `lui-add-input` is a new function to tell lui about new input that did not originate from lui itself. It is added to the history. - Circe now adds the argument to `/query` to the chat history of a query buffer. - The new variables `lui-time-stamp-time` and `lui-time-stamp-zone` allow programmers to customize the time zone for time stamps in lui. - And lots of bug fixes. # New in 2.1 - New option: `circe-inhibit-nick-highlight-function` – this allows you to disable nick highlighting in some messages. - New extension: `circe-new-day-notifier.el` – show date changes in chat buffers. (Thanks to Pásztor János!) - Improve Bitlbee support by adding a default port (6667) and disabling lagmon if it is used. - Improved buttonizing of various references, like PEP links or Emacs debbugs references. - Fix a bug that would confuse Emacs with lots of `nil` faces - Lots of other bug fixes. # New in 2.0 - Circe has had its IRC backend completely rewritten. It is now a separate library, `irc.el`, and much more powerful. Alas, this means a lot of existing configuration code will break. - Because of this, Circe now fully supports SASL authentication, extended joins, and a few other modern IRC capabilities. - XKCD references, CVE numbers and github issues are now buttonized. - All IRC buffers change to the home directory by default. - Circe now uses [buttercup][] for tests and Travis-CI for continuous integration tests. - A number of options were removed to focus on sensible defaults. Re-check your configuration. - Nick colors are now pre-computed to make them more appropriate for the current display and more distinct from each other. - A lot of format strings have been added. Check the `circe-format` customization group. [buttercup]: https://github.com/jorgenschaefer/emacs-buttercup circe-2.6/README.md000066400000000000000000000074041316355431300137360ustar00rootroot00000000000000# Circe, a Client for IRC in Emacs [![Build Status](https://api.travis-ci.org/jorgenschaefer/circe.png?branch=master)](https://travis-ci.org/jorgenschaefer/circe) [![MELPA Stable](http://stable.melpa.org/packages/circe-badge.svg)](http://stable.melpa.org/#/circe) ## Overview ![Logo](images/circe.jpg) Circe is a Client for IRC in Emacs. It tries to have sane defaults, and integrates well with the rest of the editor, using standard Emacs key bindings and indicating activity in channels in the status bar so it stays out of your way unless you want to use it. Complexity-wise, it is somewhere between rcirc (very minimal) and ERC (very complex). ## Screenshot ![Screenshot](images/screenshot.png) ## Installation ### Dependencies In order to securely connect to an IRC server using TLS, Circe requires the [GnuTLS](https://www.gnutls.org/) binary. On Debian-based GNU+Linux-distributions, you can install it likes this: ```Shell apt install gnutls-bin ``` ### `package.el` Make sure you have MELPA Stable added to your package sources. To your .emacs, add this: ```Lisp (require 'package) (add-to-list 'package-archives '("melpa-stable" . "http://stable.melpa.org/packages/") t) (package-initialize) ``` Then, use `package-install` to install Circe: ``` M-x package-install RET circe RET ``` After this, `M-x circe` should work. ### Development Version In a shell: ```Shell mkdir -d ~/.emacs.d/lisp/ cd ~/.emacs.d/lisp git clone git://github.com/jorgenschaefer/circe.git ``` Then add the following to your `.emacs` file: ```Lisp (add-to-list 'load-path "~/.emacs.d/lisp/circe") (require 'circe) ``` The next time you start your Emacs, you should be able to use `M-x circe` to connect to IRC. ## Connecting to IRC To connect to IRC, simply use `M-x circe RET irc.freenode.net RET RET`. This will connect you to Freenode. You can join us on `#emacs-circe` by using `/join #emacs-circe` in the server buffer. A more elaborate setup would require you to edit your init file and add something like the following: ```Lisp (setq circe-network-options '(("Freenode" :tls t :nick "my-nick" :sasl-username "my-nick" :sasl-password "my-password" :channels ("#emacs-circe") ))) ``` With this in your configuration, you can use `M-x circe RET Freenode RET` to connect to Freenode using these settings. _Please note:_ Circe uses the `openssl` or `gnutls-cli` command line programs to connect via TLS. These tools do not by default verify the server certificate. If you want to verify the server certificate, customize the `tls-connection-command` variable. ## Features - Sensible defaults - Tab completion - Nick highlighting - Logging - Spell checker - Ignore feature that also hides users who talk to users on your ignore list - Ignored messages can be toggled so they show up and then hidden again - TLS/SSL support - SASL authentication support - Nickserv authentication, automatic ghosting, and nick re-gain - Auto-join - Ability to reduce join/part/quit spam from lurkers - Automatic splitting of long lines at word boundaries - Netsplit handling - Activity tracking in the mode line - Fully customizeable message display - Topic changes can be shown as a diff - Automatic linking of Emacs Lisp symbols, RFCs, PEPs, SRFIs, Github issues, etc. - Automatic splitting of outgoing messages at word boundaries to adhere to IRC protocol limitations - Flood protection - Nickname coloring (via the `circe-color-nicks` module) - Lag monitoring (via the `circe-lagmon` module) - Automatic pasting to a paste site for long messages (via the `lui-autopaste` module) - Bar marking the last read position (via the `lui-track-bar` module) ## Documentation Please see the Wiki for further information: https://github.com/jorgenschaefer/circe/wiki circe-2.6/RELEASE.md000066400000000000000000000002031316355431300140470ustar00rootroot00000000000000# Circe Release Process - Clean up issues/milestones on github - Update NEWS.md - Run `bumpversion minor` - Run `git push --tags` circe-2.6/circe-chanop.el000066400000000000000000000067211316355431300153350ustar00rootroot00000000000000;;; circe-chanop.el --- Provide common channel operator commands ;; Copyright (C) 2006, 2015 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; This file is part of Circe. ;; 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, write to the Free Software ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA ;; 02110-1301 USA ;;; Commentary: ;; This Circe module provides some often-used chanop commands. I was ;; very reluctant to add this. None of these commands will make it in ;; the core, or even be provided by default. You should have to go to ;; great lengths to use them. ;; Always remember the Tao of IRC: ;; ;; IGNORE is the weapon of an IRC knight. Not as clumsy or as ;; random as a kickban. ;;; Code: (require 'circe) (defun circe-command-MODE (mode) "Set MODE in the current channel." (interactive "sMode change: ") (cond ((not (string-match "^[+-]" mode)) (irc-send-raw (circe-server-process) (format "MODE %s" mode))) ((eq major-mode 'circe-channel-mode) (irc-send-raw (circe-server-process) (format "MODE %s %s" circe-chat-target mode))) (t (circe-display-server-message "Not in a channel buffer.")))) (defun circe-command-BANS (&optional ignored) "Show channel bans" (if (not circe-chat-target) (circe-display-server-message "No target for current buffer") (irc-send-raw (circe-server-process) (format "MODE %s +b" circe-chat-target)))) (defun circe-command-KICK (nick &optional reason) "Kick WHO from the current channel with optional REASON." (interactive "sKick who: \nsWhy: ") (if (not (eq major-mode 'circe-channel-mode)) (circe-display-server-message "Not in a channel buffer.") (when (not reason) (if (string-match "^\\([^ ]*\\) +\\(.+\\)" nick) (setq reason (match-string 2 nick) nick (match-string 1 nick)) (setq reason "-"))) (irc-send-raw (circe-server-process) (format "KICK %s %s :%s" circe-chat-target nick reason)))) (defun circe-command-GETOP (&optional ignored) "Ask chanserv for op on the current channel." (interactive) (if (not (eq major-mode 'circe-channel-mode)) (circe-display-server-message "Not in a channel buffer.") (irc-send-PRIVMSG (circe-server-process) "chanserv" (format "op %s" circe-chat-target)))) (defun circe-command-DROPOP (&optional ignored) "Lose op mode on the current channel." (interactive) (if (not (eq major-mode 'circe-channel-mode)) (circe-display-server-message "Not in a channel buffer.") (irc-send-raw (circe-server-process) (format "MODE %s -o %s" circe-chat-target (circe-nick))))) ;; For KICKBAN (requested by Riastradh), we'd need a callback on a ;; USERHOST command. (provide 'circe-chanop) ;;; circe-chanop.el ends here circe-2.6/circe-color-nicks.el000066400000000000000000000312331316355431300163040ustar00rootroot00000000000000;;; circe-color-nicks.el --- Color nicks in the channel ;; Copyright (C) 2012 Taylan Ulrich Bayırlı/Kammer ;; Author: Taylan Ulrich Bayırlı/Kammer ;; This file is part of Circe. ;; 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, write to the Free Software ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA ;; 02110-1301 USA ;;; Commentary: ;; This Circe module adds the ability to assign a color to each ;; nick in a channel. ;; Some ideas/code copied from rcirc-colors.el. ;; To use it, put the following into your .emacs: ;; (require 'circe-color-nicks) ;; (enable-circe-color-nicks) ;;; Code: (require 'circe) (require 'color) (require 'cl-lib) ;;;###autoload (defun enable-circe-color-nicks () "Enable the Color Nicks module for Circe. This module colors all encountered nicks in a cross-server fashion." (interactive) (dolist (buf (buffer-list)) (with-current-buffer buf (when (eq major-mode 'circe-channel-mode) (add-circe-color-nicks)))) (add-hook 'circe-channel-mode-hook 'add-circe-color-nicks)) (defun disable-circe-color-nicks () "Disable the Color Nicks module for Circe. See `enable-circe-color-nicks'." (interactive) (dolist (buf (buffer-list)) (with-current-buffer buf (when (eq major-mode 'circe-channel-mode) (remove-circe-color-nicks)))) (remove-hook 'circe-channel-mode-hook 'add-circe-color-nicks)) (defun add-circe-color-nicks () "Add `circe-color-nicks' to `lui-pre-output-hook'." (add-hook 'lui-pre-output-hook 'circe-color-nicks)) (defun remove-circe-color-nicks () "Remove `circe-color-nicks' from `lui-pre-output-hook'." (remove-hook 'lui-pre-output-hook 'circe-color-nicks)) (defgroup circe-color-nicks nil "Nicks colorization for Circe" :prefix "circe-color-nicks-" :group 'circe) (defcustom circe-color-nicks-min-contrast-ratio 7 "Minimum contrast ratio from background for generated colors; recommended is 7:1, or at least 4.5:1 (7 stands for 7:1 here). Lower value allows higher color spread, but could lead to less readability." :group 'circe-color-nicks) (defcustom circe-color-nicks-min-difference 17 "Minimum difference from each other for generated colors." :group 'circe-color-nicks) (defcustom circe-color-nicks-min-fg-difference 17 "Minimum difference from foreground for generated colors." :group 'circe-color-nicks) (defcustom circe-color-nicks-min-my-message-difference 0 "Minimum difference from own nick color for generated colors." :group 'circe-color-nicks) (defcustom circe-color-nicks-everywhere nil "Whether nicks should be colored in message bodies too." :type 'boolean :group 'circe-color-nicks) (defcustom circe-color-nicks-message-blacklist nil "Blacklist for nicks that shall never be highlighted inside images." :type '(repeat string) :group 'circe-color-nicks) (defcustom circe-color-nicks-pool-type 'adaptive "Type of the color nick pool. Must be one of the following: 'adaptive: Generate colors based on the current theme. List of strings: Pick colors from the specified list of hex codes or color names (see `color-name-rgb-alist')." :type '(choice (const :tag "Adaptive" adaptive) (repeat string)) :group 'circe-color-nicks) ;;; See http://www.w3.org/TR/2013/NOTE-WCAG20-TECHS-20130905/G18 (defsubst circe-w3-contrast-c-to-l (c) (if (<= c 0.03928) (/ c 12.92) (expt (/ (+ c 0.055) 1.055) 2.4))) (defsubst circe-w3-contrast-relative-luminance (rgb) (apply #'+ (cl-mapcar (lambda (color coefficient) (* coefficient (circe-w3-contrast-c-to-l color))) rgb '(0.2126 0.7152 0.0722)))) (defsubst circe-w3-contrast-contrast-ratio (color1 color2) (let ((l1 (+ 0.05 (circe-w3-contrast-relative-luminance color1))) (l2 (+ 0.05 (circe-w3-contrast-relative-luminance color2)))) (if (> l1 l2) (/ l1 l2) (/ l2 l1)))) (defun circe-color-alist () "Return list of colors (name rgb lab) where rgb is 0 to 1." (let ((alist (if (display-graphic-p) color-name-rgb-alist (mapcar (lambda (c) (cons (car c) (cddr c))) (tty-color-alist)))) (valmax (float (car (color-values "#ffffff"))))) (mapcar (lambda (c) (let* ((name (car c)) (rgb (mapcar (lambda (v) (/ v valmax)) (cdr c))) (lab (apply #'color-srgb-to-lab rgb))) (list name rgb lab))) alist))) (defun circe-color-canonicalize-format (color) "Turns COLOR into (name rgb lab) format. Avoid calling this in a loop, it's very slow on a tty!" (let* ((name color) (rgb (circe-color-name-to-rgb color)) (lab (apply #'color-srgb-to-lab rgb))) (list name rgb lab))) (defun circe-color-contrast-ratio (color1 color2) "Gives the contrast ratio between two colors." (circe-w3-contrast-contrast-ratio (nth 1 color1) (nth 1 color2))) (defun circe-color-diff (color1 color2) "Gives the difference between two colors per CIEDE2000." (color-cie-de2000 (nth 2 color1) (nth 2 color2))) (defun circe-color-name-to-rgb (color) "Like `color-name-to-rgb' but also handles \"unspecified-bg\" and \"unspecified-fg\"." (cond ((equal color "unspecified-bg") '(0 0 0)) ((equal color "unspecified-fg") '(1 1 1)) (t (color-name-to-rgb color)))) (defun circe-nick-color-appropriate-p (color bg fg my-msg) "Tells whether COLOR is appropriate for being a nick color. BG, FG, and MY-MSG are the background, foreground, and my-message colors; these are expected as parameters instead of computed here because computing them repeatedly is a heavy operation." (and (>= (circe-color-contrast-ratio color bg) circe-color-nicks-min-contrast-ratio) (>= (circe-color-diff color fg) circe-color-nicks-min-fg-difference) (>= (circe-color-diff color my-msg) circe-color-nicks-min-my-message-difference))) (defun circe-nick-colors-delete-similar (colors) "Return list COLORS with pairs of colors filtered out that are too similar per `circe-color-nicks-min-difference'. COLORS may be mutated." (cl-mapl (lambda (rest) (let ((color (car rest))) (setcdr rest (cl-delete-if (lambda (c) (< (circe-color-diff color c) circe-color-nicks-min-difference)) (cdr rest))))) colors) colors) (defun circe-nick-color-generate-pool () "Return a list of appropriate nick colors." (if (consp circe-color-nicks-pool-type) circe-color-nicks-pool-type (let ((bg (circe-color-canonicalize-format (face-background 'default))) (fg (circe-color-canonicalize-format (face-foreground 'default))) (my-msg (circe-color-canonicalize-format (face-attribute 'circe-my-message-face :foreground nil 'default)))) (mapcar #'car (circe-nick-colors-delete-similar (cl-remove-if-not (lambda (c) (circe-nick-color-appropriate-p c bg fg my-msg)) (circe-color-alist))))))) (defun circe-nick-color-pool-test () "Display all appropriate nick colors in a temp buffer." (interactive) (switch-to-buffer (get-buffer-create "*Circe color test*")) (erase-buffer) (let ((pool (circe-nick-color-generate-pool))) (while pool (let ((pt (point))) (insert "The quick brown fox jumped over the lazy dog.\n") (put-text-property pt (point) 'face `(:foreground ,(pop pool))))))) (defvar circe-nick-color-pool nil "Pool of yet unused nick colors.") (defvar circe-nick-color-mapping (make-hash-table :test 'equal) "Hash-table from nicks to colors.") (defun circe-nick-color-nick-list () "Return list of all nicks that have a color assigned to them. Own and blacklisted nicks are excluded." (let ((our-nick (circe-nick)) (channel-nicks (circe-channel-nicks)) nicks) (maphash (lambda (nick color) (when (and (member nick channel-nicks) (not (string= our-nick nick)) (not (member nick circe-color-nicks-message-blacklist))) (push nick nicks))) circe-nick-color-mapping) nicks)) (defvar circe-nick-color-timestamps (make-hash-table :test 'equal) "Hash-table from colors to the timestamp of their last use.") (defun circe-nick-color-for-nick (nick) "Return the color for NICK. Assigns a color to NICK if one wasn't assigned already." (let ((color (gethash nick circe-nick-color-mapping))) (when (not color) ;; NOTE use this as entry point for taking NICK into account for ;; picking the new color (setq color (circe-nick-color-pick)) (puthash nick color circe-nick-color-mapping)) (puthash color (float-time) circe-nick-color-timestamps) color)) (defun circe-nick-color-pick () "Picks either a color from the pool of unused colors, or the color that was used least recently (i.e. nicks that have it assigned have been least recently active)." (if (zerop (hash-table-count circe-nick-color-mapping)) (setq circe-nick-color-pool (circe-nick-color-generate-pool))) (or (pop circe-nick-color-pool) (circe-nick-color-pick-least-recent))) (defun circe-nick-color-pick-least-recent () "Pick the color that was used least recently. See `circe-nick-color-pick', which is where this is used." (let ((least-recent-color nil) (oldest-time (float-time))) (maphash (lambda (color time) (if (< time oldest-time) (progn (setq least-recent-color color) (setq oldest-time time)))) circe-nick-color-timestamps) (if least-recent-color least-recent-color ;; Someone must have messed with `circe-nick-color-mapping', recover by ;; re-filling the pool. (setq circe-nick-color-pool (circe-nick-color-generate-pool)) (pop circe-nick-color-pool)))) (defun circe-color-nicks () "Color nicks on this lui output line." (when (eq major-mode 'circe-channel-mode) (let ((nickstart (text-property-any (point-min) (point-max) 'lui-format-argument 'nick))) (when nickstart (goto-char nickstart) (let ((nickend (next-single-property-change nickstart 'lui-format-argument)) (nick (plist-get (plist-get (text-properties-at nickstart) 'lui-keywords) :nick))) (when (not (circe-server-my-nick-p nick)) (let ((color (circe-nick-color-for-nick nick))) (add-face-text-property nickstart nickend `(:foreground ,color))))))) (when circe-color-nicks-everywhere (let ((body (text-property-any (point-min) (point-max) 'lui-format-argument 'body))) (when body (with-syntax-table circe-nick-syntax-table (goto-char body) (let* ((nicks (circe-nick-color-nick-list)) (regex (regexp-opt nicks 'words))) (let (case-fold-search) (while (re-search-forward regex nil t) (let* ((nick (match-string-no-properties 0)) (color (circe-nick-color-for-nick nick))) (add-face-text-property (match-beginning 0) (match-end 0) `(:foreground ,color)))))))))))) (defun circe-nick-color-reset () "Reset the nick color mapping (and some internal data). This is useful if you switched between frames supporting different color ranges and would like nicks to get new colors appropriate to the new color range." (interactive) (setq circe-nick-color-pool (circe-nick-color-generate-pool)) (setq circe-nick-color-mapping (make-hash-table :test 'equal)) (setq circe-nick-color-timestamps (make-hash-table :test 'equal))) (provide 'circe-color-nicks) ;;; circe-color-nicks.el ends here circe-2.6/circe-compat.el000066400000000000000000000037171316355431300153520ustar00rootroot00000000000000;;; circe-compat.el --- Compatibility definitions ;; Copyright (C) 2015 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; 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: ;; Define functions and variables as needed by Circe to remain ;; compatible with older Emacsen. ;;; Code: (when (not (fboundp 'string-trim)) (defun string-trim (string) "Remove leading and trailing whitespace from STRING." (if (string-match "\\` *\\(.*[^[:space:]]\\) *\\'" string) (match-string 1 string) string))) (when (not (fboundp 'add-face-text-property)) (defun add-face-text-property (start end face &optional append object) (while (/= start end) (let* ((next (next-single-property-change start 'face object end)) (prev (get-text-property start 'face object)) (value (if (listp prev) prev (list prev)))) (put-text-property start next 'face (if append (append value (list face)) (append (list face) value)) object) (setq start next))))) (when (not (boundp 'mode-line-misc-info)) (defvar mode-line-misc-info nil "Misc info in the mode line.") (add-to-list 'mode-line-format 'mode-line-misc-info t)) (provide 'circe-compat) ;;; circe-compat.el ends here circe-2.6/circe-highlight-all-nicks.el000066400000000000000000000070331316355431300177040ustar00rootroot00000000000000;;; circe-highlight-all-nicks.el --- Highlight all nicks in the current channel ;; Copyright (C) 2005 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; This file is part of Circe. ;; 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, write to the Free Software ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA ;; 02110-1301 USA ;;; Commentary: ;; This Circe module adds the ability to highlight every occurance of ;; a nick in the current channel in a message by other people. ;; To use it, put the following into your .emacs: ;; (require 'circe-highlight-all-nicks) ;; (enable-circe-highlight-all-nicks) ;;; Code: (require 'circe) (defface circe-highlight-all-nicks-face '((t (:foreground "green"))) "The face used for nicks from the current channel. See `enable-circe-highlight-all-nicks'." :group 'circe) ;;;###autoload (defun enable-circe-highlight-all-nicks () "Enable the Highlight Nicks module for Circe. This module highlights all occurances of nicks in the current channel in messages of other people." (interactive) (dolist (buf (buffer-list)) (with-current-buffer buf (when (eq major-mode 'circe-channel-mode) (add-circe-highlight-all-nicks)))) (add-hook 'circe-channel-mode-hook 'add-circe-highlight-all-nicks)) (defun disable-circe-highlight-all-nicks () "Disable the Highlight Nicks module for Circe. See `enable-circe-highlight-all-nicks'." (interactive) (dolist (buf (buffer-list)) (with-current-buffer buf (when (eq major-mode 'circe-channel-mode) (remove-circe-highlight-all-nicks)))) (remove-hook 'circe-channel-mode-hook 'add-circe-highlight-all-nicks)) (defun add-circe-highlight-all-nicks () "Add `circe-highlight-all-nicks' to `lui-pre-output-hook'." (add-hook 'lui-pre-output-hook 'circe-highlight-all-nicks nil t)) (defun remove-circe-highlight-all-nicks () "Remove `circe-highlight-all-nicks' from `lui-pre-output-hook'." (remove-hook 'lui-pre-output-hook 'circe-highlight-all-nicks t)) (defun circe-highlight-all-nicks () "Highlight all occurances of nicks of the current channel in the message." (when (eq major-mode 'circe-channel-mode) (let ((body (text-property-any (point-min) (point-max) 'lui-format-argument 'body)) (nicks '()) (regex nil)) (when body (let ((channel-nicks (circe-channel-nicks))) (when channel-nicks (mapc (lambda (nick) (when (not (circe-server-my-nick-p nick)) (setq nicks (cons nick nicks)))) channel-nicks))) (setq regex (regexp-opt nicks 'words)) (goto-char body) (while (re-search-forward regex nil t) (add-text-properties (match-beginning 0) (match-end 0) '(face circe-highlight-all-nicks-face))))))) (provide 'circe-highlight-all-nicks) ;;; circe-highlight-all-nicks.el ends here circe-2.6/circe-lagmon.el000066400000000000000000000215311316355431300153360ustar00rootroot00000000000000;;; circe-lagmon.el --- Lag Monitor for Circe ;; Copyright (C) 2011-2012 Jorgen Schaefer ;; Author: John J Foerch , ;; Jorgen Schaefer ;; This file is part of Circe. ;; 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, write to the Free Software ;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA ;; 02110-1301, USA. ;;; Commentary: ;;; ;;; Circe-lagmon-mode monitors the amount of lag on your connection to ;;; each server, and displays the lag time in seconds in the mode-line. ;;; It works by managing two timers. Timer1 sends CTCP LAGMON to yourself ;;; on each server every 60 seconds. Each time around, timer1 starts ;;; timer2 to monitor for timeouts of these messages. Timer2 cancels ;;; itself when all of the pings in the round have been answered. ;;; ;;; Code: (require 'circe) ;;; User variables (defgroup circe-lagmon nil "Lag Monitor for Circe" :prefix "circe-lagmon-" :group 'circe) (defcustom circe-lagmon-timer-tick 5 "How often to check for lag. Increase this to improve performance at the cost of accuracy." :type 'number :group 'circe-lagmon) (defcustom circe-lagmon-check-interval 60 "Interval in seconds at which to send the CTCP message." :type 'number :group 'circe-lagmon) (defcustom circe-lagmon-reconnect-interval 120 "Seconds after which to automatically reconnect upon a timeout of a lag monitor message. A value of nil disables the feature." :type '(choice (const :tag "Disable auto-reconnect" nil) number) :group 'circe-lagmon) (defcustom circe-lagmon-mode-line-format-string "lag:%.1f " "Format string for displaying the lag in the mode-line." :type 'string :group 'circe-lagmon) (defcustom circe-lagmon-mode-line-unknown-lag-string "lag:? " "Indicator string for displaying unknown lag in the mode-line." :type 'string :group 'circe-lagmon) (defvar circe-lagmon-disabled nil "A boolean value if lagmon should be disabled on this network. Don't set this by hand, use `circe-network-options'.") (make-variable-buffer-local 'circe-lagmon-disabled) ;;; Internal variables ;;; (defvar circe-lagmon-timer nil) (defvar circe-lagmon-server-lag nil) (make-variable-buffer-local 'circe-lagmon-server-lag) (defvar circe-lagmon-last-send-time nil) (make-variable-buffer-local 'circe-lagmon-last-send-time) (defvar circe-lagmon-last-receive-time nil) (make-variable-buffer-local 'circe-lagmon-last-receive-time) (defun circe-lagmon-timer-tick () "Function run periodically to check lag. This will call `circe-lagmon-server-check' in every active server buffer. You can call it yourself if you like to force an update, there is no harm in running it too often, but it really should be run sufficiently often with the timer." (dolist (buffer (circe-server-buffers)) (with-current-buffer buffer (when (and (eq major-mode 'circe-server-mode) circe-server-process (eq (irc-connection-state circe-server-process) 'registered) (not circe-lagmon-disabled)) (circe-lagmon-server-check))))) (defun circe-lagmon-server-check () "Check the current server for lag. This will reconnect if we haven't heard back for too long, or send a request if it's time for that. See `circe-lagmon-reconnect-interval' and `circe-lagmon-check-interval' to configure the behavior.." (let ((now (float-time))) (cond ;; No answer so far... ((and circe-lagmon-last-send-time (not circe-lagmon-last-receive-time)) ;; Count up until the answer comes. (let ((lag (/ (- now circe-lagmon-last-send-time) 2))) (when (or (not circe-lagmon-server-lag) (> lag circe-lagmon-server-lag)) (setq circe-lagmon-server-lag lag) (circe-lagmon-force-mode-line-update))) ;; Check for timeout. (when (and circe-lagmon-reconnect-interval (> now (+ circe-lagmon-last-send-time circe-lagmon-reconnect-interval))) (setq circe-lagmon-last-send-time nil circe-lagmon-last-receive-time nil) (circe-reconnect))) ;; Nothing sent so far, or last send was too long ago. ((or (not circe-lagmon-last-send-time) (> now (+ circe-lagmon-last-send-time circe-lagmon-check-interval))) (irc-send-raw (circe-server-process) (format "PRIVMSG %s :\C-aLAGMON %s\C-a" (circe-nick) now) :nowait) (setq circe-lagmon-last-send-time now circe-lagmon-last-receive-time nil)) ))) (defun circe-lagmon-force-mode-line-update () "Call force-mode-line-update on a circe server buffer and all of its chat buffers." (force-mode-line-update) (dolist (b (circe-server-chat-buffers)) (with-current-buffer b (force-mode-line-update)))) (defun circe-lagmon-format-mode-line-entry () "Format the mode-line entry for displaying the lag." (let ((buf (cond ((eq major-mode 'circe-server-mode) (current-buffer)) (circe-server-buffer circe-server-buffer) (t nil)))) (when buf (with-current-buffer buf (cond (circe-lagmon-disabled nil) (circe-lagmon-server-lag (format circe-lagmon-mode-line-format-string circe-lagmon-server-lag)) (t circe-lagmon-mode-line-unknown-lag-string)))))) (defun circe-lagmon-init () "Initialize the values of the lag monitor for one server, and start the lag monitor if it has not been started." (setq circe-lagmon-server-lag nil circe-lagmon-last-send-time nil circe-lagmon-last-receive-time nil) (circe-lagmon-force-mode-line-update) (unless circe-lagmon-timer (setq circe-lagmon-timer (run-at-time nil circe-lagmon-timer-tick 'circe-lagmon-timer-tick)))) (defun circe-lagmon--rpl-welcome-handler (conn &rest ignored) (with-current-buffer (irc-connection-get conn :server-buffer) (circe-lagmon-init))) (defun circe-lagmon--ctcp-lagmon-handler (conn event sender target argument) (when (irc-current-nick-p conn (irc-userstring-nick sender)) (with-current-buffer (irc-connection-get conn :server-buffer) (let* ((now (float-time)) (lag (/ (- now (string-to-number argument)) 2))) (setq circe-lagmon-server-lag lag circe-lagmon-last-receive-time now) (circe-lagmon-force-mode-line-update))))) (defun circe-lagmon--nick-handler (conn event sender new-nick) (when (irc-current-nick-p conn (irc-userstring-nick sender)) (with-current-buffer (irc-connection-get conn :server-buffer) (setq circe-lagmon-last-send-time nil)))) ;;;###autoload (define-minor-mode circe-lagmon-mode "Circe-lagmon-mode monitors the amount of lag on your connection to each server, and displays the lag time in seconds in the mode-line." :global t (let ((mode-line-entry '(:eval (circe-lagmon-format-mode-line-entry)))) (remove-hook 'mode-line-modes mode-line-entry) (let ((table (circe-irc-handler-table))) (irc-handler-remove table "001" 'circe-lagmon--rpl-welcome-handler) (irc-handler-remove table "irc.ctcp.LAGMON" 'circe-lagmon--ctcp-lagmon-handler) (irc-handler-remove table "NICK" 'circe-lagmon--nick-handler)) (circe-set-display-handler "irc.ctcp.LAGMON" nil) (when circe-lagmon-timer (cancel-timer circe-lagmon-timer) (setq circe-lagmon-timer nil)) (when circe-lagmon-mode (add-hook 'mode-line-modes mode-line-entry) (let ((table (circe-irc-handler-table))) (irc-handler-add table "001" 'circe-lagmon--rpl-welcome-handler) (irc-handler-add table "irc.ctcp.LAGMON" 'circe-lagmon--ctcp-lagmon-handler) (irc-handler-add table "NICK" 'circe-lagmon--nick-handler)) (circe-set-display-handler "irc.ctcp.LAGMON" 'circe-display-ignore) (dolist (buffer (circe-server-buffers)) (with-current-buffer buffer (setq circe-lagmon-server-lag nil) (when (and circe-server-process (eq (irc-connection-state circe-server-process) 'registered)) (circe-lagmon-init))))))) (provide 'circe-lagmon) ;;; circe-lagmon.el ends here circe-2.6/circe-new-day-notifier.el000066400000000000000000000054161316355431300172460ustar00rootroot00000000000000;;; circe-new-day-notifier.el --- Send a message every midnight to all ;;; channels ;; Copyright (C) 2015 Pásztor János ;; Author: Pásztor János ;; This file is part of Circe. ;; 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 St, Fifth Floor, Boston, MA ;; 02110-1301 USA ;;; Commentary: ;; This Circe module adds the ability to send a notification to all ;; channels every midnight ;; Some ideas/code copied from circe-lagmon.el and ;; circe-color-nicks.el ;; To use it, put the following into your .emacs: ;; (require 'circe-new-day-notifier) ;; (enable-circe-new-day-notifier) ;;; Code: (require 'circe) (defgroup circe-new-day-notifier nil "Midnight notification to Circe" :prefix "circe-new-day-notifier-" :group 'circe) (defcustom circe-new-day-notifier-format-message "*** Day changed to {day}" "The format string which will be printed to the channels. It should contain {day} to print the date. See `circe-display' for further documentation" :type 'string :group 'circe-new-day-notifier) (defcustom circe-new-day-notifier-date-format "%Y-%m-%d, %A" "The date format, which will be used at circe-new-day-notifier-format-message. See `format-time-string' for documentation" :type 'string :group 'circe-new-day-notifier) (defvar circe-new-day-notifier-timer nil) ;;;###autoload (defun enable-circe-new-day-notifier () (interactive) (unless circe-new-day-notifier-timer (setq circe-new-day-notifier-timer (run-at-time "24:00:00" (* 24 60 60) 'circe-new-day-notification)))) ;;;###autoload (defun disable-circe-new-day-notifier () (interactive) (when circe-new-day-notifier-timer (cancel-timer circe-new-day-notifier-timer) (setq circe-new-day-notifier-timer nil))) (defun circe-new-day-notification () "This function prints the new day notification to each query and chat buffer" (dolist (buf (buffer-list)) (with-current-buffer buf (when (derived-mode-p 'circe-chat-mode) (circe-display 'circe-new-day-notifier-format-message :day (format-time-string circe-new-day-notifier-date-format)))))) (provide 'circe-new-day-notifier) ;;; circe-new-day-notifier.el ends here circe-2.6/circe-pkg.el000066400000000000000000000001761316355431300146440ustar00rootroot00000000000000(define-package "circe" "2.6" "Client for IRC in Emacs" '((cl-lib "0.5")) :url "https://github.com/jorgenschaefer/circe") circe-2.6/circe.el000066400000000000000000004126161316355431300140730ustar00rootroot00000000000000;;; circe.el --- Client for IRC in Emacs -*- lexical-binding: t -*- ;; Copyright (C) 2005 - 2015 Jorgen Schaefer ;; Version: 2.6 ;; Keywords: IRC, chat ;; Author: Jorgen Schaefer ;; URL: https://github.com/jorgenschaefer/circe ;; This file is part of Circe. ;; 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: ;; Circe is a Client for IRC in Emacs. It integrates well with the rest ;; of the editor, using standard Emacs key bindings and indicating ;; activity in channels in the status bar so it stays out of your way ;; unless you want to use it. ;;; Code: (defvar circe-version "2.6" "Circe version string.") (require 'circe-compat) (require 'ring) (require 'timer) (require 'lui) (require 'lui-format) (require 'lcs) (require 'irc) ;; Used to be optional. But sorry, we're in the 21st century already. (require 'lui-irc-colors) ;; necessary for inheriting from diff-added and diff-removed faces (require 'diff-mode) (defgroup circe nil "Yet Another Emacs IRC Client." :prefix "circe-" :group 'applications) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Customization Options ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;; ;;;; Faces ;;;; ;;;;;;;;;;;;;;; (defface circe-prompt-face '((t (:weight bold :foreground "Black" :background "LightSeaGreen"))) "The face for the Circe prompt." :group 'circe) (defface circe-server-face '((((type tty)) (:foreground "blue" :weight bold)) (((background dark)) (:foreground "#5095cf")) (((background light)) (:foreground "#3840b0")) (t (:foreground "SteelBlue"))) "The face used to highlight server messages." :group 'circe) (defface circe-highlight-nick-face '((default (:weight bold)) (((type tty)) (:foreground "cyan")) (((background dark)) (:foreground "#82e2ed")) (((background light)) (:foreground "#0445b7")) (t (:foreground "CadetBlue3"))) "The face used to highlight messages directed to us." :group 'circe) (defface circe-my-message-face '((t)) "The face used to highlight our own messages." :group 'circe) (defface circe-originator-face '((t)) "The face used to highlight the originator of a message." :group 'circe) (defface circe-topic-diff-new-face '((t (:inherit diff-added))) "The face used for text added to a topic. See the {topic-diff} parameter to `circe-format-server-topic'." :group 'circe) (defface circe-topic-diff-removed-face '((t (:inherit diff-removed))) "The face used for text removed from a topic. See the {topic-diff} parameter to `circe-format-server-topic'." :group 'circe) (defface circe-fool-face '((((type tty)) (:foreground "grey40" :bold t)) (t (:foreground "grey40"))) "The face used for fools. See `circe-fool-list'." :group 'circe) ;;;;;;;;;;;;;;;;;;; ;;;; Variables ;;;; ;;;;;;;;;;;;;;;;;;; (defcustom circe-default-nick (user-login-name) "The default nick for circe." :type 'string :group 'circe) (defcustom circe-default-user circe-default-nick "The default user name for circe." :type 'string :group 'circe) (defcustom circe-default-realname (if (string= (user-full-name) "") circe-default-nick (user-full-name)) "The default real name for circe." :type 'string :group 'circe) (defcustom circe-default-ip-family nil "Default IP family to use. 'nil - Use either IPv4 or IPv6. 'ipv4 - Use IPv4 'ipv6 - Use IPv6" :type '(choice (const :tag "Both" nil) (const :tag "IPv4" ipv4) (const :tag "IPv6" ipv6)) :group 'circe) (defcustom circe-default-directory "~/" "The value of `default-directory' for Circe buffers." :type 'string :group 'circe) (defcustom circe-network-options nil "Network options. This alist maps network names to respective options. Common options: :pass - The IRC server password to use for this network, or a function to fetch it. :nick - The nick name to use (defaults to `circe-default-nick') :user - The user name to use (defaults to `circe-default-user') :realname - The real name to use (defaults to `circe-default-realname') :channels - A plist of channels to join (see `circe-channels'). :server-buffer-name - Format to be used for the server buffer name (see `circe-server-buffer-name') :host - The host name of the server to connect to. :port - The port or service name for the server. :use-tls - A boolean indicating as to whether to use TLS or not (defaults to nil). If you set this, you'll likely have to set :port as well. :ip-family - Option to enforce a specific IP version (defaults to `circe-default-ip-family') :nickserv-nick - The nick to authenticate with to nickserv, if configured. (defaults to the value of :nick) :nickserv-password - The password to use for nickserv authentication or a function to fetch it. :sasl-username - The username for SASL authentication. :sasl-password - The password for SASL authentication." :type '(alist :key-type string :value-type plist) :group 'circe) (defvar circe-network-defaults '(("Freenode" :host "irc.freenode.net" :port (6667 . 6697) :tls t :nickserv-mask "^NickServ!NickServ@services\\.$" :nickserv-identify-challenge "\C-b/msg\\s-NickServ\\s-identify\\s-\C-b" :nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {nick} {password}" :nickserv-identify-confirmation "^You are now identified for .*\\.$" :nickserv-ghost-command "PRIVMSG NickServ :GHOST {nick} {password}" :nickserv-ghost-confirmation "has been ghosted\\.$\\|is not online\\.$" ) ("Coldfront" :host "irc.coldfront.net" :port 6667 :nickserv-mask "^NickServ!services@coldfront\\.net$" :nickserv-identify-challenge "/msg\\s-NickServ\\s-IDENTIFY\\s-\C-_password\C-_" :nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {password}" ) ("Bitlbee" :host "localhost" :port 6667 :nickserv-mask "\\(bitlbee\\|root\\)!\\(bitlbee\\|root\\)@" :nickserv-identify-challenge "use the \x02identify\x02 command to identify yourself" :nickserv-identify-command "PRIVMSG &bitlbee :identify {password}" :nickserv-identify-confirmation "Password accepted, settings and accounts loaded" :lagmon-disabled t ) ("OFTC" :host "irc.oftc.net" :port (6667 . 6697) :nickserv-mask "^NickServ!services@services\\.oftc\\.net$" :nickserv-identify-challenge "This nickname is registered and protected." :nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {password} {nick}" :nickserv-identify-confirmation "^You are successfully identified as .*\\.$" ) ) "Alist of networks and connection settings. See the `circe' command for details of this variable.") (defcustom circe-default-quit-message "Using Circe, the loveliest of all IRC clients" "The default quit message when no other is given. This is sent when the server buffer is killed or when /QUIT is given with no argument." :type 'string :group 'circe) (defcustom circe-default-part-message "Using Circe, the loveliest of all IRC clients" "How to part when a channel buffer is killed, or when no argument is given to /PART." :type 'string :group 'circe) (defcustom circe-auto-query-max 23 "The maximum number of queries which are opened automatically. If more messages arrive - typically in a flood situation - they are displayed in the server buffer." :type 'integer :group 'circe) (defcustom circe-use-cycle-completion nil "Whether Circe should use cycle completion. If this is not nil, Circe will set `completion-cycle-threshold' to t locally in Circe buffers, enabling cycle completion for nicks no matter what completion style you use in the rest of Emacs. If you set this to nil, Circe will not touch your default completion style." :type 'boolean :group 'circe) (defcustom circe-reduce-lurker-spam nil "If enabled, Circe will stop showing some messages. This means that JOIN, PART, QUIT and NICK messages are not shown for users on channels that have not spoken yet (\"lurker\"), or haven't spoken in `circe-active-users-timeout' seconds. When they speak for the first time, Circe displays their join time." :type 'boolean :group 'circe) (defcustom circe-active-users-timeout nil "When non-nil, should be the number of seconds after which active users are regarded as inactive again after speaking." :type 'integer :group 'circe) (defcustom circe-prompt-string (concat (propertize ">" 'face 'circe-prompt-face) " ") "The string to initialize the prompt with. To change the prompt dynamically or just in specific buffers, use `lui-set-prompt' in the appropriate hooks." :type 'string :group 'circe) (defcustom circe-extra-nicks nil "List of other nicks than your current one to highlight." :type '(repeat string) :group 'circe) (defcustom circe-highlight-nick-type 'sender "How to highlight occurrences of our own nick. 'sender - Highlight the nick of the sender (messages without a sender and your own are highlighted with the occurrence type instead) 'occurrence - Highlight the occurrences of the nick 'message - Highlight the message without the sender 'all - Highlight the whole line" :type '(choice (const :tag "Sender" sender) (const :tag "Occurrences" occurrence) (const :tag "Message" message) (const :tag "Whole line" all)) :group 'circe) (defcustom circe-inhibit-nick-highlight-function nil "Function for inhibiting nick highlighting. If non-nil, its value is called with the respective buffer selected and point in the line that's about to get highlighted. A non-nil return value inhibits any highlighting." :type '(choice (const :tag "None" nil) function) :group 'circe) (defcustom circe-completion-suffix ": " "A suffix for completed nicks at the beginning of a line." :type '(choice (const :tag "The standard suffix" ": ")) :group 'circe) (defcustom circe-ignore-list nil "List of regular expressions to ignore. Each regular expression is matched against nick!user@host." :type '(repeat regexp) :group 'circe) (defcustom circe-fool-list nil "List of regular expressions for fools. Each regular expression is matched against nick!user@host. Messages from such people are still inserted, but not shown. They can be displayed using \\[lui-toggle-ignored]." :type '(repeat regexp) :group 'circe) (defcustom circe-ignore-functions nil "A list of functions to check whether we should ignore a message. These functions get three arguments: NICK, USERHOST, and BODY. If one of them returns a non-nil value, the message is ignored." :type 'hook :group 'circe) (defcustom circe-split-line-length 440 "The maximum length of a single message. If a message exceeds this size, it is broken into multiple ones. IRC allows for lines up to 512 bytes. Two of them are CR LF. And a typical message looks like this: :nicky!uhuser@host212223.dialin.fnordisp.net PRIVMSG #lazybastards :Hello! You can limit here the maximum length of the \"Hello!\" part. Good luck." :type 'integer :group 'circe) (defcustom circe-server-max-reconnect-attempts 5 "How often Circe should attempt to reconnect to the server. If this is 0, Circe will not reconnect at all. If this is nil, it will try to reconnect forever (not recommended)." :type '(choice integer (const :tag "Forever" nil)) :group 'circe) (defcustom circe-netsplit-delay 60 "The number of seconds a netsplit may be dormant. If anything happens with a netsplit after this amount of time, the user is re-notified." :type 'number :group 'circe) (defcustom circe-server-killed-confirmation 'ask-and-kill-all "How to ask for confirmation when a server buffer is killed. This can be one of the following values: ask - Ask the user for confirmation ask-and-kill-all - Ask the user, and kill all associated buffers kill-all - Don't ask the user, and kill all associated buffers nil - Kill first, ask never" :type '(choice (const :tag "Ask before killing" ask) (const :tag "Ask, then kill all associated buffers" ask-and-kill-all) (const :tag "Don't ask, then kill all associated buffers" kill-all) (const :tag "Don't ask" nil)) :group 'circe) (defcustom circe-channel-killed-confirmation 'ask "How to ask for confirmation when a channel buffer is killed. This can be one of the following values: ask - Ask the user for confirmation nil - Don't ask, just kill" :type '(choice (const :tag "Ask before killing" ask) (const :tag "Don't ask" nil)) :group 'circe) (defcustom circe-track-faces-priorities '(circe-highlight-nick-face lui-highlight-face circe-my-message-face circe-server-face) "A list of faces which should show up in the tracking. The first face is kept if the new message has only lower faces, or faces that don't show up at all." :type '(repeat face) :group 'circe) (defcustom circe-server-send-unknown-command-p nil "Non-nil when Circe should just pass on commands it doesn't know. E.g. /fnord foo bar would then just send \"fnord foo bar\" to the server." :type 'boolean :group 'circe) (defcustom circe-server-connected-hook nil "Hook run when we successfully connected to a server. This is run from a 001 (RPL_WELCOME) message handler." :type 'hook :group 'circe) (defcustom circe-server-auto-join-default-type :immediate "The default auto-join type to use. Possible options: :immediate - Immediately after registering on the server :after-auth - After nickserv authentication succeeded :after-cloak - After we have acquired a cloaked host name :after-nick - After we regained our preferred nick, or after nickserv authentication if we don't need to regain it. See `circe-nickserv-ghost-style'. See `circe-channels' for more details." :type '(choice (const :tag "Immediately" :immediate) (const :tag "After Authentication" :after-auth) (const :tag "After Cloaking" :after-cloak) (const :tag "After Nick Regain" :after-nick)) :group 'circe) ;;;;;;;;;;;;;;;;; ;;;; Formats ;;;; ;;;;;;;;;;;;;;;;; (defgroup circe-format nil "Format strings for Circe. All these formats always allow the {mynick} and {chattarget} format strings." :prefix "circe-format-" :group 'circe) (defcustom circe-format-not-tracked '(circe-format-server-message circe-format-server-notice circe--irc-format-server-numeric circe-format-server-topic circe-format-server-rejoin circe-format-server-lurker-activity circe-format-server-topic-time circe-format-server-topic-time-for-channel circe-format-server-netmerge circe-format-server-join circe-format-server-join-in-channel circe-format-server-mode-change circe-format-server-nick-change-self circe-format-server-nick-change circe-format-server-nick-regain circe-format-server-part circe-format-server-netsplit circe-format-server-quit-channel circe-format-server-quit) "A list of formats that should not trigger tracking." :type '(repeat symbol) :group 'circe-format) (defcustom circe-format-server-message "*** {body}" "The format for generic server messages. {body} - The body of the message." :type 'string :group 'circe-format) (defcustom circe-format-self-say "> {body}" "The format for messages to queries or channels. {nick} - Your nick. {body} - The body of the message." :type 'string :group 'circe-format) (defcustom circe-format-self-action "* {nick} {body}" "The format for actions to queries or channels. {nick} - Your nick. {body} - The body of the action." :type 'string :group 'circe-format) (defcustom circe-format-self-message "-> *{chattarget}* {body}" "The format for messages sent to other people outside of queries. {chattarget} - The target nick. {body} - The body of the message." :type 'string :group 'circe-format) (defcustom circe-format-action "* {nick} {body}" "The format for actions in queries or channels. {nick} - The nick doing the action. {body} - The body of the action." :type 'string :group 'circe-format) (defcustom circe-format-message-action "* *{nick}* {body}" "The format for actions in messages outside of queries. {nick} - The nick doing the action. {body} - The body of the action." :type 'string :group 'circe-format) (defcustom circe-format-say "<{nick}> {body}" "The format for normal channel or query talk. {nick} - The nick talking. {body} - The message." :type 'string :group 'circe-format) (defcustom circe-format-message "*{nick}* {body}" "The format for a message outside of a query. {nick} - The originator. {body} - The message." :type 'string :group 'circe-format) (defcustom circe-format-notice "-{nick}- {body}" "The format for a notice. {nick} - The originator. {body} - The notice." :type 'string :group 'circe-format) (defcustom circe-format-server-notice "-Server Notice- {body}" "The format for a server notice. {body} - The notice." :type 'string :group 'circe-format) (defcustom circe-format-server-topic "*** Topic change by {nick} ({userhost}): {new-topic}" "The format for topic changes. The following format arguments are available: nick - The nick of the user who changed the topic userhost - The user@host string of that user channel - Where the topic change happened new-topic - The new topic old-topic - The previous topic topic-diff - A colorized diff of the topics" :type 'string :group 'circe-format) (defcustom circe-format-server-lurker-activity "*** First activity: {nick} joined {joindelta} ago." "The format for the first-activity notice of a user. {nick} - The originator. {jointime} - The join time of the user (in seconds). {joindelta} - The duration from joining until now." :type 'string :group 'circe-format) (defcustom circe-format-server-rejoin "*** Re-join: {nick} ({userinfo}), left {departuredelta} ago" "The format for the re-join notice of a user. The following format arguments are available: nick - The nick of the user who joined userhost - The user@host string of the user who joined accountname - The account name, if the server supports this realname - The real name, if the server supports this userinfo - A combination of userhost, accountname, and realname channel - A date string describing this time departuretime - Time in seconds when the originator had left. departuredelta - Description of the time delta since the originator left." :type 'string :group 'circe-format) (defcustom circe-server-buffer-name "{host}:{port}" "The format for the server buffer name. The following format arguments are available: network - The name of the network host - The host name of the server port - The port number or service name service - Alias for port" :type 'string :group 'circe-format) (defcustom circe-format-server-whois-idle-with-signon "*** {whois-nick} is {idle-duration} idle (signon on {signon-date}, {signon-ago} ago)" "Format for RPL_WHOISIDLE messages. The following format arguments are available: whois-nick - The nick this is about idle-seconds - The number of seconds this nick has been idle idle-duration - A textual description of the duration of the idle time signon-time - The time (in seconds since the epoch) when this user signed on signon-date - A date string describing this time signon-ago - A textual description of the duraction since signon" :type 'string :group 'circe-format) (defcustom circe-format-server-whois-idle "*** {whois-nick} is {idle-duration} idle" "Format for RPL_WHOISIDLE messages. The following format arguments are available: whois-nick - The nick this is about idle-seconds - The number of seconds this nick has been idle idle-duration - A textual description of the duration of the idle time" :type 'string :group 'circe-format) (defcustom circe-format-server-topic-time "*** Topic set by {setter} on {topic-date}, {topic-ago} ago" "Format for RPL_TOPICWHOTIME messages for the current channel. The following format arguments are available: channel - The channel the topic is for setter - The nick of the person who set the topic setter-userhost - The user@host string of the person who set the topic topic-time - The time the topic was set, in seconds since the epoch topic-date - A date string describing this time topic-ago - A textual description of the duration since the topic was set" :type 'string :group 'circe-format) (defcustom circe-format-server-topic-time-for-channel "*** Topic for {channel} set by {setter} on {topic-date}, {topic-ago} ago" "Format for RPL_TOPICWHOTIME messages for a channel we are not on. The following format arguments are available: channel - The channel the topic is for setter - The nick of the person who set the topic setter-userhost - The user@host string of the person who set the topic topic-time - The time the topic was set, in seconds since the epoch topic-date - A date string describing this time topic-ago - A textual description of the duration since the topic was set" :type 'string :group 'circe-format) (defcustom circe-format-server-channel-creation-time "*** Channel {channel} created on {date}, {ago} ago" "Format for RPL_CREATIONTIME messages for the current channel. The following format arguments are available: channel - The channel the topic is for date - A date string describing this time ago - A textual description of the duration since the channel was created" :type 'string :group 'circe-format) (defcustom circe-format-server-ctcp-ping "*** CTCP PING request from {nick} ({userhost}) to {target}: {body} ({ago} ago)" "Format for CTCP PING requests. The following format arguments are available: nick - The nick of the user who sent this PING request userhost - The user@host string of the user who sent this request target - The target of the message, usually us, but can be a channel body - The argument of the PING request, usually a number ago - A textual description of the duration since the request was sent, if parseable" :type 'string :group 'circe-format) (defcustom circe-format-server-ctcp-ping-reply "*** CTCP PING reply from {nick} ({userhost}) to {target}: {ago} ago ({body})" "Format for CTCP PING replies. The following format arguments are available: nick - The nick of the user who sent this PING request userhost - The user@host string of the user who sent this request target - The target of the message, usually us, but can be a channel body - The argument of the PING request, usually a number ago - A textual description of the duration since the request was sent, if parseable" :type 'string :group 'circe-format) (defcustom circe-format-server-ctcp "*** CTCP {command} request from {nick} ({userhost}) to {target}: {body}" "Format for CTCP requests. The following format arguments are available: nick - The nick of the user who sent this PING request userhost - The user@host string of the user who sent this request target - The target of the message, usually us, but can be a channel command - The CTCP command used body - The argument of the PING request, usually a number" :type 'string :group 'circe-format) (defcustom circe-format-server-netsplit "*** Netsplit: {split} (Use /WL to see who left)" "Format for netsplit notifications. The following format arguments are available: split - The name of the split, usually describing the servers involved" :type 'string :group 'circe-format) (defcustom circe-format-server-netmerge "*** Netmerge: {split}, split {ago} ago (Use /WL to see who's still missing)" "Format for netmerge notifications. The following format arguments are available: split - The name of the split, usually describing the servers involved time - The time when this split happened, in seconds date - A date string describing this time ago - A textual description of the duration since the split happened" :type 'string :group 'circe-format) (defcustom circe-format-server-join "*** Join: {nick} ({userinfo})" "Format for join messages in a channel buffer. The following format arguments are available: nick - The nick of the user joining userhost - The user@host string for the user accountname - The account name, if the server supports this realname - The real name, if the server supports this userinfo - A combination of userhost, accountname, and realname channel - The channel this user is joining" :type 'string :group 'circe-format) (defcustom circe-format-server-join-in-channel "*** Join: {nick} ({userinfo}) joined {channel}" "Format for join messages in query buffers of the joining user. The following format arguments are available: nick - The nick of the user joining userhost - The user@host string for the user accountname - The account name, if the server supports this realname - The real name, if the server supports this userinfo - A combination of userhost, accountname, and realname channel - The channel this user is joining" :type 'string :group 'circe-format) (defcustom circe-format-server-mode-change "*** Mode change: {change} on {target} by {setter} ({userhost})" "Format for mode changes. The following format arguments are available: setter - The name of the split, usually describing the servers involved userhost - The user@host string for the user target - The target of this mode change change - The actual changed modes" :type 'string :group 'circe-format) (defcustom circe-format-server-nick-change-self "*** Nick change: You are now known as {new-nick}" "Format for nick changes of the current user. The following format arguments are available: old-nick - The old nick this change was from new-nick - The new nick this change was to userhost - The user@host string for the user" :type 'string :group 'circe-format) (defcustom circe-format-server-nick-change "*** Nick change: {old-nick} ({userhost}) is now known as {new-nick}" "Format for nick changes of the current user. The following format arguments are available: old-nick - The old nick this change was from new-nick - The new nick this change was to userhost - The user@host string for the user" :type 'string :group 'circe-format) (defcustom circe-format-server-nick-regain "*** Nick regain: {old-nick} ({userhost}) is now known as {new-nick}" "Format for nick changes of the current user. The following format arguments are available: old-nick - The old nick this change was from new-nick - The new nick this change was to userhost - The user@host string for the user" :type 'string :group 'circe-format) (defcustom circe-format-server-part "*** Part: {nick} ({userhost}) left {channel}: {reason}" "Format for users parting a channel. The following format arguments are available: nick - The nick of the user who left userhost - The user@host string for this user channel - The channel they left reason - The reason they gave for leaving" :type 'string :group 'circe-format) (defcustom circe-format-server-quit-channel "*** Quit: {nick} ({userhost}) left {channel}: {reason}" "Format for users quitting from a channel. The following format arguments are available: nick - The nick of the user who left userhost - The user@host string for this user channel - The channel they left reason - The reason they gave for leaving" :type 'string :group 'circe-format) (defcustom circe-format-server-quit "*** Quit: {nick} ({userhost}) left IRC: {reason}" "Format for users quitting. The following format arguments are available: nick - The nick of the user who left userhost - The user@host string for this user reason - The reason they gave for leaving" :type 'string :group 'circe-format) ;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Private variables ;;; ;;;;;;;;;;;;;;;;;;;;;;;;; (defvar circe-source-url "https://github.com/jorgenschaefer/circe" "URL to Circe's source repository") (defvar circe-host nil "The name of the server we're currently connected to.") (make-variable-buffer-local 'circe-host) (defvar circe-port nil "The port number or service name of the server.") (make-variable-buffer-local 'circe-host) (defvar circe-network nil "The network name of the server we're currently connected to.") (make-variable-buffer-local 'circe-network) (defvar circe-ip-family nil "The IP family in use. See `make-network-process' and :family for valid values.") (make-variable-buffer-local 'circe-ip-family) (defvar circe-nick nil "Our current nick.") (make-variable-buffer-local 'circe-nick) (defvar circe-user nil "The current user name.") (make-variable-buffer-local 'circe-user) (defvar circe-realname nil "The current real name.") (make-variable-buffer-local 'circe-realname) (defvar circe-pass nil "The password for the current server or a function to recall it. If a function is set it will be called with the value of `circe-host'.") (make-variable-buffer-local 'circe-pass) (defvar circe-sasl-username nil "The username for SASL authentication.") (make-variable-buffer-local 'circe-sasl-username) (defvar circe-sasl-password nil "The password for SASL authentication. If a function is set it will be called with the value of `circe-host'.") (make-variable-buffer-local 'circe-sasl-password) (defvar circe-use-tls nil "If non-nil, use `open-tls-stream' to connect to the server.") (make-variable-buffer-local 'circe-use-tls) (defvar circe-server-process nil "The process of the server connection.") (make-variable-buffer-local 'circe-server-process) (defvar circe-server-last-active-buffer nil "The last active circe buffer.") (make-variable-buffer-local 'circe-server-last-active-buffer) (defvar circe-display-table nil "A hash table mapping commands to their display functions.") (defvar circe-server-inhibit-auto-reconnect-p nil "Non-nil when Circe should not reconnect. This can be set from commands to avoid reconnecting when the server disconnects.") (make-variable-buffer-local 'circe-server-inhibit-auto-reconnect-p) (defvar circe-chat-calling-server-buffer-and-target nil "Internal variable to pass the server buffer and target to chat modes.") (defvar circe-chat-target nil "The current target for the buffer. This is either a channel or a nick name.") (make-variable-buffer-local 'circe-chat-target) (defvar circe-nick-syntax-table (let ((table (make-syntax-table text-mode-syntax-table)) (special (string-to-list "[]\`_^{}|-"))) (dolist (char special) (modify-syntax-entry char "w" table)) table) "Syntax table to treat nicks as words. This is not entirely accurate, as exact chars constituting a nick can vary between networks.") (defvar circe-nickserv-mask nil "The regular expression to identify the nickserv on this network. Matched against nick!user@host.") (make-variable-buffer-local 'circe-nickserv-mask) (defvar circe-nickserv-identify-challenge nil "A regular expression matching the nickserv challenge to identify.") (make-variable-buffer-local 'circe-nickserv-identify-challenge) (defvar circe-nickserv-identify-command nil "The IRC command to send to identify with nickserv. This must be a full IRC command. It accepts the following formatting options: {nick} - The nick to identify as {password} - The configured nickserv password") (make-variable-buffer-local 'circe-nickserv-identify-command) (defvar circe-nickserv-identify-confirmation nil "A regular expression matching a confirmation of authentication.") (make-variable-buffer-local 'circe-nickserv-identify-confirmation) (defvar circe-nickserv-ghost-command nil "The IRC command to send to regain/ghost your nick. This must be a full IRC command. It accepts the following formatting options: {nick} - The nick to ghost {password} - The configured nickserv password") (make-variable-buffer-local 'circe-nickserv-ghost-command) (defvar circe-nickserv-ghost-confirmation nil "A regular expression matching a confirmation for the GHOST command. This is used to know when we can set our nick to the regained one Leave nil if regaining automatically sets your nick") (make-variable-buffer-local 'circe-nickserv-ghost-confirmation) (defvar circe-nickserv-nick nil "The nick we are registered with for nickserv. Do not set this variable directly. Use `circe-network-options' or pass an argument to the `circe' function for this.") (make-variable-buffer-local 'circe-nickserv-nick) (defvar circe-nickserv-password nil "The password we use for nickserv on this network. Can be either a string or a unary function of the nick returning a string. Do not set this variable directly. Use `circe-network-options' or pass an argument to the `circe' function for this.") (make-variable-buffer-local 'circe-nickserv-password) (defvar circe-channels nil "The default channels to join on this server. Don't set this variable by hand, use `circe-network-options'. The value should be a list of channels to join, with optional keywords to configure the behavior of the following channels. Best explained in an example: \(\"#emacs\" :after-auth \"#channel\" \"#channel2\") Possible keyword options are: :immediate - Immediately after registering on the server :after-auth - After nickserv authentication succeeded :after-cloak - After we have acquired a cloaked host name :after-nick - After we regained our preferred nick, or after nickserv authentication if we don't need to regain it. See `circe-nickserv-ghost-style'. The default is set in `circe-server-auto-join-default-type'. A keyword in the first position of the channels list overrides `circe-server-auto-join-default-type' for re-joining manually joined channels.") (make-variable-buffer-local 'circe-channels) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Server Buffer Management ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Every Circe buffer has an associated server buffer (which might be ;; the buffer itself). Circe buffers should set the ;; `circe-server-buffer' variable to the associated server buffer. (defun circe-server-buffer () "Return the server buffer for the current buffer." (let ((buf (if (eq major-mode 'circe-server-mode) (current-buffer) circe-server-buffer))) (cond ((not buf) (error "Not in a Circe buffer")) ((not (buffer-live-p buf)) (error "The server buffer died, functionality is limited")) (t buf)))) (defmacro with-circe-server-buffer (&rest body) "Run BODY with the current buffer being the current server buffer." (declare (indent 0)) `(with-current-buffer (circe-server-buffer) ,@body)) ;;;;;;;;;;;;;;;;;;;;;;; ;;; Editor Commands ;;; ;;;;;;;;;;;;;;;;;;;;;;; ;;;###autoload (defun circe-version () "Display Circe's version." (interactive) (message "Circe %s" (circe--version))) (defun circe--version () "Return Circe's version" (let ((circe-git-version (circe--git-version))) (if circe-git-version (format "%s-%s" circe-version circe-git-version) (format "%s" circe-version)))) (defun circe--git-version () (let ((current-file-path (or load-file-name buffer-file-name))) (when (or (not current-file-path) (not (equal (file-name-nondirectory current-file-path) "circe.el"))) (setq current-file-path (locate-library "circe.el"))) (let ((vcs-path (locate-dominating-file current-file-path ".git"))) (when vcs-path (let ((default-directory vcs-path)) ;; chop off the trailing newline (substring (shell-command-to-string "git rev-parse --short HEAD") 0 -1)))))) ;;;###autoload (defun circe (network-or-server &rest server-options) "Connect to IRC. Connect to the given network specified by NETWORK-OR-SERVER. When this function is called, it collects options from the SERVER-OPTIONS argument, the user variable `circe-network-options', and the defaults found in `circe-network-defaults', in this order. If NETWORK-OR-SERVER is not found in any of these variables, the argument is assumed to be the host name for the server, and all relevant settings must be passed via SERVER-OPTIONS. All SERVER-OPTIONS are treated as variables by getting the string \"circe-\" prepended to their name. This variable is then set locally in the server buffer. See `circe-network-options' for a list of common options." (interactive (circe--read-network-and-options)) (let* ((options (circe--server-get-network-options network-or-server server-options)) (buffer (circe--server-generate-buffer options))) (with-current-buffer buffer (circe-server-mode) (circe--server-set-variables options) (circe-reconnect)) (pop-to-buffer-same-window buffer))) (defun circe--read-network-and-options () "Read a host or network name with completion. If it's not a network, also read some extra options. This uses `circe-network-defaults' and `circe-network-options' for network names." (let ((default-network (if (null circe-network-options) (caar circe-network-defaults) (caar circe-network-options))) (networks nil) (completion-ignore-case t) network-or-host) (dolist (network-spec (append circe-network-options circe-network-defaults)) (when (not (member (car network-spec) networks)) (push (car network-spec) networks))) (setq networks (sort networks 'string-lessp)) (setq network-or-host (completing-read "Network or host: " networks nil nil nil nil default-network)) (dolist (network-name networks) (when (equal (downcase network-or-host) (downcase network-name)) (setq network-or-host network-name))) (if (member network-or-host networks) (list network-or-host) (list network-or-host :host network-or-host :port (read-number "Port: " 6667))))) (defun circe--server-get-network-options (network server-options) "Combine server and network options with network defaults. See `circe-network-options' and `circe-network-defaults'." (let ((options (mapcar 'circe--translate-option-names (append server-options (cdr (assoc network circe-network-options)) (cdr (assoc network circe-network-defaults)) (list :network network))))) (when (not (plist-get options :host)) (plist-put options :host network)) (let ((port (plist-get options :port)) (use-tls (plist-get options :use-tls))) (when (consp port) (if use-tls (plist-put options :port (cdr port)) (plist-put options :port (car port))))) (dolist (required-option '(:host :port)) (when (not (plist-get options required-option)) (error (format "Network option %s not specified" required-option)))) options)) (defun circe--translate-option-names (option) "Translate option names to make them unique. Some options have multiple names, mainly for historical reasons. Unify them here." (cond ((eq option :service) :port) ((eq option :tls) :use-tls) ((eq option :family) :ip-family) (t option))) (defun circe--server-generate-buffer (options) "Return the server buffer for the connection described in OPTIONS." (let* ((network (plist-get options :network)) (host (plist-get options :host)) (port (plist-get options :port)) (buffer-name (lui-format (or (plist-get options :server-buffer-name) circe-server-buffer-name) :network network :host host :port port :service port))) (generate-new-buffer buffer-name))) (defun circe--server-set-variables (options) "Set buffer-local variables described in OPTIONS. OPTIONS is a plist as passed to `circe'. All options therein are set as buffer-local variables. Only the first occurrence of each variable is set." (setq circe-nick circe-default-nick circe-user circe-default-user circe-realname circe-default-realname circe-ip-family circe-default-ip-family) (let ((done nil) (todo options)) (while todo (when (not (memq (car todo) done)) (push (car todo) done) (let ((var (intern (format "circe-%s" (substring (symbol-name (car todo)) 1)))) (val (cadr todo))) (if (boundp var) (set (make-local-variable var) val) (warn "Unknown option %s, ignored" (car todo))))) (setq todo (cddr todo))))) (defvar circe-server-reconnect-attempts 0 "The number of reconnect attempts that Circe has done so far. See `circe-server-max-reconnect-attempts'.") (make-variable-buffer-local 'circe-server-reconnect-attempts) (defun circe-reconnect () "Reconnect the current server." (interactive) (with-circe-server-buffer (when (or (called-interactively-p 'any) (circe--reconnect-p)) (setq circe-server-inhibit-auto-reconnect-p t circe-server-reconnect-attempts (+ circe-server-reconnect-attempts 1)) (unwind-protect (circe-reconnect--internal) (setq circe-server-inhibit-auto-reconnect-p nil))))) (defun circe--reconnect-p () (cond (circe-server-inhibit-auto-reconnect-p nil) ((not circe-server-max-reconnect-attempts) t) ((<= circe-server-reconnect-attempts circe-server-max-reconnect-attempts) t) (t nil))) (defun circe-reconnect--internal () "The internal function called for reconnecting unconditionally. Do not use this directly, use `circe-reconnect'" (when (and circe-server-process (process-live-p circe-server-process)) (delete-process circe-server-process)) (circe-display-server-message "Connecting...") (dolist (buf (circe-server-chat-buffers)) (with-current-buffer buf (circe-display-server-message "Connecting..."))) (setq circe-server-process (irc-connect :host circe-host :service circe-port :tls circe-use-tls :ip-family circe-ip-family :handler-table (circe-irc-handler-table) :server-buffer (current-buffer) :nick circe-nick :nick-alternatives (list (circe--nick-next circe-nick) (circe--nick-next (circe--nick-next circe-nick))) :user circe-user :mode 8 :realname circe-realname :pass (if (functionp circe-pass) (funcall circe-pass circe-host) circe-pass) :cap-req (append (when (and circe-sasl-username circe-sasl-password) '("sasl")) '("extended-join")) :nickserv-nick (or circe-nickserv-nick circe-nick) :nickserv-password (if (functionp circe-nickserv-password) (funcall circe-nickserv-password circe-host) circe-nickserv-password) :nickserv-mask circe-nickserv-mask :nickserv-identify-challenge circe-nickserv-identify-challenge :nickserv-identify-command circe-nickserv-identify-command :nickserv-identify-confirmation circe-nickserv-identify-confirmation :nickserv-ghost-command circe-nickserv-ghost-command :nickserv-ghost-confirmation circe-nickserv-ghost-confirmation :sasl-username circe-sasl-username :sasl-password (if (functionp circe-sasl-password) (funcall circe-sasl-password circe-host) circe-sasl-password) :ctcp-version (format "Circe: Client for IRC in Emacs, version %s" circe-version) :ctcp-source circe-source-url :ctcp-clientinfo "CLIENTINFO PING SOURCE TIME VERSION" :auto-join-after-registration (append (circe--auto-join-channel-buffers) (circe--auto-join-list :immediate)) :auto-join-after-host-hiding (circe--auto-join-list :after-cloak) :auto-join-after-nick-acquisition (circe--auto-join-list :after-nick) :auto-join-after-nickserv-identification (circe--auto-join-list :after-auth) :auto-join-after-sasl-login (circe--auto-join-list :after-auth)))) (defun circe-reconnect-all () "Reconnect all Circe connections." (interactive) (dolist (buf (circe-server-buffers)) (with-current-buffer buf (if (called-interactively-p 'any) (call-interactively 'circe-reconnect) (circe-reconnect))))) (defun circe--auto-join-list (type) "Return the list of channels to join for type TYPE." (let ((result nil) (current-type circe-server-auto-join-default-type)) (dolist (channel circe-channels) (cond ((keywordp channel) (setq current-type channel)) ((eq current-type type) (push channel result)))) (nreverse result))) (defun circe--auto-join-channel-buffers () "Return a list of channels to join based on channel buffers. This includes all channel buffers of the current server, but excludes and channel that is already listed in `circe-channels'." (let ((channels nil)) (dolist (buf (circe-server-chat-buffers)) (let ((name (with-current-buffer buf (when (derived-mode-p 'circe-channel-mode) circe-chat-target)))) (when (and name (not (member name circe-channels))) (push name channels)))) channels)) ;;;;;;;;;;;;;;;;; ;;; Base Mode ;;; ;;;;;;;;;;;;;;;;; (defvar circe-mode-hook nil "Hook run for any Circe mode.") (defvar circe-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-j") 'circe-command-JOIN) (define-key map (kbd "C-c C-r") 'circe-reconnect) map) "The base keymap for all Circe modes (server, channel, query)") (defvar circe-server-buffer nil "The buffer of the server associated with the current chat buffer.") (make-variable-buffer-local 'circe-server-buffer) (define-derived-mode circe-mode lui-mode "Circe" "Base mode for all Circe buffers. A buffer should never be in this mode directly, but rather in modes that derive from this. The mode inheritance hierarchy looks like this: lui-mode `-circe-mode `-circe-server-mode `-circe-chat-mode `-circe-channel-mode `-circe-query-mode" (add-hook 'lui-pre-output-hook 'lui-irc-colors t t) (add-hook 'lui-pre-output-hook 'circe--output-highlight-nick t t) (add-hook 'completion-at-point-functions 'circe--completion-at-point nil t) (lui-set-prompt circe-prompt-string) (goto-char (point-max)) (setq lui-input-function 'circe--input default-directory (expand-file-name circe-default-directory) circe-server-last-active-buffer (current-buffer) flyspell-generic-check-word-p 'circe--flyspell-check-word-p) (when circe-use-cycle-completion (set (make-local-variable 'completion-cycle-threshold) t)) ;; Tab completion should be case-insensitive (set (make-local-variable 'completion-ignore-case) t) (set (make-local-variable 'tracking-faces-priorities) circe-track-faces-priorities)) ;;;;;;;;;;;;;;;;;;;; ;;;; Displaying ;;;; ;;;;;;;;;;;;;;;;;;;; (defun circe-display (format &rest keywords) "Display FORMAT formatted with KEYWORDS in the current Circe buffer. See `lui-format' for a description of the format. If FORMAT contains the word server, the resulting string receives a `circe-server-face'. If FORMAT contains the word self, the whole string receives a `circe-my-message-face'. If FORMAT is in `circe-format-not-tracked', a message of this type is never tracked by Lui. Keywords with the name :nick receive a `circe-originator-face'. It is always possible to use the mynick or target formats." (when (not (circe--display-ignored-p format keywords)) (let* ((name (symbol-name format)) (face (cond ((string-match "\\" name) 'circe-server-face) ((string-match "\\" name) 'circe-my-message-face))) (keywords (append `(:mynick ,(circe-nick) :chattarget ,circe-chat-target) (circe--display-add-nick-property (if (and (not (null keywords)) (null (cdr keywords))) (car keywords) keywords)))) (text (lui-format format keywords))) (when (circe--display-fool-p format keywords) (add-face-text-property 0 (length text) 'circe-fool-face t text) (put-text-property 0 (length text) 'lui-fool t text)) (when face (add-face-text-property 0 (length text) face t text)) (lui-insert text (memq format circe-format-not-tracked))))) (defun circe-display-server-message (message) "Display MESSAGE as a server message." (circe-display 'circe-format-server-message :body message)) (defun circe--display-add-nick-property (keywords) "Add a face to the value of the :nick property in KEYWORDS." (let ((keyword nil)) (mapcar (lambda (entry) (cond ((or (eq keyword :nick) (eq keyword 'nick)) (setq keyword nil) (propertize entry 'face 'circe-originator-face)) (t (setq keyword entry) entry))) keywords))) (defun circe--display-ignored-p (_format keywords) (let ((nick (plist-get keywords :nick)) (userhost (plist-get keywords :userhost)) (body (plist-get keywords :body))) (circe--ignored-p nick userhost body))) (defun circe--display-fool-p (_format keywords) (let ((nick (plist-get keywords :nick)) (userhost (plist-get keywords :userhost)) (body (plist-get keywords :body))) (circe--fool-p nick userhost body))) (defun circe--ignored-p (nick userhost body) "True if this user or message is being ignored. See `circe-ignore-functions' and `circe-ignore-list'. NICK, USER and HOST should be the sender of a the command COMMAND, which had the arguments ARGS." (or (run-hook-with-args-until-success 'circe-ignore-functions nick userhost body) (circe--ignore-matches-p nick userhost body circe-ignore-list))) (defun circe--fool-p (nick userhost body) "True if this user or message is a fool. See `circe-fool-list'. NICK, USER and HOST should be the sender of a the command COMMAND, which had the arguments ARGS." (circe--ignore-matches-p nick userhost body circe-fool-list)) (defun circe--ignore-matches-p (nick userhost body patterns) "Check if a given command does match an ignore pattern. A pattern matches if it either matches the user NICK!USER@HOST, or if it matches the first word in BODY. PATTERNS should be the list of regular expressions." (let ((string (format "%s!%s" nick userhost)) (target (when (and body (string-match "^\\([^ ]*\\)[:,]" body)) (match-string 1 body)))) (catch 'return (dolist (regex patterns) (when (string-match regex string) (throw 'return t)) (when (and (stringp target) (string-match regex target)) (throw 'return t))) nil))) ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Nick Highlighting ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun circe--output-highlight-nick () "Highlight the nick of the user in the buffer. This is used in `lui-pre-output-hook'." (goto-char (or (text-property-any (point-min) (point-max) 'lui-format-argument 'body) (point-min))) (when (or (not circe-inhibit-nick-highlight-function) (not (funcall circe-inhibit-nick-highlight-function))) (let* ((nick (circe-nick)) (nicks (append (and nick (list nick)) circe-extra-nicks))) (when nicks ;; Can't use \<...\> because that won't match for \ We ;; might eventually use \_< ... \_> if we define symbols to be ;; nicks \\= is necessary, because it might be found right where we ;; are, and that might not be the beginning of a line... (We start ;; searching from the beginning of the body) (let ((nick-regex (concat "\\(?:^\\|\\W\\|\\=\\)" "\\(" (regexp-opt nicks) "\\)" "\\(?:$\\|\\W\\)"))) (cond ((eq circe-highlight-nick-type 'sender) (if (text-property-any (point-min) (point-max) 'face 'circe-originator-face) (when (re-search-forward nick-regex nil t) (circe--extend-text-having-face (point-min) (point-max) 'circe-originator-face 'circe-highlight-nick-face)) (let ((circe-highlight-nick-type 'occurrence)) (circe--output-highlight-nick)))) ((eq circe-highlight-nick-type 'occurrence) (while (re-search-forward nick-regex nil t) (add-face-text-property (match-beginning 1) (match-end 1) 'circe-highlight-nick-face))) ((eq circe-highlight-nick-type 'message) (when (re-search-forward nick-regex nil t) (let* ((start (text-property-any (point-min) (point-max) 'lui-format-argument 'body)) (end (when start (next-single-property-change start 'lui-format-argument)))) (when (and start end) (add-face-text-property start end 'circe-highlight-nick-face))))) ((eq circe-highlight-nick-type 'all) (when (re-search-forward nick-regex nil t) (add-face-text-property (point-min) (point-max) 'circe-highlight-nick-face))))))))) (defun circe--extend-text-having-face (from to existing new) "Extend property values. In the text between FROM and TO, find any text that has its face property set to EXISTING, and prepend NEW to the value of its face property, when necessary by turning it into a list." (let ((beg (text-property-any from to 'face existing))) (while beg (let ((end (next-single-property-change beg 'face))) (add-face-text-property beg end new) (setq beg (text-property-any end to 'face existing)))))) ;;;;;;;;;;;;;;; ;;;; Input ;;;; ;;;;;;;;;;;;;;; (defun circe--input (str) "Process STR as input. This detects commands and interprets them, or sends the input using the /SAY command." (set-text-properties 0 (length str) nil str) (cond ((string= str "") nil) ;; Ignore commands in multiline input ((and (not (string-match "\n" str)) (string-match "\\`/\\([^/ ][^ ]*\\|[^/ ]*\\) ?\\([^\n]*\\)\\'" str)) (let* ((command (match-string 1 str)) (args (match-string 2 str)) (handler (intern-soft (format "circe-command-%s" (upcase command))))) (cond ((string= command "") (circe-command-SAY args)) (handler (funcall handler args)) (circe-server-send-unknown-command-p (irc-send-raw (circe-server-process) (format "%s %s" (upcase command) args))) (t (circe-display-server-message (format "Unknown command: %s" command)))))) (t (mapc #'circe-command-SAY (circe--list-drop-right (split-string str "\n") "^ *$"))))) ;;;;;;;;;;;;;;;;;; ;;;; Flyspell ;;;; ;;;;;;;;;;;;;;;;;; (defun circe--flyspell-check-word-p () "Return a true value if flyspell check the word before point. This is a suitable value for `flyspell-generic-check-word-p'. It will also call `lui-flyspell-check-word-p'." (cond ((not (lui-flyspell-check-word-p)) nil) ((circe-channel-user-p (circe--flyspell-nick-before-point)) nil) (t t))) (defun circe--flyspell-nick-before-point () "Return the IRC nick before point" (with-syntax-table circe-nick-syntax-table (let (beg end) (save-excursion (forward-word -1) (setq beg (point)) (forward-word 1) (setq end (point))) (buffer-substring beg end)))) ;;;;;;;;;;;;;;;;;;;; ;;;; Completion ;;;; ;;;;;;;;;;;;;;;;;;;; (defun circe--completion-at-point () "Return a list of possible completions for the current buffer. This is used in `completion-at-point-functions'." ;; Use markers so they move when input happens (let ((start (make-marker)) (end (make-marker))) (set-marker end (point)) (set-marker start (save-excursion (when (or (looking-back (regexp-quote circe-completion-suffix) (length circe-completion-suffix)) (looking-back " " 1)) (goto-char (match-beginning 0))) (cond ((<= (point) lui-input-marker) lui-input-marker) ((re-search-backward "\\s-" lui-input-marker t) (1+ (point))) (t lui-input-marker)))) (list start end 'circe--completion-table))) (defun circe--completion-table (string pred action) "Completion table to use for Circe buffers. See `minibuffer-completion-table' for details." (cond ;; Best completion of STRING ((eq action nil) (try-completion string (circe--completion-candidates (if (= (- (point) (length string)) lui-input-marker) circe-completion-suffix " ")) pred)) ;; A list of possible completions of STRING ((eq action t) (all-completions string (circe--completion-candidates (if (= (- (point) (length string)) lui-input-marker) circe-completion-suffix " ")) pred)) ;; t iff STRING is a valid completion as it stands ((eq action 'lambda) (test-completion string (circe--completion-candidates (if (= (- (point) (length string)) lui-input-marker) circe-completion-suffix " ")) pred)) ;; Boundaries ((eq (car-safe action) 'boundaries) `(boundaries 0 . ,(length (cdr action)))) ;; Metadata ((eq action 'metadata) '(metadata (cycle-sort-function . circe--completion-sort))))) (defun circe--completion-clean-nick (string) (with-temp-buffer (insert string) (goto-char (point-max)) (when (or (looking-back circe-completion-suffix nil) (looking-back " " nil)) (replace-match "")) (buffer-string))) (defun circe--completion-sort (collection) "Sort the COLLECTION by channel activity for nicks." (let* ((proc (circe-server-process)) (channel (when (and circe-chat-target proc) (irc-connection-channel proc circe-chat-target))) (decorated (mapcar (lambda (entry) (let* ((nick (circe--completion-clean-nick entry)) (user (when channel (irc-channel-user channel nick)))) (list (when user (irc-user-last-activity-time user)) (length entry) entry))) collection)) (sorted (sort decorated (lambda (a b) (cond ((and (car a) (car b)) (> (car a) (car b))) ((and (not (car a)) (not (car b))) (< (cadr a) (cadr b))) ((car a) t) (t nil)))))) (mapcar (lambda (entry) (nth 2 entry)) sorted))) ;; FIXME: I do not know why this is here. (defvar circe--completion-old-completion-all-sorted-completions nil "Variable to know if we can return a cached result.") (make-variable-buffer-local 'circe--completion-old-completion-all-sorted-completions) (defvar circe--completion-cache nil "The results we can cache.") (make-variable-buffer-local 'circe--completion-cache) (defun circe--completion-candidates (nick-suffix) (if (and circe--completion-old-completion-all-sorted-completions (eq completion-all-sorted-completions circe--completion-old-completion-all-sorted-completions)) circe--completion-cache (let ((completions (append (circe--commands-list) (mapcar (lambda (buf) (with-current-buffer buf circe-chat-target)) (circe-server-channel-buffers))))) (cond ;; In a server buffer, complete all nicks in all channels ((eq major-mode 'circe-server-mode) (dolist (buf (circe-server-channel-buffers)) (with-current-buffer buf (dolist (nick (circe-channel-nicks)) (setq completions (cons (concat nick nick-suffix) completions)))))) ;; In a channel buffer, only complete nicks in this channel ((eq major-mode 'circe-channel-mode) (setq completions (append (delete (concat (circe-nick) nick-suffix) (mapcar (lambda (nick) (concat nick nick-suffix)) (circe-channel-nicks))) completions))) ;; In a query buffer, only complete this query partner ((eq major-mode 'circe-query-mode) (setq completions (cons (concat circe-chat-target nick-suffix) completions))) ;; Else, we're doing something wrong (t (error "`circe-possible-completions' called outside of Circe"))) (setq circe--completion-old-completion-all-sorted-completions completion-all-sorted-completions circe--completion-cache completions) completions))) (defun circe--commands-list () "Return a list of possible Circe commands." (mapcar (lambda (symbol) (let ((str (symbol-name symbol))) (if (string-match "^circe-command-\\(.*\\)" str) (concat "/" (match-string 1 str) " ") str))) (apropos-internal "^circe-command-"))) ;;;;;;;;;;;;;;;;;;; ;;; Server Mode ;;; ;;;;;;;;;;;;;;;;;;; (defvar circe-server-mode-hook nil "Hook run when a new Circe server buffer is created.") (defvar circe-server-mode-map (make-sparse-keymap) "The key map for server mode buffers.") (define-derived-mode circe-server-mode circe-mode "Circe Server" "The mode for circe server buffers. This buffer represents a server connection. When you kill it, the server connection is closed. This will make all associated buffers unusable. Be sure to use \\[circe-reconnect] if you want to reconnect to the server. \\{circe-server-mode-map}" (add-hook 'kill-buffer-hook 'circe-server-killed nil t)) (defun circe-server-killed () "Run when the server buffer got killed. This will IRC, and ask the user whether to kill all of the server's chat buffers." (when circe-server-killed-confirmation (when (not (y-or-n-p (if (eq circe-server-killed-confirmation 'ask-and-kill-all) "Really kill all buffers of this server? (if not, try `circe-reconnect') " "Really kill the IRC connection? (if not, try `circe-reconnect') "))) (error "Buffer not killed as per user request"))) (setq circe-server-inhibit-auto-reconnect-p t) (ignore-errors (irc-send-QUIT circe-server-process circe-default-quit-message)) (ignore-errors (delete-process circe-server-process)) (when (or (eq circe-server-killed-confirmation 'ask-and-kill-all) (eq circe-server-killed-confirmation 'kill-all)) (dolist (buf (circe-server-chat-buffers)) (let ((circe-channel-killed-confirmation nil)) (kill-buffer buf))))) (defun circe-server-buffers () "Return a list of all server buffers in this Emacs instance." (let ((result nil)) (dolist (buf (buffer-list)) (with-current-buffer buf (when (eq major-mode 'circe-server-mode) (setq result (cons buf result))))) (nreverse result))) (defun circe-server-process () "Return the current server process." (with-circe-server-buffer circe-server-process)) (defun circe-server-my-nick-p (nick) "Return non-nil when NICK is our current nick." (let ((proc (circe-server-process))) (when proc (irc-current-nick-p proc nick)))) (defun circe-nick () "Return our current nick." (let ((proc (circe-server-process))) (when proc (irc-current-nick proc)))) (defun circe-server-last-active-buffer () "Return the last active buffer of this server." (with-circe-server-buffer (if (and circe-server-last-active-buffer (bufferp circe-server-last-active-buffer) (buffer-live-p circe-server-last-active-buffer)) circe-server-last-active-buffer (current-buffer)))) ;; There really ought to be a hook for this (defadvice select-window (after circe-server-track-select-window (window &optional norecord)) "Remember the current buffer as the last active buffer. This is used by Circe to know where to put spurious messages." (with-current-buffer (window-buffer window) (when (derived-mode-p 'circe-mode) (let ((buf (current-buffer))) (ignore-errors (with-circe-server-buffer (setq circe-server-last-active-buffer buf))))))) (ad-activate 'select-window) (defun circe-reduce-lurker-spam () "Return the value of `circe-reduce-lurker-spam'. This uses a buffer-local value first, then the one in the server buffer. Use this instead of accessing the variable directly to enable setting the variable through network options." (if (local-variable-p 'circe-reduce-lurker-spam) circe-reduce-lurker-spam (with-circe-server-buffer circe-reduce-lurker-spam))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Chat Buffer Management ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Server buffers keep track of associated chat buffers. This enables ;; us to not rely on buffer names staying the same, as well as keeping ;; buffers from different servers and even server connections apart ;; cleanly. (defvar circe-server-chat-buffer-table nil "A hash table of chat buffers associated with this server.") (make-variable-buffer-local 'circe-server-chat-buffer-table) (defun circe-server-get-chat-buffer (target) "Return the chat buffer addressing TARGET, or nil if none." (with-circe-server-buffer (when circe-server-chat-buffer-table (let* ((target-name (irc-isupport--case-fold (circe-server-process) target)) (buf (gethash target-name circe-server-chat-buffer-table))) (if (buffer-live-p buf) buf (remhash target-name circe-server-chat-buffer-table) nil))))) (defun circe-server-create-chat-buffer (target chat-mode) "Return a new buffer addressing TARGET in CHAT-MODE." (with-circe-server-buffer (let* ((target-name (irc-isupport--case-fold (circe-server-process) target)) (chat-buffer (generate-new-buffer target)) (server-buffer (current-buffer)) (circe-chat-calling-server-buffer-and-target (cons server-buffer target-name))) (when (not circe-server-chat-buffer-table) (setq circe-server-chat-buffer-table (make-hash-table :test 'equal))) (puthash target-name chat-buffer circe-server-chat-buffer-table) (with-current-buffer chat-buffer (funcall chat-mode)) chat-buffer))) (defun circe-server-get-or-create-chat-buffer (target chat-mode) "Return a buffer addressing TARGET; create one in CHAT-MODE if none exists." (let ((buf (circe-server-get-chat-buffer target))) (if buf buf (circe-server-create-chat-buffer target chat-mode)))) (defun circe-server-remove-chat-buffer (target-or-buffer) "Remove the buffer addressing TARGET-OR-BUFFER." (with-circe-server-buffer (let* ((target (if (bufferp target-or-buffer) (circe-server-chat-buffer-target target-or-buffer) target-or-buffer)) (target-name (irc-isupport--case-fold (circe-server-process) target))) (remhash target-name circe-server-chat-buffer-table)))) (defun circe-server-rename-chat-buffer (old-name new-name) "Note that the chat buffer addressing OLD-NAME now addresses NEW-NAME." (with-circe-server-buffer (let* ((old-target-name (irc-isupport--case-fold (circe-server-process) old-name)) (new-target-name (irc-isupport--case-fold (circe-server-process) new-name)) (buf (gethash old-target-name circe-server-chat-buffer-table))) (when buf (remhash old-target-name circe-server-chat-buffer-table) (puthash new-target-name buf circe-server-chat-buffer-table) (with-current-buffer buf (setq circe-chat-target new-name) (rename-buffer new-name t)))))) (defun circe-server-chat-buffer-target (&optional buffer) "Return the chat target of BUFFER, or the current buffer if none." (if buffer (with-current-buffer buffer circe-chat-target) circe-chat-target)) (defun circe-server-chat-buffers () "Return the list of chat buffers on this server." (with-circe-server-buffer (when circe-server-chat-buffer-table (let ((buffer-list nil)) (maphash (lambda (target-name buffer) (if (buffer-live-p buffer) (push buffer buffer-list) (remhash target-name circe-server-chat-buffer-table))) circe-server-chat-buffer-table) buffer-list)))) (defun circe-server-channel-buffers () "Return a list of all channel buffers of this server." (let ((result nil)) (dolist (buf (circe-server-chat-buffers)) (with-current-buffer buf (when (eq major-mode 'circe-channel-mode) (setq result (cons buf result))))) (nreverse result))) ;;;;;;;;;;;;;;;;; ;;; Chat Mode ;;; ;;;;;;;;;;;;;;;;; (defvar circe-chat-mode-hook nil "Hook run when a new chat buffer (channel or query) is created.") (defvar circe-chat-mode-map (make-sparse-keymap) "Base key map for all Circe chat buffers (channel, query).") ;; Defined here as we use it, but do not necessarily want to use the ;; full module. (defvar lui-logging-format-arguments nil "A list of arguments to be passed to `lui-format'. This can be used to extend the formatting possibilities of the file name for lui applications.") (make-variable-buffer-local 'lui-logging-format-arguments) (define-derived-mode circe-chat-mode circe-mode "Circe Chat" "The circe chat major mode. This is the common mode used for both queries and channels. It should not be used directly. TARGET is the default target to send data to. SERVER-BUFFER is the server buffer of this chat buffer." (setq circe-server-buffer (car circe-chat-calling-server-buffer-and-target) circe-chat-target (cdr circe-chat-calling-server-buffer-and-target)) (let ((network (with-circe-server-buffer circe-network))) (make-local-variable 'mode-line-buffer-identification) (setq mode-line-buffer-identification (list (format "%%b@%-8s" network))) (setq lui-logging-format-arguments `(:target ,circe-chat-target :network ,network))) (when (equal circe-chat-target "#emacs-circe") (set (make-local-variable 'lui-button-issue-tracker) "https://github.com/jorgenschaefer/circe/issues/%s"))) (defun circe-chat-disconnected () "The current buffer got disconnected." (circe-display-server-message "Disconnected")) ;;;;;;;;;;;;;;;;;;;; ;;; Channel Mode ;;; ;;;;;;;;;;;;;;;;;;;; (defvar circe-channel-mode-hook nil "Hook run in a new channel buffer.") (defvar circe-channel-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-n") 'circe-command-NAMES) (define-key map (kbd "C-c C-t") 'circe-command-CHTOPIC) map) "The key map for channel mode buffers.") (define-derived-mode circe-channel-mode circe-chat-mode "Circe Channel" "The circe channel chat major mode. This mode represents a channel you are talking in. TARGET is the default target to send data to. SERVER-BUFFER is the server buffer of this chat buffer. \\{circe-channel-mode-map}" (add-hook 'kill-buffer-hook 'circe-channel-killed nil t)) (defun circe-channel-killed () "Called when the channel buffer got killed. If we are not on the channel being killed, do nothing. Otherwise, if the server is live, and the user wants to kill the buffer, send PART to the server and clean up the channel's remaining state." (when (buffer-live-p circe-server-buffer) (when (and circe-channel-killed-confirmation (not (y-or-n-p "Really leave this channel? "))) (error "Channel not left.")) (ignore-errors (irc-send-PART (circe-server-process) circe-chat-target circe-default-part-message)) (ignore-errors (circe-server-remove-chat-buffer circe-chat-target)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; Channel User Tracking ;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Channel mode buffers provide some utility functions to check if a ;; given user is idle or not. (defun circe-channel-user-nick-regain-p (_old new) "Return true if a nick change from OLD to NEW constitutes a nick regain. A nick was regained if the NEW nick was also a recent user." (let ((channel (irc-connection-channel (circe-server-process) circe-chat-target))) (when channel (irc-channel-recent-user channel new)))) (defun circe-channel-user-p (nick) "Return non-nil when NICK belongs to a channel user." (cond ((eq major-mode 'circe-query-mode) (irc-string-equal-p (circe-server-process) nick circe-chat-target)) ((eq major-mode 'circe-channel-mode) (let ((channel (irc-connection-channel (circe-server-process) circe-chat-target))) (when channel (if (irc-channel-user channel nick) t nil)))))) (defun circe-channel-nicks () "Return a list of nicks in the current channel." (let* ((channel (irc-connection-channel (circe-server-process) circe-chat-target)) (nicks nil)) (when channel (maphash (lambda (_folded-nick user) (push (irc-user-nick user) nicks)) (irc-channel-users channel))) nicks)) (defun circe-user-channels (nick) "Return a list of channel buffers for the user named NICK." (let* ((result nil)) (dolist (channel (irc-connection-channel-list (circe-server-process))) (when (irc-channel-user channel nick) (let* ((name (irc-channel-name channel)) (buf (circe-server-get-chat-buffer name))) (when buf (push buf result))))) result)) (defun circe-lurker-p (nick) "Return a true value if this nick is regarded inactive." (let* ((channel (irc-connection-channel (circe-server-process) circe-chat-target)) (user (when channel (irc-channel-user channel nick))) (recent-user (when channel (irc-channel-recent-user channel nick))) (last-active (cond (user (irc-user-last-activity-time user)) (recent-user (irc-user-last-activity-time recent-user))))) (cond ;; If we do not track lurkers, no one is ever a lurker. ((not (circe-reduce-lurker-spam)) nil) ;; We ourselves are never lurkers (in this sense). ((circe-server-my-nick-p nick) nil) ;; Someone who isn't even on the channel (e.g. NickServ) isn't a ;; lurker, either. ((and (not user) (not recent-user)) nil) ;; If someone has never been active, they most definitely *are* a ;; lurker. ((not last-active) t) ;; But if someone has been active, and we mark active users ;; inactive again after a timeout ... (circe-active-users-timeout ;; They are still lurkers if their activity has been too long ;; ago. (> (- (float-time) last-active) circe-active-users-timeout)) ;; Otherwise, they have been active and we don't mark active ;; users inactive again, so nope, not a lurker. (t nil)))) (defun circe-lurker-rejoin-p (nick channel) "Return true if NICK is rejoining CHANNEL. A user is considered to be rejoining if they were on the channel shortly before, and were active then." (let* ((channel (irc-connection-channel (circe-server-process) channel)) (user (when channel (irc-channel-recent-user channel nick)))) (when user (irc-user-last-activity-time user)))) (defun circe-lurker-display-active (nick userhost) "Show that this user is active if they are a lurker." (let* ((channel (irc-connection-channel (circe-server-process) circe-chat-target)) (user (when channel (irc-channel-user channel nick))) (join-time (when user (irc-user-join-time user)))) (when (and (circe-lurker-p nick) ;; If we saw them when we joined the channel, no need to ;; say "they're suddenly active!!111one". join-time) (circe-display 'circe-format-server-lurker-activity :nick nick :userhost (or userhost "server") :jointime join-time :joindelta (circe-duration-string (- (float-time) join-time)))))) ;;;;;;;;;;;;;;;;;; ;;; Query Mode ;;; ;;;;;;;;;;;;;;;;;; (defvar circe-query-mode-hook nil "Hook run when query mode is activated.") (defvar circe-query-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map circe-chat-mode-map) map) "The key map for query mode buffers.") (define-derived-mode circe-query-mode circe-chat-mode "Circe Query" "The circe query chat major mode. This mode represents a query you are talking in. TARGET is the default target to send data to. SERVER-BUFFER is the server buffer of this chat buffer. \\{circe-query-mode-map}" (add-hook 'kill-buffer-hook 'circe-query-killed nil t)) (defun circe-query-killed () "Called when the query buffer got killed." (ignore-errors (circe-server-remove-chat-buffer circe-chat-target))) (defun circe-query-auto-query-buffer (who) "Return a buffer for a query with `WHO'. This adheres to `circe-auto-query-max'." (or (circe-server-get-chat-buffer who) (when (< (circe--query-count) circe-auto-query-max) (circe-server-get-or-create-chat-buffer who 'circe-query-mode)))) (defun circe--query-count () "Return the number of queries on the current server." (let ((num 0)) (dolist (buf (circe-server-chat-buffers)) (with-current-buffer buf (when (eq major-mode 'circe-query-mode) (setq num (+ num 1))))) num)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; IRC Protocol Handling ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar circe--irc-handler-table nil "The handler table for Circe's IRC connections. Do not use this directly. Instead, call `circe-irc-handler-table'.") (defun circe-irc-handler-table () (when (not circe--irc-handler-table) (let ((table (irc-handler-table))) (irc-handler-add table "irc.registered" #'circe--irc-conn-registered) (irc-handler-add table "conn.disconnected" #'circe--irc-conn-disconnected) (irc-handler-add table nil #'circe--irc-display-event) (irc-handle-registration table) (irc-handle-ping-pong table) (irc-handle-isupport table) (irc-handle-initial-nick-acquisition table) (irc-handle-ctcp table) (irc-handle-state-tracking table) (irc-handle-nickserv table) (irc-handle-auto-join table) (setq circe--irc-handler-table table))) circe--irc-handler-table) (defun circe--irc-conn-registered (conn _event _nick) (with-current-buffer (irc-connection-get conn :server-buffer) (setq circe-server-reconnect-attempts 0) (run-hooks 'circe-server-connected-hook))) (defun circe--irc-conn-disconnected (conn _event) (with-current-buffer (irc-connection-get conn :server-buffer) (dolist (buf (circe-server-chat-buffers)) (with-current-buffer buf (circe-chat-disconnected))) (circe-reconnect))) (defun circe--irc-display-event (conn event &optional sender &rest args) "Display an IRC message. NICK, USER and HOST specify the originator of COMMAND with ARGS as arguments." (with-current-buffer (irc-connection-get conn :server-buffer) (let* ((display (circe-get-display-handler event)) (nick (when sender (irc-userstring-nick sender))) (userhost (when sender (irc-userstring-userhost sender)))) (cond ;; Functions get called ((functionp display) (apply display nick userhost event args)) ;; Lists describe patterns ((consp display) (circe--irc-display-format (elt display 1) (elt display 0) nick userhost event args)) ;; No configured display handler, show a default (t (circe--irc-display-default nick userhost event args)))))) (defvar circe--irc-format-server-numeric "*** %s" "The format to use for server messages. Do not set this.") (defun circe--irc-display-format (format target nick userhost event args) (let* ((target+name (circe--irc-display-target target nick args)) (target (car target+name)) (name (cdr target+name)) (origin (if userhost (format "%s (%s)" nick userhost) (format "%s" nick)))) (with-current-buffer (or target (circe-server-last-active-buffer)) (let ((circe--irc-format-server-numeric (if target (format "*** %s" format) (format "*** [%s] %s" name format)))) (circe-display 'circe--irc-format-server-numeric :nick (or nick "(unknown)") :userhost (or userhost "server") :origin origin :event event :command event :target name :indexed-args args))))) (defun circe--irc-display-target (target nick args) "Return the target buffer and name. The buffer might be nil if it is not alive. See `circe-set-display-handler' for a description of target. NICK and USERHOST are the originator of COMMAND which had ARGS as arguments." (cond ((eq target 'nick) (cons (circe-server-get-chat-buffer nick) nick)) ((numberp target) (let ((name (nth target args))) (cons (circe-server-get-chat-buffer name) name))) ((eq target 'active) (let ((buf (circe-server-last-active-buffer))) (cons buf (buffer-name buf)))) ((eq target 'server) (cons (current-buffer) (buffer-name))) (t (error "Bad target in format string: %s" target)))) (defun circe--irc-display-default (nick userhost event args) (with-current-buffer (circe-server-last-active-buffer) (let ((target (if (circe-server-my-nick-p (car args)) "" (format " to %s" (car args))))) (cond ((string-match "\\`irc.ctcpreply.\\(.*\\)\\'" event) (circe-display-server-message (format "CTCP %s reply from %s (%s)%s: %s" (match-string 1 event) nick userhost target (cadr args)))) ((string-match "\\`irc.ctcp.\\(.*\\)\\'" event) (circe-display-server-message (format "Unknown CTCP request %s from %s (%s)%s: %s" (match-string 1 event) nick userhost target (cadr args)))) (t (circe-display-server-message (format "[%s from %s%s] %s" event nick (if userhost (format " (%s)" userhost) "") (mapconcat #'identity args " ")))))))) (defun circe-set-display-handler (command handler) "Set the display handler for COMMAND to HANDLER. A handler is either a function or a list. A function gets called in the server buffer with at least three arguments, but possibly more. There's at least NICK and USERHOST of the sender, which can be nil, and COMMAND, which is the event which triggered this. Further arguments are arguments to the event. Alternatively, the handler can be a list of two elements: target - The target of this message format - The format for this string The target can be any of: 'active - The last active buffer of this server 'nick - The nick who sent this message 'server - The server buffer for this server number - The index of the argument of the target The format is passed to `lui-format'. Possible format string substitutions are {mynick}, {target}, {nick}, {userhost}, {origin}, {command}, {target}, and indexed arguments for the arguments to the IRC message." (when (not circe-display-table) (setq circe-display-table (make-hash-table :test 'equal))) (puthash command handler circe-display-table)) (defun circe-get-display-handler (command) "Return the display handler for COMMAND. See `circe-set-display-handler' for more information." (when circe-display-table (gethash command circe-display-table))) ;;;;;;;;;;;;;;;; ;;; Commands ;;; ;;;;;;;;;;;;;;;; (defun circe-command-AWAY (reason) "Set yourself away with REASON." (interactive "sReason: ") (irc-send-AWAY (circe-server-process) reason)) (defun circe-command-BACK (&optional ignored) "Mark yourself not away anymore. Arguments are IGNORED." (interactive) (irc-send-AWAY (circe-server-process))) (defun circe-command-CHTOPIC (&optional ignored) "Insert the topic of the current channel. Arguments are IGNORED." (interactive) (if (not circe-chat-target) (circe-display-server-message "No target for current buffer") (let* ((channel (irc-connection-channel (circe-server-process) circe-chat-target)) (topic (when channel (irc-channel-topic channel)))) (lui-replace-input (format "/TOPIC %s %s" circe-chat-target (or topic "")))) (goto-char (point-max)))) (defun circe-command-CLEAR (&optional ignored) "Delete all buffer contents before the lui prompt." (let ((inhibit-read-only t)) (delete-region (point-min) lui-output-marker))) (defun circe-command-CTCP (who &optional command argument) "Send a CTCP message to WHO containing COMMAND with ARGUMENT. If COMMAND is not given, WHO is parsed to contain all of who, command and argument. If ARGUMENT is nil, it is interpreted as no argument." (when (not command) (if (string-match "^\\([^ ]*\\) *\\([^ ]*\\) *\\(.*\\)" who) (setq command (upcase (match-string 2 who)) argument (match-string 3 who) who (match-string 1 who)) (circe-display-server-message "Usage: /CTCP "))) (when (not (string= "" command)) (irc-send-ctcp (circe-server-process) who command (if (and argument (not (equal argument ""))) argument nil)))) (defun circe-command-FOOL (line) "Add the regex on LINE to the `circe-fool-list'." (with-current-buffer (circe-server-last-active-buffer) (cond ((string-match "\\S-+" line) (let ((regex (match-string 0 line))) (add-to-list 'circe-fool-list regex) (circe-display-server-message (format "Recognizing %s as a fool" regex)))) ((not circe-fool-list) (circe-display-server-message "Your do not know any fools")) (t (circe-display-server-message "Your list of fools:") (dolist (regex circe-fool-list) (circe-display-server-message (format "- %s" regex))))))) (defun circe-command-GAWAY (reason) "Set yourself away on all servers with reason REASON." (interactive "sReason: ") (dolist (buf (circe-server-buffers)) (with-current-buffer buf (irc-send-AWAY circe-server-process reason)))) (defun circe-command-GQUIT (reason) "Quit all servers with reason REASON." (interactive "sReason: ") (dolist (buf (circe-server-buffers)) (with-current-buffer buf (when (eq (process-status circe-server-process) 'open) (irc-send-QUIT circe-server-process reason))))) (defun circe-command-HELP (&optional ignored) "Display a list of recognized commands, nicely formatted." (circe-display-server-message (concat "Recognized commands are: " (mapconcat (lambda (s) s) (circe--commands-list) "")))) (defun circe-command-IGNORE (line) "Add the regex on LINE to the `circe-ignore-list'." (with-current-buffer (circe-server-last-active-buffer) (cond ((string-match "\\S-+" line) (let ((regex (match-string 0 line))) (add-to-list 'circe-ignore-list regex) (circe-display-server-message (format "Ignore list, meet %s" regex)))) ((not circe-ignore-list) (circe-display-server-message "Your ignore list is empty")) (t (circe-display-server-message "Your ignore list:") (dolist (regex circe-ignore-list) (circe-display-server-message (format "- %s" regex))))))) (defun circe-command-INVITE (nick &optional channel) "Invite NICK to CHANNEL. When CHANNEL is not given, NICK is assumed to be a string consisting of two words, the nick and the channel." (interactive "sInvite who: \nsWhere: ") (when (not channel) (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)" nick) (setq channel (match-string 2 nick) nick (match-string 1 nick)) (when (or (string= "" nick) (null nick)) (circe-display-server-message "Usage: /INVITE ")))) (irc-send-INVITE (circe-server-process) nick (if (and (null channel) (not (null nick))) circe-chat-target channel))) (defun circe-command-JOIN (channel) "Join CHANNEL. This can also contain a key." (interactive "sChannel: ") (let (channels keys) (when (string-match "^\\s-*\\([^ ]+\\)\\(:? \\([^ ]+\\)\\)?$" channel) (setq channels (match-string 1 channel) keys (match-string 3 channel)) (dolist (channel (split-string channels ",")) (pop-to-buffer (circe-server-get-or-create-chat-buffer channel 'circe-channel-mode))) (irc-send-JOIN (circe-server-process) channels keys)))) (defun circe-command-ME (line) "Send LINE to IRC as an action." (interactive "sAction: ") (if (not circe-chat-target) (circe-display-server-message "No target for current buffer") (circe-display 'circe-format-self-action :body line :nick (circe-nick)) (irc-send-ctcp (circe-server-process) circe-chat-target "ACTION" line))) (defun circe-command-MSG (who &optional what) "Send a message. Send WHO a message containing WHAT. If WHAT is not given, WHO should contain both the nick and the message separated by a space." (when (not what) (if (string-match "^\\([^ ]*\\) \\(.*\\)" who) (setq what (match-string 2 who) who (match-string 1 who)) (circe-display-server-message "Usage: /MSG "))) (when what (let ((buf (circe-query-auto-query-buffer who))) (if buf (with-current-buffer buf (circe-command-SAY what) (lui-add-input what)) (with-current-buffer (circe-server-last-active-buffer) (irc-send-PRIVMSG (circe-server-process) who what) (circe-display 'circe-format-self-message :target who :body what)))))) (defun circe-command-NAMES (&optional channel) "List the names of the current channel or CHANNEL." (interactive) (let ((target (when channel (string-trim channel)))) (when (or (not target) (equal target "")) (setq target circe-chat-target)) (if (not target) (circe-display-server-message "No target for current buffer") (irc-send-NAMES (circe-server-process) target)))) (defun circe-command-NICK (newnick) "Change nick to NEWNICK." (interactive "sNew nick: ") (let ((newnick (string-trim newnick))) (irc-send-NICK (circe-server-process) newnick))) (defun circe-command-PART (reason) "Part the current channel because of REASON." (interactive "sReason: ") (if (not circe-chat-target) (circe-display-server-message "No target for current buffer") (irc-send-PART (circe-server-process) circe-chat-target (if (equal "" reason) circe-default-part-message reason)))) (defun circe-command-PING (target) "Send a CTCP PING request to TARGET." (interactive "sWho: ") (let ((target (string-trim target))) (irc-send-ctcp (circe-server-process) target "PING" (format "%s" (float-time))))) (defun circe-command-QUERY (arg) "Open a query with WHO." ;; Eventually, this should probably be just the same as ;; circe-command-MSG (interactive "sQuery with: ") (let* (who what) (if (string-match "\\`\\s-*\\(\\S-+\\)\\s-\\(\\s-*\\S-.*\\)\\'" arg) (setq who (match-string 1 arg) what (match-string 2 arg)) (setq who (string-trim arg))) (when (string= who "") (circe-display-server-message "Usage: /query [something to say]")) (pop-to-buffer (circe-server-get-or-create-chat-buffer who 'circe-query-mode)) (when what (circe-command-SAY what) (lui-add-input what)))) (defun circe-command-QUIT (reason) "Quit the current server giving REASON." (interactive "sReason: ") (with-circe-server-buffer (setq circe-server-inhibit-auto-reconnect-p t) (irc-send-QUIT (circe-server-process) (if (equal "" reason) circe-default-quit-message reason)))) (defun circe-command-QUOTE (line) "Send LINE verbatim to the server." (interactive "Line: ") (irc-send-raw (circe-server-process) line) (with-current-buffer (circe-server-last-active-buffer) (circe-display-server-message (format "Sent to server: %s" line)))) (defun circe-command-SAY (line) "Say LINE to the current target." (interactive "sSay: ") (if (not circe-chat-target) (circe-display-server-message "No target for current buffer") (dolist (line (circe--split-line line)) (circe-display 'circe-format-self-say :body line :nick (circe-nick)) (irc-send-PRIVMSG (circe-server-process) circe-chat-target ;; Some IRC servers give an error if there is ;; no text at all. (if (string= line "") " " line))))) (defun circe--split-line (longline) "Splits LONGLINE into smaller components. IRC silently truncates long lines. This splits a long line into parts that each are not longer than `circe-split-line-length'." (if (< (length longline) circe-split-line-length) (list longline) (with-temp-buffer (insert longline) (let ((fill-column circe-split-line-length)) (fill-region (point-min) (point-max) nil t)) (split-string (buffer-string) "\n")))) (defun circe-command-SV (&optional ignored) "Tell the current channel about your client and Emacs version. Arguments are IGNORED." (interactive) (circe-command-SAY (format (concat "I'm using Circe version %s " "with %s %s (of %s)") (circe--version) "GNU Emacs" emacs-version (format-time-string "%Y-%m-%d" emacs-build-time)))) (defun circe-command-TOPIC (channel &optional newtopic) "Change the topic of CHANNEL to NEWTOPIC." (interactive "sChannel: \nsNew topic: ") (when (string-match "^\\s-*$" channel) (setq channel nil)) (when (and channel (not newtopic) (string-match "^\\s-*\\(\\S-+\\)\\( \\(.*\\)\\)?" channel)) (setq newtopic (match-string 3 channel) channel (match-string 1 channel))) (cond ((and channel newtopic) (irc-send-TOPIC (circe-server-process) channel newtopic)) (channel (irc-send-TOPIC (circe-server-process) channel)) (circe-chat-target (irc-send-TOPIC (circe-server-process) circe-chat-target)) (t (circe-display-server-message "No channel given, and no default target.")))) (defun circe-command-UNFOOL (line) "Remove the entry LINE from `circe-fool-list'." (with-current-buffer (circe-server-last-active-buffer) (cond ((string-match "\\S-+" line) (let ((regex (match-string 0 line))) (setq circe-fool-list (delete regex circe-fool-list)) (circe-display-server-message (format "Assuming %s is not a fool anymore" regex)))) (t (circe-display-server-message "No one is not a fool anymore? UNFOOL requires one argument"))))) (defun circe-command-UNIGNORE (line) "Remove the entry LINE from `circe-ignore-list'." (with-current-buffer (circe-server-last-active-buffer) (cond ((string-match "\\S-+" line) (let ((regex (match-string 0 line))) (setq circe-ignore-list (delete regex circe-ignore-list)) (circe-display-server-message (format "Ignore list forgot about %s" regex)))) (t (circe-display-server-message "Who do you want to unignore? UNIGNORE requires one argument"))))) (defun circe-command-WHOAMI (&optional ignored) "Request WHOIS information about yourself. Arguments are IGNORED." (interactive) (irc-send-WHOIS (circe-server-process) (circe-nick))) (defun circe-command-WHOIS (whom) "Request WHOIS information about WHOM." (interactive "sWhois: ") (let* ((whom-server-name (split-string whom)) (whom (car whom-server-name)) (server-or-name (cadr whom-server-name))) (irc-send-WHOIS (circe-server-process) whom server-or-name))) (defun circe-command-WHOWAS (whom) "Request WHOWAS information about WHOM." (interactive "sWhois: ") (let ((whom (string-trim whom))) (irc-send-WHOWAS (circe-server-process) whom))) (defun circe-command-WL (&optional split) "Show the people who left in a netsplit. Without any arguments, shows shows the current netsplits and how many people are missing. With an argument SPLIT, which must be a number, it shows the missing people due to that split." (let ((circe-netsplit-list (with-circe-server-buffer circe-netsplit-list))) (if (or (not split) (and (stringp split) (string= split ""))) (if (null circe-netsplit-list) (circe-display-server-message "No net split at the moment") (let ((n 0)) (dolist (entry circe-netsplit-list) (circe-display-server-message (format "(%d) Missing %d people due to %s" n (hash-table-count (nth 3 entry)) (car entry))) (setq n (+ n 1))))) (let* ((index (if (numberp split) split (string-to-number split))) (entry (nth index circe-netsplit-list))) (if (not entry) (circe-display-server-message (format "No split number %s - use /WL to see a list" split)) (let ((missing nil)) (maphash (lambda (_key value) (setq missing (cons value missing))) (nth 3 entry)) (circe-display-server-message (format "Missing people due to %s: %s" (car entry) (mapconcat 'identity (sort missing (lambda (a b) (string< (downcase a) (downcase b)))) ", "))))))))) ;;;;;;;;;;;;;;;;;;;;;;;; ;;; Display Handlers ;;; ;;;;;;;;;;;;;;;;;;;;;;;; (defun circe-display-ignore (_nick _userhost _command &rest _args) "Don't show a this message. NICK and USERHOST are the originator of COMMAND which had ARGS as arguments." 'noop) (circe-set-display-handler "317" 'circe-display-317) (defun circe-display-317 (_sender ignored _numeric _target nick idletime &optional signon-time body) "Show a 317 numeric (RPL_WHOISIDLE). Arguments are either of the two: : 317 :seconds idle : 317 :seconds idle, signon time" (with-current-buffer (circe-server-last-active-buffer) (let ((seconds-idle (string-to-number idletime)) (signon-time (when body (string-to-number signon-time)))) (if signon-time (circe-display 'circe-format-server-whois-idle-with-signon :whois-nick nick :idle-seconds seconds-idle :idle-duration (circe-duration-string seconds-idle) :signon-time signon-time :signon-date (current-time-string (seconds-to-time signon-time)) :signon-ago (circe-duration-string (- (float-time) signon-time))) (circe-display 'circe-format-server-whois-idle :whois-nick nick :idle-seconds seconds-idle :idle-duration (circe-duration-string seconds-idle)))))) (circe-set-display-handler "329" 'circe-display-329) (defun circe-display-329 (_server ignored _numeric _target channel timestamp) "Show a 329 numeric (RPL_CREATIONTIME)." (with-current-buffer (or (circe-server-get-chat-buffer channel) (circe-server-last-active-buffer)) (let ((creation-time (string-to-number timestamp))) (circe-display 'circe-format-server-channel-creation-time :channel channel :date (current-time-string (seconds-to-time creation-time)) :ago (circe-duration-string (- (float-time) creation-time)))))) (circe-set-display-handler "333" 'circe-display-333) (defun circe-display-333 (_server ignored _numeric target channel setter topic-time) "Show a 333 numeric (RPL_TOPICWHOTIME). Arguments are either of the two: : 333 1434996762 : 333 !@ 1434996803" (let ((channel-buffer (circe-server-get-chat-buffer channel)) (topic-time (string-to-number topic-time))) (with-current-buffer (or channel-buffer (circe-server-last-active-buffer)) (circe-display (if channel-buffer 'circe-format-server-topic-time 'circe-format-server-topic-time-for-channel) :nick target :channel channel :setter (irc-userstring-nick setter) :setter-userhost (or (irc-userstring-userhost setter) "(unknown)") :topic-time topic-time :topic-date (current-time-string (seconds-to-time topic-time)) :topic-ago (circe-duration-string (- (float-time) topic-time)))))) (circe-set-display-handler "AUTHENTICATE" 'circe-display-ignore) (circe-set-display-handler "CAP" 'circe-display-ignore) (circe-set-display-handler "conn.connected" 'circe-display-ignore) (circe-set-display-handler "conn.disconnected" 'circe-display-ignore) (circe-set-display-handler "irc.ctcp" 'circe-display-ignore) (circe-set-display-handler "irc.ctcpreply" 'circe-display-ignore) (circe-set-display-handler "irc.ctcp.ACTION" 'circe-display-ctcp-action) (defun circe-display-ctcp-action (nick userhost _command target text) "Show an ACTION." (cond ;; Query ((circe-server-my-nick-p target) (let ((query-buffer (circe-query-auto-query-buffer nick))) (with-current-buffer (or query-buffer (circe-server-last-active-buffer)) (circe-display (if query-buffer 'circe-format-action 'circe-format-message-action) :nick nick :userhost (or userhost "server") :body text)))) ;; Channel (t (with-current-buffer (circe-server-get-or-create-chat-buffer target 'circe-channel-mode) (circe-lurker-display-active nick userhost) (circe-display 'circe-format-action :nick nick :userhost (or userhost "server") :body text))))) (circe-set-display-handler "irc.ctcp.CLIENTINFO" 'circe-display-ctcp) (circe-set-display-handler "irc.ctcp.PING" 'circe-display-ctcp-ping) (defun circe-display-ctcp-ping (nick userhost _command target text) "Show a CTCP PING request." (with-current-buffer (circe-server-last-active-buffer) (circe-display 'circe-format-server-ctcp-ping :nick nick :userhost (or userhost "server") :target target :body (or text "") :ago (let ((time (when text (string-to-number text)))) (if time (format "%.2f seconds" (- (float-time) time)) "unknown seconds"))))) (circe-set-display-handler "irc.ctcpreply.PING" 'circe-display-ctcp-ping-reply) (defun circe-display-ctcp-ping-reply (nick userhost _command target text) "Show a CTCP PING reply." (with-current-buffer (circe-server-last-active-buffer) (circe-display 'circe-format-server-ctcp-ping-reply :nick nick :userhost (or userhost "server") :target target :body text :ago (let ((time (string-to-number text))) (if time (format "%.2f seconds" (- (float-time) time)) "unknown seconds"))))) (circe-set-display-handler "irc.ctcp.SOURCE" 'circe-display-ctcp) (circe-set-display-handler "irc.ctcp.TIME" 'circe-display-ctcp) (circe-set-display-handler "irc.ctcp.VERSION" 'circe-display-ctcp) (defun circe-display-ctcp (nick userhost command target text) "Show a CTCP request that does not require special handling." (with-current-buffer (circe-server-last-active-buffer) (circe-display 'circe-format-server-ctcp :nick nick :userhost (or userhost "server") :target target :command (substring command 9) :body (or text "")))) (circe-set-display-handler "irc.registered" 'circe-display-ignore) (circe-set-display-handler "JOIN" 'circe-display-JOIN) (defun circe-display-JOIN (nick userhost _command channel &optional accountname realname) "Show a JOIN message. The command receives an extra argument, the account name, on some IRC servers." (let* ((accountname (if (equal accountname "*") "(unauthenticated)" accountname)) (userinfo (if accountname (format "%s, %s: %s" userhost accountname realname) userhost)) (split (circe--netsplit-join nick))) ;; First, update the channel (with-current-buffer (circe-server-get-or-create-chat-buffer channel 'circe-channel-mode) (cond (split (let ((split-time (cadr split))) (when (< (+ split-time circe-netsplit-delay) (float-time)) (circe-display 'circe-format-server-netmerge :split (car split) :time (cadr split) :date (current-time-string (seconds-to-time (cadr split))) :ago (circe-duration-string (- (float-time) (cadr split))))))) ((and (circe-reduce-lurker-spam) (circe-lurker-rejoin-p nick circe-chat-target)) (let* ((channel (irc-connection-channel (circe-server-process) circe-chat-target)) (user (when channel (irc-channel-recent-user channel nick))) (departed (when user (irc-user-part-time user)))) (circe-display 'circe-format-server-rejoin :nick nick :userhost (or userhost "server") :accountname accountname :realname realname :userinfo userinfo :departuretime departed :departuredelta (circe-duration-string (- (float-time) departed))))) ((not (circe-reduce-lurker-spam)) (circe-display 'circe-format-server-join :nick nick :userhost (or userhost "server") :accountname accountname :realname realname :userinfo userinfo :channel circe-chat-target)))) ;; Next, a possible query buffer. We do this even when the message ;; should be ignored by a netsplit, since this can't flood. (let ((buf (circe-server-get-chat-buffer nick))) (when buf (with-current-buffer buf (circe-display 'circe-format-server-join-in-channel :nick nick :userhost (or userhost "server") :accountname accountname :realname realname :userinfo userinfo :channel circe-chat-target)))))) (circe-set-display-handler "MODE" 'circe-display-MODE) (defun circe-display-MODE (setter userhost _command target &rest modes) "Show a MODE message." (with-current-buffer (or (circe-server-get-chat-buffer target) (circe-server-last-active-buffer)) (circe-display 'circe-format-server-mode-change :setter setter :userhost (or userhost "server") :target target :change (mapconcat #'identity modes " ")))) (circe-set-display-handler "NICK" 'circe-display-NICK) (defun circe-display-NICK (old-nick userhost _command new-nick) "Show a nick change." (if (circe-server-my-nick-p new-nick) (dolist (buf (cons (or circe-server-buffer (current-buffer)) (circe-server-chat-buffers))) (with-current-buffer buf (circe-display 'circe-format-server-nick-change-self :old-nick old-nick :userhost (or userhost "server") :new-nick new-nick))) (let ((query-buffer (circe-server-get-chat-buffer old-nick))) (when query-buffer (with-current-buffer query-buffer (circe-server-rename-chat-buffer old-nick new-nick) (circe-display 'circe-format-server-nick-change :old-nick old-nick :new-nick new-nick :userhost (or userhost "server"))))) (dolist (buf (circe-user-channels new-nick)) (with-current-buffer buf (cond ((and (circe-reduce-lurker-spam) (circe-lurker-p new-nick)) nil) ((circe-channel-user-nick-regain-p old-nick new-nick) (circe-display 'circe-format-server-nick-regain :old-nick old-nick :new-nick new-nick :userhost (or userhost "server"))) (t (circe-display 'circe-format-server-nick-change :old-nick old-nick :new-nick new-nick :userhost (or userhost "server")))))))) (circe-set-display-handler "nickserv.identified" 'circe-display-ignore) ;; NOTICE is also used to encode CTCP replies. irc.el will send ;; irc.notice events for NOTICEs without CTCP replies, so we show ;; that, not the raw notice. (circe-set-display-handler "NOTICE" 'circe-display-ignore) (circe-set-display-handler "irc.notice" 'circe-display-NOTICE) (defun circe-display-NOTICE (nick userhost _command target text) "Show a NOTICE message." (cond ((not userhost) (with-current-buffer (circe-server-last-active-buffer) (circe-display 'circe-format-server-notice :server nick :body text))) ((circe-server-my-nick-p target) (with-current-buffer (or (circe-server-get-chat-buffer nick) (circe-server-last-active-buffer)) (circe-display 'circe-format-notice :nick nick :userhost (or userhost "server") :body text))) (t (with-current-buffer (or (circe-server-get-chat-buffer target) (circe-server-last-active-buffer)) (circe-display 'circe-format-notice :nick nick :userhost (or userhost "server") :body text))))) (circe-set-display-handler "PART" 'circe-display-PART) (defun circe-display-PART (nick userhost _command channel &optional reason) "Show a PART message." (with-current-buffer (or (circe-server-get-chat-buffer channel) (circe-server-last-active-buffer)) (when (or (not circe-chat-target) (not (circe-lurker-p nick))) (circe-display 'circe-format-server-part :nick nick :userhost (or userhost "server") :channel channel :reason (or reason "[No reason given]"))))) (circe-set-display-handler "PING" 'circe-display-ignore) (circe-set-display-handler "PONG" 'circe-display-ignore) ;; PRIVMSG is also used to encode CTCP requests. irc.el will send ;; irc.message events for PRIVMSGs without CTCP messages, so we show ;; that, not the raw message. (circe-set-display-handler "PRIVMSG" 'circe-display-ignore) (circe-set-display-handler "irc.message" 'circe-display-PRIVMSG) (defun circe-display-PRIVMSG (nick userhost _command target text) "Show a PRIVMSG message." (cond ((circe-server-my-nick-p target) (let ((buf (circe-query-auto-query-buffer nick))) (if buf (with-current-buffer buf (circe-display 'circe-format-say :nick nick :userhost (or userhost "server") :body text)) (with-current-buffer (circe-server-last-active-buffer) (circe-display 'circe-format-message :nick nick :userhost (or userhost "server") :body text))))) (t (with-current-buffer (circe-server-get-or-create-chat-buffer target 'circe-channel-mode) (circe-lurker-display-active nick userhost) (circe-display 'circe-format-say :nick nick :userhost (or userhost "server") :body text))))) (circe-set-display-handler "TOPIC" 'circe-display-topic) (defun circe-display-topic (nick userhost _command channel new-topic) "Show a TOPIC change." (with-current-buffer (circe-server-get-or-create-chat-buffer channel 'circe-channel-mode) (let* ((channel-obj (irc-connection-channel (circe-server-process) channel)) (old-topic (or (when channel (irc-channel-last-topic channel-obj)) ""))) (circe-display 'circe-format-server-topic :nick nick :userhost (or userhost "server") :channel channel :new-topic new-topic :old-topic old-topic :topic-diff (circe--topic-diff old-topic new-topic))))) (defun circe--topic-diff (old new) "Return a colored topic diff between OLD and NEW." (mapconcat (lambda (elt) (cond ((eq '+ (car elt)) (let ((s (cadr elt))) (add-face-text-property 0 (length s) 'circe-topic-diff-new-face nil s) s)) ((eq '- (car elt)) (let ((s (cadr elt))) (add-face-text-property 0 (length s) 'circe-topic-diff-removed-face nil s) s)) (t (cadr elt)))) (lcs-unified-diff (circe--topic-diff-split old) (circe--topic-diff-split new) 'string=) "")) (defun circe--topic-diff-split (str) "Split STR into a list of components. The list consists of words and spaces." (let ((lis nil)) (with-temp-buffer (insert str) (goto-char (point-min)) (while (< (point) (point-max)) (if (or (looking-at "\\w+\\W*") (looking-at ".\\s-*")) (progn (setq lis (cons (match-string 0) lis)) (replace-match "")) (error "Can't happen")))) (nreverse lis))) (circe-set-display-handler "channel.quit" 'circe-display-channel-quit) (defun circe-display-channel-quit (nick userhost _command channel &optional reason) "Show a QUIT message." (let ((split (circe--netsplit-quit reason nick))) (with-current-buffer (circe-server-get-or-create-chat-buffer channel 'circe-channel-mode) (cond (split (when (< (+ split circe-netsplit-delay) (float-time)) (circe-display 'circe-format-server-netsplit :split reason))) ((not (circe-lurker-p nick)) (circe-display 'circe-format-server-quit-channel :nick nick :userhost (or userhost "server") :channel channel :reason (or reason "[no reason given]"))))))) (circe-set-display-handler "QUIT" 'circe-display-QUIT) (defun circe-display-QUIT (nick userhost _command &optional reason) "Show a QUIT message. Channel quits are shown already, so just show quits in queries." (let ((buf (circe-server-get-chat-buffer nick))) (when buf (with-current-buffer buf (circe-display 'circe-format-server-quit :nick nick :userhost (or userhost "server") :reason (or reason "[no reason given]")))))) (defvar circe-netsplit-list nil "A list of recorded netsplits. Every item is a list with four elements: - The quit message for this split. - The time when last we heard about a join in this split - The time when last we heard about a quit in this split - A hash table noting which nicks did leave") (make-variable-buffer-local 'circe-netsplit-list) (defun circe--netsplit-join (nick) "Search for NICK in the netsplit lists. This either returns a pair whose car is the quit message of this split, and the cadr the time we last heard anything of the split of that user. If the NICK isn't split, this returns nil." (with-circe-server-buffer (catch 'return (dolist (entry circe-netsplit-list) (let ((table (nth 3 entry))) (when (gethash nick table) (let ((name (nth 0 entry)) (time (nth 1 entry))) (remhash nick table) (when (= 0 (hash-table-count table)) (setq circe-netsplit-list (delq entry circe-netsplit-list))) (setcar (cdr entry) (float-time)) (throw 'return (list name time)))))) nil))) (defun circe--netsplit-quit (reason nick) "If REASON indicates a netsplit, mark NICK as splitted. This either returns the time when last we heard about this split, or nil when this isn't a split." (when (circe--netsplit-reason-p reason) (with-circe-server-buffer (let ((entry (assoc reason circe-netsplit-list))) (if entry (let ((time (nth 2 entry)) (table (nth 3 entry))) (setcar (cddr entry) (float-time)) (puthash nick nick table) time) ;; New split! (let ((table (make-hash-table :test 'equal))) (puthash nick nick table) (setq circe-netsplit-list (cons (list reason 0 (float-time) table) circe-netsplit-list)) 0)))))) (defun circe--netsplit-reason-p (reason) "Return non-nil if REASON is the quit message of a netsplit. This is true when it contains exactly two hosts, with a single space in between them. The hosts must include at least one dot, and must not include colons or slashes (else they might be URLs). (Thanks to irssi for this criteria list)" (if (string-match "^[^ :/]+\\.[^ :/]* [^ :/]+\\.[^ :/]*$" reason) t nil)) (let ((simple-format-specifiers '(("INVITE" active "Invite: {origin} invites you to {1}") ("KICK" 0 "Kick: {1} kicked by {origin}: {2}") ("ERROR" active "Error: {0-}") ("001" server "{1}") ("002" server "{1}") ("003" server "{1}") ("004" server "{1-}") ("005" server "{1-}") ;; IRCnet: * Please wait while we process your connection. ("020" server "{0-}") ;; IRCnet ("042" server "Your unique ID is {1}") ("200" active "{1-}") ("201" active "{1-}") ("203" active "{1-}") ("204" active "{1-}") ("205" active "{1-}") ("206" active "{1-}") ("207" active "{1-}") ("208" active "{1-}") ("209" active "{1-}") ("211" active "{1-}") ("212" active "{1-}") ("219" active "{1-}") ("221" active "User mode: {1-}") ("234" active "Service: {1-}") ("235" active "{1-}") ("242" active "{1}") ("243" active "{1-}") ("250" server "{1}") ("251" server "{1}") ("252" server "{1-}") ("253" server "{1-}") ("254" server "{1-}") ("255" server "{1}") ("256" active "{1-}") ("257" active "{1}") ("258" active "{1}") ("259" active "{1}") ("261" active "{1-}") ("262" active "{1-}") ("263" active "{1-}") ("265" server "{1-}") ("266" server "{1-}") ;; This is returned on both WHOIS and PRIVMSG. It ;; should go to the active window for the former, and ;; the query window for the latter. Oh well. ("301" active "User away: {1}") ("302" active "User hosts: {1}") ("303" active "Users online: {1}") ("305" active "{1}") ("306" active "{1}") ("307" active "{1-}") ;; Coldfront: 310 is available for help. ("310" active "{1-}") ("311" active "{1} is {2}@{3} ({5})") ("312" active "{1} is on {2} ({3})") ("313" active "{1} {2}") ("314" active "{1} was {2}@{3} ({5})") ("315" active "{2}") ("318" active "{2}") ("319" active "{1} is on {2}") ("320" active "{1-}") ("322" active "{1-}") ("323" active "{1-}") ("324" 1 "Channel mode for {1}: {2-}") ("325" 1 "Unique operator on {1} is {2}") ("328" 1 "Channel homepage for {1}: {2-}") ("330" active "{1} is logged in as {2}") ("331" 1 "No topic for {1} set") ("332" 1 "Topic for {1}: {2}") ("341" active "Inviting {1} to {2}") ("346" 1 "Invite mask: {2}") ("347" 1 "{2}") ("348" 1 "Except mask: {2}") ("349" 1 "{2}") ("351" active "{1-}") ("352" active "{5} ({2}@{3}) in {1} on {4}: {6-}") ("353" 2 "Names: {3}") ("364" active "{1-}") ("365" active "{1-}") ("366" 1 "{2}") ("367" 1 "Ban mask: {2}") ("368" 1 "{2}") ("369" active "{1} {2}") ("371" active "{1}") ("372" server "{1}") ("374" active "{1}") ("375" server "{1}") ("376" server "{1}") ("378" active "{1-}") ("381" active "{1}") ("382" active "{1-}") ("391" active "Time on {1}: {2}") ("401" active "No such nick: {1}") ("402" active "No such server: {1}") ("403" active "No such channel: {1}") ("404" 1 "Can not send to channel {1}") ("405" active "Can not join {1}: {2}") ("406" active "{1-}") ("407" active "{1-}") ("408" active "No such service: {1}") ("422" active "{1}") ("432" active "Erroneous nick name: {1}") ("433" active "Nick name in use: {1}") ("437" active "Nick/channel is temporarily unavailable: {1}") ("441" 2 "User not on channel: {1}") ("442" active "You are not on {1}") ("443" 2 "User {1} is already on channel {2}") ;; Coldfront: 451 * :You have not registered ("451" active "{1-}") ("467" 1 "{2}") ("470" 1 "{1} made you join {2}: {3-}") ("471" 1 "{2}") ("472" active "{1-}") ("473" active "{1-}") ("474" active "{1-}") ("475" active "{1-}") ("476" active "{1-}") ("477" active "{1-}") ("481" 1 "{2-}") ("484" active "{1-}") ;; Coldfront: 671 is using a Secure Connection ("671" active "{1-}") ("728" 1 "Quiet mask: {3}") ("729" 1 "{3-}") ;; Freenode SASL auth ("900" active "SASL: {3-}") ("903" active "{1-}")))) (dolist (fmt simple-format-specifiers) (circe-set-display-handler (car fmt) (cdr fmt)))) (defun circe-set-message-target (command target) "Set the target of COMMAND to TARGET. This can be used to change format-based display handlers more easily." (let ((handler (circe-get-display-handler command))) (when (not (consp handler)) (error "Handler of command %s is not a list" command)) (setcar handler target))) ;;;;;;;;;;;;;;;;;;;;;;;; ;;; Helper Functions ;;; ;;;;;;;;;;;;;;;;;;;;;;;; (defun circe--list-drop-right (list pattern) "Drop elements from the right of LIST that match PATTERN. LIST should be a list of strings, and PATTERN is used as a regular expression." (let ((list (reverse list))) (while (and list (string-match pattern (car list))) (setq list (cdr list))) (nreverse list))) (defun circe--nick-next (oldnick) "Return a new nick to try for OLDNICK." (cond ;; If the nick ends with -+, replace those with _ ((string-match "^\\(.*[^-]\\)\\(-+\\)$" oldnick) (concat (match-string 1 oldnick) (make-string (- (match-end 2) (match-beginning 2)) ?_))) ;; If the nick is 9 chars long, take prefix and rotate. ((>= (length oldnick) 9) (when (string-match "^\\(.*[^-_]\\)[-_]*$" oldnick) (let ((nick (match-string 1 oldnick))) (concat (substring nick 1) (string (aref nick 0)))))) ;; If the nick ends with _+ replace those with - and add one ((string-match "^\\(.*[^_]\\)\\(_+\\)$" oldnick) (concat (match-string 1 oldnick) (make-string (- (match-end 2) (match-beginning 2)) ?-) "-")) ;; Else, just append - (t (concat oldnick "-")))) (defun circe-duration-string (duration) "Return a description of a DURATION in seconds." (let ((parts `((,(* 12 30 24 60 60) "year") (,(* 30 24 60 60) "month") (,(* 24 60 60) "day") (,(* 60 60) "hour") (60 "minute") (1 "second"))) (duration (round duration)) (result nil)) (dolist (part parts) (let* ((seconds-per-part (car part)) (description (cadr part)) (count (/ duration seconds-per-part))) (when (not (zerop count)) (setq result (cons (format "%d %s%s" count description (if (= count 1) "" "s")) result))) (setq duration (- duration (* count seconds-per-part))))) (if result (mapconcat #'identity (nreverse result) " ") "a moment"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Deprecated functions and variables (define-obsolete-function-alias 'circe-server-nick 'circe-nick "Circe 2.0") (define-obsolete-function-alias 'circe-server-message 'circe-display-server-message "Circe 2.0") (define-obsolete-variable-alias 'circe-networks 'circe-network-defaults "Circe 2.0") (define-obsolete-variable-alias 'circe-server-name 'circe-host "Circe 2.0") (define-obsolete-variable-alias 'circe-server-service 'circe-port "Circe 2.0") (define-obsolete-variable-alias 'circe-server-network 'circe-network "Circe 2.0") (define-obsolete-variable-alias 'circe-server-ip-family 'circe-ip-family "Circe 2.0") (define-obsolete-variable-alias 'circe-server-nick 'circe-nick "Circe 2.0") (define-obsolete-variable-alias 'circe-server-user 'circe-user "Circe 2.0") (define-obsolete-variable-alias 'circe-server-pass 'circe-pass "Circe 2.0") (define-obsolete-variable-alias 'circe-server-realname 'circe-realname "Circe 2.0") (define-obsolete-variable-alias 'circe-server-use-tls 'circe-use-tls "Circe 2.0") (define-obsolete-variable-alias 'circe-server-auto-join-channels 'circe-channels "Circe 2.0") (provide 'circe) ;;; circe.el ends here circe-2.6/images/000077500000000000000000000000001316355431300137175ustar00rootroot00000000000000circe-2.6/images/circe.jpg000066400000000000000000000342771316355431300155230ustar00rootroot00000000000000JFIF,,LEAD Technologies Inc. V1.01C  !"$"$C C!1"AQaq2#BR$3r b%Ccs,!1AQ"2aq#BR ?( ( (Wdqyۓ,꿩 g8D,Ny'Ak-SM-.7V  ( ( ( (*ݠv `o8[IHfY174Y7=}g{nEQ9'"SJQc4Ovwplc [)(]j7rwqrrHXA2[>,+ucjV.%a1JAZa޻Sl8/Hd cfoA]iz ( ( (KԳTҀ9?ߵdV2pfgRR]Y1JXAcV)5=kQߙBMQɘBXO]Z-XdWؕϾU#FĴR//^R?MٟD㘡`+[_n<%w9s',2>tsABz. w<)42,FS s:( (8)ԯY[59oy)$ㇶrpyw_<2`K;#j ckxBr HaW@O&{e,L㷄΍cl DW01Y`yݫ'E,jhY!iLH( ( E={8_mct>8gΫWI]س1IHulj(*FYfV'N7R{7tŢ-omݝv'zuǩE>}`ض[$m0h؎]}S3 }k\)J!LŭerF$ g;1Di+sȸ SOruy^֗V ``qSBW},n;?ՄoܲR2sN<]@ (;ⶶy8Bp@&>jAnѯu@66dSoRnҢZE+2P1[m28n\8L9-͍^H&~"=BnM]Fa_c] 9K> ET= (Dxpf ɨkۯ+`CK&Smm̱x[*v$iASQ힔+cۭ0`ˍQaL}9A?1:t$sD72zV@k(/Z$41Ȱ³5"U'Gwp5Ɨ,wXVeģ%)44钙d"#w$W\_ ~;B]ShnAM\u M_'U5?/ #W2ouo(>za/WH:[6xYsX^9s-ռ0.-*œ)Ka2KjY¦A_0OMy0틵դ^^FB\tޞ}紹]$ wVhږϢe3 o%7W)d&7oٵ)Pv_>u7gcp򝤐[Ҩ9.E?f+CM h $X\e[Tx82wWDo';zJ/$AGa/bnF*HnSm"[ YEb 'ʷf_f/ΰZ4܈ {8S٠dy>IDv̡NֈѶ 4DK ';gJ3z=<~-S,:֋6mnD&|A~$JpN1I{S;o:2zfimMVI"rWKgv=0jLs0RC'L̘Lۚm΋y<& 3u]r_SJ@-UN(.C̒XhOg>v%&(|KۛW1 TI޺Jp^[m#e?nz>u'/ǍȮsxY5 ~^2``yFj:򛾍ratVqv(u?SxZO?8t{gPk /ζw敼(?z6*zRp evI歎.SHG&5$o GɊQtQNX V>m:,ewygΣL->}o. 9&7޶VlchcEk{ܤ@|$֟6W<iQ~XS#g*!Q$N0wT1e8 g.rz|g7US6}9 GUjIA"/7F~퇊1+x(tt5klI lwס ГBXGfZT;J#XhHܒr@+JgL@}y-rH]Vm>&eC58I4Vs^+t{v*tH֘~ڂG9.qNWfQUs(ŕ<[Q2A05͟"xڳ_LӥRpK$d5uNT(&BXrU$W}B"{w!q|_Z89r)T->Xrg}P<"53nWICYjk\Wءg32`Nhp#]#+r|_$k5t{TC,cnzT\z:$k=2n 6򥓭Iw.!EFz3,}f\n+xK=Ik_ncS{cQjY<~*ԙZ*[wmv3^_8<ܝDm&퀅HnFף^} \6.ɟ3\6cw6s,^ &W䌕 xetT⮆MdX'u)ddftsiz[4j}rD~VjJh%FnUvWw2ŗ0H#69z~4ZTqy]˫8ݲ]G9} ._MA[(4$$͍ym׋'0և4j_e~5 jG-dH_u}?,䘳ţX9:O(ZprY<7X6=:mҵ1Ss𖤍wPB A7XU#]ҦyPIjW;I?LӵA#uKe c:5bEerb𚣅*Ȗ+lcl>U7ƌס*se9ұ=9$y#W8|qPT,+-o+ywqJ6Oj{H獀 h$=>#x_P˻Kjg5/Sicޚ:\wrW1Ck|Ǔ8>dLK8lPRBfXeν͟Y Č]G6UI^ynN,ap َ013u];yu W% oL{6Irin dI\21\y,z^ίIIGb#1!pkjX m5iEvIW 7MSLO[L "HU>y׸jW{&iC0|F?c:tld~s3R˃ uqMh 1:,:by$P9p2uRևl"!Z92`obQ@s9ίR]- *I;Z͡M> CB]֕NdB6ʏ@B/<@UQSW%:7ԫƯDUݼ}؊As0=KOgu'd $4',nѻx&ܷ|=E|ߓzΦ4k$,Q԰ȪzVKXc';p[>}6QKVʷx74sDWPide^@2Ɔ"y DT'ibZlXMcy'؏>{ŕ3tFQ#6FARr(o'=iyFN7jJ3b~xU&W{ybq;,[S0G pLDX[Cw]/;u20d*KT=$b^V¾Gu5cŶxV$c9]ʞo^ʶ K{r9 莖O'v^obs^Eᗝq Yte˝3J[eG(UYTzeY F qU?GDуʎJ0q-mqcvrL@S~ʲU%KC Wdq.o?y~G~x݃MpfsOKV[`!;m^Tq2(S'8#Һ "841Q=>:ҨlJ6 6RX# '$RiVڕEDH<횓PtXH]*']A /H #3.tGS?*{dwda(̠*w9 ~G.F_KiLnUX:Ffi%P;X |i &:6aYBMyX\E$uQ~shY%<|h2dNCz7?Eq:ZR!4ifr?#} m3#Sr`d秵k- 4XVfw{Ψ#i&@͑¶m47'AkhS 4))(qR%ټK A9|sSe*o#cK+g+c6M#nj->š 즏Zv|4xgZ2UMrN-FH I-byCoSi٭ވC:Xۜk@x'6dx@$vf*ߘ0 zdcƟ~H1=2T2*RkH+30o hgXoFI`@rM(Z ]2k%CߔX5GbhJsmQ[8_njdhcq#Ze  r w)0>멅W!ːo,pr< Yi2jzBRv/ !u{c*#{I@G9ǝ+t7[dƑ֬,77qB_iq<}3CmC Q2C!>bqh}vϝJ;4|ƽ? ;lG(BݜQ-e*ȘyU5E,dXxHg^Tz䝿VG%cgp8Sr)M3*?/Xm{Py|T_6W].c>#ǕR )>ߜcJd?PYY*7)QbRI-U%,ymJ&:ky[䜏?:u\Nvi\e20y4Q6eer:ǯdRŁc=3[}9|X 1t@;_.ɈoB]p3άnk]<ܙGRvǑޑ^;ѕ-#Y(,Pc "-{;\Av1ǟCJֆ菼nf+g[ twУZ1vMh }'(y1ҾȞ׿u*fbޤ~˱%Gyuݏʻ #жn J&;ԁʆ~R>uغG%`vNA dyR1Oe &nq h97Oq[[E#I 6xd޽Y"N ; ๒)AOʮ0qbM4Su+)md^K3RVW'M; 79U#_3#6lPT ?ӭ I0 б$+{6ئnoxɔ,6l sΩlS( Y&X$="~EG3i:?oRgBf7 "N>cGZSI?QA4[3 zXJحYi-.(&Koa}qS}a?3H4 d/MWDgUc1USebz@)FDnbQ>~,|{ԗ|yZ`{!{U;g?:v Yu7HFwa*RzVӬ+%= obV&Ies#'SJͤIss gX xzx)Fr:   dpP3G!x{dvs[Ikynr`|.$+ÙjX؞eA/ٝt\4RyFc?"j'&}1Z`ي VvmI-m~jɜ)'˦hJr:n.$pY͏Vϛ:P_peWRhoc' &]G74OEFF{"q'a59IA[xK/OIoWJ *yO_l:ua2`yTj?"re\xT>&a8JO9)6tJI*UTmUm#}^`N~DRnDaoa]r=|@֌uHcVS$ABt5X;[#R{G'cz]qY`3Y(6qc]!`O.٤Qha=A( :m9(9aVɝ OdLbM:zVl/o+rc}t{x9en61Zrc6Yr&:[N2\IrBZ8ҹы {,_1hK1?Jv'ēEXDjђUXl(iHrv9糒)\܍鷮~ƣpz35}:游iXa0O³&; ՐSwZ$2:zŽM.\.#iė˺bq&3Ȋ}84P*vTP@aӸKHEʻ?RȾz9Hͨ Ⱦ/=zT'l!q@W>U%TwRχsjwFX] PHʞlqzj'"4`{BpR,?5O6zω[⹥>y>5gT#mxfY{n?y~}>.ruD6;`txq|[d#k ( loݜ50^GwCk{B/4"N+[ 2$0ʹs=vz8R$B9 ЀpsZgCjc-[A!>6زW-Vw '>P`{]lF9n..'e `zi:B%zDvr[rt!W'yQ]!\:F tY'$JUB<c= Is%ܬë/C٫DY(8ՃةsRAѝ`Ɇ;ȪG7=;0 dHBOgIĻzk,VҐ2Gǭ<,I֘]X1-dcOZ9H޸h`-1GB?;d\mUBo 2{zѩtK[ZOYXi^̐BGNc$ԧovW ih<=e[ cv5(EEӗ)6IӊP@rdzk߸KIq{syQ\LiYIJܩu2Nb@>G5v\{0e=!byB>XrIӤX͸Fa3`0;Vj FD|W /G*q- ;r|;vġǔ!һO4 cB'ޫ$A%5ĽW|Xߨ:dSF`$=s7ZձSkL十#ޕHԾ&V@'*&'MH,oTPƎrҹcc7JC2e 9\*9ki㨭c٧!3O:Ed#b*DeʳX= vNHQ=]%UT6A|uƫF,ג{q#q=Sm'qVnKb8zu( ( ]89ഐZv8 cQL<j/: {bG+/W3EHNAs& źg8~WsCH,}#v yX̰ҹ =XJ!ٖC#$`cJ=M"7F~|#BTI˖8$ Dn!g4,|?JdϢoE5N!խ.Ѧ"q[s[glIE w8UTr\*a ( ( 9j۴h=:f ʊph?7qn=FKG}hKRFA`~~^*<QnS힯2,Ge$W{8=2;5{Gh!#ڱF$"90󬢑vH poB &=cv_= 3̀2= clu"0 V4j.'1pF?t&Psʬ%te#}9{) M !;7?H`PT,1^DF-Ci:m~Fj%'. ( ( ( ( ( ( ( (?circe-2.6/images/screenshot.png000066400000000000000000003374261316355431300166210ustar00rootroot00000000000000PNG  IHDRsBIT|d IDATx^ xו/]}ѾX# xb-N2df>Ǔ'&{/{3olO+cl.JhChזZZZ[]URTsSU=ћ[ iH^{?+,!zR@@@@@@@@@@@@@@@@@`1!few?}bB_(WQx{8(cV~灇_G}78#!ׄ\?ANnA@$[5 p BDeqx_<'+]N:NXyzxm"zo/.u40,E'Ėq֡z&jU?HEڅ8b5v;`EJG"3Ш.F'{P'*!b5ulO ~7gFA !Etv?c=Ykc|1wc#("<_ 8|Q/pMIE O߭X!1\@j:,0c;cފDt2ŇHڻy'VǺ\&Fa -V0G%+qqS_}?$_'wKDljuzfJViZ^ߜ-xug./p|l]9֘ÃkT㣪/]e?/zu8G{G\|Y7~[tLg8gL$ ++g?E<0(aqL䑛B#K!M]$9S*ĞY!iƹWqM=n]c<b[?z-E`~ Kua/pސ$(Pr4>U8: ՁL&>3m"#g#vObXc !g{Q6ׄ8qpJG'8 qRʤݲ8j.͒?㍨gq4>^=+y7CŸHuF4f <4؅J\nG}@-bW(HۍVꚇXfΫ4R|pIY5۰h>z چ|ZcQ18y +0 2{^FEYԎF10s ܊G.gplCRF-W$EJh":TheXI-O_MGOo0 (jTvQL,Ҵ4d$#cu5g ]f6okhV B7,V\b~5qX!!.gvvn2f!(F_Q~zkz;ZpS6m^`FG] .{je+Q ZF1cCUїRo(D*>CP_VՊ,$Q?I &Y-ĹkXk881¿d,!pN_=zXN=mi1$UB2֌10nQZZl3Gݼ5\7]܊GB a滋3"D X#?}>jQ.$fRlJ"26t\R{f>첛hw(of~gs0Όalx^_,EBR*'#-ȂR,T,`V3xȷvۃHツ5c~Isٜ7p?́pèw!\]"el5XwSͿ3  < Ccɺ;4Fs'f*)2ŬB.ہ\)yظ a{ RZ Ymmh2MfQ^^U\DeUڌexlh΋zKdd<!3: b~z2NVv0d:g~5;>?rzw~R8l^IPpĪvtGy3S.Aō: LrP2P;h-{C=ms08/>kNRf⪷vl9 Fxl@Nd<D`H}(4\3$+!5Ϫ#m{ }_N*亠"`% Jy^JLCRd?C&) Ķ0(hrlD⩄͚ü.o^tDP#AɯtKܦ$33DJJ$(qL:VF=bsV"ݏ\M"&r N\hU;#!s.!1.- 1ǿ'@jNx )K7!Lb *+\d@@Q DeKE05}lFeQvD4Fy8u͌Ǝce ׷MenoiDegZRp,5"ߗ\@S'~U}C{n1~=%mWJ=i.7%Pc$(il!V)Z]ީsPK;Y'lkj}[2l#Pp=|9ड़W02oְۄ4 ۃ<ʫ6NVK2kPϽqElÌ0 sXlIQ+{m z8]ųZV\:F?w[3F3^ż) 1WQx{8tKb(clsٯ{E ιF9y=@"vZ]~ FoZ݂|[#ea-qb$ 󟈬o/R` [ӕwA>Ҽ?0!$ 9̷&a6()a[ Sl\ b?5&=V-{'f˃8s/V ol{_G,u] Bwm|0>V??+\ezN1v?ėP<.iL_¥&܊P,2K 1CS $W8"6jCD>jydښ_Q6w3#|S~:w;@q ԟ0 Gd}{gEbb5_'&km/N2IYXH Jگc? dS5>oWcފDt2ŇHڻy'VǺ\&tLa\?Gby+)篾uX'wKDl#7/د3Wr"N{պw{z{it~k5Q՗ۮ[;mEcWG76zhSk/oi?l\h3"y JDɍjw 0MكAPzW%.GB)bpPB!3 =qU\SrX5!k-Wop_B {Pd%CAiKΟuC~srgJr_Ǵ: XkO?δaD⋌ؑ? %as(2te9+$~gvǞ:믽Gq}",9s1?uLᗸ?ptJ]?3391J>zpgn$+ ر,~R (8{rLC𑒌#$bnGBD/n9_cq@V""Tv"N6тDl/[ עfߴؤ 8[EX ˰ ϝéQ O W#ŸAg4=ςQ0ME-Y=1r9/KVA|&*\6>Of 5I†z"TVA=W='9E ߈d B3)b_Ʈr}M[m(o`Tҋ;)QdH4 ?ORgS(,w{N3pxJ$tG_N ]˶><勡 ;:? Vݏu8~KXga8S)qP||om}"Œd(##4>s+>'QK|!%EyjB\W0"e(Ժ&wa!!\ϟ{@de/X3,^Hنҥ[v$)PaiX$ &|b?Ҳ6?؇v!t4WkzN =Ҡ#3ASVKJ յ2~խø~5pҜޗ?!L D0n A^- :߼wj )aJEqqXQT *>CeP`B}YTp$ð>I+ŸINaO+881(ZQx,L-YO%B)]G'i^ ږӗ9֋1M$dfvu~NOX7[PylBIfx dB]R"5) AkݢHCׇko3|Ƿp?_v:g.E˸ޤGO} i|$| :v9?7UhpMf>Z P/AYϭC4=T2֍aGڀxI>90?ٍȬp"@#V!hml0S w0E"Bs,FGw)Ml<;r%^2ꕐ_ojo&mD6ĺ|nGa#UCˆӍ頳3K-37\,0I4a rFh 1.-:4,&fx<\P͔cYgM&0)F* ST!y`"v@f/)Ǡ5W@1} 0Ɏhki%jb4Жr;DCe1AXҞlU}8OӅ)y"E3@$ax`Mi+|?ydtHPL*7}?T#$)!nO^w>"ԝ=>|([⻐x#B!EO3@T@FχuӞ|qkߏIH/]rZE7n",kܓZt[sD,5r<[>9t9>|0 ' W2={3q;# J FGYs;4/Ey"(ӰNtUנ1̡-@,cCWyq%gm.v7(ovJ^ &3c~w2{7b/R<iAtԗ`y 2ʴn{0WtfQ&'e&kḱŸGܶ>.8~t-'Ce&Ug vum!m@h Wj惱(vy6Q+dh[ 3m)jؼzCgw|'ˑ +HAjG|٦ V!k7JhѦuB@CM}?چapҗTxWb%;}6ަ֙@[ Uܲ HF /; 9Hv,z Cht {kY[ :I IۀXC Gza M΅|tU'Z|5яh-(=iDA8/V͒h?=d{>0l@]E(2| ԌLZ3o_NqK`ֵd 9b;̟y?i`TسC|wFC>fK+gbi3[+n?&2>A+=RĬX ךo)N5 /qD_2,Gy:4=_C~ !s[9q'ɐkEe+MI)(dD3#4)d|dCh5 ߄0 SU* M8eQvıiD"qT9Gop3(҈ Xjj _rSUN&>I݇=<ܸ?^[czJںv]{X8kc^^#\93kh< _FRńk7c.n'\8sOoxh8#<.o&a x+Qy!tFt\=/$}^#(,CDM>8N2 Ws^sqp/4`C@,OF;uvꮃ6W5وܿp9.%pSx;zX5<$YF_|c(wCA^E^{}~ "f3!qA8 ,L KVM$P(ȡE1)c#Ծ<;^[5[УKRD- q)hջyD6vGvhAXYU4=.nXJ#$ř"$1n+Cnn̞zb|R+x LN an4 ۃs8?>7^,x]ޭb=eH{d/oNlDUDoOvj o֟BbND h}[LJ30%`~#@"]@)MɕzJ%(u87RjǏ>|seؔS.h3ڝDFAQ%ħWәᓼO% F5ʻ1ܭ֘6 ʾ'?z1{O/`wjOꋌؑ?Js( KrHVcUH@ʸlJ7K?ں/bVDj*{$!E{sSERD%beȎEۆ²N̔Y^J&ekK`@ ~/$9еgw 5MZ "rFbcK RϚeDpj,BiQ(4$PX2 <%ѱCm s8)ʹR ѿvFB]3F4f <4؅J\nGZkI(s͔{pЧ(Қܔ T\VA?po&F A؞\D6_‡mԥH R=>]h$ &$~KS)TКH\ ʁ ?y)bRp~W@fwżlT%_d ;/׿ LGH8o!!7BفoQk /wD51xP/ O?5?ьؒcnH"4tXőP |<:#_}oBi,X ))SI)Dֶ~N?- cN5-~qv}.ŹsGl#Xwn擓(ӐcC{/Zxyi*C&B8\!@&LRY8i1B?t!"$)PaiXCRE  szܛYyW iYkJJߟ?;7>;[pqLLCQ}^}Z$6b4Rf!+k"#Dn#,^"1/[hZyYǺ6lr6]wq}"/-/0&=zKpNレ?zrɷ`'?GUN P3@kǙ+sO 𭥝#3]ğM#t8N9~oN XOMeQiX-,zhmxocȢB#V!)mPf%LV䃈]J ߈Rm؜`Dc5h̎:/WB.Fe}*G&e|B031L$" m9Z7텔R BLl~#~ah>Fļʹ7 1RgY_)1@)jRHQ%)8[uh w%L33x8)")Sf&hоr5^-ܨ:Pڇ} #|`(CTz7 m&bG dFšZƠy_?DJ@,|o!g%00nPB; ?|9x݂1zL>:tҫ(>ēsqT,BZ2atoH8UxNL$(%M8U8|t/ )8!r3Lmd޳.^pEPa=(騫Aaej5cPSmAƕ\d%"k5n1v|@L Ût@YW@r%YK s=vK,EBR*'#-ȂR,B"@576F".2[vΖ xXܠ,>}$BXm" @i+T&vasWU-Vf_fhuCKȰ:҈G{yl;-ZCAwJM|0@_]ߔ1ny@ \wDGK'*|1Tt4{q?6yr` Cŵ |ckLX57)VXmU>|\wB{ $4,%q2ڜFԇ#W=aVO!_.Q@.cљ(yظ S f hLCFWT{l͢ M`DkEQ-?E [}\q?~O}e$&|aZw'ς=_Ys_"|18Z?qr 'OCLGhPsk J~)ec$HȂkNR檷G4ro ؀xH'dٹurČH58WxcQnC Q|@IZf;Ey%A/mj4Ӂ:{qn=͗qBn ğ\ABH֓T#AɯtKܨ$3deC A6t)AYVmHxHqh? b@cɵ&0o $<(Or{#6}rUgg\H%PM `6h6>ݸҨGlJ DޚH7Rzq̍PM=z$Z!$k V+ #Xnb[q^dmmabu; K5d8q4X9_֏C{vek2d5ʋ臩 %緬 Ē7JqCE ek! Ƅ۴jrj!oFUd6XsҷdRc?g+;u{^C`%قO>#(,CrWIqj/nd,ELx&|]1:~88sOoxHon/. /> ڪ qǗh,[ dRT-!eja}|:e=hP@CeȒK,r8fB/Ou8>0fc懱>ÓUe8|еC!+/\AuxGh^{tv#H>OPx'iPZA.Y+ a؇~oޮrɗ}gGFZaH߉o]xJCڸI zѡZ:>ldD[Ix:j3{}(_c-ft#.˙ppDJ*$%rS ћ[^{cWä@Jb69S0nsݬinɻۂ];k1ŏzf p"]:3-Fx 5̵ Q w^+?G ssWw"γ, Þ@al??IQ: q>Lˏ"1H{yp vo_>[}6s6ʽ\E 5MQ&J >Kk+[񟟕CBRgA 9E]OJW/x%[; }8}J4z9 3c QS/֢QkƗ/x]K_7]qg=AaGqS1&>^싾4֏ڊ"ގA3|Nevb߃\]W߃NϽwn~W޸~ݩ@syo/a\5\w 1 CɄیA!mEax^wrbQO"%~:x|Oei !woQ֠ )~hcӷ~{:`_~>5}*g9L\9%4y!_[Q( kq dmDNM*tO!/cIr#2"u5N1]bѠchkD1MKPmT#5l25)(V)Y^ĊA$%#9|J Buȳ baJ@vl)Pp44mE$-o3}JLɟ՚pdMނQr]0#8Za?{0AOQ]ir$)481RMX%N"`.4MO! cós|L>iEu 2(1 kO?δW IDAT_:lPpkzY0&La?{ E8oHF^e%O!k<b[?z-Q78#K39ecr͋IҌs⚚I=mfC*\҈ {b"PzV#~oS?'r$PBLEgiYCkXa2FfYqP`9\t't'`#%G =(ۍ[˂=ǡ5{R:B8_eezi 8M K OI19Xa[_q`^}2e}>NEYW?gTг'7s(wZ~x?ـ'`H݀WQk>pʧu~#- ~I] Q<-#BŋexeȎEۆ²Nښg>MܪI XDI*4R+1|9Q@ T|[)UKmC{oTF3|#z; |0d1 4R"G"pt]/\o5g?&nDClC](ĕv%o＀_?0sVW(HۍVꚇXfΫ:aMD ƂQ<6) FlZE䗂GD1$v{Y7 ěI᳝^"&'Ow9{^FEYR| mgE1vo|^ ti*B5 ZkaC9||'3IH )`]4X{=l7QFy,I] ΫYWݏu8~ =?X>KKaM)~>FcCS~7ê9"T7vAM=3̷ ő@ky6|Xf@F2^ G^zq' FPv>L>Erw z>ӎW3-/W;|t ,'#'q#,5OQed2}d_"F#X ]iş?;7>;p\ >R]K tRZ^S^|z;#ȃQ&oNBQ b t_Crwڟ]-(8uy >*+e^Sx9%2ÔvW/#qXQT#xÚ}YUaY5L "xF$"ІbF]Ɨc|7L gRn=N?ӗch4mMd.z^e\]x\-TsI𓉡ɬnL<0@Poj7mǎ)&,fR-d1OiR{ҁќ_ZOe\nYl<=}( 9WY̤f3Y"M& V3YO}vu`tUePF@zZF[SC}.pf[җBNzD@7 €ɫ[ۑS>,hZz+(fv[C,B3s/Zq\)F2P26H<"~AߐI~unĸ+gϚb(C'N2nFLң!J_ػl?Hi?X8er~`?66oMpmH7]%6+9u!ayHe0A %UBLig>րXҞl!㐪U}αrawoR/2 3rQW]juj#=уq h)z5uN*}yr!"!)˓dAG})@=?3 Qg4#eQm_٬t֐s|䝸R0E(W7}bru- ¶s}?j +t+fZ]lMS&AlO,Z#[ItA\ΡOE[ \^?2;7U̟?E ĦBF?1t$ZǫYi0c}MW2@a7YtV[-)|y;MeKd\/576F".2[vΖ xXX`AZh(`TeET^E (Xǟ̶(_/+AA¤ 3|zX_"hd薕^"0B\7mx}G x4bF$jp8"E.|)"Bl D}?nEqKjKT QmXS' "(C Q_W:åmFIΙ-G<&fi}a˰TJ #f1 AK.9qo/ƻqQ؜HD"oM$-fW"%%r SC FZKq?[El WKOnH@Rr@-G%缚-C ʓqވM_ܐ)')}f&Őϯ fP|Y?sp_<$nn^8|~=h@L;O4/?ϗWS%!j@0Y 258Po}oG_2 L|(ƧǨϷywq~2`Тv!Yk*X׭Bx+tMPqƇ5[6awF$$lCb\ d#Z s,݈kӈE~e1RqM܄k =+-G bAyE$-î%dECSvMhAe-KCqLpNGK) :`WWwMI$% G-}kCx?V>hPOAǧ/5Px7<\eQ\(D-h8 ÞgAz؝Pػ3ʱxb!vcKGG3:G?Nߖp _mEޮll(U萑ď^̣HJ8RM G*Y 8e7XUP4V^ꏘ~|g1;7?^D*pᏏ2O͜äry,Ls=eN r]h4ל+ā["S"D4˗]MZ$"ޣp'&95a!5/ndvM7҅RUv$!$ !$#@`bic7^f::b_{xL̛7q3mظǀ-.."}+Q*R6޼$7[us;;'O<m^މS3g#Hip`&wOM2<Ԍ?#r?Qʄ|r\Hz#! ! ! ! !# 7?~u`6oDPC?,|7Ξ;3WR"l+J:S㉢4(;jȼp$Q&! ! ! ! ! !0h׌' u o^X%E5W]f:&Q      hB'(b<|;ҍo*Q(! ! ! ! ! !033#         PTN^_<'EQ#BέxsqX1 T8kTD'ߟ{@E&r^m@m>e[}Jd?R nwD!Ds;e~`qWa֝6t|DǸ?f:>Op}pBJjEYݻw`KxЭ"C!M}UVNx?Bt8$_?|@\6R̿, j14@=*S7\屸(ׅ,)^M@KtةKlnB qXMRnTU;声Q#˒#L/+q\=6-L6'N^%F$l !Hz,Fڀ/Q!/Oҏ(zHYqw܅8Uq\Ky's/:!weA䧯't~ۍgd'_pI:=хCU%`oo(h1~(Flֿ@G!`_L i\4 qx7WWi->("*%!76?߰Q wcN!x!*RH^Iǚచa ~>n{hπGXl0עur- MhѵVsA6!Qrj'E0r'+G_:Ȟ!S!>xM^Ȉ@NipnaN|٭vRjtn[>:J"/)tA"^?_~ʯa"n+L _V:qqG4YTa<?V #˟!>έOȾ:S>"t/ξ۾T^BWfDf48F8pv̟W8&,s,2}ji$%%cӅt-s,{둏~dhӋ>C9nBGV2'ҟSzJ'ϖ <|PG+S[Mi=wS^ LJtA  wfp`k/b+cN?Aը<b3ԯk_T̾mC,ݟrD9ȓ71; J}k_<W Fq6Nu5ܿ[8״?ߔy!_>mýD J9#0$h>oT t @?s h2yvXpoDԸ(Z2 !6ySK1H huxQiET`;q U$XIb99wKbO3W~l _~!$;4pӟ?_#׈t^8`̝EBq)J"i"QX[掯9,Ft[hL✶H\%1*(5q(*g\MH-^\$&9]Ja5ز$ q (TZdEC9ԍ^:b=prG OƺoGwMn34sC]Bѷ5F V %ѿxER8vW᥎`'{f "݊k!ews`7ǎ*'|0fӧÔ[ b(?,t:!_g_dQl?a |XkTKleP;Ex2TP OFzfPkQJ$$D""IHH<C͏_ iI~!J,–{8sbTX#( IDAT5{`g:} M?n fؿY,/A=FEZb PR5^!XMؽ{8Y; JT?Y{ vf;> Y>C7c?A]ɬY[RiF@QfVoj=_Էo Q$4AI?Б$$$((^ x(j&bb e 743jsTuq{cȅJ#yX` \]e%¦ 9` ep$NlT’?V:WELW0C?aǖDQ6c;Μ<- -y҂3hS/9;ނ!~O9=}R}A96rq:*Uw +d?_aT?eG.8>Lpi|-\FUuYcG'f/xgQv1vEgpP &S!{|rJ Rfdx5w?UB*+ vp^Tv8[ n]hݿM* xv 2 a4Z8ɠrӗ&?7CG_P/u~ip>xfL~WD9ߜ h(-4C%mLF+><4 ۷ ,ӀNk0,(*£ ;rp賽ܧ’Mxѷ1cn ?.b/33A\ N̈́X950|tWi->'*%!>R??[>UPr>ÉE[8g\(|PkKEy{~|BS࣏{/ܿ#YDZJ˰1xHC+u[Ň103ĴnF!0;|SE9\ d3+8eG~@1҅ƞXmftV 7I O@U#6Fܭ*Y pa4UU)OaWT2ckV(ͦL~9Vk6ddpV A1(ʉJ%*#pe4Ӱ2I5~>w|"+=P7gD6U}No7XB3rE;aCwSo~&Ұ}h3:Gq:aPDϛM-/2O%~ll! tL$a'r'~oLj[h4ⱊ_G4~' O. V ]_24>oItV+~~嘂>6iU,~ۿC9^>)'Z~6Zq^⑯?ӫ2{" OtBK|sW~^#D$qgQ}_6\l_BmPby_v1t쵟lýtEk\tNMq/ ot@lQip~R XIm" 49;QQՋR+#N2}/PO*fjWDm? \Q_&w_Z[qp;~3 r \*a>Eg@D?]qɊC8S/گz ^C4RƇ={?MtjFz$$f7t闟C~7?'ogzO^ ڐt cVN/U#%>7?~MW$! !0P%!SՅ㕺3Im KJHLtyt6 AcU4P U"0K\/_IK [u{ =Y 8+:oŇã7%:g=Dy֋Pb@BGѫA#ΦĞ#}T>HLfǭIF        G iHSbFB`f#N^*Cjf9Sa4~:];8l =!|%H=Nts{a1bO=FzMQjoTP9ïR~E. ^"e~g7aڿg38Ez)6LG+yXloHR<  Y1QV%Ϟ?QVܾRTPE9,p]iy+L~52X:\<{GFCLE`IjlZ4Z H1Yc.ᲁrf+BPLMVg!\4iĩ 52U,V+HLݸr/PKA1XI*lZmF}NK].R%/RZpFt B5o[0ĺsؽ3-A+\L/bgy: |< ~o^.;nXC צ7!W.` B<׬OI[;m0fK k=EH:~&0}SkC?Zoqqv%:@Lq0~O| /Fd|-vD$f$;7`":t pաۮAFz\1 ]%ex:|jqXe"e.tAZRӢ2ár K6EjoQc2m6r;Ň4c؁dh'Z91('YpM'P ioam}xjp[[oG}8tob|77* =Xf"ð:XOՇɿ ʧ?\uJoNXH7"h:I^!6?{/[cb?qŇ _7o7ZOU0f/;F2ٱ2[?c^UZ1 CG6<ڱ-Iyho+ARY`YEQ TS#U/dӍB-4>}e&GUB_q-e)G Y76#z A5MJ"t.ap2#?[K_rDhBc63[q9IV O@U#6Fܭ*YZP5+3h:սf8um|Ix\)ZQNW*Q܇V: +TΌŁ3wN3cÆ&g/AܮC3?x2'd!mfq%,|"k_ß+mXY":@23ҟk8^ߏ0nAONED`֬(;4Au8`` J1STDu6_Maܯ h]onBuS'ZtmrI`ӶSt6,E^RԱGdPh-A]Vx n̦aчQqɔa&CcanH vcz&/:MwмqAhP ea"l 4a~0t q"yY6EXVہN>B]{B:K}/d_gDŽ١景<~y,oetl/@& Mfg/?/d7:瓯Ƨ( Ƨ.RD@tb8}U00>+h< &lL,X1^ޓ}e?XI-8@2gFK't)1K\{Z0?5 iIXt!67o0B: M&zCCmǪw 6ٳ0tTTCw $!6?;F/^H>ƧH:=[|b/~s8I&"b[ʹߋU YOhZJмRd3 UH(.SZ+D&dz6+X-KBEFZ4Cun 'Y$Dظ&T?_oBj2j ¤I-.LCk7*k/DAJq#ɿ|o< ϖ$x.' x#-tJj4B&fF7 S@]StC*G+N/O[mP$.Ē8GzgJ6^FPt eĶo7ǎNkx_jFxXO;fP{Sռ4L ]0io=pr Oƺ'&|vtT<\c17$0\/P?/0>D"0\/<2fxZO>'CnTNn@'Mzz7Vs_n hs :Q~^\?]u+mW2(ʟ*Ŷ_ԅQ{q.';>LMxiEۅob56lۉzzjr(uAd!­>m ac ,`JqL^Z ~Yg ׯYNq8?8s;Sm)N< txZl2 uZtɸXc6F׳ם?.o+5˟~+!u}w2MDo>+.Ptp4@_֟mرaH_ō'JQtZ܋ 쿫7Zv`!]gr,F܄T`#pxUP;FrPA}(j;"?X8>wqw{!0 $%NB@?Tk3j]TSn_F? h^ iEѵ_\ ؽ _ 94dc]գfXաaDǯ '#J,¶T!eH<(JY hˠ3y!hjr  فc ק$Kovh̤3UOf*:D7V㣓u&n߁qVt>'(~$$A౶_Ǖ쟿>7U@r򑨓$׋iURB@B@B@B@B@B@B@B@Ѹ. !" xa锫Rו(𷻿w*R'o!}=3]E[_oHGB.LQuu&d~))0<~xx۲< i_=Gy p \W،waPyx+S)gxkW>Zá{{GB@B@B@B@B@BA!`:m o: IDATf@&Q 9]794\r J ODM8Zo܊6whyIALJdP| H):wp?Q)Ūy^#%M'BfEe ~<1uנA^ƧTT*$! ! ! ! ! ! ! ZMFs #CPh4!I \i.4(‘ >8TXT!Au!8* rBN ,Hcn~6bJZ=}}XqJ=r#Sm@8%ūih) @g-J#dX\WPqz7SK{@E{uҎ& LjjI@14Yp9Ф*.࢞ԞۉmJTXP W*Z30Lt!ZU=F8F5ལ1`Re 7{O?yt>~#U|>_/`c7:d.oOJF.=#uNDQhs7/!ޕm] ; &@D u8q.u_-/-#7pMD lv9y[FC c (~A|_aq) A%G O4WWzZUѿ+)rc-y҂3hS#r|9;ނ!7t|D[`a>|WL}~9wZR.Z>ۇ:E C]DTF&߶r3|/&h9GWRFށ;1-w %(ʫ78 t &ʌLD-0>\ !?7s1M_9QZ{3X/ƅ=/$$Ujl[`{QmGDbJcp7IS! OǷB5l@>mN,yȌSdm pաۮAFz\1 ]ׄU#G$mEt5J˰1xHC끾v0?{/ί]'/}f0ڷKBQ3OID~wD)؈WspS\[M/Į2Xh[ ~ A[T9}8^\Sca&H~-jL/VS3>V8N?iaB3die+͋@әs2̈́{w!ZV=TROIM4LR5"*sʧ;ܴ'bE*uDCP,ŗGyXdӵhJ}:p!LJWSHzAt;mlc.vᰡv .X  nW롙DgfMB:pƃωF(1ï^]d2ު(]Dˠˇ'hyZ?.kA Nd+BX瓯@tb8}Ut~^i)Կ 3s?13#&> Ct/{‡MwмqAhP ea"l d l& h6E#5L {b]wMcÇޞI$=n^5vI׬p^N2Cӓڹy7W@ˬ(\zw8'9 4:~SObsi{z%W#}zL\(bvǞhEb5xբ)-gaSg>p/s5F~EDĄse1NJa7 x9U6qY,R;[_C9nB><{6O{P6/qW$TQA"OzbJ< j˓s! B:pU;߉Bp$S3.I}OtyJo%f92(T8>Vʹhu uÞ;,:4/[,07, =ӮMbp ~v+řF{@S+qÓVjn#xp+٘G&p2=}hɨzk7]SO\a\ZK|jR({6Kt>ZDNv#n1">'s2jmuې5HK]?u S& (\}dj: bCa0Y΍D[fAaH @/fh+/ϊ{M$ӊbds1ǹG6 |:[~OT'l|ZP("}_%F)YJFQ⠃ѵt.$mbm iȉAc'O@~ZJJG8Mi{ Gps`Â3Â8?tBD[.8J[a[6_$la5ز$ q ђьrf;qބe* MBiad9"SӠÍ0ش'Y$DD5a=prOƺc29gGo].%tLC9+zP\R/d0aa1BS2Qsݨ1".j(IW ܌?xeYt#IMc%_ 'o 7^! CjnJhN0On޴ @KbTPjPT4%n4<[㝻fJZ<6ݮ=sbA-~7ҔI,dt*a (l>}&2e6rrE#R:e(t CG_p)alhE9\/<2eC'^J,w=[2ڜ.fUES+P57yәNW-Cu5d!/Ж׮O(Ƚ+mՒZnp\Qe1SszML؆ *gכ;t;V?DghƕB<:'@Aag-'Ǔ [7M=K/ ?}h >UƆm;<]8UC_\@͈v$NGaçqȕgɗ!U/c_#bt3r.o jZn];\tʇA CO+#@8[v-Ct2p9/KFɘ &+gL:ahcq8&Z~%Ug~w9,Ht,$;f)%nwF "-䪸b 8bjF;4MQ;} JdFmƪh:cFj诠yXyKg#4蕗`]3%Q?TktM]^{C 6S$pݣLO9@R^!@m+ث6BX/W0Swz5::e];ør|CR͏_f.gTNYnI3[-EiPv\@؊#9U3Ȗ ut6 A&%A"! ! pXnA[ a+Oj«~7V㣓u/a"x=w`kz(Rc(DaǍĖ?m=t!@*?}UTȭJI> ܈套n@wEl.~i_oU zḽ¢7$C'huG >l~X 7^Ï2yipiΙߺ[Ÿ#.Sc^js|diU.?Q.JE+S+ȏn7KYl޽[aCH7b?R Y ӌmaa?c&6~ewSC7{hQ}5ZO?_3N>O:H !FTj ٿ"Ee&rpN/,}O4p':'T/7a^V=$ PT5FbpV*C52lp۪GΜa(4eyם\ݏ̌Vd%a GcphyYHV=QEt]U!d.n~lӶzZ|?WƵAX|H5[V|QԌRwb,fRt9 z>5 6%ūih)`@g-hg*lZmF}NK](=}R}A96rQtWqZ WޏE##'M=N,ڂח?B؞ ]'" 6.KVh 8Uwޭ5fѺy"ğ_XH/)-Pc-) X_ChcrDd_>ۇWdA\Wj5%ᜏޮ>JF( xv 2 Ӹۈ}K$-=dDǘq|S?3OXj&6ARBa9 r!3k`7k9ĠtTX,C6rSoъHb;ZrO>$dEL䥿O}$}Ty?oϒL,_ݳ=/ /M o^E,*Mm%Hj<4y9 (J }KHy<Sg)"(~Wӧ!>1m-S>I& 4a 6Z-nKFYF$ܼ ]X  "&r6fY~vs4[#lc/M8qUB'?>v-C M3t^~Xtz%`ݘ!DH{F`ZI2=A1(ʉJ%*#pe4Ӱ2I<ƅnFGA=Z醠&yh:su0Lw N‘g\WL5^3̴xbx&dVWGbp=I:.6Gl[u :U?TGtV2AU"CHb,-L=܎`yv] "k ]z]ᰡ ]ItW9GCwiOĊ]f~&iRtBDfN/>_> N A=~c$ 0kꪯ :/o 2t~|:G@$&QaJ̓icExs[:Ѣkí疶L`ʣ<:L )i navfUh,A~5siĘmBḫIŒ3`*eӱ|C ~Ҷbt6,E^Rc肸Vtס0YapѨBJN̍W boY_;vczmz80;a@B7;h^S 4u(0hbׇO 9+-S~ O>L9]Mӓ2}w^^ jhƆR\`Op8ᓦ~ j!\Thێ6\l_BmPby_rn%<|%?)oOd{n@ wSt׾3lσGtꛈGP~Ks"j<ZoW'ոv_~=^`2aGX8@)G!*32 Uhi&ɜ+4tT,z[d Ҧa-ś۰  {\Z?Vjn#xp+٘GuXpoD#SkbC~lCC |ԅAr( f|N _n0n$Rm ½#-CA'4 IDATw 6ٳ0*51H hl`Jm<&2a7#s='&\v<*/@%P$rD0$.Äd!+%izT&s?~mє@O_Ǥo怕G2h>*#a+?ilvdBݘ)B1&}]CJ~Wds1G`<]Ň! 4o mAן|ut(&c."XCPߡFXO BArz+btP >  V~7B|r;8a~6[r~ˠtG>-bKW\;keI}(Pi P7z97k7*k/DAJJ_fp+oDEU/KT 4(,Y-s-bD7䤥F(:;_oBj2j_I(-LbM&=vg V(nW^$+!Tr=IRlc)v6EOBYJَ 5@Փb,n XŦAׇm4<[㝻7g AHYَhm)O"P$>C $F&EEj7`3#VcbCv$t9hd.)?;kpSIq٘DcdRs PBZ_I ,ې*Orࢼ /&A&{qyEX#  `D6% (Y>?_}{w9==>l-+Y(QsH "bl~5 `Ԍ NUHxQ3Wj|~ЮP?{rAW(jWnNg& V@ ly8aX{ޣϼP_~ qAC܃=n` tzB9ޓ]Orgk]D=dYdBCxYm`_]M5>LFZ;ۈ'V=3Ebxh)bup,u=v~ ;U4@ŹMKLq_zXmP*Ȗ[~nK /&pUPx^W7&M/2/$~wJB^>,[skqR;k=okw_/:wDfE,~53 g cӘ#=Q~ ~q||tWJMtScQ.noC/޷]qq7&(;A=xW'wŪdlݺ+'n\='B."|,I)sj}U晅dcS;vn:>nׁ#S88|f:߇{V:I ;5x}i,v>qOwc͑)-A,E]j+<|@Q# pGùq4/)s1A*ݪu}Wd4rkDjdh&R"*|%(R}M )>eDHSCp}8u-o^Rf =(Ϙ;mFq?mnt#$".cz=s(*{ ڭMSMCV P(AeeOQ|)H\1\'##Agat9n̋ ۀ0%y1/r\ˡ\3$1~,Q௟*AI>&ô(ؼk)ݮoLrh^a"mʱ|<{Fy6Jppik 1- Cؚ5 1ipd*t?tE2B4ۇϴܻˊJ?`t!S ؘMʫzdP鲷?) 5YbHqwW'^?h?DK~\x [C-mQ7?“l> gɏOy !]@@@@@.Eݍ=7u!UXYlkΎokFAjE$(sΉHP32aw5,$]8Ү(>2^ï^MEj"Ϗ;Xϯ-AM #v^buUx\n%nϧqgq@[l ݎ uR?pÅ. p @6Ca4L!U"1pw>a#?u#bȎبyUK>H1ۄAo.lXPԃe$ YPa^\:R1mK ksu"ʰBwIv݌u#G=c( gт6 7+qREqO"tZpWinUHseԺ<:Od-Cpw\Á9Q/'~(}qX@ \3a:'Zpd)?⠈s%yaV\;݈u"+ (By;?D#:ƿX$V' ӅKйiӨl2|;JS$>Bb :5U0NjT963)#y2yBՃɬ!2 [K(1 /z%h$(~2MۆCOȄPxd '>{0ou8x͈QQбx ^kt(l| z#ؒݣ2|gYXqί=/s<~j0=ýʩ?mGFZ"~Rlk=_lW<D Ίe)1 dĖλYFW6t.V0ZU>, Iw$|,M_;mzE/n8lh'/H Aa`X3r϶~Uuv6A8d(O$]:75xP$iH b xt^:F$쌦/dL<8}Ԋ?S ~p ]{](5: SS_|{?r?+?{&I=VA7U.t#Q{_W>P|fU@@@@@# $#'aBI5dbQpQN3ƢEb#s$)%pGWBI:a&/ nzvt5+֌{du] zf]"-P&^K5cGٙmkpڀk@AtSIn$4WVG"I%Y Q#_r㇔%ȗhpB.KDIn5#!a^dN$ Q%L Smnf"Z6%/q?o-D߅&V,FZyp".MSIzEh?;(7#fRG+ `y1m=j“F򕟿'᥀]ůAą d,y1VC*|4;9C}1O#Jz,IdjW:|ڪ9(CcgĪb>|Op:><|_J4uBy:N.~#qz.«l[Kԡk춴`brYgueV^~Amk`icܖn=taEXs& ѴʸkGUӻ#EǎOaUhR&C.jO_@}󡏲ŗ ?g>E?:ȁz#8Zzil}|AN-5wa fy缿ǯlRqOIqFد7ʀ9ޓ]Or_hk]D;ůŗ.t;Xd/ "4r'P;؂<9SLGlmhRШ^/uj$+ "MV>mx,A{=?^֜6e4LBC`O!m,~53 ޞ:k1k脂̥3"lTYgϜciJH-ɽ8{zqC}-syoc#P/ p#qԡdr$lL/M T87P >a";-Io6& (Cw {~.@͹sF?"0~;^Qdm6ı8 ; z[̿"y;GS{zf_%Eo} kG=7ŷ w>iv}9?U>l4;߃od;9Sͽ>?֌BOV43޹jh_OciN`()K{=B{f"Us;JΚ3>|!I@OZgg#'?B [?ou4fÍ+RՈWHlw7Qo#o%ؐm;pY蘻JPs(Cpݓo8aFIZV}ɿ!e䵘B eAϽ$34gnľOEm+ XηY+e4 ci vsK1sAWS ՋmHiBa0dB]]M4cQW ;ȋ̩Dˍ\T(Q^Ċdgu ' c84ׇˋTشL()G`\>f{Ԋ37s?W2Py:t[B[3 A +O . Cؚ5l0ipd*t7uÄGNdZ@YVl^ޏSGay8M/Z#A)܃Kpi8$9#O*} ڎHeRk8c/?B$x*sb^&J NKZ&s$v9qʑ~?_$J!C ]k|+U:?jfm#>d$? iN\l4o: 8 f_)_B!<"aqr(H۵r?߄>'`y|ֽϮB҈?#K{~!.D}L˜9zP ȳQ܅'NX;8q{y_1~6y J,H_p?D!};,s鴋ZolAqR=qOidhMѷz 6o,duX҃'OH l뼀w;GjfʨH#  BC`fH,,_0%QV݅d==ClKƔa܈ȼJTeЁXY<=H4ç_yFӍ^pt(b3걚ʛeAcMGnz@qV5MhL+Ħxx5p3XIڻN^> Fl|Bib5υCF+Q99]k׆  Ej"Ϗ;Xϯ-AM+bo&:N3M0q3:g[M:"RߡE*t7/*zzYK7W@Ӹ9O?NJ?݄-Qx FE1rY3!K6aw6* /݊lj~ÛgBi6w18_pq#x(z4d㟇|ct<-fhAHɛ Nʳȸ-P o.蚚~Gw!(-v$,ބ=@aTZ9-,&?8=p']?7#w2beCSR䘍"9w9'6ETo6{xZ|Iwgr,?EP@y fCܶ 3\2q)}~H l8V%#x_ _|Gw‹š:p\[h5&)\[ޘ>9>Dᖡ+&QA"ZQަƀC SM[ R4 ~w+zkݯ}ڴEqJ}PQ=C}hePgԲ 5 `9ֺFhebmQZϞǥ l.zoV⤎rՓ/PRgoゾ}I '!\v3nVסG.~u)"WdrML8vNӌ4 %yaV\;݈*ЪHDR8N3-:̃B$?#2F$;'a|vy( <|fԂwUH;/֝i*BoJg\-_|T1Y?W/ ڃJ2o^;'4ee{Q]50|q6epy|qExlfjwhӏ !nA׎r:$ IDATpf)\ zg(] j&̻:f#F cc-Kcf 7)1m Can'R#ln}02I,x&4quJDfEx,^[ t,^vEZ=k\.XmfRGDq:ȤB 9}%h$(~2;.>{wƟ / GfakB%8k=ұ?~u+VF LP,zcLT^d! "jcʵf@U(%]T4n7<.n:ia2$̱8y3 ";٧ <'>d[@ ǫӄ.3S~aW}ύC2ߪM+Rdѵ&X1NN~^Os2nani`~t0͟&}~ťX)ƯN60=>?"^&x)ʖxKt;{ pjQb`3- 8s& z^>l(mQwѬS}QヾIn⠟,鳧n~( wMhWnn 6Oq.7[S}'߈k~^pr}9hYPy~dezᦋ[go]CoH~>/A\KA&n"Դg52E$ &HhHIfDizf\IRl&OoTw_؅g#)|=\* M8z0^>IZ.R83^>d?% .̕H't^jJ=+ID&럒0d(M$St9~x? RO.ELϿ6f8wEx|I4<(ywz~bm<S$R }ֱNF5:ytg_>l?P\w 3kSh7$랜h̭Ldp~[[ U[q-G8 kv–Q{+ۏ_qrjf'q֌>@L:Z;ۈ'V={kɖq!,u`]{kX&B n\(BBv|Nvu>ӡL^G |d56z{?K_>",R/;ٿ\{_L= o`n>\ ݶ:p9Iѫ;ccSaՠ,f[OȋG7:J涏w~]~3YUZgsb9s2A!.@.޼7]GNey8ypO/- p/! {IZ`qcy~=2)eeQw%}%{_! gҝ#9G`|\Vb#GoSnZœ{*pHNw:>m*;zAQ恜E@@@@@@@7hPHӋ;Ͳо 0G3'FYe'YB]n|G q;-"|,I)sj}Uflı#zCes(![1ƻl}}orj_X|f;M.XwlOF ET;pYZ( p `;sp#A2icu}Wd@d=5 P/ށNep)YA)r>Ԉ&m4a"i"Ң"Y`#_^LjE]WŪKb`θ]]7>@6Enm: .j!R qp0:E s .5MJv54d$AR>~%*lD$E.4ϷEP3(q둦g?w©9 2e24΀O/x²Hyg a#D=19j)TDȵKgO3>}┵y<6 (L ZP }╬齝d9e zz44M#&ml' hHÝ0?iK[BvգK0:_@moDyUq<| Ѽo>ҪH5?j Ha42T/xpQ:Dp{pYn4 I%89 A=Z9oU!P>fm#X?J_QtdzHeR`$c)N9 Wx0C G _Lݸ31xZgRiUaf@86ftۊ&]F]afe2kp)"UYH G  -{=:VE71ӯ zuoet(Gߎ.:h^^ٲq1Mh 7C&2P'b<(hM7BMHٽ9EJ0OC[0ҖǢwп$@=Sي-H]lB@d9ː?@fHDB;Nz L""i7BR1ۍAM ig!FEM-.\@!4k5vsQw#,!Q9Czq[l ݐ uRBl<#>mT_?7ϠMvk*R碠 z =HM[h/RĢtyNE p3)Tx2o 8C`Fͻ^D"T& z+tfh"23Q8MA^"h}*^XyXQ4\wiDZ\,Vdd,[:=ى/3Ѕ 0\^ ےE+Vv3{18` IaZtCC9v}%#:?ZnH>ڀRUx35C65$[{K [ vV8̜<,_r.sf8 a ُt)ڢ0zެɢǰ>W}z]e1ɧFt:||ȖF$/ ʣ(1 X+/N?6F 75"}+GY7n_/m3ݩ60!# bD2vhGmOiFՅKй?"/cJ ߎz4kT ҉(Y&Vzw~+[Kr:+,íR<2ϬY*rٰgm3( Fܦ"S 3lČ턇@hryW*$R/`KFP 2oȟ۠ @V#F=-E3h쁵~9cnB#+4^DdV \EмU4etM X/V {:QfS)b 5:ϔ 2!c5dzf(?ѨHX%ȊRBl`g~^}B#77%A|q)V0Lrf21z]ګ*:-GqILPups & G'tB$slC'ALҞx)ʖxK+=ZQ1|RpٲIvGoobLv{eKy+PІ|{,пz84VR᧷ɴn*3 *A\)4}paCɂGyy cbv(a$7TJD0\0YD"_]x;KQX>(ʣz?~^ 4ڑ4n&xAΊզށRRMʠ|ծM6`8[$H3)k7 YX̀uu#KMDl܈T C~Wc$(j/"R*Ȕgo(Ldi$a> )cPRAnrk01AD; UccT+45?%\Z;&TVGJJm 1Rn3݈NED.N=͈Y !$^^4{.tӊ:.+sGgo<>=gne8(]DH_8 #1&)"Y.b Q'OgpҎqG"1Y XA[0vRE,!%C*DN Nk5ei^;ʾuYRN?kD򆇐IugА{vWI& ˣK"9PDBПօ;^v38#n\ɤ]ȁ*v[7F, uM~2i Y5Vպs8;v?V *IMV,-So3>~BCxYm` ]ա>҂}="s1@;_6j/"uj$+ "=p&n42 f݆N2|6ۼvj^~.k+<_0֊VI;{κ%!Q@@@@@@@@@@@@@@@DCyӰ=HR?3{`! (ʳM(% p# (f([WJlƒe[ŭ#db.$-)ި eƭhspy=\/n}IG'5[3y?+ A('kM ޘߙwVUD̷4iYom]XO}eLZAQ⹧j)@% a)5HsF͕>WtG{^D4ÕnbomY{ZL}Vݑ@\2F8K20Jt(_h)>" [GPUR*) .OBE(EDzaewyddEWDT#Obe2 61D/(ߙv@(eU )!S%UqOO 6/RAYwa00<\SO߸:K!{ ,ݽn-@M)O\(H2<U;ɷ#<\'##Fc4Ư? /D4bTc~Twnb6`AD8o@^rKpc|-Y+e4 h+>I<_;Om?h^~T|z R'oz&!=X_C Mi7[dQW.=]jLغBZx ?6)KDpz|%sWJr!f7fDjq\3A\H%n8g;C3Qihx?_tD~%@L#ڡ\ C?8dn_9Kᾊηo"| c4><GcV?\^oBO[opw4}QZԉS4BSvvߥݹ!3>6X^({+TV}/|SC}\]̄T섳 oz~dZHM~] B)͌Bx$6ZG?}-x B$O+{ }-L5\t "%ڻeCKAB IDATxi;2߼#ƍ:*MC 65g5V 5}$(s:aҟ5f4'=LzL\HUh <eIYX`>J2ѷujE"Ey*"e/^mva !!Ou x4~w8f!~N[mq"i|gS:>h3d/DR᥇=ˏeq ?iBcZ!6,ݨŅ[ !lKƔ^u,W-$-BwSC kiam^;:t#,a$> ǁ،zsYXxЕj`UN{[yJetl1'tn$" |㟠l(ċSśgsph(3Ainj`l%҇2i=d'MH^a8L/߉O~޾;31ɫ!>si4ޘpDDRbWAA ǠLQ༌H6ղELt3 Q[2ּ5sds'>L, RHh:b;H~p f["?B_.$-kT@ Y`4"di-bi 3_/H(Ȁv|Kʗ~^ydg:޹[ բ"qWZL D*-E%Ҕ'-{$i)2 ҴǑo1}=>0 3])_}[?NSl_, mH9(pa`Өg'BX+RA(#㑟14wQ5Sդ$a&6a ERѬA*IQ12UY,GUW#Rwy /s:QU TD%3U8$oLo7_w߽zv }lWac!)vu6M((Oa@MqE|4\k9ЊG>KU:w|kb)6ZSlE>a5fLDmo}Hd Ԃ ahFy1N4mq0HMWΠ Z÷x_541DseԺ<f- Ct4deCJԅbQzF MtY4 omEߨ4Wpi[k]#04p+Nbu'C.fܬC<9 C}$?U>Cq x+#i?U7?4A3[+Bn_FXM`)J_ Ih8D Lb G/$XhQNd?tC7m8:*|I?eو,ҟa!1ˤ mq3}-< /S[bD2c|o$':.4u_:GD!ޭ +÷4e)B4I)/Wyi' w2_Rr253Tz&4^+JDfEx,^[Qp j&lleqH;ֱ!cf7)ԴH;>!}(DjmSyk[~G{2OPclN:UXF rZT$(~2}@]ns}2lfRGƽ2RȽz,l-]0(zO ) X/5Rv{:Q?LVF%FY6y-yTN=m$%otsaB.d:QH] ij`mbϿznD:)2t|.R&A&6lm{m>F:f*0|'h.ˡ!>MI\]7 ۠5D=TM (uz:-ļ(1ۜ26^h1|W<0s\q7WL|<ɝf`TP启%r6{?c}>O>xw|_X7~%1[:M4‹iw.d ‚)ł.UO&1]F^B 2~]t=ϤKQ4[|,\)@u%mDnȫנV+RӐ<Ȍ@aZtL?Hxsr8c\ؚ?CWa**8~r(s蔤83yez W4wh_,CfvJ ?ʃΛUw(cq2ON, 8s& z~>l(mtB@[~FTqfȨXqn>|%,}CI6>T}VRJ<.m]##-X})Ư6dR&^27˄a|=j(S[ȍ!?WkdfAa8JV`._ _ e.1sZawN;A?j^ (WiE} 0~3,|t/.|E>>H6{7GY x?6˜l$Ux"HXF/vGsvakD@>_RH #w=%3}<FHB'^j\gV|5[bRmYgv?~e#ϋbG5jlXY=Wp a`];WG Ӱ*ʀAYNiIN9?b:xǴ$ֶ/UcvHE oW(֓] 2p#$vGɆIy|"1ArFCGJ2q$J]՛0zϼ6LzC6P& A]YHGvJ 81C(jU-ﮮLI8oRDc}-8uЉz.Rf(,Vڙ%Ig :q&* #th;qPoR|l% ۡV^?3IMP x!C贅ilO<)t%Mp7e1%MUN]^Ei^@]/oyd`o$UCKq/ O |ǁOP*T*#L5dRa%%Ə84ļq~`+لt|}g[^ `;|?;DHIXPRY è5X7nZcv)խ"{Bznفhg$n.?YiJtܭ#/Q`l|c P:*BF+_qCfW#8+2 2X>~?}¼7@ _GTr<ɏhTσz_#6>O?|nC`7s_@B.NI\3ar*"/ѴITu'GTZxlLor?w&] II&t EG2EHGbp WRǿ#A嗥i?@?8Zu΢_g>EÏGsj*׃\O 4,Fc.`iI{ +5X>Sh1:F1HH @`$FQDZTX{}{~|OrX+ђ,E%( " f M~5H}{oݪ_[nF]n v?TԄ`Cj%ŻNLNq= \k^N_EIPCCGߵaϖgGBkX2K]#wzН:{nO2%:PPTsY]{}#5o6ËfbUC_xkO$ruN7}S;/HGªsO0]uĬM+W!mtDPRΩgpSXMCDx۽I q',/Ή'?Me#lO>{ @Cd߽s #Bp.*9)AȺ}΄ANBkH^GMWWz:WpQ_c'HX! /0S< X沷b{O?^isKrIsgo\i3#'.ã㼀.by b_%ڃ(*6нȠX~bnF6fܑ=(*&ui<{^{AIAߦ$U%O9aMʡ0}T8g'ָ0HX{qS>vb?xo)N;|pQSWPk3|$8۩ij_"RNik(U$@~cskZh~_h9!*afYؗ.J:VoN$ W ؝Rj1MRL-`2~s6tP&Q~Pp:d]Q\kš>jŜ $|ӇFGDN?̈ ;H<`,8ռ!QuZ+QT_4r +aԳkKG9OBz|]?GU9.*Se: ,T:W\?F!P#@Î x5c0 C!Xp^̴}a C!`0K aM~%Wb“vD)F9 'Ǫ͍ϨD~Q~-<9# ǁW]-?k9H&/q 0Ü\sG"VO fEg0;f>!?,^yZ<8e:}Ӑj ~)4Kܸ`>aX_V>xp6Z??fw}d*Jݘm1 HV\r Z> Ȃ(a0s@|ۨTP nOE\rQ)B{?jѠ uQDe RGI(=mhv(N!#, /GSQʾh{F||5x"r٬^xCW5Kd.Qc!V`C_FU޲Y/f!-$ӌC!/zU@<DUȈ6N"\- 5T T$DzF')|HA {UX0% _{ΆD 7䩻Jɛ߀99C/f,KGf T"w fTVAmrAȳ/CMAlJ4VXp5F$'"bQU5<^݁Z:mr t+fMJtC7s{g_n%wpbDD+k*)J5h\W E(nFh b9"HmEpz(b;l[cJ  `+L7!Z _/=t| xg{WRpu^TUiԠU*c At"!zM0T!mg>[*2t)ka*j偉ؑ1r^ݨ^OO`h>/ݤV_/iƝYo~o7Z~HOc[ rK7(Qě/fQЌ@ɑ ^*Oa"*'G aov*ל\hYy~*RFcw$nVOFw+؛ ?vjNRf2 G5ˬu+CF-Y67Ü/TTWS%ܣHʀ|Nt")n %P*k,Y9SQI8XuJqЊj]݈I#圐w§< _WH%6U .EU?9KFo΁H9 Ћywk C5n2vc#tk5-41"yĈP*q dp%ڠJ;`=s:a/Ż5v(/]<^dsS_'~ن~BG!"U*2:7cЉxX5=; { "EEb2g*ͭn`0.b@8VˉJX+b*hC|nG(98z;?EiKq?7XH~_O? ,j- wH&>K󇶤E!X-[P&E IDAT<6D'?6\FD PerV\(hg?iLHF$Uu^)HDn\dAoGӵfOW] .) U%3nGGe+kjV Jhh&܂e8[cmF|Md6QcN:vnjr ߓ:f!HىLϋ(;`05P з@kI}cK@g;; _(z>H ($ !0;k/1C%dyV/G5 zAsca N:"ACfjbp C^V|sc{%JK;|C#j>;r90ԯHg!ߑ2P1!ҋpaAi@;J/!鰡//)0Èàp[1F,Ӣ)`\Q@[+L = v&T}y?xJE[is&;ځ1I4$+!np|У0E߫+Ʀj4oCNMĮ)w"Rz±Ũpq<$_((&?t`+}A\X̛G?19t虦c!{Vp%Q޾,=Z R@k;ѮK|r6%#-2Q[`o!E ,=|d(_Gtl\ڪjܪPF?$+&K淸Y1omGBmw/}r!#19 y+SD[])ީW! AMkan}RõG M6<4C;y= LsjNw2C ,ɩB =!3~PlCa[^5Q6;sR S̊uӘc,ѧLv7 +l> #H~1}QҗbkvC!x@ ceX92-t:LXj4L}}a0[ *?#ByA҃k( Q^s(.+n B&#^~dCPkioI^r <*MU0Ng* Y,UcڕKԁWVt Q: ڽ$_P%r m 5 Łaü@0[i#`4OhF7)y+\?߁iPzaw'}0ApY\N+VI IKOv(|Ȥ4|H(k:#ԏtDF_'U _#0lx.Ȝfԗw@5)-rě~؏`{Na7@n XxA-EKHw$>"w'A4]G?9-l~NҰd%X~JTa CB@$AJd6ۢA&e>#Fyv ;mnƩoGNڂȤhQqxS<#=F؊[ 6^Z-0Gܧi,;)vfEHHϻr Oi"((|x'J[`$mX<7<:5VBU1\pf#foGC&@IbKggs t BY7T_#(۷#"ve'ͩۯ/2rO uٹ QFw],(pKPXF  C E^^>48[aBakJi~1ض.j) ux<:t;,SW XOƩEUD"7_;(ˢDjji)kSEw ;S%B5ȔkQH9|S M[Nk)$,>^,',wgGy \^g CE@e.}彆IFH (|yGqtr.7n3܈Noz>ŝ">=4()1r!dp#/xp< Ved C)I~ Jw,B{$"XG`\ jl{i]cFÙw :)=\?+u!ÄɐL eaxwCmT:>\ C!`02/\Kqq}R}tlC!`0Wpb0 C!`<,Gyv>ɯj\\xsӒkkNr*bsalC"($I%__@=CyɆs# ⏿\WlÿΡf|ܰϭU<#[?<779!oy8[sn t|NWg5TnGYb%Db!/ "q(]zL['>?~"w:@v  >xCx&l AϷӢo»|}E@iEM`g>[/_ѐI!s& e2+nSwjd~G0ӗL,Q&z%zȳ/CMAlJ4VXpWy+HNjEJD"o FUxwvlh֋+BGD$l5}We6W.oM4nt*D?D<*sz!PSpRC͹N)iL5mF T: zVfK'_C'fJxCxy4js*ei-iMٶDBb `R6Vq-K5" Rt)h/!G؝1u[([3H"[:͎GR[ׯD:#֬EbM({ɕo<ȶFٽY^΁T% cE;؍zl_7O`>/-M秃5z#.ІzHV"YǕ/Ox=~~NC#~lL SW#._B2/'$xthN p3,AtG.zMD*ANk?.`8~h4"#Qě/fQЌ$ɑ ^*Oa⹧Ϗ#~ݬswmrUh8zh]M|\W?"xA>H]soneLJQ3Fe8__PFc3>x†=pfg(Nº+gw nHCɢQ$UXDIQNՍ近4R ip'|uWbsZ Zu_4^CӊlIęp[/BqjT<軟M\ÝPebL3vU2s\sCrzj ~)4^E څzC;!FHX m ;XptJ;y ڬ}[?"*/ݷum߅&t TMO8:'֫h}K"#z~e)dԇ1x9F9s=d6r;NEݮ`ߠ,Dsv N ZT8c'pN7 "6 gᭋVe7^ߜKʑyv7/عo;TcOP_>x@># 褲Җ#=P+Z'ͷzQܫ8o= DSL=ӟkCqfx.+wۯh:< aR{]nI2pu#Aw)*b4s2L|i 8h%R->xNJzeqy֏Hէ`kZ0N\ð&Fmt?\|'_+ 1o}nkgwOoFGU|04w2}pg"H` tXϼ>,?G2 j`= tg?S|_~r  ! SS,LR[ܢN֍ +7 ]^:dе$G) 1E*b8l t6 5!B9x8~FNڌMx+G~>.ܱYJ2y(*CRzpB{mB]*1]pZai1fy|FP3yM]4mAN0pI?fA@fck1OzwR)Ku,61$ jiDe7XK`$?Ol~f3?S|a½j#Rb~(k ]G^&la$JoV Ae|!xr 4^d%fdbL1^g_7}R%8dP;ɋ+r%W6~V)z[=~%_\> ()/"t~T <^*Eށ3 Ag!ߑ2P1!ҋpЃ$#A?dLN+HÆ.W_P); c2-  E  bgA/S}}-ZW^S'Z4ml9x"RzBbTЋp ws#8mV ɐ D \^}gCH?8{9 Z2_y ځ1i6@3 ARvA.)TJ!yPvBV?ևF:xĭ?Ѯ}:L_ㄱ͛*ES+"ao&A_+?Íw68O> $ş}>MDo% M %gJ):Zݿ;X(uz?Bhd(_Gtl\ڪjܪPF?4 ?Hoq?2cǷLֱBmD'/}r!#19 y+SD[])ީ;n^\!; ~7: Q\O ~v(7 ᾞgLsfAo e=p/ 3I.t qQ֧r*~sJ=lSQcSI^\'yw"v(\:4ORP.J!1?7sԡ3SlY#ɣMC7^)w>Ĭs\--*~W0)N|׏s oyzDp볳c!0.Sdbstv3&Z߮v+9&5~;}-Bv(!;b|Cr%i}Lrg<gfeCA6.U\CEMQxP;FvY .Vws_2@yF$\W}^fOnaTizq '\?}xlYy!P:p Vt Mѧ) Vkw r8(;c!ymMÆ80b!A'tf+m =A۝CW~*]ӠRr. /SMݩXUr +XzofCc~zADN~֡ ?/D>w ʎF Sgb$ wxBo; 2">[Z!W!)/OOXaC(DH+KuTg4)Hi#\w|sa7ƽ>{Oү?|/p$ $|}Ö4ڔ8[> ߹~Dž1kr(9_9j "Gix6o !&! mu'mlZaO72cY F9wRr} _.)CeX%3ODidM|G3w laAtf7|ӣ!K I@؎YfeIs t BY7T_#(۷#"v\A؇n 9#3s?/~|えw};`hCO [6V<|4YL̚8VZ)OѣNC+sC7 3+-xC;QXO-#ϐ? Y1y5!ؐZ}<"G\ "XG`=PԈ4ֻƌ3tRzLNWB! B !y OmC vz w81_7,x4Z!|wKKJ.in.e I_QocPp>Iҟu?k@Cs4޵aϖgŇz2 ?Trg(=ܡﭠpzѻ:x3t7bJ_} Z*oXA ӹyI6b,/ov 0grO['GAQ)ڶfrmo/ IDATbl:tFsKM]w~Sˣ?6G)* u:^:UxW ~No5ٰ2ujwH>,T~bsdGluq_d(V^DžحxKxfkѹ,M<*pcfi_mƪŅkj^,uB"3x%\<7*=o}⏏ >gDo9;G8 73qvmvS5VvvNRS GJӕoV?Ahlȣ /<>dw;~`0/oձ/ΎP&Q@;🮄z>?(ټ GA؛Ʋ&ozXx$QHpHÌ䅇Qd,YkAR丂Ɯrt'1~KQw B!Qr?.Y솻xOT C` d(Q_*=.w&7C> @>{Ea*6C!`LF`V{ox C!`0 (?.p19 , (K\1pAydRlÿΡRoF8SXnm9 X3sxP|&#G:U<0p:q)1 fEwtch} (\|X;C`)"<ʳК'oyτ=vf58!@>?~"JwC߃塟AAϿ@ ȈXuA.?lx8 ~(`R-sE>A`yS}vx `?,!CYT6YT85Z`VF`=ؘJ]%qMFOzhnqi;=2O/!ld D?wrSD*1pF=tT;ヒgqGH%}v*.,A,G؝0u[(SYpAq7{֧Ak86UrC_M秃5z#.ІzHV"YǕ/OʻK#EbM(zɕo<ǶFٽE^Ãĥ'{ETR'j\ttlP">{F@({ g 8 ?@;9B'?p!>\n7s~9/>Thh[>'@nFn$ -w`߹~dzJbZʼnra"9Rwċ^ 5L d~ͼIO۳tZO3y} ?ϥ_'\ j㻿p\?_A2N %d(c$R"[|~#:7V-OC^נۡDRvo=VhHPCOdFxv.ih(|j4n/K[@ \4EK)+*z^ݳ EI?S͎~Iq`}n#S7*'v N ZT8c'pWLŴjgPo, M;apFInFE+vy(o)w`Wp>+ʾC%8'iO^|uc*"73[Qڻ >3\QMDvUalگ*Fc 'qLB9\sp^x3;?UGx*|5jlNLѿ3g&VF`kZ0Ni:1"yĈP }|P\<>}} 3E=GeU?Ϥs+24d譸P4C0-)B^,[P&E<6D!rpڈ;2 QO\問|׏@xC ~gC 4 Xk¶~f"9s~TBHw=q2j"R6l3~Mq~ s7חIQ8^kTt}Wy|&m U\?^|W.K%Qv3LaAI؝ YQ !h3 95B4+#2N]5gmQMչA~pso}1``c3*'zn?SIN}}-ZW^6T6?8~D*~1Ũ D> a+Na#Uƭls#9mV BNvX@<\:+W7a ?a^#q4 )X qj&"ŷ}rĦXeu>7#L?)Z$ ԓ'LipSꄱ͛*ES+"ao ^.J\׏w}L}^w~q}J󌯐Ko!S9㾿ޟӗg|?E`ʴ`l:8<Lѳ)ʥ`QPp? E*S3{BnA:҂(G`St9]9ۙs@E =o35HB cet~"{=74!4v LV!y$:LD#u>{tQ?isRk*pYt+$qX5΋g)X ]aȬN͗}<"e#Dpo8~V$v>D "0G֗}KDPxlM( Q !||oxg ]?~_@Xr,I% ͈[*>Q؜;{^?91^:q<ΏB_uNB֗'y1v!H?xҏ 9OA;O0.gf`=i磠3BA5-m^LxB>un݊dJ`3um[3GzS Sk7++y2d)$C@ؔV-.\S'g9:Iܦ̀F\LO@BK-v2`zX3ov*JlNz(]RW|M1&FJp7lhxז=[{sQeytӞsMW<țW{PzC[A(-<'6G?6<$x՗7Q3ԌS.D ,bl:t9nozy=AZՏK)+ u:#נ/>j'7K/Cf^BG< 6<㉿Nzd\n"pfn֗g"|HA-臏&/q/8O!n:⟇Ƽ׏Ǐc< d`fDo9;G8y4Ӯ3v<{{N.;16r`YpH4AYF~|SCi$Ai U0ܯip :˃ςpÚ!X:cH*`0>y8p Myam^xp6Z??%>ۘ?'0(ۗ 'z2 C!x0_'KJ#bh݅河D)HbiE6Z8U4b5nu;P!jDYCXʳF `0 C!ƩsC(*"Qަ T6lENy*ңr [Y[v\KKFrZثŠ)D?X.)CY 7~ n\sMj%|1-Ǐh3E^x1LA~j0ohDt`0 C`J9ӜbHe+@zvRqo(́'s6:d IJ gk pj*+{6PuO%#z'"xE mJVDF,4]>CJp9ylMUᒮJH3WMw=h@(SV C!`<"ȡ AS\qCX#崷^S:b_BpMhޔP):$] {4!AB]/Sb1*Z^ĽNhP܃~:2 C!Xz ] bڻ >r6%#*&Fm"mu1/!C#}` 7`(2I=oaOGZl}*{7Ԭ\հ C!`< ceXd@=LXj4L}}a0whPA)wpПᑬrp߆J@ |\.}!A47QC}yı)HMEEAN'P@DKgӭĥbdZGC!`0"I R"G֘A&Gb'%edzx?Wr4.E ;S%B5ȔkQ7'۫P'Q諮Cה͔Nk".%tJ78h'2 L *gɌBޜTHl X$m3 C!`<,b%vϡ0HR"l's !}黦_BN[j0|~7hp U lX:kF,rXpM؋t8oikÞ-bA=*pem;Ia1~";L] bMdoC!`0by b/A~Ш6h;bm݋ SLGhFĬ)ui^{)Ͷ4󢷏q#]}O#yۏ7c+Wj' C!`,I )Lh<|k,bo7/5 v|pvC!`0pZ+QT_)Ce\_B!:>V?"kb0 C!xx4 eJV{(z̕g0 C!X8V֋Qb0 C!`p" eQH6z!AD@d䜂QG!`0  5}ӐɌ_ C!`06 k(/m, C!`0 1!] Az u_|ïb8>JhEMQAl֣ф"HmEpz(b;l[cxf `+L7!Z _/=t| xg{Wy6^"8\JY2L#aHHl^ UjUd oGȤNku*痲M4nt:&SBGqMj-kdXs=6'@aAɕoza,p?2?+""j\tt*爡Jڈ3UGʹ00 C!xPIu+W /!*kGo*\oB1dH]Z?@?"vh'd"(V.B[w:`{g,;?\qwY. =ET^(os:![ M:7ڞ,e-bGqtuN50 ~W 8!OD"hy>W:G9 [BF}]쬇:.;gb(jEY,A4Ku J$nCUYaRĦ!9uJrPt 5.M%vPZ/:1{Xi~_EyB? T_7 2#_njC!`0AXX/#j'jtIpu)LE+*1M+yM6|Æ=j&pb @W W;CT8}mYUDHzq`-:bh87 64jKc9:vp\.]CbJ֦op7\92 UHQQi較 F T,F?:`C[rE!uw 6u6Da iW`T[L. C!`0 C'1/n޹\,="@C5pt9G e!ߑ2B20$ vt8HuЏN2VٰRsK >E7=~k'Tks8Fm05;AIyxig)p{ IDATbh8mYAI؝ YQpMwCHS}uR;mV._(sa^v12lf@`%#H6[!?`eF/ C!`<2#e:6dǏ^p{oUGY> 9& AMkab}{õG M6!S J'XfwjNw2C ei[`'JqN5| I|dtjT&W&p0&ܔs T=/Σ=#GKaԗg0 C!d(;hXE5TD(\cobu;ܺiNLM6X^P0Z%r m 5 [0aO6FSft ; pT~RA饆S-kW"/9gM_jm־}#d0Mmbxq/USLI}%3g8N281`cl/lBhIhC[[jn'L޽,s=(MTs e2 IRUaHIΩ9N+nIIKGP!#|:8f}Wn=kϯ3[2Z 8C!`0 966t?ïw}Ĥ!xRÆGT4kUkE@Q.TRU(p1lG`Vdr $Ɉ,IuߛǢ~ӭ*:GM}*H! \jDY GEȏ2˃WjnQ#y 5yw^XހX)) ׯ'D?(i+47l:dF BfSf*4 w eiHRD{pp{JV []P4p,4z`H[뗸/``d\MYQPQN]D*(K>@ct@Ai+K>NW x>v\z!CRN!MBR[egH$ʕ˱:=Ab;LM8Uze:OfF˽aٯSpyН2ᑟ {ECEקljpQ/~$[wŖ\ F {_;ΐoI/A\~B BN8[0@84?ޞ?ljnZ",h<<ÿ]؈XH% tjO}E .ANAIQ9W˱\N|8ӿ7G4 qBR4كu.yG# W_@ӏO>>9fÁ_{ /?-~'LL$GgyzO\} A`jeT.Y8Zp4u#pX0;;NB,CӠq7bYϥB 9! "&_]P(lA> 1AsZ\t6ځ> .W{.6>1%[Do*jVt \svנ75 ܸQ h~#7@&2z bB(th~?V`UZ }_. $FO{-@%r}̄}A o3tjMԙj=ۿoЀxJ).ha8}Ct-HI}8z;;JÏ x/O`=--oH (I*z*5OCm}.(# 54|gy߹HȄQyJvلW P|b-_ Ȑ9(>u_ 6&:)t6R򱣤֞8"f"PwjP"5=^|b% -9/ A͌Gʣ(ti'?T߾³3{p೏PѣMx7~ jSӠ8v>`A̲|t A-*;{1:! BPճI(uX1 y9F`cX#>|h|zƍ>5nq@VئˮFhm~XYj J_>/7Ro _|_9|B,0qH!t^~di/xC/lh^LeI~ts|40*q }#Qq ۠níА\gH?C5);_]q"%y2ZdCWYr\9_fEVJGzik&ߙiv8i߂Ä7{`.1wZMʪqdԊV}Ɨ"),{=Cac#lB;(͐~bŧ?O9~O&$ٟڏWo2qUerbd4NG p,hG[ŏ?+:q̊RWx>U E'3T21L&Z BS]R%8U\@=3ڐ6Ӻ#EY q(V"4/l"h?oс_ x}# 80asxZ OCTIT A/gCdn&CiitxU??)5ANQn?1zX Z GҎPk0 Sc7Hq}VNc˖mj\m֢Eӆ뷻A3hY)dBJv'/GB[z4Q%MŦȉ bhf@?',F#FWmo*,  & ~]NG6 4 5L 1nwO'c$G~ѧGoDWC=Sxe}r$dFd:Kw VзO FKܕ}Ǘ&8n|#AhL= g"5!T~7Q;ͯߘN&7u!:/csrmk !Es b`o<>yƷܽ7,?ڹu7nzuN!&oeٱBuE^by0R2Q$YaNݪž7 .W{i8"Ysh- Qe@:VnB㨍svWVGOn.hm?a"  ݢI̩6$'")6k7zpg*j@9xJ±",֞ǮGL/ʝ5\_dB.39+O91Io]ʞ)Qhn|uU{J3>$ ygRf%?~S߱Մ;~>Nj~$ǃ^k?ߋ|6 á0Ȱ<ֆ_zŠd*w?~Kβ91qJ QHUv*:gcP]A!vl*Zf~r4@dODizw?~A!SzBJ=$߰?{mv@#H3iьQ$T9`zdVtXn2-U[zuM:b$m 0[ `OLR,sV]!4|qj&%:=' NPIZc'C$f`=ߛxv XH3ux2 IRU~ !"`LU5FhJGG?0LI.x|{{{ouZ)~H0#RoB}v:tu"&5ROg߂;pf"3PnT*mͨ [GҊC`W-0GV_?w0A»{A5KI"_0fwwo?A1y4t'd ܀r0&o1́[?qJw{}b/oן׻z:`>*4t(L'ltxk)░QI;zDG"@< ٙ[ F.іtxxcꌵFd5DPF&#E?ſZt@h=۳X67+G~Yվ.!"7y #*,)C6w+%t#>Jr#KEYX؅W ;`lE [c=rJK'HZ Ǻرp>94~U8 Og _J}(PD[7ŏikI"d!SF A|b/^x)pW$? j-krnxQ,nBP!||y'PJVmg4rpx)(7bI~hb*<7^rM, aZu F}cvkXqO$+*`u'?u\ux==̕6#Ùw0t=\a4FuH_N+=:[MK2F~&k!6}ၴ.GUl2aB>xh@Ktrq0l߆#wRn-!pL={1<]*v ;4zWWV\׫5⋯+&$WA\:wmx'pAT0PxfZ$[˫ж6ÒG?>/ '-X?ğERT+>G s]7?Bj_.Ƨذys-/bqȫu,'Ŗ/`ˀ+]/ Wn|ym(@^owfd L.j\?>)se&9[v9.N`t*E#Ŋ57 tӞ 6==0Ǻ?NL{v3 o t\Vp w ~-QC@1rϛ?9i"G"'DJ <*Gb2 AYc9hnsD=&ƼF`|-HYQ14d_>z3 @x}G.ZN! $6&͸t}?{غc3M5o YmkndSf Q~;-C 66k9J(N\>s'#._ P}[pfނiȏv;u G=)y{|8xMȸ~w% j^{6G>ǞFJ~X. /?lY_c&sn IDAT$ErJSB 7wJG_1*Gfv!`75c߬e"AHYzFhό07Ü?T%ʗUSI\` eHQi?Y@ح4YQR|DY!,ZJk s!꜈-(#T(hyb%|&LL 'e'$ʉ+-Bf"PwjP"5=^$NkfG"!#G +ɳ $jr`cX#>| OJ4 mQ{U OW1"HKJ_Sk,bx}}ۈp২٠JǎX{hWz";)DYpfHMtBW"C>D ҡ<~GסQfs?hı5Hy!05|$v7$Y1T#oG~'?,)Wx_$GJQ 6GB-l@Ȅ;_a&` C@Еmy#ThWh q`hd%G- h~JW$P%¨$ O)YY#FhF{m4YxVpiRi 2,GnVK@" b_{[}h#(~T\A);*Na_utCv؉ȣwR{z1dDzdj,eCȭL7LVJ݊ۇ&$b^R ڲni>K) Fs5݌[8eBn R Wo"4=EIE.k?^[wɇN;iGDj5RZor\6G`EJ $S?+-܎UHH)@IP>9 П?&i*x'`|TWUi 4Әvh?N꬐!`Cwul", XOh(qLzr~i` R̓e Bc쩆ֵ;)n`I RÔSMpᠯ.8lRY +MŦȉ b44G,6+K!yXZlF]+L8aLO!@3>gM-}W/'HbUt5ԣ;?Q'GBf,MU 1CѧG$>ш1FB?(<.]9IOⵒ~ n[o4w|eOtLH?zlWsx/鞰m8{`B9kw=h[T &w ^K^LKSi3:p+=9ȍS!U;ڽ~D7ZedoK(o+Dq 2G)!љV59˼q~J!gx?o\Si)1 hg3 K"!_E' pjGSo_\` :#Ckt3Ŕ=S6H5_1V/AgΓ{iEQH&uZM ,xBtC#V!)`WouFTP )Y`g^N_^$Nd9)ZF2QRӥ >Nج*I(i">4)G,L+4V%i8pf"3cD[3*<1{+gQ\8p"D~>`BD֝ƧG@;sk'kvp{H6XC!6"IIvu^0mf]ո&NS#O@$.CQ-ۺP^ۇ|+ 0810}iQ"##jJu26I-(k"iE2(#( cG'-(rZeC? ]AهfL,Bv2e MxhzہȴM}עEi+H ~tWu7e怱aU6]uXH<ƿÖbCF~HXrʚ?o{]RCd6e 7 e~ Y5u5=;&"Y2##\ϋ}yzožb.| Z_ľ/'.Ƨذy<)q_߀_\@퐓||xfZ$[˫ж6[a''anKz8jѳ,LXZVs=^_%U|>/qٯYOX-_-.VA NJk#B\+vh.»yc'ۨ4cs wẰ6-tRGRT|^FgRhq%bcxo?w[G\4~|^x2.߂14zu-V!`L<[>B6:`#)1,V)6u< oEJDnCD~!aM5\…vދڵӷwq3qBC!wȢW㫿e#a0+y;=tjwΞwPvN؀HNttzʷ"[a oh^5w4fl Noę+t+ 븀&1cC!mtlӕ~ބ^z*C!Xu7Q^~em*>8YKs_ &!C!!xpzQs yg2 Nϒ2 C!`0 {}(sm#kNˆhp&az$Rį/^/Aq߄?VL?ntK瑨o+>_/b{܃iy7;^7aA1Ʌzɐ9L]_r@؁q@^ߑֽ{ps~i?devlo]߽5|R'zNZ83ˤK(Df*ztYP}|m/TNVۇN}#n!*؊'o]=Nz+ښ~7G4ɝR:./-E=ZgHU늰>%rsaхk#_Ds Xnb"4(;{GM0=*x$ˊхaW."|Y nkż>)+ *Jcة0X!iѿo\Ҟw{|ؗ~< X}E`jeT.Y8Zp=]hSx mр?G?}d% UXX]WR "I]H,Dǟ>F'[K6-d+7"a >W ptNWu&ZO1D!xH$"!n?Dقtԇ'fdk6@E5ъ{Um﹊޹ %EB&GVm^-.@MI0%؞ك}m3OoPwHll~Z[oـQWSfBxy %:T)QRk~mKGݤ.`զMYqۛwNƶvʻIGQFji`4p챉!>.~l}^{ N, &:H+E'ra&" Ux]%RE?{q昜{a=^x'l kć@Xո>OnJϥq*;{AP *./1 c,+GTτ~Ч.l<~GסQff餱? Om+BlYeW#6?,\,a\%,_hGt8E ұ|?c|e7N[wl9܎fZѴ#GzSc%\sĠ03T@ OC51q)'!,{=Cao>xvڞGY?_yZ<]gf A+)Ex~U8SY䯆\_NiUȸ6E@D9EQ#fq.?MCZ-kԸLKMsr78ӧ>lb.kgoC(#F &mMEK ŸaUG7> ǍZlFGO'ݐ(f9R!#ӣϾN ufB{O7 U}/Dɹ1h⸭fE]oI? ڻ{{ng||=s;Bzr|*:Qw&.^GaHM\.|f ϡ0GqH[ vrH$~t+M"݆J b[K-G,FJZ& #+̉[Us&(w<ެ0D}!C"p*tS3$奪$߰?{mv#HcwS7Nh5 EN+nI^~D 0*$26/6n+Cj$LU4)d?t)lGcU")VaiU'o?i՟?__{ N;Z!I7m? P5qQgV=<&P!)`W( BTPO>}{k>|h@t3>Q p> /C@笇ڥ z c\ޥ_O_ޥ/QS$qڣ!sѧD!q>Ų{|.>:ONV}"0yF7qkw=HCX67<YZ+rɖ*qcVs/ffA&@ȒTP[4_4au#UEGh #:A"ߪbDA *~|d2R$S{to< [noHXօ>D#/\A6PaIa-qNA[cm&Hb!;L2an|+aJy@,cyL[~_ۓFD,#*(Cb_[̀\l 9-LH`͟XD}RB!q\Դ㵿ЎKaw;jJiO;(&ӢDFF,dl\2?a{k>|x҉+V #¡Ɱp\ >o_|KQN7H5g9$Z5 Fԟ&}2B'CȖPG J¾jqM3/1"P!h+ewm|joύ+ 0^dr9 _82W F3ahzg _WI! íi"_됾\BV:[MKgb:,xk4Y ;uSZ뭬Bg;W{;WHއ#u {fW O/NL47~SI8㹇_2.Ƨذypנ@kKP3Za!WN!J\3k'L8_^vas C)_я34s"΀ Yiǟ㋏D۾.w| IDAT)v?gFjQއH_|B:an#togWGMسWL՝ABw5@Led2fd4ǿؿoBym7/_i׌=[v9.N%t= ) ^z隨blqߣ,d!exܣXA }f ˈ1ExqM:ѧljpQO)8KW4Ђ3PPbZ/=>ނAYVӅUtvߙL)cIQ`Ӡ7QQ~;HT 񇸧vw=Pc^<'-C5,OCAv9y[\) h#WŠ&*2+=n)+ *J8bة0x+LqkO[Szhwsa |x.#k6p9q*U7^Z={N2\n-G5i]Wu}N2yG?V`0 G`L)eA ggGEE+aԎK-Re`q7xow:(х:!9+_\ah@46<*уQybU:T)QRk~Տ?+GN {UUB ^ߑֽ{ps|J5ywӠ8v>@ŗ`k`*ň\HC=ACx3whqhG(r 8&Ea9s{j~ib؝'ї73$/>劄Lś'(]s&Z\擨ʑZ C!`[G4 U\7WWYUrƍ{naߙ[hiGWs3 HL7LVM8~ݽ~( Fs(l7V%NsyzIxѼ}*y%Bjm՗pD*cGG)nnC#Fb+!ң{6]W=Iv=|\B݋2>00RG{z7_Nq&1l7B,}7?~R).Ƭ!`0 @`^(dà:Fh$H SBh}ӣz'Tbju=0 6ar&+J"bs- ڴ'&aw^N u1b32'GbSRC1e1 uh]mSj-6\Gs{ޔ oLǏ 5}Yvڬr?AY%C!`09bLq:1w>NOYw)*ޤ9 *~׋hK°",֞Ǯhce^`pɉHx4~{=4+X3Z_~&4O[Q@1C!`0fyzᴚ9$A{ut)Th>}Hq DƆmI_߀_\@퐷q8Aң8Lmi]g@U , TCs޵ч8 ^SZ_Oꍓê3x<|͂bo7Qz?8;piTxfZ$[˫ж6{T[0qvk_Wbwf6lTU+/o{c̽ccϛ`#wYOX-_-.VA p9 #j1 C!pokojSa왻xQ~ }/{ C!`0#UՐ\֬!`0 C!01sC&C!`0 y-D~&Urz.T$MF!`0 [Q~`0 C!093?QayE"&} o[~[ޙz W#smyZꊊu%ȐώMrں!lۻ?K}!¶b_`ʩ]w C`#0HG*|wn(̱DOCt cx97mfll&iζEZK1Ff{B8g(.ZL1 QvRXjyL?" s ꏳ`ϞL ?(2 C` 0퉲Dŋeė@'ᑢF0vy kt" pz"M;WhD pæCf d6%nfBk}XEZj+ңQ0ܸ1^߁U-.(GM"Җ4OS|Ux6WnrG?<3&H) OrNGタѕTDNJl@O# Ahq>²" a4B<4#pt%3@WЋWqwY^ ?ʣՠiho(롌ArJ 02!%ۮA-KQK!RZt.h#]ښ ?-G+v{ % {j Io0.nR`d\MYQPQN]D|i$ +QF-ݨ,=\$XI eVG ol© (ӑg@IľSr֧A38Ro]Gل[_w pY\ZמAϱѕΫSPResr;Ag|P .Pg? B4sٟ~ ey˅34?ޞ?ljnw#?il4e?~<5\Ic!}ϼ8p!xi)zr,Ƿt3V` 0H u\* ,BAr]-Xݎ^I;A#(]3r@rJTiЊX RqυiPIugÚN 9Ljjo: @ {TNܻ;ܚ=N jPx5pF+:~5M xc4h"7nDTDZF ;KX ]%%X},(ŀyBߗy^$b "u\ߦlF$,3s'0R6CY $<Щ':AqpBD"-q@; [Npvv?9><^7೿~Ksƿsҟ=vgh*z*\[E=89NQE ضЎC>By˟Qs4IN]"T>EB&GV&Z\A FLDY JNjOӸ5s ATFwqUWMW7˲lKdUႱ1 `6`)ٰ Ila!l `ۀ FɲezhިX53Oq9c},w9{{{};?e'2pWm50 D b  F2VC+=vNkQvDtMtG@u8q+d4}|VT? -?K7|ޒdK!Է7/f#\#3'w-^&&$36bLV&0ޚPVѳ/WW>'c^̆Iׇ t1@ u͘2j_rm)XymH+wFF Vro;c;}K7Z~Bl#e8zk{Qf#W!ۖ&7":6 tmh8^5S9sGQ}}=w3-}Jػ &tgQvR'GȄ,S>|U]?}KGc#].)DBvQЯ.CV $= LCem$[;-.so#J[zGsa$OJK8R܎^mrhP"QԤYUh@'rQK?Y-`Rb\<ƋbPv,RkG[_MlX`p `ޢH%bc!>;[ '5v,DUZҡ$;dG"7ԘCm>%YŜ`[K4Ӑ5~%4Y:~npvM aK;pi*>3t LsL % ʣl@kYu@ଐC1klFU/ Z}U%udPɋ+13 A}P#Gh+M7Jx @UtJXltZ4عB)Egǫе6Bj]GW9 2zKbH:-:=:!c5 ]S=`c#7GkUe(?joD5d0'i6BvCU(i3*j˸6n?T\ʸ-hyRHNSGUQ&v]G5%^$ñ,TN'][PѨQNԚɄME(]0DxO"amuP۔wwT 4!~Xf6Vě)jɨi";߻aGjRFGEnAM v (W @iieꛪ_&n4wz¢s3ͪeb-Ҋ0G}͆xa\ykӿ-0]m2>L+g(CYG r2N#'<(F9i4lٚhQͦ/T2#ydSI3;z)"QvFl4 z@T 5 yTLx(9f 15x JԉQ&HXݭ @JvJdWZ,7 vhO%mǠ!ufog4П'j*9&]9OyhSakƚnWbMx؇&:k@ٲxqU$m6_0Q|S>;B{YW:{~T 7J ۩"(H:'~U#fxĻy~",I&A^Ht@2ފ O .~&l\]`'\th1oÈ-zǏ1AM,pk~-_׉N,J-6Ei7+7IL! 8am0`LN$0Eb+oGMbdkTp @o" Z7pMvuP7cԦ] ;FO˝45jz||M+aZj'^ؓYqF2Mq6wn/Ggz8s`Ȅ}}vpB)#^+­Z4^hbu#ܙp (3c2[xle( :Jh1a>bG`?ɷ!㍏k:L!A!banLj⓱n/< fN"z~pu 0Ëd~9n#b2ÉV]eΰa b0>dpb/PK2,$mL,H#bГf#+Ў r2c-Cjհ 6?~Ə7-:xE/CIZK1f&}-Q"ɔ7+8Tu@; 3ݕPz"11˙L [F8 t7R9?-H`tēGe xa#.]ÜiXH^^'KU3#r <0/2CSc3ڊV`-)nn|Ϳ2&pcŷvԸVMv$%J7\.[/ݮ#,ݱfz̪<6ne6Q>k[RuXNL` L%<鿞z;#a/ =0!vnv/w2d~P6Hyx9&S1eL 0&p˷aIJ1(CnzZƻ֫kbL 0&pDqjo͇7YL'o7^~n (9kd*ja<.|V]b `L 0&l(-=z2&`L Lʓř`L 0&l(-=z2&`L L(CYc. goZ5YHaI˙`L 0&M! j׋Ttǚ5E{!f甅s`'7`L 0&&E@︈s va2 $[|ysorbL 0&`Q#jѝ9_K$t=|-r#|u$L 0&`w9QFJo؅."r2ȣ\?0wygL 0&`Qi6W%$<e)gQup$L μk1IDAT0&`L`(CY;i>S&Kay &`L 0&pe(kFE1u켱z8`L 0&Ln1w''`L 0&n*6o*nn 0&`Lv!S,'`L 0&M% *FYepSߘgw-I$`L 0&mI=ʷeL 0&`7('rlز1AUŽio; gEC\Ǵo^^:D!o*< 9"Ft' ^ں2Idp PD@A2^(Gׯ2 d*{۰D/P&Ro¼i>yxWy#[x'bu&6~Xa vVGjTR9:^Hp@"!k@~KtĒhĐGFߋʂK{MZO~'`y'dzt5 7k .?ؒ!Q+Oz@ X{8`ڇP/'-yÓ1kr 78S4t zBPtVNڮ\LK2;b [ښ:>U؈ 4nA { # }r2:Vvr5F#;䡮34t']yGi@+[|3/O~zqT#1>ZC_{ g4 Ο70c%Jw̝?AP" c.`-NJ_7bR2u,GZ!Or_0<9rfP hx2WDM@G;+6)C91RyOj5 YeعJብ̇d8JQf}`H\0]:O Axh2wcnL&K.@hw]A8w\|1;*NзV#=4:FXXr*t֓\ E5hi2x%–Bc`=qh}9B(ܰxE2GoX#GBzj6lH)!m4~fiy qStͦ5Lphee.g.W'ԿkUҖ _`E7(o8`O_kq=ot yyRo#t7?\I ~a-xP* nWƃK7~W숏ʷ x?4n˃yePO1&`INI H2)׿;sߐAu ނ |Ui )ʥj۵e+'䎰]+y{64xl^xl7b)>9~|lXPG 3+GKQm@ҍK(h|M}dJe$%`O&˭We궖*rzhGT= 98ɡnhAc^+y]bq4 NnO-\#R`KDW1o8S>p¨G-(]&_XEڢ"f?&b?Yq^\#ol1;K8*(v;:ufArEA`:- *Viߌ!1#>@FV>oiYVSyA,*(Q0 :)ȨRX^$U:!hBZM=e(j^S$L(ه{F3")U8A8'9 $4 l=KFnq3uwd7sԨ6 Rwx )DIe WSXܜTa[=o珅>tJ<ljW=4EopyR \F]-A/Q3B\|Iӷޱע:+#}5gb*1$ Q |Rnxplw*!7Ň/n ;9Z 2()\*ڜB^^uǰ\O +4M}rSx1ʁ~Ib&~5lERVH=z=Jtuꇌ e1.([\VwΖX섙e%א<< yJpcXzªhiM MG"MPOep`$ olw--M^S y.6&ɝ,lӆ̲PQl#,vo[ؤ| h*<} ]I_K7fck]_ë5h/?o~#/L $0iCP/Z˱rs$a;>UO؅/Í<&^6)'N>W9!x}X0{QYxso!Z]c*#u;`tH}'^9v0\!`Z B5Ts>8=1m(GXUNqS78Ĉ@zb5QgADGFlh)mE&G9ئC^'7x%noW^2˜$]?y/!J&\}0-Rr 2sz(tHr,5 Gf^RXcM\RZxd׋+WJQ=88p0>SI1\D_жbB@Rpz<-AA;YZ^ӈmxIP]ڽ e4wD׸d{%S[J C o |~ ZfjqRGRb<&gfL`DotOOW8+dpLsk8zgm&Oqlq"?౽F^lˏ,,;V$0;ZE苢0f:Zu;EFSEP8 l.G4B0Bi ګNMZ9ȓcPhC`  ?]IK=C>5Fۊ cL @M.ԉOk @ 7,>4h6x"F&b7EVlah9X維z.4 c9uN<kC. ]Pl{?};@OzRSCGw 6[GBeowFSAa^p-nlN]y.!7켱 fT2ruȂc0JتŖw'K2 .܃@}YpwEܲ $Ǒocώ^g?rAeyk7Olz=s\rxs?c.Y&O])h%Mis2?/V^6ʄj؃^Wgx=/z㗒 X܅?h`?R~'(|xX^|KuXIjh+S'qhN߷V3Gi{5æ:f{i"y:U m;iqx*6հ=H0|0+L@8<}I3;93NKl,[kBn.G BKrE'vFiDzv E@] m +݃Rz[#bF,B|Ezi1~dP#C#ٞHD\>"ө~L#[H) (\ðgl> `p@2׿(p6G mW{AOi +x]/9'ezݓHp߳}t*y 4%1|wo%t(OaӼyx:JJ['BV 襞ơIX>(S^67ZDң]}G݋d>8"P6`ay/xUx4sX|~?^|Crx뷫meo|3Z/_[N/G{MxjA6sݴ7'&qj*qǯO;C.XL9H*⅏-xmÒE1-gdL`;/I䞸oK2~̛$#ިiuz5h͔kIWf{SFD xf%Ѿ8. ۠pbL 0[=Y7-%0 #meH1n\Pi>Ra~La&/|> p@ 7ϹPz`oעE₄3Pv/2&$`n>Fu[m^+|䅦K!>qS_K9ܰSɭrsL@<Ms1(Ѡ- ?-dL |D}]9:qpcw1Nd~b:`L"ʘX׳.X]| 0&`L 1PcaL 0&&6IbL 0&c|t%+`L 0&`Ml([&`L 0&p`CJV 0&`LP&M 0&`L!ӕ`L 0&5 lM\`L 0&C ;+Y&`L 0k`Cٚ4.&`L 0;wLW"L 0&`$5ir]L 0&`w 6dE`L 0&I ek亘`L 0&7v1ڰ"L 0&`LJ?b |%4WIENDB`circe-2.6/irc.el000066400000000000000000001504401316355431300135550ustar00rootroot00000000000000;;; irc.el --- Library to handle IRC connections -*- lexical-binding: t -*- ;; Copyright (C) 2015 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; URL: https://github.com/jorgenschaefer/circe ;; 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: ;; The main entry function is `irc-connect'. This creates a new ;; connection to an IRC server, and also takes an event handler table ;; which is used to run various event handlers. Handlers receive a ;; connection object which can be used for other API calls. ;; IRC connection objects also accept connection options. These can be ;; queried using `irc-connection-get', and are set by `irc-connect' or ;; later using `irc-connection-put'. ;; Event handler tables are simple maps of names to functions. See ;; `irc-handler-table', `irc-handler-add' and `irc-handler-run' for ;; the API. ;; To send commands to the server, use `irc-send-raw' or ;; `irc-send-command'. ;; The rest of the library are handler packs that add support for ;; various IRC features. ;;; Code: (require 'cl-lib) (require 'make-tls-process) (defvar irc-debug-log nil "Emit protocol debug info if this is non-nil.") ;;;;;;;;;;;;;;;;;;;;;;; ;;; Connection function (defun irc-connect (&rest keywords) "Connect to an IRC server. Supported keyword arguments: :name NAME -- The name for the process :host HOST -- The host to connect to :service SERVICE -- The service or port to connect to :tls BOOL -- Whether to use TLS :family IP-FAMILY -- Force using of ipv4 or ipv6 :handler-table HANDLER -- The event handler table to send events to. The following events are supported: conn.connected conn -- The connection was established conn.failed conn -- The connection could not be established conn.disconnected conn -- A previously established connection was lost NNN conn sender args... -- A numeric reply from IRC was received COMMAND conn sender args... -- An IRC command message was received" (let ((proc (funcall (if (plist-get keywords :tls) #'make-tls-process #'make-network-process) :name (or (plist-get keywords :name) (plist-get keywords :host)) :host (or (plist-get keywords :host) (error "Must specify a :host to connect to")) :service (or (plist-get keywords :service) (error "Must specify a :service to connect to")) :family (plist-get keywords :family) :coding 'no-conversion :nowait (featurep 'make-network-process '(:nowait t)) :noquery t :filter #'irc--filter :sentinel #'irc--sentinel :plist keywords :keepalive t))) ;; When we used `make-network-process' without :nowait, the ;; sentinel is not called with the open event, so we do this ;; manually. (when (eq (process-status proc) 'open) (irc--sentinel proc "open manually")) proc)) (defun irc-connection-get (conn propname) "Return the value of CONN's PROPNAME property." (process-get conn propname)) (defun irc-connection-put (conn propname value) "Change CONN's PROPNAME property to VALUE." (process-put conn propname value)) (defun irc--sentinel (proc event) (cond ((string-match "\\`failed" event) (irc-event-emit proc "conn.failed")) ((string-match "\\`open" event) (irc-event-emit proc "conn.connected")) ((string-match "\\`\\(connection broken\\|finished\\|exited abnormally\\)" event) (irc-event-emit proc "conn.disconnected")) ((string-match "\\`\\(deleted\\|killed\\)" event) nil) (t (error "Unknown event in IRC sentinel: %S" event)))) (defvar irc--filter-running-p nil "Non-nil when we're currently processing a message. Yep, this is a mutex. Why would one need a mutex in Emacs, a single-threaded application, you ask? Easy! When, during the execution of a process filter, any piece of code waits for process output - e.g. because they started a some external program - Emacs will process any input from external processes. Including the one for the filter that is currently running. If that process does emit output, the filter is run again, while it is already running. If the filter is not careful, this can cause data to arrive out of order, or get lost.") (defun irc--filter (proc data) "Handle data from the process." (irc-connection-put proc :conn-data (concat (or (irc-connection-get proc :conn-data) "") data)) (when (not irc--filter-running-p) (let ((irc--filter-running-p t) (data (irc-connection-get proc :conn-data))) (while (string-match "\r?\n" data) (let ((line (substring data 0 (match-beginning 0)))) (setq data (substring data (match-end 0))) (irc-connection-put proc :conn-data data) (irc--handle-line proc line) (setq data (irc-connection-get proc :conn-data))))))) (defun irc--handle-line (proc line) "Handle a single line from the IRC server. The command is simply passed to the event handler of the IRC connection." (irc-debug-out proc "S: %s" line) (let* ((parsed (irc--parse line)) (sender (car parsed)) (command (cadr parsed)) (args (cddr parsed))) (apply #'irc-event-emit proc command sender args))) (defun irc--parse (line) "Parse a line from IRC. Returns a list: (sender command args...) A line from IRC is a space-separated list of arguments. If the first word starts with a colon, that's the sender. The first or second word is the command. All further words are arguments. The first word to start with a colon ends the argument list. Examples: COMMAND COMMAND arg COMMAND arg1 arg2 COMMAND arg1 arg2 :arg3 still arg3 :sender COMMAND arg1 arg2 :arg3 still arg3" (with-temp-buffer (insert line) (goto-char (point-min)) (let ((sender nil) (args nil)) ;; Optional sender. (when (looking-at ":\\([^ ]+\\) ") (setq sender (decode-coding-string (match-string 1) 'undecided)) (goto-char (match-end 0))) ;; COMMAND. (unless (looking-at "\\([^ ]+\\)") (error "Invalid message: %s" line)) (push (decode-coding-string (match-string 1) 'undecided) args) (goto-char (match-end 0)) ;; Arguments. (while (re-search-forward " :\\(.*\\)\\| \\([^ ]*\\)" nil t) (push (decode-coding-string (or (match-string 1) (match-string 2)) 'undecided) args)) (cons sender (nreverse args))))) (defun irc-userstring-nick (userstring) "Return the nick in a given USERSTRING. USERSTRING is a typical nick!user@host prefix as used by IRC." (if (string-match "\\`\\([^!]+\\)!\\([^@]+\\)@\\(.*\\)\\'" userstring) (match-string 1 userstring) userstring)) (defun irc-userstring-userhost (userstring) "Return the nick in a given USERSTRING. USERSTRING is a typical nick!user@host prefix as used by IRC." (if (string-match "\\`\\([^!]+\\)!\\([^@]+@.*\\)\\'" userstring) (match-string 2 userstring) nil)) (defun irc-event-emit (conn event &rest args) "Run the event handlers for EVENT in CONN with ARGS." (irc-debug-out conn "E: %S %s" event (mapconcat (lambda (elt) (format "%S" elt)) args " ")) (let ((handler-table (irc-connection-get conn :handler-table))) (when handler-table (apply #'irc-handler-run handler-table event conn event args) (apply #'irc-handler-run handler-table nil conn event args)))) ;;;;;;;;;;;;;;;;;;;;;;; ;;; Event handler table (defun irc-handler-table () "Return a new event handler table." (make-hash-table :test 'equal)) (defun irc-handler-add (table event handler) "Add HANDLER for EVENT to the event handler table TABLE." (puthash event (append (gethash event table) (list handler)) table)) (defun irc-handler-remove (table event handler) "Remove HANDLER for EVENT to the event handler table TABLE." (puthash event (delete handler (gethash event table)) table)) (defun irc-handler-run (table event &rest args) "Run the handlers for EVENT in TABLE, passing ARGS to each." (dolist (handler (gethash event table)) (if debug-on-error (apply handler args) (condition-case err (apply handler args) (error (message "Error running event %S handler %S: %S (args were %S)" event handler err args)))))) ;;;;;;;;;;; ;;; Sending (defun irc-send-raw (conn line &optional flood-handling) "Send a line LINE to the IRC connection CONN. LINE should not include the trailing newline. FLOOD-HANDLING defines how to handle the situation when we are sending too much data. It can have three values: nil -- Add the message to a queue and send it later :nowait -- Send the message immediately, circumventing flood protection :drop -- Send the message only if we are not flooding, and drop it if we have queued up messages. The flood protection algorithm works like the one detailed in RFC 2813, section 5.8 \"Flood control of clients\". * If `flood-last-message' is less than the current time, set it equal. * While `flood-last-message' is less than `flood-margin' seconds ahead of the current time, send a message, and increase `flood-last-message' by `flood-penalty'." (cond ((null flood-handling) (irc-connection-put conn :flood-queue (append (irc-connection-get conn :flood-queue) (list line))) (irc-send--queue conn)) ((eq flood-handling :nowait) (irc-send--internal conn line)) ((eq flood-handling :drop) (let ((queue (irc-connection-get conn :flood-queue))) (when (not queue) (irc-connection-put conn :flood-queue (list line)) (irc-send--queue conn)))))) (defun irc-send--queue (conn) "Send messages from the flood queue in CONN. See `irc-send-raw' for the algorithm." (let ((queue (irc-connection-get conn :flood-queue)) (last-message (or (irc-connection-get conn :flood-last-message) 0)) (margin (or (irc-connection-get conn :flood-margin) 10)) (penalty (or (irc-connection-get conn :flood-penalty) 3)) (now (float-time))) (when (< last-message now) (setq last-message now)) (while (and queue (< last-message (+ now margin))) (irc-send--internal conn (car queue)) (setq queue (cdr queue) last-message (+ last-message penalty))) (irc-connection-put conn :flood-queue queue) (irc-connection-put conn :flood-last-message last-message) (let ((timer (irc-connection-get conn :flood-timer))) (when timer (cancel-timer timer) (irc-connection-put conn :flood-timer nil)) (when queue (irc-connection-put conn :flood-timer (run-at-time 1 nil #'irc-send--queue conn)))))) (defun irc-send--internal (conn line) "Send LINE to CONN." (irc-debug-out conn "C: %s" line) (process-send-string conn (concat (encode-coding-string line 'utf-8) "\r\n"))) (defun irc-send-command (conn command &rest args) "Send COMMAND with ARGS to IRC connection CONN." (irc-send-raw conn (apply #'irc--format-command command args))) (defun irc--format-command (command &rest args) "Format COMMAND and ARGS for IRC. The last value in ARGS will be escaped with a leading colon if it contains a space. All other arguments are checked to make sure they do not contain a space." (dolist (arg (cons command args)) (when (not (stringp arg)) (error "Argument must be a string"))) (let* ((prefix (cons command (butlast args))) (last (last args))) (dolist (arg prefix) (when (string-match " " arg) (error "IRC protocol error: Argument %S must not contain space" arg))) (when (and last (or (string-match " " (car last)) (string-match "^:" (car last)) (equal "" (car last)))) (setcar last (concat ":" (car last)))) (mapconcat #'identity (append prefix last) " "))) (defun irc-send-AUTHENTICATE (conn arg) "Send an AUTHENTICATE message with ARG. See https://github.com/atheme/charybdis/blob/master/doc/sasl.txt for details." (irc-send-command conn "AUTHENTICATE" arg)) (defun irc-send-AWAY (conn &optional reason) "Mark yourself as AWAY with reason REASON, or back if reason is nil." (if reason (irc-send-command conn "AWAY" reason) (irc-send-command conn "AWAY"))) (defun irc-send-CAP (conn &rest args) "Send a CAP message. See https://tools.ietf.org/html/draft-mitchell-irc-capabilities-01 for details." (apply #'irc-send-command conn "CAP" args)) (defun irc-send-INVITE (conn nick channel) "Invite NICK to CHANNEL." (irc-send-command conn "INVITE" nick channel)) (defun irc-send-JOIN (conn channel &optional key) "Join CHANNEL. If KEY is given, use it to join the password-protected channel." (if key (irc-send-command conn "JOIN" channel key) (irc-send-command conn "JOIN" channel))) (defun irc-send-NAMES (conn &optional channel) "Retrieve user names from the server, optionally limited to CHANNEL." (if channel (irc-send-command conn "NAMES" channel) (irc-send-command conn "NAMES"))) (defun irc-send-NICK (conn nick) "Change your own nick to NICK." (irc-send-command conn "NICK" nick)) (defun irc-send-NOTICE (conn msgtarget text-to-be-sent) "Send a private notice containing TEXT-TO-BE-SENT to MSGTARGET. MSGTARGET can be either a nick or a channel." (irc-send-command conn "NOTICE" msgtarget text-to-be-sent)) (defun irc-send-PART (conn channel reason) "Leave CHANNEL with reason REASON." (irc-send-command conn "PART" channel reason)) (defun irc-send-PASS (conn password) "Authenticate to the server using PASSWORD." (irc-send-command conn "PASS" password)) (defun irc-send-PONG (conn server) "Respond to a PING message." (irc-send-raw conn (irc--format-command "PONG" server) :nowait)) (defun irc-send-PRIVMSG (conn msgtarget text-to-be-sent) "Send a private message containing TEXT-TO-BE-SENT to MSGTARGET. MSGTARGET can be either a nick or a channel." (irc-send-command conn "PRIVMSG" msgtarget text-to-be-sent)) (defun irc-send-QUIT (conn reason) "Leave IRC with reason REASON." (irc-send-command conn "QUIT" reason)) (defun irc-send-TOPIC (conn channel &optional new-topic) "Retrieve or set the topic of CHANNEL If NEW-TOPIC is given, set this as the new topic. If it is omitted, retrieve the current topic." (if new-topic (irc-send-command conn "TOPIC" channel new-topic) (irc-send-command conn "TOPIC" channel))) (defun irc-send-USER (conn user mode realname) "Send a USER message for registration. MODE should be an integer as per RFC 2812" (irc-send-command conn "USER" user (format "%s" mode) "*" realname)) (defun irc-send-WHOIS (conn target &optional server-or-name) "Retrieve current whois information on TARGET." (if server-or-name (irc-send-command conn "WHOIS" target server-or-name) (irc-send-command conn "WHOIS" target))) (defun irc-send-WHOWAS (conn target) "Retrieve past whois information on TARGET." (irc-send-command conn "WHOWAS" target)) ;;;;;;;;;;;;;;; ;;; Debug stuff (defun irc-debug-out (conn fmt &rest args) (when irc-debug-log (let ((name (format "*IRC Protocol %s:%s*" (irc-connection-get conn :host) (irc-connection-get conn :service)))) (with-current-buffer (get-buffer-create name) (save-excursion (goto-char (point-max)) (insert (apply #'format fmt args) "\n")))))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: Registration (defun irc-handle-registration (table) "Add command handlers to TABLE to handle registration. This will send the usual startup messages after we are connected. Events emitted: \"irc.registered\" current-nick -- We have successfully registered with the IRC server. Most commands can be used now. In particular, joining channels is only possible now. \"sasl.login\" nick!user@host account -- SASL log in was successful. Connection options used: :nick -- The nick to use to register with the server :user -- The user name to use :mode -- The initial mode to use; an integer. See RFC 2812 for the meaning. :realname -- The realname to use for the registration :pass -- The server password to send :cap-req -- CAP protocol capabilities to request, if available :sasl-username -- The SASL username to send, if sasl is available :sasl-password -- The SASL password to send, if sasl is available Connection options set: :connection-state -- One of nil, connected, registered, disconnected See `irc-connection-state' for an interface to this. :cap-supported-p -- Non-nil if the server supports the CAP protocol :cap-ack -- The list of active capabilities negotiated with the server" (irc-handler-add table "conn.connected" #'irc-handle-registration--connected) (irc-handler-add table "conn.disconnected" #'irc-handle-registration--disconnected) (irc-handler-add table "001" ;; RPL_WELCOME #'irc-handle-registration--rpl-welcome) (irc-handler-add table "CAP" #'irc-handle-registration--cap) (irc-handler-add table "AUTHENTICATE" #'irc-handle-registration--authenticate) (irc-handler-add table "900" ;; RPL_LOGGEDIN #'irc-handle-registration--logged-in)) (defun irc-handle-registration--connected (conn _event) (irc-connection-put conn :connection-state 'connected) (when (irc-connection-get conn :cap-req) (irc-send-CAP conn "LS")) (let ((password (irc-connection-get conn :pass))) (when password (irc-send-PASS conn password))) (irc-send-NICK conn (irc-connection-get conn :nick)) (irc-send-USER conn (irc-connection-get conn :user) (irc-connection-get conn :mode) (irc-connection-get conn :realname))) (defun irc-handle-registration--disconnected (conn _event) (irc-connection-put conn :connection-state 'disconnected)) (defun irc-handle-registration--rpl-welcome (conn _event _sender target &rest ignored) (irc-connection-put conn :connection-state 'registered) (irc-event-emit conn "irc.registered" target)) (defun irc-handle-registration--cap (conn _event _sender _target subcommand arg) (cond ((equal subcommand "LS") (let ((supported (split-string arg)) (wanted nil)) (dolist (cap (irc-connection-get conn :cap-req)) (when (member cap supported) (setq wanted (append wanted (list cap))))) (if wanted (irc-send-CAP conn "REQ" (mapconcat #'identity wanted " ")) (irc-send-CAP conn "END")))) ((equal subcommand "ACK") (let ((acked (split-string arg))) (irc-connection-put conn :cap-ack acked) (if (and (member "sasl" acked) (irc-connection-get conn :sasl-username) (irc-connection-get conn :sasl-password)) (irc-send-AUTHENTICATE conn "PLAIN") (irc-send-CAP conn "END")))) (t (message "Unknown CAP response from server: %s %s" subcommand arg)))) (defun irc-handle-registration--authenticate (conn _event _sender arg) (if (equal arg "+") (let ((username (irc-connection-get conn :sasl-username)) (password (irc-connection-get conn :sasl-password))) (irc-send-AUTHENTICATE conn (base64-encode-string (format "%s\x00%s\x00%s" username username password))) (irc-send-CAP conn "END")) (message "Unknown AUTHENTICATE response from server: %s" arg))) (defun irc-handle-registration--logged-in (conn _event _sender _target userhost account _message) (irc-event-emit conn "sasl.login" userhost account)) (defun irc-connection-state (conn) "connecting connected registered disconnected" (let ((state (irc-connection-get conn :connection-state))) (if (null state) 'connecting state))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: Ping-Pong (defun irc-handle-ping-pong (table) "Add command handlers to respond to PING requests." (irc-handler-add table "PING" #'irc-handle-ping-pong--ping)) (defun irc-handle-ping-pong--ping (conn _event _sender argument) (irc-send-PONG conn argument)) ;;;;;;;;;;;;;;;;;;;;; ;;; Handler: ISUPPORT (defun irc-handle-isupport (table) "Add command handlers to track 005 RPL_ISUPPORT capabilities." (irc-handler-add table "005" #'irc-handle-isupport--005)) (defun irc-handle-isupport--005 (conn _event _sender _target &rest args) (irc-connection-put conn :isupport (append (irc-connection-get conn :isupport) (irc-handle-isupport--capabilities-to-alist args)))) (defun irc-handle-isupport--capabilities-to-alist (capabilities) (mapcar (lambda (cap) (if (string-match "\\`\\([^=]+\\)=\\(.*\\)\\'" cap) (cons (match-string 1 cap) (match-string 2 cap)) (cons cap t))) capabilities)) (defun irc-isupport (conn capability) "Return the value of CAPABILITY of CONN. These capabilities are set when the server sends a 005 RPL_ISUPPORT message. The return value is either the value of the capability, or t if it is a boolean capability that is present. If the capability is not present, the return value is nil." (cdr (assoc capability (irc-connection-get conn :isupport)))) (defun irc-string-equal-p (conn s1 s2) "Compare S1 to S2 case-insensitively. What case means is defined by the server of CONN." (equal (irc-isupport--case-fold conn s1) (irc-isupport--case-fold conn s2))) (defvar irc-isupport--ascii-table (let ((table (make-string 128 0)) (char 0)) (while (<= char 127) (if (and (<= ?A char) (<= char ?Z)) (aset table char (+ char (- ?a ?A))) (aset table char char)) (setq char (1+ char))) table) "A case mapping table for the ascii CASEMAPPING.") (defvar irc-isupport--rfc1459-table (let ((table (concat irc-isupport--ascii-table))) ; copy string (aset table ?\[ ?\{) (aset table ?\] ?\}) (aset table ?\\ ?\|) (aset table ?^ ?\~) table) "A case mapping table for the rfc1459 CASEMAPPING.") (defvar irc-isupport--rfc1459-strict-table (let ((table (concat irc-isupport--ascii-table))) ; copy string (aset table ?\[ ?\{) (aset table ?\] ?\}) (aset table ?\\ ?\|) table) "A case mapping table for the rfc1459-strict CASEMAPPING.") (defun irc-isupport--case-fold (conn s) "Translate S to be a lower-case. This uses the case mapping defined by the IRC server for CONN." (with-temp-buffer (insert s) (let ((mapping (or (irc-isupport conn "CASEMAPPING") "rfc1459"))) (cond ((equal mapping "rfc1459") (translate-region (point-min) (point-max) irc-isupport--rfc1459-table)) ((equal mapping "ascii") (translate-region (point-min) (point-max) irc-isupport--ascii-table)) ((equal mapping "rfc1459-strict") (translate-region (point-min) (point-max) irc-isupport--rfc1459-strict-table)))) (buffer-string))) (defun irc-channel-name-p (conn string) "True iff STRING is a valid channel name for CONN. This depends on the CHANTYPES setting set by the server of CONN." (let ((chantypes (string-to-list (or (irc-isupport conn "CHANTYPES") "#")))) (if (and (> (length string) 0) (member (aref string 0) chantypes)) t nil))) (defun irc-nick-without-prefix (conn nick) "Return NICK without any mode prefixes. For example, a user with op status might be shown as @Nick. This function would return Nick without the prefix. This uses the 005 RPL_ISUPPORT setting of PREFIX set by the IRC server for CONN." (let ((prefixes (irc-connection-get conn :nick-prefixes))) (when (not prefixes) (let ((prefix-string (or (irc-isupport conn "PREFIX") "(qaohv)~&@%+"))) (setq prefixes (string-to-list (if (string-match "(.*)\\(.*\\)" prefix-string) (match-string 1 prefix-string) "~&@%+"))) (irc-connection-put conn :nick-prefixes prefixes))) (while (and (> (length nick) 0) (member (aref nick 0) prefixes)) (setq nick (substring nick 1))) nick)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: Initial nick acquisition (defun irc-handle-initial-nick-acquisition (table) "Track the current nick of the user. Connection options used: :nick-alternatives -- A list of nicks to try if the first attempt does not succeed." (irc-handler-add table "432" ;; ERR_ERRONEUSNICKNAME #'irc-handle-initial-nick-acquisition--get-initial-nick) (irc-handler-add table "433" ;; ERR_NICKNAMEINUSE #'irc-handle-initial-nick-acquisition--get-initial-nick) (irc-handler-add table "437" ;; ERR_UNAVAILRESOURCE #'irc-handle-initial-nick-acquisition--get-initial-nick)) (defun irc-handle-initial-nick-acquisition--get-initial-nick (conn _event _sender current-nick _attempted-nick _reason) (when (equal current-nick "*") (let ((alternatives (irc-connection-get conn :nick-alternatives))) (if (not alternatives) (irc-send-NICK conn (irc-generate-nick)) (irc-connection-put conn :nick-alternatives (cdr alternatives)) (irc-send-NICK conn (car alternatives)))))) (defun irc-generate-nick () "Return a random, valid IRC nick name. Valid nick names are at least (RFC 1459): ::= { | | } ::= '-' | '[' | ']' | '\' | '`' | '^' | '{' | '}'" (let ((chars "abcdefghijklmnopqrstuvwxyz")) (mapconcat (lambda (_) (make-string 1 (aref chars (random (length chars))))) (make-string 9 0) ""))) ;;;;;;;;;;;;;;;;; ;;; Handler: CTCP (defun irc-handle-ctcp (table) "Add command handlers to TABLE to handle the CTCP protocol. Connection options used: :ctcp-version -- The response to a CTCP VERSION request. :ctcp-clientinfo -- The response to a CTCP CLIENTINFO request. :ctcp-source -- The response to a CTCP SOURCE request. Events emitted: \"irc.message\" sender target body -- A non-CTCP PRIVMSG \"irc.notice\" sender target body -- A non-CTCP NOTICE \"irc.ctcp\" sender target verb argument -- A CTCP request. ARGUMENT can be nil if there was no argument, or the empty string if the argument was empty. \"irc.ctcpreply\" sender target verb argument -- A CTCP reply. ARGUMENT is similar to above. \"irc.ctcp.VERB\" sender target argument -- A CTCP request of this specific type. \"irc.ctcpreply.VERB\" sender target argument -- A CTCP reply of this specific type." (irc-handler-add table "PRIVMSG" #'irc-handle-ctcp--privmsg) (irc-handler-add table "irc.ctcp" #'irc-handle-ctcp--ctcp) (irc-handler-add table "NOTICE" #'irc-handle-ctcp--notice) (irc-handler-add table "irc.ctcpreply" #'irc-handle-ctcp--ctcpreply) (irc-handler-add table "irc.ctcp.VERSION" #'irc-handle-ctcp--ctcp-version) (irc-handler-add table "irc.ctcp.CLIENTINFO" #'irc-handle-ctcp--ctcp-clientinfo) (irc-handler-add table "irc.ctcp.SOURCE" #'irc-handle-ctcp--ctcp-source) (irc-handler-add table "irc.ctcp.PING" #'irc-handle-ctcp--ctcp-ping) (irc-handler-add table "irc.ctcp.TIME" #'irc-handle-ctcp--ctcp-time) ) (defun irc-handle-ctcp--privmsg (conn _event sender target body) (if (string-match "\\`\x01\\([^ ]+\\)\\(?: \\(.*\\)\\)?\x01\\'" body) (irc-event-emit conn "irc.ctcp" sender target (match-string 1 body) (match-string 2 body)) (irc-event-emit conn "irc.message" sender target body))) (defun irc-handle-ctcp--ctcp (conn _event sender target verb argument) (irc-event-emit conn (format "irc.ctcp.%s" (upcase verb)) sender target argument)) (defun irc-handle-ctcp--notice (conn _event sender target body) (if (string-match "\\`\x01\\([^ ]+\\)\\(?: \\(.*\\)\\)?\x01\\'" body) (irc-event-emit conn "irc.ctcpreply" sender target (match-string 1 body) (match-string 2 body)) (irc-event-emit conn "irc.notice" sender target body))) (defun irc-handle-ctcp--ctcpreply (conn _event sender target verb argument) (irc-event-emit conn (format "irc.ctcpreply.%s" (upcase verb)) sender target argument)) (defun irc-handle-ctcp--ctcp-version (conn _event sender _target _argument) (let ((version (irc-connection-get conn :ctcp-version))) (when version (irc-send-ctcpreply conn (irc-userstring-nick sender) "VERSION" version)))) (defun irc-handle-ctcp--ctcp-clientinfo (conn _event sender _target _argument) (let ((clientinfo (irc-connection-get conn :ctcp-clientinfo))) (when clientinfo (irc-send-ctcpreply conn (irc-userstring-nick sender) "CLIENTINFO" clientinfo)))) (defun irc-handle-ctcp--ctcp-source (conn _event sender _target _argument) (let ((source (irc-connection-get conn :ctcp-source))) (when source (irc-send-ctcpreply conn (irc-userstring-nick sender) "SOURCE" source)))) (defun irc-handle-ctcp--ctcp-ping (conn _event sender _target argument) (when argument (irc-send-ctcpreply conn (irc-userstring-nick sender) "PING" argument))) (defun irc-handle-ctcp--ctcp-time (conn _event sender _target _argument) (irc-send-ctcpreply conn (irc-userstring-nick sender) "TIME" (current-time-string))) (defun irc-send-ctcp (conn target verb &optional argument) "Send a CTCP VERB request to TARGET, optionally with ARGUMENT." (irc-send-PRIVMSG conn target (format "\x01%s%s\x01" verb (if argument (concat " " argument) "")))) (defun irc-send-ctcpreply (conn target verb &optional argument) "Send a CTCP VERB reply to TARGET, optionally with ARGUMENT." (irc-send-raw conn (irc--format-command "NOTICE" target (format "\x01%s%s\x01" verb (if argument (concat " " argument) ""))) :drop)) ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: State tracking (defun irc-handle-state-tracking (table) "Add command handlers to TABLE to track the IRC state. Connection options used: :current-nick -- The current nick, or nil if not known/set yet. Use helper functions to access the information tracked by this handler: - `irc-current-nick' - `irc-current-nick-p' Events emitted: \"channel.quit\" sender channel reason -- A user quit IRC and left this channel that way." (irc-handler-add table "001" ;; RPL_WELCOME #'irc-handle-state-tracking--rpl-welcome) (irc-handler-add table "JOIN" #'irc-handle-state-tracking--JOIN) (irc-handler-add table "PART" #'irc-handle-state-tracking--PART) (irc-handler-add table "KICK" #'irc-handle-state-tracking--KICK) (irc-handler-add table "QUIT" #'irc-handle-state-tracking--QUIT) (irc-handler-add table "NICK" #'irc-handle-state-tracking--NICK) (irc-handler-add table "PRIVMSG" #'irc-handle-state-tracking--PRIVMSG) (irc-handler-add table "353" ;; RPL_NAMREPLY #'irc-handle-state-tracking--rpl-namreply) (irc-handler-add table "366" ;; RPL_ENDOFNAMES #'irc-handle-state-tracking--rpl-endofnames) (irc-handler-add table "TOPIC" #'irc-handle-state-tracking--TOPIC) (irc-handler-add table "331" ;; RPL_NOTOPIC #'irc-handle-state-tracking--rpl-notopic) (irc-handler-add table "332" ;; RPL_TOPIC #'irc-handle-state-tracking--rpl-topic) ) (cl-defstruct irc-channel name topic last-topic folded-name users recent-users receiving-names connection) (defun irc-channel-from-name (conn name) "Create a new IRC channel object on CONN, named NAME." (make-irc-channel :name name :folded-name (irc-isupport--case-fold conn name) :users (make-hash-table :test 'equal) :recent-users (make-hash-table :test 'equal) :connection conn)) (defun irc-connection-channel (conn channel-name) "Return the channel object for CHANNEL-NAME on CONN." (let ((channel-table (irc--connection-channel-table conn)) (folded-name (irc-isupport--case-fold conn channel-name))) (gethash folded-name channel-table))) (defun irc-connection-channel-list (conn) "Return the list of channel object on CONN." (let ((channel-list nil)) (maphash (lambda (_folded-name channel) (push channel channel-list)) (irc--connection-channel-table conn)) channel-list)) (defun irc-connection-add-channel (conn channel-name) "Add CHANNEL-NAME to the channel table of CONN." (let* ((channel-table (irc--connection-channel-table conn)) (channel (irc-channel-from-name conn channel-name)) (folded-name (irc-channel-folded-name channel))) (when (not (gethash folded-name channel-table)) (puthash folded-name channel channel-table)))) (defun irc-connection-remove-channel (conn channel-name) "Remove CHANNEL-NAME from the channel table of CONN." (let* ((channel-table (irc--connection-channel-table conn)) (folded-name (irc-isupport--case-fold conn channel-name))) (remhash folded-name channel-table))) (defun irc-current-nick (conn) "Return the current nick on IRC connection CONN, or nil if not set yet." (irc-connection-get conn :current-nick)) (defun irc-current-nick-p (conn nick) "Return t if NICK is our current nick on IRC connection CONN." (let ((current-nick (irc-current-nick conn))) (if (and (stringp nick) (stringp current-nick)) (irc-string-equal-p conn current-nick nick) nil))) (defun irc--connection-channel-table (conn) (let ((table (irc-connection-get conn :channel-table))) (when (not table) (setq table (make-hash-table :test 'equal)) (irc-connection-put conn :channel-table table)) table)) (cl-defstruct irc-user nick folded-nick userhost join-time last-activity-time part-time connection) (defun irc-user-from-userstring (conn userstring) "Create an irc-user struct on CONN from USERSTRING. USERSTRING should be a s tring of the form \"nick!user@host\"." (let ((nick (irc-userstring-nick userstring))) (make-irc-user :nick nick :folded-nick (irc-isupport--case-fold conn nick) :userhost (let ((nick-len (length nick))) (if (>= nick-len (length userstring)) nil (substring userstring (1+ nick-len)))) :connection conn))) (defun irc-channel-user (channel nick) "Return a user named NICK on channel CHANNEL." (let ((user-table (irc-channel-users channel)) (folded-nick (irc-isupport--case-fold (irc-channel-connection channel) nick))) (gethash folded-nick user-table))) (defun irc-channel-recent-user (channel nick) "Return a recent user named NICK on channel CHANNEL." (let ((user-table (irc-channel-recent-users channel)) (folded-nick (irc-isupport--case-fold (irc-channel-connection channel) nick))) (gethash folded-nick user-table))) (defun irc-channel-add-user (channel userstring) "Add USER to CHANNEL." (let* ((user-table (irc-channel-users channel)) (user (irc-user-from-userstring (irc-channel-connection channel) userstring)) (folded-nick (irc-user-folded-nick user)) (recent-user (irc-channel-recent-user channel (irc-user-nick user)))) (when (not (gethash folded-nick user-table)) (when (and recent-user (equal (irc-user-userhost recent-user) (irc-user-userhost user))) (setf (irc-user-last-activity-time user) (irc-user-last-activity-time recent-user))) (puthash folded-nick user user-table) user))) (defun irc-channel-remove-user (channel nick) "Remove NICK from CHANNEL." (let* ((user-table (irc-channel-users channel)) (recent-user-table (irc-channel-recent-users channel)) (folded-nick (irc-isupport--case-fold (irc-channel-connection channel) nick)) (user (gethash folded-nick user-table))) (remhash folded-nick user-table) (when user (setf (irc-user-part-time user) (float-time)) (puthash folded-nick user recent-user-table) (maphash (lambda (folded-nick user) (when (< (irc-user-part-time user) (- (float-time) (* 60 60))) (remhash folded-nick recent-user-table))) recent-user-table)))) (defun irc-channel-rename-user (channel oldnick newnick) "Update CHANNEL so that the user with nick OLDNICK now has nick NEWNICK." (let ((user-table (irc-channel-users channel)) (user (irc-channel-user channel oldnick)) (newnick-folded (irc-isupport--case-fold (irc-channel-connection channel) newnick)) (recent-user (irc-channel-recent-user channel newnick))) (when user (when (and recent-user (equal (irc-user-userhost recent-user) (irc-user-userhost user))) (setf (irc-user-last-activity-time user) (irc-user-last-activity-time recent-user))) (remhash (irc-user-folded-nick user) user-table) (setf (irc-user-nick user) newnick) (setf (irc-user-folded-nick user) newnick-folded) (puthash (irc-user-folded-nick user) user user-table)))) (defun irc-handle-state-tracking--rpl-welcome (conn _event _sender target &rest ignored) (irc-connection-put conn :current-nick target)) (defun irc-handle-state-tracking--JOIN (conn _event sender target &optional _account _realname) (let ((nick (irc-userstring-nick sender))) (cond ((irc-current-nick-p conn nick) (irc-connection-add-channel conn target)) (t (let ((channel (irc-connection-channel conn target))) (when channel (let ((user (irc-channel-add-user channel sender))) (when user (setf (irc-user-join-time user) (float-time)))))))))) (defun irc-handle-state-tracking--PART (conn _event sender target &optional _reason) (let ((nick (irc-userstring-nick sender))) (cond ((irc-current-nick-p conn nick) (irc-connection-remove-channel conn target)) (t (let ((channel (irc-connection-channel conn target))) (when channel (irc-channel-remove-user channel nick))))))) (defun irc-handle-state-tracking--KICK (conn _event _sender target nick &optional _reason) (cond ((irc-current-nick-p conn nick) (irc-connection-remove-channel conn target)) (t (let ((channel (irc-connection-channel conn target))) (when channel (irc-channel-remove-user channel nick)))))) (defun irc-handle-state-tracking--QUIT (conn _event sender &optional reason) (let ((nick (irc-userstring-nick sender))) (if (irc-current-nick-p conn nick) (dolist (channel (irc-connection-channel-list conn)) (irc-connection-remove-channel conn (irc-channel-folded-name channel))) (dolist (channel (irc-connection-channel-list conn)) (when (irc-channel-user channel nick) (irc-event-emit conn "channel.quit" sender (irc-channel-name channel) reason)) (irc-channel-remove-user channel nick))))) (defun irc-handle-state-tracking--NICK (conn _event sender new-nick) ;; Update channels (let ((nick (irc-userstring-nick sender))) (dolist (channel (irc-connection-channel-list conn)) (irc-channel-rename-user channel nick new-nick))) ;; Update our own nick (when (irc-current-nick-p conn (irc-userstring-nick sender)) (irc-connection-put conn :current-nick new-nick))) (defun irc-handle-state-tracking--PRIVMSG (conn _event sender target _message) (let ((channel (irc-connection-channel conn target)) (nick (irc-userstring-nick sender))) (when channel (let ((user (irc-channel-user channel nick))) (when user (setf (irc-user-last-activity-time user) (float-time))))))) (defun irc-handle-state-tracking--rpl-namreply (conn _event _sender _current-nick _channel-type channel-name nicks) (let ((channel (irc-connection-channel conn channel-name))) (when channel (setf (irc-channel-receiving-names channel) (append (irc-channel-receiving-names channel) (mapcar (lambda (nick) (irc-nick-without-prefix conn (string-trim nick))) (split-string nicks))))))) (defun irc-handle-state-tracking--rpl-endofnames (conn _event _sender _current-nick channel-name _description) (let ((channel (irc-connection-channel conn channel-name))) (when channel (irc-channel--synchronize-nicks channel (irc-channel-receiving-names channel)) (setf (irc-channel-receiving-names channel) nil)))) (defun irc-channel--synchronize-nicks (channel nicks) "Update the user list of CHANNEL to match NICKS." (let ((have (irc-channel-users channel)) (want (make-hash-table :test 'equal))) (dolist (nick nicks) (puthash (irc-isupport--case-fold (irc-channel-connection channel) nick) nick want)) (maphash (lambda (nick-folded user) (when (not (gethash nick-folded want)) (irc-channel-remove-user channel (irc-user-nick user)))) have) (maphash (lambda (_nick-folded nick) (irc-channel-add-user channel nick)) want))) (defun irc-handle-state-tracking--TOPIC (conn _event _sender channel new-topic) (let ((channel (irc-connection-channel conn channel))) (when channel (setf (irc-channel-last-topic channel) (irc-channel-topic channel)) (setf (irc-channel-topic channel) new-topic)))) (defun irc-handle-state-tracking--rpl-notopic (conn _event _sender _current-nick channel _no-topic-desc) (let ((channel (irc-connection-channel conn channel))) (when channel (setf (irc-channel-topic channel) nil)))) (defun irc-handle-state-tracking--rpl-topic (conn _event _sender _current-nick channel topic) (let ((channel (irc-connection-channel conn channel))) (when channel (setf (irc-channel-topic channel) topic)))) ;;;;;;;;;;;;;;,;;;;;; ;;; Handler: NickServ (defun irc-handle-nickserv (table) "Add command handlers to TABLE to deal with NickServ. Connection options used: :nickserv-nick -- The nick to register as :nickserv-password -- The password for nickserv; can be a function and is then called with the IRC connection as its sole argument :nickserv-mask -- A regular expression matching the correct NickServ's nick!user@host string to avoid fakes :nickserv-identify-challenge -- A regular expression matching the challenge sent by NickServ to request identification :nickserv-identify-command -- The raw IRC command to send to identify; expands {nick} and {password} when present :nickserv-identify-confirmation -- A regular expression matching the confirmation message from NickServ after successful identification :nickserv-ghost-command -- The raw IRC comment to ghost your original nick; expands {nick} and {password}. Set this to nil to disable ghosting and nick regaining. :nickserv-ghost-confirmation -- A regular expression matching the confirmation message that the nick was ghosted Events emitted: \"nickserv.identified\" -- We have successfully identified with nickserv. \"nickserv.ghosted\" -- We have ghosted a nick." (irc-handler-add table "irc.registered" #'irc-handle-nickserv--registered) (irc-handler-add table "NOTICE" #'irc-handle-nickserv--NOTICE) (irc-handler-add table "PRIVMSG" #'irc-handle-nickserv--NOTICE) (irc-handler-add table "NICK" #'irc-handle-nickserv--NICK)) (defun irc-handle-nickserv--password (conn) (let ((password (irc-connection-get conn :nickserv-password))) (if (functionp password) (funcall password conn) password))) (defun irc-handle-nickserv--registered (conn _event current-nick) (let ((ghost-command (irc-connection-get conn :nickserv-ghost-command)) (wanted-nick (irc-connection-get conn :nickserv-nick)) (password (irc-handle-nickserv--password conn))) (when (and ghost-command wanted-nick password (not (irc-string-equal-p conn current-nick wanted-nick))) (irc-send-raw conn (irc-format ghost-command 'nick wanted-nick 'password password))))) (defun irc-handle-nickserv--NOTICE (conn _event sender _target message) (let ((nickserv-mask (irc-connection-get conn :nickserv-mask)) identify-challenge identify-command identify-confirmation ghost-confirmation nickserv-nick nickserv-password) (when (and nickserv-mask (string-match nickserv-mask sender)) (setq identify-challenge (irc-connection-get conn :nickserv-identify-challenge)) (setq identify-command (irc-connection-get conn :nickserv-identify-command)) (setq identify-confirmation (irc-connection-get conn :nickserv-identify-confirmation)) (setq ghost-confirmation (irc-connection-get conn :nickserv-ghost-confirmation)) (setq nickserv-nick (irc-connection-get conn :nickserv-nick)) (setq nickserv-password (irc-handle-nickserv--password conn)) (cond ;; Identify ((and identify-challenge identify-command nickserv-nick nickserv-password (string-match identify-challenge message)) (irc-send-raw conn (irc-format identify-command 'nick nickserv-nick 'password nickserv-password))) ;; Identification confirmed ((and identify-confirmation (string-match identify-confirmation message)) (irc-event-emit conn "nickserv.identified")) ;; Ghosting confirmed ((and ghost-confirmation (string-match ghost-confirmation message)) (irc-event-emit conn "nickserv.ghosted") (irc-connection-put conn :nickserv-regaining-nick t) (when nickserv-nick (irc-send-NICK conn nickserv-nick))))))) (defun irc-handle-nickserv--NICK (conn _event _sender new-nick) (when (and (irc-connection-get conn :nickserv-regaining-nick) (irc-string-equal-p conn new-nick (irc-connection-get conn :nickserv-nick))) (irc-connection-put conn :nickserv-regaining-nick nil) (irc-event-emit conn "nickserv.regained"))) (defun irc-format (format &rest args) "Return a formatted version of FORMAT, using substitutions from ARGS. The substitutions are identified by braces ('{' and '}')." (with-temp-buffer (insert format) (goto-char (point-min)) (while (re-search-forward "{\\([^}]*\\)}" nil t) (replace-match (format "%s" (plist-get args (intern (match-string 1)))) t t)) (buffer-string))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: Auto-Join (defun irc-handle-auto-join (table) "Add command handlers to TABLE to deal with NickServ. Connection options used: :auto-join-after-registration -- List of channels to join immediately after registration with the server :auto-join-after-host-hiding -- List of channels to join after our host was hidden :auto-join-after-nick-acquisition -- List of channels to join after we gained our desired nick :auto-join-after-nickserv-identification -- List of channels to join after we identified successfully with NickServ" (irc-handler-add table "irc.registered" #'irc-handle-auto-join--registered) (irc-handler-add table "396" ;; RPL_HOSTHIDDEN #'irc-handle-auto-join--rpl-hosthidden) (irc-handler-add table "nickserv.regained" #'irc-handle-auto-join--nickserv-regained) (irc-handler-add table "nickserv.identified" #'irc-handle-auto-join--nickserv-identified) (irc-handler-add table "sasl.login" #'irc-handle-auto-join--sasl-login)) (defun irc-handle-auto-join--registered (conn _event _current-nick) (dolist (channel (irc-connection-get conn :auto-join-after-registration)) (irc-send-JOIN conn channel))) (defun irc-handle-auto-join--rpl-hosthidden (conn _event _sender _target _host _description) (dolist (channel (irc-connection-get conn :auto-join-after-host-hiding)) (irc-send-JOIN conn channel))) (defun irc-handle-auto-join--nickserv-regained (conn _event) (dolist (channel (irc-connection-get conn :auto-join-after-nick-acquisition)) (irc-send-JOIN conn channel))) (defun irc-handle-auto-join--nickserv-identified (conn event) (dolist (channel (irc-connection-get conn :auto-join-after-nickserv-identification)) (irc-send-JOIN conn channel)) (if (irc-string-equal-p conn (irc-connection-get conn :nick) (irc-connection-get conn :nickserv-nick)) (irc-handle-auto-join--nickserv-regained conn event))) (defun irc-handle-auto-join--sasl-login (conn _event &rest ignored) (dolist (channel (irc-connection-get conn :auto-join-after-sasl-login)) (irc-send-JOIN conn channel))) (provide 'irc) ;;; irc.el ends here circe-2.6/lcs.el000066400000000000000000000162631316355431300135650ustar00rootroot00000000000000;;; lcs.el --- find out the longest common sequence ;; Copyright (c) 2002-2003 by Alex Shinn, All rights reserved. ;; Copyright (c) 2002-2003 by Shiro Kawai, All rights reserved. ;; Copyright (c) 2006, 2012 by Jorgen Schaefer, All rights reserved. ;; Authors: Alex Shinn, Shiro Kawai ;; Maintainer: Jorgen Schaefer ;; URL: https://github.com/jorgenschaefer/circe/wiki/lcs ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions ;; are met: ;; 1. Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. ;; 2. Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in the ;; documentation and/or other materials provided with the distribution. ;; 3. Neither the name of the authors nor the names of its contributors ;; may be used to endorse or promote products derived from this ;; software without specific prior written permission. ;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT ;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR ;; A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT ;; OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, ;; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED ;; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR ;; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF ;; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. ;;; Commentary: ;; lcs.el is a library for other Emacs Lisp programs not useful by ;; itself. ;; This library provides functions to find the Longest Common Sequence ;; (LCS) of two sequences. This is used to create a unified diff of to ;; two lists. See `lcs-unified-diff' for a useful function to be ;; called. ;; The code is more or less a literal translation of (part of) ;; Gauche's util/lcs.scm module to Emacs Lisp. ;;; Code: (put 'lcs-for 'lisp-indent-function 4) (defmacro lcs-for (var from to step &rest body) "A simple FOR loop macro. Count VAR from FROM to TO by stepsize STEP. Evaluate BODY in each iteration." (let ((sto (make-symbol "to")) (sstep (make-symbol "step"))) `(let ((,var ,from) (,sto ,to) (,sstep ,step)) (while (<= ,var ,sto) (progn ,@body) (setq ,var (+ ,var ,sstep)))))) (defun lcs-split-at (lis pos) "Return a cons cell of the first POS elements of LIS and the rest." (let ((head nil)) (while (> pos 0) (setq head (cons (car lis) head) pos (- pos 1) lis (cdr lis))) (cons (reverse head) lis))) (defun lcs-finish (M+N V_l vl V_r vr) "Finalize the LCS algorithm. Should be used only by `lcs-with-positions'." (let ((maxl 0) (r '())) (lcs-for i (- M+N) M+N 1 (when (> (funcall vl i) maxl) (setq maxl (funcall vl i) r (funcall vr i)))) (list maxl (reverse r)))) (defun lcs-with-positions (a-ls b-ls &optional equalp) "Return the longest common subsequence (LCS) of A-LS and B-LS. EQUALP can be any procedure which returns non-nil when two elements should be considered equal." (let* ((A (vconcat a-ls)) (B (vconcat b-ls)) (N (length A)) (M (length B)) (M+N (+ M N)) (V_d (make-vector (+ 1 (* 2 M+N)) 0)) (V_r (make-vector (+ 1 (* 2 M+N)) nil)) (V_l (make-vector (+ 1 (* 2 M+N)) 0)) (vd (lambda (i &optional x) (if x (aset V_d (+ i M+N) x) (aref V_d (+ i M+N))))) (vr (lambda (i &optional x) (if x (aset V_r (+ i M+N) x) (aref V_r (+ i M+N))))) (vl (lambda (i &optional x) (if x (aset V_l (+ i M+N) x) (aref V_l (+ i M+N)))))) (when (not equalp) (setq equalp 'equal)) (catch 'return (if (= M+N 0) (throw 'return '(0 ())) (lcs-for d 0 M+N 1 (lcs-for k (- d) d 2 (let ((x nil) (y nil) (l nil) (r nil)) (if (or (= k (- d)) (and (not (= k d)) (< (funcall vd (- k 1)) (funcall vd (+ k 1))))) (setq x (funcall vd (+ k 1)) l (funcall vl (+ k 1)) r (funcall vr (+ k 1))) (setq x (+ 1 (funcall vd (- k 1))) l (funcall vl (- k 1)) r (funcall vr (- k 1)))) (setq y (- x k)) (while (and (< x N) (< y M) (funcall equalp (aref A x) (aref B y))) (setq r (cons (list (aref A x) x y) r) x (+ x 1) y (+ y 1) l (+ l 1))) (funcall vd k x) (funcall vr k r) (funcall vl k l) (when (and (>= x N) (>= y M)) (throw 'return(lcs-finish M+N V_l vl V_r vr))))))) (error "Can't happen")))) (defun lcs-unified-diff (a b &optional equalp) "Return a unified diff of the lists A and B. EQUALP should can be a procedure that returns non-nil when two elements of A and B should be considered equal. It's `equal' by default." (let ((common (cadr (lcs-with-positions a b equalp))) (a a) (a-pos 0) (b b) (b-pos 0) (diff '())) (while common (let* ((elt (car common)) (a-off (nth 1 elt)) (a-skip (- a-off a-pos)) (b-off (nth 2 elt)) (b-skip (- b-off b-pos)) (a-split (lcs-split-at a a-skip)) (a-head (car a-split)) (a-tail (cdr a-split)) (b-split (lcs-split-at b b-skip)) (b-head (car b-split)) (b-tail (cdr b-split))) (setq diff (append diff (mapcar (lambda (a) `(- ,a)) a-head) (mapcar (lambda (b) `(+ ,b)) b-head) `((! ,(car elt)))) common (cdr common) a (cdr a-tail) a-pos (+ a-off 1) b (cdr b-tail) b-pos (+ b-off 1)))) (append diff (mapcar (lambda (a) `(- ,a)) a) (mapcar (lambda (b) `(+ ,b)) b)))) (provide 'lcs) ;;; lcs.el ends here circe-2.6/lui-autopaste.el000066400000000000000000000102621316355431300155710ustar00rootroot00000000000000;;; lui-autopaste.el --- Extension for lui for long text input ;; Copyright (C) 2012 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; This file is part of Lui. ;; 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: ;; This extension for lui will intercept long input and replace it by ;; an URL to a paste service. ;; What is considered "long" is defined by `lui-autopaste-lines'. You ;; can configure which paste service to use by changing ;; `lui-autopaste-function'. ;; Run `enable-lui-autopaste' to enable this. ;;; Code: (defgroup lui-autopaste nil "The Lui autopaste extension." :prefix "lui-autopaste-" :group 'lui) (defcustom lui-autopaste-lines 3 "Starting at this number of lines, Lui will ask to paste the input." :type 'integer :group 'lui-autopaste) (defcustom lui-autopaste-function 'lui-autopaste-service-ixio "Which paste service to use. This function will be called with some text as its only argument, and is expected to return an URL to view the contents." :type '(choice (const :tag "ix.io" lui-autopaste-service-ixio) (const :tag "ptpb.pw" lui-autopaste-service-ptpb-pw)) :group 'lui-autopaste) ;;;###autoload (defun enable-lui-autopaste () "Enable the lui autopaste feature. If you enter more than `lui-autopaste-lines' at once, Lui will ask if you would prefer to use a paste service instead. If you agree, Lui will paste your input to `lui-autopaste-function' and replace it with the resulting URL." (interactive) (add-hook 'lui-pre-input-hook 'lui-autopaste)) ;;;###autoload (defun disable-lui-autopaste () "Disable the lui autopaste feature." (interactive) (remove-hook 'lui-pre-input-hook 'lui-autopaste)) (defun lui-autopaste () "Check if the lui input is too large. If so, paste it instead." (when (and (>= (count-lines (point-min) (point-max)) lui-autopaste-lines) (y-or-n-p "That's pretty long, would you like to use a paste service instead? ")) (let ((url (funcall lui-autopaste-function (buffer-substring (point-min) (point-max))))) (delete-region (point-min) (point-max)) (insert url)))) (defun lui-autopaste-service-ptpb-pw (text) "Paste TEXT to ptpb.pw and return the paste url." (let ((url-request-method "POST") (url-request-extra-headers '(("Content-Type" . "application/x-www-form-urlencoded"))) (url-request-data (format "c=%s" (url-hexify-string text))) (url-http-attempt-keepalives nil)) (let ((buf (url-retrieve-synchronously "https://ptpb.pw/"))) (unwind-protect (with-current-buffer buf (goto-char (point-min)) (if (re-search-forward "^url: \\(.*\\)" nil t) (match-string 1) (error "Error during pasting to ptpb.pw"))) (kill-buffer buf))))) (defun lui-autopaste-service-ixio (text) "Paste TEXT to ix.io and return the paste url." (let ((url-request-method "POST") (url-request-extra-headers '(("Content-Type" . "application/x-www-form-urlencoded"))) (url-request-data (format "f:1=%s" (url-hexify-string text))) (url-http-attempt-keepalives nil)) (let ((buf (url-retrieve-synchronously "http://ix.io/"))) (unwind-protect (with-current-buffer buf (goto-char (point-min)) (if (re-search-forward "\n\n" nil t) (buffer-substring (point) (point-at-eol)) (error "Error during pasting to ix.io"))) (kill-buffer buf))))) (provide 'lui-autopaste) ;;; lui-autopaste.el ends here circe-2.6/lui-format.el000066400000000000000000000155501316355431300150610ustar00rootroot00000000000000;;; lui-format.el --- A formatting function for use with Lui ;; Copyright (C) 2005, 2012 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; This file is part of Lui. ;; 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: ;; An improved formatting function using named parameters. ;; ;; See the docstring of `lui-format' for more details. ;; ;; Most of the design is borrowed from Python's string.format. ;;; Code: (require 'lui) (defun lui-display (format not-tracked-p &rest keywords) "Display a formatted string in the current Lui interface. The string is formatted using FORMAT and `lui-format'. If NOT-TRACKED-P is given, the inserted string won't trigger tracking. See `lui-insert' for a description. KEYWORDS are the keyword arguments passed to `lui-format'. See `lui-format' for a full description of the arguments." (lui-insert (lui-format format keywords) not-tracked-p)) (defun lui-format (format &rest keywords) "Display FORMAT formatted with KEYWORDS. FORMAT should be a symbol whose value is taken. If the value is a procedure, the keyword list is passed as a single argument to it, and it should return the formatted string. If the value is a string, it is formatted according to the rules below. KEYWORDS is a plist of keywords and strings, or symbols and strings. They are used as format arguments. The string is taken verbatim, unless there is are opening or closing braces. Double opening or closing braces are replaced by single occurrences of those characters. Otherwise, the contents between opening and closing braces is a format description and replaced by a formatted string. The string between opening and closing braces is taken as a name of a keyword argument, and replaced by that argument's value. If there is a colon in the string, the keyword name is the part before the colon. The part after the colon is used to format the argument using standard `format' Example: (lui-format \"Hello {foo:.1f}\" :foo 3.1415) is equivalent to (format \"Hello %.1f\" 3.1415) If the name is either a number, a number followed by a dash, or two numbers with a dash in between them, this is taken as a special name that is looked up in the list given using the list argument to the :indexed-args keyword. {1} refers to the second element (element 1) {1-} refers to the second and all following elements {1-3} refers to the second through fourth element If more than one element is selected, the elements are separated by a single space character. All named arguments receive a property of `lui-format-argument' with the respective name as value. The whole string receives a `lui-format' property with FORMAT as a value, and a `lui-keywords' argument with KEYWORDS as a value." ;; If it's only a single argument, that argument is a list. (when (not (cdr keywords)) (setq keywords (car keywords))) (cond ((functionp format) (apply format keywords)) ((and (symbolp format) (functionp (symbol-value format))) (apply (symbol-value format) keywords)) (t (let* ((format-string (if (symbolp format) (symbol-value format) format)) (plist (mapcar (lambda (entry) (if (keywordp entry) ;; Keyword -> symbol (intern (substring (symbol-name entry) 1)) entry)) keywords))) (propertize (lui-format-internal format-string plist) 'lui-format format 'lui-keywords keywords))))) (defun lui-format-internal (fmt keywords) "Internal function for `lui-format'. FMT is the format string and KEYWORDS is the symbol-based plist. See `lui-format'." (with-temp-buffer (insert fmt) (goto-char (point-min)) (while (re-search-forward "{{\\|}}\\|{\\([^}]*\\)}" nil t) (cond ((string-equal (match-string 0) "3.1") (replace-match "{")) ((string-equal (match-string 0) "}}") (replace-match "}")) (t ;; (match-string 1) (replace-match (save-match-data (lui-format-single (match-string 1) keywords)) t t)))) (buffer-string))) (defun lui-format-single (specifier keywords) "Format a single braced SPECIFIER according to KEYWORDS. See `lui-format' for details. This adds `lui-format-argument' as necessary." (let* ((split (split-string specifier ":")) (identifier (car split)) (format (cadr split))) (when (not format) (setq format "s")) (propertize (format (concat "%" format) (lui-format-lookup identifier keywords)) 'lui-format-argument (intern identifier)))) (defun lui-format-lookup (identifier keywords) "Lookup the format IDENTIFIER in KEYWORDS. See `lui-format' for details." (cond ((string-match "^\\([0-9]+\\)\\(-\\([0-9]+\\)?\\)?$" identifier) (let ((from (match-string 1 identifier)) (rangep (match-string 2 identifier)) (to (match-string 3 identifier)) (indexed-args (plist-get keywords 'indexed-args))) (if rangep (mapconcat (lambda (element) (if (stringp element) element (format "%s" element))) (lui-sublist indexed-args (string-to-number from) (when to (string-to-number to))) " ") (or (nth (string-to-number from) indexed-args) "")))) (t (or (plist-get keywords (intern identifier)) (error "Unknown keyword argument %S" identifier))))) (defun lui-sublist (list from &optional to) "Return the sublist from LIST starting at FROM and ending at TO." (if (not to) (nthcdr from list) (let ((from-list (nthcdr from list)) (i (- to from)) (to-list nil)) (while (>= i 0) (when (null from-list) (error "Argument out of range: %S" to)) (setq to-list (cons (car from-list) to-list) i (- i 1) from-list (cdr from-list))) (nreverse to-list)))) (provide 'lui-format) ;;; lui-format.el ends here circe-2.6/lui-irc-colors.el000066400000000000000000000137431316355431300156470ustar00rootroot00000000000000;;; lui-irc-colors.el --- Add IRC color support to LUI ;; Copyright (C) 2005 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; This file is part of Lui. ;; 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, write to the Free Software ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA ;; 02110-1301 USA ;;; Commentary: ;; This tells LUI how to display IRC colors: ;; ^B - Bold ;; ^_ - Underline ;; ^V - Inverse ;; ^] - Italic ;; ^O - Return to normal ;; ^C1,2 - Colors ;; The colors are documented at http://www.mirc.co.uk/help/color.txt ;;; Code: (require 'lui) (defgroup lui-irc-colors nil "LUI IRC colors faces." :group 'circe) (defface lui-irc-colors-inverse-face '((t (:inverse-video t))) "Face used for inverse video." :group 'lui-irc-colors) (defun lui-irc-defface (face property on-dark on-light rest doc) (custom-declare-face face `((((type graphic) (class color) (background dark)) (,property ,on-dark)) (((type graphic) (class color) (background light)) (,property ,on-light)) (t (,property ,rest))) doc :group 'lui-irc-colors)) (defun lui-irc-defface-pair (number on-dark on-light rest name) (lui-irc-defface (intern (format "lui-irc-colors-fg-%d-face" number)) :foreground on-dark on-light rest (concat "Face used for foreground IRC color " (number-to-string number) " (" name ").")) (lui-irc-defface (intern (format "lui-irc-colors-bg-%d-face" number)) :background on-light on-dark rest (concat "Face used for background IRC color " (number-to-string number) " (" name ")."))) (defun lui-irc-defface-bulk (colors) (dotimes (n (length colors)) (apply 'lui-irc-defface-pair n (nth n colors)))) (lui-irc-defface-bulk '(("#ffffff" "#585858" "white" "white") ("#a5a5a5" "#000000" "black" "black") ("#9b9bff" "#0000ff" "blue4" "blue") ("#40eb51" "#006600" "green4" "green") ("#ff9696" "#b60000" "red" "red") ("#d19999" "#8f3d3d" "red4" "brown") ("#d68fff" "#9c009c" "magenta4" "purple") ("#ffb812" "#7a4f00" "yellow4" "orange") ("#ffff00" "#5c5c00" "yellow" "yellow") ("#80ff95" "#286338" "green" "light green") ("#00b8b8" "#006078" "cyan4" "teal") ("#00ffff" "#006363" "cyan" "light cyan") ("#a8aeff" "#3f568c" "blue" "light blue") ("#ff8bff" "#853885" "magenta" "pink") ("#cfcfcf" "#171717" "dimgray" "grey") ("#e6e6e6" "#303030" "gray" "light grey"))) (defvar lui-irc-colors-regex "\\(\x02\\|\x1F\\|\x16\\|\x1D\\|\x0F\\|\x03\\)" "A regular expression matching IRC control codes.") ;;;###autoload (defun enable-lui-irc-colors () "Enable IRC color interpretation for Lui." (interactive) (add-hook 'lui-pre-output-hook 'lui-irc-colors)) (defun disable-lui-irc-colors () "Disable IRC color interpretation for Lui." (interactive) (remove-hook 'lui-pre-output-hook 'lui-irc-colors)) (defun lui-irc-colors () "Add color faces for IRC colors. This is an appropriate function for `lui-pre-output-hook'." (goto-char (point-min)) (let ((start (point)) (boldp nil) (inversep nil) (italicp nil) (underlinep nil) (fg nil) (bg nil)) (while (re-search-forward lui-irc-colors-regex nil t) (lui-irc-propertize start (point) boldp inversep italicp underlinep fg bg) (let ((code (match-string 1))) (replace-match "") (setq start (point)) (cond ((string= code "") (setq boldp (not boldp))) ((string= code "") (setq inversep (not inversep))) ((string= code "") (setq italicp (not italicp))) ((string= code "") (setq underlinep (not underlinep))) ((string= code "") (setq boldp nil inversep nil italicp nil underlinep nil fg nil bg nil)) ((string= code "") (if (looking-at "\\([0-9][0-9]?\\)\\(,\\([0-9][0-9]?\\)\\)?") (progn (setq fg (string-to-number (match-string 1)) bg (if (match-string 2) (string-to-number (match-string 3)) bg)) (setq fg (if (and fg (not (= fg 99))) (mod fg 16) nil) bg (if (and bg (not (= bg 99))) (mod bg 16) nil)) (replace-match "")) (setq fg nil bg nil))) (t (error "lui-irc-colors: Can't happen!"))))) (lui-irc-propertize (point) (point-max) boldp inversep italicp underlinep fg bg))) (defun lui-irc-propertize (start end boldp inversep italicp underlinep fg bg) "Propertize the region between START and END." (let ((faces (append (and boldp '(bold)) (and inversep '(lui-irc-colors-inverse-face)) (and italicp '(italic)) (and underlinep '(underline)) (and fg (list (lui-irc-colors-face 'fg fg))) (and bg (list (lui-irc-colors-face 'bg bg)))))) (when faces (add-face-text-property start end faces)))) (defun lui-irc-colors-face (type n) "Return a face appropriate for face number N. TYPE is either 'fg or 'bg." (if (and (<= 0 n) (<= n 15)) (intern (format "lui-irc-colors-%s-%s-face" type n)) 'default-face)) (provide 'lui-irc-colors) ;;; lui-irc-colors.el ends here circe-2.6/lui-logging.el000066400000000000000000000156041316355431300152170ustar00rootroot00000000000000;;; lui-logging.el --- Logging support for lui ;; Copyright (C) 2006 Jorgen Schaefer, ;; 2012 Anthony Martinez ;; Author: Anthony Martinez ;; This file is part of Lui. ;; 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, write to the Free Software ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA ;; 02110-1301 USA ;;; Commentary: ;; This lui module enables logging. Lui applications can change the ;; values of `lui-logging-format-arguments' to provide further ;; possibilities of customizing `lui-logging-file-format' for users. ;;; Code: (require 'lui-format) (require 'url-util) (defgroup lui-logging nil "Logging support." :prefix "lui-logging-" :group 'lui) (defcustom lui-logging-format "[%T] {text}" "The format used for log file entries. This is first passed through `format-time-string' and then through `lui-format'. The following format strings exist: {text} - the text to be logged" :type 'string :group 'lui-logging) (defcustom lui-logging-directory "~/.logs" "The directory where log files are stored." :type 'directory :group 'lui-logging) (defcustom lui-logging-file-format "{buffer}_%Y-%m-%d.txt" "The format to be used for the log file name. This is first passed through `format-time-string', and then through `lui-format'. Possible lui format strings are: {buffer} - the buffer name where the logging happened. Lui applications can provide further format strings. See `lui-logging-format-arguments' in the appropriate buffer." :type 'string :group 'lui-logging) (defcustom lui-logging-flush-delay 0 "The number of seconds to delay writing newly-received messages to disk. This can increase performance/decrease IO-wait at the cost of a little bit of safety." :type 'integer :group 'lui-logging) (defvar lui-logging-format-arguments nil "A list of arguments to be passed to `lui-format'. This can be used to extend the formatting possibilities of the file name for lui applications.") (make-variable-buffer-local 'lui-logging-format-arguments) (defvar lui-logging-file-name-unreserved-chars ;; All but '/' is fine actually, but also omit '%' because otherwise there's ;; ambiguity between one introduced by encoding and a literal one. '(?! ?\" ?# ?$ ?& ?` ?\( ?\) ?* ?+ ?,?: ?\; ?< ?= ?> ?? ?@?\[ ?\\ ?\] ?^ ?` ?\{ ?| ?\}) "A list of characters that should not be percent-encoded by `url-hexify-string' while generating a logging file name.") (defvar lui-pending-logs (make-hash-table :test 'equal) "Storage for log messages awaiting write. It is structured as a hash table mapping filenames to a list-of-strings, which serves as a queue.") (defvar lui-logging-timer nil "The timer used to flush lui-logged buffers") (defun lui-logging-delayed-p () (> lui-logging-flush-delay 0)) (defun enable-lui-logging () "Enable lui logging for this buffer. Also create the log file's directory, should it not exist." (interactive) (add-hook 'lui-pre-output-hook 'lui-logging nil t)) (defun disable-lui-logging () "Disable lui logging for this buffer, and flush any pending logs to disk." (interactive) (remove-hook 'lui-pre-output-hook 'lui-logging t) (lui-logging-flush)) (defun enable-lui-logging-globally () "Enable lui logging for all Lui buffers. This affects current as well as future buffers." (interactive) (add-hook 'lui-mode-hook 'enable-lui-logging) (dolist (buf (buffer-list)) (with-current-buffer buf (when lui-input-marker (enable-lui-logging))))) (defun disable-lui-logging-globally () "Disable logging in all future Lui buffers. This affects current as well as future buffers." (interactive) (remove-hook 'lui-mode-hook 'enable-lui-logging) (dolist (buf (buffer-list)) (with-current-buffer buf (when lui-input-marker (disable-lui-logging))))) (defun lui-logging-file-name () "Create the name of the log file based on `lui-logging-file-format'." (let* ((time-formatted (format-time-string lui-logging-file-format)) (buffer (let ((url-unreserved-chars (append url-unreserved-chars lui-logging-file-name-unreserved-chars)) (downcased (downcase (buffer-name (current-buffer))))) (url-hexify-string downcased))) (filename (apply 'lui-format time-formatted :buffer buffer lui-logging-format-arguments))) (concat lui-logging-directory "/" filename))) (defun lui-logging-flush () "Flush out the lui-logging queue, and clear the timer set by `lui-logging'." (maphash #'lui-logging-flush-file lui-pending-logs) (clrhash lui-pending-logs) (cancel-timer lui-logging-timer) (setq lui-logging-timer nil)) (defun lui-logging-write-to-log (file-name content) "Actually perform a write to the logfile." (let ((coding-system-for-write 'raw-text) (dir (file-name-directory file-name))) (when (not (file-directory-p dir)) (make-directory dir t)) (write-region content nil file-name t 'nomessage))) (defun lui-logging-flush-file (file-name queue) "Consume the logging queue and write the content to the log file." (let ((content (apply #'concat (nreverse queue)))) (lui-logging-write-to-log file-name content))) (defun lui-logging-format-string (text) "Generate a string to be either directly written or enqueued." (substring-no-properties (lui-format (format-time-string lui-logging-format) :text text))) (defun lui-logging-enqueue (file-name text) "Given a filename, push text onto its queue, and tickle the timer, if necessary." (puthash file-name (cons text (gethash file-name lui-pending-logs)) lui-pending-logs) (when (null lui-logging-timer) (setq lui-logging-timer (run-with-timer lui-logging-flush-delay nil #'lui-logging-flush)))) (defun lui-logging () "If output-queueing is enabled, append the to-be-logged string to the output queue. Otherwise, write directly to the logfile. This should be added to `lui-pre-output-hook' by way of `enable-lui-logging'." (let ((text (lui-logging-format-string (buffer-string)))) (if (lui-logging-delayed-p) (lui-logging-enqueue (lui-logging-file-name) text) (lui-logging-write-to-log (lui-logging-file-name) text)))) (provide 'lui-logging) ;;; lui-logging.el ends here circe-2.6/lui-track-bar.el000066400000000000000000000074271316355431300154430ustar00rootroot00000000000000;;; lui-track-bar.el --- Provides a bar to track the last read position ;; Copyright (C) 2016 Vasilij Schneidermann ;; Author: Vasilij Schneidermann ;; This file is part of LUI. ;; 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, write to the Free Software ;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA ;; 02110-1301 USA ;;; Commentary: ;; This allows you to track where you've last left off a buffer. ;; Use (enable-lui-track-bar) to enable this mode globally. You can ;; customize `lui-track-bar-behavior' to change when the track bar ;; moves. You can also use M-x lui-track-bar-move to move the track ;; bar manually. ;;; Code: (require 'lui) (require 'tracking) (defgroup lui-track-bar nil "Last read position tracking for LUI" :prefix "lui-track-bar-" :group 'lui) (defcustom lui-track-bar-behavior 'before-switch-to-buffer "When to move the track bar. The following values are possible. before-switch-to-buffer (default) Move the bar to the bottom of the buffer when switching away from a buffer. before-tracking-next-buffer Move the bar when switching to the next buffer using \\[tracking-next-buffer]. after-send Move the bar after sending a message." :type '(choice (const :tag "Before switching buffers" before-switch-to-buffer) (const :tag "Before tracking switch" before-tracking-next-buffer) (const :tag "After sending" after-send)) :group 'lui-track-bar) (defface lui-track-bar '((((type graphic) (background light)) :inherit default :background "dim gray" :height 0.1) (((type graphic) (background dark)) :inherit default :background "light gray" :height 0.1) (((type tty)) :inherit (font-lock-comment-face default) :underline t)) "Track bar face" :group 'lui-track-bar) (defvar lui-track-bar-overlay nil) (make-variable-buffer-local 'lui-track-bar-overlay) ;;;###autoload (defun enable-lui-track-bar () "Enable a bar in Lui buffers that shows where you stopped reading." (interactive) (defadvice switch-to-buffer (before lui-track-bar activate) (when (and (eq lui-track-bar-behavior 'before-switch-to-buffer) ;; Do not move the bar if the buffer is displayed still (<= (length (get-buffer-window-list (current-buffer))) 1)) (lui-track-bar-move))) (defadvice tracking-next-buffer (before lui-track-bar activate) (when (eq lui-track-bar-behavior 'before-tracking-next-buffer) (lui-track-bar-move))) (add-hook 'lui-pre-input-hook 'lui-track-bar--move-pre-input)) (defun lui-track-bar--move-pre-input () (when (eq lui-track-bar-behavior 'after-send) (lui-track-bar-move))) (defun lui-track-bar-move () "Move the track bar down." (interactive) (when (derived-mode-p 'lui-mode) (when (not lui-track-bar-overlay) (setq lui-track-bar-overlay (make-overlay (point-min) (point-min))) (overlay-put lui-track-bar-overlay 'after-string (propertize "\n" 'face 'lui-track-bar))) (move-overlay lui-track-bar-overlay lui-output-marker lui-output-marker))) (provide 'lui-track-bar) ;;; lui-track-bar.el ends here circe-2.6/lui.el000066400000000000000000001503031316355431300135670ustar00rootroot00000000000000;;; lui.el --- Linewise User Interface -*- lexical-binding: t -*- ;; Copyright (C) 2005 - 2016 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; URL: https://github.com/jorgenschaefer/circe/wiki/Lui ;; 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: ;; Lui is a library for other Emacs Lisp programs and not useful by ;; itself. ;; This major mode provides a user interface for applications. The ;; user interface is quite simple, consisting of an input line, a ;; prompt, and some output area, but Lui includes a lot of common ;; options, such as time stamps, filling, colorization, etc. ;; Application programs should create modes derived from lui-mode. ;; The application API consists of: ;; lui-mode ;; lui-set-prompt ;; lui-insert ;; lui-input-function ;; lui-completion-function ;; lui-time-stamp-time ;; lui-time-stamp-zone ;; and the 'lui-fool and 'lui-do-not-track text properties ;;; Code: (require 'button) (require 'flyspell) (require 'help-mode) (require 'ispell) (require 'paren) (require 'ring) (require 'thingatpt) (require 'rx) (require 'tracking) ;;;;;;;;;;;;;;;;;;;;; ;;; Customization ;;; ;;;;;;;;;;;;;;;;;;;;; (defgroup lui nil "The Linewise User Interface." :prefix "lui-" :group 'applications) (defcustom lui-scroll-behavior t "Set the behavior lui should exhibit for scrolling. The following values are possible. If in doubt, use post-output. nil Use default Emacs scrolling. post-command Keep the input line at the end of the window if point is after the input mark. post-output Keep the input line at the end of the window only after output. t Combine both post-command and post-output. post-scroll Keep the input line at the end of the window on every scroll event. Careful, this might interact badly with other functions on `window-scroll-functions'. It would be entirely sensible for Emacs to provide a setting to do this kind of scrolling by default in a buffer. It seems rather intuitive and sensible. But as noted on emacs-devel: [T]hose who know the code know that it's going to be a pain to implement, especially if you want acceptable performance. IOW, patches welcome The full discussion can be found here: https://lists.gnu.org/archive/html/emacs-devel/2012-10/msg00652.html These settings are all hacks that try to give the user the choice between most correct behavior (post-scroll) and most compliant behavior (post-output)." :type '(choice (const :tag "Post Command" t) (const :tag "Post Output" post-output) (const :tag "Post Scroll" post-scroll) (const :tag "Use default scrolling" nil)) :group 'lui) (defvaralias 'lui-scroll-to-bottom-p 'lui-scroll-behavior) (defcustom lui-flyspell-p nil "Non-nil if Lui should spell-check your input. See the function `flyspell-mode' for more information." :type 'boolean :group 'lui) (defcustom lui-flyspell-alist nil "Alist of buffer dictionaries. This is a list of mappings from buffers to dictionaries to use for the function `flyspell-mode'. The appropriate dictionary is automatically used when Lui is activated in a buffer with a matching buffer name. The entries are of the form (REGEXP DICTIONARY), where REGEXP must match a buffer name, and DICTIONARY specifies an existing dictionary for the function `flyspell-mode'. See `ispell-local-dictionary-alist' and `ispell-dictionary-alist' for a valid list of dictionaries." :type 'string :group 'lui) (defcustom lui-highlight-keywords nil "A list of keywords to highlight. This specifies a list of keywords that Lui should highlight. Each entry is of one of the following forms (similar to `font-lock-keywords'): REGEXP Highlight every match in `lui-highlight-face' (REGEXP SUBMATCH) Highlight the SUBMATCH (a number) in REGEXP in `lui-highlight-face' (REGEXP FACE) Highlight everything matching REGEXP in FACE (a symbol) (REGEXP SUBMATCH FACE) Highlight the SUBMATCH in REGEXP in FACE In all of these cases, the FACE can also be a property list which is then associated with the match. All matches are run, which means later matches can override changes by earlier ones." :type '(repeat (choice (string :tag "Regular Expression") (list :tag "Submatch" (string :tag "Regular Expression") (integer :tag "Submatch")) (list :tag "Regular Expression in Specific Face" (string :tag "Regular Expression") (face :tag "Face")) (list :tag "Submatch in Specific Face" (string :tag "Regular Expression") (integer :tag "Submatch") (face :tag "Face")))) :group 'lui) (defface lui-strong-face '((t (:inherit bold))) "Face used for strong markup." :group 'lui-irc-colors) (defface lui-emphasis-face '((t (:inherit italic))) "Face for emphasis markup." :group 'lui-irc-colors) (defface lui-deleted-face '((t (:strike-through t))) "Face for deleted messages" :group 'lui-irc-colors) (defcustom lui-formatting-list nil "List of enabled formatting types. Each list item is a list consisting of a regular expression matching the highlighted text, an integer for the submatch and a face for highlighting the match." :type `(set (const :tag "*Strong* text" (,(rx (or bol whitespace) (group "*" (+? (not (any whitespace "*"))) "*") (or eol whitespace)) 1 lui-strong-face)) (const :tag "_Emphasized_ text" (,(rx (or bol whitespace) (group "_" (+? (not (any whitespace "_"))) "_") (or eol whitespace)) 1 lui-emphasis-face))) :group 'lui) (defcustom lui-buttons-list `(("`\\([A-Za-z0-9+=*/-]+\\)'" 1 lui-button-elisp-symbol 1) ("\\") 'lui-previous-button) (define-key map (kbd "") 'lui-previous-button) (define-key map (kbd "M-p") 'lui-previous-input) (define-key map (kbd "M-n") 'lui-next-input) (define-key map (kbd "C-c C-u") 'lui-kill-to-beginning-of-line) (define-key map (kbd "C-c C-i") 'lui-fool-toggle-display) map) "The key map used in Lui modes.") (defvar lui-input-marker nil "The marker where input should be inserted.") (make-variable-buffer-local 'lui-input-marker) (defvar lui-output-marker nil "The marker where output should be inserted. Use `lui-insert' instead of accessing this marker directly.") (make-variable-buffer-local 'lui-output-marker) (defvar lui-input-ring nil "The input history ring.") (make-variable-buffer-local 'lui-input-ring) (defvar lui-input-ring-index nil "The index to the current item in the input ring.") (make-variable-buffer-local 'lui-input-ring-index) ;;;;;;;;;;;;;; ;;; Macros ;;; ;;;;;;;;;;;;;; (defmacro lui-save-undo-list (&rest body) "Run BODY without modifying the undo list." (let ((old-marker-sym (make-symbol "old-marker"))) `(let ((,old-marker-sym (marker-position lui-input-marker)) (val nil)) ;; Don't modify the undo list. The undo list is for the user's ;; input only. (let ((buffer-undo-list t)) (setq val (progn ,@body))) (when (consp buffer-undo-list) ;; Not t :-) (lui-adjust-undo-list ,old-marker-sym (- lui-input-marker ,old-marker-sym))) val))) ;;;;;;;;;;;;;;;;;; ;;; Major Mode ;;; ;;;;;;;;;;;;;;;;;; (define-derived-mode lui-mode nil "LUI" "The Linewise User Interface mode. This can be used as a user interface for various applications. Those should define derived modes of this, so this function should never be called directly. It can be customized for an application by specifying a `lui-input-function'." (setq lui-input-marker (make-marker) lui-output-marker (make-marker) lui-input-ring (make-ring lui-input-ring-size) lui-input-ring-index nil flyspell-generic-check-word-p 'lui-flyspell-check-word-p) (set-marker lui-input-marker (point-max)) (set-marker lui-output-marker (point-max)) (add-hook 'window-scroll-functions 'lui-scroll-window nil t) (add-hook 'post-command-hook 'lui-scroll-post-command) (add-hook 'change-major-mode-hook 'lui-change-major-mode nil t) (lui-paren-highlighting) (lui-time-stamp-enable-filtering) (tracking-mode 1) (auto-fill-mode 0) (when (fboundp 'cursor-intangible-mode) (cursor-intangible-mode 1)) (when lui-flyspell-p (require 'flyspell) (lui-flyspell-change-dictionary))) (defun lui-change-major-mode () "Assure that the user really wants to change the major mode. This is a good value for a buffer-local `change-major-mode-hook'." (when (not (y-or-n-p "Really change major mode in a Lui buffer? ")) (error "User disallowed mode change"))) (defun lui-scroll-window (window _display-start) "Scroll the input line to the bottom of the WINDOW. DISPLAY-START is passed by the hook `window-scroll-functions' and is ignored. See `lui-scroll-behavior' for how to customize this." (when (and (eq lui-scroll-behavior 'post-scroll) window (window-live-p window)) (with-selected-window window (when (or (>= (point) lui-input-marker) (equal (point-max) (window-end nil t))) (let ((resize-mini-windows nil)) (save-excursion (goto-char (point-max)) (recenter -1))))))) (defun lui-scroll-post-command () "Scroll the input line to the bottom of the window. This is called from `post-command-hook'. See `lui-scroll-behavior' for how to customize this." (condition-case err (dolist (w (window-list)) (with-current-buffer (window-buffer w) (when (and lui-input-marker (memq lui-scroll-behavior '(t post-command))) ;; Code from ERC's erc-goodies.el. I think this was originally ;; mine anyhow, not sure though. (save-restriction (widen) (when (>= (point) lui-input-marker) (save-excursion (goto-char (point-max)) (with-selected-window w (recenter -1)))))))) (error (message "Error in lui-scroll-post-command: %S" err) ))) (defun lui-scroll-post-output () "Scroll the input line to the bottom of the window. This is called when lui output happens. See `lui-scroll-behavior' for how to customize this." (when (memq lui-scroll-behavior '(t post-output)) (let ((resize-mini-windows nil)) (dolist (window (get-buffer-window-list (current-buffer) nil t)) (when (or (>= (point) lui-input-marker) (equal (point-max) (window-end window))) (with-selected-window window (save-excursion (goto-char (point-max)) (recenter -1)))))))) ;;;;;;;;;;;;; ;;; Input ;;; ;;;;;;;;;;;;; (defun lui-send-input () "Send the current input to the Lui application. If point is not in the input area, insert a newline." (interactive) (if (< (point) lui-input-marker) (newline) (save-restriction (narrow-to-region lui-input-marker (point-max)) (run-hooks 'lui-pre-input-hook)) (let ((input (buffer-substring lui-input-marker (point-max)))) (delete-region lui-input-marker (point-max)) (lui-add-input input) (if lui-input-function (funcall lui-input-function input) (error "No input function specified"))))) (defun lui-add-input (input) "Add INPUT as if entered by the user." (ring-insert lui-input-ring input) (setq lui-input-ring-index nil)) ;;;;;;;;;;;;;;; ;;; Buttons ;;; ;;;;;;;;;;;;;;; (define-button-type 'lui-button 'supertype 'button 'follow-link t 'face 'lui-button-face) (defun lui-buttonize () "Buttonize the current message." (lui-buttonize-urls) (lui-buttonize-custom) (lui-buttonize-issues)) (defun lui-buttonize-custom () "Add custom buttons to the current message. This uses `lui-buttons-list'." (dolist (entry lui-buttons-list) (let ((regex (nth 0 entry)) (submatch (nth 1 entry)) (function-or-url (nth 2 entry)) (arg-matches (nthcdr 3 entry))) (goto-char (point-min)) (while (re-search-forward regex nil t) ;; Ensure we're not inserting a button inside a URL button (when (not (button-at (match-beginning 0))) (let* ((function (if (functionp function-or-url) function-or-url 'browse-url)) (matches (mapcar (lambda (n) (match-string-no-properties n)) arg-matches)) (arguments (if (functionp function-or-url) matches (list (apply #'format function-or-url matches))))) (make-button (match-beginning submatch) (match-end submatch) 'type 'lui-button 'action 'lui-button-activate 'lui-button-function function 'lui-button-arguments arguments))))))) (defun lui-buttonize-issues () "Buttonize issue references in the current message, if configured." (when lui-button-issue-tracker (goto-char (point-min)) (while (re-search-forward "\\(?:^\\|\\W\\)\\(#\\([0-9]+\\)\\)" nil t) ;; Ensure we're not inserting a button inside a URL button (when (not (button-at (point))) (make-button (match-beginning 1) (match-end 1) 'type 'lui-button 'action 'lui-button-activate 'lui-button-function 'browse-url 'lui-button-arguments (list (format lui-button-issue-tracker (match-string 2)))))))) (defun lui-buttonize-urls () "Buttonize URLs in the current message." (let ((regex (regexp-opt thing-at-point-uri-schemes))) (goto-char (point-min)) (while (re-search-forward regex nil t) (let ((bounds (bounds-of-thing-at-point 'url))) (when bounds (make-button (car bounds) (cdr bounds) 'type 'lui-button 'action 'lui-button-activate 'lui-button-function 'browse-url 'lui-button-arguments (list (buffer-substring-no-properties (car bounds) (cdr bounds))))))))) (defun lui-button-activate (button) "Activate BUTTON. This calls the function stored in the `lui-button-function' property with the argument stored in `lui-button-arguments'." (apply (button-get button 'lui-button-function) (button-get button 'lui-button-arguments))) (defun lui-next-button-or-complete () "Go to the next button, or complete at point. When point is in the input line, call `lui-completion-function'. Otherwise, we move to the next button." (interactive) (if (>= (point) lui-input-marker) (funcall lui-completion-function) (forward-button 1))) (defun lui-previous-button () "Go to the previous button." (interactive) (backward-button 1)) (defun lui-button-elisp-symbol (name) "Show the documentation for the symbol named NAME." (let ((sym (intern-soft name))) (cond ((not sym) (message "No such symbol %s" name) (ding)) (t (help-xref-interned sym))))) (defun lui-button-pep (number) "Browse the PEP NUMBER." (browse-url (format "https://www.python.org/dev/peps/pep-%04i" (string-to-number number)))) (defun lui-button-issue (issue) "Browse the issue tracker number ISSUE, if configured." (if lui-button-issue-tracker (browse-url (format lui-button-issue-tracker issue)) (error "No issue tracker configured, see `lui-button-issue-tracker'"))) ;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Input Line Killing ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;; (defun lui-kill-to-beginning-of-line () "Kill the input from point to the beginning of the input." (interactive) (let* ((beg (point-at-bol)) (end (point)) (str (buffer-substring beg end))) (delete-region beg end) (kill-new str))) ;;;;;;;;;;;;;;;;;;;;; ;;; Input History ;;; ;;;;;;;;;;;;;;;;;;;;; ;; FIXME! ;; These need some better algorithm. They clobber input when it is not ;; in the ring! (defun lui-previous-input () "Cycle through the input history to the last input." (interactive) (when (> (ring-length lui-input-ring) 0) (if (and lui-input-ring-index (= (1- (ring-length lui-input-ring)) lui-input-ring-index)) ;; last item - insert a single empty line (progn (lui-replace-input "") (setq lui-input-ring-index nil)) ;; If any input is left, store it in the input ring (when (and (null lui-input-ring-index) (> (point-max) lui-input-marker)) (ring-insert lui-input-ring (buffer-substring lui-input-marker (point-max))) (setq lui-input-ring-index 0)) ;; Increment the index (setq lui-input-ring-index (if lui-input-ring-index (ring-plus1 lui-input-ring-index (ring-length lui-input-ring)) 0)) ;; And insert the last input (lui-replace-input (ring-ref lui-input-ring lui-input-ring-index)) (goto-char (point-max))))) (defun lui-next-input () "Cycle through the input history to the next input." (interactive) (when (> (ring-length lui-input-ring) 0) (if (and lui-input-ring-index (= 0 lui-input-ring-index)) ;; first item - insert a single empty line (progn (lui-replace-input "") (setq lui-input-ring-index nil)) ;; If any input is left, store it in the input ring (when (and (null lui-input-ring-index) (> (point-max) lui-input-marker)) (ring-insert lui-input-ring (buffer-substring lui-input-marker (point-max))) (setq lui-input-ring-index 0)) ;; Decrement the index (setq lui-input-ring-index (ring-minus1 (or lui-input-ring-index 0) (ring-length lui-input-ring))) ;; And insert the next input (lui-replace-input (ring-ref lui-input-ring lui-input-ring-index)) (goto-char (point-max))))) (defun lui-replace-input (str) "Replace input with STR." (save-excursion (goto-char lui-input-marker) (delete-region lui-input-marker (point-max)) (insert str))) ;;;;;;;;;;;;; ;;; Fools ;;; ;;;;;;;;;;;;; (defun lui-fools () "Propertize the current narrowing according to foolhardiness. That is, if any part of it has the text property 'lui-fool set, make the whole thing invisible." (when (text-property-any (point-min) (point-max) 'lui-fool t) (add-text-properties (point-min) (point-max) '(invisible lui-fool)))) (defun lui-fools-hidden-p () "Return whether fools are currently hidden." (if (or (eq t buffer-invisibility-spec) (memq 'lui-fool buffer-invisibility-spec)) t nil)) (defun lui-fool-toggle-display () "Display what fools have said." (interactive) (when (eq buffer-invisibility-spec t) (add-to-invisibility-spec 'lui-fool)) (cond ((lui-fools-hidden-p) (message "Now showing the gibberish of fools") (remove-from-invisibility-spec 'lui-fool)) (t (message "Now hiding fools again *phew*") (add-to-invisibility-spec 'lui-fool))) ;; For some reason, after this, the display does not always update ;; (issue #31). Force an update just in case. (force-mode-line-update t)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Blink Paren and Show Paren Mode ;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun lui-paren-highlighting () "Enable sane parenthesis highlighting in this buffer." (set (make-local-variable 'blink-paren-function) 'lui-blink-paren-function) (when (boundp 'show-paren-data-function) (set (make-local-variable 'show-paren-data-function) 'lui-show-paren-data-function))) (defun lui-blink-paren-function () "Do not blink opening parens outside of the lui input area. When point is within the lui input area, inserting a closing parenthesis should only blink parens within the input area, not outside of it. This is a suitable value for `blink-paren-function', which see." (if (> (point) lui-input-marker) (let ((blink-matching-paren-distance (- (point) lui-input-marker))) (blink-matching-open)) (blink-matching-open))) (defun lui-show-paren-data-function () "Show parens only within the input area. When `show-paren-mode' is enabled, and point is in the input area, parenthesis highlighting should only happen within the input area, not include the rest of the buffer. This is a suitable value for `show-paren-data-function', which see." (when (fboundp 'show-paren--default) (let ((range (show-paren--default))) (if (or (< (point) lui-input-marker) (not (elt range 2)) (>= (elt range 2) lui-input-marker)) range nil)))) ;;;;;;;;;;;;;;;; ;;; Flyspell ;;; ;;;;;;;;;;;;;;;; (defun lui-flyspell-change-dictionary (&optional dictionary) "*Change flyspell to DICTIONARY. If DICTIONARY is nil, set a default dictionary according to `lui-flyspell-alist'. If it is \"\", disable flyspell." (interactive (list (completing-read "Use new dictionary (RET for none, SPC to complete): " (and (fboundp 'ispell-valid-dictionary-list) (mapcar 'list (ispell-valid-dictionary-list))) nil t))) (let ((dictionary (or dictionary (lui-find-dictionary (buffer-name))))) (when flyspell-mode (flyspell-mode 0)) (when (and dictionary (not (equal dictionary ""))) (ispell-change-dictionary dictionary)) (flyspell-mode 1))) (defun lui-find-dictionary (buffer-name) "Return a dictionary appropriate for BUFFER-NAME." (let ((lis lui-flyspell-alist) (result nil)) (while lis (if (string-match (caar lis) buffer-name) (setq result (cadr (car lis)) lis nil) (setq lis (cdr lis)))) result)) (defun lui-flyspell-check-word-p () "Return non-nil when flyspell should verify at this position. This is the value of Lui for `flyspell-generic-check-word-p'." (>= (point) lui-input-marker)) ;;;;;;;;;;;;;; ;;; Output ;;; ;;;;;;;;;;;;;; (defvar lui-message-id 0 "Unique id for each message. Used to allow navigation between messages and editing and deleting.") (make-variable-buffer-local 'lui-message-id) (defvar lui-internal-text-properties '(lui-formatted-time-stamp lui-time-stamp-last lui-raw-text lui-message-id lui-saved-text-properties) "Text properties used internally by lui. These are always kept when replacing messages.") (defun lui-insert (str &optional not-tracked-p) "Insert STR into the current Lui buffer. If NOT-TRACKED-P is given, this insertion won't trigger tracking of the buffer." (if not-tracked-p (lui-insert-with-text-properties str 'not-tracked-p t) (lui-insert-with-text-properties str))) (defun lui-plist-keys (plist) "Get the keys from PLIST. PLIST should be a flat list with keys and values alternating, like used for setting and getting text properties." (let ((key t) result) (dolist (item plist (reverse result)) (when key (push item result)) (setq key (not key))))) (defun lui-insert-with-text-properties (str &rest text-properties) "Insert STR into the current Lui buffer. TEXT-PROPERTIES is a property list containing text properties to add to the inserted message." (let ((not-tracked-p (plist-get text-properties 'not-tracked-p)) (saved-text-properties (append (lui-plist-keys text-properties) lui-internal-text-properties))) (lui-save-undo-list (save-excursion (save-restriction (let ((inhibit-read-only t) (inhibit-point-motion-hooks t)) (widen) (goto-char lui-output-marker) (let ((beg (point)) (end nil)) (insert str "\n") (setq end (point)) (set-marker lui-output-marker (point)) (narrow-to-region beg end)) (goto-char (point-min)) (add-text-properties (point-min) (point-max) `(lui-raw-text ,str)) (run-hooks 'lui-pre-output-hook) (lui-apply-formatting) (lui-highlight-keywords) (lui-buttonize) (lui-fill) (lui-time-stamp (plist-get text-properties 'lui-formatted-time-stamp)) (goto-char (point-min)) (add-text-properties (point-min) (point-max) (plist-put text-properties 'lui-message-id lui-message-id)) (setq lui-message-id (1+ lui-message-id)) (run-hooks 'lui-post-output-hook) (lui-fools) (goto-char (point-min)) (let ((faces (lui-faces-in-region (point-min) (point-max))) (foolish (text-property-any (point-min) (point-max) 'lui-fool t)) (not-tracked-p (or not-tracked-p (text-property-any (point-min) (point-max) 'lui-do-not-track t)))) (widen) (lui-truncate) (lui-read-only) (when (and (not not-tracked-p) (not foolish)) (tracking-add-buffer (current-buffer) faces))) (lui-scroll-post-output) (add-text-properties (point-min) (point-max) `(lui-saved-text-properties ,saved-text-properties)))))))) (defun lui--adjust-p (pos old) (and (numberp pos) (>= (abs pos) old))) (defun lui--new-pos (pos shift) (* (if (< pos 0) -1 1) (+ (abs pos) shift))) (defun lui-adjust-undo-list (old-begin shift) ;; Translate buffer positions in buffer-undo-list by SHIFT. (unless (or (zerop shift) (atom buffer-undo-list)) (let ((list buffer-undo-list) elt) (while list (setq elt (car list)) (cond ((integerp elt) ; POSITION (if (lui--adjust-p elt old-begin) (setf (car list) (lui--new-pos elt shift)))) ((or (atom elt) ; nil, EXTENT (markerp (car elt))) ; (MARKER . DISTANCE) nil) ((integerp (car elt)) ; (BEGIN . END) (if (lui--adjust-p (car elt) old-begin) (setf (car elt) (lui--new-pos (car elt) shift))) (if (lui--adjust-p (cdr elt) old-begin) (setf (cdr elt) (lui--new-pos (cdr elt) shift)))) ((stringp (car elt)) ; (TEXT . POSITION) (if (lui--adjust-p (cdr elt) old-begin) (setf (cdr elt) (lui--new-pos (cdr elt) shift)))) ((null (car elt)) ; (nil PROPERTY VALUE BEG . END) (let ((cons (nthcdr 3 elt))) (if (lui--adjust-p (car cons) old-begin) (setf (car cons) (lui--new-pos (car cons) shift))) (if (lui--adjust-p (cdr cons) old-begin) (setf (cdr cons) (lui--new-pos (cdr cons) shift))))) ((and (featurep 'xemacs) (extentp (car elt))) ; (EXTENT START END) (if (lui--adjust-p (nth 1 elt) old-begin) (setf (nth 1 elt) (lui--new-pos (nth 1 elt) shift))) (if (lui--adjust-p (nth 2 elt) old-begin) (setf (nth 2 elt) (lui--new-pos (nth 2 elt) shift))))) (setq list (cdr list)))))) (defvar lui-prompt-map (let ((map (make-sparse-keymap))) (define-key map (kbd "") 'lui-prompt-end-of-line) (define-key map (kbd "C-e") 'lui-prompt-end-of-line) map) "Keymap for Lui prompts. Since \\[end-of-line] can't move out of fields, this DTRT for an unexpecting user.") (defun lui-set-prompt (prompt) "Set PROMPT as the current Lui prompt." (let ((inhibit-read-only t)) (lui-save-undo-list (save-excursion (goto-char lui-output-marker) (insert prompt) (if (> lui-input-marker (point)) (delete-region (point) lui-input-marker) (set-marker lui-input-marker (point))) (add-text-properties lui-output-marker lui-input-marker `(read-only t rear-nonsticky t field lui-prompt keymap ,lui-prompt-map front-sticky t )))))) (defun lui-prompt-end-of-line (&optional _N) "Move past the prompt, and then to the end of the line. This uses `end-of-line'. The argument N is ignored." (interactive "p") (goto-char lui-input-marker) (call-interactively 'end-of-line)) (defun lui-faces-in-region (beg end) "Return a face that describes the region between BEG and END." (goto-char beg) (let ((faces nil)) (while (not (= (point) end)) (let ((face (get-text-property (point) 'face))) (dolist (face (if (consp face) face (list face))) (when (and face (facep face) (face-differs-from-default-p face)) (push face faces))) (goto-char (next-single-property-change (point) 'face nil end)))) faces)) ;;;;;;;;;;;;;;;;;;;; ;;; Highlighting ;;; ;;;;;;;;;;;;;;;;;;;; (defun lui-highlight-keywords () "Highlight the entries in the variable `lui-highlight-keywords'. This is called automatically when new text is inserted." (let ((regex (lambda (entry) (if (stringp entry) entry (car entry)))) (submatch (lambda (entry) (if (and (consp entry) (numberp (cadr entry))) (cadr entry) 0))) (properties (lambda (entry) (let ((face (cond ;; REGEXP ((stringp entry) 'lui-highlight-face) ;; (REGEXP SUBMATCH) ((and (numberp (cadr entry)) (null (cddr entry))) 'lui-highlight-face) ;; (REGEXP FACE) ((null (cddr entry)) (cadr entry)) ;; (REGEXP SUBMATCH FACE) (t (nth 2 entry))))) (if (facep face) `(face ,face) face))))) (dolist (entry lui-highlight-keywords) (goto-char (point-min)) (while (re-search-forward (funcall regex entry) nil t) (let* ((exp (funcall submatch entry)) (beg (match-beginning exp)) (end (match-end exp))) (when (not (text-property-any beg end 'lui-highlight-fontified-p t)) (add-text-properties beg end (append (funcall properties entry) '(lui-highlight-fontified-p t))))))))) (defun lui-apply-formatting () "Highlight the entries in `lui-formatting-list'." (dolist (entry lui-formatting-list) (goto-char (point-min)) (let ((re (car entry)) (subgroup (cadr entry)) (face (nth 2 entry))) (while (re-search-forward re nil t) (when face (add-face-text-property (match-beginning subgroup) (match-end subgroup) face nil (current-buffer))))))) ;;;;;;;;;;;;;;; ;;; Filling ;;; ;;;;;;;;;;;;;;; (defun lui-fill () "Fill the text in the buffer. This is called automatically when new text is inserted. See `lui-fill-type' and `lui-fill-column' on how to customize this function." (cond ((stringp lui-fill-type) (let ((fill-prefix lui-fill-type) (fill-column (or lui-fill-column fill-column))) (fill-region (point-min) (point-max) nil t))) ((eq lui-fill-type 'variable) (let ((fill-prefix (save-excursion (goto-char (point-min)) (let ((beg (point))) (re-search-forward "\\s-" nil t) (make-string (- (point) beg) ? )))) (fill-column (or lui-fill-column fill-column))) (fill-region (point-min) (point-max) nil t))) ((numberp lui-fill-type) (let ((right-end (save-excursion (goto-char (point-min)) (re-search-forward "\\s-" nil t) (- (point) (point-at-bol))))) (goto-char (point-min)) (when (< right-end lui-fill-type) (insert (make-string (- lui-fill-type right-end) ? ))) (let ((fill-prefix (make-string lui-fill-type ? )) (fill-column (or lui-fill-column fill-column))) (fill-region (point-min) (point-max) nil t))))) (when lui-fill-remove-face-from-newline (goto-char (point-min)) (while (re-search-forward "\n" nil t) (put-text-property (match-beginning 0) (match-end 0) 'face nil)))) ;;;;;;;;;;;;;;;;;;; ;;; Time Stamps ;;; ;;;;;;;;;;;;;;;;;;; (defvar lui-time-stamp-last nil "The last time stamp.") (make-variable-buffer-local 'lui-time-stamp-last) (defvar lui-time-stamp-time nil "A custom time to use as the time stamp for `lui-insert'. This variable should be let-bound when you wish to provide a custom time to be printed by `lui-time-stamp'. If this variable is nil the current time is used. See the TIME argument to `format-time-string' for more information.") (defvar lui-time-stamp-zone nil "A custom timezone to use for the time stamp for `lui-insert'. This variable should be let-bound when you wish to provide a custom time zone when printing the time stamp with `lui-time-stamp'. If this variable is nil local time is used. See the ZONE argument to `format-time-string' for more information.") (defun lui-time-stamp (&optional text) "Add a time stamp to the current buffer. If TEXT is specified, use that instead of formatting a new time stamp." (let ((ts (or text (format-time-string lui-time-stamp-format lui-time-stamp-time lui-time-stamp-zone)))) (cond ;; Time stamps right ((or (numberp lui-time-stamp-position) (eq lui-time-stamp-position 'right)) (when (or (not lui-time-stamp-only-when-changed-p) (not lui-time-stamp-last) (not (string= ts lui-time-stamp-last))) (goto-char (point-min)) (goto-char (point-at-eol)) (let* ((curcol (current-column)) (col (if (numberp lui-time-stamp-position) lui-time-stamp-position (+ 2 (or lui-fill-column fill-column (point))))) (indent (if (> col curcol) (- col curcol) 1)) (ts-string (propertize (concat (make-string indent ?\s) (propertize ts 'face 'lui-time-stamp-face)) 'lui-time-stamp t)) (start (point))) (insert ts-string) (add-text-properties start (1+ (point)) '(intangible t)) (add-text-properties (1+ start) (point) '(cursor-intangible t))))) ;; Time stamps left ((eq lui-time-stamp-position 'left) (let ((indent-string (propertize (make-string (length ts) ?\s) 'lui-time-stamp t))) (goto-char (point-min)) (cond ;; Time stamp ((or (not lui-time-stamp-only-when-changed-p) (not lui-time-stamp-last) (not (string= ts lui-time-stamp-last))) (insert (propertize ts 'face 'lui-time-stamp-face 'lui-time-stamp t))) ;; Just indentation (t (insert indent-string))) (forward-line 1) (while (< (point) (point-max)) (insert indent-string) (forward-line 1)))) ;; Time stamps in margin ((or (eq lui-time-stamp-position 'right-margin) (eq lui-time-stamp-position 'left-margin)) (when (or (not lui-time-stamp-only-when-changed-p) (not lui-time-stamp-last) (not (string= ts lui-time-stamp-last))) (goto-char (point-min)) (when lui-fill-type (goto-char (point-at-eol))) (let* ((ts (propertize ts 'face 'lui-time-stamp-face)) (ts-margin (propertize " " 'display `((margin ,lui-time-stamp-position) ,ts) 'lui-time-stamp t))) (insert ts-margin))))) (add-text-properties (point-min) (point-max) `(lui-formatted-time-stamp ,ts lui-time-stamp-last ,lui-time-stamp-last)) (setq lui-time-stamp-last ts))) (defun lui-time-stamp-enable-filtering () "Enable filtering of timestamps from copied text." (set (make-local-variable 'filter-buffer-substring-functions) '(lui-filter-buffer-time-stamps))) (defun lui-filter-buffer-time-stamps (fun beg end delete) "Filter text from copied strings. This is meant for the variable `filter-buffer-substring-functions', which see for an explanation of the argument FUN, BEG, END and DELETE." (let ((string (funcall fun beg end delete)) (inhibit-point-motion-hooks t) (inhibit-read-only t) ;; Emacs 24.4, 24.5 deactivate-mark) (with-temp-buffer (insert string) (let ((start (text-property-any (point-min) (point-max) 'lui-time-stamp t))) (while start (let ((end (next-single-property-change start 'lui-time-stamp nil (point-max)))) (delete-region start end) (setq start (text-property-any (point-min) (point-max) 'lui-time-stamp t)))) (buffer-string))))) (defun lui-time-stamp-buffer-substring (buffer-string) "Filter text from copied strings. This is meant for the variable `buffer-substring-filters', which see for an explanation of the argument BUFFER-STRING." (lui-filter-buffer-time-stamps (lambda (_beg _end _delete) buffer-string) nil nil nil)) ;;;;;;;;;;;;;;;;;; ;;; Truncating ;;; ;;;;;;;;;;;;;;;;;; (defun lui-truncate () "Truncate the current buffer if it exceeds `lui-max-buffer-size'." (when (and lui-max-buffer-size (> (point-max) lui-max-buffer-size)) (goto-char (- (point-max) lui-max-buffer-size)) (forward-line 0) (let ((inhibit-read-only t)) (delete-region (point-min) (point))))) ;;;;;;;;;;;;;;;;; ;;; Read-Only ;;; ;;;;;;;;;;;;;;;;; (defun lui-read-only () "Make the current output read-only if `lui-read-only-output-p' is non-nil." (when lui-read-only-output-p (add-text-properties (point-min) lui-output-marker '(read-only t front-sticky t)))) ;;;;;;;;;;;;;;;;;; ;;; Navigation ;;; ;;;;;;;;;;;;;;;;;; (defun lui-at-message-p () "Check if point is on a message." (get-text-property (point) 'lui-message-id)) (defun lui-beginning-of-message-p () "Check if point is at the beginning of a message." (or (= (point) (point-min)) (not (equal (get-text-property (point) 'lui-message-id) (get-text-property (1- (point)) 'lui-message-id))))) (defun lui-beginning-of-message () "Move point to the beginning of the message at point." (goto-char (previous-single-property-change (point) 'lui-message-id))) (defun lui-forward-message () "Move point to the next message in the buffer and return point. If there is no next message, move to the end of the buffer instead." (let ((current-id (get-text-property (point) 'lui-message-id)) (next-point (next-single-property-change (point) 'lui-message-id))) (if (not next-point) (goto-char (point-max)) (let ((message-id (get-text-property next-point 'lui-message-id))) (goto-char next-point) (when (or (not (or current-id message-id)) (and current-id (not message-id)) (and current-id message-id (= current-id message-id))) (lui-forward-message)))) (point))) (defun lui-backward-message () "Move point to the previous message in the buffer and return point. If there is no previous message, move to the beginning of the buffer instead." (let ((current-id (get-text-property (point) 'lui-message-id)) (prev-point (previous-single-property-change (point) 'lui-message-id))) (if (not prev-point) (goto-char (point-min)) (let ((message-id (get-text-property prev-point 'lui-message-id))) (goto-char prev-point) (when (or (not (or current-id message-id)) (and current-id (not message-id)) (and current-id message-id (= current-id message-id))) (lui-backward-message)))) (point))) ;;;;;;;;;;;;;;; ;;; Editing ;;; ;;;;;;;;;;;;;;; (defun lui-recover-output-marker () "Reset the output marker to just before the lui prompt." (let ((input-position (marker-position lui-input-marker))) (set-marker lui-output-marker (field-beginning (1- input-position))))) (defun lui-build-plist (keys) "Build a plist with KEYS taken from current text properties." (let (result) (dolist (key keys result) (let ((value (get-text-property (point) key))) (when value (setq result (plist-put result key value))))))) (defun lui-replace-message (new-message) "Replace the message at point with NEW-MESSAGE." (unless (lui-at-message-p) (error "Point is not on a message")) (unless (lui-beginning-of-message-p) (lui-beginning-of-message)) (let* ((saved-text-properties (get-text-property (point) 'lui-saved-text-properties)) (text-properties (lui-build-plist saved-text-properties)) (inhibit-read-only t) (lui-time-stamp-last (get-text-property (point) 'lui-time-stamp-last)) (lui-message-id (get-text-property (point) 'lui-message-id))) (unwind-protect (progn (setq lui-output-marker (point-marker)) (delete-region (point) (next-single-property-change (point) 'lui-message-id)) (apply #'lui-insert-with-text-properties new-message (plist-put text-properties 'not-tracked-p t))) (lui-recover-output-marker)))) (defun lui-replace (new-message predicate) "Replace a message with NEW-MESSAGE. PREDICATE should be a function that returns a non-nil value for the message that should be replaced." (save-excursion (goto-char (point-max)) (while (> (lui-backward-message) (point-min)) (when (funcall predicate) (lui-replace-message new-message))))) (defun lui-delete-message () "Delete the message at point." (unless (lui-at-message-p) (error "Point is not on a message")) (unless (lui-beginning-of-message-p) (lui-beginning-of-message)) (let ((inhibit-read-only t)) (add-text-properties (point) (next-single-property-change (point) 'lui-message-id) '(face lui-deleted-face)))) (defun lui-delete (predicate) "Delete a message. PREDICATE should be a function that returns a non-nil value for the message that should be replaced." (save-excursion (goto-char (point-max)) (while (> (lui-backward-message) (point-min)) (when (funcall predicate) (lui-delete-message))))) (provide 'lui) ;;; lui.el ends here circe-2.6/make-tls-process.el000066400000000000000000000163671316355431300162020ustar00rootroot00000000000000;;; make-tls-process.el --- A non-blocking TLS connection function ;; Copyright (C) 2015 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; URL: https://github.com/jorgenschaefer/circe ;; 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: ;; A `make-tls-process' function like `make-network-process', in ;; particular supporting non-blocking connects. ;;; Code: (require 'tls) (defcustom tls-connection-command (if (executable-find "gnutls-cli") "gnutls-cli --insecure -p %p %h" "openssl s_client -connect %h:%p -ign_eof") "The command to use to create a TLS connection. %h is replaced with server hostname, %p with port to connect to. The program should read input on stdin and write output to stdout. Also see `tls-success' for what the program should output after successful negotiation." :group 'tls :type 'string) (defvar tls-debug-output nil "Non-nil if you want to see lots of debug messages.") (defun tls--debug (format-string &rest args) "Display a message if debug output is enabled. If `tls-debug-output' is non-nil, this acts like `message'. Otherwise, it's a no-op." (when tls-debug-output (apply #'message format-string args))) (defun make-tls-process (&rest args) "Create a TLS client process. A TLS network process is a command process that runs a command line program like gnutls or openssl, not a full network process. Network communication should work as usual, but the sentinel might receive process-specific events. Different from a process sentinel, but like a network sentinel, the sentinel is called with an event \"open\\n\" when the connection is established. This function uses `tls-connection-command' to connect to a server. Do NOT use `set-process-filter' or `set-process-sentinel' on the return value of this function. The connection setup uses special sentinels and filters to be deal with the program output used here. Use the :sentinel and :filter keyword arguments to set them once the connection is fully established. Arguments are specified as keyword/argument pairs, similar to `make-network-process'. The following arguments are defined: :name NAME -- NAME is name for process. It is modified if necessary to make it unique. :buffer BUFFER -- BUFFER is the buffer (or buffer-name) to associate with the process. Process output goes at end of that buffer, unless you specify an output stream or filter function to handle the output. BUFFER may be also nil, meaning that this process is not associated with any buffer. :host HOST -- HOST is name of the host to connect to, or its IP address. The symbol `local' specifies the local host. If specified for a server process, it must be a valid name or address for the local host, and only clients connecting to that address will be accepted. :service SERVICE -- SERVICE is name of the service desired, or an integer specifying a port number to connect to. If SERVICE is t, a random port number is selected for the server. (If Emacs was compiled with getaddrinfo, a port number can also be specified as a string, e.g. \"80\", as well as an integer. This is not portable.) :coding CODING -- If CODING is a symbol, it specifies the coding system used for both reading and writing for this process. If CODING is a cons (DECODING . ENCODING), DECODING is used for reading, and ENCODING is used for writing. :noquery BOOL -- Query the user unless BOOL is non-nil, and process is running when Emacs is exited. :filter FILTER -- Install FILTER as the process filter. :sentinel SENTINEL -- Install SENTINEL as the process sentinel. :plist PLIST -- Install PLIST as the new process's initial plist." (let* ((name (plist-get args :name)) (host (plist-get args :host)) (service (plist-get args :service)) (proc (tls--start-process name tls-connection-command host service))) (process-put proc :tls-args args) (set-process-sentinel proc #'tls--sentinel) (set-process-filter proc #'tls--filter) proc)) (defun tls--sentinel (proc event) "The default sentinel for TLS connections. Try the next command in the list, or fail if there are none left." (tls--debug "tls--sentinel %S %S" (process-status proc) event) (tls--debug "Failed TLS output: %s" (process-get proc :tls-data)) (if (eq (process-status proc) 'exit) (let ((sentinel (plist-get (process-get proc :tls-args) :sentinel))) (when sentinel (funcall sentinel proc (format "failed with %s\n" event)))) (error "Unexpected event in tls sentinel: %S" event))) (defun tls--filter (proc data) "The default filter for TLS connections. We wait until both `tls-success' and `tls-end-of-info' have been received. Once that happens, we are done and we can switch over to the real connection." (let ((data (concat (or (process-get proc :tls-data) "") data))) (if (and (string-match tls-success data) (string-match tls-end-of-info data)) (let* ((remaining-data (substring data (match-end 0))) (args (process-get proc :tls-args)) (buffer (plist-get args :buffer)) (coding (plist-get args :coding)) (noquery (plist-get args :noquery)) (filter (plist-get args :filter)) (sentinel (plist-get args :sentinel)) (plist (plist-get args :plist))) (set-process-plist proc plist) (set-process-sentinel proc sentinel) (set-process-filter proc filter) (set-process-buffer proc buffer) (if (consp coding) (set-process-coding-system proc (car coding) (cdr coding)) (set-process-coding-system proc coding coding)) (set-process-query-on-exit-flag proc (not noquery)) (when sentinel (funcall sentinel proc "open\n")) (when (and (not (equal remaining-data "")) filter) (funcall filter proc remaining-data))) (process-put proc :tls-data data)))) (defun tls--start-process (name cmd host port) "Start a single process for network communication. This code is mostly taken from tls.el." (let ((process-connection-type tls-process-connection-type) (formatted-cmd (format-spec cmd (format-spec-make ?h host ?p (if (integerp port) (int-to-string port) port))))) (tls--debug "TLS starting process: %s" formatted-cmd) (start-process name nil shell-file-name shell-command-switch formatted-cmd))) (provide 'make-tls-process) ;;; make-tls-process.el ends here circe-2.6/scripts/000077500000000000000000000000001316355431300141415ustar00rootroot00000000000000circe-2.6/scripts/compile000077500000000000000000000003631316355431300155210ustar00rootroot00000000000000#!/bin/sh set -e cd "$(dirname "$0")/.." find . -name '*.elc' -delete cask exec "${EMACS:-emacs}" -batch \ -L . \ --eval "(setq byte-compile-warnings '(not cl-functions))" \ -f batch-byte-compile $(ls *.el|grep -v -- -pkg.el) circe-2.6/scripts/env000066400000000000000000000000641316355431300146540ustar00rootroot00000000000000SUPPORTED_EMACS_VERSIONS="24.1 24.2 24.3 24.4 24.5" circe-2.6/scripts/setup000077500000000000000000000003221316355431300152240ustar00rootroot00000000000000#!/bin/sh set -e cd "$(dirname "$0")/.." . scripts/env test -d .cask && rm -rf .cask test -d dist && rm -rf dist cask install for ver in $SUPPORTED_EMACS_VERSIONS do EMACS="emacs-$ver" cask install done circe-2.6/scripts/test000077500000000000000000000001041316355431300150410ustar00rootroot00000000000000#!/bin/sh set -e cd "$(dirname "$0")/.." cask exec buttercup -L . circe-2.6/scripts/test-full000077500000000000000000000002571316355431300160120ustar00rootroot00000000000000#!/bin/sh set -e cd "$(dirname "$0")/.." . scripts/env cask exec buttercup -L . for ver in $SUPPORTED_EMACS_VERSIONS do EMACS="emacs-$ver" cask exec buttercup -L . done circe-2.6/shorten.el000066400000000000000000000211101316355431300144510ustar00rootroot00000000000000;;; shorten.el --- component-wise string shortener ;; Copyright (C) 2013 John J Foerch ;; Keywords: extensions ;; Author: John J Foerch ;; URL: https://github.com/jorgenschaefer/circe/blob/master/shorten.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 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: ;; This is a component-wise string shortener, meaning that, given a list ;; of strings, it breaks each string into parts, then computes shortest ;; prefix of each part with respect to others of the same 'depth', such ;; that when joined back together, the shortened form of the whole string ;; remains unique within the resulting list. Many styles of shortening ;; are made possible via three functions that the caller may provide: the ;; split function, the join function, and the validate-component function. ;; ;; Strings are broken with the value of `shorten-split-function' (a ;; procedure string->list), and shortened components are rejoined with the ;; value of `shorten-join-function' (a procedure list->string[*]). The ;; default split and join functions break the string on word boundaries, ;; and rejoin on the empty string. Potential shortened forms of ;; components are tested with `shorten-validate-component-function'; its ;; default value passes only if its argument contains at least one ;; word-constituent character (regexp \w), meaning that by default, ;; components consisting entirely of non-word characters will not be ;; shortened, and components that start with non-word characters will only ;; be shortened so much that they have at least one word-constituent ;; character in them. ;; ;; The main entry point is `shorten-strings', which takes a list of strings ;; as its argument and returns an alist ((STRING . SHORTENED-STRING) ...). ;; ;; [*] Also takes a second argument; see docstring of ;; `shorten-join-function'. ;;; History: ;; - Version 0.1 (March 7, 2013): initial release ;;; Code: ;; Tree utils ;; (defsubst shorten-make-tree-root () (cons nil nil)) (defsubst shorten-tree-make-entry (token short full) (list token short full nil)) (defsubst shorten-tree-token (entry) (car entry)) (defsubst shorten-tree-fullname (entry) (nth 2 entry)) (defsubst shorten-tree-descendants (entry) (nthcdr 3 entry)) (defsubst shorten-tree-set-shortened (entry short) (setcar (cdr entry) short)) (defsubst shorten-tree-set-fullname (entry full) (setcar (nthcdr 2 entry) full)) (defsubst shorten-tree-insert (node item) (when (car node) (setcdr node (cons (car node) (cdr node)))) (setcar node item)) ;; Caller configuration ;; (defun shorten-split (s) (split-string s "\\b" t)) (defun shorten-join (lst &optional tail-count) (mapconcat #'identity lst "")) (defun shorten-join-sans-tail (lst tail-count) "A shorten-join that drops unnecessary tail components." (shorten-join (butlast lst tail-count))) (defun shorten-validate-component (str) (string-match-p "\\w" str)) (defvar shorten-split-function #'shorten-split "Value should be a function of string->list that breaks a string into components. The default breaks on word-boundaries. To get simple prefix shortening, bind this to `list'. Users should not generally change the global value of this variable; instead, bind it dynamically around calls to `shorten-strings'.") (defvar shorten-join-function #'shorten-join "A function that takes a list of components and a tail-count, and returns a joined string. Tail-count is the number of components on the end of the list that are not needed to uniquify the result, and so may be safely dropped if aggressive shortening is desired. The default preserves tail components, and joins the list on the empty string. Users should not generally change the global value of this variable; instead, bind it dynamically around calls to `shorten-strings'.") (defvar shorten-validate-component-function #'shorten-validate-component "Predicate that returns t if a proposed shortened form of a single component is acceptable, nil if a longer one should be tried. The default validates only when the candidate contains at least one word-constituent character, thus strings consisting of punctuation will not be shortened. For aggressive shortening, bind to a procedure that always returns t. Users should not generally change the global value of this variable; instead, bind it dynamically around calls to `shorten-strings'.") ;; Main procedures ;; (defun shorten-one (str others) "Return shortest unique prefix of STR among OTHERS, or STR if it cannot be shortened. If STR is a member of OTHERS (tested with `eq') that entry is ignored. The value of `shorten-validate-component-function' will be used to validate any prefix." (let ((max (length str)) (len 1)) (or (catch 'return (while (< len max) (let ((prefix (substring str 0 len))) (when (funcall shorten-validate-component-function prefix) (when (catch 'return (dolist (other others t) (when (and (>= (length other) len) (string= (substring other 0 len) prefix) (not (eq other str))) (throw 'return nil)))) (throw 'return prefix))) (setq len (1+ len))))) str))) (defun shorten-walk-internal (node path tail-count result-out) (let ((others (mapcar #'car node))) (setq tail-count (if (cdr node) 0 (1+ tail-count))) (dolist (entry node) (let* ((token (shorten-tree-token entry)) (shortened (shorten-one token others)) (path (cons shortened path)) (fullname (shorten-tree-fullname entry)) (descendants (shorten-tree-descendants entry)) (have-descendants (not (equal '(nil) descendants)))) (shorten-tree-set-shortened entry shortened) ;; if this entry has a fullname, add to result-out (when fullname (let ((joined (funcall shorten-join-function (reverse path) (if have-descendants 0 tail-count)))) (shorten-tree-insert result-out (cons fullname joined)))) ;; if this entry has descendants, recurse (when have-descendants (shorten-walk-internal descendants path (if fullname -1 tail-count) result-out)))))) (defun shorten-walk (tree) "Takes a tree of the type made by `shorten-make-tree' and returns an alist ((STRING . SHORTENED-STRING) ...). Uses `shorten-join-function' to join shortened components back together into SHORTENED-STRING. See also `shorten-validate-component-function'." (let ((result-out (shorten-make-tree-root))) (shorten-walk-internal tree '() -1 result-out) (if (equal '(nil) result-out) nil result-out))) (defun shorten-make-tree (strings) "Takes a list of strings and returns a tree of the type used by `shorten-walk' to generate shortened strings. Uses `shorten-split-function' to split the strings." (let ((tree (shorten-make-tree-root))) (dolist (s strings) (let ((node tree) (tokens (funcall shorten-split-function s)) (entry nil)) ;; create a path in tree for tokens (dolist (token tokens) (setq entry (assoc token node)) (when (not entry) (setq entry (shorten-tree-make-entry token nil nil)) (shorten-tree-insert node entry)) (setq node (shorten-tree-descendants entry))) ;; for the last token, set 'fullname' (shorten-tree-set-fullname entry s))) (if (equal tree '(nil)) nil tree))) ;;;###autoload (defun shorten-strings (strings) "Takes a list of strings and returns an alist ((STRING . SHORTENED-STRING) ...). Uses `shorten-split-function' to split the strings, and `shorten-join-function' to join shortened components back together into SHORTENED-STRING. See also `shorten-validate-component-function'." (shorten-walk (shorten-make-tree strings))) (provide 'shorten) ;;; shorten.el ends here circe-2.6/tests/000077500000000000000000000000001316355431300136145ustar00rootroot00000000000000circe-2.6/tests/test-circe.el000066400000000000000000000211601316355431300162000ustar00rootroot00000000000000;; -*-lexical-binding: t-*- (require 'circe) (describe "Circe chat mode" (describe "creation function" (it "should have circe-server-buffer set in the mode hook" (let* ((csb-value nil) (circe-server-killed-confirmation nil) (circe-chat-mode-hook (list (lambda () (setq csb-value circe-server-buffer)))) buf) (with-temp-buffer (circe-server-mode) (spy-on 'irc-isupport--case-fold :and-return-value "foo") (setq buf (circe-server-create-chat-buffer "foo" 'circe-chat-mode)) (kill-buffer buf) (expect csb-value :to-equal (current-buffer))))))) (describe "The `circe-version' command" (it "should display the current version" (spy-on 'message) (spy-on 'circe--version :and-return-value "23.5") (call-interactively 'circe-version) (expect 'message :to-have-been-called-with "Circe %s" "23.5"))) (describe "The `circe-duration-string' function" (it "should handle very short amounts of time" (expect (circe-duration-string 0) :to-equal "a moment")) (it "should support second granularity" (expect (circe-duration-string 1) :to-equal "1 second") (expect (circe-duration-string 2) :to-equal "2 seconds")) (it "should support minute granularity" (expect (circe-duration-string 60) :to-equal "1 minute") (expect (circe-duration-string 61) :to-equal "1 minute 1 second") (expect (circe-duration-string 62) :to-equal "1 minute 2 seconds") (expect (circe-duration-string 122) :to-equal "2 minutes 2 seconds")) (it "should support monthly granularity" (expect (circe-duration-string (+ (* 24 60 60 30) 120)) :to-equal "1 month 2 minutes"))) (describe "Circe's completion facility" (let (proc channel-buffer server-buffer) (before-each (setq server-buffer (generate-new-buffer "*Test Server*")) (set-buffer server-buffer) (circe-server-mode) (setq proc (start-process "test" nil "cat") circe-server-process proc) (setq circe-server-killed-confirmation nil) (setq channel-buffer (circe-server-create-chat-buffer "test" 'circe-channel-mode)) (set-buffer channel-buffer) (setq circe-channel-killed-confirmation nil) (spy-on 'circe-nick :and-return-value "mynick") (spy-on 'circe-channel-nicks :and-return-value '("testnick")) (spy-on 'irc-connection-channel)) (after-each (delete-process proc) (kill-buffer channel-buffer) (kill-buffer server-buffer)) (it "should complete nicks with colon at the beginning of the input" (insert "TESTNICK") (completion-at-point) (expect (buffer-substring lui-input-marker (point-max)) :to-equal "testnick: ")) (it "should complete nicks without colon later in the input" (insert "some stuff TESTNICK") (completion-at-point) (expect (buffer-substring lui-input-marker (point-max)) :to-equal "some stuff testnick ")))) (describe "Display of" (let ((current-time 1434995549)) (before-each (spy-on 'circe-display) (spy-on 'float-time :and-return-value (+ current-time 5)) (set-buffer (get-buffer-create "*Test*")) (spy-on 'circe-server-last-active-buffer :and-return-value (current-buffer))) (after-each (kill-buffer (current-buffer))) (describe "RPL_WHOISREPLY" (it "should show idle time" (circe-display-317 "sender" nil "317" "target" "nick" "23" "seconds idle") (expect 'circe-display :to-have-been-called-with 'circe-format-server-whois-idle :whois-nick "nick" :idle-seconds 23 :idle-duration "23 seconds")) (it "should show idle time and signon time" (circe-display-317 "sender" nil "317" "target" "nick" "23" (format "%s" current-time) "seconds idle, signon time") (expect 'circe-display :to-have-been-called-with 'circe-format-server-whois-idle-with-signon :whois-nick "nick" :idle-seconds 23 :idle-duration "23 seconds" :signon-time current-time :signon-date (current-time-string (seconds-to-time current-time)) :signon-ago "5 seconds"))) (describe "RPL_TOPICWHOTIME" (it "should show current topic time" (spy-on 'circe-server-get-chat-buffer :and-return-value (current-buffer)) (circe-display-333 "sender" nil "333" "target" "#channel" "setter!user@host" (format "%s" current-time)) (expect 'circe-display :to-have-been-called-with 'circe-format-server-topic-time :nick "target" :channel "#channel" :setter "setter" :setter-userhost "user@host" :topic-time current-time :topic-date (current-time-string (seconds-to-time current-time)) :topic-ago "5 seconds")) (it "should show current topic time in a different channel" (spy-on 'circe-server-get-chat-buffer :and-return-value nil) (spy-on 'circe-server-last-active-buffer :and-return-value (current-buffer)) (circe-display-333 "sender" nil "333" "target" "#channel" "setter!user@host" (format "%s" current-time)) (expect 'circe-server-last-active-buffer :to-have-been-called) (expect 'circe-display :to-have-been-called-with 'circe-format-server-topic-time-for-channel :nick "target" :channel "#channel" :setter "setter" :setter-userhost "user@host" :topic-time current-time :topic-date (current-time-string (seconds-to-time current-time)) :topic-ago "5 seconds"))) (describe "CTCP ACTION" (it "should show a query in a query buffer" (spy-on 'circe-query-auto-query-buffer :and-return-value (current-buffer)) (spy-on 'circe-server-my-nick-p :and-return-value t) (circe-display-ctcp-action "nick" "user@host" "irc.ctcp.ACTION" "my-nick" "the text") (expect 'circe-display :to-have-been-called-with 'circe-format-action :nick "nick" :userhost "user@host" :body "the text")) (it "should show a query in the current buffer" (spy-on 'circe-server-my-nick-p :and-return-value t) (spy-on 'circe-query-auto-query-buffer :and-return-value nil) (spy-on 'circe-server-last-active-buffer :and-return-value (current-buffer)) (circe-display-ctcp-action "nick" "user@host" "irc.ctcp.ACTION" "my-nick" "the text") (expect 'circe-display :to-have-been-called-with 'circe-format-message-action :nick "nick" :userhost "user@host" :body "the text")) (it "should show a channel action" (spy-on 'circe-server-my-nick-p :and-return-value nil) (spy-on 'circe-server-get-or-create-chat-buffer :and-return-value (current-buffer)) (spy-on 'circe-lurker-display-active) (circe-display-ctcp-action "nick" "user@host" "irc.ctcp.ACTION" "#channel" "the text") (expect 'circe-lurker-display-active :to-have-been-called) (expect 'circe-display :to-have-been-called-with 'circe-format-action :nick "nick" :userhost "user@host" :body "the text"))) (describe "CTCP PING" (it "should display unknown seconds when passed nil for text" (spy-on 'circe-server-my-nick-p :and-return-value nil) (spy-on 'circe-server-get-or-create-chat-buffer :and-return-value (current-buffer)) (spy-on 'circe-display) (circe-display-ctcp-ping "nick" "user@host" "irc.ctcp.PING" "target" nil) (expect 'circe-display :to-have-been-called-with 'circe-format-server-ctcp-ping :nick "nick" :userhost "user@host" :target "target" :body "" :ago "unknown seconds"))))) circe-2.6/tests/test-irc.el000066400000000000000000001771221316355431300157020ustar00rootroot00000000000000;; -*-lexical-binding: t-*- (require 'buttercup) (require 'irc) ;;;;;;;;;;;;;;;;;;;;;;; ;;; Connection function (describe "The `irc-connect' function" :var (process-status) (before-each (spy-on 'make-tls-process :and-return-value 'the-test-tls-process) (spy-on 'make-network-process :and-return-value 'the-test-process) (spy-on 'process-status :and-call-fake (lambda (proc) process-status)) (spy-on 'irc--sentinel :and-return-value nil)) (it "should call `make-network-process' if tls was not requested" (irc-connect :host "irc.local" :service 6667) (expect 'make-network-process :to-have-been-called-with :name "irc.local" :host "irc.local" :service 6667 :family nil :coding 'no-conversion :nowait t :noquery t :filter #'irc--filter :sentinel #'irc--sentinel :plist '(:host "irc.local" :service 6667) :keepalive t)) (it "should call `make-tls-process' if tls was requested" (irc-connect :host "irc.local" :service 6667 :tls t) (expect 'make-tls-process :to-have-been-called)) (it "should return a process when using non-tls connections" (expect (irc-connect :host "irc.local" :service 6667) :to-be 'the-test-process)) (it "should return a process when using tls connections" (expect (irc-connect :host "irc.local" :service 6667 :tls t) :to-be 'the-test-tls-process)) (it "should not use nowait if it is not supported" (spy-on 'featurep :and-return-value nil) (irc-connect :host "irc.local" :service 6667) (expect 'featurep :to-have-been-called-with 'make-network-process '(:nowait t)) (expect 'make-network-process :to-have-been-called-with :name "irc.local" :host "irc.local" :service 6667 :family nil :coding 'no-conversion :nowait nil :noquery t :filter #'irc--filter :sentinel #'irc--sentinel :plist '(:host "irc.local" :service 6667) :keepalive t)) (it "should call the sentinel if nowait is not supported" (setq process-status 'open) (irc-connect :host "irc.local" :service 6667) (expect 'irc--sentinel :to-have-been-called-with 'the-test-process "open manually"))) (describe "Connection options" (let (proc) (before-each (setq proc (start-process "test" nil "cat"))) (after-each (ignore-errors (delete-process proc))) (it "should retrieve options set" (irc-connection-put proc :key "value") (expect (irc-connection-get proc :key) :to-equal "value")))) (describe "The `irc--sentinel' function" (before-each (spy-on 'irc-event-emit)) (it "should emit conn.failed for a failed event" (irc--sentinel 'proc "failed to do something\n") (expect 'irc-event-emit :to-have-been-called-with 'proc "conn.failed") (spy-calls-reset 'irc-event-emit) (irc--sentinel 'proc "failed\n") (expect 'irc-event-emit :to-have-been-called-with 'proc "conn.failed")) (it "should emit conn.connected on an open event" (irc--sentinel 'proc "open\n") (expect 'irc-event-emit :to-have-been-called-with 'proc "conn.connected")) (it "should emit conn.disconnected for a broken connection" (irc--sentinel 'proc "connection broken by remote peer\n") (expect 'irc-event-emit :to-have-been-called-with 'proc "conn.disconnected")) (it "should emit conn.disconnected for a finished process" (irc--sentinel 'proc "finished\n") (expect 'irc-event-emit :to-have-been-called-with 'proc "conn.disconnected")) (it "should emit conn.disconnected for an exiting process" (irc--sentinel 'proc "exited abnormally with code 54\n") (expect 'irc-event-emit :to-have-been-called-with 'proc "conn.disconnected")) (it "should ignored killed processes" (irc--sentinel 'proc "killed\n") (expect 'irc-event-emit :not :to-have-been-called-with)) (it "should ignore deleted processes" (irc--sentinel 'proc "deleted\n") (expect 'irc-event-emit :not :to-have-been-called)) (it "should raise an error for unknown events" (expect (irc--sentinel 'proc "bla bla\n") :to-throw))) (describe "The `irc--filter' function" (let (proc) (before-each (spy-on 'irc--handle-line) (setq proc (start-process "test" nil "cat"))) (after-each (ignore-errors (delete-process proc))) (it "should handle single lines" (irc--filter proc "line\r\n") (expect 'irc--handle-line :to-have-been-called-with proc "line")) (it "should handle single lines even without CR" (irc--filter proc "line\n") (expect 'irc--handle-line :to-have-been-called-with proc "line")) (it "should handle multiple lines at once" (irc--filter proc "line1\r\nline2\r\nline3\r\n") (expect (spy-calls-all-args 'irc--handle-line) :to-equal `((,proc "line1") (,proc "line2") (,proc "line3")))) (it "should handle partial lines" (irc--filter proc "line1\r\nli") (expect 'irc--handle-line :to-have-been-called-with proc "line1") (spy-calls-reset 'irc--handle-line) (irc--filter proc "ne2\r\n") (expect 'irc--handle-line :to-have-been-called-with proc "line2")) (it "should not handle a line received while others are processed" ;; If you wonder what this is about, see the docstring of ;; `irc--filter-running-p' (spy-on 'irc--handle-line :and-call-fake (lambda (proc line) (when (equal line "line1") (irc--filter proc "line3\r\n")))) (irc--filter proc "line1\r\nline2\r\n") (expect (spy-calls-all-args 'irc--handle-line) :to-equal `((,proc "line1") (,proc "line2") (,proc "line3")))))) (describe "The `irc--handle-line' function" (before-each (spy-on 'irc-event-emit)) (it "should emit an event for the command" (irc--handle-line 'proc ":sender COMMAND arg1 arg2") (expect 'irc-event-emit :to-have-been-called-with 'proc "COMMAND" "sender" "arg1" "arg2"))) (describe "The `irc--parse' function" (it "should parse a command without anything else" (expect (irc--parse "COMMAND") :to-equal '(nil "COMMAND"))) (it "should parse a command with a single argument" (expect (irc--parse "COMMAND arg") :to-equal '(nil "COMMAND" "arg"))) (it "should parse a command with two arguments" (expect (irc--parse "COMMAND arg1 arg2") :to-equal '(nil "COMMAND" "arg1" "arg2"))) (it "should treat single space as argument separator" (expect (irc--parse "COMMAND arg1 arg3") :to-equal '(nil "COMMAND" "arg1" "" "arg3"))) (it "should parse a command with rest argument" (expect (irc--parse "COMMAND arg1 arg2 :arg3 still arg3") :to-equal '(nil "COMMAND" "arg1" "arg2" "arg3 still arg3"))) (it "should parse a command with sender and no arguments" (expect (irc--parse ":sender COMMAND") :to-equal '("sender" "COMMAND"))) (it "should parse a command with sender and a single argument" (expect (irc--parse ":sender COMMAND arg") :to-equal '("sender" "COMMAND" "arg"))) (it "should parse a command with sender and two arguments" (expect (irc--parse ":sender COMMAND arg1 arg2") :to-equal '("sender" "COMMAND" "arg1" "arg2"))) (it "should parse a command with sender and rest argument" (expect (irc--parse ":sender COMMAND arg1 arg2 :arg3 still arg3") :to-equal '("sender" "COMMAND" "arg1" "arg2" "arg3 still arg3"))) (it "should decode arguments" (expect (irc--parse "PRIVMSG #channel :m\xc3\xb6p") :to-equal '(nil "PRIVMSG" "#channel" "möp"))) (it "should decode arguments individually" ;; Undecided is broken in older Emacsen (when (version< emacs-version "24.4") (signal 'buttercup-pending t)) ;; This is utf-16 (expect (irc--parse (concat ":\xff\xfe\x6d\x00\xf6\x00\x70\x00 " "PRIVMSG #channel :\xff\xfe\x6d\x00\xf6\x00\x70\x00")) :to-equal '("möp" "PRIVMSG" "#channel" "möp")))) (describe "The `irc-userstring-nick' function" (it "should return the nick of a nick!user@host userstring" (expect (irc-userstring-nick "nick!user@host") :to-equal "nick")) (it "should return the string verbatim if it's something else" (expect (irc-userstring-nick "nick!usernoathost") :to-equal "nick!usernoathost"))) (describe "The `irc-userstring-userhost' function" (it "should return the user@host of a nick!user@host userstring" (expect (irc-userstring-userhost "nick!user@host") :to-equal "user@host")) (it "should return nil if it's something else" (expect (irc-userstring-userhost "nick!usernoathost") :to-equal nil))) (describe "The `irc-event-emit' function" (let (proc handler-table) (before-each (setq proc (start-process "test" nil "cat") handler-table (irc-handler-table)) (irc-connection-put proc :handler-table handler-table)) (after-each (ignore-errors (delete-process proc))) (it "should run the irc-handler for the event" (let ((called-with nil)) (irc-handler-add handler-table "the.event" (lambda (&rest args) (setq called-with args))) (irc-event-emit proc "the.event" 1 2 3) (expect called-with :to-equal `(,proc "the.event" 1 2 3)))) (it "should run the irc-handler for nil" (let ((called-with nil)) (irc-handler-add handler-table nil (lambda (&rest args) (setq called-with args))) (irc-event-emit proc "the.event" 1 2 3) (expect called-with :to-equal `(,proc "the.event" 1 2 3)))))) ;;;;;;;;;;;;;;;;;;;;;;; ;;; Event handler table (describe "The event handler table API" (it "should run an event that was added" (let ((table (irc-handler-table)) (called-with nil)) (irc-handler-add table "the.event" (lambda (&rest args) (setq called-with args))) (irc-handler-run table "the.event" 1 2 3) (expect called-with :to-equal '(1 2 3)))) (it "should not throw an error if a handler throws one" (let ((table (irc-handler-table)) (debug-on-error nil)) (spy-on 'message) (irc-handler-add table "the.event" (lambda (&rest args) (error "Oops!"))) (expect (irc-handler-run table "the.event") :not :to-throw))) (it "should not throw an error if a handler throws one and debug-on-error" (let ((table (irc-handler-table)) (debug-on-error t)) (irc-handler-add table "the.event" (lambda (&rest args) (error "Oops!"))) (expect (irc-handler-run table "the.event") :to-throw))) (it "should not run a remove handler" (let* ((table (irc-handler-table)) (called-with nil) (handler (lambda (&rest args) (setq called-with args)))) (irc-handler-add table "the.event" handler) (irc-handler-remove table "the.event" handler) (irc-handler-run table "the.event" 1 2 3) (expect called-with :to-equal nil)))) ;;;;;;;;;;; ;;; Sending (describe "The `irc-send-raw' function" (let (proc current-time) (before-each (setq proc (start-process "test" nil "cat") current-time (float-time)) (spy-on 'process-send-string) (spy-on 'run-at-time) (spy-on 'float-time :and-call-fake (lambda () current-time))) (after-each (ignore-errors (delete-process proc))) (after-each (ignore-errors (delete-process proc))) (it "should send single messages immediately" (irc-send-raw proc "the line") (expect 'process-send-string :to-have-been-called-with proc "the line\r\n")) (it "should not create a timer for a single message" (irc-send-raw proc "the line") (expect 'run-at-time :not :to-have-been-called)) (it "should prevent flooding" (dolist (line '("line1" "line2" "line3" "line4" "line5" "line6")) (irc-send-raw proc line)) (expect (spy-context-args (spy-calls-most-recent 'process-send-string)) :to-equal `(,proc "line4\r\n"))) (it "should continue sending after a delay" (dolist (line '("line1" "line2" "line3" "line4" "line5" "line6")) (irc-send-raw proc line)) (expect 'run-at-time :to-have-been-called) ;; Two minutes later (setq current-time (+ current-time 120)) (irc-send--queue proc) (expect (spy-context-args (spy-calls-most-recent 'process-send-string)) :to-equal `(,proc "line6\r\n"))) (it "should drop lines if the flood queue is full and :drop is given" (dolist (line '("line1" "line2" "line3" "line4" "line5" "line6")) (irc-send-raw proc line)) (irc-send-raw proc "dropped" :drop) (setq current-time (+ current-time 120)) (irc-send--queue proc) (expect (spy-context-args (spy-calls-most-recent 'process-send-string)) :to-equal `(,proc "line6\r\n"))) (it "should send items immediately if :nowait is given" (dolist (line '("line1" "line2" "line3" "line4" "line5" "line6")) (irc-send-raw proc line)) (irc-send-raw proc "priority" :nowait) (expect (spy-context-args (spy-calls-most-recent 'process-send-string)) :to-equal `(,proc "priority\r\n"))) (it "should encode strings being sent as utf-8" (irc-send-raw proc "möp") (expect 'process-send-string :to-have-been-called-with proc "m\xc3\xb6p\r\n")))) (describe "The `irc-send-command'" (before-each (spy-on 'irc-send-raw)) (it "should send properly-formatted commands" (irc-send-command 'proc "PRIVMSG" "#emacs" "Hello, World!") (expect 'irc-send-raw :to-have-been-called-with 'proc "PRIVMSG #emacs :Hello, World!")) (it "should quote a final argument if it starts with a colon" (irc-send-command 'proc "PRIVMSG" "#emacs" ":-D") (expect 'irc-send-raw :to-have-been-called-with 'proc "PRIVMSG #emacs ::-D")) (it "should fail if any argument is not a string" (expect (irc-send-command 'proc "PRIVMSG" 23 "Hi!") :to-throw)) (it "should fail if any argument but the last has a space" (expect (irc-send-command 'proc "PRIVMSG" "#my channel" "Hello") :to-throw))) (describe "The send function" (before-each (spy-on 'irc-send-raw)) (describe "`irc-send-AUTHENTICATE'" (it "should send an AUTHENTICATE message" (irc-send-AUTHENTICATE 'proc "1234567890abcdef") (expect 'irc-send-raw :to-have-been-called-with 'proc "AUTHENTICATE 1234567890abcdef"))) (describe "`irc-send-AUTHENTICATE'" (it "should send an AWAY message with reason" (irc-send-AWAY 'proc "Away reason") (expect 'irc-send-raw :to-have-been-called-with 'proc "AWAY :Away reason")) (it "should send an AWAY message without reason to return" (irc-send-AWAY 'proc) (expect 'irc-send-raw :to-have-been-called-with 'proc "AWAY"))) (describe "`irc-send-CAP'" (it "should send a CAP message" (irc-send-CAP 'proc "LS") (expect 'irc-send-raw :to-have-been-called-with 'proc "CAP LS"))) (describe "`irc-send-INVITE'" (it "should send an INVITE message" (irc-send-INVITE 'proc "nick" "#channel") (expect 'irc-send-raw :to-have-been-called-with 'proc "INVITE nick #channel"))) (describe "`irc-send-JOIN'" (it "should send a normal JOIN" (irc-send-JOIN 'proc "#channel") (expect 'irc-send-raw :to-have-been-called-with 'proc "JOIN #channel")) (it "should send a JOIN with key" (irc-send-JOIN 'proc "#channel" "secret key") (expect 'irc-send-raw :to-have-been-called-with 'proc "JOIN #channel :secret key"))) (describe "`irc-send-NAMES'" (it "should send a NAMES message with no arguments" (irc-send-NAMES 'proc) (expect 'irc-send-raw :to-have-been-called-with 'proc "NAMES")) (it "should send a NAMES message with a channel argument" (irc-send-NAMES 'proc "#channel") (expect 'irc-send-raw :to-have-been-called-with 'proc "NAMES #channel"))) (describe "`irc-send-NICK'" (it "should send a NICK message" (irc-send-NICK 'proc "New_Nick") (expect 'irc-send-raw :to-have-been-called-with 'proc "NICK New_Nick"))) (describe "`irc-send-NOTICE'" (it "should send a NOTICE message" (irc-send-NOTICE 'proc "#channel" "Hello, World") (expect 'irc-send-raw :to-have-been-called-with 'proc "NOTICE #channel :Hello, World"))) (describe "`irc-send-PART'" (it "should send a PART message" (irc-send-PART 'proc "#channel" "the reason") (expect 'irc-send-raw :to-have-been-called-with 'proc "PART #channel :the reason"))) (describe "`irc-send-PASS'" (it "should send a PASS message" (irc-send-PASS 'proc "top-secret-password") (expect 'irc-send-raw :to-have-been-called-with 'proc "PASS top-secret-password"))) (describe "`irc-send-PONG'" (it "should send a PONG message to a single server" (irc-send-PONG 'proc "server1") (expect 'irc-send-raw :to-have-been-called-with 'proc "PONG server1" :nowait))) (describe "`irc-send-PRIVMSG'" (it "should send a PRIVMSG message" (irc-send-PRIVMSG 'proc "#channel" "Hello, World") (expect 'irc-send-raw :to-have-been-called-with 'proc "PRIVMSG #channel :Hello, World"))) (describe "`irc-send-QUIT'" (it "should send a QUIT message" (irc-send-QUIT 'proc "the reason") (expect 'irc-send-raw :to-have-been-called-with 'proc "QUIT :the reason"))) (describe "`irc-send-TOPIC'" (it "should retrieve a TOPIC with no new topic" (irc-send-TOPIC 'proc "#channel") (expect 'irc-send-raw :to-have-been-called-with 'proc "TOPIC #channel")) (it "should set a TOPIC with new topic argument" (irc-send-TOPIC 'proc "#channel" "new topic") (expect 'irc-send-raw :to-have-been-called-with 'proc "TOPIC #channel :new topic"))) (describe "`irc-send-USER'" (it "should send a USER message" (irc-send-USER 'proc "username" 8 "My Real Name (honest)") (expect 'irc-send-raw :to-have-been-called-with 'proc "USER username 8 * :My Real Name (honest)"))) (describe "`irc-send-WHOIS'" (it "should send a WHOIS message" (irc-send-WHOIS 'proc "user") (expect 'irc-send-raw :to-have-been-called-with 'proc "WHOIS user")) (it "should allow for an optional WHOIS argument" (irc-send-WHOIS 'proc "user" "user") (expect 'irc-send-raw :to-have-been-called-with 'proc "WHOIS user user"))) (describe "`irc-send-WHOWAS'" (it "should send a WHOWAS message" (irc-send-WHOWAS 'proc "user") (expect 'irc-send-raw :to-have-been-called-with 'proc "WHOWAS user")))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: Registration (defun client-messages () (mapcar #'cadr (spy-calls-all-args 'irc-send-raw))) (describe "The registration handler" (let (proc table) (before-each (setq proc (start-process "test" nil "cat") table (irc-handler-table)) (irc-connection-put proc :handler-table table) (irc-connection-put proc :nick "My_Nick") (irc-connection-put proc :user "username") (irc-connection-put proc :mode 8) (irc-connection-put proc :realname "My Real Name") (spy-on 'irc-send-raw) (irc-handle-registration table)) (after-each (ignore-errors (delete-process proc))) (describe "on conn.connected" (it "should send the standard registration on connect" (irc-event-emit proc "conn.connected") (expect (client-messages) :to-equal '("NICK My_Nick" "USER username 8 * :My Real Name"))) (it "should set the connection state to connected" (expect (irc-connection-state proc) :not :to-be 'connected) (irc-event-emit proc "conn.connected") (expect (irc-connection-state proc) :to-be 'connected)) (it "should send a PASS message if a password is given" (irc-connection-put proc :pass "top-secret") (irc-event-emit proc "conn.connected") (expect (client-messages) :to-equal '("PASS top-secret" "NICK My_Nick" "USER username 8 * :My Real Name"))) (it "should send a CAP request if the connection specifies it" (irc-connection-put proc :cap-req '("sasl")) (irc-event-emit proc "conn.connected") (expect (client-messages) :to-equal '("CAP LS" "NICK My_Nick" "USER username 8 * :My Real Name")))) (describe "on conn.disconnected" (it "should set the connection state to disconnected" (expect (irc-connection-state proc) :not :to-be 'disconnected) (irc-event-emit proc "conn.disconnected") (expect (irc-connection-state proc) :to-be 'disconnected))) (describe "on 001 RPL_WELCOME" (it "should set the connection stat to registered" (expect (irc-connection-state proc) :not :to-be 'registered) (irc-event-emit proc "001" "irc.server" "My_Nick" "Welcome!") (expect (irc-connection-state proc) :to-be 'registered)) (it "should emit the irc.registered event" (let ((registered nil)) (irc-handler-add table "irc.registered" (lambda (conn event my-nick) (setq registered my-nick))) (irc-event-emit proc "001" "irc.server" "My_Nick" "Welcome!") (expect registered :to-equal "My_Nick"))) (it "should not fail when there are spurious arguments" (irc-event-emit proc "001" "irc.server" "My_Nick" "Some" "broken" "arguments"))) (describe "on a CAP message" (it "should do the full negotiation" (irc-connection-put proc :cap-req '("multi-prefix")) (irc-event-emit proc "conn.registered") (spy-calls-reset 'irc-send-raw) (irc-event-emit proc "CAP" "irc.server" "*" "LS" "multi-prefix") (irc-event-emit proc "CAP" "irc.server" "*" "ACK" "multi-prefix") (expect (client-messages) :to-equal '("CAP REQ multi-prefix" "CAP END"))) (it "should not negotiation with no common capabilities" (irc-connection-put proc :cap-req '("sasl")) (irc-event-emit proc "conn.registered") (spy-calls-reset 'irc-send-raw) (irc-event-emit proc "CAP" "irc.server" "*" "LS" "multi-prefix") (expect (client-messages) :to-equal '("CAP END")))) (describe "on SASL authentication" (it "should do the full negotiation" (irc-connection-put proc :cap-req '("sasl")) (irc-connection-put proc :sasl-username "my_nick") (irc-connection-put proc :sasl-password "top-secret") (irc-event-emit proc "conn.registered") (spy-calls-reset 'irc-send-raw) (irc-event-emit proc "CAP" "irc.server" "*" "LS" "sasl") (irc-event-emit proc "CAP" "irc.server" "*" "ACK" "sasl") (irc-event-emit proc "AUTHENTICATE" nil "+") (expect (client-messages) :to-equal '("CAP REQ sasl" "AUTHENTICATE PLAIN" "AUTHENTICATE bXlfbmljawBteV9uaWNrAHRvcC1zZWNyZXQ=" "CAP END")))) (describe "on SASL authentication" (it "should emit sasl.login for 900 numeric" (let (auth-args) (irc-handler-add table "sasl.login" (lambda (&rest args) (setq auth-args args))) (irc-event-emit proc "900" "irc.server" "mynick" "mynick!user@host" "account" "You are now logged in as mynick") (expect auth-args :to-equal (list proc "sasl.login" "mynick!user@host" "account"))))))) (describe "The `irc-connection-state' function" (let (proc) (before-each (setq proc (start-process "test" nil "cat"))) (after-each (ignore-errors (delete-process proc))) (it "should return the connection state" (irc-connection-put proc :connection-state 'registered) (expect (irc-connection-state proc) :to-be 'registered)) (it "should return connecting if nothing was set" (expect (irc-connection-state proc) :to-be 'connecting)))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: Ping-Pong (describe "The ping-pong handler" (let (proc table) (before-each (setq proc (start-process "test" nil "cat") table (irc-handler-table)) (irc-connection-put proc :handler-table table) (spy-on 'irc-send-raw) (irc-handle-ping-pong table)) (after-each (ignore-errors (delete-process proc))) (it "should send PONG on a PING" (irc-event-emit proc "PING" "irc.server" "arg") (expect (client-messages) :to-equal '("PONG arg"))))) ;;;;;;;;;;;;;;;;;;;;; ;;; Handler: ISUPPORT (describe "The 005 RPL_ISUPPORT handler" (let (proc table) (before-each (setq proc (start-process "test" nil "cat") table (irc-handler-table)) (irc-connection-put proc :handler-table table) (irc-handle-isupport table)) (after-each (ignore-errors (delete-process proc))) (it "should set the :isupport connection option" (irc-event-emit proc "005" "irc.server" "mynick" "WITHARG=#" "NOARG") (expect (irc-isupport proc "WITHARG") :to-equal "#") (expect (irc-isupport proc "NOARG") :to-equal t) (expect (irc-isupport proc "SOMETHINGELSE") :to-equal nil)) (describe "string comparison function" (it "should compare with rfc1459 by default" (expect (irc-string-equal-p proc "FOO[]\\^" "foo{}|~") :to-be t)) (it "should compare with rfc1459 if CASEMAPPING is rfc1459" (irc-event-emit proc "005" "irc.server" "mynick" "CASEMAPPING=rfc1459") (expect (irc-string-equal-p proc "FOO[]\\^" "foo{}|~") :to-be t)) (it "should compare with ascii mapping if casemapping is ascii" (irc-event-emit proc "005" "irc.server" "mynick" "CASEMAPPING=ascii") (expect (irc-string-equal-p proc "FOO[]\\^" "foo[]\\^") :to-be t) (expect (irc-string-equal-p proc "FOO[]\\^" "foo{}|~") :not :to-be t)) (it "should compare with rfc1459-strict mapping if casemapping is that" (irc-event-emit proc "005" "irc.server" "mynick" "CASEMAPPING=rfc1459-strict") (expect (irc-string-equal-p proc "FOO[]\\" "foo{}|") :to-be t) (expect (irc-string-equal-p proc "FOO[]\\^" "foo{}|~") :not :to-be t))) (describe "the channel name identification" (it "should identify a channel name" (irc-event-emit proc "005" "irc.server" "mynick" "CHANTYPES=#+") (expect (irc-channel-name-p proc "#foo") :to-be t) (expect (irc-channel-name-p proc "&foo") :not :to-be t) (expect (irc-channel-name-p proc "!foo") :not :to-be t) (expect (irc-channel-name-p proc "+foo") :to-be t))) (describe "the `irc-nick-without-prefix' function" (it "should remove a prefix" (irc-event-emit proc "005" "irc.server" "mynick" "PREFIX=(ov)@+") (expect (irc-nick-without-prefix proc "@nick") :to-equal "nick") (expect (irc-nick-without-prefix proc "+nick") :to-equal "nick") (expect (irc-nick-without-prefix proc "%nick") :to-equal "%nick"))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: Initial nick acquisition (describe "The initial nick acquisition handler" (let (proc table) (before-each (setq proc (start-process "test" nil "cat") table (irc-handler-table)) (irc-connection-put proc :handler-table table) (irc-connection-put proc :nick-alternatives '("alt1" "alt2")) (spy-on 'irc-send-raw) (irc-handle-initial-nick-acquisition table)) (after-each (ignore-errors (delete-process proc))) (it "should try an alternative nick if the initial nick is bogus" (irc-event-emit proc "432" "irc.server" "*" "bogus" "Erroneous Nickname") (expect 'irc-send-raw :to-have-been-called-with proc "NICK alt1") (expect (irc-connection-get proc :nick-alternatives) :to-equal '("alt2"))) (it "should try an alternative nick if the initial nick is in use" (irc-event-emit proc "433" "irc.server" "*" "inuse" "Nickname is already in use.") (expect 'irc-send-raw :to-have-been-called-with proc "NICK alt1") (expect (irc-connection-get proc :nick-alternatives) :to-equal '("alt2"))) (it "should try an alternative nick if the initial nick unavailable" (irc-event-emit proc "437" "irc.server" "*" "unavail" "Nickname is unavailable.") (expect 'irc-send-raw :to-have-been-called-with proc "NICK alt1") (expect (irc-connection-get proc :nick-alternatives) :to-equal '("alt2"))) (it "should not try an alternative nick if we already registered" (irc-event-emit proc "432" "irc.server" "mynick" "bogus" "Erroneous Nickname") (irc-event-emit proc "433" "irc.server" "mynick" "inuse" "Nickname is already in use.") (irc-event-emit proc "437" "irc.server" "mynick" "unavail" "Nickname is unavailable.") (expect 'irc-send-raw :not :to-have-been-called)) (it "should try a random nick if no alternatives available" (irc-connection-put proc :nick-alternatives nil) (spy-on 'irc-generate-nick :and-return-value "randomnick") (irc-event-emit proc "433" "irc.server" "*" "inuse" "Nickname is already in use.") (expect 'irc-send-raw :to-have-been-called-with proc "NICK randomnick")))) (describe "The `irc-generate-nick' function" (it "should return a random, valid nick" (expect (stringp (irc-generate-nick))))) ;;;;;;;;;;;;;;;;; ;;; Handler: CTCP (describe "The CTCP handler" (let (proc table last-message last-ctcp last-notice last-ctcpreply) (before-each (setq proc (start-process "test" nil "cat") table (irc-handler-table) last-message nil last-ctcp nil last-notice nil last-ctcpreply nil) (irc-connection-put proc :handler-table table) (irc-handle-ctcp table) (irc-handler-add table "irc.message" (lambda (proc &rest event) (setq last-message event))) (irc-handler-add table "irc.notice" (lambda (proc &rest event) (setq last-notice event))) (irc-handler-add table "irc.ctcp" (lambda (proc &rest event) (setq last-ctcp event))) (irc-handler-add table "irc.ctcpreply" (lambda (proc &rest event) (setq last-ctcpreply event)))) (after-each (ignore-errors (delete-process proc))) (it "should send irc.message on a normal PRIVMSG" (irc-event-emit proc "PRIVMSG" "alice" "bob" "Hi") (expect last-message :to-equal (list "irc.message" "alice" "bob" "Hi"))) (it "should send irc.ctcp on a CTCP request with no arguments" (irc-event-emit proc "PRIVMSG" "alice" "bob" "\x01VERSION\x01") (expect last-message :to-be nil) (expect last-ctcp :to-equal (list "irc.ctcp" "alice" "bob" "VERSION" nil))) (it "should send irc.ctcp on a CTCP request with arguments" (irc-event-emit proc "PRIVMSG" "alice" "bob" "\x01PING foo\x01") (expect last-message :to-be nil) (expect last-ctcp :to-equal (list "irc.ctcp" "alice" "bob" "PING" "foo"))) (it "should send irc.notice on a normal NOTICE" (irc-event-emit proc "NOTICE" "alice" "bob" "Hi") (expect last-notice :to-equal (list "irc.notice" "alice" "bob" "Hi"))) (it "should send irc.ctcpreply on a CTCP reply with no arguments" (irc-event-emit proc "NOTICE" "alice" "bob" "\x01VERSION\x01") (expect last-notice :to-be nil) (expect last-ctcpreply :to-equal (list "irc.ctcpreply" "alice" "bob" "VERSION" nil))) (it "should send irc.ctcpreply on a CTCP reply with arguments" (irc-event-emit proc "NOTICE" "alice" "bob" "\x01PING foo\x01") (expect last-notice :to-be nil) (expect last-ctcpreply :to-equal (list "irc.ctcpreply" "alice" "bob" "PING" "foo"))) (it "should send irc.ctcp.VERB for a CTCP request without argument" (let ((last-event nil)) (irc-handler-add table "irc.ctcp.PING" (lambda (proc &rest event) (setq last-event event))) (irc-event-emit proc "PRIVMSG" "alice" "bob" "\x01PING\x01") (expect last-event :to-equal (list "irc.ctcp.PING" "alice" "bob" nil)))) (it "should send irc.ctcp.VERB for a CTCP request with argument" (let ((last-event nil)) (irc-handler-add table "irc.ctcp.PING" (lambda (proc &rest event) (setq last-event event))) (irc-event-emit proc "PRIVMSG" "alice" "bob" "\x01PING foo\x01") (expect last-event :to-equal (list "irc.ctcp.PING" "alice" "bob" "foo")))) (it "should send irc.ctcpreply.VERB for a CTCP reply without argument" (let ((last-event nil)) (irc-handler-add table "irc.ctcpreply.PING" (lambda (proc &rest event) (setq last-event event))) (irc-event-emit proc "NOTICE" "alice" "bob" "\x01PING\x01") (expect last-event :to-equal (list "irc.ctcpreply.PING" "alice" "bob" nil)))) (it "should send irc.ctcpreply.VERB for a CTCP reply with argument" (let ((last-event nil)) (irc-handler-add table "irc.ctcpreply.PING" (lambda (proc &rest event) (setq last-event event))) (irc-event-emit proc "NOTICE" "alice" "bob" "\x01PING foo\x01") (expect last-event :to-equal (list "irc.ctcpreply.PING" "alice" "bob" "foo")))) (describe "`irc-send-ctcp' function" (before-each (spy-on 'irc-send-raw)) (it "should send a CTCP request" (irc-send-ctcp proc "alice" "VERSION" "test version 1.0") (expect 'irc-send-raw :to-have-been-called-with proc "PRIVMSG alice :\x01VERSION test version 1.0\x01"))) (describe "`irc-send-ctcpreply' function" (before-each (spy-on 'irc-send-raw)) (it "should send a CTCP reply that is dropped on flooding" (irc-send-ctcpreply proc "alice" "VERSION" "test version 1.0") (expect 'irc-send-raw :to-have-been-called-with proc "NOTICE alice :\x01VERSION test version 1.0\x01" :drop))) (describe "default CTCP handlers" (before-each (spy-on 'irc-send-ctcpreply)) (it "should respond with :ctcp-version to CTCP VERSION" (irc-connection-put proc :ctcp-version "test version 1.0") (irc-event-emit proc "irc.ctcp.VERSION" "alice" "bob" nil) (expect 'irc-send-ctcpreply :to-have-been-called-with proc "alice" "VERSION" "test version 1.0")) (it "should respond with :ctcp-clientinfo to CTCP CLIENTINFO" (irc-connection-put proc :ctcp-clientinfo "FOO BAR BAZ") (irc-event-emit proc "irc.ctcp.CLIENTINFO" "alice" "bob" nil) (expect 'irc-send-ctcpreply :to-have-been-called-with proc "alice" "CLIENTINFO" "FOO BAR BAZ")) (it "should respond with :ctcp-source to CTCP SOURCE" (irc-connection-put proc :ctcp-source "https://website/") (irc-event-emit proc "irc.ctcp.SOURCE" "alice" "bob" nil) (expect 'irc-send-ctcpreply :to-have-been-called-with proc "alice" "SOURCE" "https://website/")) (it "should respond with the argument to CTCP PING" (irc-event-emit proc "irc.ctcp.PING" "alice" "bob" "12345") (expect 'irc-send-ctcpreply :to-have-been-called-with proc "alice" "PING" "12345")) (it "should respond with the current time to CTCP TIME" (spy-on 'current-time-string :and-return-value "Test current time") (irc-event-emit proc "irc.ctcp.TIME" "alice" "bob" nil) (expect 'irc-send-ctcpreply :to-have-been-called-with proc "alice" "TIME" "Test current time")) ))) ;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: State Tracking (describe "The connection channels and users" (let (proc table) (before-each (setq proc (start-process "test" nil "cat") table (irc-handler-table))) (after-each (ignore-errors (delete-process proc))) (it "should create channels correctly" (let ((channel (irc-channel-from-name proc "#CHANNEL"))) (expect (irc-channel-connection channel) :to-equal proc) (expect (irc-channel-name channel) :to-equal "#CHANNEL") (expect (irc-channel-folded-name channel) :to-equal "#channel"))) (it "should not know channels not added yet" (expect (irc-connection-channel proc "#channel") :to-be nil)) (it "should return a channel after it was added" (irc-connection-add-channel proc "#CHANNEL") (expect (irc-channel-name (irc-connection-channel proc "#channel")) :to-equal "#CHANNEL")) (it "should create users correctly" (let ((user (irc-user-from-userstring proc "SOMENICK!foo@bar"))) (expect (irc-user-connection user) :to-equal proc) (expect (irc-user-nick user) :to-equal "SOMENICK") (expect (irc-user-folded-nick user) :to-equal "somenick") (expect (irc-user-userhost user) :to-equal "foo@bar"))) (it "should return no user if not added yet" (let ((channel (irc-channel-from-name proc "#CHANNEL"))) (expect (irc-channel-user channel "somenick") :to-be nil))) (it "should return the user object that was added before" (let ((channel (irc-channel-from-name proc "#CHANNEL"))) (irc-channel-add-user channel "SOMENICK!user@host") (expect (irc-user-nick (irc-channel-user channel "somenick")) :to-equal "SOMENICK"))) (it "should remove a channel" (irc-connection-add-channel proc "#channel") (irc-connection-remove-channel proc "#channel") (expect (irc-connection-channel proc "#channel") :to-be nil)) (it "should remove a user" (let ((channel (irc-channel-from-name proc "#CHANNEL"))) (irc-channel-add-user channel "SOMENICK!user@host") (irc-channel-remove-user channel "somenick") (expect (irc-channel-user channel "somenick") :to-be nil))) (it "should track all channels" (irc-connection-add-channel proc "#chan1") (irc-connection-add-channel proc "#chan2") (irc-connection-add-channel proc "#chan3") (expect (sort (mapcar #'irc-channel-name (irc-connection-channel-list proc)) #'string<) :to-equal '("#chan1" "#chan2" "#chan3"))) (it "should rember activity times for a rejoining user" (let ((channel (irc-channel-from-name proc "#channel")) user) (irc-channel-add-user channel "nick!user@host") (setq user (irc-channel-user channel "nick")) (setf (irc-user-last-activity-time user) 235) (irc-channel-remove-user channel "nick") (irc-channel-add-user channel "nick!user@host") (expect (irc-user-last-activity-time (irc-channel-user channel "nick")) :to-equal 235))) (it "should rember activity times for a user regaining their nick" (let ((channel (irc-channel-from-name proc "#channel")) user) (irc-channel-add-user channel "nick!user@host") (setq user (irc-channel-user channel "nick")) (setf (irc-user-last-activity-time user) 235) (irc-channel-remove-user channel "nick") (irc-channel-add-user channel "nick2!user@host") (irc-channel-rename-user channel "nick2" "nick") (expect (irc-user-last-activity-time (irc-channel-user channel "nick")) :to-equal 235))))) (describe "The State Tracking handler" (let (proc table) (before-each (setq proc (start-process "test" nil "cat") table (irc-handler-table)) (irc-connection-put proc :handler-table table) (irc-connection-put proc :current-nick "mynick") (irc-handle-state-tracking table)) (after-each (ignore-errors (delete-process proc))) (describe "for the current nick" (it "should set the nick on 001 RPL_WELCOME" (irc-event-emit proc "001" "irc.server" "new-nick" "Welcome to IRC") (expect (irc-current-nick proc) :to-equal "new-nick") (expect (irc-current-nick-p proc "new-nick") :to-equal t)) (it "should not fail when there are spurious arguments to 001" (irc-event-emit proc "001" "irc.server" "My_Nick" "Some" "broken" "arguments")) (it "should change the nick on NICK" (irc-event-emit proc "001" "irc.server" "initial-nick" "Welcome to IRC") (irc-event-emit proc "NICK" "initial-nick!user@host" "new-nick") (expect (irc-current-nick proc) :to-equal "new-nick") (expect (irc-current-nick-p proc "new-nick") :to-equal t))) (describe "for joining" (it "should update the channel list if we join" (expect (irc-connection-channel proc "#channel") :to-be nil) (irc-event-emit proc "JOIN" "mynick!user@host" "#channel") (expect (irc-connection-channel proc "#channel") :not :to-be nil)) (it "should treat channels case-insensitively" (irc-event-emit proc "JOIN" "mynick!user@host" "#channel") (let ((channel (irc-connection-channel proc "#CHANNEL"))) (expect (irc-channel-name channel) :not :to-be nil))) (it "should update users in a channel if someone else joins" (irc-event-emit proc "JOIN" "mynick!user@host" "#channel") (let ((channel (irc-connection-channel proc "#channel"))) (expect (irc-channel-user channel "otheruser") :to-be nil) (irc-event-emit proc "JOIN" "otheruser!user@host" "#channel") (expect (irc-channel-user channel "otheruser") :not :to-be nil))) (it "should not update users in a channel we are not there" (irc-event-emit proc "JOIN" "otheruser!user@host" "#channel") (expect (irc-connection-channel proc "#channel") :to-be nil)) (it "should not fail on extended JOIN" (irc-event-emit proc "JOIN" "mynick!user@host" "#channel" "account" "The real name") (irc-event-emit proc "JOIN" "otheruser!user@host" "#channel" "account" "The real name")) (it "should set the join time" (spy-on 'float-time :and-return-value 23) (irc-event-emit proc "JOIN" "mynick!user@host" "#channel") (irc-event-emit proc "JOIN" "somenick!user@host" "#channel") (expect (irc-user-join-time (irc-channel-user (irc-connection-channel proc "#channel") "somenick")) :to-equal 23))) (describe "for parting" (before-each (irc-event-emit proc "JOIN" "mynick!user@host" "#channel") (irc-event-emit proc "JOIN" "othernick!user@host" "#channel")) (it "should remove a channel if we part" (irc-event-emit proc "PART" "mynick!user@host" "#channel") (expect (irc-connection-channel proc "#channel") :to-be nil)) (it "should remove a channel if we get kicked" (irc-event-emit proc "KICK" "somenick!user@host" "#channel" "mynick" "You are out") (expect (irc-connection-channel proc "#channel") :to-be nil)) (it "should remove all channels if we quit" (irc-event-emit proc "QUIT" "mynick!user@host" "I am out") (expect (irc-connection-channel proc "#channel") :to-be nil)) (it "should remove a user if they part" (irc-event-emit proc "PART" "othernick!user@host" "#channel") (expect (irc-channel-user (irc-connection-channel proc "#channel") "othernick") :to-be nil)) (it "should remove a channel from other users if we get kicked" (irc-event-emit proc "KICK" "mynick!user@host" "#channel" "othernick" "You are out") (expect (irc-channel-user (irc-connection-channel proc "#channel") "othernick") :to-be nil)) (it "should remove a user from a channel if they quit" (irc-event-emit proc "QUIT" "othernick!user@host" "I am out") (expect (irc-channel-user (irc-connection-channel proc "#channel") "othernick") :to-be nil)) (it "should emit a signal for each channel a user was on if they quit" (let ((events nil)) (irc-handler-add table "channel.quit" (lambda (proc event sender channel message) (push (list sender channel message) events))) (irc-event-emit proc "JOIN" "mynick!user@host" "#channel1") (irc-event-emit proc "JOIN" "othernick!user@host" "#channel1") (irc-event-emit proc "JOIN" "mynick!user@host" "#channel2") (irc-event-emit proc "JOIN" "othernick!user@host" "#channel2") (irc-event-emit proc "JOIN" "mynick!user@host" "#channel3") (irc-event-emit proc "QUIT" "othernick!user@host" "I am out") (expect events :to-contain '("othernick!user@host" "#channel1" "I am out")) (expect events :to-contain '("othernick!user@host" "#channel2" "I am out")) (expect events :not :to-contain '("othernick!user@host" "#channel3" "I am out")) ))) (describe "for nick changes" (before-each (irc-event-emit proc "JOIN" "mynick!user@host" "#chan1") (irc-event-emit proc "JOIN" "mynick!user@host" "#chan2") (irc-event-emit proc "JOIN" "mynick!user@host" "#chan3") (irc-event-emit proc "JOIN" "othernick!user@host" "#chan1") (irc-event-emit proc "JOIN" "othernick!user@host" "#chan2")) (it "should update the user on all channels" (irc-event-emit proc "NICK" "othernick!user@host" "newnick") (expect (irc-channel-user (irc-connection-channel proc "#chan1") "othernick") :to-be nil) (expect (irc-channel-user (irc-connection-channel proc "#chan1") "newnick") :not :to-be nil) (expect (irc-channel-user (irc-connection-channel proc "#chan2") "othernick") :to-be nil) (expect (irc-channel-user (irc-connection-channel proc "#chan2") "newnick") :not :to-be nil))) (describe "for activity" (it "should set the last activity timestamp on PRIVMSG" (spy-on 'float-time :and-return-value 23) (irc-event-emit proc "JOIN" "mynick!user@host" "#channel") (irc-event-emit proc "JOIN" "othernick!user@host" "#channel") (irc-event-emit proc "PRIVMSG" "othernick!user@host" "#channel" "Hi!") (expect (irc-user-last-activity-time (irc-channel-user (irc-connection-channel proc "#channel") "othernick")) :to-equal 23))) (describe "for NAMES" (before-each (irc-event-emit proc "JOIN" "mynick!user@host" "#channel")) (it "should add nicks" (irc-event-emit proc "353" "irc.server" "mynick" "=" "#channel" "nick1 @nick2") (irc-event-emit proc "353" "irc.server" "mynick" "=" "#channel" "nick3") (irc-event-emit proc "366" "irc.server" "mynick" "#channel" "End of /NAMES list") (let ((nicks nil)) (maphash (lambda (nick-folded user) (push (irc-user-nick user) nicks)) (irc-channel-users (irc-connection-channel proc "#channel"))) (setq nicks (sort nicks #'string<)) (expect nicks :to-equal '("nick1" "nick2" "nick3")))) (it "should add nicks with a join time of nil" (irc-event-emit proc "353" "irc.server" "mynick" "=" "#channel" "nick1") (irc-event-emit proc "366" "irc.server" "mynick" "#channel" "End of /NAMES list") (expect (irc-user-join-time (irc-channel-user (irc-connection-channel proc "#channel") "nick1")) :to-be nil)) (it "should not touch existing nicks" (irc-event-emit proc "JOIN" "somenick!user@host" "#channel") (irc-event-emit proc "353" "irc.server" "mynick" "=" "#channel" "SOMENICK") (irc-event-emit proc "366" "irc.server" "mynick" "#channel" "End of /NAMES list") (expect (irc-user-nick (irc-channel-user (irc-connection-channel proc "#channel") "SOMENICK")) :to-equal "somenick")) (it "should not fail for unknown channels" (irc-event-emit proc "353" "irc.server" "mynick" "=" "#unknown" "SOMENICK") (irc-event-emit proc "366" "irc.server" "mynick" "#unknown" "End of /NAMES list"))) (describe "for recent channel users" (before-each (irc-event-emit proc "JOIN" "mynick!user@host" "#channel")) (it "should not know a recent user that was not there" (irc-event-emit proc "JOIN" "somenick!user@host" "#channel") (expect (irc-channel-recent-user (irc-connection-channel proc "#channel") "somenick") :to-be nil)) (it "should add a user to recent users when they leave" (irc-event-emit proc "JOIN" "somenick!user@host" "#channel") (irc-event-emit proc "PART" "somenick!user@host" "#channel") (expect (irc-channel-recent-user (irc-connection-channel proc "#channel") "somenick") :not :to-be nil)) (it "should set the part time" (irc-event-emit proc "JOIN" "somenick!user@host" "#channel") (let ((user (irc-channel-user (irc-connection-channel proc "#channel") "somenick"))) (expect (irc-user-part-time user) :to-be nil) (irc-event-emit proc "PART" "somenick!user@host" "#channel") (expect (irc-user-part-time user) :not :to-be nil))) (it "should remove users who left over an hour ago" (spy-on 'float-time :and-return-value 10000) (irc-event-emit proc "JOIN" "nick1!user@host" "#channel") (irc-event-emit proc "JOIN" "nick2!user@host" "#channel") (irc-event-emit proc "PART" "nick1!user@host" "#channel") (spy-on 'float-time :and-return-value 13605) (irc-event-emit proc "PART" "nick2!user@host" "#channel") (expect (irc-channel-recent-user (irc-connection-channel proc "#channel") "nick1") :to-be nil))) (describe "for channel topics" (let (channel) (before-each (irc-connection-add-channel proc "#channel") (setq channel (irc-connection-channel proc "#channel"))) (it "should leave the initial topic empty" (expect (irc-channel-topic channel) :to-be nil) (irc-event-emit proc "331" "irc.server" "mynick" "#channel" "No topic is set") (expect (irc-channel-topic channel) :to-be nil)) (it "should set the initial topic" (expect (irc-channel-topic channel) :to-be nil) (irc-event-emit proc "332" "irc.server" "mynick" "#channel" "The initial topic") (expect (irc-channel-topic channel) :to-equal "The initial topic")) (it "should change topics" (irc-event-emit proc "TOPIC" "nick!user@host" "#channel" "New topic") (expect (irc-channel-topic channel) :to-equal "New topic")) (it "should remember the old topic" (irc-event-emit proc "TOPIC" "nick!user@host" "#channel" "Old topic") (irc-event-emit proc "TOPIC" "nick!user@host" "#channel" "New topic") (expect (irc-channel-last-topic channel) :to-equal "Old topic")) )))) ;;;;;;;;;;;;;;;;;;;;; ;;; Handler: NickServ (describe "The nickserv handler" (let (proc table identified-args ghosted-args regained-args) (before-each (setq proc (start-process "test" nil "cat") table (irc-handler-table)) (irc-connection-put proc :handler-table table) (spy-on 'irc-send-raw) (dolist (elt '((:nickserv-nick "mynick") (:nickserv-password "top-secret") (:nickserv-mask "\\`NickServ!n@s\\'") (:nickserv-identify-challenge "Please identify") (:nickserv-identify-command "PRIVMSG NickServ :IDENTIFY {nick} {password}") (:nickserv-identify-confirmation "You are identified") (:nickserv-ghost-command "PRIVMSG NickServ :GHOST {nick} {password}") (:nickserv-ghost-confirmation "has been ghosted"))) (irc-connection-put proc (car elt) (cadr elt))) (irc-handle-nickserv table) (setq identified-args nil) (irc-handler-add table "nickserv.identified" (lambda (&rest args) (setq identified-args args))) (setq ghosted-args nil) (irc-handler-add table "nickserv.ghosted" (lambda (&rest args) (setq ghosted-args args))) (setq regained-args nil) (irc-handler-add table "nickserv.regained" (lambda (&rest args) (setq regained-args args)))) (after-each (ignore-errors (delete-process proc))) (describe "identification" (it "should register on the identify challenge" (irc-event-emit proc "PRIVMSG" "NickServ!n@s" "mynick" "Please identify") (expect 'irc-send-raw :to-have-been-called-with proc "PRIVMSG NickServ :IDENTIFY mynick top-secret")) (it "should register with a password function" (irc-connection-put proc :nickserv-password (lambda (conn) "bottom-secret")) (irc-event-emit proc "PRIVMSG" "NickServ!n@s" "mynick" "Please identify") (expect 'irc-send-raw :to-have-been-called-with proc "PRIVMSG NickServ :IDENTIFY mynick bottom-secret")) (it "should not respond to a fake challenge" (irc-event-emit proc "PRIVMSG" "NickServ!fake@host" "mynick" "Please identify") (expect 'irc-send-raw :not :to-have-been-called)) (it "should emit nickserv.identified for the identification confirmation" (irc-event-emit proc "PRIVMSG" "NickServ!n@s" "mynick" "You are identified") (expect identified-args :to-equal (list proc "nickserv.identified"))) (it "should not fail if no nickserv mask is given" (irc-connection-put proc :nickserv-mask nil) (irc-event-emit proc "PRIVMSG" "NickServ!n@s" "mynick" "Please identify")) (it "should not fail if no password is given" (irc-connection-put proc :nickserv-password nil) (irc-event-emit proc "PRIVMSG" "NickServ!n@s" "mynick" "Please identify"))) (describe "ghosting" (it "should ghost if we do not have our nick" (irc-event-emit proc "irc.registered" "othernick") (expect 'irc-send-raw :to-have-been-called-with proc "PRIVMSG NickServ :GHOST mynick top-secret")) (it "should not ghost if we do have our nick" (irc-event-emit proc "irc.registered" "mynick") (expect 'irc-send-raw :not :to-have-been-called)) (it "should emit nickserv.ghosted after successful ghosting" (irc-event-emit proc "PRIVMSG" "NickServ!n@s" "othernick" "That person has been ghosted") (expect ghosted-args :to-equal (list proc "nickserv.ghosted"))) (it "should regain the original nick" (irc-event-emit proc "PRIVMSG" "NickServ!n@s" "othernick" "That person has been ghosted") (expect 'irc-send-raw :to-have-been-called-with proc "NICK mynick")) (it "should emit nickserv.regained when the nick is regained" (irc-event-emit proc "irc.registered" "othernick") (irc-event-emit proc "PRIVMSG" "NickServ!n@s" "othernick" "That person has been ghosted") (irc-event-emit proc "NICK" "othernick!user@host" "mynick") (expect regained-args :to-equal (list proc "nickserv.regained"))) (it "should not fail if no password is given" (irc-connection-put proc :nickserv-password nil) (irc-event-emit proc "irc.registered" "othernick"))))) (describe "The `irc-format' function" (it "should format simple strings" (expect (irc-format "{greeting}, {world}!" 'greeting "Hello" 'world "World") :to-equal "Hello, World!")) (it "should use string formatting for objects" (expect (irc-format "{obj}" 'obj (list 1 2 3)) :to-equal "(1 2 3)"))) ;;;;;;;;;;;;;;;;;;;;;; ;;; Handler: Auto join (describe "The auto join handler" (let (proc table) (before-each (setq proc (start-process "test" nil "cat") table (irc-handler-table)) (irc-connection-put proc :handler-table table) (irc-connection-put proc :nick "mynick") (irc-connection-put proc :nickserv-nick "mynick") (irc-connection-put proc :auto-join-after-registration '("#after-registration")) (irc-connection-put proc :auto-join-after-host-hiding '("#after-host-hiding")) (irc-connection-put proc :auto-join-after-nick-acquisition '("#after-nick-acquisition")) (irc-connection-put proc :auto-join-after-nickserv-identification '("#after-nickserv-identification")) (irc-connection-put proc :auto-join-after-sasl-login '("#after-sasl-login")) (spy-on 'irc-send-raw) (irc-handle-auto-join table)) (after-each (ignore-errors (delete-process proc))) (it "should join channels after registration" (irc-event-emit proc "irc.registered" "mynick") (expect 'irc-send-raw :to-have-been-called-with proc "JOIN #after-registration")) (it "should join channels after host hiding" (irc-event-emit proc "396" "server" "mynick" "host" "is now your host") (expect 'irc-send-raw :to-have-been-called-with proc "JOIN #after-host-hiding")) (it "should join channels after nick regain" (irc-event-emit proc "nickserv.regained") (expect 'irc-send-raw :to-have-been-called-with proc "JOIN #after-nick-acquisition")) (it "should join channels after nickserv identification" (irc-event-emit proc "nickserv.identified") (expect 'irc-send-raw :to-have-been-called-with proc "JOIN #after-nickserv-identification")) (it "should join channels after sasl login" (irc-event-emit proc "sasl.login" "mynick!user@host" "account") (expect 'irc-send-raw :to-have-been-called-with proc "JOIN #after-sasl-login")))) circe-2.6/tests/test-shorten.el000066400000000000000000000074741316355431300166110ustar00rootroot00000000000000;; -*-lexical-binding: t-*- (require 'shorten) (describe "The `shorten-one' function" (it "should shorten to a single character" (expect (let ((lst (list "foo" "bar" "baz" "quux"))) (shorten-one (car lst) lst)) :to-equal "f")) (it "should shorten to two characters" (expect (let ((lst (list "foo" "fig"))) (shorten-one (car lst) lst)) :to-equal "fo")) (it "should shorten to three characters" (expect (let ((lst (list "foo" "fig" "foot"))) (shorten-one (car lst) lst)) :to-equal "foo")) (it "should support a component validation function" (expect (let ((shorten-validate-component-function (lambda (x) (> (length x) 1))) (lst (list "foo" "bar" "baz" "quux"))) (shorten-one (car lst) lst)) :to-equal "fo"))) (describe "The `shorten-make-tree' function" ;; This is a terrible description. (it "should make trees" (expect (shorten-make-tree (list "foo")) :to-equal '(("foo" nil "foo" nil))) (expect (let ((shorten-split-function (lambda (s) (split-string s "-")))) (shorten-make-tree (list "foo" "bar"))) :to-equal '(("bar" nil "bar" nil) ("foo" nil "foo" nil))) (expect (let ((shorten-split-function (lambda (s) (split-string s "-")))) (shorten-make-tree (list "foo" "foo-bar"))) :to-equal '(("foo" nil "foo" ("bar" nil "foo-bar" nil)))) (expect (shorten-make-tree (list)) :to-equal nil) (expect (shorten-make-tree (list "foo-bar" "foo")) :to-equal '(("foo" nil "foo" ("-" nil nil ("bar" nil "foo-bar" nil))))))) (describe "The `shorten-walk' function" (it "should return the empty list for a an empty tree" (expect (shorten-walk '()) :to-equal nil)) (it "should return an alist for a single word" (expect (shorten-walk '(("foo" nil "foo" nil))) :to-equal '(("foo" . "f"))))) (describe "The `shorten-strings' function" ;; Another terrible name. (it "should work" (expect (shorten-strings (list)) :to-equal nil) (expect (shorten-strings (list "foo")) :to-equal '(("foo" . "f"))) (expect (shorten-strings (list "foo" "bar")) :to-equal '(("foo" . "f") ("bar" . "b"))) (expect (shorten-strings (list "foo" "foo-bar")) :to-equal '(("foo-bar" . "f-b") ("foo" . "f"))) (expect (shorten-strings (list "fo" "f")) :to-equal '(("fo" . "fo") ("f" . "f"))) (expect (shorten-strings (list "foo-foo" "foo-bar" "foo-baz" "foo-quux" "bar-foo" "bar-bar" "bar-baz" "bar-quux")) :to-equal '(("foo-foo" . "f-f") ("foo-bar" . "f-bar") ("foo-baz" . "f-baz") ("foo-quux" . "f-q") ("bar-foo" . "b-f") ("bar-bar" . "b-bar") ("bar-baz" . "b-baz") ("bar-quux" . "b-q"))))) (defun shorten-tests-tail-count-join-function (lst tail-count) (concat (shorten-join lst) "{" (number-to-string tail-count) "}")) (describe "The `shorten-strings-tail-count' function" ;; More terrible names (it "should work" (let ((shorten-join-function #'shorten-tests-tail-count-join-function)) (expect (shorten-strings (list "foo" "foo-bar")) :to-equal `(("foo-bar" . "f-b{1}") ("foo" . "f{0}"))) (expect (shorten-strings (list "foo" "foo-bar" "foo-bar-baz")) :to-equal `(("foo-bar-baz" . "f-b-b{1}") ("foo-bar" . "f-b{0}") ("foo" . "f{0}")))))) circe-2.6/tests/test-tracking.el000066400000000000000000000005071316355431300167170ustar00rootroot00000000000000;;; Automated tests for tracking.el (require 'tracking) (describe "The `tracking-shorten' function" (it "should retain text properties" (expect (text-properties-at 0 (car (tracking-shorten (list (propertize (buffer-name) 'face 'foo))))) :to-equal '(face foo)))) circe-2.6/tracking.el000066400000000000000000000341301316355431300145770ustar00rootroot00000000000000;;; tracking.el --- Buffer modification tracking ;; Copyright (C) 2006, 2012 - 2015 Jorgen Schaefer ;; Author: Jorgen Schaefer ;; URL: https://github.com/jorgenschaefer/circe/wiki/Tracking ;; 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: ;; tracking.el is a library for other Emacs Lisp programs not useful ;; by itself. ;; The library provides a way to globally register buffers as being ;; modified and scheduled for user review. The user can cycle through ;; the buffers using C-c C-SPC. This is especially useful for buffers ;; that interact with external sources, such as chat clients and ;; similar programs. ;;; Code: (require 'easy-mmode) (require 'shorten) (require 'cl-lib) ;;; User customization (defgroup tracking nil "Tracking of buffer activities." :prefix "tracking-" :group 'applications) (defcustom tracking-shorten-buffer-names-p t "Whether to shorten buffer names in the mode line. A non-nil value will cause tracked buffer names to be shortened as much as possible to stay unambiguous when displaying them in the mode line." :type 'boolean :group 'tracking) (defcustom tracking-frame-behavior 'visible "How to deal with frams to determine visibility of buffers. This is passed as the second argument to `get-buffer-window', see there for further explanation." :type '(choice (const :tag "All visible frames" visible) (const :tag "Visible and iconified frames" 0) (const :tag "All frames" t) (const :tag "Selected frame only" nil)) :group 'tracking) (defcustom tracking-position 'before-modes "Where tracked buffers should appear in the mode line. 'before-modes Before the mode indicators 'after-modes After the mode indicators 'end At the end of the mode line" :type '(choice (const :tag "Before the Mode Indicators" before-modes) (const :tag "Afterthe Mode Indicators" after-modes) (const :tag "At the End of the Mode Line" end)) :group 'tracking) (defcustom tracking-faces-priorities nil "A list of faces which should be shown by tracking in the mode line. The first face found in this list is used." :type '(repeat face) :group 'tracking) (defcustom tracking-ignored-buffers nil "A list of buffers that are never tracked. Each element of this list has one of the following forms: regexp - Any buffer matching won't be tracked. function - Any buffer matching won't be tracked. (regexp faces ...) - Any buffer matching won't be tracked, unless it has a face in FACES ... associated with it. If no faces are given, `tracking-faces-priorities' is used. (function faces ...) - As per above, but with a function as predicate instead of a regexp." :type '(repeat (choice regexp function (list (choice regexp function) (repeat face)))) :group 'tracking) (defcustom tracking-most-recent-first nil "When non-nil, newly tracked buffers will go to the front of the list, rather than to the end." :type 'boolean :group 'tracking) (defcustom tracking-buffer-added-hook nil "Hook run when a buffer has some activity. The functions are run in the context of the buffer. This can also happen when the buffer is already tracked. Check if the buffer name is in `tracking-buffers' if you want to see if it was added before." :type 'hook :group 'tracking) (defcustom tracking-buffer-removed-hook nil "Hook run when a buffer becomes active and is removed. The functions are run in the context of the buffer." :type 'hook :group 'tracking) ;;; Internal variables (defvar tracking-buffers nil "The list of currently tracked buffers.") (defvar tracking-mode-line-buffers "" "The entry to the mode line.") (put 'tracking-mode-line-buffers 'risky-local-variable t) (defvar tracking-start-buffer nil "The buffer we started from when cycling through the active buffers.") (defvar tracking-last-buffer nil "The buffer we last switched to with `tracking-next-buffer'. When this is not the current buffer when we continue switching, a new `tracking-start-buffer' is created.") (defvar tracking-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-SPC") 'tracking-next-buffer) (define-key map (kbd "C-c C-@") 'tracking-next-buffer) map) "The keymap used for tracking mode.") ;;;###autoload (define-minor-mode tracking-mode "Allow cycling through modified buffers. This mode in itself does not track buffer modification, but provides an API for programs to add buffers as modified (using `tracking-add-buffer'). Once this mode is active, modified buffers are shown in the mode line. The user can cycle through them using \\[tracking-next-buffer]." :group 'tracking :global t (cond (tracking-mode (cond ((eq tracking-position 'before-modes) (let ((head nil) (tail (default-value 'mode-line-format))) (when (not (memq 'tracking-mode-line-buffers tail)) (catch 'return (while tail (if (not (eq (car tail) 'mode-line-modes)) (setq head (cons (car tail) head) tail (cdr tail)) (setq-default mode-line-format (append (reverse head) '(tracking-mode-line-buffers) tail)) (throw 'return t))))))) ((eq tracking-position 'after-modes) (add-to-list 'mode-line-misc-info 'tracking-mode-line-buffers)) ((eq tracking-position 'end) (add-to-list 'mode-line-misc-info 'tracking-mode-line-buffers t)) (t (error "Invalid value for `tracking-position' (%s)" tracking-position))) (add-hook 'window-configuration-change-hook 'tracking-remove-visible-buffers)) (t (setq mode-line-misc-info (delq 'tracking-mode-line-buffers mode-line-misc-info)) (setq-default mode-line-format (delq 'tracking-mode-line-buffers (default-value 'mode-line-format))) (remove-hook 'window-configuration-change-hook 'tracking-remove-visible-buffers)))) ;;;###autoload (defun tracking-add-buffer (buffer &optional faces) "Add BUFFER as being modified with FACES. This does check whether BUFFER is currently visible. If FACES is given, it lists the faces that might be appropriate for BUFFER in the mode line. The highest-priority face of these and the current face of the buffer, if any, is used. Priority is decided according to `tracking-faces-priorities'." (when (and (not (get-buffer-window buffer tracking-frame-behavior)) (not (tracking-ignored-p buffer faces))) (with-current-buffer buffer (run-hooks 'tracking-buffer-added-hook)) (let* ((entry (member (buffer-name buffer) tracking-buffers))) (if entry (setcar entry (tracking-faces-merge (car entry) faces)) (setq tracking-buffers (if tracking-most-recent-first (cons (tracking-faces-merge (buffer-name buffer) faces) tracking-buffers) (nconc tracking-buffers (list (tracking-faces-merge (buffer-name buffer) faces))))))) (setq tracking-mode-line-buffers (tracking-status)) (force-mode-line-update t) )) ;;;###autoload (defun tracking-remove-buffer (buffer) "Remove BUFFER from being tracked." (when (member (buffer-name buffer) tracking-buffers) (with-current-buffer buffer (run-hooks 'tracking-buffer-removed-hook))) (setq tracking-buffers (delete (buffer-name buffer) tracking-buffers)) (setq tracking-mode-line-buffers (tracking-status)) (sit-for 0) ;; Update mode line ) ;;;###autoload (defun tracking-next-buffer () "Switch to the next active buffer." (interactive) (cond ((and (not tracking-buffers) tracking-start-buffer) (let ((buf tracking-start-buffer)) (setq tracking-start-buffer nil) (if (buffer-live-p buf) (switch-to-buffer buf) (message "Original buffer does not exist anymore") (ding)))) ((not tracking-buffers) nil) (t (when (not (eq tracking-last-buffer (current-buffer))) (setq tracking-start-buffer (current-buffer))) (let ((new (car tracking-buffers))) (when (buffer-live-p (get-buffer new)) (with-current-buffer new (run-hooks 'tracking-buffer-removed-hook))) (setq tracking-buffers (cdr tracking-buffers) tracking-mode-line-buffers (tracking-status)) (if (buffer-live-p (get-buffer new)) (switch-to-buffer new) (message "Buffer %s does not exist anymore" new) (ding) (setq tracking-mode-line-buffers (tracking-status)))) (setq tracking-last-buffer (current-buffer)) ;; Update mode line. See `force-mode-line-update' for the idea for ;; this code. Using `sit-for' can be quite inefficient for larger ;; buffers. (dolist (w (window-list)) (with-current-buffer (window-buffer w))) ))) ;;;###autoload (defun tracking-previous-buffer () "Switch to the last active buffer." (interactive) (when tracking-buffers (switch-to-buffer (car (last tracking-buffers))))) (defun tracking-ignored-p (buffer faces) "Return non-nil when BUFFER with FACES shouldn't be tracked. This uses `tracking-ignored-buffers'. Actual returned value is the entry from tracking-ignored-buffers that causes this buffer to be ignored." (catch 'return (let ((buffer-name (buffer-name buffer))) (dolist (entry tracking-ignored-buffers) (cond ((stringp entry) (and (string-match entry buffer-name) (throw 'return entry))) ((functionp entry) (and (funcall entry buffer-name) (throw 'return entry))) ((or (and (stringp (car entry)) (string-match (car entry) buffer-name)) (and (functionp (car entry)) (funcall (car entry) buffer-name))) (when (not (tracking-any-in (or (cdr entry) tracking-faces-priorities) faces)) (throw 'return entry)))))) nil)) (defun tracking-status () "Return the current track status. This returns a list suitable for `mode-line-format'." (if (not tracking-buffers) "" (let* ((buffer-names (cl-remove-if-not #'get-buffer tracking-buffers)) (shortened-names (tracking-shorten tracking-buffers)) (result (list " ["))) (while buffer-names (push `(:propertize ,(car shortened-names) face ,(get-text-property 0 'face (car buffer-names)) keymap ,(let ((map (make-sparse-keymap))) (define-key map [mode-line down-mouse-1] `(lambda () (interactive) (pop-to-buffer ,(car buffer-names)))) map) mouse-face mode-line-highlight help-echo ,(format (concat "New activity in %s\n" "mouse-1: pop to the buffer") (car buffer-names))) result) (setq buffer-names (cdr buffer-names) shortened-names (cdr shortened-names)) (when buffer-names (push "," result))) (push "] " result) (nreverse result)))) (defun tracking-remove-visible-buffers () "Remove visible buffers from the tracked buffers. This is usually called via `window-configuration-changed-hook'." (interactive) (dolist (buffer-name tracking-buffers) (let ((buffer (get-buffer buffer-name))) (cond ((not buffer) (setq tracking-buffers (delete buffer-name tracking-buffers)) (setq tracking-mode-line-buffers (tracking-status)) (sit-for 0)) ((get-buffer-window buffer tracking-frame-behavior) (tracking-remove-buffer buffer)))))) ;;; Helper functions (defun tracking-shorten (buffers) "Shorten BUFFERS according to `tracking-shorten-buffer-names-p'." (if tracking-shorten-buffer-names-p (let ((all (shorten-strings (mapcar #'buffer-name (buffer-list))))) (mapcar (lambda (buffer) (let ((short (cdr (assoc buffer all)))) (set-text-properties 0 (length short) (text-properties-at 0 buffer) short) short)) buffers)) buffers)) (defun tracking-any-in (lista listb) "Return non-nil when any element in LISTA is in LISTB" (catch 'return (dolist (entry lista) (when (memq entry listb) (throw 'return t))) nil)) (defun tracking-faces-merge (string faces) "Merge faces into string, adhering to `tracking-faces-priorities'. This returns STRING with the new face." (let ((faces (cons (get-text-property 0 'face string) faces))) (catch 'return (dolist (candidate tracking-faces-priorities) (when (memq candidate faces) (throw 'return (propertize string 'face candidate)))) string))) (provide 'tracking) ;;; tracking.el ends here