diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,676 @@ + GNU GENERAL PUBLIC LICENSE + Version 3, 29 June 2007 + + Copyright (C) 2007 Free Software Foundation, Inc. + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The GNU General Public License is a free, copyleft license for +software and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program--to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers' and authors' protection, the GPL clearly explains +that there is no warranty for this free software. For both users' and +authors' sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users' freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + + TERMS AND CONDITIONS + + 0. Definitions. + + "This License" refers to version 3 of the GNU General Public License. + + "Copyright" also means copyright-like laws that apply to other kinds of +works, such as semiconductor masks. + + "The Program" refers to any copyrightable work licensed under this +License. Each licensee is addressed as "you". "Licensees" and +"recipients" may be individuals or organizations. + + To "modify" a work means to copy from or adapt all or part of the work +in a fashion requiring copyright permission, other than the making of an +exact copy. The resulting work is called a "modified version" of the +earlier work or a work "based on" the earlier work. + + A "covered work" means either the unmodified Program or a work based +on the Program. + + To "propagate" a work means to do anything with it that, without +permission, would make you directly or secondarily liable for +infringement under applicable copyright law, except executing it on a +computer or modifying a private copy. Propagation includes copying, +distribution (with or without modification), making available to the +public, and in some countries other activities as well. + + To "convey" a work means any kind of propagation that enables other +parties to make or receive copies. Mere interaction with a user through +a computer network, with no transfer of a copy, is not conveying. + + An interactive user interface displays "Appropriate Legal Notices" +to the extent that it includes a convenient and prominently visible +feature that (1) displays an appropriate copyright notice, and (2) +tells the user that there is no warranty for the work (except to the +extent that warranties are provided), that licensees may convey the +work under this License, and how to view a copy of this License. If +the interface presents a list of user commands or options, such as a +menu, a prominent item in the list meets this criterion. + + 1. Source Code. + + The "source code" for a work means the preferred form of the work +for making modifications to it. "Object code" means any non-source +form of a work. + + A "Standard Interface" means an interface that either is an official +standard defined by a recognized standards body, or, in the case of +interfaces specified for a particular programming language, one that +is widely used among developers working in that language. + + The "System Libraries" of an executable work include anything, other +than the work as a whole, that (a) is included in the normal form of +packaging a Major Component, but which is not part of that Major +Component, and (b) serves only to enable use of the work with that +Major Component, or to implement a Standard Interface for which an +implementation is available to the public in source code form. A +"Major Component", in this context, means a major essential component +(kernel, window system, and so on) of the specific operating system +(if any) on which the executable work runs, or a compiler used to +produce the work, or an object code interpreter used to run it. + + The "Corresponding Source" for a work in object code form means all +the source code needed to generate, install, and (for an executable +work) run the object code and to modify the work, including scripts to +control those activities. However, it does not include the work's +System Libraries, or general-purpose tools or generally available free +programs which are used unmodified in performing those activities but +which are not part of the work. For example, Corresponding Source +includes interface definition files associated with source files for +the work, and the source code for shared libraries and dynamically +linked subprograms that the work is specifically designed to require, +such as by intimate data communication or control flow between those +subprograms and other parts of the work. + + The Corresponding Source need not include anything that users +can regenerate automatically from other parts of the Corresponding +Source. + + The Corresponding Source for a work in source code form is that +same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of +copyright on the Program, and are irrevocable provided the stated +conditions are met. This License explicitly affirms your unlimited +permission to run the unmodified Program. The output from running a +covered work is covered by this License only if the output, given its +content, constitutes a covered work. This License acknowledges your +rights of fair use or other equivalent, as provided by copyright law. + + You may make, run and propagate covered works that you do not +convey, without conditions so long as your license otherwise remains +in force. You may convey covered works to others for the sole purpose +of having them make modifications exclusively for you, or provide you +with facilities for running those works, provided that you comply with +the terms of this License in conveying all material for which you do +not control copyright. Those thus making or running the covered works +for you must do so exclusively on your behalf, under your direction +and control, on terms that prohibit them from making any copies of +your copyrighted material outside their relationship with you. + + Conveying under any other circumstances is permitted solely under +the conditions stated below. Sublicensing is not allowed; section 10 +makes it unnecessary. + + 3. Protecting Users' Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological +measure under any applicable law fulfilling obligations under article +11 of the WIPO copyright treaty adopted on 20 December 1996, or +similar laws prohibiting or restricting circumvention of such +measures. + + When you convey a covered work, you waive any legal power to forbid +circumvention of technological measures to the extent such circumvention +is effected by exercising rights under this License with respect to +the covered work, and you disclaim any intention to limit operation or +modification of the work as a means of enforcing, against the work's +users, your or third parties' legal rights to forbid circumvention of +technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program's source code as you +receive it, in any medium, provided that you conspicuously and +appropriately publish on each copy an appropriate copyright notice; +keep intact all notices stating that this License and any +non-permissive terms added in accord with section 7 apply to the code; +keep intact all notices of the absence of any warranty; and give all +recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, +and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to +produce it from the Program, in the form of source code under the +terms of section 4, provided that you also meet all of these conditions: + + a) The work must carry prominent notices stating that you modified + it, and giving a relevant date. + + b) The work must carry prominent notices stating that it is + released under this License and any conditions added under section + 7. This requirement modifies the requirement in section 4 to + "keep intact all notices". + + c) You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable section 7 + additional terms, to the whole of the work, and all its parts, + regardless of how they are packaged. This License gives no + permission to license the work in any other way, but it does not + invalidate such permission if you have separately received it. + + d) If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has interactive + interfaces that do not display Appropriate Legal Notices, your + work need not make them do so. + + A compilation of a covered work with other separate and independent +works, which are not by their nature extensions of the covered work, +and which are not combined with it such as to form a larger program, +in or on a volume of a storage or distribution medium, is called an +"aggregate" if the compilation and its resulting copyright are not +used to limit the access or legal rights of the compilation's users +beyond what the individual works permit. Inclusion of a covered work +in an aggregate does not cause this License to apply to the other +parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms +of sections 4 and 5, provided that you also convey the +machine-readable Corresponding Source under the terms of this License, +in one of these ways: + + a) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b) Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that product + model, to give anyone who possesses the object code either (1) a + copy of the Corresponding Source for all the software in the + product that is covered by this License, on a durable physical + medium customarily used for software interchange, for a price no + more than your reasonable cost of physically performing this + conveying of source, or (2) access to copy the + Corresponding Source from a network server at no charge. + + c) Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, and + only if you received the object code with such an offer, in accord + with subsection 6b. + + d) Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to the + Corresponding Source in the same way through the same place at no + further charge. You need not require recipients to copy the + Corresponding Source along with the object code. If the place to + copy the object code is a network server, the Corresponding Source + may be on a different server (operated by you or a third party) + that supports equivalent copying facilities, provided you maintain + clear directions next to the object code saying where to find the + Corresponding Source. Regardless of what server hosts the + Corresponding Source, you remain obligated to ensure that it is + available for as long as needed to satisfy these requirements. + + e) Convey the object code using peer-to-peer transmission, provided + you inform other peers where the object code and Corresponding + Source of the work are being offered to the general public at no + charge under subsection 6d. + + A separable portion of the object code, whose source code is excluded +from the Corresponding Source as a System Library, need not be +included in conveying the object code work. + + A "User Product" is either (1) a "consumer product", which means any +tangible personal property which is normally used for personal, family, +or household purposes, or (2) anything designed or sold for incorporation +into a dwelling. In determining whether a product is a consumer product, +doubtful cases shall be resolved in favor of coverage. For a particular +product received by a particular user, "normally used" refers to a +typical or common use of that class of product, regardless of the status +of the particular user or of the way in which the particular user +actually uses, or expects or is expected to use, the product. A product +is a consumer product regardless of whether the product has substantial +commercial, industrial or non-consumer uses, unless such uses represent +the only significant mode of use of the product. + + "Installation Information" for a User Product means any methods, +procedures, authorization keys, or other information required to install +and execute modified versions of a covered work in that User Product from +a modified version of its Corresponding Source. The information must +suffice to ensure that the continued functioning of the modified object +code is in no case prevented or interfered with solely because +modification has been made. + + If you convey an object code work under this section in, or with, or +specifically for use in, a User Product, and the conveying occurs as +part of a transaction in which the right of possession and use of the +User Product is transferred to the recipient in perpetuity or for a +fixed term (regardless of how the transaction is characterized), the +Corresponding Source conveyed under this section must be accompanied +by the Installation Information. But this requirement does not apply +if neither you nor any third party retains the ability to install +modified object code on the User Product (for example, the work has +been installed in ROM). + + The requirement to provide Installation Information does not include a +requirement to continue to provide support service, warranty, or updates +for a work that has been modified or installed by the recipient, or for +the User Product in which it has been modified or installed. Access to a +network may be denied when the modification itself materially and +adversely affects the operation of the network or violates the rules and +protocols for communication across the network. + + Corresponding Source conveyed, and Installation Information provided, +in accord with this section must be in a format that is publicly +documented (and with an implementation available to the public in +source code form), and must require no special password or key for +unpacking, reading or copying. + + 7. Additional Terms. + + "Additional permissions" are terms that supplement the terms of this +License by making exceptions from one or more of its conditions. +Additional permissions that are applicable to the entire Program shall +be treated as though they were included in this License, to the extent +that they are valid under applicable law. If additional permissions +apply only to part of the Program, that part may be used separately +under those permissions, but the entire Program remains governed by +this License without regard to the additional permissions. + + When you convey a copy of a covered work, you may at your option +remove any additional permissions from that copy, or from any part of +it. (Additional permissions may be written to require their own +removal in certain cases when you modify the work.) You may place +additional permissions on material, added by you to a covered work, +for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material you +add to a covered work, you may (if authorized by the copyright holders of +that material) supplement the terms of this License with terms: + + a) Disclaiming warranty or limiting liability differently from the + terms of sections 15 and 16 of this License; or + + b) Requiring preservation of specified reasonable legal notices or + author attributions in that material or in the Appropriate Legal + Notices displayed by works containing it; or + + c) Prohibiting misrepresentation of the origin of that material, or + requiring that modified versions of such material be marked in + reasonable ways as different from the original version; or + + d) Limiting the use for publicity purposes of names of licensors or + authors of the material; or + + e) Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f) Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified versions of + it) with contractual assumptions of liability to the recipient, for + any liability that these contractual assumptions directly impose on + those licensors and authors. + + All other non-permissive additional terms are considered "further +restrictions" within the meaning of section 10. If the Program as you +received it, or any part of it, contains a notice stating that it is +governed by this License along with a term that is a further +restriction, you may remove that term. If a license document contains +a further restriction but permits relicensing or conveying under this +License, you may add to a covered work material governed by the terms +of that license document, provided that the further restriction does +not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you +must place, in the relevant source files, a statement of the +additional terms that apply to those files, or a notice indicating +where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in the +form of a separately written license, or stated as exceptions; +the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly +provided under this License. Any attempt otherwise to propagate or +modify it is void, and will automatically terminate your rights under +this License (including any patent licenses granted under the third +paragraph of section 11). + + However, if you cease all violation of this License, then your +license from a particular copyright holder is reinstated (a) +provisionally, unless and until the copyright holder explicitly and +finally terminates your license, and (b) permanently, if the copyright +holder fails to notify you of the violation by some reasonable means +prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is +reinstated permanently if the copyright holder notifies you of the +violation by some reasonable means, this is the first time you have +received notice of violation of this License (for any work) from that +copyright holder, and you cure the violation prior to 30 days after +your receipt of the notice. + + Termination of your rights under this section does not terminate the +licenses of parties who have received copies or rights from you under +this License. If your rights have been terminated and not permanently +reinstated, you do not qualify to receive new licenses for the same +material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or +run a copy of the Program. Ancillary propagation of a covered work +occurring solely as a consequence of using peer-to-peer transmission +to receive a copy likewise does not require acceptance. However, +nothing other than this License grants you permission to propagate or +modify any covered work. These actions infringe copyright if you do +not accept this License. Therefore, by modifying or propagating a +covered work, you indicate your acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically +receives a license from the original licensors, to run, modify and +propagate that work, subject to this License. You are not responsible +for enforcing compliance by third parties with this License. + + An "entity transaction" is a transaction transferring control of an +organization, or substantially all assets of one, or subdividing an +organization, or merging organizations. If propagation of a covered +work results from an entity transaction, each party to that +transaction who receives a copy of the work also receives whatever +licenses to the work the party's predecessor in interest had or could +give under the previous paragraph, plus a right to possession of the +Corresponding Source of the work from the predecessor in interest, if +the predecessor has it or can get it with reasonable efforts. + + You may not impose any further restrictions on the exercise of the +rights granted or affirmed under this License. For example, you may +not impose a license fee, royalty, or other charge for exercise of +rights granted under this License, and you may not initiate litigation +(including a cross-claim or counterclaim in a lawsuit) alleging that +any patent claim is infringed by making, using, selling, offering for +sale, or importing the Program or any portion of it. + + 11. Patents. + + A "contributor" is a copyright holder who authorizes use under this +License of the Program or a work on which the Program is based. The +work thus licensed is called the contributor's "contributor version". + + A contributor's "essential patent claims" are all patent claims +owned or controlled by the contributor, whether already acquired or +hereafter acquired, that would be infringed by some manner, permitted +by this License, of making, using, or selling its contributor version, +but do not include claims that would be infringed only as a +consequence of further modification of the contributor version. For +purposes of this definition, "control" includes the right to grant +patent sublicenses in a manner consistent with the requirements of +this License. + + Each contributor grants you a non-exclusive, worldwide, royalty-free +patent license under the contributor's essential patent claims, to +make, use, sell, offer for sale, import and otherwise run, modify and +propagate the contents of its contributor version. + + In the following three paragraphs, a "patent license" is any express +agreement or commitment, however denominated, not to enforce a patent +(such as an express permission to practice a patent or covenant not to +sue for patent infringement). To "grant" such a patent license to a +party means to make such an agreement or commitment not to enforce a +patent against the party. + + If you convey a covered work, knowingly relying on a patent license, +and the Corresponding Source of the work is not available for anyone +to copy, free of charge and under the terms of this License, through a +publicly available network server or other readily accessible means, +then you must either (1) cause the Corresponding Source to be so +available, or (2) arrange to deprive yourself of the benefit of the +patent license for this particular work, or (3) arrange, in a manner +consistent with the requirements of this License, to extend the patent +license to downstream recipients. "Knowingly relying" means you have +actual knowledge that, but for the patent license, your conveying the +covered work in a country, or your recipient's use of the covered work +in a country, would infringe one or more identifiable patents in that +country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or +arrangement, you convey, or propagate by procuring conveyance of, a +covered work, and grant a patent license to some of the parties +receiving the covered work authorizing them to use, propagate, modify +or convey a specific copy of the covered work, then the patent license +you grant is automatically extended to all recipients of the covered +work and works based on it. + + A patent license is "discriminatory" if it does not include within +the scope of its coverage, prohibits the exercise of, or is +conditioned on the non-exercise of one or more of the rights that are +specifically granted under this License. You may not convey a covered +work if you are a party to an arrangement with a third party that is +in the business of distributing software, under which you make payment +to the third party based on the extent of your activity of conveying +the work, and under which the third party grants, to any of the +parties who would receive the covered work from you, a discriminatory +patent license (a) in connection with copies of the covered work +conveyed by you (or copies made from those copies), or (b) primarily +for and in connection with specific products or compilations that +contain the covered work, unless you entered into that arrangement, +or that patent license was granted, prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting +any implied license or other defenses to infringement that may +otherwise be available to you under applicable patent law. + + 12. No Surrender of Others' Freedom. + + If conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot convey a +covered work so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you may +not convey it at all. For example, if you agree to terms that obligate you +to collect a royalty for further conveying from those to whom you convey +the Program, the only way you could satisfy both those terms and this +License would be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have +permission to link or combine any covered work with a work licensed +under version 3 of the GNU Affero General Public License into a single +combined work, and to convey the resulting work. The terms of this +License will continue to apply to the part which is the covered work, +but the special requirements of the GNU Affero General Public License, +section 13, concerning interaction through a network will apply to the +combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new versions of +the GNU General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + + Each version is given a distinguishing version number. If the +Program specifies that a certain numbered version of the GNU General +Public License "or any later version" applies to it, you have the +option of following the terms and conditions either of that numbered +version or of any later version published by the Free Software +Foundation. If the Program does not specify a version number of the +GNU General Public License, you may choose any version ever published +by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future +versions of the GNU General Public License can be used, that proxy's +public statement of acceptance of a version permanently authorizes you +to choose that version for the Program. + + Later license versions may give you additional or different +permissions. However, no additional obligations are imposed on any +author or copyright holder as a result of your choosing to follow a +later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY +APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT +HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY +OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM +IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF +ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS +THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY +GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE +USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF +DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD +PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), +EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF +SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided +above cannot be given local legal effect according to their terms, +reviewing courts shall apply local law that most closely approximates +an absolute waiver of all civil liability in connection with the +Program, unless a warranty or assumption of liability accompanies a +copy of the Program in return for a fee. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see . + +Also add information on how to contact you by electronic and paper mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + Copyright (C) + This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, your program's commands +might be different; for a GUI interface, you would use an "about box". + + You should also get your employer (if you work as a programmer) or school, +if any, to sign a "copyright disclaimer" for the program, if necessary. +For more information on this, and how to apply and follow the GNU GPL, see +. + + The GNU General Public License does not permit incorporating your program +into proprietary programs. If your program is a subroutine library, you +may consider it more useful to permit linking proprietary applications with +the library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. But first, please read +. + + diff --git a/Main.hs b/Main.hs new file mode 100644 --- /dev/null +++ b/Main.hs @@ -0,0 +1,27 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable, TypeSynonymInstances, RankNTypes, FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +module Main where + +import Manatee.Daemon + +-- | main entry. +main :: IO () +main = daemonMain diff --git a/Manatee/Action/Basic.hs b/Manatee/Action/Basic.hs new file mode 100644 --- /dev/null +++ b/Manatee/Action/Basic.hs @@ -0,0 +1,418 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable, TypeSynonymInstances, RankNTypes, FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +module Manatee.Action.Basic where + +import Control.Applicative hiding (empty) +import Control.Concurrent.MVar +import Control.Concurrent.STM.TVar +import Control.Monad.State +import DBus.Client hiding (Signal) +import Data.Text.Lazy (Text) +import Graphics.UI.Gtk hiding (Action, Frame, Window) +import Manatee.Action.Tabbar +import Manatee.Core.DBus +import Manatee.Core.Types +import Manatee.Toolkit.General.Basic +import Manatee.Toolkit.General.List +import Manatee.Toolkit.General.Maybe +import Manatee.Toolkit.General.Process +import Manatee.Toolkit.General.STM +import Manatee.Toolkit.General.Seq +import Manatee.Toolkit.General.State +import Manatee.Toolkit.Gtk.Container +import Manatee.Toolkit.Gtk.Editable +import Manatee.Toolkit.Gtk.Gtk +import Manatee.Toolkit.Widget.Interactivebar +import Manatee.Toolkit.Widget.NotebookTab +import Manatee.Toolkit.Widget.PopupWindow +import Manatee.Types +import Manatee.UI.FocusNotifier +import Manatee.UI.Frame +import Manatee.UI.UIFrame +import Manatee.UI.Window hiding (windowNew) +import System.Posix.Types (ProcessID) + +import qualified Data.Foldable as F +import qualified Data.Map as M +import qualified Data.Set as Set +import qualified Graphics.UI.Gtk as Gtk +import qualified Manatee.Toolkit.Data.ListZipper as LZ + +type PageActionInputArgs = (Window, (TVar SignalBoxList, (TVar PageId, TVar SignalBoxId))) + +-- | Run action. +runAction :: Environment -> Action -> IO () +runAction env (Action {actionFun = fun}) = + envGet env >>= fun >>= envPut env + +(==>) :: forall a b . (ActionInputArgs a, ActionOutputArgs b) => Text -> (a -> IO b) -> (Text, Action) +key ==> command = (key, Action command) + +-- | Build socket frame. +socketFrameNew :: IO Gtk.Frame +socketFrameNew = frameNewWithShadowType Nothing + +-- | Create new signal box. +signalBoxNew :: UIFrame -> WindowId -> TVar SignalBoxId -> TVar SignalBoxList -> IO SignalBox +signalBoxNew uiFrame windowId signalBoxCounter signalBoxList = do + -- Ticker signal box counter. + signalBoxId <- tickTVarIO signalBoxCounter + + -- Create signal box. + let signalBox = SignalBox signalBoxId uiFrame windowId + + -- Add new SignalBox to list. + runTVarStateT signalBoxList $ put . Set.insert signalBox + + return signalBox + +-- | Clone tabs. +cloneTabs :: Window -> Client -> TVar Tabbar -> TVar SignalBoxList -> TVar SignalBoxId -> [(PageModeName, ProcessID, PageId)] -> IO () +cloneTabs window client tabbarTVar signalBoxList sId = + mapM_ (cloneTab window client tabbarTVar signalBoxList sId) + +-- | Clone tab. +cloneTab :: Window -> Client -> TVar Tabbar -> TVar SignalBoxList -> TVar SignalBoxId -> (PageModeName, ProcessID, PageId) -> IO () +cloneTab window client tabbarTVar signalBoxList sId (modeName, processId, pageId) = do + let windowId = windowGetId window + notebook = windowNotebook window + + -- Create new socket frame. + uiFrame <- uiFrameStick notebook Nothing + + -- Create signal box. + signalBox <- signalBoxNew uiFrame windowId sId signalBoxList + + -- Add page id information to tabbar, + -- then will replace other information after render page create. + -- And make sure render page will insert at correct place when call 'daemonHandleNewPageConfirm'. + modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId 0 0 uiFrame)) + + -- Send `ReparentRenderPage` signal. + mkRenderSignal client processId CloneRenderPage (CloneRenderPageArgs pageId (signalBoxId signalBox)) + +-- | Synchronization tab name. +syncTabName :: Environment -> WindowId -> IO () +syncTabName env windowId = do + (tabbar, (BufferList bufferList)) <- envGet env + + tabbarGetTabInfo tabbar windowId + ?>= \ (modeName, tabSeq) -> + M.lookup modeName bufferList + ?>= \ seqBuffer -> do + let nameList = map bufferName $ F.toList seqBuffer + zipWithIndexM_ nameList $ \name index -> do + maybeIndex tabSeq index ?>= \tab -> + notebookTabSetName (uiFrameNotebookTab $ tabUIFrame tab) name + +-- | Get current interactivebar. +getCurrentInteractivebar :: Environment -> IO (Maybe Interactivebar) +getCurrentInteractivebar env = + getCurrentUIFrame env >?>=> + (return . Just . uiFrameInteractivebar) + +-- | Get current uiFrame. +getCurrentUIFrame :: Environment -> IO (Maybe UIFrame) +getCurrentUIFrame env = + getCurrentTab env >?>=> \ tab -> return $ Just (tabUIFrame tab) + +-- | Get page mode name of specify window. +getWindowPageModeName :: Environment -> Window -> IO (Maybe PageModeName) +getWindowPageModeName env window = do + tabbar <- envGet env + return $ tabbarGetPageModeName tabbar (windowGetId window) + +-- | Get current tab. +getCurrentTab :: Environment -> IO (Maybe Tab) +getCurrentTab env = do + (tabbar, window) <- envGet env + + tabbarGetTabSeq tabbar (windowGetId window) ?>=> \ tabSeq -> do + currentPageIndex <- notebookGetCurrentPage (windowNotebook window) + return $ maybeIndex tabSeq currentPageIndex + +-- | Get next window. +getNextWindow :: WindowList -> Maybe Window +getNextWindow windowList + | LZ.length windowList <= 1 + = Nothing + | otherwise + = LZ.getRightCircular windowList + +-- | Action in next window. +withNextWindow :: Environment -> (Window -> IO ()) -> IO () +withNextWindow env action = do + windowList <- envGet env + + case getNextWindow windowList of + Just win -> action win + Nothing -> message env "Just current window exist." + +-- | Display message. +message :: Environment -> String -> IO () +message env output = + getCurrentUIFrame env >?>= \frame -> + uiFrameShowOutputbar frame output + +-- | Focus current tab.. +focusCurrentTab :: Environment -> IO () +focusCurrentTab env = do + client <- envGet env + + -- Exit popup window. + popupWindowExit_ env + + -- Send `FocusRenderPage` signal to focus page. + getCurrentTab env >?>= \ Tab {tabProcessId = processId + ,tabPlugId = plugId} -> + mkRenderSignal client processId FocusRenderPage (FocusRenderPageArgs plugId) + +-- | Init anything view. +anythingInitStartup :: Frame -> VBox -> Interactivebar -> IO () +anythingInitStartup frame anythingBox interactivebar = do + -- Clean first. + containerRemoveAll frame + containerRemoveAll anythingBox + + -- Add box and interactivebar. + interactivebarSetTitle interactivebar "Search " + interactivebarSetContent interactivebar "" -- clean input + interactivebarShow anythingBox interactivebar + frame `containerAdd` anythingBox + widgetShowAll anythingBox + + -- Start anything process. + startupAnything (SpawnAnythingProcessArgs GlobalSearchArgs) + +-- | Remove tabs match window id. +removeTabs :: Tabbar -> Client -> Window -> IO Tabbar +removeTabs (Tabbar tabbar) client window = do + let windowId = windowGetId window + notebook = windowNotebook window + + -- Remove all tab widget from notebook. + containerRemoveAll notebook + + -- Send tab destroy signal to child process. + forM_ (tabbarGetTabList windowId (Tabbar tabbar)) $ + \ Tab {tabProcessId = processId + ,tabPageId = pageId + ,tabPlugId = plugId} -> + mkRenderSignal client processId DestroyRenderPage (DestroyRenderPageArgs pageId plugId) + + -- Return new tabbar that remove all tabs match window id. + return $ tabbarRemoveTabs windowId (Tabbar tabbar) + +-- | Exit all render processes. +exitAllRenderProcess :: Environment -> IO () +exitAllRenderProcess env = do + (client, bufferListTVar) <- envGet env + + modifyTVarIOM bufferListTVar $ \ (BufferList bufferList) -> do + -- Send dbus signal `ExitRenderProcess` to all render processes. + forM_ (M.toList bufferList) $ \ (_, bufferSeq) -> + forM_ (F.toList bufferSeq) $ \ Buffer {bufferProcessId = processId + ,bufferPageId = pageId} -> + mkRenderSignal client processId ExitRenderProcess (ExitRenderProcessArgs pageId) + + -- Clean up buffer list. + return $ BufferList M.empty + +-- | Switch focus. +focusSwitch :: Environment -> IO () +focusSwitch env = do + focusStatus <- getFocusStatus env + case focusStatus of + FocusLocalInteractivebar -> focusCurrentTab env + FocusWindow -> envGet env >>= focusInteractivebar + +-- | Focus tab. +focusTab :: Environment -> IO () +focusTab env = do + focusStatus <- getFocusStatus env + case focusStatus of + FocusWindow -> do + focusCurrentTab env + envGet env >>= highlightCurrentWindow + FocusLocalInteractivebar -> + envGet env >>= highlightCurrentWindow + FocusInitInteractivebar -> + editableFocus $interactivebarEntry $ envInitInteractivebar env + +-- | Is focus on init interactivebar. +isFocusOnInitInteractivebar :: VBox -> IO Bool +isFocusOnInitInteractivebar = widgetHasParent + +-- | Get focus status. +getFocusStatus :: Environment -> IO FocusStatus +getFocusStatus env = do + let initBox = envInitBox env + ifM (isFocusOnInitInteractivebar initBox) + (return FocusInitInteractivebar) + (do + currentUIFrame <- getCurrentUIFrame env + case currentUIFrame of + Nothing -> (return FocusWindow) -- focus window when can't found page + Just uiFrame -> + ifM (uiFrameIsFocusInteractivebar uiFrame) + (return FocusLocalInteractivebar) + (return FocusWindow)) + +-- | Highlight window. +highlightCurrentWindow :: (Window, TVar FocusNotifierList) -> IO () +highlightCurrentWindow (window, focusNotifierList) = + focusNotifierShow (windowGetId window) focusNotifierList + +-- | Focus input. +focusInteractivebar :: (Environment, PopupWindow) -> IO () +focusInteractivebar (env, popupWindow) = + getCurrentUIFrame env >?>= \uiFrame -> do + let interactivebar = uiFrameInteractivebar uiFrame + -- Show interactivebar. + interactivebarSetTitle interactivebar "Search " + interactivebarSetContent interactivebar "" -- clean input + uiFrameShowInteractivebar uiFrame + -- When PopupWindow is invisible startup anythingView process. + whenM (not <$> popupWindowIsVisible popupWindow) + (do + -- Activate popup window. + popupWindowActivate popupWindow interactivebar + -- Start anything process. + startupAnything (SpawnAnythingProcessArgs GlobalSearchArgs)) + +-- | Startup anything. +startupAnything :: SpawnProcessArgs -> IO () +startupAnything args = + runProcess_ "manatee-anything" [show args] + +-- | Activate popup window. +popupWindowActivate :: PopupWindow -> Interactivebar -> IO () +popupWindowActivate popupWindow interactivebar = do + let entry = interactivebarEntry interactivebar + -- Stick entry. + popupWindowStickParent popupWindow entry + -- Set minimize size hide popupwindow. + popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1) + -- Show popup window. + popupWindowShow popupWindow + +-- | Exit input. +exitInteractivebar :: Environment -> IO () +exitInteractivebar env = + getCurrentUIFrame env >?>= \uiFrame -> do + interactivebarExit (uiFrameBox uiFrame) (uiFrameInteractivebar uiFrame) + popupWindowExit_ env + +-- | Exit popup window and fill envLocalInteractiveLock. +popupWindowExit_ :: Environment -> IO () +popupWindowExit_ env = do + popupWindowExit (envAnythingPopupWindow env) + tryPutMVar (envLocalInteractiveLock env) (Left "Interactivebar exit.") + tryPutMVar (envGlobalInteractiveLock env) (Left "Interactivebar exit.") + return () + +-- | Synchronization new tab in window. +tabbarSyncNewTab :: Environment -> WindowId -> DaemonSignalArgs -> IO () +tabbarSyncNewTab env wId (NewRenderPageConfirmArgs pageId _ _ _ processId modeName _ _) = do + (tabbarTVar, (Tabbar tabbar, (windowList, (client, (signalBoxList, signalBoxId))))) <- envGet env + + -- Synchronization tab in all same mode window. + forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), tabSeq) -> + -- When window mode same as tab mode and not current window. + when (windowId /= wId && pageModeName == modeName) $ + -- And tab haven't exist in current window. + unless (any (\x -> tabProcessId x == processId) (F.toList tabSeq)) $ + -- Then clone tab in current window. + windowListGetWindow windowId windowList ?>= \window -> + cloneTab window client tabbarTVar signalBoxList signalBoxId (modeName, processId, pageId) + +-- | Get top-level container. +getToplevelContainer :: Environment -> Container +getToplevelContainer = toContainer . envFrame + +-- | Get focus window. +getFocusWindow :: Environment -> IO Window +getFocusWindow env = do + let container = getToplevelContainer env + focusNotifierList = envFocusNotifierList env + windowList = envWindowList env + windowNodeList = envWindowNodeList env + + focusWindow <- windowListGetFocusWindow windowList windowNodeList focusNotifierList container + + case focusWindow of + Just window -> return window + Nothing -> error "getFocusWindow: can't found any window." + +instance ActionInputArgs Frame where + envGet = return . envFrame +instance ActionInputArgs Client where + envGet = return . envDaemonClient +instance ActionInputArgs Environment where + envGet = return +instance ActionInputArgs Window where + envGet = getFocusWindow +instance ActionInputArgs Container where + envGet = return . getToplevelContainer +instance ActionInputArgs VBox where + envGet = return . envInitBox +instance ActionInputArgs Interactivebar where + envGet = return . envInitInteractivebar +instance ActionInputArgs WindowList where + envGet = readTVarIO . envWindowList +instance ActionInputArgs WindowNodeList where + envGet = readTVarIO . envWindowNodeList +instance ActionInputArgs FocusNotifierList where + envGet = readTVarIO . envFocusNotifierList +instance ActionInputArgs Tabbar where + envGet = readTVarIO . envTabbar +instance ActionInputArgs BufferList where + envGet = readTVarIO . envBufferList +instance ActionInputArgs (TVar WindowList) where + envGet = return . envWindowList +instance ActionInputArgs (TVar WindowNodeList) where + envGet = return . envWindowNodeList +instance ActionInputArgs (TVar FocusNotifierList) where + envGet = return . envFocusNotifierList +instance ActionInputArgs (TVar SignalBoxList) where + envGet = return . envSignalBoxList +instance ActionInputArgs (TVar SignalBoxId) where + envGet = return . envSignalBoxIdCounter +instance ActionInputArgs (TVar ProcessID) where + envGet = return . envAnythingProcessId +instance ActionInputArgs (TVar Tabbar) where + envGet = return . envTabbar +instance ActionInputArgs (TVar BufferList) where + envGet = return . envBufferList +instance ActionInputArgs (TVar TabCloseHistory) where + envGet = return . envTabCloseHistory +instance ActionInputArgs ProcessID where + envGet = readTVarIO . envAnythingProcessId +instance ActionInputArgs PopupWindow where + envGet = return . envAnythingPopupWindow +instance ActionOutputArgs WindowList where + envPut = writeTVarIO . envWindowList +instance ActionOutputArgs WindowNodeList where + envPut = writeTVarIO . envWindowNodeList +instance ActionOutputArgs Tabbar where + envPut = writeTVarIO . envTabbar +instance ActionOutputArgs BufferList where + envPut = writeTVarIO . envBufferList diff --git a/Manatee/Action/BufferList.hs b/Manatee/Action/BufferList.hs new file mode 100644 --- /dev/null +++ b/Manatee/Action/BufferList.hs @@ -0,0 +1,158 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +module Manatee.Action.BufferList where + +import Data.Sequence (Seq) +import Manatee.Core.Types +import Manatee.Toolkit.Data.Unique +import Manatee.Toolkit.General.Map +import Manatee.Toolkit.General.Seq +import Manatee.Toolkit.General.String +import System.Posix.Types (ProcessID) + +import qualified Data.Foldable as F +import qualified Data.Map as M +import qualified Data.Sequence as Seq + +-- | Replace path. +bufferListReplacePath :: PageModeName -> PageId -> String -> BufferList -> BufferList +bufferListReplacePath pageModeName pageId newPath bl@(BufferList bufferMap) = + case bufferListGetBufferInfo pageModeName pageId bl of + Nothing -> bl + Just (oldBuffer, (bi, bufferSeq)) -> + let newBuffer = oldBuffer {bufferPath = newPath} + newBufferSeq = Seq.update bi newBuffer bufferSeq + in BufferList $ M.insert pageModeName newBufferSeq bufferMap + +-- | Replace tab name. +bufferListReplaceName :: PageModeName -> PageId -> String -> BufferList -> BufferList +bufferListReplaceName pageModeName pageId newTabName bl@(BufferList bufferMap) = + case bufferListGetBufferInfo pageModeName pageId bl of + Nothing -> bl + Just (oldBuffer, (bi, bufferSeq)) -> + let newBuffer = oldBuffer {bufferName = newTabName} + newBufferSeq = Seq.update bi newBuffer bufferSeq + in BufferList $ M.insert pageModeName newBufferSeq bufferMap + +-- | Strip tab name with special length. +bufferListStripName :: PageModeName -> PageId -> String -> BufferList -> BufferList +bufferListStripName pageModeName pageId newPath bl@(BufferList bufferMap) = + case bufferListGetBufferInfo pageModeName pageId bl of + Nothing -> bl + Just (oldBuffer, (bi, bufferSeq)) -> + let newBuffer = oldBuffer {bufferName = stripFormat newPath 25} + newBufferSeq = Seq.update bi newBuffer bufferSeq + in BufferList $ M.insert pageModeName newBufferSeq bufferMap + +-- | Unique buffer name. +bufferListUniqueName :: PageModeName -> BufferList -> BufferList +bufferListUniqueName modeName (BufferList bufferMap) = + let matchBuffer = findMinMatch bufferMap (\ mName _ -> mName == modeName) + in BufferList $ + case matchBuffer of + Nothing -> bufferMap + Just (name, bufferSeq) -> + let buffers = F.toList bufferSeq + bufferPathList = map bufferPath buffers + newBuffers = map (\ (buffer, newName) -> + buffer {bufferName = newName} + ) (zip buffers (map (uncurry formatBufferName) $ unique bufferPathList)) + in M.insert name (Seq.fromList newBuffers) bufferMap + +-- | Remove buffer. +bufferListRemoveBuffer :: PageModeName -> Int -> BufferList -> BufferList +bufferListRemoveBuffer modeName index (BufferList bufferMap) = + BufferList $ M.filter (not . Seq.null) -- remove item from BufferList if 'Seq Buffer' is empty + $ M.mapWithKey + (\ pageModeName buffers -> + if pageModeName == modeName + -- Delete buffer from 'Seq Buffer' when find match + then deleteAt index buffers + -- Otherwise keep unchange. + else buffers + ) bufferMap + +-- | Swap buffer. +bufferListSwapBuffer :: PageModeName -> Int -> Int -> BufferList -> BufferList +bufferListSwapBuffer modeName currentIndex targetIndex (BufferList bufferMap) = + BufferList $ M.mapWithKey + (\ pageModeName buffers -> + if pageModeName == modeName + then swap currentIndex targetIndex buffers + else buffers + ) bufferMap + +-- | Add buffer. +bufferListAddBuffer :: (PageModeName, ProcessID, PageId, PageType, String) -> BufferList -> BufferList +bufferListAddBuffer (pageModeName, processId, pageId, pType, path) (BufferList bufferMap) = + let matchBuffer = findMinMatch bufferMap (\ modeName _ -> modeName == pageModeName) + newBuffer = Buffer processId pageId pType path "" + sequence = case matchBuffer of + -- Add new tab if haven't same mode found. + Nothing -> Seq.singleton newBuffer + -- Replace or add new tab. + Just (_, seq) -> replaceOrAdd (\x -> bufferPageId x == pageId) newBuffer seq + in BufferList $ M.insert pageModeName sequence bufferMap + +-- | Is buffer exist. +bufferListGetBufferIndex :: BufferList -> PageModeName -> FilePath -> Maybe Int +bufferListGetBufferIndex (BufferList bufferMap) pageModeName path = index + where matchBuffer = findMinMatch bufferMap (\ modeName _ -> modeName == pageModeName) + index = case matchBuffer of + Just (_, bufferSeq) -> Seq.findIndexL (\x -> bufferPath x == path) bufferSeq + Nothing -> Nothing + +-- | Is buffer exist. +bufferListGetBufferIndexWithId :: BufferList -> PageModeName -> PageId -> Maybe Int +bufferListGetBufferIndexWithId (BufferList bufferMap) pageModeName pId = index + where matchBuffer = findMinMatch bufferMap (\ modeName _ -> modeName == pageModeName) + index = case matchBuffer of + Just (_, bufferSeq) -> Seq.findIndexL (\x -> bufferPageId x == pId) bufferSeq + Nothing -> Nothing + +-- | Find match buffer. +bufferListGetBufferInfo :: PageModeName -> PageId -> BufferList -> Maybe (Buffer, (Int, Seq Buffer)) +bufferListGetBufferInfo pageModeName pageId (BufferList bufferMap) = + let matchBuffer = findMinMatch bufferMap (\ modeName _ -> modeName == pageModeName) + in case matchBuffer of + Nothing -> Nothing + Just (_, bufferSeq) -> + case Seq.findIndexL (\x -> bufferPageId x == pageId) bufferSeq of + Nothing -> Nothing + Just bi -> + let oldBuffer = Seq.index bufferSeq bi + in Just (oldBuffer, (bi, bufferSeq)) + +-- | Get buffer with given mode name and page id. +bufferListGetBuffer :: BufferList -> PageModeName -> PageId -> Maybe Buffer +bufferListGetBuffer bl pageModeName pId = + fmap fst (bufferListGetBufferInfo pageModeName pId bl) + +-- | Format unique name. +formatBufferName :: FilePath -> FilePath -> FilePath +formatBufferName file dir + | null dir = file + | otherwise = file ++ "<" ++ dir ++ ">" + +-- | Return 'Ture' if have any buffer exist, +-- Otherwise return 'False' +bufferListHaveBufferExist :: BufferList -> Bool +bufferListHaveBufferExist (BufferList bufferMap) = + not $ M.null bufferMap + diff --git a/Manatee/Action/Tab.hs b/Manatee/Action/Tab.hs new file mode 100644 --- /dev/null +++ b/Manatee/Action/Tab.hs @@ -0,0 +1,490 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +module Manatee.Action.Tab where + +import Control.Concurrent.STM.TVar +import Control.Monad +import Data.List (partition) +import Graphics.UI.Gtk hiding (Action, Frame, Window) +import Manatee.Action.Basic +import Manatee.Action.BufferList +import Manatee.Action.Tabbar +import Manatee.Action.Window +import Manatee.Core.DBus +import Manatee.Core.PageMode +import Manatee.Core.Config +import Manatee.Core.Types +import Manatee.Toolkit.General.Basic hiding (swap) +import Manatee.Toolkit.General.List +import Manatee.Toolkit.General.Map +import Manatee.Toolkit.General.Maybe +import Manatee.Toolkit.General.Process +import Manatee.Toolkit.General.STM +import Manatee.Toolkit.Gtk.Notebook +import Manatee.Types +import Manatee.UI.UIFrame +import Manatee.UI.Window hiding (windowNew) + +import qualified Data.Foldable as F +import qualified Data.Map as M +import qualified Data.Sequence as Seq + +-- | New tab. +-- If tab has created, switch to tab. +-- Otherwise create tab. +newTab :: PageType -> PagePath -> Environment -> IO () +newTab pType pPath env = do + bufferList <- envGet env + + modeName <- getPageModeName pType pPath + case bufferListGetBufferIndex bufferList modeName pPath of + -- Switch to buffer if it has exist. + Just i -> do + tabSwitchGroupCurrentWindow env modeName + window <- envGet env + notebookSetCurrentPage (windowNotebook window) i + -- Otherwise create buffer. + Nothing -> newTabInternal pType pPath env + +-- | New path. +newTabInternal :: PageType -> PagePath -> Environment -> IO () +newTabInternal pType pPath env = do + (PageTypeRule rule) <- readConfig pageTypeRulePath (PageTypeRule M.empty) + case findMinMatch rule (\ typ _ -> typ == pType) of + Nothing -> putStrLn $ "newTabInternal : Can't found rule for `" ++ pType ++ "`" + Just (_, binaryPath) -> do + (window, (tabbarTVar, (bufferListTVar, (signalBoxList, (pId, sId))))) <- envGet env + + -- Create socket with current window. + let notebook = windowNotebook window + pageId <- tickTVarIO pId + + -- Switch mode before add new tab. + modeName <- getPageModeName pType pPath + tabSwitchGroupCurrentWindow env modeName + + -- Add to socket frame in notebook. + -- Because socket will failed to attached in notebook, + -- if haven't any plug add in socket. + -- So we use frame as socket container, we add socket in + -- frame after plug create complete and return plug id. + uiFrame <- uiFrameStick notebook Nothing + + -- Build signal box. + let windowId = windowGetId window + signalBox <- signalBoxNew uiFrame windowId sId signalBoxList + + -- Add page id information to buffer list and tabbar, + -- then will replace other information after render page create. + -- And make sure render page will insert at correct place when call 'daemonHandleNewPageConfirm'. + modifyTVarIO bufferListTVar (bufferListAddBuffer (modeName, 0, pageId, pType, "")) + modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId 0 0 uiFrame)) + + -- Spawn render process. + runProcess_ binaryPath [show (SpawnRenderProcessArgs pageId pType (signalBoxId signalBox) pPath)] + + return () + +-- | Move tab to left in next window. +tabMoveToLeftWithNextWindow :: Environment -> IO () +tabMoveToLeftWithNextWindow env = + withNextWindow env $ \win -> tabMoveToLeft (win, env) + +-- | Move tab to right in next window. +tabMoveToRightWithNextWindow :: Environment -> IO () +tabMoveToRightWithNextWindow env = + withNextWindow env $ \win -> tabMoveToRight (win, env) + +-- | Move tab to begin in next window. +tabMoveToBeginWithNextWindow :: Environment -> IO () +tabMoveToBeginWithNextWindow env = + withNextWindow env $ \win -> tabMoveToBegin (win, env) + +-- | Move tab to end in next window. +tabMoveToEndWithNextWindow :: Environment -> IO () +tabMoveToEndWithNextWindow env = + withNextWindow env $ \win -> tabMoveToEnd (win, env) + +-- | Move tab to left. +tabMoveToLeft :: (Window, Environment) -> IO () +tabMoveToLeft (window, env) = do + (windowList, tabbar) <- envGet env + + windowListGetWindow (windowGetId window) windowList ?>= \ window -> do + let notebook = windowNotebook window + unlessM (notebookAtStart notebook) $ + tabbarGetPageModeName tabbar (windowGetId window) ?>= \modeName -> do + currentPageIndex <- notebookGetCurrentPage notebook + tabMove env modeName currentPageIndex (currentPageIndex - 1) + +-- | Move tab to right. +tabMoveToRight :: (Window, Environment) -> IO () +tabMoveToRight (window, env) = do + (windowList, tabbar) <- envGet env + + windowListGetWindow (windowGetId window) windowList ?>= \ window -> do + let notebook = windowNotebook window + unlessM (notebookAtEnd notebook) $ + tabbarGetPageModeName tabbar (windowGetId window) ?>= \modeName -> do + currentPageIndex <- notebookGetCurrentPage notebook + tabMove env modeName currentPageIndex (currentPageIndex + 1) + +-- | Move tab to first. +tabMoveToBegin :: (Window, Environment) -> IO () +tabMoveToBegin (window, env) = do + (windowList, tabbar) <- envGet env + + windowListGetWindow (windowGetId window) windowList ?>= \ window -> do + let notebook = windowNotebook window + unlessM (notebookAtStart notebook) $ + tabbarGetPageModeName tabbar (windowGetId window) ?>= \modeName -> do + currentPageIndex <- notebookGetCurrentPage notebook + firstIndex <- notebookFirstIndex notebook + tabMove env modeName currentPageIndex firstIndex + +-- | Move tab to end. +tabMoveToEnd :: (Window, Environment) -> IO () +tabMoveToEnd (window, env) = do + (windowList, tabbar) <- envGet env + + windowListGetWindow (windowGetId window) windowList ?>= \ window -> do + let notebook = windowNotebook window + unlessM (notebookAtEnd notebook) $ + tabbarGetPageModeName tabbar (windowGetId window) ?>= \modeName -> do + currentPageIndex <- notebookGetCurrentPage notebook + lastIndex <- notebookLastIndex notebook + tabMove env modeName currentPageIndex lastIndex + +-- | Move tab. +tabMove :: Environment -> PageModeName -> Int -> Int -> IO () +tabMove env pageModeName currentIndex targetIndex = do + (bufferListTVar, tabbarTVar) <- envGet env + + -- Swap buffer. + modifyTVarIO bufferListTVar (bufferListSwapBuffer pageModeName currentIndex targetIndex) + -- Swap tab in notebook. + windowSwapTab env pageModeName currentIndex targetIndex + -- Swap tabbar. + modifyTVarIO tabbarTVar (tabbarSwapTab pageModeName currentIndex targetIndex) + +-- | Select next tab. +tabSelectNext :: Window -> IO () +tabSelectNext = + notebookSelectNextPage . windowNotebook + +-- | Select prev tab. +tabSelectPrev :: Window -> IO () +tabSelectPrev = + notebookSelectPrevPage . windowNotebook + +-- | Select first tab. +tabSelectFirst :: Window -> IO () +tabSelectFirst = + notebookSelectFirstPage . windowNotebook + +-- | Select last tab. +tabSelectLast :: Window -> IO () +tabSelectLast = + notebookSelectLastPage . windowNotebook + +-- | Select next tab in other window. +tabSelectNextWithNextWindow :: Environment -> IO () +tabSelectNextWithNextWindow env = + withNextWindow env tabSelectNext + +-- | Select previous tab in other window. +tabSelectPrevWithNextWindow :: Environment -> IO () +tabSelectPrevWithNextWindow env = + withNextWindow env tabSelectPrev + +-- | Select first tab in other window. +tabSelectFirstWithNextWindow :: Environment -> IO () +tabSelectFirstWithNextWindow env = + withNextWindow env tabSelectFirst + +-- | Select last tab in other window. +tabSelectLastWithNextWindow :: Environment -> IO () +tabSelectLastWithNextWindow env = + withNextWindow env tabSelectLast + +-- | Close specify tab. +tabClose :: Environment -> PageId -> IO () +tabClose env tPageId = do + (client, (window, (tabbarTVar, bufferListTVar))) <- envGet env + + let windowId = windowGetId window + + (Tabbar tabbar) <- readTVarIO tabbarTVar + tabbarGetTabInfo (Tabbar tabbar) windowId + ?>= \ (modeName, tabSeq) -> + -- Find page index that match page id. + Seq.findIndexL (\x -> tabPageId x == tPageId) tabSeq + ?>= \ currentPageIndex -> + -- Get match tab. + F.toList tabSeq ?! currentPageIndex + ?>= \ Tab {tabProcessId = processId + ,tabPageId = pageId} -> do + + -- When delete last buffer in buffer list, + -- mode name information will delete from buffer list. + -- So we need get next mode name before update buffer list + -- for switch next mode. + nextMode <- + getWindowPageModeName env window + >?>=> \currentModeName -> do + (BufferList bufferList) <- readTVarIO bufferListTVar + return $ findNextCycle (== currentModeName) (M.keys bufferList) + + -- PUsh close tab to history list. + pushCloseTab env modeName pageId + + -- Update buffer list. + modifyTVarIO bufferListTVar (bufferListRemoveBuffer modeName currentPageIndex) + + -- Just unique tab name when current page mode NOT in 'pageModeDuplicateTabList'. + pageModeDuplicateTabList <- getDuplicateTabList + unless (modeName `elem` pageModeDuplicateTabList) $ + modifyTVarIO bufferListTVar (bufferListUniqueName modeName) + + -- Remove tab widget from window notebook. + windowRemoveTab env modeName currentPageIndex nextMode + + -- Update tabbar + modifyTVarIO tabbarTVar (tabbarRemoveTab modeName currentPageIndex) + + -- Send `ExitRenderProcess` signal to exit render process. + mkRenderSignal client processId ExitRenderProcess (ExitRenderProcessArgs pageId) + + -- Switch to global input interactivebar if haven't any buffer exist. + bufferList <- readTVarIO bufferListTVar + unless (bufferListHaveBufferExist bufferList) $ + -- Will popup global input interactivebar after close all windows. + windowCloseAll env + +-- | Push to tab close history. +pushCloseTab :: Environment -> PageModeName -> PageId -> IO () +pushCloseTab env pageModeName pageId = do + (bufferList, tabCloseHistoryTVar) <- envGet env + + bufferListGetBuffer bufferList pageModeName pageId + ?>= \ Buffer {bufferPageType = pageType + ,bufferPath = pagePath} -> + -- Push close tab to history list. + modifyTVarIO tabCloseHistoryTVar $ \ (TabCloseHistory historyList) -> + let newItem = (pageModeName, pageType, pagePath) + (_, list) = partition (== newItem) historyList + in TabCloseHistory (newItem : list) + +-- | Undo close tab. +tabUndoCloseGlobal :: Environment -> IO () +tabUndoCloseGlobal env = do + tabCloseHistoryTVar <- envGet env + (TabCloseHistory history) <- readTVarIO tabCloseHistoryTVar + + -- Undo last close tab if history list not empty. + unless (null history) $ do + -- Open last close tab. + let ([(_, pageType, pagePath)], restList) = splitAt 1 history + newTab pageType pagePath env + + -- Update history list. + writeTVarIO tabCloseHistoryTVar (TabCloseHistory restList) + +-- | Undo close tab that same mode as current mode. +tabUndoCloseLocal :: Environment -> IO () +tabUndoCloseLocal env = do + focusStatus <- getFocusStatus env + case focusStatus of + -- If focus init interactivebar, same as 'tabUndoCloseGlobal'. + FocusInitInteractivebar -> tabUndoCloseGlobal env + -- Otherwise just undo tab that same as current mode. + _ -> do + (tabCloseHistoryTVar, window) <- envGet env + (TabCloseHistory history) <- readTVarIO tabCloseHistoryTVar + getWindowPageModeName env window + >?>= \ currentModeName -> do + -- Get history list that same as current mode. + let filterList = filter (\ (modeName, _, _) -> modeName == currentModeName) history + + -- Just open last tab when history list not empty. + unless (null filterList) $ do + -- Open last close tab. + let ([undoItem@(_, pageType, pagePath)], _) = splitAt 1 filterList + newTab pageType pagePath env + + -- Update history list. + writeTVarIO tabCloseHistoryTVar (TabCloseHistory (snd $ partition (== undoItem) history)) + +-- | Update output message. +tabUpdateOutput :: TVar Tabbar -> PagePlugId -> String -> IO () +tabUpdateOutput tabbar plugId output = do + tabs <- readTVarIO tabbar + tabbarGetTab plugId tabs ?>= \ tab -> + uiFrameShowOutputbar (tabUIFrame tab) output + +-- | Update status message. +tabUpdateStatus :: TVar Tabbar -> PagePlugId -> String -> String -> IO () +tabUpdateStatus tabbar plugId item status = do + tabs <- readTVarIO tabbar + tabbarGetTab plugId tabs ?>= \ tab -> + uiFrameUpdateStatusbar (tabUIFrame tab) item status + +-- | Update progress. +tabUpdateProgress :: TVar Tabbar -> PagePlugId -> Double -> IO () +tabUpdateProgress tabbar plugId progress = do + tabs <- readTVarIO tabbar + tabbarGetTab plugId tabs ?>= \ tab -> + uiFrameUpdateProgress (tabUIFrame tab) progress + +-- | Get current page id. +tabGetCurrentPageId :: Environment -> IO (Maybe PageId) +tabGetCurrentPageId env = do + (window, tabbarTVar) <- envGet env + + -- Get current page index. + let windowId = windowGetId window + currentPageIndex <- notebookGetCurrentPage (windowNotebook window) + + -- Get current page id. + (Tabbar tabbar) <- readTVarIO tabbarTVar + tabbarGetTabInfo (Tabbar tabbar) windowId + ?>=> \ (_, tabSeq) -> + F.toList tabSeq ?! currentPageIndex + ?>=> \ Tab {tabPageId = pageId} -> + return $ Just pageId + +-- | Close current tab. +tabCloseCurrent :: Environment -> IO () +tabCloseCurrent env = + tabGetCurrentPageId env + >?>= \ pageId -> + tabClose env pageId + +-- | Close all tabs except current one. +tabCloseOthers :: Environment -> IO () +tabCloseOthers env = do + (window, tabbarTVar) <- envGet env + + tabGetCurrentPageId env + >?>= \ currentPageId -> do + let windowId = windowGetId window + (Tabbar tabbar) <- readTVarIO tabbarTVar + -- Loop tab sequence, close all tabs except current one. + tabbarGetTabInfo (Tabbar tabbar) windowId + ?>= \ (_, tabSeq) -> + forM_ (F.toList tabSeq) $ \ Tab {tabPageId = pageId} -> + when (pageId /= currentPageId) $ + tabClose env pageId + +-- | Switch to next mode. +tabForwardGroup :: (Window, Environment) -> IO () +tabForwardGroup (window, env) = + tabForwardGroupWithWindow env window + +-- | Switch to previous mode. +tabBackwardGroup :: (Window, Environment) -> IO () +tabBackwardGroup (window, env) = + tabBackwardGroupWithWindow env window + +-- | Switch to next mode with next window. +tabForwardGroupWithNextWindow :: Environment -> IO () +tabForwardGroupWithNextWindow env = + withNextWindow env (tabForwardGroupWithWindow env) + +-- | Switch to next mode with next window. +tabBackwardGroupWithNextWindow :: Environment -> IO () +tabBackwardGroupWithNextWindow env = + withNextWindow env (tabBackwardGroupWithWindow env) + +-- | Switch to next mode with window. +tabBackwardGroupWithWindow :: Environment -> Window -> IO () +tabBackwardGroupWithWindow env window = do + (BufferList bufferList) <- envGet env + + getWindowPageModeName env window + >?>= \currentModeName -> + findPrevCycle (\ (modeName, _) -> modeName == currentModeName) (M.toList bufferList) + ?>= \ (prevModeName, _) -> + tabSwitchGroupWithWindow env window prevModeName + +-- | Switch to next mode with window. +tabForwardGroupWithWindow :: Environment -> Window -> IO () +tabForwardGroupWithWindow env window = do + (BufferList bufferList) <- envGet env + + getWindowPageModeName env window + >?>= \currentModeName -> + findNextCycle (\ (modeName, _) -> modeName == currentModeName) (M.toList bufferList) + ?>= \ (nextModeName, _) -> + tabSwitchGroupWithWindow env window nextModeName + +-- | Switch mode. +tabSwitchGroupCurrentWindow :: Environment -> PageModeName -> IO () +tabSwitchGroupCurrentWindow env pageModeName = do + window <- envGet env + tabSwitchGroupWithWindow env window pageModeName + +-- | Switch mode with window. +tabSwitchGroupWithWindow :: Environment -> Window -> PageModeName -> IO () +tabSwitchGroupWithWindow env window pageModeName = do + (Tabbar tabbar, (tabbarTVar, (BufferList bufferList, (client, (signalBoxList, sId))))) <- envGet env + + let windowId = windowGetId window + windowMode = findMinMatch tabbar (\ (wId, wModeName) _ -> wId == windowId && wModeName == pageModeName) + case windowMode of + Just _ -> return () + Nothing -> do + -- Remove all tabs match window id. + modifyTVarIOM tabbarTVar $ \ tabs -> removeTabs tabs client window + + -- Rebuild all tabs match target mode if can found same mode in buffer list. + findMinMatch bufferList (\ name _ -> name == pageModeName) + ?>= \ (_, bufferSeq) -> do + let tabDataList = map (\x -> (pageModeName, bufferProcessId x, bufferPageId x)) $ F.toList bufferSeq + cloneTabs window client tabbarTVar signalBoxList sId tabDataList + +-- | Remove tab from window. +windowRemoveTab :: Environment -> PageModeName -> Int -> Maybe PageModeName -> IO () +windowRemoveTab env modeName currentPageIndex nextMode = do + (Tabbar tabbar, windowList) <- envGet env + + forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), _) -> + when (pageModeName == modeName) $ + windowListGetWindow windowId windowList + ?>= \ window -> do + -- Remove tab widget. + notebookRemovePage (windowNotebook window) currentPageIndex + -- Synchronization tab name. + syncTabName env windowId + -- Switch to next mode when all tabs in current mode has delete. + number <- notebookGetNPages (windowNotebook window) + when (number == 0) $ + nextMode ?>= \mode -> + tabSwitchGroupWithWindow env window mode + +-- | Swap tab in window. +windowSwapTab :: Environment -> PageModeName -> Int -> Int -> IO () +windowSwapTab env pageModeName currentIndex targetIndex = do + (Tabbar tabbar, windowList) <- envGet env + + let filterMap = M.filterWithKey (\(_, modeName) _ -> modeName == pageModeName) tabbar + forM_ (M.toList filterMap) $ \ ((windowId, _), _) -> + windowListGetWindow windowId windowList ?>= \ window -> + notebookGetNthPage (windowNotebook window) currentIndex >?>= \ child -> + notebookReorderChild (windowNotebook window) child targetIndex diff --git a/Manatee/Action/Tabbar.hs b/Manatee/Action/Tabbar.hs new file mode 100644 --- /dev/null +++ b/Manatee/Action/Tabbar.hs @@ -0,0 +1,98 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +module Manatee.Action.Tabbar where + +import Data.List (find) +import Data.Map (filterWithKey) +import Data.Sequence (Seq) +import Manatee.Core.Types +import Manatee.Types +import Manatee.Toolkit.General.Map +import Manatee.Toolkit.General.Seq + +import qualified Data.Foldable as F +import qualified Data.Sequence as Seq +import qualified Data.Map as M + +-- | Swap tab. +tabbarSwapTab :: PageModeName -> Int -> Int -> Tabbar -> Tabbar +tabbarSwapTab modeName currentIndex targetIndex (Tabbar tabbar) = + Tabbar $ M.mapWithKey + (\ (_, pageModeName) tabs -> + if pageModeName == modeName + then swap currentIndex targetIndex tabs + else tabs + ) tabbar + +-- | Remove tab. +tabbarRemoveTab :: PageModeName -> Int -> Tabbar -> Tabbar +tabbarRemoveTab modeName index (Tabbar tabbar) = + Tabbar $ M.mapWithKey + (\ (_, pageModeName) tabs -> + if pageModeName == modeName + then deleteAt index tabs + else tabs + ) tabbar + +-- | Add new tab information in tabbar. +tabbarAddTab :: WindowId -> PageModeName -> Tab -> Tabbar -> Tabbar +tabbarAddTab windowId modeName newTab (Tabbar tabbar) = Tabbar newTabbar + where matchTab = findMinMatch tabbar (\(winId, _) _ -> winId == windowId) + sequence = case matchTab of + -- Add new tab if haven't same mode found. + Nothing -> Seq.singleton newTab + -- Replace or add new tab. + Just (_, seq) -> replaceOrAdd (\x -> tabPageId x == tabPageId newTab) newTab seq + newTabbar = M.insert (windowId, modeName) sequence tabbar + +-- | Remove tab with window id. +tabbarRemoveTabs :: WindowId -> Tabbar -> Tabbar +tabbarRemoveTabs windowId (Tabbar tabbar) = Tabbar newTabbar + where newTabbar = filterWithKey (\(winId, _) _ -> winId /= windowId) tabbar + +-- | Get tab that match plug id. +tabbarGetTab :: PagePlugId -> Tabbar -> Maybe Tab +tabbarGetTab plugId (Tabbar tabbar) = + find (\ tab -> tabPlugId tab == plugId) allTabs + where allTabList = map snd $ M.toList tabbar + allTabs = concatMap F.toList allTabList + +-- | Get page mode with special tab. +tabbarGetTabInfo :: Tabbar -> WindowId -> Maybe (PageModeName, Seq Tab) +tabbarGetTabInfo (Tabbar tabbar) windowId = info + where matchTab = findMinMatch tabbar (\ (wId, _) _ -> wId == windowId) + info = case matchTab of + Nothing -> Nothing + Just ((_, name), tabs) -> Just (name, tabs) + +-- | Get page mode name with window id. +tabbarGetPageModeName :: Tabbar -> WindowId -> Maybe PageModeName +tabbarGetPageModeName tabbar windowId = + maybe Nothing (Just . fst) (tabbarGetTabInfo tabbar windowId) + +-- | Get tabs. +tabbarGetTabSeq :: Tabbar -> WindowId -> Maybe (Seq Tab) +tabbarGetTabSeq tabbar windowId = + maybe Nothing (Just . snd) (tabbarGetTabInfo tabbar windowId) + +-- | Get tab list of match window. +tabbarGetTabList :: WindowId -> Tabbar -> [Tab] +tabbarGetTabList windowId tabbar = + maybe [] F.toList (tabbarGetTabSeq tabbar windowId) + diff --git a/Manatee/Action/Window.hs b/Manatee/Action/Window.hs new file mode 100644 --- /dev/null +++ b/Manatee/Action/Window.hs @@ -0,0 +1,237 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +module Manatee.Action.Window where + +import Control.Monad +import GHC.Conc +import Graphics.UI.Gtk hiding (Window) +import Manatee.Action.Basic +import Manatee.Action.Tabbar +import Manatee.Core.DBus +import Manatee.Core.Types +import Manatee.Toolkit.General.Maybe +import Manatee.Toolkit.General.STM +import Manatee.Types +import Manatee.UI.UIFrame +import Manatee.UI.Window hiding (windowNew) +import Manatee.UI.WindowNode + +import qualified Manatee.Toolkit.Data.ListZipper as LZ + +-- | Split window vertically. +windowSplitVertically :: Environment -> IO () +windowSplitVertically = windowSplit DVertical + +-- | Split window horizontally. +windowSplitHortizontally :: Environment -> IO () +windowSplitHortizontally = windowSplit DHortizontal + +-- | Spit window with specify direction. +windowSplit :: WindowNodeDirection -> Environment -> IO () +windowSplit direction env = do + (tabbarTVar, (tabbar, (windowParent, (container, (focusNotifierList, (windowListTVar, windowNodeListTVar)))))) <- envGet env + + let winParentId = windowGetId windowParent + tabbarGetPageModeName tabbar winParentId ?>= \modeName -> do + -- Get data before split parent window. + let seqList = tabbarGetTabList winParentId tabbar + currentTabIndex <- notebookGetCurrentPage (windowNotebook windowParent) + + -- Split window. + (windowChild1, windowChild2) <- windowSplitInternal + direction + windowParent + windowListTVar + windowNodeListTVar + focusNotifierList + container + + -- Build re-parent sockets for new child window. + windowChildReparentTabs env windowChild1 seqList modeName + + -- Build clone sockets for new child window. + windowChildCloneTabs env windowChild2 seqList modeName + + -- Update state. + modifyTVarIO tabbarTVar (tabbarRemoveTabs winParentId) + modifyTVarIO windowListTVar (`windowListFocus` windowChild1) + + -- Store tab index with window children. + notebookSetCurrentPage (windowNotebook windowChild1) currentTabIndex + notebookSetCurrentPage (windowNotebook windowChild2) currentTabIndex + +-- | Select next window and focus page. +windowSelectNext :: TVar WindowList -> IO () +windowSelectNext windowList = + modifyTVarIO windowList windowListNextCircular + +-- | Select previous window and focus page. +windowSelectPrev :: TVar WindowList -> IO () +windowSelectPrev windowList = + modifyTVarIO windowList windowListPrevCircular + +-- | Close current window. +windowCloseCurrent :: Environment -> IO () +windowCloseCurrent env = do + -- Get current window and close it. + window <- envGet env + windowRemove env window + +-- | Close all windows except current one. +windowCloseOthers :: Environment -> IO () +windowCloseOthers env = do + -- Get current window and window list. + (currentWindow, windowList) <- envGet env + + -- Loop window list to close windows. + forM_ (LZ.toList windowList) $ \ window -> + -- Close window that not match current window id. + when (windowGetId window /= windowGetId currentWindow) $ + windowRemove env window + +-- | Close all windows. +-- Will popup global input interactivebar after close all windows. +windowCloseAll :: Environment -> IO () +windowCloseAll env = do + windowList <- envGet env + forM_ (LZ.toList windowList) $ \ window -> + windowRemove env window + +-- | Remove window. +windowRemove :: Environment -> Window -> IO () +windowRemove env window = do + -- Get args. + (client, (frame, (anythingBox, (anythingInteractivebar, (tabbar, args))))) <- envGet env + + -- Remove all tabs match window id. + newTabbar <- removeTabs tabbar client window + + -- Remove window from window list. + (newWindowList, newWindowNodeList) <- windowRemoveInternal (window, args) + + -- Feed environment back. + envPut env (newTabbar, (newWindowList, newWindowNodeList)) + + -- Show anything input interface if no window exist. + when (LZ.isEmpty newWindowList) $ do + -- Hide local popup window. + popupWindowExit_ env + + -- Exit all render processes. + exitAllRenderProcess env + + -- Init anything view when no window exist. + anythingInitStartup frame anythingBox anythingInteractivebar + +-- | Re-parent tabs of parent in child window. +windowChildReparentTabs :: Environment -> Window -> [Tab] -> PageModeName -> IO () +windowChildReparentTabs env window seqList modeName = do + (client, (tabbarTVar, (signalBoxList, sId))) <- envGet env + + let notebook = windowNotebook window + windowId = windowGetId window + forM_ seqList $ \ Tab {tabProcessId = processId + ,tabPageId = pageId + ,tabPlugId = oldPlugId + ,tabUIFrame = oldUIFrame} -> do + -- Create new socket frame. + uiFrame <- uiFrameStick notebook (Just oldUIFrame) -- keep same UIFrame status with old one + + -- Create signal box. + signalBox <- signalBoxNew uiFrame windowId sId signalBoxList + + -- Add page id information to tabbar, + -- then will replace other information after render page create. + -- And make sure render page will insert at correct place when call 'daemonHandleNewPageConfirm'. + modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab 0 pageId 0 0 uiFrame)) + + -- Send `ReparentRenderPage` signal. + mkRenderSignal client processId ReparentRenderPage (ReparentRenderPageArgs pageId oldPlugId (signalBoxId signalBox)) + +-- | Clone tabs of parent in child window. +windowChildCloneTabs :: Environment -> Window -> [Tab] -> PageModeName -> IO () +windowChildCloneTabs env window seqList modeName = do + (client, (tabbarTVar, (signalBoxList, sId))) <- envGet env + + let tabDataList = map (\x -> (modeName, tabProcessId x, tabPageId x)) seqList + cloneTabs window client tabbarTVar signalBoxList sId tabDataList + +-- | Enlarge window up. +windowEnlargeUp :: Environment -> IO () +windowEnlargeUp env = do + (window, windowNodeList) <- envGet env + windowNodeZoom windowNodeList (windowNode window) ZUp True + +-- | Enlarge window down. +windowEnlargeDown :: Environment -> IO () +windowEnlargeDown env = do + (window, windowNodeList) <- envGet env + windowNodeZoom windowNodeList (windowNode window) ZDown True + +-- | Enlarge window left. +windowEnlargeLeft :: Environment -> IO () +windowEnlargeLeft env = do + (window, windowNodeList) <- envGet env + windowNodeZoom windowNodeList (windowNode window) ZLeft True + +-- | Enlarge window right. +windowEnlargeRight :: Environment -> IO () +windowEnlargeRight env = do + (window, windowNodeList) <- envGet env + windowNodeZoom windowNodeList (windowNode window) ZRight True + +-- | Enlarge window. +windowEnlarge :: Environment -> IO () +windowEnlarge env = do + windowEnlargeUp env + windowEnlargeDown env + windowEnlargeLeft env + windowEnlargeRight env + +-- | Shrink window up. +windowShrinkUp :: Environment -> IO () +windowShrinkUp env = do + (window, windowNodeList) <- envGet env + windowNodeZoom windowNodeList (windowNode window) ZUp False + +-- | Shrink window down. +windowShrinkDown :: Environment -> IO () +windowShrinkDown env = do + (window, windowNodeList) <- envGet env + windowNodeZoom windowNodeList (windowNode window) ZDown False + +-- | Shrink window left. +windowShrinkLeft :: Environment -> IO () +windowShrinkLeft env = do + (window, windowNodeList) <- envGet env + windowNodeZoom windowNodeList (windowNode window) ZLeft False + +-- | Shrink window right. +windowShrinkRight :: Environment -> IO () +windowShrinkRight env = do + (window, windowNodeList) <- envGet env + windowNodeZoom windowNodeList (windowNode window) ZRight False + +-- | Shrink window. +windowShrink :: Environment -> IO () +windowShrink env = do + windowShrinkUp env + windowShrinkDown env + windowShrinkLeft env + windowShrinkRight env diff --git a/Manatee/Daemon.hs b/Manatee/Daemon.hs new file mode 100644 --- /dev/null +++ b/Manatee/Daemon.hs @@ -0,0 +1,852 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-} +module Manatee.Daemon where + +import Control.Applicative hiding (empty) +import Control.Concurrent.MVar +import Control.Exception +import Control.Monad +import Control.Monad.Trans +import DBus.Client hiding (Signal) +import DBus.Types +import Data.Map (Map) +import Data.Text.Lazy (Text) +import GHC.Conc +import Graphics.UI.Gtk hiding (Window, windowNew, Frame, frameNew, + Signal, Variant, Action, + plugNew, plugGetId, get, Keymap) +import Graphics.UI.Gtk.Gdk.SerializedEvent +import Manatee.Action.Basic +import Manatee.Action.BufferList +import Manatee.Action.Tab +import Manatee.Action.Tabbar +import Manatee.Action.Window +import Manatee.Core.DBus +import Manatee.Core.Debug +import Manatee.Core.PageMode +import Manatee.Core.Interactive +import Manatee.Core.Types +import Manatee.Environment +import Manatee.Toolkit.General.Basic +import Manatee.Toolkit.General.FilePath +import Manatee.Toolkit.General.List +import Manatee.Toolkit.General.Maybe +import Manatee.Toolkit.General.Process +import Manatee.Toolkit.General.STM +import Manatee.Toolkit.General.Set hiding (mapM) +import Manatee.Toolkit.Gio.Gio +import Manatee.Toolkit.Gtk.Concurrent +import Manatee.Toolkit.Gtk.Editable +import Manatee.Toolkit.Gtk.Event +import Manatee.Toolkit.Gtk.Gtk +import Manatee.Toolkit.Gtk.Struct +import Manatee.Toolkit.Widget.Interactivebar +import Manatee.Toolkit.Widget.NotebookTab +import Manatee.Toolkit.Widget.PopupWindow +import Manatee.Toolkit.Widget.Tooltip +import Manatee.Types +import Manatee.UI.Frame +import Manatee.UI.UIFrame +import Manatee.UI.Window +import System.Directory + +import qualified Data.Map as M +import qualified Data.Set as Set +import qualified Data.Text.Lazy as T +import qualified Data.Foldable as F +import qualified Data.ByteString.UTF8 as UTF8 + +-- | Daemon process main entry. +daemonMain :: IO () +daemonMain = do + -- Init. + unsafeInitGUIForThreadedRTS + + env <- mkEnvironment + let frame = envFrame env + anythingBox = envInitBox env + anythingInteractivebar = envInitInteractivebar env + + -- Build daemon client for listen dbus signal. + mkDaemonClient env + + -- Build local object. + mkDaemonMethods [("GetBufferList", callGetBufferList env) + ,("Interactive", callGetInteractive env) + ,("GetBufferHistory", callGetBufferHistory env)] + + -- Handle key event. + frame `on` keyPressEvent $ tryEvent $ do + -- Remove tooltip when press key. + liftIO $ do + tList <- readTVarIO $ envTooltipSet env + forM_ (Set.toList tList) (\x -> tooltipExit x (envTooltipSet env)) + + -- Focus tab when press key. + liftIO $ focusTab env + -- Get event status. + focusStatus <- liftIO $ getFocusStatus env + keystoke <- eventKeystoke + sEvent <- serializedEvent + + -- liftIO $ do + -- ((tabbar, bufferList) :: (Tabbar, BufferList)) <- envGet env + -- putStrLn $ "-------------------------------" + -- putStrLn $ "daemonMain bufferlist: " ++ groom bufferList + -- putStrLn $ "daemonMain tabbar: " ++ groom tabbar + + -- liftIO $ do + -- (windowList, tabbar) :: (WindowList, Tabbar) <- envGet env + -- putStrLn $ "---------------------------" + -- putStrLn $ "daemonMain WindowList : " ++ groom windowList + -- putStrLn $ "daemonMain tabbar: " ++ groom tabbar + + -- liftIO $ putStrLn $ "Debug keystoke : " ++ show keystoke + + -- Handle key press event. + liftIO $ do + -- Handle global keymap first. + case M.lookup keystoke globalKeymap of + -- Execute global command. + Just action -> runAction env action + Nothing -> + case focusStatus of + -- Ignore localKeymap when handle init interactivebar. + FocusInitInteractivebar -> handleInteractivebarKeyPress env keystoke anythingInteractivebar + _ -> + case M.lookup keystoke localKeymap of + -- Execute local command. + Just action -> runAction env action + _ -> case focusStatus of + -- Handle PageView keymap. + FocusWindow -> envGet env >>= handlePageViewKeyPress keystoke sEvent + -- Handle local interactivebar. + FocusLocalInteractivebar -> + getCurrentInteractivebar env >?>= + handleInteractivebarKeyPress env keystoke + -- Focus tab after handle event. + focusTab env + + -- Init commander. + anythingInitStartup frame anythingBox anythingInteractivebar + + -- Show. + widgetShowAll frame + frame `onDestroy` do + -- Send broadcast quit signal, other process can listen this signal when daemon process quit. + client <- envGet env + mkDaemonBroadcastSignal client ExitDaemonProcess ExitDaemonProcessArgs + -- Need exit all render processes before exit daemon process. + exitAllRenderProcess env + -- Exit daemon process. + mainQuit + + -- Loop. + mainGUI + +globalKeymap :: Keymap +globalKeymap = + M.fromList + ["F2" ==> startProcessManager + ,"F3" ==> startFeedReader + ,"F4" ==> startFileManager + ,"F5" ==> startBrowser + ,"F6" ==> loginIrcDefaultChannel + ,"F7" ==> startIrc + ,"F11" ==> toggleFullscreen + ,"F12" ==> lockScreen + ,"C-'" ==> tabUndoCloseGlobal + ,"C-\"" ==> tabUndoCloseLocal + ] + +interactiveKeymap :: EditableClass ed => Map Text (ed -> IO ()) +interactiveKeymap = + M.fromList + [("Tab", editableExpandCompletion) + ,("BackSpace", editableDeleteBackwardChar) + ,("M-,", editableDeleteBackwardChar) + ,("M-<", editableDeleteBackwardWord) + ,("M-d", editableDeleteAllText) + ,("M-x", editableCutClipboard) + ,("M-c", editableCopyClipboard) + ,("M-v", editablePasteClipboard)] + +localKeymap :: Keymap +localKeymap = + M.fromList + -- Window keymap. + ["M-t" ==> windowSplitVertically + ,"M-T" ==> windowSplitHortizontally + ,"M-n" ==> windowSelectNext + ,"M-p" ==> windowSelectPrev + ,"M-;" ==> windowCloseCurrent + ,"M-:" ==> windowCloseOthers + -- Window zoom keymap. + ,"P-." ==> windowEnlarge + ,"P-," ==> windowShrink + ,"P-j" ==> windowEnlargeDown + ,"P-k" ==> windowEnlargeUp + ,"P-h" ==> windowEnlargeLeft + ,"P-l" ==> windowEnlargeRight + ,"P-J" ==> windowShrinkDown + ,"P-K" ==> windowShrinkUp + ,"P-H" ==> windowShrinkLeft + ,"P-L" ==> windowShrinkRight + -- Tab keymap in current window. + ,"M-9" ==> tabForwardGroup + ,"M-0" ==> tabBackwardGroup + ,"M-7" ==> tabSelectPrev + ,"M-8" ==> tabSelectNext + ,"M-&" ==> tabSelectFirst + ,"M-*" ==> tabSelectLast + ,"C-7" ==> tabMoveToLeft + ,"C-8" ==> tabMoveToRight + ,"C-&" ==> tabMoveToBegin + ,"C-*" ==> tabMoveToEnd + ,"M-'" ==> tabCloseCurrent + ,"M-\"" ==> tabCloseOthers + -- Tab keymap with next window. + ,"P-7" ==> tabSelectPrevWithNextWindow + ,"P-8" ==> tabSelectNextWithNextWindow + ,"P-&" ==> tabSelectFirstWithNextWindow + ,"P-*" ==> tabSelectLastWithNextWindow + ,"P-9" ==> tabForwardGroupWithNextWindow + ,"P-0" ==> tabBackwardGroupWithNextWindow + ,"C-P-7" ==> tabMoveToLeftWithNextWindow + ,"C-P-8" ==> tabMoveToRightWithNextWindow + ,"C-P-&" ==> tabMoveToBeginWithNextWindow + ,"C-P-*" ==> tabMoveToEndWithNextWindow + -- Other keymap. + ,"M-f" ==> focusInteractivebar + ,"M-F" ==> focusCurrentTab + ,"M-b" ==> focusSwitch + ,"M-g" ==> exitInteractivebar + ,"M-[" ==> viewBufferDirectory + ] + +-- | Build daemon client for listen dbus signal. +mkDaemonClient :: Environment -> IO () +mkDaemonClient env = do + let tabbar = envTabbar env + client = envDaemonClient env + + mkDaemonMatchRules client + [(NewRenderPageConfirm, daemonHandleNewPageConfirm env) + ,(RenderProcessExit, daemonHandleRenderProcessExit) + ,(NewTab, daemonHandleNewTab env) + ,(NewAnythingProcessConfirm, daemonHandleNewAnythingProcessConfirm env) + ,(AnythingViewOutput, daemonHandleAnythingViewOutput env) + ,(LocalInteractivebarExit, daemonHandleLocalInteractivebarExit env) + ,(LocalOutputbarUpdate, daemonHandleLocalOutputbarUpdate tabbar) + ,(LocalStatusbarUpdate, daemonHandleLocalStatusbarUpdate tabbar) + ,(LocalProgressUpdate, daemonHandleLocalProgressUpdate tabbar) + ,(SynchronizationPathName, daemonHandleSynchronizationPathName env) + ,(ChangeTabName, daemonHandleChangeTabName env) + ,(SwitchBuffer, daemonHandleSwitchBuffer env) + ,(ShowTooltip, daemonHandleShowTooltip env) + ,(LocalInteractiveReturn, daemonHandleLocalInteractiveReturn env) + ,(GlobalInteractiveReturn, daemonHandleGlobalInteractiveReturn env) + ] + +-- | Handle render process exit signal. +daemonHandleRenderProcessExit :: DaemonSignalArgs -> IO () +daemonHandleRenderProcessExit (RenderProcessExitArgs pageId processId) = + debugDBusMessage $ "daemonHandleRenderProcessExit: child process " ++ show processId ++ " exit. With page id : " ++ show pageId + +-- | Handle new tab signal. +daemonHandleNewTab :: Environment -> DaemonSignalArgs -> IO () +daemonHandleNewTab env (NewTabArgs pageType pagePath) = + runAction env (Action (newTab pageType pagePath)) + +-- | Handle new anything process confirm signal. +daemonHandleNewAnythingProcessConfirm :: Environment -> DaemonSignalArgs -> IO () +daemonHandleNewAnythingProcessConfirm env (NewAnythingProcessConfirmArgs (GWindowId plugId) processId) = do + let popupWindow = envAnythingPopupWindow env + anythingBox = envInitBox env + anythingProcessId = envAnythingProcessId env + + socket <- socketNew_ + focusStatus <- getFocusStatus env + case focusStatus of + FocusInitInteractivebar -> anythingBox `containerAdd` socket + _ -> popupWindowAdd popupWindow socket + socketAddId socket plugId + + writeTVarIO anythingProcessId processId + +-- | Handle interactivebar input. +daemonHandleAnythingViewOutput :: Environment -> DaemonSignalArgs -> IO () +daemonHandleAnythingViewOutput env (AnythingViewOutputArgs input completion outputHeight keyPressId) = do + -- Just update anything input entry status when + -- return return keyPressId is same current one. + -- Otherwise drop *old* calculation result. + currentKeyPressId <- readTVarIO $ envAnythingKeyPressId env + when (currentKeyPressId == keyPressId) $ do + let interactivebar = envInitInteractivebar env + popupWindow = envAnythingPopupWindow env + focusStatus <- getFocusStatus env + case focusStatus of + FocusInitInteractivebar -> + editableSetCompletionText (interactivebarEntry interactivebar) input completion + _ -> + getCurrentInteractivebar env >?>= \ bar -> do + -- Set entry. + editableSetCompletionText (interactivebarEntry bar) input completion + case outputHeight of + -- Adjust popup window with special size and position. + Just height -> do + let adjustHeight | height < popupWindowDefaultHeight + = height + | otherwise + = popupWindowDefaultHeight + -- Get size of interactivebar. + (Rectangle x y w h) <- widgetGetAllocation (interactivebarEntry bar) + -- Get size of screen. + (_, screenHeight) <- widgetGetScreenSize (interactivebarEntry bar) + -- If interactivebar's position too low, display popup window at above of interactivebar. + -- Otherwise, at below of interactivebar. + let adjustY | y + h + popupWindowDefaultHeight > screenHeight + = y - adjustHeight + | otherwise + = y + h + popupWindowSetAllocation popupWindow (Rectangle x adjustY w adjustHeight) + popupWindowShow popupWindow + -- Hide popup window when no output need to display. + Nothing -> popupWindowHide popupWindow + +-- | Handle local interactivebar exit. +daemonHandleLocalInteractivebarExit :: Environment -> DaemonSignalArgs -> IO () +daemonHandleLocalInteractivebarExit env LocalInteractivebarExitArgs = do + focusStatus <- getFocusStatus env + unless (focusStatus == FocusInitInteractivebar) $ + exitInteractivebar env + +-- | Handle local outputbar update. +daemonHandleLocalOutputbarUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO () +daemonHandleLocalOutputbarUpdate tabbar (LocalOutputbarUpdateArgs plugId output) = + tabUpdateOutput tabbar plugId output + +-- | Handle local statusbar update. +daemonHandleLocalStatusbarUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO () +daemonHandleLocalStatusbarUpdate tabbar (LocalStatusbarUpdateArgs plugId item status) = + tabUpdateStatus tabbar plugId item status + +-- | Handle local statusbar update. +daemonHandleLocalProgressUpdate :: TVar Tabbar -> DaemonSignalArgs -> IO () +daemonHandleLocalProgressUpdate tabbar (LocalProgressUpdateArgs plugId progress) = + tabUpdateProgress tabbar plugId progress + +-- | Handle synchronization tab name. +daemonHandleSynchronizationPathName :: Environment -> DaemonSignalArgs -> IO () +daemonHandleSynchronizationPathName env (SynchronizationPathNameArgs modeName pageId path) = do + debugDBusMessage $ "daemonHandleSynchronizationPathName: Catch SynchronizationPathName signal. Page id : " ++ show pageId + + (bufferListTVar, Tabbar tabbar) <- envGet env + + -- Replace path name. + modifyTVarIO bufferListTVar (bufferListReplacePath modeName pageId path) + + -- Adjust tab name. + pageModeDuplicateTabList <- getDuplicateTabList + if modeName `elem` pageModeDuplicateTabList + -- Just strip tab name when current page mode in 'pageModeDuplicateTabList' + then modifyTVarIO bufferListTVar (bufferListStripName modeName pageId path) + -- Otherwise unique all tab names. + else modifyTVarIO bufferListTVar (bufferListUniqueName modeName) + + -- Update notebook name. + forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), _) -> + when (pageModeName == modeName) $ syncTabName env windowId + +-- | Handle synchronization tab name. +daemonHandleChangeTabName :: Environment -> DaemonSignalArgs -> IO () +daemonHandleChangeTabName env (ChangeTabNameArgs modeName pageId path) = do + debugDBusMessage $ "daemonHandleChangeTabName: Catch SynchronizationPathName signal. Page id : " ++ show pageId + + (bufferListTVar, Tabbar tabbar) <- envGet env + + -- Replace tab name. + modifyTVarIO bufferListTVar (bufferListReplaceName modeName pageId path) + + -- Update notebook name. + forM_ (M.toList tabbar) $ \ ((windowId, pageModeName), _) -> + when (pageModeName == modeName) $ syncTabName env windowId + +-- | Handle switch buffer. +daemonHandleSwitchBuffer :: Environment -> DaemonSignalArgs -> IO () +daemonHandleSwitchBuffer env (SwitchBufferArgs modeName pageId) = do + -- Switch to buffer if it has exist. + bufferList <- envGet env + bufferListGetBufferIndexWithId bufferList modeName pageId + ?>= \ i -> do + tabSwitchGroupCurrentWindow env modeName + window <- envGet env + notebookSetCurrentPage (windowNotebook window) i + +-- | Handle InteractiveReturn return. +daemonHandleLocalInteractiveReturn :: Environment -> DaemonSignalArgs -> IO () +daemonHandleLocalInteractiveReturn env (LocalInteractiveReturnArgs strList) = do + popupWindow <- envGet env + focusStatus <- getFocusStatus env + unless (focusStatus == FocusInitInteractivebar) $ do + -- Get track value. + track <- readTVarIO (envLocalInteractiveTrack env) + -- Update return value. + modifyTVarIO (envLocalInteractiveReturn env) (++ strList) + if length track <= 1 + -- Exit interactivebar when user input complete. + then do + returnList <- readTVarIO (envLocalInteractiveReturn env) + tryPutMVar (envLocalInteractiveLock env) (Right returnList) + exitInteractivebar env + -- Or update track value and input next. + else do + let restTrack = tail track + interactiveName = (fst . head) restTrack + interactiveTitle = (snd . head) restTrack + -- Update track value. + writeTVarIO (envLocalInteractiveTrack env) restTrack + + -- Reset interactivebar and popup window. + getCurrentUIFrame env >?>= \uiFrame -> do + let interactivebar = uiFrameInteractivebar uiFrame + interactivebarSetTitle interactivebar interactiveTitle + interactivebarSetContent interactivebar "" + popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1) + + -- Change anything view candidate. + processId <- readTVarIO $ envAnythingProcessId env + mkRenderSignal (envDaemonClient env) processId AnythingViewChangeCandidate + (AnythingViewChangeCandidateArgs [interactiveName]) + +-- | Handle InteractiveReturn return. +daemonHandleGlobalInteractiveReturn :: Environment -> DaemonSignalArgs -> IO () +daemonHandleGlobalInteractiveReturn env (GlobalInteractiveReturnArgs strList) = do + -- Get popup window and focus status. + popupWindow <- envGet env + focusStatus <- getFocusStatus env + -- Get track value. + track <- readTVarIO (envGlobalInteractiveTrack env) + -- Update return value. + modifyTVarIO (envGlobalInteractiveReturn env) (++ strList) + if length track <= 1 + -- Exit interactivebar when user input complete. + then do + returnList <- readTVarIO (envGlobalInteractiveReturn env) + tryPutMVar (envGlobalInteractiveLock env) (Right returnList) + unless (focusStatus == FocusInitInteractivebar) $ + exitInteractivebar env + -- Or update track value and input next. + else do + -- Get interactive name and title. + let restTrack = tail track + interactiveName = (fst . head) restTrack + interactiveTitle = (snd . head) restTrack + + -- Update track value. + writeTVarIO (envGlobalInteractiveTrack env) restTrack + + -- Reset interactivebar and popup window. + case focusStatus of + FocusInitInteractivebar -> do + -- Show init interactivebar. + let interactivebar = envInitInteractivebar env + interactivebarSetTitle interactivebar interactiveTitle + interactivebarSetContent interactivebar "" + _ -> + getCurrentUIFrame env >?>= \uiFrame -> do + -- Show local interactivebar. + let interactivebar = uiFrameInteractivebar uiFrame + interactivebarSetTitle interactivebar interactiveTitle + interactivebarSetContent interactivebar "" + -- Hide popup window. + popupWindowSetAllocation popupWindow (Rectangle 0 0 1 1) + + -- Change anything view candidate. + processId <- readTVarIO $ envAnythingProcessId env + mkRenderSignal (envDaemonClient env) processId AnythingViewChangeCandidate + (AnythingViewChangeCandidateArgs [interactiveName]) + +-- | Handle switch buffer. +daemonHandleShowTooltip :: Environment -> DaemonSignalArgs -> IO () +daemonHandleShowTooltip env (ShowTooltipArgs text point int foreground background hideWhenPress pageId) = do + -- Init. + tooltipId <- tickTVarIO (envTooltipCounter env) + let showTooltip p = + tooltipNew tooltipId (envFrame env) text p int foreground background hideWhenPress (envTooltipSet env) + -- Just add in set when tooltip will hide after press key. + >>= \tooltip -> when hideWhenPress $ modifyTVarIO (envTooltipSet env) (Set.insert tooltip) + + -- Get current tab. + focusStatus <- liftIO $ getFocusStatus env + currentTab <- + case focusStatus of + FocusInitInteractivebar -> return Nothing + _ -> getCurrentTab env + + -- Show tooltip. + case currentTab of + -- Show tooltip when current no window exist. + Nothing -> showTooltip point + Just (Tab {tabPageId = tpId + ,tabUIFrame = UIFrame {uiFrameFrame = frame}}) -> do + -- Translate UIFrame coordinate to top-level coordinate. + (Rectangle fx fy _ _) <- widgetGetAllocation frame + let tooltipPoint = + case point of + Just (px, py) -> Just (fx + px, fy + py) + Nothing -> Nothing + case pageId of + -- Show tooltip directly when no pageId information in DBus signal. + Nothing -> showTooltip tooltipPoint + -- Or just show tooltip when user not at same page as signal from. + Just pId -> when (tpId /= pId) $ showTooltip tooltipPoint + +-- | Handle new page confirm signal. +daemonHandleNewPageConfirm :: Environment -> DaemonSignalArgs -> IO () +daemonHandleNewPageConfirm env + args@(NewRenderPageConfirmArgs + pageId pType sId plugId processId modeName path isFirstPage) = do + (tabbarTVar, (bufferListTVar, (signalBoxList, windowList))) <- envGet env + + -- Debug. + -- putStrLn $ "Page id : " ++ show pageId ++ + -- "\nPage plug id : " ++ show plugId ++ + -- "\nProcess id : " ++ show processId ++ + -- "\nMode name : " ++ modeName ++ + -- "\nPath : " ++ path + + -- Get signal box. + sbList <- readTVarIO signalBoxList + case (maybeFindMin sbList (\x -> signalBoxId x == sId)) of + Nothing -> putStrLn $ "### Impossible: daemonHandleNewPageConfirm - Can't find signal box Id " ++ show sId + Just signalBox -> do + -- Get window id that socket add. + let windowId = signalBoxWindowId signalBox + + -- Add page. + debugDBusMessage $ "daemonHandleNewPageConfirm: Catch NewRenderPageConfirm signal. Box id : " ++ show sId + debugDBusMessage "------------------------------" + + -- Add plug to socket. + let uiFrame = signalBoxUIFrame signalBox + notebookTab = uiFrameNotebookTab uiFrame + socketId <- socketFrameAdd uiFrame plugId modeName + + -- Stop spinner animation. + notebookTabStop notebookTab + + -- Close current page when click close button. + ntCloseButton notebookTab `onToolButtonClicked` do + -- Focus window container close button first, + -- otherwise `tabClose` can't work. + modifyTVarIO windowList (`windowListFocusId` windowId) + tabClose env pageId + + -- Update buffer list when first page create. + when isFirstPage $ do + -- Add new buffer. + modifyTVarIO bufferListTVar (bufferListAddBuffer (modeName, processId, pageId, pType, path)) + + -- Adjust tab name. + pageModeDuplicateTabList <- getDuplicateTabList + if modeName `elem` pageModeDuplicateTabList + -- Just strip tab name when current page mode in 'pageModeDuplicateTabList' + then modifyTVarIO bufferListTVar (bufferListStripName modeName pageId path) + -- Otherwise unique all tab names. + else modifyTVarIO bufferListTVar (bufferListUniqueName modeName) + + -- Update buffer history. + bufferList <- readTVarIO bufferListTVar + bufferListGetBuffer bufferList modeName pageId + ?>= \ Buffer {bufferPageType = pageType + ,bufferPath = path} -> + modifyTVarIO (envBufferHistory env) (insertUnique (BufferHistory modeName pageType path)) + + -- Update tabbar. + modifyTVarIO tabbarTVar (tabbarAddTab windowId modeName (Tab processId pageId socketId plugId uiFrame)) + + -- Synchronization tab name. + syncTabName env windowId + + -- Delete corresponding SignalBox from SignalBoxList. + writeTVarIO signalBoxList (Set.delete signalBox sbList) + + -- Synchronization tab in all window when first page create. + when isFirstPage $ tabbarSyncNewTab env windowId args + +-- | Add socket to socket frame. +socketFrameAdd :: UIFrame -> PagePlugId -> PageModeName -> IO PageSocketId +socketFrameAdd uiFrame (GWindowId plugId) modeName = do + -- Add plug in UIFrame. + let socketFrame = uiFrameFrame uiFrame + socket <- socketNew_ + socketFrame `containerAdd` socket + socketAddId socket plugId + -- Update page mode status in UIFrame. + uiFrameUpdateStatusbar uiFrame "PageMode" ("Mode (" ++ modeName ++ ")") + GWindowId <$> socketGetId socket + +-- | Return buffer history. +callGetBufferHistory :: Environment -> Member +callGetBufferHistory env = + Method "" "s" $ \ call -> do + history <- readTVarIO $ envBufferHistory env + replyReturn call [toVariant history] + +-- | Return buffer list. +callGetBufferList :: Environment -> Member +callGetBufferList env = + Method "" "s" $ \ call -> do + (BufferList bufferList) <- readTVarIO $ envBufferList env + let list = concatMap (\ (modeName, bufferSeq) -> + map (\ Buffer {bufferPageId = pageId + ,bufferPath = path + ,bufferName = name} -> + BufferInfo modeName path name pageId) $ F.toList bufferSeq) + $ M.toList bufferList + -- Don't return current buffer. + focusStatus <- liftIO $ getFocusStatus env + currentPageId <- + case focusStatus of + FocusInitInteractivebar -> return Nothing + _ -> tabGetCurrentPageId env + let bufferInfos = + case currentPageId of + Just pId -> filter (\ x -> bufferInfoId x /= pId) list + Nothing -> list + replyReturn call [toVariant bufferInfos] + +-- | Return interactive [String]. +callGetInteractive :: Environment -> Member +callGetInteractive env = + Method "s" "s" $ \ call -> do + -- Get input arguments. + (tabbar, popupWindow) <- envGet env + let Just input = fromVariant (head $ methodCallBody call) + (plugId, inputStr) = read input :: (PagePlugId, String) + + case parseInteractiveString inputStr of + -- Return error if parse interactive string failed. + Left err -> replyLocalInteractiveError call err + Right list -> do + -- Init track and return value. + writeTVarIO (envLocalInteractiveTrack env) list + writeTVarIO (envLocalInteractiveReturn env) [] + + -- Empty interactive lock first. + tryTakeMVar (envLocalInteractiveLock env) + + postGUIAsync $ + tabbarGetTab plugId tabbar + ?>= \ Tab {tabUIFrame = uiFrame} -> do + let interactivebar = uiFrameInteractivebar uiFrame + interactiveName = (fst . head) list + title = (snd . head) list + -- Show interactivebar. + interactivebarSetTitle interactivebar title + interactivebarSetContent interactivebar "" -- clean input + uiFrameShowInteractivebar uiFrame + -- When PopupWindow is invisible startup anythingView process. + whenM (not <$> popupWindowIsVisible popupWindow) + (do + -- Activate popup window. + popupWindowActivate popupWindow interactivebar + -- Start anything process. + startupAnything (SpawnAnythingProcessArgs + (InteractiveSearchArgs LocalInteractive [interactiveName]))) + + -- Wait interactive result. + result <- takeMVar (envLocalInteractiveLock env) + + -- Return. + case result of + Left err -> replyLocalInteractiveError call err + Right res -> replyReturn call [toVariant res] + +-- | Global interactive. +globalInteractive :: Environment -> String -> ([String] -> IO ()) -> IO () +globalInteractive env inputStr action = + case parseInteractiveString inputStr of + -- Return error if parse interactive string failed. + Left err -> putStrLn $ "globalInteractive : parse interactive string failed : " ++ show err + Right strList -> do + -- Get popup window and focus status. + popupWindow <- envGet env + focusStatus <- getFocusStatus env + + -- Init track and return value. + writeTVarIO (envGlobalInteractiveTrack env) strList + writeTVarIO (envGlobalInteractiveReturn env) [] + + -- Empty interactive lock first. + tryTakeMVar (envGlobalInteractiveLock env) + + -- Get interactive name and title. + let interactiveName = (fst . head) strList + interactiveTitle = (snd . head) strList + + case focusStatus of + FocusInitInteractivebar -> do + -- Show interactivebar. + let interactivebar = envInitInteractivebar env + interactivebarSetTitle interactivebar interactiveTitle + interactivebarSetContent interactivebar "" + + -- Change interactive type. + let client = envDaemonClient env + processId <- readTVarIO $ envAnythingProcessId env + mkRenderSignal client processId AnythingViewChangeInteractiveType + (AnythingViewChangeInteractiveTypeArgs GlobalInteractive) + -- Change candidate. + mkRenderSignal client processId AnythingViewChangeCandidate + (AnythingViewChangeCandidateArgs [interactiveName]) + _ -> + getCurrentUIFrame env >?>= \uiFrame -> do + -- Show interactivebar. + let interactivebar = uiFrameInteractivebar uiFrame + interactivebarSetTitle interactivebar interactiveTitle + interactivebarSetContent interactivebar "" + uiFrameShowInteractivebar uiFrame + -- When PopupWindow is invisible startup anythingView process. + whenM (not <$> popupWindowIsVisible popupWindow) + (do + -- Activate popup window. + popupWindowActivate popupWindow interactivebar + -- Start anything process. + startupAnything (SpawnAnythingProcessArgs + (InteractiveSearchArgs GlobalInteractive [interactiveName]))) + + -- Wait interactive result. + forkGuiIO_ (takeMVar (envGlobalInteractiveLock env)) + (\ result -> + case result of + Left err -> putStrLn $ "globalInteractive : " ++ show err + Right list -> + -- Just do action if return list match. + when (length strList == length list) $ + bracketOnError + (return list) + -- Print error message if exception rasied when do action. + (\ _ -> putStrLn "globalInteractive: exception rasied.") + action) + +-- | Reply interactive error. +replyLocalInteractiveError :: MethodCall -> Text -> IO () +replyLocalInteractiveError call err = + replyError call (mkErrorName_ daemonInteractiveErrorName) [toVariant err] + +-- | Handle page view key press event. +handlePageViewKeyPress :: Text -> SerializedEvent -> (Environment, Client) -> IO () +handlePageViewKeyPress keystoke sEvent (env, client) = + getCurrentTab env >?>= \ Tab {tabProcessId = processId + ,tabPlugId = plugId} -> + mkRenderSignal client processId PageViewKeyPress (PageViewKeyPressArgs plugId keystoke sEvent) + +-- | Handle interactivebar key press event. +handleInteractivebarKeyPress :: Environment -> Text -> Interactivebar -> IO () +handleInteractivebarKeyPress env keystoke bar = do + let client = envDaemonClient env + entry = interactivebarEntry bar + -- Focus anything input entry. + editableFocus entry + -- Do action. + isChanged <- + editableIsChanged entry $ + case M.lookup keystoke interactiveKeymap of + Just action -> action entry + _ -> + -- Insert character. + when (T.length keystoke == 1) $ do + unselectText <- editableGetUnselectText entry + editableSetText entry (unselectText ++ T.unpack keystoke) + -- Get input string. + allText <- editableGetAllText entry + unselectText <- editableGetUnselectText entry + -- Get anything process. + processId <- readTVarIO $ envAnythingProcessId env + -- Get keyPressId for identify anything process. + keyPressId <- tickTVarIO $ envAnythingKeyPressId env + -- Send signal to anything process. + mkRenderSignal client processId AnythingViewKeyPress + (AnythingViewKeyPressArgs keystoke allText unselectText keyPressId isChanged) + +-- | View buffer directory. +-- If buffer path is not directory, view current directory. +viewBufferDirectory :: Environment -> IO () +viewBufferDirectory env = do + (bufferList, (tabbar, window)) <- envGet env + getCurrentTab env + >?>= \ tab -> + tabbarGetPageModeName tabbar (windowGetId window) + ?>= \modeName -> + bufferListGetBuffer bufferList modeName (tabPageId tab) + ?>= \buffer -> do + let path = getUpperDirectory $ bufferPath buffer + if not (null path) && directoryDoesExist (UTF8.fromString path) + then newTab "PageFileManager" path env + else do + currentDir <- getCurrentDirectory + newTab "PageFileManager" currentDir env + +-- | Lock screen. +lockScreen :: Environment -> IO () +lockScreen _ = do + -- Don't burn LCD power. + (runCommand_ "xset dpms force off && sleep 1") + -- Lock screen. + (runCommand_ "xtrlock") + +-- | Startup process manager. +startProcessManager :: Environment -> IO () +startProcessManager = + newTab "PageProcessManager" "ProcessManager" + +-- | Startup rss/atom reader. +startFeedReader :: Environment -> IO () +startFeedReader = + newTab "PageReader" "Feed Reader" + +-- | Startup file manager. +startFileManager :: Environment -> IO () +startFileManager env = do + dir <- getCurrentDirectory + newTab "PageFileManager" dir env + +-- | Startup browser. +startBrowser :: Environment -> IO () +startBrowser = + newTab "PageBrowser" "http://www.google.com" + +-- | Login default channel. +loginIrcDefaultChannel :: Environment -> IO () +loginIrcDefaultChannel = + newTab "PageIrc" "irc://" + +-- | Start irc. +startIrc :: Environment -> IO () +startIrc env = + globalInteractive + env + "sServer : \nnPort : \nsChannel : \nsUserName : \n" + $ \ [server, port, channel, user] -> do + let info = "irc://" ++ user ++ "@" ++ server ++ ":" ++ port ++ "/" ++ channel + mkDaemonSignal (envDaemonClient env) NewTab (NewTabArgs "PageIrc" info) + diff --git a/Manatee/Environment.hs b/Manatee/Environment.hs new file mode 100644 --- /dev/null +++ b/Manatee/Environment.hs @@ -0,0 +1,69 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable, TypeSynonymInstances, RankNTypes, FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +module Manatee.Environment where + +import Control.Applicative +import Control.Concurrent.MVar +import Control.Concurrent.STM +import Graphics.UI.Gtk hiding (Frame, Window, frameNew) +import Manatee.Core.DBus +import Manatee.Core.Types +import Manatee.Toolkit.General.DBus +import Manatee.Toolkit.Widget.Interactivebar +import Manatee.Toolkit.Widget.PopupWindow +import Manatee.Types +import Manatee.UI.FocusNotifier +import Manatee.UI.Frame +import Manatee.UI.Window hiding (windowNew) +import Manatee.UI.WindowNode + +import qualified Data.Map as M +import qualified Data.Set as Set + +-- | Build environment arguments. +-- This is strut for manage miscellaneous state in Daemon process. +mkEnvironment :: IO Environment +mkEnvironment = + Environment <$> frameNew + <*> mkSessionClientWithName daemonBusName + <*> newTVarIO windowListNew + <*> newTVarIO windowNodeListNew + <*> newTVarIO (Tabbar M.empty) + <*> newTVarIO (BufferList M.empty) + <*> newTVarIO Set.empty + <*> newTVarIO 0 + <*> newTVarIO 0 + <*> newTVarIO (FocusNotifierList Set.empty Nothing) + <*> vBoxNew False 0 + <*> interactivebarNew + <*> popupWindowNew + <*> newTVarIO 0 + <*> newTVarIO 0 + <*> newTVarIO 0 + <*> newTVarIO Set.empty + <*> newMVar (Right []) + <*> newTVarIO [] + <*> newTVarIO [] + <*> newMVar (Right []) + <*> newTVarIO [] + <*> newTVarIO [] + <*> newTVarIO (TabCloseHistory []) + <*> newTVarIO [] diff --git a/Manatee/Types.hs b/Manatee/Types.hs new file mode 100644 --- /dev/null +++ b/Manatee/Types.hs @@ -0,0 +1,258 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +{-# LANGUAGE ExistentialQuantification, DeriveDataTypeable, TypeSynonymInstances, RankNTypes, FlexibleInstances, GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +module Manatee.Types where + +import Control.Applicative hiding (empty) +import Control.Concurrent.MVar +import Control.Concurrent.STM +import DBus.Client hiding (Signal) +import Data.Function +import Data.Map (Map) +import Data.Ord +import Data.Sequence (Seq) +import Data.Set +import Data.Text.Lazy (Text) +import Graphics.UI.Gtk hiding (on, get, Action, Statusbar, statusbarNew, Window, Frame, frameNew, Plug, Tooltip) +import Manatee.Core.Types +import Manatee.Toolkit.Data.ListZipper +import Manatee.Toolkit.Data.SetList +import Manatee.Toolkit.Widget.Interactivebar +import Manatee.Toolkit.Widget.NotebookTab +import Manatee.Toolkit.Widget.Outputbar +import Manatee.Toolkit.Widget.PopupWindow +import Manatee.Toolkit.Widget.Statusbar +import Manatee.Toolkit.Widget.Tooltip +import Manatee.UI.FocusNotifier +import Manatee.UI.Frame +import System.Posix.Types (ProcessID) +import Text.Printf + +import qualified Graphics.UI.Gtk as Gtk + +-- | Environment. +data Environment = + Environment {envFrame :: Frame + ,envDaemonClient :: Client + ,envWindowList :: TVar WindowList + ,envWindowNodeList :: TVar WindowNodeList + ,envTabbar :: TVar Tabbar + ,envBufferList :: TVar BufferList + ,envSignalBoxList :: TVar SignalBoxList + ,envPageIdCounter :: TVar PageId + ,envSignalBoxIdCounter :: TVar SignalBoxId + ,envFocusNotifierList :: TVar FocusNotifierList + ,envInitBox :: VBox + ,envInitInteractivebar :: Interactivebar + ,envAnythingPopupWindow :: PopupWindow + ,envAnythingProcessId :: TVar ProcessID + ,envAnythingKeyPressId :: TVar AnythingKeyPressId + ,envTooltipCounter :: TVar Int + ,envTooltipSet :: TVar (Set Tooltip) + ,envLocalInteractiveLock :: MVar (Either Text [String]) + ,envLocalInteractiveTrack :: TVar [(String, String)] + ,envLocalInteractiveReturn :: TVar [String] + ,envGlobalInteractiveLock :: MVar (Either Text [String]) + ,envGlobalInteractiveTrack :: TVar [(String, String)] + ,envGlobalInteractiveReturn:: TVar [String] + ,envTabCloseHistory :: TVar TabCloseHistory + ,envBufferHistory :: TVar [BufferHistory] + } + +-- | Tab close history for undo close action. +data TabCloseHistory = + TabCloseHistory [(PageModeName, PageType, PagePath)] + deriving Show + +-- | Keymap +-- | The design of `Keymap` is do a friendly, easy keymap interface. +type Keymap = Map Text Action + +-- | Action just wrap to taken polymorphism function. +-- It won't store polymorphism function. +-- You can use 'Action' wrap any polymorphism functions that +-- input argument is instance of ActionInputArgs and +-- output argument is instance of ActionOutputArgs. +data Action = forall a b . (ActionInputArgs a, ActionOutputArgs b) => + Action {actionFun :: a -> IO b} + +-- | ActionInputArgs is class to implement polymorphism keymap function. +-- +-- Example, you have functions: +-- +-- foo :: (Arg1, (Arg2, Arg3)) -> IO () +-- bar :: (Arg1, (Arg2, (Arg3, Arg4))) -> IO () +-- +-- you can write your keymap with below: +-- +-- keymap :: Keymap +-- keymap = M.fromList +-- ["M-1" ==> foo +-- ,"M-2" ==> bar] +-- +-- See? It's so flexible. +class ActionInputArgs a where + envGet :: Environment -> IO a + +-- | ActionOutputArgs is class to implement polymorphism result. +-- This class is very useful when you want transform pure function to `Keymap`. +-- You can return any result that instance of `ActionOutputArgs`, +-- then system will write those value back to `Environment`. +-- If you want update those value (such as TVar) yourself, just return `()`. +class ActionOutputArgs b where + envPut :: Environment -> b -> IO () + +instance ActionInputArgs () where + envGet _ = return () + +instance (ActionInputArgs a, ActionInputArgs b) => ActionInputArgs (a, b) where + envGet env = liftA2 (,) (envGet env) (envGet env) + +instance ActionOutputArgs () where + envPut _ _ = return () + +instance (ActionOutputArgs a, ActionOutputArgs b) => ActionOutputArgs (a, b) where + envPut env (a,b) = envPut env a >> envPut env b + +-- | 'SignalBox' build when create socket. +-- Pick info when receive dbus signal. +-- Delete after create new page. +data SignalBox = + SignalBox {signalBoxId :: SignalBoxId + ,signalBoxUIFrame :: UIFrame + ,signalBoxWindowId :: WindowId + } + +instance Eq SignalBox where + (==) = (==) `on` signalBoxId + +instance Ord SignalBox where + compare = comparing signalBoxId + +type SignalBoxList = Set SignalBox + +-- | WindowNode containe window node. +data WindowNode = + WindowNode {windowNodeId :: WindowNodeId + ,windowNodePaned :: Paned + ,windowNodeParentId :: TVar (Maybe WindowNodeId) + ,windowNodeChildLeftId :: TVar (Maybe WindowNodeId) + ,windowNodeChildRightId :: TVar (Maybe WindowNodeId) + ,windowNodeType :: TVar WindowNodeType + ,windowNodeDirection :: WindowNodeDirection} + +type WindowNodeId = Int + +data WindowNodeType = TNodeLeft + | TNodeRight + | TNodeRoot + deriving (Eq, Show, Read) + +data WindowNodeDirection = DVertical + | DHortizontal + deriving (Eq, Show, Read) + +data ZoomDirection = ZUp + | ZDown + | ZLeft + | ZRight + deriving (Eq, Show, Read) + +instance Eq WindowNode where + (==) = (==) `on` windowNodeId + +instance Ord WindowNode where + compare = comparing windowNodeId + +type WindowNodeList = SetList WindowNode + +-- | Window contain GtkNotebook for contain tabs. +data Window = + Window {windowNode :: WindowNode + ,windowNotebook :: Notebook} + +instance Eq Window where + (==) = (==) `on` windowNode + +instance Ord Window where + compare = comparing windowNode + +instance Show Window where + show = printf "<#Window %s>" . show . windowNodeId . windowNode + +type WindowList = ListZipper Window + + +data WindowListSelectDirection = VLeft + | VRight + deriving (Eq, Show, Read) +type WindowId = WindowNodeId + +type WindowListTuple = (WindowList, WindowNodeList) + +type WindowNodeArgs = (WindowNodeList, Container) + +type WindowArgs = (WindowList, WindowNodeList, Container) + +type WindowNodeAttr = (Maybe WindowNodeId + ,Maybe WindowNodeId + ,Maybe WindowNodeId + ,Maybe WindowNodeId + ,WindowNodeType + ,WindowNodeDirection) + +-- | Tabbar +-- Contain all tab in windows. +-- For update tab information in windows. +-- PageId for synchronization with different window. +-- Tabbar corresponding Notebook status. +newtype Tabbar = + Tabbar (Map (WindowId, PageModeName) (Seq Tab)) + deriving Show + +data Tab = + Tab {tabProcessId :: ProcessID + ,tabPageId :: PageId + ,tabSocketId :: PageSocketId + ,tabPlugId :: PagePlugId + ,tabUIFrame :: UIFrame} + deriving Show + +-- | UIFrame. +data UIFrame = + UIFrame {uiFrameBox :: VBox -- box for contain `PageView' + ,uiFrameInteractivebar :: Interactivebar -- interactivebar for interactive input + ,uiFrameFrame :: Gtk.Frame + ,uiFrameOutputbar :: Outputbar -- outputbar for display message + ,uiFrameStatusbar :: Statusbar -- statusbar + ,uiFrameNotebookTab :: NotebookTab -- notebook tab + } +instance Show UIFrame where + show _ = "UIFrame" + +-- | Focus status. +data FocusStatus = FocusInitInteractivebar + | FocusLocalInteractivebar + | FocusWindow + deriving (Eq, Show, Read, Ord) + +-- | Anything startup function. +data AnythingStartupFun = AnythingStartupFun (IO ()) + diff --git a/Manatee/UI/FocusNotifier.hs b/Manatee/UI/FocusNotifier.hs new file mode 100644 --- /dev/null +++ b/Manatee/UI/FocusNotifier.hs @@ -0,0 +1,188 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +-- | FocusNotifier use Cairo draw highlight frame when widget is focus. +module Manatee.UI.FocusNotifier where + +import Control.Concurrent.STM +import Control.Monad +import Control.Monad.Trans +import Data.Ord +import Data.Set (Set) +import Graphics.Rendering.Cairo +import Graphics.UI.Gtk +import Manatee.Toolkit.General.Basic +import Manatee.Toolkit.General.STM +import Manatee.Toolkit.General.Set +import Manatee.Toolkit.Gtk.Cairo +import Manatee.Toolkit.Gtk.Gtk + +import qualified Data.Function as Fun +import qualified Data.Set as Set + +data FocusNotifier = + FocusNotifier {focusNotifierId :: FocusNotifierId + ,focusNotifierBody :: Widget + ,focusNotifierFocus :: Bool} + +type FocusNotifierId = Int + +data FocusNotifierList = FocusNotifierList (Set FocusNotifier) (Maybe FocusNotifierId) + +instance Eq FocusNotifier where + (==) = (==) `Fun.on` focusNotifierId + +instance Ord FocusNotifier where + compare = comparing focusNotifierId + +-- | The frame size for notifier. +focusNotifierSize :: Int +focusNotifierSize = 2 + +-- | The color of notifier. +focusNotifierColor :: Color +focusNotifierColor = Color 61440 30464 17920 + +-- | The alpha value of color. +focusNotifierAlpha :: Double +focusNotifierAlpha = 0.7 + +-- | Create new FocusNotifier. +focusNotifierNew :: WidgetClass widget => FocusNotifierId -> widget -> TVar FocusNotifierList -> IO FocusNotifier +focusNotifierNew frameId widget focusNotifierList = do + -- Create new FocusNotifier. + let focusNotifier = FocusNotifier frameId (toWidget widget) False + + -- Add FocusNotifier to list. + modifyTVarIO focusNotifierList $ \(FocusNotifierList setList currentFocusId) -> + (FocusNotifierList (Set.insert focusNotifier setList ) currentFocusId) + + -- Try draw highlight frame when widget is focus. + -- Don't use : `on` exposeEvent, + -- otherwise child widget can't work (such as notebook) + widget `after` exposeEvent $ tryEvent $ liftIO $ + -- If current widget is focus, draw highlight frame abound widget. + whenM (focusNotifierIsFocus frameId focusNotifierList) $ do + (Rectangle x y w h) <- widgetGetAllocation widget -- get widget size. + frameWin <- widgetGetDrawWindow widget -- get draw window + renderWithDrawable frameWin $ -- draw highlight frame + focusNotifierDraw + (integralToDouble x) + (integralToDouble y) + (integralToDouble w) + (integralToDouble h) + (integralToDouble focusNotifierSize) + + -- Delete FocusNotifier when widget is destroy. + widget `on` destroyEvent $ tryEvent $ liftIO $ + modifyTVarIO focusNotifierList $ \(FocusNotifierList setList currentFocusId) -> + -- Delete FocusNotifier from list. + let newSetList = Set.delete focusNotifier setList + newFocusId = case currentFocusId of + -- Change focus id if it equal delete one. + Just i -> if i == focusNotifierId focusNotifier + then Nothing + else Just i + Nothing -> Nothing + + -- Update list. + in (FocusNotifierList newSetList newFocusId) + + -- Return. + return focusNotifier + +-- Widget is focus? +focusNotifierIsFocus :: FocusNotifierId -> TVar FocusNotifierList -> IO Bool +focusNotifierIsFocus frameId focusNotifierList = do + focusNotifier <- focusNotifierGetWithId frameId focusNotifierList + return $ case focusNotifier of + Just fn -> focusNotifierFocus fn + Nothing -> False + +-- | Hide focus notifier. +focusNotifierHide :: TVar FocusNotifierList -> IO () +focusNotifierHide focusNotifierList = + modifyTVarIOM focusNotifierList $ \list@(FocusNotifierList sfSet focusId) -> + case focusId of + Just fi -> do + -- Get match one. + match <- focusNotifierGetWithId fi focusNotifierList + case match of + -- Hide focus highlight frame. + Just m@(FocusNotifier sfId widget _) -> do + -- Redraw widget to hide highlight frame. + focusNotifierErase widget + -- Update list. + let newSet = Set.insert (FocusNotifier sfId widget False) $ Set.delete m sfSet + return (FocusNotifierList newSet Nothing) + Nothing -> return $ FocusNotifierList sfSet Nothing + Nothing -> return list + +-- | Show focus notifier. +focusNotifierShow :: FocusNotifierId -> TVar FocusNotifierList -> IO () +focusNotifierShow frameId focusNotifierList = do + let showFun = + modifyTVarIOM focusNotifierList $ \list@(FocusNotifierList sfSet _) -> do + match <- focusNotifierGetWithId frameId focusNotifierList + case match of + Just m@(FocusNotifier sfId widget _) -> do + -- Redraw widget to show highlight frame. + focusNotifierErase widget + -- Update list. + let newSet = Set.insert (FocusNotifier sfId widget True) $ Set.delete m sfSet + return (FocusNotifierList newSet (Just sfId)) + Nothing -> return list + + (FocusNotifierList _ focusId) <- readTVarIO focusNotifierList + -- Just redraw when focus widget is change. + case focusId of + Just fi -> unless (frameId == fi) $ do + -- Hide old one. + focusNotifierHide focusNotifierList + -- Focus new one. + showFun + Nothing -> showFun + +-- | Draw highlight frame around widget. +focusNotifierDraw :: Double -> Double -> Double -> Double -> Double -> Render () +focusNotifierDraw x y w h lw = do + -- Set style. + let (rv, gv, bv) = colorToRGB focusNotifierColor + setSourceRGBA rv gv bv focusNotifierAlpha + setLineWidth lw + + -- Draw highlight frame smaller than widget, + -- otherwise, widget's redraw can't hide highlight frame. + roundRectangle (x + 1) (y + 1) (w - 2) (h - 2) pi + stroke + +-- | Get notifier with id. +focusNotifierGetWithId :: FocusNotifierId -> TVar FocusNotifierList -> IO (Maybe FocusNotifier) +focusNotifierGetWithId frameId focusNotifierList = do + (FocusNotifierList sfSet _) <- readTVarIO focusNotifierList + return $ maybeFindMin sfSet (\fn -> focusNotifierId fn == frameId) + +-- | Erase highlight frame around widget. +focusNotifierErase :: WidgetClass self => self -> IO () +focusNotifierErase widget = do + (Rectangle x y w h) <- widgetGetAllocation widget + --`widgetRedrawRectangleFrame` just redraw special rectangle + -- is more efficient than `widgetQueueDraw` (redraw entire area). + widgetRedrawRectangleFrame widget + x y w h -- bigger than highlight frame area + (focusNotifierSize + 1) -- make sure erase highlight frame diff --git a/Manatee/UI/Frame.hs b/Manatee/UI/Frame.hs new file mode 100644 --- /dev/null +++ b/Manatee/UI/Frame.hs @@ -0,0 +1,45 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +module Manatee.UI.Frame where + +import Graphics.UI.Gtk hiding (on, get, Frame) +import Manatee.Toolkit.Gtk.Gtk + +type Frame = Window + +-- | Create new frame. +frameNew :: IO Frame +frameNew = do + frame <- windowNew + windowFullscreen frame + return frame + +-- | Toggle fullscreen. +toggleFullscreen :: Frame -> IO () +toggleFullscreen frame = do + -- Get fullscreen states. + isFullscreen <- windowIsFullscreen frame + + -- Toggle fullscreen. + if isFullscreen + then do + windowUnfullscreen frame + windowMaximize frame + else windowFullscreen frame + diff --git a/Manatee/UI/UIFrame.hs b/Manatee/UI/UIFrame.hs new file mode 100644 --- /dev/null +++ b/Manatee/UI/UIFrame.hs @@ -0,0 +1,125 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +module Manatee.UI.UIFrame where + +import Graphics.UI.Gtk hiding (Statusbar, statusbarNew) +import Manatee.Types +import Manatee.Toolkit.Gtk.Gtk +import Manatee.Toolkit.Gtk.Notebook +import Manatee.Toolkit.Widget.Interactivebar +import Manatee.Toolkit.Widget.NotebookTab +import Manatee.Toolkit.Widget.Outputbar +import Manatee.Toolkit.Widget.Statusbar + +-- | Stick ui frame to notebook. +uiFrameStick :: NotebookClass notebook => notebook -> Maybe UIFrame -> IO UIFrame +uiFrameStick notebook frame = do + -- Create or clone ui frame. + uiFrame <- case frame of + Just f -> uiFrameClone f + Nothing -> uiFrameNew + + -- Stick uiFrame in notebook. + let notebookTab = uiFrameNotebookTab uiFrame + notebookAppendPageTab_ notebook (uiFrameBox uiFrame) (ntBox notebookTab) + notebookSetTabReorderable notebook (uiFrameBox uiFrame) False -- disable reorder tab use DND action + notebookTabStart notebookTab -- start spinner animation + + return uiFrame + +-- | Create 'UIFrame'. +uiFrameNew :: IO UIFrame +uiFrameNew = do + -- Create box. + box <- vBoxNew False 0 + + -- Interactivebar. + interactivebar <- interactivebarNew + + -- Body frame. + frame <- frameNewWithShadowType Nothing + boxPackStart box frame PackGrow 0 + + -- Outputbar. + outputbar <- outputbarNew + + -- Statusbar. + statusbar <- statusbarNew box + + -- Notebook tab. + notebookTab <- notebookTabNew Nothing Nothing + + return $ UIFrame box interactivebar frame outputbar statusbar notebookTab + +-- | Clone UIFrame. +uiFrameClone :: UIFrame -> IO UIFrame +uiFrameClone oldUIFrame = do + -- Create box. + box <- vBoxNew False 0 + + -- Clone interactivebar. + interactivebar <- interactivebarClone box (uiFrameInteractivebar oldUIFrame) + + -- Body frame. + frame <- frameNewWithShadowType Nothing + boxPackStart box frame PackGrow 0 + + -- Outputbar. + outputbar <- outputbarNew + + -- Clone statusbar. + statusbar <- statusbarClone box (uiFrameStatusbar oldUIFrame) + + -- Notebook tab. + notebookTab <- notebookTabNew Nothing Nothing + + return $ UIFrame box interactivebar frame outputbar statusbar notebookTab + +-- | Show interactivebar. +uiFrameShowInteractivebar :: UIFrame -> IO () +uiFrameShowInteractivebar uiFrame = + interactivebarShow (uiFrameBox uiFrame) + (uiFrameInteractivebar uiFrame) + +-- | Hide interactivebar. +uiFrameHideInteractivebar :: UIFrame -> IO () +uiFrameHideInteractivebar uiFrame = + interactivebarExit (uiFrameBox uiFrame) + (uiFrameInteractivebar uiFrame) + +-- | Is focus on interactivebar. +uiFrameIsFocusInteractivebar :: UIFrame -> IO Bool +uiFrameIsFocusInteractivebar = + widgetGetIsFocus . interactivebarEntry . uiFrameInteractivebar + +-- | Show outputbar. +uiFrameShowOutputbar :: UIFrame -> String -> IO () +uiFrameShowOutputbar uiFrame = + outputbarShow (uiFrameBox uiFrame) + (uiFrameOutputbar uiFrame) + +-- | Update statusbar. +uiFrameUpdateStatusbar :: UIFrame -> String -> String -> IO () +uiFrameUpdateStatusbar uiFrame = + statusbarInfoItemUpdate (uiFrameStatusbar uiFrame) + +-- | Update statusbar. +uiFrameUpdateProgress :: UIFrame -> Double -> IO () +uiFrameUpdateProgress uiFrame = + statusbarProgressUpdate (uiFrameStatusbar uiFrame) diff --git a/Manatee/UI/Window.hs b/Manatee/UI/Window.hs new file mode 100644 --- /dev/null +++ b/Manatee/UI/Window.hs @@ -0,0 +1,317 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +module Manatee.UI.Window where + +import Control.Applicative hiding (empty) +import Control.Concurrent.STM +import Control.Monad.State +import Data.List +import Data.Maybe +import Graphics.UI.Gtk hiding (Window, windowNew, get) +import Manatee.Types +import Manatee.UI.FocusNotifier +import Manatee.UI.WindowNode +import Manatee.Toolkit.Data.ListZipper hiding (length, delete, get) +import Manatee.Toolkit.General.Maybe +import Manatee.Toolkit.General.STM +import Manatee.Toolkit.General.State +import Manatee.Toolkit.Gtk.Container +import Manatee.Toolkit.Gtk.Gtk + +import qualified Manatee.Toolkit.Data.ListZipper as LZ + +-- | Create new window. +windowNew :: WindowNodeType -> WindowNodeDirection -> Maybe WindowNode -> Container -> TVar FocusNotifierList -> WindowListTuple -> IO (Window, WindowListTuple) +windowNew vnType direction parentNode container focusNotifierList (windowList, windowNodeList) = + runStateT_ (windowList, windowNodeList) $ do + -- New window node. + node <- modifyM_ (\(wList, nList) -> do + (node, nnList) <- windowNodeNew parentNode vnType direction (nList, container) + return (node, (wList, nnList))) snd fst + + -- New window. + notebook <- lift notebookNew + let window = Window node notebook + lift $ do + -- Set notebook attributes. + set notebook [notebookScrollable := True] -- enable scrolling arrow when too many tabs fit the notebook + + -- Add notify frame. + notifierFrame <- frameNewWithShadowType Nothing + windowGetContainer window `containerAdd` notifierFrame + notifierFrame `containerAdd` notebook + focusNotifierNew (windowGetId window) notifierFrame focusNotifierList + + -- Show current window. + widgetShowAll (windowNodePaned node) + + -- Add window to window list. + vnType <- lift $ windowNodeGetType node + modifyFst (\(wList, _) -> windowListAddWindow wList window vnType) + + return window + +-- | New root window. +windowRootNew :: WindowArgs -> TVar FocusNotifierList -> IO (Window, WindowListTuple) +windowRootNew (windowList, windowNodeList, container) focusNotifierList = + runStateT_ (windowList, windowNodeList) $ do + -- Create new window. + window <- modifyM_ (windowNew TNodeRoot DVertical Nothing container focusNotifierList) snd fst + + -- Focus window. + modifyFst (\(wList, _) -> windowListFocus wList window) + + return window + +-- | Init window. +windowInit :: WindowArgs -> TVar FocusNotifierList -> IO (WindowList, WindowNodeList) +windowInit (windowList, windowNodeList, container) focusNotifierList = + runStateT' (windowList, windowNodeList) $ + -- Just create first window when window list is empty. + when (isEmpty windowList) $ + modifyM (\(wList, nList) -> do + -- Remove all children from container. + containerRemoveAll container + + -- Build root window and add to container. + snd <$> windowRootNew (wList, nList, container) focusNotifierList) + +-- | Split window with indicate direction. +windowSplitInternal :: WindowNodeDirection + -> Window + -> TVar WindowList + -> TVar WindowNodeList + -> TVar FocusNotifierList + -> Container + -> IO (Window, Window) +windowSplitInternal direction windowParent windowList windowNodeList focusNotifierList container = do + -- Get old value. + oldWindowList <- readTVarIO windowList + oldWindowNodeList <- readTVarIO windowNodeList + + -- Split. + ((wc1, wc2), (newWindowList, newWindowNodeList)) <- runStateT_ (oldWindowList, oldWindowNodeList) $ do + -- Get split node. + parentNode <- modifyM_ (\(wList, nList) -> do + (pNode, nnList) <- windowNodeGetSplitContainer + (windowNode windowParent) + direction + (nList, container) + return (pNode, (wList, nnList))) snd fst + + -- Create window children. + windowChild1 <- modifyM_ (windowNew TNodeLeft direction (Just parentNode) container focusNotifierList) snd fst + windowChild2 <- modifyM_ (windowNew TNodeRight direction (Just parentNode) container focusNotifierList) snd fst + + -- Remove old window from window list. + modifyFst (\(wList, _) -> windowListRemoveWindow windowParent wList) + + -- Show all widgets, this step is NECESSARY! + lift $ widgetShowAll (windowNodePaned parentNode) + + -- Set size request for window child. + nodeList <- gets snd + lift $ + -- Get size of toplevel container. + containerApplySize container $ \width height -> do + windowNodeSetSizeRequest (windowNode windowChild1) nodeList (width, height) + windowNodeSetSizeRequest (windowNode windowChild2) nodeList (width, height) + + -- Return child windows. + return (windowChild1, windowChild2) + + -- Update new value. + writeTVarIO windowList newWindowList + writeTVarIO windowNodeList newWindowNodeList + + return (wc1, wc2) + +-- | Remove window. +windowRemoveInternal :: (Window, (Container, (WindowList, WindowNodeList))) -> IO WindowListTuple +windowRemoveInternal (window, (container, (windowList, windowNodeList))) = + runStateT' (windowList, windowNodeList) $ + case windowListGetSize windowList of + -- Haven't any window exist. + 0 -> lift $ putStrLn "Haven't any window exist." + -- Otherwise remove window. + _ -> do + -- Remove window node. + modifySndM (\(_, nList) -> + windowNodeRemove (windowNode window) (nList, container) True) + + -- Remove from windowList. + modifyFst (\(wList, _) -> windowListRemoveWindow window wList) + +-- | Remove others windows except current window. +windowRemoveOthers :: Window -> WindowArgs -> IO WindowListTuple +windowRemoveOthers window (windowList, windowNodeList, container) = + runStateT' (windowList, windowNodeList) $ + case windowListGetSize windowList of + -- Don't delete window when haven't or just only one window exist. + 0 -> lift $ putStrLn "Haven't any window exist." + 1 -> lift $ putStrLn "Haven't others window exist." + -- Otherwise delete others window except current one. + _ -> do + -- Remove other window nodes. + modifySndM (\(_, nList) -> windowNodeRemoveOthers (windowNode window) (nList, container)) + + -- Remove other window from window list. + modifyFst (\(wList, _) -> windowListRemoveOthersWindow wList) + + -- Focus window. + modifyFst (\(wList, _) -> windowListFocus wList window) + +-- | Get top window container. +windowGetContainer :: Window -> Paned +windowGetContainer = windowNodePaned . windowNode + +-- | Get window id. +windowGetId :: Window -> WindowId +windowGetId = windowNodeId . windowNode + +-- | Create window list. +windowListNew :: WindowList +windowListNew = empty + +-- | Add window to window list. +windowListAddWindow :: WindowList -> Window -> WindowNodeType -> WindowList +windowListAddWindow windowList window TNodeLeft = insertLeft window windowList +windowListAddWindow windowList window _ = insertRight window windowList + +-- | Remove others window except current window from window list. +windowListRemoveOthersWindow :: WindowList -> WindowList +windowListRemoveOthersWindow windowList = + fromMaybe windowList (deleteOthers windowList) + +-- | Get current focus window. +windowListGetFocusWindow :: TVar WindowList -> TVar WindowNodeList -> TVar FocusNotifierList -> Container -> IO (Maybe Window) +windowListGetFocusWindow windowList windowNodeList focusNotifierList container = do + -- Get old value. + wList <- readTVarIO windowList + wnList <- readTVarIO windowNodeList + + -- When window list is empty, create root window. + (newWindowList, newWindowNodeList) <- windowInit (wList, wnList, container) focusNotifierList + + -- Update window list. + writeTVarIO windowList newWindowList + writeTVarIO windowNodeList newWindowNodeList + + -- Return current window. + return $ getCurrent newWindowList + +-- | Ge window with special id. +windowListGetWindow :: WindowId -> WindowList -> Maybe Window +windowListGetWindow id windowList = + find (\v -> windowNodeId (windowNode v) == id) (windowListGetList windowList) + +-- | Apply window with special id. +windowListApplyWithId :: WindowList -> WindowId -> (Window -> IO ()) -> IO () +windowListApplyWithId windowList id f = + windowListGetWindow id windowList ?>= f + +-- | Get list. +windowListGetList :: WindowList -> [Window] +windowListGetList = toList + +-- | Show window list. +windowListShow ::WindowList -> IO () +windowListShow = print . show . windowListGetList + +-- | Get window list size. +windowListGetSize :: WindowList -> Int +windowListGetSize = LZ.length + +-- | Apply window. +windowListApplyWindow :: (Window -> IO ()) -> WindowList -> IO () +windowListApplyWindow f windowList = mapM_ f $ windowListGetList windowList + +-- | Select window with given direction. +windowListSelect :: WindowListSelectDirection -> Bool -> WindowList -> WindowList +windowListSelect direction circular windowList = newWindowList + -- Get next focus function. + where selectFunction = + case direction of + VLeft -> if circular + then getLeftCircular + else getLeft + VRight -> if circular + then getRightCircular + else getRight + -- Move next focus if have it. + newWindowList = case selectFunction windowList of + Just x -> windowListFocus windowList x + Nothing -> windowList + +-- | Next window in window list. +windowListNext :: WindowList -> WindowList +windowListNext = windowListSelect VRight False + +-- | Previous window in window list. +windowListPrev :: WindowList -> WindowList +windowListPrev = windowListSelect VLeft False + +-- | Next window circular in window list. +windowListNextCircular :: WindowList -> WindowList +windowListNextCircular = windowListSelect VRight True + +-- | Previous window circular in window list. +windowListPrevCircular :: WindowList -> WindowList +windowListPrevCircular = windowListSelect VLeft True + +-- | Focus window. +windowListFocus :: WindowList -> Window -> WindowList +windowListFocus windowList window = + fromMaybe windowList (focusNode window windowList) + +-- | Focus window id. +windowListFocusId :: WindowList -> WindowId -> WindowList +windowListFocusId windowList windowId = + case windowListGetWindow windowId windowList of + Just w -> windowListFocus windowList w + Nothing -> windowList + +-- | Remove current window from window list. +windowListRemoveCurrentWindow :: WindowList -> WindowList +windowListRemoveCurrentWindow windowList = newWindowList + where + -- Get next focus. + nextFocus = getRightCircular windowList + -- Remove from window list. + wList = fromMaybe windowList (LZ.delete windowList) + -- Get new window list. + newWindowList = case nextFocus of + Just x -> windowListFocus wList x + Nothing -> wList + +-- | Remove window from window list. +windowListRemoveWindow :: Window -> WindowList -> WindowList +windowListRemoveWindow window windowList = do + let newWindowList = fromMaybe windowList $ LZ.deleteNode window windowList + + -- We need make sure focus some window + -- if have any window exist in window list. + case LZ.getCurrent newWindowList of + Just _ -> newWindowList + Nothing -> + case LZ.getRightCircular newWindowList of + Just x -> windowListFocus newWindowList x + Nothing -> newWindowList + + diff --git a/Manatee/UI/WindowNode.hs b/Manatee/UI/WindowNode.hs new file mode 100644 --- /dev/null +++ b/Manatee/UI/WindowNode.hs @@ -0,0 +1,342 @@ +-- Author: Andy Stewart +-- Maintainer: Andy Stewart +-- +-- Copyright (C) 2010 Andy Stewart, all rights reserved. +-- +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- 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 . + +module Manatee.UI.WindowNode where + +import Control.Applicative +import Control.Concurrent.STM +import Control.Monad.State +import Data.Maybe +import Graphics.UI.Gtk hiding (on, get) +import Manatee.Types +import Manatee.Toolkit.Data.SetList +import Manatee.Toolkit.General.Maybe +import Manatee.Toolkit.General.STM +import Manatee.Toolkit.General.State +import Manatee.Toolkit.Gtk.Container +import Manatee.Toolkit.Gtk.Gtk +import Text.Printf + +-- | The default zoom size. +zoomDefaultSize :: Int +zoomDefaultSize = 10 + +-- | Create new window node. +windowNodeNew :: Maybe WindowNode -> WindowNodeType -> WindowNodeDirection -> WindowNodeArgs -> IO (WindowNode, WindowNodeList) +windowNodeNew parentNode nType direction = + windowNodeNewInternal (Nothing, maybeApply parentNode windowNodeId, Nothing, Nothing, nType, direction) + +-- | Internal function for create window node. +windowNodeNewInternal :: WindowNodeAttr -> WindowNodeArgs -> IO (WindowNode, WindowNodeList) +windowNodeNewInternal (vId, pId, clId, crId, typ, direction) (windowNodeList, container) = + runStateT_ nodeList $ do + -- Create new window node. + windowNode <- lift $ WindowNode id + <$> windowNodePanedNew direction + <*> newTVarIO pId + <*> newTVarIO clId + <*> newTVarIO crId + <*> newTVarIO typ + <*> pure direction + + -- Connect current node parent. + lift $ windowNodeConnectToParent windowNode (nodeList, container) + + -- Add to window node list. + modify (`setListAddNode` windowNode) + + return windowNode + -- Init value. + where (id, nodeList) = + case vId of + Just vi -> (vi, windowNodeList) + Nothing -> setListGetNewCounter windowNodeList + +-- | Remove window node. +windowNodeRemove :: WindowNode -> WindowNodeArgs -> Bool -> IO WindowNodeList +windowNodeRemove windowNode (windowNodeList, container) removeOtioseNode = + runStateT' windowNodeList $ do + -- Get type. + vType <- lift $ windowNodeGetType windowNode + + -- Remove window node from window node list first. + modify (`setListRemoveNode` windowNode) + + -- Remove window node paned. + getM (\x -> windowNodePanedRemove windowNode (x, container)) + + -- Clean otiose nodes. + unless (vType == TNodeRoot) $ do + parentNode <- getM (windowNodeGetParentNode windowNode) + case parentNode of + Just n -> do + -- Remove current node from parent node. + lift $ windowNodeRemoveFromParentNode windowNode n + + -- Remove otiose node. + when removeOtioseNode $ do + -- Is have child node? + haveChildNode <- lift $ windowNodeIsHaveChildNode n + + -- Clean otiose node when haven't children node under current node. + unless haveChildNode $ modifyM (\x -> windowNodeRemove n (x, container) True) + +-- | Remove others window nodes except current window node. +windowNodeRemoveOthers :: WindowNode -> WindowNodeArgs -> IO WindowNodeList +windowNodeRemoveOthers windowNode (windowNodeList, container) = do + -- Change window node to root window node. + windowNodeChangeToRoot windowNode (windowNodeList, container) + containerRemoveAll container -- remove all child from root container + windowNodeConnectToRootContainer windowNode container -- add window node to root container + + -- Remove others window node from window node list. + return $ setListRemoveOthersNode windowNodeList windowNode + +-- | Get parent node of current node. +windowNodeGetParentNode :: WindowNode -> WindowNodeList -> IO (Maybe WindowNode) +windowNodeGetParentNode windowNode windowNodeList = + readTVarIO (windowNodeParentId windowNode) >>= + (?>=> (return . windowNodeListGetNode windowNodeList)) + +-- | Get split container for child window node. +windowNodeGetSplitContainer :: WindowNode -> WindowNodeDirection -> WindowNodeArgs -> IO (WindowNode, WindowNodeList) +windowNodeGetSplitContainer windowNode direction (windowNodeList, container) = + runStateT_ windowNodeList $ + if windowNodeDirection windowNode == direction + -- Return current window node if child node is same split direction. + then do + lift $ containerRemoveAll $ windowNodePaned windowNode + return windowNode + -- Otherwise, create new container node from parent node of current node. + else do + -- Remove current node first. + modifyM (\x -> windowNodeRemove windowNode (x, container) False) + + -- Create new window node from parent node. + parentNode <- getM (windowNodeGetParentNode windowNode) + vType <- lift $ windowNodeGetType windowNode + modifyM_ (\x -> windowNodeNew parentNode vType direction (x, container)) snd fst + +-- | Change window node to root node. +windowNodeChangeToRoot :: WindowNode -> WindowNodeArgs -> IO () +windowNodeChangeToRoot windowNode (windowNodeList, container) = do + -- Remove window paned from parent container. + windowNodePanedRemove windowNode (windowNodeList, container) + + -- Change window node attribute. + writeTVarIO (windowNodeParentId windowNode) Nothing + writeTVarIO (windowNodeChildLeftId windowNode) Nothing + writeTVarIO (windowNodeChildRightId windowNode) Nothing + writeTVarIO (windowNodeType windowNode) TNodeRoot + +-- | Add window node paned to parent container. +windowNodeConnectToParent :: WindowNode -> WindowNodeArgs -> IO () +windowNodeConnectToParent windowNode (windowNodeList, container) = do + vType <- windowNodeGetType windowNode + case vType of + -- Add window node to root container if it is root node. + TNodeRoot -> windowNodeConnectToRootContainer windowNode container + TNodeLeft -> windowNodeConnectToParentNodeLeft windowNode windowNodeList + TNodeRight -> windowNodeConnectToParentNodeRight windowNode windowNodeList + +-- | Add window node to root container. +windowNodeConnectToRootContainer :: ContainerClass container => WindowNode -> container -> IO () +windowNodeConnectToRootContainer windowNode = + (`containerAdd` windowNodePaned windowNode) + +-- | Add window node to parent node. +windowNodeConnectToParentNodeLeft :: WindowNode -> WindowNodeList -> IO () +windowNodeConnectToParentNodeLeft windowNode windowNodeList = + windowNodeGetParentNode windowNode windowNodeList >>= + (?>= (\n -> do + -- Add current node to other window node. + let vParentPaned = windowNodePaned n + vPaned = windowNodePaned windowNode + id = windowNodeId windowNode + panedPack1 vParentPaned vPaned True True + writeTVarIO (windowNodeChildLeftId n) (Just id))) + +-- | Add window node to parent node right. +windowNodeConnectToParentNodeRight :: WindowNode -> WindowNodeList -> IO () +windowNodeConnectToParentNodeRight windowNode windowNodeList = + windowNodeGetParentNode windowNode windowNodeList >>= + (?>= (\n -> do + -- Add current node to other window node. + let vParentPaned = windowNodePaned n + vPaned = windowNodePaned windowNode + id = windowNodeId windowNode + panedPack2 vParentPaned vPaned True True + writeTVarIO (windowNodeChildRightId n) (Just id) + )) + +-- | Get window node paned with indicate split direction. +windowNodePanedNew :: WindowNodeDirection -> IO Paned +windowNodePanedNew DVertical + = castToPaned <$> vPanedNew +windowNodePanedNew _ + = castToPaned <$> hPanedNew + +-- | Remove node paned from parent container. +windowNodePanedRemove :: WindowNode -> WindowNodeArgs -> IO () +windowNodePanedRemove windowNode (windowNodeList, container) = do + let vPaned = windowNodePaned windowNode + vType <- windowNodeGetType windowNode + + case vType of + -- Just remove from root container if current node is root node. + TNodeRoot -> container `containerRemove` vPaned + -- Otherwise, remove from parent window node. + _ -> + -- Remove paned from parent node paned. + windowNodeGetParentNode windowNode windowNodeList >>= + (?>= (\n -> windowNodePaned n `containerRemove` vPaned)) + +-- | Is haven't any child node. +windowNodeIsHaveChildNode :: WindowNode -> IO Bool +windowNodeIsHaveChildNode windowNode = do + childLeftId <- windowNodeGetChildLeftId windowNode + childRightId <- windowNodeGetChildRightId windowNode + + return $ isJust childLeftId || isJust childRightId + +-- | Remove from parent node. +windowNodeRemoveFromParentNode :: WindowNode -> WindowNode -> IO () +windowNodeRemoveFromParentNode windowNode n = do + vnType <- windowNodeGetType windowNode + case vnType of + TNodeLeft -> writeTVarIO (windowNodeChildLeftId n) Nothing + TNodeRight -> writeTVarIO (windowNodeChildRightId n) Nothing + _ -> return () + +-- | Get type. +windowNodeGetType :: WindowNode -> IO WindowNodeType +windowNodeGetType = + readTVarIO . windowNodeType + +-- | Get parent id. +windowNodeGetParentId :: WindowNode -> IO (Maybe WindowNodeId) +windowNodeGetParentId = + readTVarIO . windowNodeParentId + +-- | Get child left id. +windowNodeGetChildLeftId :: WindowNode -> IO (Maybe WindowNodeId) +windowNodeGetChildLeftId = + readTVarIO . windowNodeChildLeftId + +-- | Get child right id +windowNodeGetChildRightId :: WindowNode -> IO (Maybe WindowNodeId) +windowNodeGetChildRightId = + readTVarIO . windowNodeChildRightId + +-- | Request node size. +-- If vertical split times is `vn`, the request height is `height / (2 ^ vn)`. +-- If horizontal split times is `hn`, the request width is `width / (2 ^ hn)`. +windowNodeSetSizeRequest :: WindowNode -> WindowNodeList -> (Int, Int) -> IO () +windowNodeSetSizeRequest currentNode nodeList (width, height) = do + -- Get split times. + (vSplitTimes, hSplitTimes) <- windowNodeGetSplitTimes currentNode nodeList (0, 0) + + -- Compute size along with split times. + let requestHeight = height `div` (^) 2 vSplitTimes + requestWidth = width `div` (^) 2 hSplitTimes + + -- Set size request. + widgetSetSizeRequest (windowNodePaned currentNode) requestWidth requestHeight + +-- | Get split times of current window node. +windowNodeGetSplitTimes :: WindowNode -> WindowNodeList -> (Int, Int) -> IO (Int, Int) +windowNodeGetSplitTimes windowNode nodeList (vSplit, hSplit) = do + -- Get parent node. + parentNode <- windowNodeGetParentNode windowNode nodeList + case parentNode of + Just pn -> do + let direction = windowNodeDirection pn + splitTimes = + if direction == DVertical + -- Tick vertical split times. + then (vSplit + 1, hSplit) + -- Tick horizontal split times. + else (vSplit, hSplit + 1) + + nodeType <- readTVarIO $ windowNodeType pn + case nodeType of + -- Return split times if current node is root node. + TNodeRoot -> return splitTimes + -- Otherwise, search upper node. + _ -> windowNodeGetSplitTimes pn nodeList splitTimes + +-- | Show window node. +windowNodeShow :: WindowNode -> IO () +windowNodeShow windowNode = do + let id = windowNodeId windowNode + parentId <- windowNodeGetParentId windowNode + leftId <- windowNodeGetChildLeftId windowNode + rightId <- windowNodeGetChildRightId windowNode + printf "Node (%s) \n" (show id) (show parentId) (show leftId) (show rightId) + +-- | New window node. +windowNodeListNew :: WindowNodeList +windowNodeListNew = setListNew + +-- | Get window node with given id. +windowNodeListGetNode :: WindowNodeList -> WindowNodeId -> Maybe WindowNode +windowNodeListGetNode windowNodeList id = + setListGetNode windowNodeList (\y -> windowNodeId y == id) + +-- | Show window node list. +windowNodeListShow :: WindowNodeList -> IO () +windowNodeListShow windowNodeList = + mapM_ windowNodeShow $ setListGetList windowNodeList + +-- | Get zoom direction of window node. +windowNodeGetZoomDirection :: WindowNode -> WindowNode -> IO ZoomDirection +windowNodeGetZoomDirection node parentNode = do + nodeType <- readTVarIO $ windowNodeType node + let nodeDirection = windowNodeDirection parentNode + return $ if nodeType == TNodeRight + then if nodeDirection == DVertical then ZDown else ZRight + else if nodeDirection == DVertical then ZUp else ZLeft + +-- | Get match zoom direction. +windowNodeGetMatchZoomDirectionSize :: ZoomDirection -> Bool -> (ZoomDirection, Int) +windowNodeGetMatchZoomDirectionSize zoomDirection isEnlarge + | zoomDirection == ZUp = (ZDown, if isEnlarge then -zoomDefaultSize else zoomDefaultSize) + | zoomDirection == ZDown = (ZUp, if isEnlarge then zoomDefaultSize else -zoomDefaultSize) + | zoomDirection == ZLeft = (ZRight, if isEnlarge then -zoomDefaultSize else zoomDefaultSize) + | otherwise = (ZLeft, if isEnlarge then zoomDefaultSize else -zoomDefaultSize) + + +-- | Zoom window. +windowNodeZoom :: WindowNodeList -> WindowNode -> ZoomDirection -> Bool -> IO () +windowNodeZoom nodeList node enlargeDirection isEnlarge = do + let (matchDirection, adjustSize) = windowNodeGetMatchZoomDirectionSize enlargeDirection isEnlarge + nodeType <- readTVarIO $ windowNodeType node + case nodeType of + -- Don't do anything when reach root node. + TNodeRoot -> return () + _ -> + readTVarIO (windowNodeParentId node) + >?>= \ parentNodeId -> + setListGetNode nodeList (\x -> windowNodeId x == parentNodeId) + ?>= \ parentNode -> do + direction <- windowNodeGetZoomDirection node parentNode + if direction == matchDirection + -- Enlarge node when node direction match enlarge direction. + then panedAdjustSize (windowNodePaned parentNode) adjustSize + -- Otherwise, search parent node to enlarge. + else windowNodeZoom nodeList parentNode enlargeDirection isEnlarge diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,3 @@ +import Distribution.Simple + +main = defaultMain diff --git a/manatee.cabal b/manatee.cabal new file mode 100644 --- /dev/null +++ b/manatee.cabal @@ -0,0 +1,80 @@ +name: manatee +version: 0.0.1 +Cabal-Version: >= 1.6 +license: GPL-3 +license-file: LICENSE +copyright: (c) 2009 ~ 2010 Andy Stewart +synopsis: The Haskell/Gtk+ Integrated Live Environment +description: Manatee is Haskell integrated environment written in Haskell. + . + The goal of the Manatee project is to provide + a fast, safe and flexible integrated environment for haskell hacking. + . + You can consider it is new environment mix Gnome and Emacs. + Like Gnome to provide friendly graphics interface and work efficient like Emacs. + . + Manatee use multi-processes framework, any sub-module running in separate process to protected core won't crash. + So it minimize your losses when some unexpected exception throw in extension. + . + You can find screenshots at : http://goo.gl/MkVw + . + Below is build step for Manatee: + . + 1) Install C library: + In Debian use below command: + . + > sudo aptitude install libgtksourceview2.0-dev libgconf2-dev libwebkit-dev libcurl4-openssl-dev libgtkimageview-dev libpoppler-glib-dev poppler-data libtagc0-dev -y + . + 2) Install Gtk2hs: + . + > cabal install gtk2hs-buildtools gtk + . + And make sure HOME/.cabal/bin/ in your PATH. + . + 3) Install Manatee: + . + > cabal install manatee-core manatee-anything manatee-browser manatee-editor manatee-filemanager manatee-imageviewer manatee-ircclient manatee-mplayer manatee-pdfviewer manatee-processmanager manatee-reader manatee + . + That's all, then type command "manatee" to play it! :) + . +author: Andy Stewart +maintainer: Andy Stewart +stability: provisional +category: Manatee, Operating System, Desktop Environment, IDE + +tested-with: GHC==6.12.3 +build-type: Simple +extra-source-files: repos.sh + +Source-Repository head + type: darcs + location: http://patch-tag.com/r/AndyStewart/manatee + +library + exposed-modules: + Manatee.Daemon + Manatee.Environment + Manatee.Types + + Manatee.Action.Window + Manatee.Action.Tab + Manatee.Action.Basic + Manatee.Action.Tabbar + Manatee.Action.BufferList + + Manatee.UI.FocusNotifier + Manatee.UI.Frame + Manatee.UI.UIFrame + Manatee.UI.Window + Manatee.UI.WindowNode + + other-modules: + +executable manatee + build-depends: base >=4 && < 5, manatee-core >= 0.0.1, containers >= 0.3.0.0, unix >= 2.4.0.0, + mtl >= 1.1.0.2, gtk-serialized-event >= 0.12.0, text >= 0.7.1.0, utf8-string, + gtk >= 0.12.0, dbus-client >= 0.3 && < 0.4, + stm, cairo >= 0.12.0, directory, dbus-core, template-haskell + main-is: Main.hs + ghc-options: -fwarn-unused-matches -fwarn-unused-binds -fwarn-unused-imports -fwarn-overlapping-patterns -fwarn-duplicate-exports -threaded -fwarn-unrecognised-pragmas -fwarn-hi-shadowing + diff --git a/repos.sh b/repos.sh new file mode 100644 --- /dev/null +++ b/repos.sh @@ -0,0 +1,62 @@ +#!/bin/sh + +set -e + +USAGE="Usage: `basename $0` (get|pull|install|diff|record|revert|push|pushall|send|clean|whatsnew|changes|release) [pkg] .." + +[ $# -lt 1 ] && echo $USAGE && exit 1 + +DIR=$PWD/`dirname $0` +CMD=$1 + +shift + +repos_action () { + PKG=$1 + echo == $PKG == + if [ ! -d "$DIR/../$PKG" -a ! $CMD = 'get' ]; then + echo "$PKG is missing." + echo "Please run \"`basename $0` get $PKG\" first." + exit 1 + fi + if [ ! $CMD = 'get' ]; then + cd $DIR/../$PKG + else + cd $DIR/.. + fi + case $CMD in + clean) cabal clean + ;; + install) cabal install + ;; + diff) darcs diff -u + ;; + get) [ -d "$PKG" ] || darcs get http://patch-tag.com/r/AndyStewart/$PKG + ;; + pull) darcs pull + ;; + push) darcs push AndyStewart@patch-tag.com:/r/AndyStewart/$PKG + ;; + pushall) darcs push AndyStewart@patch-tag.com:/r/AndyStewart/$PKG -a + ;; + record) darcs record -l + ;; + revert) darcs revert + ;; + send) darcs send -O + ;; + whatsnew) darcs whatsnew -s + ;; + changes) darcs changes --last 10 + ;; + release) rm ./dist/*.tar.gz && cabal sdist && cabal upload ./dist/*.tar.gz + ;; + *) echo "Unknown command: $CMD"; echo $USAGE; exit 1 + ;; + esac +} + +for pkg in ${*:-manatee-core manatee-anything manatee-browser manatee-editor manatee-filemanager manatee-pdfviewer manatee-mplayer manatee-ircclient manatee-processmanager manatee-imageviewer manatee-reader manatee}; +do + repos_action $pkg +done