diff options
| -rw-r--r-- | .dir-locals.el | 1 | ||||
| -rw-r--r-- | .gitignore | 3 | ||||
| -rw-r--r-- | COPYING | 674 | ||||
| -rw-r--r-- | Cask | 5 | ||||
| -rw-r--r-- | Makefile | 9 | ||||
| -rw-r--r-- | README | 5 | ||||
| -rw-r--r-- | debian/changelog (renamed from changelog) | 0 | ||||
| -rw-r--r-- | debian/compat (renamed from compat) | 0 | ||||
| -rw-r--r-- | debian/control (renamed from control) | 0 | ||||
| -rw-r--r-- | debian/copyright (renamed from copyright) | 0 | ||||
| -rw-r--r-- | debian/elpa-tablist.elpa (renamed from elpa-tablist.elpa) | 0 | ||||
| -rwxr-xr-x | debian/rules (renamed from rules) | 0 | ||||
| -rw-r--r-- | debian/source/format (renamed from source/format) | 0 | ||||
| -rw-r--r-- | debian/watch (renamed from watch) | 0 | ||||
| -rw-r--r-- | tablist-filter.el | 449 | ||||
| -rw-r--r-- | tablist.el | 1949 |
16 files changed, 3095 insertions, 0 deletions
diff --git a/.dir-locals.el b/.dir-locals.el new file mode 100644 index 0000000..607602c --- /dev/null +++ b/.dir-locals.el @@ -0,0 +1 @@ +nil diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..b74540f --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +*.elc +.dir-locals.el +.cask @@ -0,0 +1,674 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/> + 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. + + <one line to give the program's name and a brief idea of what it does.> + Copyright (C) <year> <name of author> + + 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 <http://www.gnu.org/licenses/>. + +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: + + <program> Copyright (C) <year> <name of author> + 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 +<http://www.gnu.org/licenses/>. + + 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 +<http://www.gnu.org/philosophy/why-not-lgpl.html>. @@ -0,0 +1,5 @@ +(source gnu) +(source melpa) + +(package-file "tablist.el") +(files "*.el") diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..91e6b00 --- /dev/null +++ b/Makefile @@ -0,0 +1,9 @@ + +all: package + +package: + cask package +clean: + rm -rf dist + rm -f -- *.elc + @@ -0,0 +1,5 @@ +This package adds marks and filters to tabulated-list-mode. It +also kind of puts a dired face on tabulated list buffers. + +It can be used by deriving from tablist-mode and some features by +using tablist-minor-mode inside a tabulated-list-mode buffer. diff --git a/changelog b/debian/changelog index 855cd76..855cd76 100644 --- a/changelog +++ b/debian/changelog diff --git a/copyright b/debian/copyright index a9bc05f..a9bc05f 100644 --- a/copyright +++ b/debian/copyright diff --git a/elpa-tablist.elpa b/debian/elpa-tablist.elpa index 8aad2b4..8aad2b4 100644 --- a/elpa-tablist.elpa +++ b/debian/elpa-tablist.elpa diff --git a/source/format b/debian/source/format index 163aaf8..163aaf8 100644 --- a/source/format +++ b/debian/source/format diff --git a/tablist-filter.el b/tablist-filter.el new file mode 100644 index 0000000..6a6f058 --- /dev/null +++ b/tablist-filter.el @@ -0,0 +1,449 @@ +;;; tablist-filter.el --- Filter expressions for tablists. + +;; Copyright (C) 2013, 2014 Andreas Politz + +;; Author: Andreas Politz <politza@fh-trier.de> +;; Keywords: extensions, lisp + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; + +(let (python-mode-hook) +(require 'semantic/wisent/comp) +(require 'semantic/wisent/wisent)) + +;;; Code: + +(defvar wisent-eoi-term) +(declare-function wisent-parse "semantic/wisent/wisent.el") + +(defvar tablist-filter-binary-operator + '((== . tablist-filter-op-equal) + (=~ . tablist-filter-op-regexp) + (< . tablist-filter-op-<) + (> . tablist-filter-op->) + (<= . tablist-filter-op-<=) + (>= . tablist-filter-op->=) + (= . tablist-filter-op-=))) + +(defvar tablist-filter-unary-operator nil) + +(defvar tablist-filter-wisent-parser nil) + +(defvar tablist-filter-lexer-regexps nil) + +(defvar tablist-filter-wisent-grammar + '( + ;; terminals + ;; Use lowercase for better looking error messages. + (operand unary-operator binary-operator or and not) + + ;; terminal associativity & precedence + ((left binary-operator) + (left unary-operator) + (left or) + (left and) + (left not)) + + ;; rules + (filter-or-empty + ((nil)) + ((?\( ?\)) nil) + ((filter) $1)) + (filter + ((operand) $1) ;;Named filter + ((operand binary-operator operand) `(,(intern $2) ,$1 ,$3)) + ((unary-operator operand) `(,(intern $1) ,$2)) + ((not filter) `(not ,$2)) + ((filter and filter) `(and ,$1 ,$3)) + ((filter or filter) `(or ,$1 ,$3)) + ((?( filter ?)) $2)))) + +(defun tablist-filter-parser-init (&optional reinitialize interactive) + (interactive (list t t)) + (unless (and tablist-filter-lexer-regexps + (not reinitialize)) + (let ((re (mapcar + (lambda (l) + (let ((re (regexp-opt + (mapcar 'symbol-name + (mapcar 'car l)) t))) + (if (= (length re) 0) + ".\\`" ;;matches nothing + re))) + (list tablist-filter-binary-operator + tablist-filter-unary-operator)))) + (setq tablist-filter-lexer-regexps + (nreverse + (cons (concat "\\(?:" (car re) "\\|" (cadr re) + "\\|[ \t\f\r\n\"!()]\\|&&\\|||\\)") + re))))) + (unless (and tablist-filter-wisent-parser + (not reinitialize)) + (let ((wisent-compile-grammar* + (symbol-function + 'wisent-compile-grammar))) + (setq tablist-filter-wisent-parser + ;; Trick the byte-compile into not using the byte-compile + ;; handler in semantic/wisent/comp.el, since it does not + ;; always work (wisent-context-compile-grammar n/a). + (funcall wisent-compile-grammar* + tablist-filter-wisent-grammar)))) + (when interactive + (message "Parser reinitialized.")) + nil) + +(defun tablist-filter-wisent-lexer () + (cl-destructuring-bind (unary-op binary-op keywords) + tablist-filter-lexer-regexps + (skip-chars-forward " \t\f\r\n") + (cond + ((eobp) (list wisent-eoi-term)) + ((= ?\" (char-after)) + `(operand , (condition-case err + (read (current-buffer)) + (error (signal (car err) (cons + "invalid lisp string" + (cdr err))))))) + ((looking-at unary-op) + (goto-char (match-end 0)) + `(unary-operator ,(match-string-no-properties 0))) + ((looking-at binary-op) + (goto-char (match-end 0)) + `(binary-operator ,(match-string-no-properties 0))) + ((looking-at "&&") + (forward-char 2) + `(and "&&")) + ((looking-at "||") + (forward-char 2) + `(or "||")) + ((= ?! (char-after)) + (forward-char) + `(not "!")) + ((= ?\( (char-after)) + (forward-char) + `(?\( "(")) + ((= ?\) (char-after)) + (forward-char) + `(?\) ")")) + (t + (let ((beg (point))) + (when (re-search-forward keywords nil 'move) + (goto-char (match-beginning 0))) + `(operand ,(buffer-substring-no-properties + beg + (point)))))))) + +(defun tablist-filter-parse (filter) + (interactive "sFilter: ") + (tablist-filter-parser-init) + (with-temp-buffer + (save-excursion (insert filter)) + (condition-case error + (wisent-parse tablist-filter-wisent-parser + 'tablist-filter-wisent-lexer + (lambda (msg) + (signal 'error + (replace-regexp-in-string + "\\$EOI" "end of input" + msg t t)))) + (error + (signal 'error + (append (if (consp (cdr error)) + (cdr error) + (list (cdr error))) + (list (point)))))))) + +(defun tablist-filter-unparse (filter &optional noerror) + (cl-labels + ((unparse (filter &optional noerror) + (cond + ((stringp filter) + (if (or (string-match (nth 2 tablist-filter-lexer-regexps) + filter) + (= 0 (length filter))) + (format "%S" filter) + filter)) + ((and (eq (car-safe filter) 'not) + (= (length filter) 2)) + (let ((paren (memq (car-safe (nth 1 filter)) '(or and)))) + (format "!%s%s%s" + (if paren "(" "") + (unparse (cadr filter) noerror) + (if paren ")" "")))) + ((and (memq (car-safe filter) '(and or)) + (= (length filter) 3)) + (let ((lparen (and (eq (car filter) 'and) + (eq 'or (car-safe (car-safe (cdr filter)))))) + (rparen (and (eq (car filter) 'and) + (eq 'or (car-safe (car-safe (cddr filter))))))) + (format "%s%s%s %s %s%s%s" + (if lparen "(" "") + (unparse (cadr filter) noerror) + (if lparen ")" "") + (cl-case (car filter) + (and "&&") (or "||")) + (if rparen "(" "") + (unparse (car (cddr filter)) noerror) + (if rparen ")" "")))) + ((and (assq (car-safe filter) tablist-filter-binary-operator) + (= (length filter) 3)) + (format "%s %s %s" + (unparse (cadr filter) noerror) + (car filter) + (unparse (car (cddr filter)) noerror))) + ((and (assq (car-safe filter) tablist-filter-unary-operator) + (= (length filter) 2)) + (format "%s %s" + (car filter) + (unparse (cadr filter) noerror))) + ((not filter) "") + (t (funcall (if noerror 'format 'error) + "Invalid filter: %s" filter))))) + (tablist-filter-parser-init) + (unparse filter noerror))) + + +(defun tablist-filter-eval (filter id entry &optional named-alist) + (cl-labels + ((feval (filter) + (pcase filter + (`(not . ,(and operand (guard (not (cdr operand))))) + (not (feval (car operand)))) + (`(and . ,(and operands (guard (= 2 (length operands))))) + (and + (feval (nth 0 operands)) + (feval (nth 1 operands)))) + (`(or . ,(and operands (guard (= 2 (length operands))))) + (or + (feval (nth 0 operands)) + (feval (nth 1 operands)))) + (`(,op . ,(and operands (guard (= (length operands) 1)))) + (let ((fn (assq op tablist-filter-unary-operator))) + (unless fn + (error "Undefined unary operator: %s" op)) + (funcall fn id entry (car operands)))) + (`(,op . ,(and operands (guard (= (length operands) 2)))) + (let ((fn (cdr (assq op tablist-filter-binary-operator)))) + (unless fn + (error "Undefined binary operator: %s" op)) + (funcall fn id entry (car operands) + (cadr operands)))) + ((guard (stringp filter)) + (let ((fn (cdr (assoc filter named-alist)))) + (unless fn + (error "Undefined named filter: %s" filter)) + (if (functionp fn) + (funcall fn id entry)) + (feval + (if (stringp fn) (tablist-filter-unparse fn) fn)))) + (`nil t) + (_ (error "Invalid filter: %s" filter))))) + (feval filter))) + +(defun tablist-filter-get-item-by-name (entry col-name) + (let* ((col (cl-position col-name tabulated-list-format + :key 'car + :test + (lambda (s1 s2) + (eq t (compare-strings + s1 nil nil s2 nil nil t))))) + (item (and col (elt entry col)))) + (unless col + (error "No such column: %s" col-name)) + (if (consp item) ;(LABEL . PROPS) + (car item) + item))) + +(defun tablist-filter-op-equal (id entry op1 op2) + "COLUMN == STRING : Matches if COLUMN's entry is equal to STRING." + (let ((item (tablist-filter-get-item-by-name entry op1))) + (string= item op2))) + +(defun tablist-filter-op-regexp (id entry op1 op2) + "COLUMN =~ REGEXP : Matches if COLUMN's entry matches REGEXP." + (let ((item (tablist-filter-get-item-by-name entry op1))) + (string-match op2 item))) + +(defun tablist-filter-op-< (id entry op1 op2) + "COLUMN < NUMBER : Matches if COLUMN's entry is less than NUMBER." + (tablist-filter-op-numeric '< id entry op1 op2)) + +(defun tablist-filter-op-> (id entry op1 op2) + "COLUMN > NUMBER : Matches if COLUMN's entry is greater than NUMBER." + (tablist-filter-op-numeric '> id entry op1 op2)) + +(defun tablist-filter-op-<= (id entry op1 op2) + "COLUMN <= NUMBER : Matches if COLUMN's entry is less than or equal to NUMBER." + (tablist-filter-op-numeric '<= id entry op1 op2)) + +(defun tablist-filter-op->= (id entry op1 op2) + "COLUMN >= NUMBER : Matches if COLUMN's entry is greater than or equal to NUMBER." + (tablist-filter-op-numeric '>= id entry op1 op2)) + +(defun tablist-filter-op-= (id entry op1 op2) + "COLUMN = NUMBER : Matches if COLUMN's entry as a number is equal to NUMBER." + (tablist-filter-op-numeric '= id entry op1 op2)) + +(defun tablist-filter-op-numeric (op id entry op1 op2) + (let ((item (tablist-filter-get-item-by-name entry op1))) + (funcall op (string-to-number item) + (string-to-number op2)))) + +(defun tablist-filter-help (&optional temporary) + (interactive) + (cl-labels + ((princ-op (op) + (princ (car op)) + (princ (concat (make-string (max 0 (- 4 (length (symbol-name (car op))))) + ?\s) + "- " + (car (split-string + (or (documentation (cdr op)) + (format "FIXME: Not documented: %s" + (cdr op))) + "\n" t)) + "\n")))) + (with-temp-buffer-window + "*Help*" + (if temporary + '((lambda (buf alist) + (let ((win + (or (display-buffer-reuse-window buf alist) + (display-buffer-in-side-window buf alist)))) + (fit-window-to-buffer win) + win)) + (side . bottom))) + nil + (princ "Filter entries with the following operators.\n\n") + (princ "&& - FILTER1 && FILTER2 : Locical and.\n") + (princ "|| - FILTER1 || FILTER2 : Locical or.\n") + (dolist (op tablist-filter-binary-operator) + (princ-op op)) + (princ "! - ! FILTER : Locical not.\n\n") + (dolist (op tablist-filter-unary-operator) + (princ-op op)) + (princ "\"...\" may be used to quote names and values if necessary, +and \(...\) to group expressions.") + (with-current-buffer standard-output + (help-mode))))) + +;; +;; **Filter Functions +;; + +;; filter ::= nil | named | fn | (OP OP1 [OP2]) + +(defun tablist-filter-negate (filter) + "Return a filter not matching filter." + (cond + ((eq (car-safe filter) 'not) + (cadr filter)) + (filter + (list 'not filter)))) + +(defun tablist-filter-push (filter new-filter &optional or-p) + "Return a filter combining FILTER and NEW-FILTER. + +By default the filters are and'ed, unless OR-P is non-nil." + (if (or (null filter) + (null new-filter)) + (or filter + new-filter) + (list (if or-p 'or 'and) + filter new-filter))) + +(defun tablist-filter-pop (filter) + "Remove the first operator or operand from filter. + +If filter starts with a negation, return filter unnegated, +if filter starts with a dis- or conjuction, remove the first operand, +if filter is nil, raise an error, +else return nil." + (pcase filter + (`(,(or `and `or) . ,tail) + (car (cdr tail))) + (`(not . ,op1) + (car op1)) + (_ (unless filter + (error "Filter is empty"))))) + +(defun tablist-filter-map (fn filter) + (pcase filter + (`(,(or `and `or `not) . ,tail) + (cons (car filter) + (mapcar (lambda (f) + (tablist-filter-map fn f)) + tail))) + (_ (funcall fn filter)))) + + +;; +;; Reading filter +;; + +(defvar tablist-filter-edit-history nil) +(defvar tablist-filter-edit-display-help t) + +(defun tablist-filter-edit-filter (prompt &optional + initial-filter history + validate-fn) + (let* ((str (tablist-filter-unparse initial-filter)) + (filter initial-filter) + (validate-fn (or validate-fn 'identity)) + error done) + (save-window-excursion + (when tablist-filter-edit-display-help + (tablist-filter-help t)) + (while (not done) + (minibuffer-with-setup-hook + (lambda () + (when error + (when (car error) + (goto-char (+ (field-beginning) + (car error))) + (skip-chars-backward " \t\n")) + (minibuffer-message "%s" (cdr error)) + (setq error nil))) + (setq str (propertize + (read-string prompt str + (or history 'tablist-filter-edit-history))) + done t)) + (condition-case err + (progn + (setq filter (tablist-filter-parse str)) + (funcall validate-fn filter)) + (error + (setq done nil) + (setq error (cons (car-safe (cddr err)) nil)) + (when (car error) + (setq str (with-temp-buffer + (insert str) + (goto-char (car error)) + (set-text-properties + (progn + (skip-chars-backward " \t\n") + (backward-char) + (point)) + (min (car error) (point-max)) + '(face error rear-nonsticky t)) + (buffer-string)))) + (setcdr error (error-message-string err))))) + filter))) + +(provide 'tablist-filter) +;;; tablist-filter.el ends here diff --git a/tablist.el b/tablist.el new file mode 100644 index 0000000..65ad3bc --- /dev/null +++ b/tablist.el @@ -0,0 +1,1949 @@ +;;; tablist.el --- Extended tabulated-list-mode -*- lexical-binding: t -*- + +;; Copyright (C) 2013, 2014 Andreas Politz + +;; Author: Andreas Politz <politza@fh-trier.de> +;; Keywords: extensions, lisp +;; Package: tablist +;; Version: 0.70 +;; Package-Requires: ((emacs "24.3")) + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; This package adds marks and filters to tabulated-list-mode. It +;; also kind of puts a dired face on tabulated list buffers. +;; +;; It can be used by deriving from tablist-mode and some features by +;; using tablist-minor-mode inside a tabulated-list-mode buffer. +;; + +(require 'cl-lib) +(require 'ring) +(require 'tabulated-list) +(require 'dired) +(require 'tablist-filter) + +;; +;; *Macros +;; + +(defmacro tablist-save-marks (&rest body) + "Eval body, while preserving all marks." + (let ((marks (make-symbol "marks"))) + `(let (,marks) + (save-excursion + (goto-char (point-min)) + (let ((re "^\\([^ ]\\)")) + (while (re-search-forward re nil t) + (push (cons (tabulated-list-get-id) + (tablist-get-mark-state)) + ,marks)))) + (unwind-protect + (progn ,@body) + (save-excursion + (dolist (m ,marks) + (let ((id (pop m))) + (goto-char (point-min)) + (while (and id (not (eobp))) + (when (equal id (tabulated-list-get-id)) + (tablist-put-mark-state m) + (setq id nil)) + (forward-line))))))))) + +(defmacro tablist-with-remembering-entry (&rest body) + "Remember where body left of and restore previous position. + +If the current entry is still visible, move to it. Otherwise move +to the next visible one after it. If that also fails, goto to +the beginning of the buffer. Finally move point to the major +column." + (declare (indent 0) (debug t)) + (let ((re (make-symbol "re")) + (id (make-symbol "id")) + (col (make-symbol "col"))) + `(let ((,re + (replace-regexp-in-string + "[\t ]+" "[\t ]*" (regexp-quote + (or (thing-at-point 'line) "")) + t t)) + (,id (tabulated-list-get-id)) + (,col (tablist-current-column))) + (progn + ,@body + (let (success pos) + (goto-char (point-min)) + (setq pos (point)) + (while (and (setq success (re-search-forward ,re nil t)) + (> (point) (prog1 pos (setq pos (point)))) + (forward-line -1) + (not (equal ,id (tabulated-list-get-id)))) + (forward-line)) + (unless success + (goto-char (point-min)) + (while (and (not (eobp)) + (not success)) + (if (equal (tabulated-list-get-id) ,id) + (setq success t) + (forward-line)))) + (unless (and success (not (invisible-p (point)))) + (goto-char (point-min))) + (tablist-skip-invisible-entries) + (tablist-move-to-column + (or ,col (car (tablist-major-columns)))) + (dolist (win (get-buffer-window-list)) + (set-window-point win (point)))))))) + +(defmacro tablist-with-filter-displayed (&rest body) + "Display the current filter in the mode while evalling BODY." + (let ((state (make-symbol "state"))) + `(let ((,state (tablist-display-filter 'state))) + (tablist-display-filter t) + (unwind-protect + (progn ,@body) + (tablist-display-filter ,state))))) + +;; +;; *Mode Maps +;; + +(defvar tablist-mode-filter-map + (let ((kmap (make-sparse-keymap))) + (define-key kmap "p" 'tablist-pop-filter) + (define-key kmap "r" 'tablist-push-regexp-filter) + (define-key kmap "=" 'tablist-push-equal-filter) + (define-key kmap "n" 'tablist-push-numeric-filter) + (define-key kmap "!" 'tablist-negate-filter) + (define-key kmap "t" 'tablist-toggle-first-filter-logic) + (define-key kmap "/" 'tablist-display-filter) + (define-key kmap "z" 'tablist-suspend-filter) + + (define-key kmap "a" 'tablist-push-named-filter) + (define-key kmap "s" 'tablist-name-current-filter) + (define-key kmap "D" 'tablist-delete-named-filter) + (define-key kmap "d" 'tablist-deconstruct-named-filter) + (define-key kmap "e" 'tablist-edit-filter) + (define-key kmap "C" 'tablist-clear-filter) + kmap)) + +(defvar tablist-mode-mark-map + (let ((kmap (make-sparse-keymap))) + (define-key kmap "c" 'tablist-change-marks) + (define-key kmap "!" 'tablist-unmark-all-marks) + (define-key kmap "r" 'tablist-mark-items-regexp) + (define-key kmap "n" 'tablist-mark-items-numeric) + (define-key kmap "m" 'tablist-mark-forward) + kmap)) + +(defvar tablist-mode-regexp-map + (let ((kmap (make-sparse-keymap))) + ;; (define-key kmap "&" 'tablist-flag-gargabe-items) + (define-key kmap "m" 'tablist-mark-items-regexp) + kmap)) + +(defvar tablist-minor-mode-map + (let ((kmap (make-sparse-keymap))) + (define-key kmap "m" 'tablist-mark-forward) + (define-key kmap (kbd "DEL") 'tablist-unmark-backward) + (define-key kmap "k" 'tablist-do-kill-lines) + (define-key kmap "U" 'tablist-unmark-all-marks) + (define-key kmap "u" 'tablist-unmark-forward) + (define-key kmap "t" 'tablist-toggle-marks) + + (define-key kmap (kbd "TAB") 'tablist-forward-column) + (define-key kmap "\t" 'tablist-forward-column) + (define-key kmap [backtab] 'tablist-backward-column) + + (define-key kmap "%" tablist-mode-regexp-map) + (define-key kmap "*" tablist-mode-mark-map) + (define-key kmap "/" tablist-mode-filter-map) + + ;; (define-key kmap "e" 'tablist-edit-column) + ;; (define-key kmap "i" 'tablist-insert-entry) + (define-key kmap "s" 'tablist-sort) + (define-key kmap [remap back-to-indentation] 'tablist-move-to-major-column) + (define-key kmap [remap next-line] 'tablist-next-line) + (define-key kmap [remap previous-line] 'tablist-previous-line) + (define-key kmap "<" 'tablist-shrink-column) + (define-key kmap ">" 'tablist-enlarge-column) + (define-key kmap "q" 'tablist-quit) + (define-key kmap "G" 'tablist-revert) + (define-key kmap (kbd "C-c C-e") 'tablist-export-csv) + kmap)) + +(defvar tablist-mode-map + (let ((kmap (copy-keymap tablist-minor-mode-map))) + (set-keymap-parent kmap tabulated-list-mode-map) + (define-key kmap "d" 'tablist-flag-forward) + (define-key kmap (kbd "RET") 'tablist-find-entry) + (define-key kmap "f" 'tablist-find-entry) + ;; (define-key kmap "~" 'tablist-flag-gargabe-items) + (define-key kmap "D" 'tablist-do-delete) + (define-key kmap "C" 'tablist-do-copy) + (define-key kmap "R" 'tablist-do-rename) + (define-key kmap "x" 'tablist-do-flagged-delete) + ;; (define-key kmap "F" 'tablist-find-marked-items) + ;; (define-key kmap (kbd "C-o") 'tablist-display-item) + kmap)) + + +;; +;; *Variables +;; + +;; Marking +(defvar tablist-umark-filtered-entries t) +(defvar tablist-marker-char dired-marker-char + "The character used for marking.") +(defvar tablist-marker-face 'dired-mark + "The face used for the mark character.") +(defvar tablist-marked-face 'dired-marked + "The face used for marked major columns.") + +;; Operations +(defvar-local tablist-operations-function nil + "A function for handling operations on the entries. + +The function is called with varying number of arguments, while +the first one is always a symbol describing one of the following +operations. + +`supported-operations' + +This is the only mandatory operation. There are no other +arguments and the function should return a list of symbols of +supported operations. + +`delete' + +The 2nd argument will be a list of entry ID's. The function +should somehow delete these entries and update +`tabulated-list-entries'. + +`find-entry' + +The 2nd argument is the ID of an entry. The function should +somehow find/display this entry, i.e. a kind of default +operation. + +`edit-column' + +The function is called with 3 further arguments: ID, INDEX and +NEW-COLUMN, where ID represents the entry to edit, INDEX is the index +of the column and NEW-COLUMN is the proposed new value for this +column. It should either + +i. return a new edited complete entry and update +`tabulated-list-entries', or + +ii. throw an error, if NEW-COLUMN is not a valid value for this +column. + +`complete' + +The function is called with 4 further arguments: ID, INDEX, +STRING and POS, where ID represents an entry, INDEX is the index +of the column to complete, STRING it's current value and POS an +offset of the current position of point into STRING. + +The function should return a collection for this column, suitable +as argument for the function `completion-in-region'.") + +;; Differentiating columns +(defvar-local tablist-major-columns nil + "Columns used to mark and when querying.") + +;; Filter +(defvar-local tablist-current-filter nil) +(defvar-local tablist-filter-suspended nil) +(defvar tablist-named-filter nil) + +;; History variables +(defvar tablist-column-name-history nil) + +;; Hooks +(defvar tablist-selection-changed-functions nil + "A hook run when ever point moves to a different entry.") + +;; Context Window +(defvar-local tablist-context-window nil) +(defvar-local tablist-context-window-function nil) +(defvar tablist-context-window-display-action + `((display-buffer-reuse-window + tablist-display-buffer-split-below-and-attach) + (window-height . 0.25) + (inhibit-same-window . t))) + +;; +;; *Setup +;; + +(defvar savehist-additional-variables) +(add-hook 'savehist-save-hook + (lambda nil + (add-to-list 'savehist-additional-variables 'tablist-named-filter))) + +;;;###autoload +(define-minor-mode tablist-minor-mode + nil nil nil nil + (unless (derived-mode-p 'tabulated-list-mode) + (error "Buffer is not in Tabulated List Mode")) + (tablist-init (not tablist-minor-mode))) + +;;;###autoload +(define-derived-mode tablist-mode tabulated-list-mode "TL" + (tablist-init)) + +(defun tablist-init (&optional disable) + (let ((cleaned-misc (cl-remove 'tablist-current-filter + mode-line-misc-info :key 'car))) + (cond + ((not disable) + (set (make-local-variable 'mode-line-misc-info) + (append + (list + (list 'tablist-current-filter + '(:eval (format " [%s]" + (if tablist-filter-suspended + "suspended" + "filtered"))))))) + (add-hook 'post-command-hook + 'tablist-selection-changed-handler nil t) + (add-hook 'tablist-selection-changed-functions + 'tablist-context-window-update nil t)) + (t + (setq mode-line-misc-info cleaned-misc) + (remove-hook 'post-command-hook + 'tablist-selection-changed-handler t) + (remove-hook 'tablist-selection-changed-functions + 'tablist-context-window-update t))))) + +(defun tablist-quit () + (interactive) + (tablist-hide-context-window) + (quit-window)) + +(defvar-local tablist-selected-id nil) +(defvar tablist-edit-column-minor-mode) + +(defun tablist-selection-changed-handler () + (unless tablist-edit-column-minor-mode + (let ((id tablist-selected-id) + (selected (tabulated-list-get-id))) + (unless (eq selected id) + (setq tablist-selected-id selected) + (run-hook-with-args + 'tablist-selection-changed-functions + tablist-selected-id))))) + +(defvar tablist-context-window-update--timer nil) + +(defun tablist-context-window-update (&optional id) + (when (and tablist-context-window-function + (window-live-p tablist-context-window) + (not tablist-edit-column-minor-mode)) + (unless id + (setq id (tabulated-list-get-id))) + (when (timerp tablist-context-window-update--timer) + (cancel-timer tablist-context-window-update--timer)) + (setq tablist-context-window-update--timer + (run-with-idle-timer 0.1 nil + (lambda (fn window) + (when (window-live-p window) + (with-selected-window window + (set-window-dedicated-p nil nil) + (save-selected-window + (funcall fn id)) + (when (window-live-p (selected-window)) + (set-window-dedicated-p nil t))))) + tablist-context-window-function + tablist-context-window)))) + +(defun tablist-display-context-window () + (interactive) + (unless tablist-context-window-function + (error "No function for handling a context is defined")) + (unless (window-live-p tablist-context-window) + (setq tablist-context-window + (display-buffer + (current-buffer) + tablist-context-window-display-action))) + (prog1 + tablist-context-window + (tablist-context-window-update))) + +(defun tablist-hide-context-window () + (interactive) + (when (window-live-p tablist-context-window) + (let ((ignore-window-parameters t)) + (delete-window tablist-context-window))) + (setq tablist-context-window nil)) + +(defun tablist-toggle-context-window () + (interactive) + (if (window-live-p tablist-context-window) + (tablist-hide-context-window) + (tablist-display-context-window))) + + +;; +;; *Marking +;; + +(defun tablist-revert () + "Revert the list with marks preserved, position kept." + (interactive) + (tablist-save-marks + (tablist-with-remembering-entry + (tabulated-list-revert)))) + +(defun tablist-major-columns () + (if (null tablist-major-columns) + (number-sequence 0 (1- (length tabulated-list-format))) + (if (numberp tablist-major-columns) + (list tablist-major-columns) + tablist-major-columns))) + +(defun tablist-put-mark (&optional pos) + "Put a mark before the entry at POS. + +POS defaults to point. Use `tablist-marker-char', +`tablist-marker-face', `tablist-marked-face' and +`tablist-major-columns' to determine how to mark and what to put +a face on." + (when (or (null tabulated-list-padding) + (< tabulated-list-padding 1)) + (setq tabulated-list-padding 1) + (tabulated-list-revert)) + (save-excursion + (and pos (goto-char pos)) + (unless (tabulated-list-get-id) + (error "No entry at this position")) + (let ((inhibit-read-only t)) + (tabulated-list-put-tag + (string tablist-marker-char)) + (put-text-property + (point-at-bol) + (1+ (point-at-bol)) + 'face tablist-marker-face) + (let ((columns (tablist-column-offsets))) + (dolist (c (tablist-major-columns)) + (when (and (>= c 0) + (< c (length columns))) + (let ((beg (+ (point-at-bol) + (nth c columns))) + (end (if (= c (1- (length columns))) + (point-at-eol) + (+ (point-at-bol) + (nth (1+ c) columns))))) + (cond + ((and tablist-marked-face + (not (eq tablist-marker-char ?\s))) + (tablist--save-face-property beg end) + (put-text-property + beg end 'face tablist-marked-face)) + (t (tablist--restore-face-property beg end)))))))))) + +(defun tablist-mark-forward (&optional arg interactive) + "Mark ARG entries forward. + +ARG is interpreted as a prefix-arg. If interactive is non-nil, +maybe use the active region instead of ARG. + +See `tablist-put-mark' for how entries are marked." + (interactive (list current-prefix-arg t)) + (cond + ;; Mark files in the active region. + ((and interactive (use-region-p)) + (save-excursion + (goto-char (region-beginning)) + (beginning-of-line) + (tablist-repeat-over-lines + (1+ (count-lines + (point) + (save-excursion + (goto-char (region-end)) + (beginning-of-line) + (point)))) + 'tablist-put-mark))) + ;; Mark the current (or next ARG) files. + (t + (tablist-repeat-over-lines + (prefix-numeric-value arg) + 'tablist-put-mark)))) + +(defun tablist-mark-backward (&optional arg interactive) + "Mark ARG entries backward. + +See `tablist-mark-forward'." + (interactive (list current-prefix-arg t)) + (tablist-mark-forward (- (prefix-numeric-value arg)) + interactive)) + +(defun tablist-unmark-forward (&optional arg interactive) + "Unmark ARG entries forward. + +See `tablist-mark-forward'." + (interactive (list current-prefix-arg t)) + (let ((tablist-marker-char ?\s) + tablist-marked-face) + (tablist-mark-forward arg interactive))) + +(defun tablist-unmark-backward (&optional arg interactive) + "Unmark ARG entries backward. + +See `tablist-mark-forward'." + (interactive (list current-prefix-arg t)) + (let ((tablist-marker-char ?\s) + tablist-marked-face) + (tablist-mark-backward arg interactive))) + +(defun tablist-flag-forward (&optional arg interactive) + "Flag ARG entries forward. + +See `tablist-mark-forward'." + (interactive (list current-prefix-arg t)) + (let ((tablist-marker-char ?D) + (tablist-marked-face 'dired-flagged)) + (tablist-mark-forward arg interactive))) + +(defun tablist-change-marks (old new) + "Change all OLD marks to NEW marks. + +OLD and NEW are both characters used to mark files." + (interactive + (let* ((cursor-in-echo-area t) + (old (progn (message "Change (old mark): ") (read-char))) + (new (progn (message "Change %c marks to (new mark): " old) + (read-char)))) + (list old new))) + (when (eq new ?\n) + (error "Mark character \\n is not allowed")) + (let ((default-mark-p (equal tablist-marker-char new)) + (tablist-marker-char old)) + (save-excursion + (tablist-map-over-marks + (lambda nil + (pcase new + (?D + (tablist-flag-forward 1)) + (t + (let ((tablist-marker-char new) + (tablist-marked-face + (and default-mark-p + tablist-marked-face))) + (tablist-put-mark))))))))) + +(defun tablist-unmark-all-marks (&optional marks interactive) + "Remove alls marks in MARKS. + +MARKS should be a string of mark characters to match and defaults +to all marks. Interactively, remove all marks, unless a prefix +arg was given, in which case ask about which ones to remove. +Give a message, if interactive is non-nil. + +Returns the number of unmarked marks." + (interactive + (list (if current-prefix-arg + (read-string "Remove marks: ")) t)) + (let ((re (if marks + (tablist-marker-regexp marks) + "^[^ ]")) + (removed 0)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward re nil t) + (let ((tablist-marker-char ?\s) + tablist-marker-face + tablist-marked-face) + (tablist-put-mark)) + (cl-incf removed))) + (when interactive + (message "Removed %d marks" removed)) + removed)) + +(defun tablist-toggle-marks () + "Unmark all marked and mark all unmarked entries. + +See `tablist-put-mark'." + (interactive) + (let ((marked-re (tablist-marker-regexp)) + (not-marked-re + (let ((tablist-marker-char ?\s)) + (tablist-marker-regexp)))) + (save-excursion + (goto-char (point-min)) + (tablist-skip-invisible-entries) + (while (not (eobp)) + (cond + ((looking-at marked-re) + (save-excursion (tablist-unmark-backward -1))) + ((looking-at not-marked-re) + (tablist-put-mark))) + (tablist-forward-entry))) + (tablist-move-to-major-column))) + +(defun tablist-get-marked-items (&optional arg distinguish-one-marked) + "Return marked or ARG entries." + (let ((items (save-excursion + (tablist-map-over-marks + (lambda () (cons (tabulated-list-get-id) + (tabulated-list-get-entry))) + arg nil distinguish-one-marked)))) + (if (and distinguish-one-marked + (eq (car items) t)) + items + (nreverse items)))) + +(defun tablist-mark-items-regexp (column-name regexp) + "Mark entries matching REGEXP in column COLUMN-NAME." + (interactive + (tablist-read-regexp-filter "Mark" current-prefix-arg )) + (tablist-map-with-filter + 'tablist-put-mark + `(=~ ,column-name ,regexp))) + +(defun tablist-mark-items-numeric (binop column-name operand) + "Mark items fulfilling BINOP with arg OPERAND in column COLUMN-NAME. + +First the column's value is coerced to a number N. Then the test +proceeds as \(BINOP N OPERAND\)." + (interactive + (tablist-read-numeric-filter "Mark" current-prefix-arg)) + (tablist-map-with-filter + 'tablist-put-mark + `(,binop ,column-name ,operand))) + +(defun tablist-map-over-marks (fn &optional arg show-progress + distinguish-one-marked) + (prog1 + (cond + ((and arg (integerp arg)) + (let (results) + (tablist-repeat-over-lines + arg + (lambda () + (if show-progress (sit-for 0)) + (push (funcall fn) results))) + (if (< arg 0) + (nreverse results) + results))) + (arg + ;; non-nil, non-integer ARG means use current item: + (tablist-skip-invisible-entries) + (unless (eobp) + (list (funcall fn)))) + (t + (cl-labels ((search (re) + (let (sucess) + (tablist-skip-invisible-entries) + (while (and (setq sucess + (re-search-forward re nil t)) + (invisible-p (point))) + (tablist-forward-entry)) + sucess))) + (let ((regexp (tablist-marker-regexp)) + next-position results found) + (save-excursion + (goto-char (point-min)) + ;; remember position of next marked file before BODY + ;; can insert lines before the just found file, + ;; confusing us by finding the same marked file again + ;; and again and... + (setq next-position (and (search regexp) + (point-marker)) + found (not (null next-position))) + (while next-position + (goto-char next-position) + (if show-progress (sit-for 0)) + (push (funcall fn) results) + ;; move after last match + (goto-char next-position) + (forward-line 1) + (set-marker next-position nil) + (setq next-position (and (search regexp) + (point-marker))))) + (if (and distinguish-one-marked (= (length results) 1)) + (setq results (cons t results))) + (if found + results + (unless (or (eobp) (invisible-p (point))) + (list (funcall fn)))))))) + (tablist-move-to-major-column))) + +(defun tablist-marker-regexp (&optional marks) + "Return a regexp matching marks in MARKS. + +MARKS should be a string of mark characters to match and defaults +to the current value of `tablist-marker-char' as a string." + (concat (format "^[%s]" + (or marks (string tablist-marker-char))))) + +(defun tablist-get-mark-state () + "Return the mark state of the entry at point." + (save-excursion + (beginning-of-line) + (when (looking-at "^\\([^ ]\\)") + (let ((mark (buffer-substring + (match-beginning 1) + (match-end 1)))) + (tablist-move-to-major-column) + (list (aref mark 0) + (get-text-property 0 'face mark) + (get-text-property (point) 'face)))))) + +(defun tablist-put-mark-state (state) + "Set the mark of the entry at point according to STATE. + +STATE is a return value of `tablist-get-mark-state'." + (cl-destructuring-bind (tablist-marker-char + tablist-marker-face + tablist-marked-face) + state + (tablist-put-mark))) + +(defun tablist-mark-prompt (arg items) + "Return a string suitable for use in a tablist prompt." + ;; distinguish-one-marked can cause the first element to be just t. + (if (eq (car items) t) (setq items (cdr items))) + (let ((count (length items))) + (if (= count 1) + (car items) + ;; more than 1 item: + (if (integerp arg) + ;; abs(arg) = count + ;; Perhaps this is nicer, but it also takes more screen space: + ;;(format "[%s %d items]" (if (> arg 0) "next" "previous") + ;; count) + (format "[next %d item%s]" + arg (dired-plural-s arg)) + (format "%c [%d item%s]" dired-marker-char count + (dired-plural-s count)))))) + +;; +;; *Movement +;; + +(defun tablist-forward-entry (&optional n) + "Move past the next N unfiltered entries." + (unless n (setq n 1)) + (while (and (> n 0) + (not (eobp))) + (forward-line) + (when (invisible-p (point)) + (tablist-skip-invisible-entries)) + (cl-decf n)) + (while (and (< n 0) + (not (bobp))) + (forward-line -1) + (when (invisible-p (point)) + (tablist-skip-invisible-entries t)) + (cl-incf n)) + n) + +(defun tablist-next-line (&optional n) + (interactive "p") + (when (and (< n 0) + (save-excursion + (end-of-line 0) + (tablist-skip-invisible-entries t) + (bobp))) + (signal 'beginning-of-buffer nil)) + (when (and (> n 0) + (save-excursion + (tablist-forward-entry) + (eobp))) + (signal 'end-of-buffer nil)) + + (let ((col (tablist-current-column))) + (tablist-forward-entry (or n 1)) + (if col + (tablist-move-to-column col) + (tablist-move-to-major-column)))) + +(defun tablist-previous-line (&optional n) + (interactive "p") + (tablist-next-line (- (or n 1)))) + +(defun tablist-repeat-over-lines (arg function) + "Call FUNCTION for the next ARG entries." + ;; Move out of potentially invisble area. + (tablist-skip-invisible-entries) + (let ((pos (make-marker))) + (while (and (> arg 0) + (not (eobp))) + (cl-decf arg) + (save-excursion + (tablist-forward-entry) + (move-marker pos (1+ (point)))) + (unless (eobp) + (save-excursion (funcall function))) + ;; Advance to the next line--actually, to the line that *was* next. + ;; (If FUNCTION inserted some new lines in between, skip them.) + (goto-char pos)) + (while (and (< arg 0) (not (bobp))) + (cl-incf arg) + (tablist-forward-entry -1) + (save-excursion (funcall function))) + (move-marker pos nil) + (tablist-move-to-major-column))) + +(defun tablist-move-to-column (n) + "Move to the N'th list column." + (interactive "p") + (when (tabulated-list-get-id) + (let ((columns (tablist-column-offsets))) + (when (or (< n 0) + (>= n (length columns))) + (error "No such column: %s" n)) + (beginning-of-line) + (forward-char (nth n columns)) + (when (and (plist-get (nthcdr 3 (elt tabulated-list-format n)) + :right-align) + (not (= n (1- (length columns))))) + (forward-char (1- (car (cdr (elt tabulated-list-format n))))))))) + + + +(defun tablist-move-to-major-column (&optional first-skip-invisible-p) + "Move to the first major column." + (interactive (list t)) + (when first-skip-invisible-p + (tablist-skip-invisible-entries)) + (tablist-move-to-column (car (tablist-major-columns)))) + +(defun tablist-forward-column (n) + "Move n columns forward, while wrapping around." + (interactive "p") + (unless (tabulated-list-get-id) + (error "No entry on this line")) + (let* ((columns (tablist-column-offsets)) + (current (1- (length columns)))) + ;; find current column + (while (and (>= current 0) + (> (nth current columns) + (current-column))) + (cl-decf current)) + ;; there may be an invisible spec here + (when (bolp) + (forward-char)) + ;; before any columns + (when (< current 0) + (goto-char (+ (point-at-bol) (if (> n 0) + (car columns) + (car (last columns))))) + (setq n (* (cl-signum n) (1- (abs n))))) + (when (/= n 0) + (tablist-move-to-column + (mod (+ current n) (length columns)))))) + +(defun tablist-backward-column (n) + "Move n columns backward, while wrapping around." + (interactive "p") + (tablist-forward-column (- n))) + +;; +(defun tablist-skip-invisible-entries (&optional backward) + "Skip invisible entries BACKWARD or forward. + +Do nothing, if the entry at point is visible. Otherwise move to +the beginning of the next visible entry in the direction +determined by BACKWARD. + +Return t, if point is now in a visible area." + + (cond + ((and backward + (not (bobp)) + (get-text-property (point) 'invisible)) + (when (get-text-property (1- (point)) 'invisible) + (goto-char (previous-single-property-change + (point) + 'invisible nil (point-min)))) + (forward-line -1)) + ((and (not backward) + (not (eobp)) + (get-text-property (point) 'invisible)) + (goto-char (next-single-property-change + (point) + 'invisible nil (point-max))))) + (not (invisible-p (point)))) + +;; +;; *Operations +;; + +(defun tablist-yes-or-no-p (operation arg items) + "Query the user whether to proceed with some operation. + +Operation should be a symbol or string describing the operation, +ARG the prefix-arg of the command used in +`tablist-get-marked-items' or elsewhere, to get the ITEMS." + + (let ((pp-items (mapcar 'tablist-pretty-print-entry + (mapcar 'cdr items))) + dired-no-confirm + (op-str (upcase-initials + (if (stringp operation) + operation + (symbol-name operation))))) + (dired-mark-pop-up + (format " *%s*" op-str) nil + pp-items + dired-deletion-confirmer + (format "%s %s " + op-str + (tablist-mark-prompt arg pp-items))))) + + +(defun tablist-operation-available-p (op) + (and (functionp tablist-operations-function) + (memq op (funcall tablist-operations-function + 'supported-operations)))) + +(defun tablist-do-delete (&optional arg) + "Delete ARG entries." + (interactive "P") + (unless (tablist-operation-available-p 'delete) + (error "Deleting entries is not available in this buffer")) + (let ((items (tablist-get-marked-items arg))) + (when (tablist-yes-or-no-p 'delete arg items) + (tablist-do-kill-lines arg) + (funcall tablist-operations-function + 'delete (mapcar 'car items)) + (tablist-move-to-major-column)))) + +(defun tablist-do-flagged-delete (&optional interactive) + "Delete all entries marked with a D." + (interactive "p") + (let* ((tablist-marker-char ?D)) + (if (save-excursion + (goto-char (point-min)) + (re-search-forward (tablist-marker-regexp) nil t)) + (tablist-do-delete) + (or (not interactive) + (message "(No deletions requested)"))))) + +(defun tablist-do-kill-lines (&optional arg interactive) + "Remove ARG lines from the display." + (interactive (list current-prefix-arg t)) + (save-excursion + (let ((positions + (tablist-map-over-marks 'point arg)) + (inhibit-read-only t)) + (dolist (pos positions) + (goto-char pos) + (tabulated-list-delete-entry)) + (when interactive + (message (format "Killed %d line%s" + (length positions) + (dired-plural-s (length positions)))))))) + +(defun tablist-do-operation (arg fn operation &optional delete-p revert-p) + "Operate on marked items. + +ARG should be the `current-prefix-arg', FN is a function of two +arguments \(ID ENTRY\) handling the operation. It gets called +repeatly with all marked items. OPERATION is a symbol or string +describing the operation, it is used for display. + +Optional non-nil DELETE-P means, remove the items from the display. +Optional REVERT-P means, revert the display afterwards." + (let ((items (tablist-get-marked-items arg))) + (unless items + (error "No items marked")) + (when (tablist-yes-or-no-p operation arg items) + (when delete-p + (tablist-do-kill-lines arg)) + (dolist (item items) + (funcall fn (car item))) + (when revert-p + (tablist-revert)) + (tablist-move-to-major-column)))) + +;; +;; *Editing +;; +(defvar tablist-edit-column-minor-mode-map + (let ((kmap (make-sparse-keymap))) + (set-keymap-parent kmap (current-global-map)) + (define-key kmap [remap self-insert-command] 'self-insert-command) + (define-key kmap "\r" 'tablist-edit-column-commit) + (define-key kmap (kbd "C-g") 'tablist-edit-column-quit) + (define-key kmap (kbd "C-c C-c") 'tablist-edit-column-commit) + (define-key kmap (kbd "C-c C-q") 'tablist-edit-column-quit) + (define-key kmap "\t" 'tablist-edit-column-complete) + (define-key kmap (kbd "TAB") 'tablist-edit-column-complete) + (define-key kmap [remap end-of-buffer] 'end-of-line) + (define-key kmap [remap beginning-of-buffer] 'beginning-of-line) + (define-key kmap [remap mark-whole-buffer] 'tablist-edit-column-mark-field) + kmap)) + +(define-minor-mode tablist-edit-column-minor-mode + "" nil nil nil + (unless (or tablist-minor-mode + (derived-mode-p 'tablist-mode)) + (error "Not in a tablist buffer")) + (cond + (tablist-edit-column-minor-mode + (add-to-list 'mode-line-misc-info + '(tablist-edit-column-minor-mode "[edit]")) + (add-hook 'post-command-hook 'tablist-edit-column-constrain-point nil t) + (read-only-mode -1)) + (t + (remove-hook 'post-command-hook 'tablist-edit-column-constrain-point t) + (read-only-mode 1)))) + + +(defun tablist-edit-column (&optional n) + (interactive "P") + (unless n (setq n (tablist-current-column))) + (tablist-assert-column-editable n) + (let* ((offsets (append (tablist-column-offsets) + (list (- (point-at-eol) + (point-at-bol))))) + (beg (+ (point-at-bol) + (nth n offsets))) + (end (+ (point-at-bol) + (nth (1+ n) offsets))) + (entry (tabulated-list-get-entry beg)) + (inhibit-read-only t) + (inhibit-field-text-motion t) + (alist `((entry . ,entry) + (column . ,n) + (id . ,(tabulated-list-get-id beg)))) + ov) + (goto-char beg) + (delete-region beg end) + (add-text-properties + (point-at-bol) (point-at-eol) + '(read-only t field t)) + (unless (= beg (point-at-bol)) + (put-text-property (1- beg) beg 'rear-nonsticky t)) + (save-excursion + ;; Keep one read-only space at the end for keeping text + ;; properties. + (insert + (propertize + (concat + (tablist-nth-entry n entry) + (propertize " " + 'display `(space :align-to ,(- end (point-at-bol))))) + 'field nil + 'front-sticky '(tablist-edit) + 'rear-nonsticky '(read-only field) + 'tablist-edit alist)) + (setq end (point))) + (add-text-properties + (1- end) end '(read-only t field 'tablist-edit-end)) + (setq ov (make-overlay beg end)) + (overlay-put ov 'priority 9999) + (overlay-put ov 'face '(:background "deep sky blue" :foreground "white")) + (overlay-put ov 'evaporate t) + (overlay-put ov 'tablist-edit t) + (tablist-edit-column-minor-mode 1))) + +(defun tablist-edit-column-quit () + (interactive) + (tablist-edit-column-commit t)) + +(defun tablist-edit-column-commit (&optional abandon-edit) + (interactive (list current-prefix-arg)) + (let ((inhibit-read-only t) + (inhibit-field-text-motion t) + bounds) + (condition-case nil + (setq bounds (tablist-edit-column-bounds)) + (error + (tablist-edit-column-minor-mode -1) + (tabulated-list-revert) + (put-text-property (point-min) (point-max) + 'tablist-edit nil) + (error "Unable to complete the edit"))) + (let* ((beg (car bounds)) + (end (cdr bounds)) + (alist (get-text-property beg 'tablist-edit)) + (column (cdr (assq 'column alist))) + (id (cdr (assq 'id alist))) + (entry (cdr (assq 'entry alist))) + (item (buffer-substring-no-properties beg (1- end)))) + + (unless abandon-edit + ;; Throws an error, if item is invalid. + (setq entry (funcall tablist-operations-function + 'edit-column id column item))) + (tablist-edit-column-minor-mode -1) + (remove-overlays beg end 'tablist-edit t) + (put-text-property beg end 'tablist-edit nil) + (delete-region (point-at-bol) (1+ (point-at-eol))) + (save-excursion + (tabulated-list-print-entry id entry)) + (forward-char (nth column (tablist-column-offsets)))))) + +(defun tablist-edit-column-complete () + (interactive) + (unless (tablist-operation-available-p 'complete) + (error "Completion not available")) + (cl-destructuring-bind (beg &rest end) + (tablist-edit-column-bounds t) + (let* ((string (buffer-substring-no-properties + beg end)) + (alist (get-text-property beg 'tablist-edit)) + (completions (funcall tablist-operations-function + 'complete + (cdr (assq 'id alist)) + (cdr (assq 'column alist)) + string + (- (point) beg)))) + (unless completions + (error "No completions available")) + (completion-in-region beg end completions)))) + +(defun tablist-column-editable (n) + (and (tablist-operation-available-p 'edit-column) + (not (tablist-column-property n :read-only)))) + +(defun tablist-assert-column-editable (n) + (unless (and (>= n 0) + (< n (length tabulated-list-format))) + (error "Invalid column number: %s" n)) + (unless (tablist-operation-available-p 'edit-column) + (error "Editing columns not enabled in this buffer")) + (when (tablist-column-property n :read-only) + (error "This column is read-only"))) + +(defun tablist-edit-column-constrain-point () + (unless tablist-edit-column-minor-mode + (error "Not editing a column")) + (unless (get-text-property (point) 'tablist-edit) + (let ((bounds (tablist-edit-column-bounds))) + (when bounds + (if (> (point) (cdr bounds)) + (goto-char (1- (cdr bounds))) + (goto-char (car bounds))) + (point))))) + +(defun tablist-edit-column-bounds (&optional skip-final-space) + (unless tablist-edit-column-minor-mode + (error "Not editing a column")) + (let ((pos (next-single-property-change + (point) 'tablist-edit)) + beg end) + (cond + ((null pos) + (setq end (previous-single-property-change + (point-max) 'tablist-edit) + beg (previous-single-property-change + end 'tablist-edit))) + ((get-text-property pos 'tablist-edit) + (setq beg pos + end (next-single-property-change + pos 'tablist-edit))) + (pos + (setq end pos + beg (previous-single-property-change + pos 'tablist-edit)))) + + (unless (and beg end (get-text-property beg 'tablist-edit)) + (error "Unable to locate edited text")) + (cons beg (if skip-final-space (1- end) end)))) + +(defun tablist-edit-column-mark-field () + (interactive) + (push-mark (field-beginning)) + (push-mark (field-end) nil t) + (goto-char (field-beginning))) + +(defun tablist-find-entry (&optional id) + (interactive) + (unless (tablist-operation-available-p 'find-entry) + (error "Finding entries not supported in this buffer")) + (funcall tablist-operations-function + 'find-entry + (or id (tabulated-list-get-id)))) + +;; +;; *Utility +;; + +(defun tablist-column-property (n prop) + (plist-get + (nthcdr 3 (aref tabulated-list-format n)) + prop)) + +(defun tablist-current-column () + "Return the column number at point. + +Returns nil, if point is before the first column." + (let ((column + (1- (cl-position + (current-column) + (append (tablist-column-offsets) + (list most-positive-fixnum)) + :test (lambda (column offset) (> offset column)))))) + (when (>= column 0) + column))) + +(defun tablist-column-offsets () + "Return a list of column positions. + +This is a list of offsets from the beginning of the line." + (let ((cc tabulated-list-padding) + columns) + (dotimes (i (length tabulated-list-format)) + (let* ((c (aref tabulated-list-format i)) + (len (nth 1 c)) + (pad (or (plist-get (nthcdr 3 c) :pad-right) + 1))) + (push cc columns) + (when (numberp len) + (cl-incf cc len)) + (when pad + (cl-incf cc pad)))) + (nreverse columns))) + +(defun tablist-pretty-print-entry (item) + (mapconcat (lambda (i) + (tablist-nth-entry i item)) + (tablist-major-columns) " ")) + +(defun tablist--save-face-property (beg end) + ;; We need to distinguish ,,not set'' from ''no face''. + (unless (and (text-property-not-all beg end 'face nil) + (< beg end)) + (put-text-property beg (1+ beg) 'face 'default)) + (unless (text-property-not-all beg end 'tablist-saved-face nil) + (tablist-copy-text-property beg end 'face 'tablist-saved-face))) + +(defun tablist--restore-face-property (beg end) + (when (text-property-not-all beg end 'tablist-saved-face nil) + (tablist-copy-text-property beg end 'tablist-saved-face 'face))) + +(defun tablist-copy-text-property (beg end from to) + "Copy text property FROM to TO in region BEG to END." + (let ((inhibit-read-only t)) + (save-excursion + (while (< beg end) + (goto-char beg) + (put-text-property + (point) + (setq beg (next-single-property-change + (point) from nil end)) + to + (get-text-property (point) from)))))) + +;; +(defun tablist-read-column-name (arg &optional prompt default) + "Read the name of a column using ARG. + +If ARG is a number, return column ARG. +If ARG is nil, return DEFAULT or the current column. +Else ask the user, using PROMPT and DEFAULT." + (cond + ((numberp arg) + (or (tablist-column-name + (prefix-numeric-value arg)) + (error "No such column: %d" (prefix-numeric-value arg)))) + ((null arg) + (or default + (tablist-column-name + (or (tablist-current-column) + (car (tablist-major-columns)) + 0)))) + (t + (let* ((default (or default + (tablist-column-name + (car (tablist-major-columns))))) + (result + (completing-read + (format "%s %s: " + (or prompt "Use column") + (if default + (format "(default %s)" + default) + "")) + (tablist-column-names) + nil t nil 'tablist-column-name-history))) + (if (> (length result) 0) + result + (if (not default) + (error "No column selected") + default)))))) + +(defun tablist-column-name (n) + "Return the name of column N." + (when (and n + (>= n 0) + (< n (length tabulated-list-format))) + (substring-no-properties + (car (elt tabulated-list-format n)) 0))) + +(defun tablist-column-names () + "Return a list of all column-names." + (mapcar 'tablist-column-name + (number-sequence 0 (1- (length tabulated-list-format))))) + +(defun tablist-nth-entry (n &optional entry) + (unless entry (setq entry (tabulated-list-get-entry))) + (when (and entry + (>= n 0) + (< n (length entry))) + (let ((str (elt entry n))) + (if (stringp str) + str + (car str))))) + +(defun tablist-major-column-name () + "Return a list of the major column names." + (tablist-column-name (car (tablist-major-columns)))) + +(defun tablist-export-csv (&optional separator always-quote-p + invisible-p out-buffer display-p) + "Export a tabulated list to a CSV format. + +Use SEPARATOR (or ;) and quote if necessary (or always if +ALWAYS-QUOTE-P is non-nil). Only consider non-filtered entries, +unless invisible-p is non-nil. Create a buffer for the output or +insert it after point in OUT-BUFFER. Finally if DISPLAY-P is +non-nil, display this buffer. + +Return the output buffer." + + (interactive (list nil t nil nil t)) + (unless (derived-mode-p 'tabulated-list-mode) + (error "Not in Tabulated List Mode")) + (unless (stringp separator) + (setq separator (string (or separator ?\;)))) + (let* ((outb (or out-buffer + (get-buffer-create + (format "%s.csv" (buffer-name))))) + (escape-re (format "[%s\"\n]" separator)) + (header (tablist-column-names))) + (unless (buffer-live-p outb) + (error "Expected a live buffer: %s" outb)) + (cl-labels + ((printit (entry) + (insert + (mapconcat + (lambda (e) + (unless (stringp e) + (setq e (car e))) + (if (or always-quote-p + (string-match escape-re e)) + (concat "\"" + (replace-regexp-in-string "\"" "\"\"" e t t) + "\"") + e)) + entry separator)) + (insert ?\n))) + (with-current-buffer outb + (let ((inhibit-read-only t)) + (erase-buffer) + (printit header))) + (save-excursion + (goto-char (point-min)) + (unless invisible-p + (tablist-skip-invisible-entries)) + (while (not (eobp)) + (let* ((entry (tabulated-list-get-entry))) + (with-current-buffer outb + (let ((inhibit-read-only t)) + (printit entry))) + (if invisible-p + (forward-line) + (tablist-forward-entry))))) + (if display-p + (display-buffer outb)) + outb))) + +;; + +(defun tablist-enlarge-column (&optional column width) + "Enlarge column COLUMN by WIDTH. + +This function is lazy and therfore pretty slow." + (interactive + (list nil (* (prefix-numeric-value current-prefix-arg) + 3))) + (unless column (setq column (tablist-current-column))) + (unless column + (error "No column given and no entry at point")) + (unless width (setq width 1)) + (when (or (not (numberp column)) + (< column 0) + (>= column (length tabulated-list-format))) + (error "No such column: %d" column)) + (when (= column (1- (length tabulated-list-format))) + (error "Can't resize last column")) + + (let* ((cur-width (cadr (elt tabulated-list-format column)))) + (setcar (cdr (elt tabulated-list-format column)) + (max 3 (+ cur-width width))) + (tablist-with-remembering-entry + (tablist-save-marks + (tabulated-list-init-header) + (tabulated-list-print))))) + + +(defun tablist-shrink-column (&optional column width) + (interactive + (list nil (* (prefix-numeric-value current-prefix-arg) + 3))) + (tablist-enlarge-column column (- (or width 1)))) + + +;; *Sorting +;; + +(defun tablist-sort (&optional column) + "Sort the tabulated-list by COLUMN. + +COLUMN may be either a name or an index. The default compare +function is given by the `tabulated-list-format', which see. + +This function saves the current sort column and the inverse +sort-direction in the variable `tabulated-list-sort-key', which +also determines the default COLUMN and direction. + +The main difference to `tabulated-list-sort' is, that this +function sorts the buffer in-place and it ignores a nil sort +entry in `tabulated-list-format' and sorts on the column +anyway (why not ?)." + + (interactive + (list + (if (null current-prefix-arg) + (tablist-column-name + (or (tablist-current-column) + (car (tablist-major-columns)) + 0)) + (tablist-read-column-name + '(4) "Sort by column" + (tablist-column-name (car (tablist-major-columns))))))) + + (unless column + (setq column (or (car tabulated-list-sort-key) + (tablist-column-name (car (tablist-major-columns))) + (tablist-column-name 0)))) + (when (numberp column) + (let ((column-name (tablist-column-name column))) + (unless column-name + (error "No such column: %d" column)) + (setq column column-name))) + + (setq tabulated-list-sort-key + (cons column + (if (equal column (car tabulated-list-sort-key)) + (cdr tabulated-list-sort-key)))) + + (let* ((entries (if (functionp tabulated-list-entries) + (funcall tabulated-list-entries) + tabulated-list-entries)) + (reverse (cdr tabulated-list-sort-key)) + (n (tabulated-list--column-number ;;errors if column is n/a + (car tabulated-list-sort-key))) + (compare-fn (nth 2 (aref tabulated-list-format n)))) + + (when (or (null compare-fn) + (eq compare-fn t)) + (setq compare-fn + (lambda (a b) + (setq a (aref (cadr a) n)) + (setq b (aref (cadr b) n)) + (string< (if (stringp a) a (car a)) + (if (stringp b) b (car b)))))) + + (unless compare-fn + (error "This column cannot be sorted: %s" column)) + + (setcdr tabulated-list-sort-key (not reverse)) + ;; Presort the entries and hash the result and sort the buffer. + (setq entries (sort (copy-sequence entries) compare-fn)) + (let ((hash (make-hash-table :test 'equal))) + (dotimes (i (length entries)) + (puthash (caar entries) i hash) + (setq entries (cdr entries))) + (tablist-with-remembering-entry + (goto-char (point-min)) + (tablist-skip-invisible-entries) + (let ((inhibit-read-only t)) + (sort-subr + nil 'tablist-forward-entry 'end-of-line + (lambda () + (gethash (tabulated-list-get-id) hash 0)) + nil (if reverse '< '>)))) + (tablist-move-to-column n) + ;; Make the sort arrows display. + (tabulated-list-init-header)))) + +;; +;; *Filter +;; + +(defun tablist-read-filter-name (prompt) + (let ((filter (cdr (assq major-mode tablist-named-filter)))) + (unless filter + (error "No filter defined for %s mode" mode-name)) + (let ((name (completing-read + (format "%s: " prompt) + filter + nil t))) + (unless (> (length name) 0) + (error "No filter selected")) + name))) + +(defun tablist-apply-filter (&optional filter) + "Apply FILTER to the current tabulated list. + +FILTER defaults to `tablist-current-filter'." + (unless filter (setq filter tablist-current-filter)) + (tablist-filter-unhide-buffer) + (when (and filter + (null tablist-filter-suspended)) + (tablist-with-remembering-entry + (tablist-map-with-filter + (lambda nil + (if tablist-umark-filtered-entries + (save-excursion (tablist-unmark-forward))) + (tablist-filter-hide-entry)) + (tablist-filter-negate filter)))) + (force-mode-line-update)) + +(defadvice tabulated-list-print (after tabulated-list activate) + "Reapply the filter." + (when (or tablist-minor-mode + (derived-mode-p 'tablist-mode)) + (tablist-apply-filter))) + +(defun tablist-eval-filter (filter) + (tablist-filter-eval + filter + (tabulated-list-get-id) + (tabulated-list-get-entry) + (cdr (assq major-mode tablist-named-filter)))) + +(defun tablist-map-with-filter (fn filter &optional show-progress + distinguish-one-marked) + "Call FN for every unfiltered entry matching FILTER." + (prog1 + (cl-labels ((search () + (tablist-skip-invisible-entries) + (while (and (not (eobp)) + (not (tablist-eval-filter filter))) + (tablist-forward-entry)) + (unless (eobp) + (point-marker)))) + (let (next-position results) + (save-excursion + (goto-char (point-min)) + (setq next-position (search)) + (while next-position + (goto-char next-position) + (if show-progress (sit-for 0)) + (push (funcall fn) results) + ;; move after last match + (goto-char next-position) + (forward-line 1) + (set-marker next-position nil) + (setq next-position (search))) + (if (and distinguish-one-marked (= (length results) 1)) + (setq results (cons t results)))))))) + +;; +;; **Filter Commands +;; +(defun tablist-push-filter (filter &optional interactive or-p) + (setq tablist-current-filter + (tablist-filter-push + tablist-current-filter + filter or-p)) + (tablist-apply-filter) + (when interactive + (tablist-display-filter-temporarily))) + +(defun tablist-pop-filter (&optional n interactive) + "Remove the first N filter components." + (interactive (list (prefix-numeric-value current-prefix-arg) t)) + (while (and tablist-current-filter + (> n 0)) + (setq tablist-current-filter + (tablist-filter-pop + tablist-current-filter)) + (cl-decf n)) + (tablist-apply-filter) + (when interactive + (when (> n 0) + (message "The filter is empty.")) + (tablist-display-filter-temporarily)) + n) + +(defun tablist-negate-filter (&optional interactive) + "Negate the current filter." + (interactive (list t)) + (setq tablist-current-filter + (tablist-filter-negate + tablist-current-filter)) + (tablist-apply-filter) + (when interactive + (tablist-display-filter-temporarily))) + +(defun tablist-toggle-first-filter-logic () + "Toggle between and/or for the first filter operand." + (interactive) + (setq tablist-current-filter + (pcase tablist-current-filter + (`(or ,x1 ,x2) + `(and ,x1 ,x2)) + (`(and ,x1 ,x2) + `(or ,x1 ,x2)) + (`(not ,x) x) + (x `(not ,x)))) + (tablist-apply-filter) + (tablist-display-filter-temporarily)) + +(defun tablist-suspend-filter (&optional flag) + "Temporarily disable filtering according to FLAG. + +Interactively, this command toggles filtering." + (interactive + (list (not tablist-filter-suspended))) + (let ((state tablist-filter-suspended)) + (unless (eq (not (not state)) + (not (not flag))) + (set (make-local-variable 'tablist-filter-suspended) flag) + (tablist-apply-filter)))) + +(defun tablist-read-regexp-filter (operation arg) + (let ((column-name (tablist-read-column-name arg))) + (list + column-name + (let ((re + (read-regexp (format "%s where %s matches: " operation column-name)))) + (unless (> (length re) 0) + (error "No regexp given")) + re)))) + +(defun tablist-read-equal-filter (operation arg) + (let ((column-name (tablist-read-column-name arg))) + (list + column-name + (read-string (format "%s where %s equals: " operation column-name))))) + +(defun tablist-read-numeric-filter (operation arg) + (let* ((entry (tabulated-list-get-entry 1)) + (default (cl-some + (lambda (idx) + (let ((value (tablist-nth-entry idx entry))) + (when (or (not (eq 0 (string-to-number value))) + (equal "0" value)) + (tablist-column-name idx)))) + (number-sequence 0 (length entry)))) + (column-name (tablist-read-column-name arg nil default)) + (op (completing-read + (format "%s %s matching binary op: " operation column-name) + '("=" "<" ">" "<=" ">=") nil t)) + oper) + + (when (equal "" op) + (error "No operation selected")) + (setq op (intern op)) + (setq oper (number-to-string + (read-number + (format "%s where %s %s " operation column-name op)))) + + (list op column-name oper))) + +(defun tablist-push-regexp-filter (column-name regexp) + "Add a new filter matching REGEXP in COLUMN-NAME. + +The filter is and'ed with the current filter. Use +`tablist-toggle-first-filter-logic' to change this." + (interactive + (tablist-with-filter-displayed + (tablist-read-regexp-filter "Filter" current-prefix-arg))) + (tablist-push-filter + `(=~ ,column-name ,regexp) + (called-interactively-p 'any))) + +(defun tablist-push-equal-filter (column-name string) + "Add a new filter whre string equals COLUMN-NAME's value. + +The filter is and'ed with the current filter. Use +`tablist-toggle-first-filter-logic' to change this." + (interactive + (tablist-with-filter-displayed + (tablist-read-equal-filter "Filter" current-prefix-arg))) + (tablist-push-filter + `(== ,column-name ,string) + (called-interactively-p 'any))) + +(defun tablist-push-numeric-filter (op column-name 2nd-arg) + "Add a new filter matching a numeric predicate. + +The filter is and'ed with the current filter. Use +`tablist-toggle-first-filter-logic' to change this." + (interactive + (tablist-with-filter-displayed + (tablist-read-numeric-filter "Filter" current-prefix-arg))) + (tablist-push-filter + `(,op ,column-name ,2nd-arg) + (called-interactively-p 'any))) + +(defun tablist-push-named-filter (name) + "Add a named filter called NAME. + +Named filter are saved in the variable `tablist-named-filter'." + (interactive + (tablist-with-filter-displayed + (list + (tablist-read-filter-name "Add filter")))) + (when (and name (symbolp name)) + (setq name (symbol-name name))) + (tablist-push-filter name (called-interactively-p 'any))) + +(defun tablist-delete-named-filter (name &optional mode) + (interactive + (tablist-with-filter-displayed + (list + (tablist-read-filter-name "Delete filter")))) + (setq tablist-current-filter + (tablist-filter-map + (lambda (f) + (when (equal f name) + (setq f (tablist-get-named-filter f))) + f) + tablist-current-filter)) + (unless mode (setq mode major-mode)) + (let ((mode-filter + (assq mode tablist-named-filter))) + (when mode-filter + (setcdr mode-filter + (cl-remove name (cdr mode-filter) + :test 'equal :key 'car))))) + +(defun tablist-name-current-filter (name) + (interactive + (list (tablist-with-filter-displayed + (read-string + "Add name for current filter: ")))) + (unless tablist-current-filter + (error "Filter is empty")) + (unless (> (length name) 0) + (error "No name given")) + (tablist-put-named-filter + name (if (stringp tablist-current-filter) + (tablist-get-named-filter + tablist-current-filter) + tablist-current-filter)) + (setq tablist-current-filter name) + (force-mode-line-update)) + +(defun tablist-deconstruct-named-filter () + (interactive) + (let (found) + (setq tablist-current-filter + (tablist-filter-map + (lambda (f) + (when (and (not found) + (stringp f)) + (setq found t) + (let ((df (tablist-get-named-filter f))) + (unless df + (error "Filter is not defined: %s" f)) + (setq f df))) + f) + tablist-current-filter)) + (unless found + (error "No named filter found")) + (force-mode-line-update))) + + +(defun tablist-filter-names (&optional mode) + (mapcar 'car (cdr (assq (or mode major-mode) + tablist-named-filter)))) + +(defun tablist-get-named-filter (name &optional mode) + (cdr (assoc name + (cdr (assq (or mode major-mode) + tablist-named-filter))))) + +(defun tablist-put-named-filter (name filter &optional mode) + (unless mode (setq mode major-mode)) + (let ((mode-filter + (assq mode tablist-named-filter))) + (unless mode-filter + (setq mode-filter (cons mode nil)) + (push mode-filter tablist-named-filter)) + (let ((entry (assoc name mode-filter))) + (if entry + (setcdr entry filter) + (setcdr mode-filter + (list (cons name filter))))))) + +(defun tablist-validate-named-filter (filter) + (tablist-filter-map + (lambda (f) + (when (and (stringp f) + (null (tablist-get-named-filter f))) + (error "Undefined named filter: %s (defined: %s)" f + (mapconcat 'identity (tablist-filter-names) ",")))) + filter)) + +(defun tablist-edit-filter () + (interactive) + (setq tablist-current-filter + (tablist-with-filter-displayed + (tablist-filter-edit-filter + "Edit filter: " + tablist-current-filter + nil + 'tablist-validate-named-filter))) + (tablist-apply-filter)) + +(defun tablist-clear-filter () + (interactive) + (setq tablist-current-filter nil) + (tablist-apply-filter)) + +;; **Displaying filter +;; + +(defconst tablist-display-filter-mode-line-tag nil) + +(defun tablist-display-filter (&optional flag) + "Display the current filter according to FLAG. + +If FLAG has the value 'toggle, toggle it's visibility. +If FLAG has the 'state, then do nothing but return the current +visibility." + (interactive (list 'toggle)) + (let* ((tag 'tablist-display-filter-mode-line-tag) + (displayed-p (not (not (assq tag mode-line-format))))) + (if (eq flag 'state) + displayed-p + (let ((display-p (not (not (if (eq flag 'toggle) + (not displayed-p) + flag))))) + (unless (eq displayed-p display-p) + (setq mode-line-format + (if display-p + (list (cons tag mode-line-format) + '(:eval + (replace-regexp-in-string + "%" "%%" + (concat + (propertize "Filter: " 'face 'minibuffer-prompt) + (and tablist-filter-suspended + "[suspended] ") + (if tablist-current-filter + (tablist-filter-unparse + tablist-current-filter t) + "[none]"))))) + (cdr (assq tag mode-line-format))))) + (force-mode-line-update) + display-p)))) + +(defun tablist-display-filter-temporarily () + (tablist-with-filter-displayed + (sit-for 9999))) + +;; +;; **Hiding/Unhiding Entries +;; +(defun tablist-filter-set-entry-hidden (flag &optional pos) + (save-excursion + (when pos (goto-char pos)) + (beginning-of-line) + (let ((inhibit-read-only t)) + (add-text-properties + (point-at-bol) + (1+ (point-at-eol)) + `(invisible ,flag))))) + +(defun tablist-filter-hide-entry (&optional pos) + (interactive) + (tablist-filter-set-entry-hidden t pos)) + +(defun tablist-filter-unhide-entry (&optional pos) + (tablist-filter-set-entry-hidden nil pos)) + +(defun tablist-filter-unhide-buffer () + (let ((inhibit-read-only t)) + (remove-text-properties + (point-min) (point-max) + '(invisible)))) + + +(defun tablist-window-attach (awindow &optional window) + "Attach AWINDOW to WINDOW. + +This has the following effect. Whenever WINDOW, defaulting to +the selected window, stops displaying the buffer it currently +displays (e.g., by switching buffers or because it was deleted) +AWINDOW is deleted." + (unless window (setq window (selected-window))) + (let ((buffer (window-buffer window)) + (hook (make-symbol "window-attach-hook"))) + (fset hook + (lambda () + (when (or (not (window-live-p window)) + (not (eq buffer (window-buffer window)))) + (remove-hook 'window-configuration-change-hook + hook) + ;; Deleting windows inside wcch may cause errors in + ;; windows.el . + (run-with-timer + 0 nil (lambda (win) + (when (and (window-live-p win) + (not (eq win (selected-window)))) + (delete-window win))) + awindow)))) + (add-hook 'window-configuration-change-hook hook))) + +(defun tablist-display-buffer-split-below-and-attach (buf alist) + "Display buffer action using `tablist-window-attach'." + (let ((window (selected-window)) + (height (cdr (assq 'window-height alist))) + newwin) + (when height + (when (floatp height) + (setq height (round (* height (frame-height))))) + (setq height (- (max height window-min-height)))) + (setq newwin (window--display-buffer + buf + (split-window-below height) + 'window alist display-buffer-mark-dedicated)) + (tablist-window-attach newwin window) + newwin)) + +(defun tablist-generate-sorter (column compare-fn &optional read-fn) + "Generate a sort function for `tabulated-list' entries. + +Example: + + \(tablist-generate-sorter 0 '< 'string-to-number\) + +would create a sort function sorting `tabulated-list-entries' on +the 0-th column as numbers by the less-than relation." + + (lambda (e1 e2) + (funcall compare-fn + (funcall (or read-fn 'identity) + (aref (cadr e1) column)) + (funcall read-fn + (aref (cadr e2) column))))) + +(provide 'tablist) +;;; tablist.el ends here |