packages feed

vision (empty) → 0.0.2.2

raw patch · 66 files changed

+8577/−0 lines, 66 filesdep +MonadCatchIO-mtldep +arraydep +basesetup-changed

Dependencies added: MonadCatchIO-mtl, array, base, containers, directory, filepath, glib, gtk, json, mtl, parsec, utf8-string, xmms2-client, xmms2-client-glib

Files

+ COPYING view
@@ -0,0 +1,676 @@++		    GNU GENERAL PUBLIC LICENSE+		       Version 3, 29 June 2007++ Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++			    Preamble++  The GNU General Public License is a free, copyleft license for+software and other kinds of works.++  The licenses for most software and other practical works are designed+to take away your freedom to share and change the works.  By contrast,+the GNU General Public License is intended to guarantee your freedom to+share and change all versions of a program--to make sure it remains free+software for all its users.  We, the Free Software Foundation, use the+GNU General Public License for most of our software; it applies also to+any other work released this way by its authors.  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+them if you wish), that you receive source code or can get it if you+want it, that you can change the software or use pieces of it in new+free programs, and that you know you can do these things.++  To protect your rights, we need to prevent others from denying you+these rights or asking you to surrender the rights.  Therefore, you have+certain responsibilities if you distribute copies of the software, or if+you modify it: responsibilities to respect the freedom of others.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must pass on to the recipients the same+freedoms that you received.  You must make sure that they, too, receive+or can get the source code.  And you must show them these terms so they+know their rights.++  Developers that use the GNU GPL protect your rights with two steps:+(1) assert copyright on the software, and (2) offer you this License+giving you legal permission to copy, distribute and/or modify it.++  For the developers' and authors' protection, the GPL clearly explains+that there is no warranty for this free software.  For both users' and+authors' sake, the GPL requires that modified versions be marked as+changed, so that their problems will not be attributed erroneously to+authors of previous versions.++  Some devices are designed to deny users access to install or run+modified versions of the software inside them, although the manufacturer+can do so.  This is fundamentally incompatible with the aim of+protecting users' freedom to change the software.  The systematic+pattern of such abuse occurs in the area of products for individuals to+use, which is precisely where it is most unacceptable.  Therefore, we+have designed this version of the GPL to prohibit the practice for those+products.  If such problems arise substantially in other domains, we+stand ready to extend this provision to those domains in future versions+of the GPL, as needed to protect the freedom of users.++  Finally, every program is threatened constantly by software patents.+States should not allow patents to restrict development and use of+software on general-purpose computers, but in those that do, we wish to+avoid the special danger that patents applied to a free program could+make it effectively proprietary.  To prevent this, the GPL assures that+patents cannot be used to render the program non-free.++  The precise terms and conditions for copying, distribution and+modification follow.++		       TERMS AND CONDITIONS++  0. Definitions.++  "This License" refers to version 3 of the GNU General Public License.++  "Copyright" also means copyright-like laws that apply to other kinds of+works, such as semiconductor masks.+ +  "The Program" refers to any copyrightable work licensed under this+License.  Each licensee is addressed as "you".  "Licensees" and+"recipients" may be individuals or organizations.++  To "modify" a work means to copy from or adapt all or part of the work+in a fashion requiring copyright permission, other than the making of an+exact copy.  The resulting work is called a "modified version" of the+earlier work or a work "based on" the earlier work.++  A "covered work" means either the unmodified Program or a work based+on the Program.++  To "propagate" a work means to do anything with it that, without+permission, would make you directly or secondarily liable for+infringement under applicable copyright law, except executing it on a+computer or modifying a private copy.  Propagation includes copying,+distribution (with or without modification), making available to the+public, and in some countries other activities as well.++  To "convey" a work means any kind of propagation that enables other+parties to make or receive copies.  Mere interaction with a user through+a computer network, with no transfer of a copy, is not conveying.++  An interactive user interface displays "Appropriate Legal Notices"+to the extent that it includes a convenient and prominently visible+feature that (1) displays an appropriate copyright notice, and (2)+tells the user that there is no warranty for the work (except to the+extent that warranties are provided), that licensees may convey the+work under this License, and how to view a copy of this License.  If+the interface presents a list of user commands or options, such as a+menu, a prominent item in the list meets this criterion.++  1. Source Code.++  The "source code" for a work means the preferred form of the work+for making modifications to it.  "Object code" means any non-source+form of a work.++  A "Standard Interface" means an interface that either is an official+standard defined by a recognized standards body, or, in the case of+interfaces specified for a particular programming language, one that+is widely used among developers working in that language.++  The "System Libraries" of an executable work include anything, other+than the work as a whole, that (a) is included in the normal form of+packaging a Major Component, but which is not part of that Major+Component, and (b) serves only to enable use of the work with that+Major Component, or to implement a Standard Interface for which an+implementation is available to the public in source code form.  A+"Major Component", in this context, means a major essential component+(kernel, window system, and so on) of the specific operating system+(if any) on which the executable work runs, or a compiler used to+produce the work, or an object code interpreter used to run it.++  The "Corresponding Source" for a work in object code form means all+the source code needed to generate, install, and (for an executable+work) run the object code and to modify the work, including scripts to+control those activities.  However, it does not include the work's+System Libraries, or general-purpose tools or generally available free+programs which are used unmodified in performing those activities but+which are not part of the work.  For example, Corresponding Source+includes interface definition files associated with source files for+the work, and the source code for shared libraries and dynamically+linked subprograms that the work is specifically designed to require,+such as by intimate data communication or control flow between those+subprograms and other parts of the work.++  The Corresponding Source need not include anything that users+can regenerate automatically from other parts of the Corresponding+Source.++  The Corresponding Source for a work in source code form is that+same work.++  2. Basic Permissions.++  All rights granted under this License are granted for the term of+copyright on the Program, and are irrevocable provided the stated+conditions are met.  This License explicitly affirms your unlimited+permission to run the unmodified Program.  The output from running a+covered work is covered by this License only if the output, given its+content, constitutes a covered work.  This License acknowledges your+rights of fair use or other equivalent, as provided by copyright law.++  You may make, run and propagate covered works that you do not+convey, without conditions so long as your license otherwise remains+in force.  You may convey covered works to others for the sole purpose+of having them make modifications exclusively for you, or provide you+with facilities for running those works, provided that you comply with+the terms of this License in conveying all material for which you do+not control copyright.  Those thus making or running the covered works+for you must do so exclusively on your behalf, under your direction+and control, on terms that prohibit them from making any copies of+your copyrighted material outside their relationship with you.++  Conveying under any other circumstances is permitted solely under+the conditions stated below.  Sublicensing is not allowed; section 10+makes it unnecessary.++  3. Protecting Users' Legal Rights From Anti-Circumvention Law.++  No covered work shall be deemed part of an effective technological+measure under any applicable law fulfilling obligations under article+11 of the WIPO copyright treaty adopted on 20 December 1996, or+similar laws prohibiting or restricting circumvention of such+measures.++  When you convey a covered work, you waive any legal power to forbid+circumvention of technological measures to the extent such circumvention+is effected by exercising rights under this License with respect to+the covered work, and you disclaim any intention to limit operation or+modification of the work as a means of enforcing, against the work's+users, your or third parties' legal rights to forbid circumvention of+technological measures.++  4. Conveying Verbatim Copies.++  You may convey verbatim copies of the Program's source code as you+receive it, in any medium, provided that you conspicuously and+appropriately publish on each copy an appropriate copyright notice;+keep intact all notices stating that this License and any+non-permissive terms added in accord with section 7 apply to the code;+keep intact all notices of the absence of any warranty; and give all+recipients a copy of this License along with the Program.++  You may charge any price or no price for each copy that you convey,+and you may offer support or warranty protection for a fee.++  5. Conveying Modified Source Versions.++  You may convey a work based on the Program, or the modifications to+produce it from the Program, in the form of source code under the+terms of section 4, provided that you also meet all of these conditions:++    a) The work must carry prominent notices stating that you modified+    it, and giving a relevant date.++    b) The work must carry prominent notices stating that it is+    released under this License and any conditions added under section+    7.  This requirement modifies the requirement in section 4 to+    "keep intact all notices".++    c) You must license the entire work, as a whole, under this+    License to anyone who comes into possession of a copy.  This+    License will therefore apply, along with any applicable section 7+    additional terms, to the whole of the work, and all its parts,+    regardless of how they are packaged.  This License gives no+    permission to license the work in any other way, but it does not+    invalidate such permission if you have separately received it.++    d) If the work has interactive user interfaces, each must display+    Appropriate Legal Notices; however, if the Program has interactive+    interfaces that do not display Appropriate Legal Notices, your+    work need not make them do so.++  A compilation of a covered work with other separate and independent+works, which are not by their nature extensions of the covered work,+and which are not combined with it such as to form a larger program,+in or on a volume of a storage or distribution medium, is called an+"aggregate" if the compilation and its resulting copyright are not+used to limit the access or legal rights of the compilation's users+beyond what the individual works permit.  Inclusion of a covered work+in an aggregate does not cause this License to apply to the other+parts of the aggregate.++  6. Conveying Non-Source Forms.++  You may convey a covered work in object code form under the terms+of sections 4 and 5, provided that you also convey the+machine-readable Corresponding Source under the terms of this License,+in one of these ways:++    a) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by the+    Corresponding Source fixed on a durable physical medium+    customarily used for software interchange.++    b) Convey the object code in, or embodied in, a physical product+    (including a physical distribution medium), accompanied by a+    written offer, valid for at least three years and valid for as+    long as you offer spare parts or customer support for that product+    model, to give anyone who possesses the object code either (1) a+    copy of the Corresponding Source for all the software in the+    product that is covered by this License, on a durable physical+    medium customarily used for software interchange, for a price no+    more than your reasonable cost of physically performing this+    conveying of source, or (2) access to copy the+    Corresponding Source from a network server at no charge.++    c) Convey individual copies of the object code with a copy of the+    written offer to provide the Corresponding Source.  This+    alternative is allowed only occasionally and noncommercially, and+    only if you received the object code with such an offer, in accord+    with subsection 6b.++    d) Convey the object code by offering access from a designated+    place (gratis or for a charge), and offer equivalent access to the+    Corresponding Source in the same way through the same place at no+    further charge.  You need not require recipients to copy the+    Corresponding Source along with the object code.  If the place to+    copy the object code is a network server, the Corresponding Source+    may be on a different server (operated by you or a third party)+    that supports equivalent copying facilities, provided you maintain+    clear directions next to the object code saying where to find the+    Corresponding Source.  Regardless of what server hosts the+    Corresponding Source, you remain obligated to ensure that it is+    available for as long as needed to satisfy these requirements.++    e) Convey the object code using peer-to-peer transmission, provided+    you inform other peers where the object code and Corresponding+    Source of the work are being offered to the general public at no+    charge under subsection 6d.++  A separable portion of the object code, whose source code is excluded+from the Corresponding Source as a System Library, need not be+included in conveying the object code work.++  A "User Product" is either (1) a "consumer product", which means any+tangible personal property which is normally used for personal, family,+or household purposes, or (2) anything designed or sold for incorporation+into a dwelling.  In determining whether a product is a consumer product,+doubtful cases shall be resolved in favor of coverage.  For a particular+product received by a particular user, "normally used" refers to a+typical or common use of that class of product, regardless of the status+of the particular user or of the way in which the particular user+actually uses, or expects or is expected to use, the product.  A product+is a consumer product regardless of whether the product has substantial+commercial, industrial or non-consumer uses, unless such uses represent+the only significant mode of use of the product.++  "Installation Information" for a User Product means any methods,+procedures, authorization keys, or other information required to install+and execute modified versions of a covered work in that User Product from+a modified version of its Corresponding Source.  The information must+suffice to ensure that the continued functioning of the modified object+code is in no case prevented or interfered with solely because+modification has been made.++  If you convey an object code work under this section in, or with, or+specifically for use in, a User Product, and the conveying occurs as+part of a transaction in which the right of possession and use of the+User Product is transferred to the recipient in perpetuity or for a+fixed term (regardless of how the transaction is characterized), the+Corresponding Source conveyed under this section must be accompanied+by the Installation Information.  But this requirement does not apply+if neither you nor any third party retains the ability to install+modified object code on the User Product (for example, the work has+been installed in ROM).++  The requirement to provide Installation Information does not include a+requirement to continue to provide support service, warranty, or updates+for a work that has been modified or installed by the recipient, or for+the User Product in which it has been modified or installed.  Access to a+network may be denied when the modification itself materially and+adversely affects the operation of the network or violates the rules and+protocols for communication across the network.++  Corresponding Source conveyed, and Installation Information provided,+in accord with this section must be in a format that is publicly+documented (and with an implementation available to the public in+source code form), and must require no special password or key for+unpacking, reading or copying.++  7. Additional Terms.++  "Additional permissions" are terms that supplement the terms of this+License by making exceptions from one or more of its conditions.+Additional permissions that are applicable to the entire Program shall+be treated as though they were included in this License, to the extent+that they are valid under applicable law.  If additional permissions+apply only to part of the Program, that part may be used separately+under those permissions, but the entire Program remains governed by+this License without regard to the additional permissions.++  When you convey a copy of a covered work, you may at your option+remove any additional permissions from that copy, or from any part of+it.  (Additional permissions may be written to require their own+removal in certain cases when you modify the work.)  You may place+additional permissions on material, added by you to a covered work,+for which you have or can give appropriate copyright permission.++  Notwithstanding any other provision of this License, for material you+add to a covered work, you may (if authorized by the copyright holders of+that material) supplement the terms of this License with terms:++    a) Disclaiming warranty or limiting liability differently from the+    terms of sections 15 and 16 of this License; or++    b) Requiring preservation of specified reasonable legal notices or+    author attributions in that material or in the Appropriate Legal+    Notices displayed by works containing it; or++    c) Prohibiting misrepresentation of the origin of that material, or+    requiring that modified versions of such material be marked in+    reasonable ways as different from the original version; or++    d) Limiting the use for publicity purposes of names of licensors or+    authors of the material; or++    e) Declining to grant rights under trademark law for use of some+    trade names, trademarks, or service marks; or++    f) Requiring indemnification of licensors and authors of that+    material by anyone who conveys the material (or modified versions of+    it) with contractual assumptions of liability to the recipient, for+    any liability that these contractual assumptions directly impose on+    those licensors and authors.++  All other non-permissive additional terms are considered "further+restrictions" within the meaning of section 10.  If the Program as you+received it, or any part of it, contains a notice stating that it is+governed by this License along with a term that is a further+restriction, you may remove that term.  If a license document contains+a further restriction but permits relicensing or conveying under this+License, you may add to a covered work material governed by the terms+of that license document, provided that the further restriction does+not survive such relicensing or conveying.++  If you add terms to a covered work in accord with this section, you+must place, in the relevant source files, a statement of the+additional terms that apply to those files, or a notice indicating+where to find the applicable terms.++  Additional terms, permissive or non-permissive, may be stated in the+form of a separately written license, or stated as exceptions;+the above requirements apply either way.++  8. Termination.++  You may not propagate or modify a covered work except as expressly+provided under this License.  Any attempt otherwise to propagate or+modify it is void, and will automatically terminate your rights under+this License (including any patent licenses granted under the third+paragraph of section 11).++  However, if you cease all violation of this License, then your+license from a particular copyright holder is reinstated (a)+provisionally, unless and until the copyright holder explicitly and+finally terminates your license, and (b) permanently, if the copyright+holder fails to notify you of the violation by some reasonable means+prior to 60 days after the cessation.++  Moreover, your license from a particular copyright holder is+reinstated permanently if the copyright holder notifies you of the+violation by some reasonable means, this is the first time you have+received notice of violation of this License (for any work) from that+copyright holder, and you cure the violation prior to 30 days after+your receipt of the notice.++  Termination of your rights under this section does not terminate the+licenses of parties who have received copies or rights from you under+this License.  If your rights have been terminated and not permanently+reinstated, you do not qualify to receive new licenses for the same+material under section 10.++  9. Acceptance Not Required for Having Copies.++  You are not required to accept this License in order to receive or+run a copy of the Program.  Ancillary propagation of a covered work+occurring solely as a consequence of using peer-to-peer transmission+to receive a copy likewise does not require acceptance.  However,+nothing other than this License grants you permission to propagate or+modify any covered work.  These actions infringe copyright if you do+not accept this License.  Therefore, by modifying or propagating a+covered work, you indicate your acceptance of this License to do so.++  10. Automatic Licensing of Downstream Recipients.++  Each time you convey a covered work, the recipient automatically+receives a license from the original licensors, to run, modify and+propagate that work, subject to this License.  You are not responsible+for enforcing compliance by third parties with this License.++  An "entity transaction" is a transaction transferring control of an+organization, or substantially all assets of one, or subdividing an+organization, or merging organizations.  If propagation of a covered+work results from an entity transaction, each party to that+transaction who receives a copy of the work also receives whatever+licenses to the work the party's predecessor in interest had or could+give under the previous paragraph, plus a right to possession of the+Corresponding Source of the work from the predecessor in interest, if+the predecessor has it or can get it with reasonable efforts.++  You may not impose any further restrictions on the exercise of the+rights granted or affirmed under this License.  For example, you may+not impose a license fee, royalty, or other charge for exercise of+rights granted under this License, and you may not initiate litigation+(including a cross-claim or counterclaim in a lawsuit) alleging that+any patent claim is infringed by making, using, selling, offering for+sale, or importing the Program or any portion of it.++  11. Patents.++  A "contributor" is a copyright holder who authorizes use under this+License of the Program or a work on which the Program is based.  The+work thus licensed is called the contributor's "contributor version".++  A contributor's "essential patent claims" are all patent claims+owned or controlled by the contributor, whether already acquired or+hereafter acquired, that would be infringed by some manner, permitted+by this License, of making, using, or selling its contributor version,+but do not include claims that would be infringed only as a+consequence of further modification of the contributor version.  For+purposes of this definition, "control" includes the right to grant+patent sublicenses in a manner consistent with the requirements of+this License.++  Each contributor grants you a non-exclusive, worldwide, royalty-free+patent license under the contributor's essential patent claims, to+make, use, sell, offer for sale, import and otherwise run, modify and+propagate the contents of its contributor version.++  In the following three paragraphs, a "patent license" is any express+agreement or commitment, however denominated, not to enforce a patent+(such as an express permission to practice a patent or covenant not to+sue for patent infringement).  To "grant" such a patent license to a+party means to make such an agreement or commitment not to enforce a+patent against the party.++  If you convey a covered work, knowingly relying on a patent license,+and the Corresponding Source of the work is not available for anyone+to copy, free of charge and under the terms of this License, through a+publicly available network server or other readily accessible means,+then you must either (1) cause the Corresponding Source to be so+available, or (2) arrange to deprive yourself of the benefit of the+patent license for this particular work, or (3) arrange, in a manner+consistent with the requirements of this License, to extend the patent+license to downstream recipients.  "Knowingly relying" means you have+actual knowledge that, but for the patent license, your conveying the+covered work in a country, or your recipient's use of the covered work+in a country, would infringe one or more identifiable patents in that+country that you have reason to believe are valid.+  +  If, pursuant to or in connection with a single transaction or+arrangement, you convey, or propagate by procuring conveyance of, a+covered work, and grant a patent license to some of the parties+receiving the covered work authorizing them to use, propagate, modify+or convey a specific copy of the covered work, then the patent license+you grant is automatically extended to all recipients of the covered+work and works based on it.++  A patent license is "discriminatory" if it does not include within+the scope of its coverage, prohibits the exercise of, or is+conditioned on the non-exercise of one or more of the rights that are+specifically granted under this License.  You may not convey a covered+work if you are a party to an arrangement with a third party that is+in the business of distributing software, under which you make payment+to the third party based on the extent of your activity of conveying+the work, and under which the third party grants, to any of the+parties who would receive the covered work from you, a discriminatory+patent license (a) in connection with copies of the covered work+conveyed by you (or copies made from those copies), or (b) primarily+for and in connection with specific products or compilations that+contain the covered work, unless you entered into that arrangement,+or that patent license was granted, prior to 28 March 2007.++  Nothing in this License shall be construed as excluding or limiting+any implied license or other defenses to infringement that may+otherwise be available to you under applicable patent law.++  12. No Surrender of Others' Freedom.++  If conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot convey a+covered work so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you may+not convey it at all.  For example, if you agree to terms that obligate you+to collect a royalty for further conveying from those to whom you convey+the Program, the only way you could satisfy both those terms and this+License would be to refrain entirely from conveying the Program.++  13. Use with the GNU Affero General Public License.++  Notwithstanding any other provision of this License, you have+permission to link or combine any covered work with a work licensed+under version 3 of the GNU Affero General Public License into a single+combined work, and to convey the resulting work.  The terms of this+License will continue to apply to the part which is the covered work,+but the special requirements of the GNU Affero General Public License,+section 13, concerning interaction through a network will apply to the+combination as such.++  14. Revised Versions of this License.++  The Free Software Foundation may publish revised and/or new versions of+the GNU General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++  Each version is given a distinguishing version number.  If the+Program specifies that a certain numbered version of the GNU General+Public License "or any later version" applies to it, you have the+option of following the terms and conditions either of that numbered+version or of any later version published by the Free Software+Foundation.  If the Program does not specify a version number of the+GNU General Public License, you may choose any version ever published+by the Free Software Foundation.++  If the Program specifies that a proxy can decide which future+versions of the GNU General Public License can be used, that proxy's+public statement of acceptance of a version permanently authorizes you+to choose that version for the Program.++  Later license versions may give you additional or different+permissions.  However, no additional obligations are imposed on any+author or copyright holder as a result of your choosing to follow a+later version.++  15. Disclaimer of Warranty.++  THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY+APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR+PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM+IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.++  16. Limitation of Liability.++  IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF+SUCH DAMAGES.++  17. Interpretation of Sections 15 and 16.++  If the disclaimer of warranty and limitation of liability provided+above cannot be given local legal effect according to their terms,+reviewing courts shall apply local law that most closely approximates+an absolute waiver of all civil liability in connection with the+Program, unless a warranty or assumption of liability accompanies a+copy of the Program in return for a fee.++		     END OF TERMS AND CONDITIONS++	    How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+state the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <one line to give the program's name and a brief idea of what it does.>+    Copyright (C) <year>  <name of author>++    This program is free software: you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation, either version 3 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program.  If not, see <http://www.gnu.org/licenses/>.++Also add information on how to contact you by electronic and paper mail.++  If the program does terminal interaction, make it output a short+notice like this when it starts in an interactive mode:++    <program>  Copyright (C) <year>  <name of author>+    This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, your program's commands+might be different; for a GUI interface, you would use an "about box".++  You should also get your employer (if you work as a programmer) or school,+if any, to sign a "copyright disclaimer" for the program, if necessary.+For more information on this, and how to apply and follow the GNU GPL, see+<http://www.gnu.org/licenses/>.++  The GNU General Public License does not permit incorporating your program+into proprietary programs.  If your program is a subroutine library, you+may consider it more useful to permit linking proprietary applications with+the library.  If this is what you want to do, use the GNU Lesser General+Public License instead of this License.  But first, please read+<http://www.gnu.org/philosophy/why-not-lgpl.html>.+
+ Setup.hs view
@@ -0,0 +1,4 @@+#! /usr/bin/env runhaskell+import Distribution.Simple+main = defaultMainWithHooks autoconfUserHooks+
+ src/Atoms.hs view
@@ -0,0 +1,34 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 21 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Atoms+  ( xmms2PosList+  , xmms2MlibId+  , propPosList+  , mlibIdClipboard+  ) where++import Graphics.UI.Gtk+import System.IO.Unsafe+++xmms2PosList    = unsafePerformIO $ atomNew "application/x-xmms2poslist"+xmms2MlibId     = unsafePerformIO $ atomNew "application/x-xmms2mlibid"+propPosList     = unsafePerformIO $ atomNew "application/x-visionpropposlist"+mlibIdClipboard = unsafePerformIO $ atomNew "_VISION_MEDIAID_CLIPBOARD"
+ src/Clipboard.hs view
@@ -0,0 +1,92 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 26 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Clipboard+  ( initClipboard+  , clipboard+  , onClipboardTargets+  , getClipboardTargets+  ) where++import Control.Concurrent.MVar+import Control.Monad++import Data.Maybe++import Graphics.UI.Gtk hiding (Clipboard)+import qualified Graphics.UI.Gtk as G++import Context+import Handler+import Utils+++data State+  = State { sTargets :: [TargetTag] }++makeState =+  State { sTargets = [] }++data Clipboard+  = Clipboard { cState              :: MVar State+              , cClipboard          :: G.Clipboard+              , cOnClipboardTargets :: HandlerMVar ()+              }++state = cState context++clipboard = cClipboard context++onClipboardTargets = onHandler $ cOnClipboardTargets context++getClipboardTargets = withMVar state $ return . sTargets++updateClipboardTargets targets = do+  let targets' = fromMaybe [] targets+  modifyMVar state $ \state ->+    return (state { sTargets = targets' }, sTargets state /= targets')+++initClipboard = do+  context <- initContext+  let ?context = context++  timeoutAdd checkClipboard 0++  return ?context+++initContext = do+  state              <- newMVar makeState+  clipboard          <- clipboardGet selectionClipboard+  onClipboardTargets <- makeHandlerMVar+  return $ augmentContext+    Clipboard { cState              = state+              , cClipboard          = clipboard+              , cOnClipboardTargets = onClipboardTargets+              }++checkClipboard = do+  clipboard <- clipboardGet selectionClipboard+  clipboardRequestTargets clipboard $ \targets -> do+    changed <- updateClipboardTargets targets+    when changed $ onClipboardTargets $ invoke ()+    timeoutAdd checkClipboard 250+    return ()+  return False
+ src/Collection.hs view
@@ -0,0 +1,64 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 14 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Collection+  ( initCollection+  , browseCollection+  ) where++import Graphics.UI.Gtk++import UI+import Collection.Common+import Collection.List+import Collection.Model+import Collection.View+import Collection.Control+import Collection.UI+++initCollection = do+  context <- initCommon+  let ?context = context++  context <- initList+  let ?context = context++  return ?context+++browseCollection maybeName = do+  let f = browseCollection++  context <- initUI+  let ?context = context++  context <- initModel+  let ?context = context++  context <- initView+  let ?context = context++  context <- initCollectionUI f+  let ?context = context++  widgetShowAll window+  case maybeName of+    Just name -> loadNamed name+    Nothing   -> widgetGrabFocus collFilter
+ src/Collection/Common.hs view
@@ -0,0 +1,39 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 14 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Collection.Common+  ( initCommon+  , universe+  ) where++import XMMS2.Client++import Context+++data Common+  = Common { cUniverse :: Coll }++universe = cUniverse context+++initCommon = do+  universe <- collUniverse+  return $ augmentContext+    Common { cUniverse = universe }
+ src/Collection/Control.hs view
@@ -0,0 +1,269 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Collection.Control+  ( loadSelected+  , loadNamed+  , loadCurrent+  , browseSelected+  , addToPlaylist+  , collAddToPlaylist+  , listAddToPlaylist+  , applyFilter+  , editFilter+  , allMedia+  , saveCollection+  , renameCollection+  , removeCollection+  , updateWindowTitle+  , editCopy+  , editSelectAll+  , editInvertSelection+  , showPropertyEditor+  , showPropertyExport+  , getOrder+  , setOrder+  ) where++import Prelude hiding (catch)+import Control.Monad.CatchIO+import Control.Monad+import Control.Monad.Trans+import Control.Applicative++import Data.Maybe++import Graphics.UI.Gtk++import XMMS2.Client++import XMMS+import Utils+import UI+import Atoms+import Clipboard+import qualified Properties as P+import Collection.Common+import Collection.Model hiding (setOrder)+import qualified Collection.Model as Model+import Collection.View+import Collection.List.View+++loadSelected = do+  maybeName <- getSelectedCollection+  case maybeName of+    Just name ->+      loadNamed name+    Nothing   -> do+      setCurColl universe ""+      loadCurrent++loadNamed name =+  collGet xmms name "Collections" >>* do+    coll <- result+    liftIO $ do+      setCurColl coll name+      loadCurrent+    return False++setOrder order = do+  Model.setOrder True order+  loaded <- getLoaded+  when loaded loadCurrent++loadCurrent =+  loadCurrent' `catch` \ParseError -> return ()++loadCurrent' = do+  text <- trim <$> entryGetText collFilter+  entrySetText collFilter text+  setFilter text+  coll <- getCurColl+  keys <- getOrderKeys+  collQueryIds xmms coll keys 0 0 >>* do+    ids <- result+    liftIO $ do+      setLoaded True+      updateWindowTitle+      populateModel ids+      widgetGrabFocus collView+    return False++browseSelected browse =+  browse =<< getSelectedCollection+++addToPlaylist replace = do+  list <- widgetGetIsFocus listView+  if list+    then listAddToPlaylist replace+    else do+    coll <- widgetGetIsFocus collView+    when coll $ collAddToPlaylist replace++collAddToPlaylist replace =+  add `catch` \ParseError -> return ()+  where add = do+          ids <- getSelectedIds+          cur <- getCurColl+          sel <- collNewIdlist ids+          int <- collNew TypeIntersection+          collAddOperand int cur+          collAddOperand int sel+          addCollection replace int++listAddToPlaylist replace = do+  maybeName <- getSelectedCollection+  case maybeName of+    Nothing   -> addCollection replace universe+    Just name -> collGet xmms name "Collections" >>* do+      coll <- result+      liftIO $ addCollection replace coll+      return False++addCollection replace coll = do+  when replace $ playlistClear xmms Nothing >> return ()+  playlistAddCollection xmms Nothing coll =<< getOrderKeys+  return ()++getSelectedIds =+  mapM (listStoreGetValue collStore . head)+  =<< treeSelectionGetSelectedRows collSel++applyFilter = do+  conn <- connected+  when conn loadCurrent++editFilter = do+  editableSelectRegion collFilter 0 (-1)+  widgetGrabFocus collFilter++allMedia = do+  resetModel+  resetListView+  entrySetText collFilter ""+  widgetGrabFocus collFilter+  updateWindowTitle++saveCollection = do+  name <- trim <$> getCurName+  coll <- getCurColl+  res  <- runDlg "Save collection" (not $ null name) (const True) name+  fmaybeM_ res $ \name -> do+    collSave xmms coll name "Collections"+    return ()++renameCollection = do+  old <- fromJust <$> getSelectedCollection+  res <- runDlg "Rename collection" False (/= old) old+  fmaybeM_ res $ \new -> do+    collRename xmms old new "Collections"+    return ()++removeCollection = do+  name <- fromJust <$> getSelectedCollection+  collRemove xmms name "Collections"+  return ()++runDlg title enable isOk init = do+  dialog <- dialogNew+  windowSetTitle dialog title+  windowSetTransientFor dialog window+  windowSetModal dialog True+  windowGroupAddWindow windowGroup dialog++  dialogSetHasSeparator dialog False+  dialogAddButton dialog "gtk-cancel" ResponseCancel+  dialogAddButtonCR dialog "gtk-ok" ResponseOk+  dialogSetDefaultResponse dialog ResponseOk+  dialogSetResponseSensitive dialog ResponseOk enable++  box <- vBoxNew False 0+  containerSetBorderWidth box 7+  upper <- dialogGetUpper dialog+  containerAdd upper box++  entry <- entryNew+  entrySetText entry init+  editableSelectRegion entry 0 (-1)+  editableSetPosition entry (-1)+  boxPackStart box entry PackNatural 0++  let ok = do+        new <- trim <$> entryGetText entry+        return $ not (null new) && isOk new+      check = dialogSetResponseSensitive dialog ResponseOk =<< ok+      checkInsert str pos = check >> return (length str + pos)+      checkDelete _ _     = check+  entry `onEntryActivate` do+    ok <- ok+    when ok $ dialogResponse dialog ResponseOk+  entry `afterInsertText` checkInsert+  entry `afterDeleteText` checkDelete++  widgetShowAll dialog+  resp <- dialogRun dialog+  new  <- trim <$> entryGetText entry+  widgetDestroy dialog++  return $ case resp of+    ResponseOk -> Just new+    _          -> Nothing++updateWindowTitle = do+  name   <- getCurName+  loaded <- getLoaded+  filter <- getFilter+  let t = if loaded then f ++ n ++ " - " else ""+      n = case name of+        "" -> "All media"+        _  -> name+      f = if null filter then "" else "*"+  setWindowTitle $ t ++ "Vision collection browser"++editCopy = do+  ids <- getSelectedIds+  clipboardSetWithData clipboard+    [(xmms2MlibId, 0)]+    (const $ selectionDataSet selectionTypeInteger ids)+    (return ())+  return ()++editSelectAll =+  treeSelectionSelectAll collSel++editInvertSelection = do+  rows <- treeSelectionGetSelectedRows collSel+  treeSelectionSelectAll collSel+  mapM_ (treeSelectionUnselectPath collSel) rows+++showPropertyEditor = withSelectedIds P.showPropertyEditor++showPropertyExport = withSelectedIds P.showPropertyExport++withSelectedIds f =+  f =<< getSelectedIds++getOrderKeys =+  map orderKey <$> getOrder++orderKey (prop, False) = P.propKey prop+orderKey (prop, True)  = '-' : P.propKey prop
+ src/Collection/List.hs view
@@ -0,0 +1,31 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Collection.List+  ( initList+  , listStore+  , initListView+  , listView+  ) where++import Collection.List.Model+import Collection.List.View+++initList = initListModel
+ src/Collection/List/Model.hs view
@@ -0,0 +1,74 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Collection.List.Model+  ( initListModel+  , listStore+  ) where++import Control.Monad+import Control.Monad.Trans++import Graphics.UI.Gtk hiding (add)++import XMMS2.Client++import Context+import XMMS+import Handler+++data Model+  = Model { mStore :: ListStore (Maybe String) }++listStore = mStore context+++initListModel = do+  context <- initContext+  let ?context = context++  onServerConnection . add . ever $ \conn ->+    if conn+    then do+      broadcastCollectionChanged xmms >>* do+        change <- result+        when (namespace change == "Collections") $+          -- TODO: use the change info instead of repopulating the model.+          liftIO $ listCollections+        return True+      listCollections+    else+      listStoreClear listStore++  return ?context++initContext = do+  store <- listStoreNewDND [] Nothing Nothing+  return $ augmentContext+    Model { mStore = store }++listCollections =+  collList xmms "Collections" >>* do+    colls <- result+    liftIO $ do+      listStoreClear listStore+      listStoreAppend listStore Nothing+      mapM_ (listStoreAppend listStore . Just) colls+    return False
+ src/Collection/List/View.hs view
@@ -0,0 +1,118 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 10 Mar. 2010+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--  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.+--++module Collection.List.View+  ( initListView+  , listView+  , resetListView+  , onCollectionActivated+  , onCollectionSelectionChanged+  , onCollectionListMidClick+  , onCollectionListCR+  , getSelectedCollection+  ) where++import Control.Applicative+import Control.Monad.Trans++import Data.Char (toLower)+import Data.List (isInfixOf)++import Graphics.UI.Gtk++import Context+import Collection.List.Model+++data View+  = View { vView :: TreeView+         , vSel  :: TreeSelection+         }++listView = vView context+listSel  = vSel  context+++initListView = do+  context <- initContext+  let ?context = context++  treeSelectionSetMode listSel SelectionBrowse++  treeViewSetHeadersVisible listView False+  widgetSetSizeRequest listView 200 (-1)++  column <- treeViewColumnNew+  treeViewAppendColumn listView column+  cell <- cellRendererTextNew+  treeViewColumnPackStart column cell True+  cellLayoutSetAttributes column cell listStore $ \n ->+    case n of+      Nothing ->+        [ cellText := "All Media", cellTextWeight := 800 ]+      Just cn ->+        [ cellText := cn, cellTextWeightSet := False ]++  treeViewSetEnableSearch listView True+  treeViewSetSearchEqualFunc listView . Just $ \str iter ->+    maybe False (isInfixOf (map toLower str) . map toLower) <$>+      (listStoreGetValue listStore . head+       =<< treeModelGetPath listStore iter)++  return ?context++resetListView =+  treeViewSetCursor listView [0] Nothing+++initContext = do+  view <- treeViewNewWithModel listStore+  sel  <- treeViewGetSelection view+  return $ augmentContext+    View { vView = view+         , vSel  = sel+         }++onCollectionActivated =+  onRowActivated listView . const . const++onCollectionSelectionChanged =+  onSelectionChanged listSel++onCollectionListMidClick f =+  listView `on` buttonPressEvent $ tryEvent $ do+    MiddleButton <- eventButton+    SingleClick  <- eventClick+    (x, y)       <- eventCoordinates+    liftIO $ do+      Just (p, _, _) <- treeViewGetPathAtPos listView (round x, round y)+      treeViewSetCursor listView p Nothing+      f++onCollectionListCR f =+  listView `on` keyPressEvent $ tryEvent $ do+    [Control] <- eventModifier+    "Return"  <- eventKeyName+    liftIO f++getSelectedCollection = do+  path <- fst <$> treeViewGetCursor listView+  case path of+    [n] -> listStoreGetValue listStore n+    _   -> return Nothing+
+ src/Collection/Model.hs view
@@ -0,0 +1,172 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 14 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE TupleSections #-}++module Collection.Model+  ( initModel+  , collStore+  , getInfo+  , populateModel+  , getCurName+  , getCurColl+  , setCurColl+  , getFilter+  , setFilter+  , resetModel+  , getLoaded+  , setLoaded+  , getOrder+  , setOrder+  ) where++import Control.Applicative+import Control.Monad+import Control.Concurrent.MVar++import Data.Maybe++import Graphics.UI.Gtk++import XMMS2.Client++import Context+import Index hiding (getInfo)+import qualified Index as Index+import Medialib hiding (getInfo)+import Collection.Common+import qualified Properties as P+import Config+import Utils+++data State+  = State { sCurColl :: Coll+          , sCurName :: String+          , sFilter  :: String+          , sLoaded  :: Bool+          , sOrder   :: [(P.Property, Bool)]+          }++makeState =+  State { sCurColl = universe+        , sCurName = ""+        , sFilter  = ""+        , sLoaded  = False+        , sOrder   = []+        }++data Model+  = Model { mState :: MVar State+          , mStore :: ListStore MediaId+          , mIndex :: Index MediaInfo+          }++state = mState context++collStore = mStore context+collIndex = mIndex context++getCurName =+  withMVar state $ return . sCurName++getCurColl =+  withMVar state $ \s -> do+    case sFilter s of+      []   -> return $ sCurColl s+      text -> do+        fil <- collParse text+        int <- collNew TypeIntersection+        collAddOperand int $ sCurColl s+        collAddOperand int fil+        return int++setCurColl coll name =+  modifyMVar_ state $ \s ->+    return s { sCurColl = coll+             , sCurName = name+             }++getFilter = withMVar state $ return . sFilter++setFilter text =+  modifyMVar_ state $ \s ->+    return s { sFilter = text }++getLoaded =+  withMVar state $ return . sLoaded++setLoaded loaded =+  modifyMVar_ state $ \s ->+    return s { sLoaded = loaded }++getOrder =+  withMVar state $ return . sOrder++setOrder save o = do+  modifyMVar_ state $ \s ->+    return s { sOrder = o }+  when save $ saveOrder o++getInfo = Index.getInfo (mIndex context)+++initModel = do+  context <- initContext+  let ?context = context++  setOrder False =<< loadOrder++  return ?context+++initContext = do+  state <- newMVar makeState+  store <- listStoreNewDND [] Nothing Nothing+  index <- makeIndex store return+  return $ augmentContext+    Model { mState = state+          , mStore = store+          , mIndex = index+          }++populateModel ids = do+  clearIndex collIndex+  listStoreClear collStore+  mapM_ addOne ids+  where addOne id = do+          n <- listStoreAppend collStore id+          addToIndex collIndex id n++resetModel = do+  listStoreClear collStore+  modifyMVar_ state . const $ return makeState+++loadOrder =+  catMaybes <$> (mapM convert =<< config configFile [])+  where convert (name, desc) =+          maybe Nothing (Just . (, desc)) <$> P.property name++saveOrder order = do+  writeConfig configFile $ map (mapFst P.propName) order+  return ()++configFile =+  "collection-order.conf"
+ src/Collection/Order.hs view
@@ -0,0 +1,86 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 10 Sep. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE TupleSections #-}++module Collection.Order+  ( OrderDialog+  , makeOrderDialog+  , showOrderDialog+  ) where++import Control.Monad++import Graphics.UI.Gtk++import UI+import Compound+import Editor+import Properties+import Collection.Control+++type OrderDialog = EditorDialog (PropertyView Bool)++showOrderDialog dialog =+  runEditorDialog dialog+  getOrder+  setOrder+  False window++makeOrderDialog =+  makeEditorDialog [(stockApply, ResponseApply)]+  makeOrderView $ \v -> do+    let outerw = outer v+    windowSetTitle outerw "Configure ordering"+    windowSetDefaultSize outerw 500 400++makeOrderView parent onState = do+  view <- makePropertyView (, False) parent onState+  let store = propertyViewStore view+      right = propertyViewRight view++  treeViewSetRulesHint right True++  column <- treeViewColumnNew+  treeViewColumnSetTitle column "Order"+  treeViewAppendColumn right column+  cell <- cellRendererComboNew+  treeViewColumnPackStart column cell True+  cellLayoutSetAttributes column cell store $ \(_, dir) ->+    [ cellText := dirToString dir ]++  cmod <- listStoreNewDND [False, True] Nothing Nothing+  let clid = makeColumnIdString 0+  customStoreSetColumn cmod clid dirToString+  cell `set` [ cellTextEditable   := True+             , cellComboHasEntry  := False+             , cellComboTextModel := (cmod, clid) ]+  cell `on` edited $ \[n] str -> do+    (prop, dir) <- listStoreGetValue store n+    let dir' = stringToDir str+    unless (dir' == dir) $+      listStoreSetValue store n (prop, dir')++  return view++dirToString False = "Ascending"+dirToString True  = "Descending"++stringToDir = ("Descending" ==)
+ src/Collection/UI.hs view
@@ -0,0 +1,365 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 14 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Collection.UI+  ( initCollectionUI+  ) where++import Control.Applicative+import Control.Monad.Trans++import Data.Maybe++import System.IO.Unsafe++import Graphics.UI.Gtk hiding (add)++import UI+import XMMS+import Handler+import Utils+import Context+import Properties (showPropertyImport, showPropertyManager)+import Collection.View+import Collection.List.View+import Collection.Control+import Collection.Order+++data CollectionUI+  = CollectionUI { cOrderDialog :: OrderDialog }++orderDialog = cOrderDialog context+++initCollectionUI browse = do+  context <- initContext+  let ?context = context++  addUIActions $ uiActions browse++  srvAG <- actionGroupNew "server"+  actionGroupAddActions srvAG $ srvActions browse+  onServerConnectionAdd . ever $ actionGroupSetSensitive srvAG+  insertActionGroup srvAG 1++  addUIFromFile "collection-browser"++  onCollectionActivated $ loadSelected+  onCollectionListMidClick $ browseSelected browse+  onCollectionListCR $ browseSelected browse++  paned <- hPanedNew+  boxPackStartDefaults contents paned++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  scrolledWindowSetShadowType scroll ShadowIn+  containerAdd scroll listView+  panedAdd1 paned scroll++  box <- vBoxNew False 5+  panedAdd2 paned box++  boxPackStart box collFilter PackNatural 0+  collFilter `onEntryActivate` applyFilter++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  scrolledWindowSetShadowType scroll ShadowIn+  containerAdd scroll collView+  boxPackStartDefaults box scroll++  popup <- getWidget castToMenu "ui/collection-popup"+  setupTreeViewPopup collView popup++  popup <- getWidget castToMenu "ui/list-popup"+  setupTreeViewPopup listView popup++  acts <- mapM (getAction srvAG)+          [ "rename-collection"+          , "remove-collection"+          ]+  onCollectionSelectionChanged $ do+    en <- isJust <$> getSelectedCollection+    mapM_ (flip actionSetSensitive en) acts++  acts <- mapM (getAction srvAG)+          [ "add-to-playlist"+          , "replace-playlist"+          ]+  let updatePA = liftIO $ do+        list <- widgetGetIsFocus listView+        coll <- widgetGetIsFocus collView+        mapM_ (flip actionSetSensitive (list || coll)) acts+        return False+      setupPA w = do+        w `on` focusInEvent $ updatePA+        w `on` focusOutEvent $ updatePA+  setupPA listView+  setupPA collView+  updatePA++  acts <- mapM (getAction srvAG)+          ["copy", "edit-properties", "export-properties"]+  let updateE = do+        en <- (/= 0) <$> treeSelectionCountSelectedRows collSel+        mapM_ (flip actionSetSensitive en) acts+  collSel `onSelectionChanged` updateE+  updateE++  updateWindowTitle+  return ?context+++initContext = do+  context <- initListView+  let ?context = context++  orderDialog <- unsafeInterleaveIO makeOrderDialog++  return $ augmentContext+    CollectionUI { cOrderDialog = orderDialog }+++uiActions browse =+  [ ActionEntry+    { actionEntryName        = "collection"+    , actionEntryLabel       = "_Collection"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "new-window"+    , actionEntryLabel       = "_New window"+    , actionEntryStockId     = Just stockNew+    , actionEntryAccelerator = Just "<Control>n"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = newWindow browse+    }+  , ActionEntry+    { actionEntryName        = "edit-filter"+    , actionEntryLabel       = "_Edit filter"+    , actionEntryStockId     = Just stockEdit+    , actionEntryAccelerator = Just "<Control>l"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editFilter+    }+  , ActionEntry+    { actionEntryName        = "all-media"+    , actionEntryLabel       = "A_ll media"+    , actionEntryStockId     = Just stockNew+    , actionEntryAccelerator = Just "<Control>u"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = allMedia+    }+  , ActionEntry+    { actionEntryName        = "edit"+    , actionEntryLabel       = "_Edit"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "view"+    , actionEntryLabel       = "_View"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "configure-columns"+    , actionEntryLabel       = "Configure _columns"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showViewConfigDialog+    }+  , ActionEntry+    { actionEntryName        = "configure-ordering"+    , actionEntryLabel       = "Configure _ordering"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showOrderDialog orderDialog+    }+  , ActionEntry+    { actionEntryName        = "properties"+    , actionEntryLabel       = "P_roperties"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "manage-properties"+    , actionEntryLabel       = "_Manage properties"+    , actionEntryStockId     = Just stockPreferences+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showPropertyManager+    }+  , ActionEntry+    { actionEntryName        = "collection-popup"+    , actionEntryLabel       = ""+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  ]++srvActions browse =+  [ ActionEntry+    { actionEntryName        = "browse-in-new-window"+    , actionEntryLabel       = "_Browse in new window"+    , actionEntryStockId     = Just stockOpen+    , actionEntryAccelerator = Just "<Control>Return"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = browseSelected browse+    }+  , ActionEntry+    { actionEntryName        = "save-collection"+    , actionEntryLabel       = "_Save collection"+    , actionEntryStockId     = Just stockSave+    , actionEntryAccelerator = Just "<Control>s"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = saveCollection+    }+  , ActionEntry+    { actionEntryName        = "rename-collection"+    , actionEntryLabel       = "Rena_me collection"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = renameCollection+    }+  , ActionEntry+    { actionEntryName        = "remove-collection"+    , actionEntryLabel       = "Remo_ve collection"+    , actionEntryStockId     = Just stockDelete+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = removeCollection+    }+  , ActionEntry+    { actionEntryName        = "add-to-playlist"+    , actionEntryLabel       = "_Add to playlist"+    , actionEntryStockId     = Just stockAdd+    , actionEntryAccelerator = Just "<Control>p"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = addToPlaylist False+    }+  , ActionEntry+    { actionEntryName        = "replace-playlist"+    , actionEntryLabel       = "_Replace playlist"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Just "<Control><Shift>p"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = addToPlaylist True+    }+  , ActionEntry+    { actionEntryName        = "coll-add-to-playlist"+    , actionEntryLabel       = "_Add to playlist"+    , actionEntryStockId     = Just stockAdd+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = collAddToPlaylist False+    }+  , ActionEntry+    { actionEntryName        = "coll-replace-playlist"+    , actionEntryLabel       = "_Replace playlist"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = collAddToPlaylist True+    }+  , ActionEntry+    { actionEntryName        = "list-add-to-playlist"+    , actionEntryLabel       = "_Add to playlist"+    , actionEntryStockId     = Just stockAdd+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = listAddToPlaylist False+    }+  , ActionEntry+    { actionEntryName        = "list-replace-playlist"+    , actionEntryLabel       = "_Replace playlist"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = listAddToPlaylist True+    }+  , ActionEntry+    { actionEntryName        = "copy"+    , actionEntryLabel       = "_Copy"+    , actionEntryStockId     = Just stockCopy+    , actionEntryAccelerator = Just "<Control>c"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editCopy+    }+  , ActionEntry+    { actionEntryName        = "select-all"+    , actionEntryLabel       = "_Select all"+    , actionEntryStockId     = Just stockSelectAll+    , actionEntryAccelerator = Just "<Control>a"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editSelectAll+    }+  , ActionEntry+    { actionEntryName        = "invert-selection"+    , actionEntryLabel       = "_Invert selection"+    , actionEntryStockId     = Just stockSelectAll+    , actionEntryAccelerator = Just "<Control><Shift>a"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editInvertSelection+    }+  , ActionEntry+    { actionEntryName        = "edit-properties"+    , actionEntryLabel       = "_Edit properties"+    , actionEntryStockId     = Just stockEdit+    , actionEntryAccelerator = Just "<Alt>Return"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showPropertyEditor+    }+  , ActionEntry+    { actionEntryName        = "export-properties"+    , actionEntryLabel       = "E_xport properties"+    , actionEntryStockId     = Just stockSave+    , actionEntryAccelerator = Just ""+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showPropertyExport+    }+  , ActionEntry+    { actionEntryName        = "import-properties"+    , actionEntryLabel       = "_Import properties"+    , actionEntryStockId     = Just stockOpen+    , actionEntryAccelerator = Just ""+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showPropertyImport+    }+  ]+++newWindow browse =+  browse Nothing
+ src/Collection/View.hs view
@@ -0,0 +1,165 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 14 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE TupleSections #-}++module Collection.View+  ( initView+  , collView+  , collSel+  , collFilter+  , showViewConfigDialog+  ) where++import Control.Monad+import Control.Applicative++import Data.IORef+import Data.Maybe+import Data.List (isInfixOf)+import Data.Char++import System.IO.Unsafe++import Graphics.UI.Gtk++import UI+import Config+import Compound+import Editor+import Context+import Prelude hiding (lookup)+import Properties+import Collection.Model+++data View+  = View { vView      :: TreeView+         , vSel       :: TreeSelection+         , vFilter    :: Entry+         , vConfigDlg :: EditorDialog (PropertyView ())+         , vColumns   :: IORef [Property]+         }++collView   = vView context+collSel    = vSel  context+collFilter = vFilter context+configDlg  = vConfigDlg context+columns    = vColumns context+++initView = do+  context <- initContext+  let ?context = context++  treeViewSetRulesHint collView True+  treeSelectionSetMode collSel SelectionMultiple++  setColumns False =<< loadConfig++  return ?context++showViewConfigDialog =+  runEditorDialog configDlg+  (map (, ()) <$> getColumns)+  (setColumns True . map fst)+  False window++initContext = do+  view      <- treeViewNewWithModel collStore+  sel       <- treeViewGetSelection view+  filter    <- entryNew+  configDlg <- unsafeInterleaveIO makeConfigDlg+  columns   <- newIORef []+  return $ augmentContext+    View { vView      = view+         , vSel       = sel+         , vFilter    = filter+         , vConfigDlg = configDlg+         , vColumns   = columns+         }++getColumns =+  readIORef columns++setColumns save props = do+  mapM_ (treeViewRemoveColumn collView) =<< treeViewGetColumns collView+  writeIORef columns props+  mapM_ addColumn props+  setupSearch props+  when save $ saveConfig props++addColumn prop = do+  column <- treeViewColumnNew+  treeViewAppendColumn collView column+  treeViewColumnSetTitle column $ propName prop+  treeViewColumnSetResizable column True+  cell <- cellRendererTextNew+  treeViewColumnPackStart column cell True+  cellLayoutSetAttributeFunc column cell collStore $ \iter -> do+    maybeInfo <- getInfoIfNeeded iter+    let text = case maybeInfo of+          Just info -> maybe "" id (lookup prop info)+          Nothing   -> ""+    cell `set` [ cellText := text ]++getInfoIfNeeded iter = do+  [n] <- treeModelGetPath collStore iter+  mid <- listStoreGetValue collStore n+  rng <- treeViewGetVisibleRange collView+  getInfo mid $ case rng of+    ([f], [t]) -> n >= f && t >= n+    _          -> False++makeConfigDlg =+  makeEditorDialog [(stockApply, ResponseApply)]+  (makePropertyView (, ())) $ \v -> do+    let outerw = outer v+    windowSetTitle outerw "Configure collection browser"+    windowSetDefaultSize outerw 500 400++loadConfig =+  catMaybes <$> (mapM property =<< config configFile defaultConfig)++saveConfig props = do+  writeConfig configFile $ map propName props+  return ()++configFile =+  "collection-view.conf"++defaultConfig =+  ["Artist", "Album", "Track", "Title"]++setupSearch props = do+  treeViewSetEnableSearch collView True+  treeViewSetSearchEqualFunc collView $ Just $ \str iter -> do+    [n]  <- treeModelGetPath collStore iter+    mid  <- listStoreGetValue collStore n+    search (map toLower str) props <$> getInfo mid True++search _ _ Nothing = False+search _ [] _ = False+search str (prop:props) (Just info) =+  let ptext = map toLower $ maybe "" id $ lookup prop info in+  if isInfixOf str ptext+  then True+  else search str props (Just info)++
+ src/Compound.hs view
@@ -0,0 +1,29 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 1 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Compound+  ( CompoundWidget (..)+  ) where+++class CompoundWidget cw where+  type Outer cw+  outer :: cw -> Outer cw++
+ src/Config.hs view
@@ -0,0 +1,126 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 21 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Config+  ( config+  , writeConfig+  , ConfigWidget (..)+  , makeConfigDialog+  , ConfigDialog+  , prepareToShow+  ) where++import Control.Monad++import Data.Maybe++import Text.JSON++import System.FilePath+import System.Directory+import System.IO++import Graphics.UI.Gtk++import Environment+import Compound+import Utils+++config name defl = do+  withFile (configFileName name) ReadMode config' `catch` \_ -> return defl+  where config' h = do+          c <- hGetContents h+          case decodeStrict c of+            Ok r    -> return r+            Error _ -> readIO c -- try to read old format++writeConfig name cont =+  writeConfig' >> return True `catch` \_ -> return False+  where writeConfig' = do+          createDirectoryIfMissing True configBaseDir+          writeFile (configFileName name) $ encodeStrict $ showJSON cont+++configFileName name = joinPath [configBaseDir, name]++configBaseDir = joinPath [fromJust homeDir, ".vision"]+++class CompoundWidget cw => ConfigWidget cw where+  type Config cw+  getConfig    :: cw -> IO (Config cw)+  setConfig    :: cw -> Config cw -> IO ()+  clearConfig  :: cw -> IO ()+  getChanged   :: cw -> IO Bool+  clearChanged :: cw -> IO ()+  grabFocus    :: cw -> IO ()+++data ConfigDialog+  = ConfigDialog { cDialog       :: Dialog+                 , prepareToShow :: IO ()+                 }++instance CompoundWidget ConfigDialog where+  type Outer ConfigDialog = Dialog+  outer = cDialog++makeConfigDialog make destroy getc setc = do+  dialog <- dialogNew+  windowSetModal dialog False+  dialogSetHasSeparator dialog False++  dialogAddButton   dialog "gtk-apply"  ResponseApply+  dialogAddButton   dialog "gtk-cancel" ResponseCancel+  dialogAddButtonCR dialog "gtk-ok"     ResponseOk+  dialogSetResponseSensitive dialog ResponseApply False++  upper <- dialogGetUpper dialog+  cw <- make dialog $ dialogSetResponseSensitive dialog ResponseApply True+  widgetShowAll $ outer cw+  boxPackStartDefaults upper $ outer cw++  let hide = do+        widgetHide dialog+        clearConfig cw+        clearChanged cw+        when destroy $ widgetDestroy dialog+      prepareToShow = do+        setConfig cw =<< getc+        grabFocus cw++  dialog `onResponse` \resp ->+    case resp of+      ResponseApply -> do+        dialogSetResponseSensitive dialog ResponseApply False+        changed <- getChanged cw+        when changed $ setc =<< getConfig cw+        clearChanged cw+        grabFocus cw+      ResponseOk    -> do+        changed <- getChanged cw+        when changed $ setc =<< getConfig cw+        hide+      _ ->+        hide++  return ConfigDialog { cDialog       = dialog+                      , prepareToShow = prepareToShow+                      }
+ src/Context.hs view
@@ -0,0 +1,58 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 18 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE MultiParamTypeClasses,+             FlexibleInstances,+             OverlappingInstances,+             TypeOperators #-}++module Context+  ( ContextClass+  , ContextType+  , makeContext+  , augmentContext+  , context+  ) where+++infixr 9 :*+data a :* b = a :* b+data Nil = Nil++class ContextClass c a where+  ctxt :: a -> c++instance ContextClass c (c :* b) where+  ctxt (c :* _) = c++instance ContextClass c b => ContextClass c (a :* b) where+  ctxt (_ :* b) = ctxt b+++type ContextType a b = a :* b+++makeContext :: c -> ContextType c Nil+makeContext c = c :* Nil++augmentContext :: (?context :: c1) => c2 -> ContextType c2 c1+augmentContext c = c :* ?context++context :: (?context :: a, ContextClass c a) => c+context = ctxt ?context
+ src/DnD.hs view
@@ -0,0 +1,92 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 10 Sep. 2010+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--+--  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.+--++{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module DnD+  ( setupDnDReorder+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans++import Data.IORef++import Graphics.UI.Gtk+++setupDnDReorder target store view apply = do+  sel <- treeViewGetSelection view++  targetList <- targetListNew+  targetListAdd targetList target [TargetSameWidget] 0++  dropRef <- newIORef False++  dragSourceSet view [Button1] [ActionMove]+  dragSourceSetTargetList view targetList++  view `on` dragDataGet $ \_ _ _ -> do+    rows <- liftIO $ treeSelectionGetSelectedRows sel+    selectionDataSet selectionTypeInteger $ map head rows+    return ()++  dragDestSet view [DestDefaultMotion, DestDefaultHighlight] [ActionMove]+  dragDestSetTargetList view targetList++  view `on` dragDrop $ \ctxt _ tstamp -> do+    writeIORef dropRef True+    dragGetData view ctxt target tstamp+    return True++  view `on` dragDataReceived $ \ctxt (_, y) _ tstamp -> do+    drop <- liftIO $ readIORef dropRef+    when drop $ do+      liftIO $ writeIORef dropRef False+      (rows :: Maybe [Int]) <- selectionDataGet selectionTypeInteger+      liftIO $ doReorder apply store view y rows+      liftIO $ dragFinish ctxt True True tstamp++  view `on` dragDataDelete $ \_ ->+    treeSelectionUnselectAll sel+++doReorder _ _ _ _ Nothing                  = return ()+doReorder apply store view y (Just rows) = do+  base <- getTargetRow+  apply $ reorder base rows+  where getTargetRow = do+          maybePos <- treeViewGetPathAtPos view (0, y)+          case maybePos of+            Just ([n], _, _) ->+              return n+            Nothing ->+              pred <$> listStoreGetSize store++reorder = reorderDown 0+  where reorderDown _ _ [] = []+        reorderDown dec base rows@(r:rs)+          | r <= base = (r - dec, base) : reorderDown (dec + 1) base rs+          | otherwise = reorderUp (if dec /= 0 then base + 1 else base) rows+        reorderUp _ [] = []+        reorderUp base (r:rs)+          | r == base = reorderUp (base + 1) rs+          | otherwise = (r, base) : reorderUp (base + 1) rs+
+ src/Editor.hs view
@@ -0,0 +1,141 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 1 Sep. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE DoRec #-}++module Editor+  ( EditorWidget (..)+  , EditorDialog+  , makeEditorDialog+  , runEditorDialog+  ) where++import Control.Applicative+import Control.Monad+import Control.Concurrent.MVar++import Data.Maybe++import Graphics.UI.Gtk++import Compound+import Utils+++class CompoundWidget w => EditorWidget w where+  type Data w+  setData       :: w -> Data w -> IO ()+  getData       :: w -> IO (Data w)+  clearData     :: w -> IO ()+  setupView     :: w -> IO ()+  focusView     :: w -> IO ()+  getState      :: w -> IO (Bool, Bool)+  resetModified :: w -> IO ()++  clearData = const $ return ()+  setupView = const $ return ()+  focusView = const $ return ()+++data EditorWidget e => EditorDialog e+  = EditorDialog+    { eLock   :: MVar ()+    , eDialog :: Dialog+    , eEditor :: e+    }++instance EditorWidget e => CompoundWidget (EditorDialog e) where+  type Outer (EditorDialog e) = Dialog+  outer = eDialog+++makeEditorDialog buttons makeEditor setup = do+  lock <- newMVar ()++  dialog <- dialogNew+  hideOnDeleteEvent dialog+  dialogSetHasSeparator dialog False++  mapM_ (uncurry $ dialogAddButton dialog) buttons+  dialogAddButton dialog stockCancel ResponseCancel+  dialogAddButtonCR dialog stockOk ResponseOk++  rec { editor <- makeEditor dialog $ updateState dialog editor }++  upper <- dialogGetUpper dialog+  boxPackStartDefaults upper $ outer editor+  widgetShowAll $ outer editor++  let e = EditorDialog { eLock   = lock+                       , eDialog = dialog+                       , eEditor = editor+                       }+  setup e+  return e++runEditorDialog e get set modal parent = do+  let dialog = eDialog e+      editor = eEditor e+      lock   = eLock e++  locked <- isJust <$> tryTakeMVar lock+  when locked $ do+    windowSetModal dialog modal+    windowSetTransientFor dialog parent+    when modal $ do+      windowGroup <- windowGroupNew+      windowGroupAddWindow windowGroup parent+      windowGroupAddWindow windowGroup dialog++    setData editor =<< get+    resetModified editor+    updateState dialog editor+    dialogSetDefaultResponse dialog ResponseOk+    setupView editor+    focusView editor+    rec { cid <- dialog `onResponse` \resp -> do+             let done = do+                   signalDisconnect cid+                   widgetHide dialog+                   clearData editor+                   putMVar lock ()+             dialogSetDefaultResponse dialog ResponseOk+             focusView editor+             case resp of+               ResponseApply -> do+                 (valid, modified) <- getState editor+                 when (valid && modified) (set =<< getData editor)+                 resetModified editor+                 updateState dialog editor+               ResponseOk -> do+                 (valid, modified) <- getState editor+                 when valid $ do+                   when modified (set =<< getData editor)+                   done+               _ -> done+        }+    return ()++  windowPresent dialog+++updateState dialog editor = do+  (valid, modified) <- getState editor+  dialogSetResponseSensitive dialog ResponseOk valid+  dialogSetResponseSensitive dialog ResponseApply modified
+ src/Environment.hs view
@@ -0,0 +1,67 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 18 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE UndecidableInstances #-}++module Environment+  ( EnvironmentContextClass+  , initEnvironment+  , homeDir+  , dataDir+  , uiFilePath+  , xmmsPath+  , maybeGetEnv+  ) where++import System.Environment+import System.FilePath+import Control.Applicative++import Context++import Paths_vision+++data Environment+  = Environment { eHomeDir  :: Maybe FilePath+                , eDataDir  :: FilePath+                , eXMMSPath :: Maybe String }++class (ContextClass Environment c) => EnvironmentContextClass c where {}+instance (ContextClass Environment c) => EnvironmentContextClass c++homeDir   = eHomeDir context+dataDir   = eDataDir context+xmmsPath  = eXMMSPath context+++initEnvironment = do+  homeDir  <- maybeGetEnv "HOME"+  dataDir  <- getDataDir+  xmmsPath <- maybeGetEnv "XMMS_PATH"+  return $ makeContext Environment { eHomeDir  = homeDir+                               , eDataDir  = dataDir+                               , eXMMSPath = xmmsPath+                               }++maybeGetEnv var =+  (Just <$> getEnv var) `catch` \_ -> return Nothing++uiFilePath name = dataDir </> "ui" </> name <.> "xml"+
+ src/Handler.hs view
@@ -0,0 +1,78 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 11 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Handler+  ( Id+  , Handler+  , make+  , add+  , remove+  , invoke+  , once+  , ever+  , keep+  ) where++import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import Data.Foldable+++data Id m a = Id Int++type Entry m a = (Int, a -> m Bool)+type Entries m a = IntMap (Entry m a)++data Handler m a+  = Handler { nextId  :: Id m a+            , entries :: Entries m a+            }++make :: Handler m a+make = Handler { nextId = Id 0, entries = IntMap.empty }++add :: Monad m => (a -> m Bool) -> Handler m a -> m (Handler m a, Id m a)+add f Handler { nextId = id@(Id n), entries = e } =+  return (h, id)+  where h = Handler { nextId   = Id $ succ n+                    , entries = IntMap.insert n (n, f) e+                    }++remove :: Monad m => Id m a -> Handler m a -> m (Handler m a, ())+remove (Id n) h =+  return (h { entries = IntMap.delete n $ entries h }, ())++invoke :: Monad m => a -> Handler m a -> m (Handler m a, ())+invoke a h@Handler { entries = e } = do+  e' <- foldlM (invoke' a) e e+  return (h { entries = e' }, ())+  where invoke' a e (i, f) = do+          p <- f a+          if p+            then return e+            else return $ IntMap.delete i e++once :: Monad m => (a -> m b) -> a -> m Bool+once = keep False++ever :: Monad m => (a -> m b) -> a -> m Bool+ever = keep True++keep :: Monad m => Bool -> (a -> m b) -> a -> m Bool+keep r f a = f a >> return r
+ src/Index.hs view
@@ -0,0 +1,113 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module Index+  ( Index+  , makeIndex+  , getInfo+  , addToIndex+  , clearIndex+  ) where++import Control.Concurrent.MVar+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap++import Graphics.UI.Gtk hiding (add)++import XMMS2.Client++import Medialib hiding (getInfo)+import Handler+++data IndexEntry i+  = IENone+  | IERetrieving+  | IEReady Stamp MediaInfo i++data Index i+  = Index { iTable :: MVar (IntMap (IndexEntry i, [TreeRowReference]))+          , iStore :: ListStore MediaId+          , iConv  :: MediaInfo -> IO i+          }++makeIndex store conv = do+  table <- newMVar IntMap.empty+  let index = Index { iTable = table+                    , iStore = store+                    , iConv  = conv+                    }++  onMediaInfo . add . ever $ handleInfo index++  return index++handleInfo index (id, stamp, info) = do+  let id' = fromIntegral id+  modifyMVar_ (iTable index) $ \ix ->+    case IntMap.lookup id' ix of+      Just (entry, list) ->+        updateIndex index ix id' stamp info entry list+      Nothing            ->+        return ix++updateIndex index ix id stamp info old list =+  if upd+  then do+    ti <- (iConv index) info+    mapM_ (touch index) list+    return $ IntMap.insert id (IEReady stamp info ti, list) ix+  else+    return ix+  where upd = case old of+          IEReady oldStamp _ _ -> stamp /= oldStamp+          _                    -> True++touch index ref = do+  path <- treeRowReferenceGetPath ref+  case path of+    [n] -> do+      Just iter <- treeModelGetIter (iStore index) [n]+      treeModelRowChanged (iStore index) [n] iter+    _   ->+      return ()++getInfo index id force = do+  let id' = fromIntegral id+  modifyMVar (iTable index) $ \ix ->+    case IntMap.lookup id' ix of+      Just (IEReady _ _ info, _) ->+        return (ix, Just info)+      Just (IENone, list) | force -> do+        requestInfo id+        return (IntMap.insert id'(IERetrieving, list) ix, Nothing)+      _ ->+        return (ix, Nothing)++addToIndex index id n =+  modifyMVar_ (iTable index) $ \ix -> do+    Just ref <- treeRowReferenceNew (iStore index) [n]+    return $ IntMap.insertWith iw (fromIntegral id) (IENone, [ref]) ix+  where iw (_, [new]) (entry, old) = (entry, new : old)++clearIndex index =+  modifyMVar_ (iTable index) . const $ return IntMap.empty
+ src/Location.hs view
@@ -0,0 +1,59 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 28 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Location+  ( initLocation+  , browseLocation+  ) where++import Graphics.UI.Gtk++import UI+import Location.History+import Location.Model+import Location.View+import Location.Control+import Location.UI+++initLocation =+  initHistory+++browseLocation order maybeURL = do+  let f = browseLocation++  context <- initUI+  let ?context = context++  context <- initModel order+  let ?context = context++  context <- initView+  let ?context = context++  setupUI f++  widgetShowAll window+  case maybeURL of+    Just url -> loadLocation $ Go url+    Nothing  -> openLocation+++
+ src/Location/Control.hs view
@@ -0,0 +1,112 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 28 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Location.Control+  ( loadLocation+  , makeURL+  , addToPlaylist+  , replacePlaylist+  , updateWindowTitle+  , openLocation+  ) where++import Prelude hiding (catch)+import Control.Monad.CatchIO+import Control.Monad.Trans++import Data.Maybe+import Data.List++import Graphics.UI.Gtk++import XMMS2.Client++import XMMS+import Environment+import UI+import Location.History+import Location.Model+import Location.View+++loadLocation location = do+  listStoreClear locationStore+  maybeURL <- updateLocation location+  case maybeURL of+    Just url -> do+      addToHistory url+      updateWindowTitle+      entrySetText locationEntry url+      xformMediaBrowse xmms url >>* handleBrowse url+    Nothing ->+      return ()++handleBrowse url = do+  handleBrowse' `catch` \(_ :: XMMSException) ->+    liftIO $ putStrLn $ "error loading " ++ url+  return False+  where handleBrowse' = do+          r <- result+          liftIO $ do+            mapM_ (listStoreAppend locationStore . makeItem) r+            widgetGrabFocus locationView++makeURL url+  | isInfixOf "://" url =+    url+  | isPrefixOf "~/" url && isJust homeDir =+    "file://" ++ fromJust homeDir ++ tail url+  | otherwise =+    "file://" ++ url++replacePlaylist = do+  playlistClear xmms Nothing+  addToPlaylist++addToPlaylist = do+  rows <- treeSelectionGetSelectedRows locationSel+  mapM_ addOne rows++addOne p = do+  item <- itemByPath p+  let path = iPath item+  if iIsDir item+    then do+      playlistRAdd xmms Nothing path+      return ()+    else do+      collIdlistFromPlaylistFile xmms path >>*+        ((do coll <- result+             lift $ playlistAddIdlist xmms Nothing coll+             return False)+         `catch`+         (\(_ :: XMMSException) -> do+             lift $ playlistAddURL xmms Nothing path+             return False))+      return ()++updateWindowTitle = do+  loc <- getCurrentLocation+  setWindowTitle $ case loc of+    [] -> "Vision location browser"+    _  -> loc ++ " - Vision location browser"++openLocation = do+  widgetGrabFocus locationEntry+  editableSelectRegion locationEntry 0 (-1)
+ src/Location/History.hs view
@@ -0,0 +1,67 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 1 Jul. 2010+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--  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.+--++module Location.History+  ( History+  , initHistory+  , makeHistoryCompletion+  , addToHistory+  ) where++import Data.List+import Data.Char++import Graphics.UI.Gtk++import Config+import Context+++data History+  = History { hStore :: ListStore String }++historyStore = hStore context+++initHistory = do+  history <- config "history.urls" []+  store   <- listStoreNewDND history Nothing Nothing+  return $ augmentContext+    History { hStore = store }++makeHistoryCompletion = do+  comp <- entryCompletionNew++  entryCompletionSetModel comp $ Just historyStore+  entryCompletionSetTextModel comp historyStore+  entryCompletionSetMatchFunc comp $ \s i -> do+    [n] <- treeModelGetPath historyStore i+    t   <- listStoreGetValue historyStore n+    return $ isInfixOf s $ map toLower t++  entryCompletionSetPopupCompletion comp True+  entryCompletionSetPopupSingleMatch comp True++  return comp++addToHistory url = do+  history <- listStoreToList historyStore+  maybe (return ()) (listStoreRemove historyStore) $ elemIndex url history+  listStorePrepend historyStore url+  writeConfig "history.urls" =<< listStoreToList historyStore+  return ()
+ src/Location/Model.hs view
@@ -0,0 +1,220 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 28 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module Location.Model+  ( initModel+  , Item (..)+  , makeItem+  , locationStore+  , sortModel+  , getCurrentLocation+  , onLocation+  , LocationChange (..)+  , updateLocation+  , canGo+  , itemByIter+  , itemByPath+  , setSortOrder+  , getSortOrder+  ) where++import Control.Concurrent.MVar+import Control.Applicative++import Data.List++import Graphics.UI.Gtk++import XMMS2.Client++import Context+import Utils+import Handler+++data Location+  = Location { lCurrent :: String+             , lBack    :: [String]+             , lForward :: [String]+             }++makeLocation =+  Location { lCurrent = ""+           , lBack    = []+           , lForward = []+           }++data LocationChange+  = Back+  | Forward+  | Go String+  | Refresh+  | Up++changeLocation Back l =+  case lBack l of+    (u : us) ->+      (l { lCurrent = u+         , lBack    = us+         , lForward = lCurrent l : lForward l+         }, Just u)+    _ ->+      (l, Nothing)+changeLocation Forward l =+  case lForward l of+    (u : us) ->+      (l { lCurrent = u+         , lBack    = lCurrent l : lBack l+         , lForward = us+         }, Just u)+    _ ->+      (l, Nothing)+changeLocation (Go u) l =+  (l { lCurrent = u+     , lBack    = case lCurrent l of+         [] -> lBack l+         u' -> u' : lBack l+     , lForward = []+     }, Just u)+changeLocation Refresh l =+  (l, Just $ lCurrent l)+changeLocation Up l =+  let u = reverse . dropWhile (/= '/') . tail . reverse $ lCurrent l+  in changeLocation (Go u) l+++data State+  = State { sLocation :: Location+          , sOrder    :: SortType+          }++makeState order =+  State { sLocation = makeLocation+        , sOrder    = order+        }++data Item+  = Item { iName  :: String+         , iPath  :: String+         , iIsDir :: Bool+         }++makeItem x =+  Item { iName  = name+       , iPath  = path+       , iIsDir = entryIsDir x+       }+  where name = last $ split $ path+        path = decodeURL $ entryPath x++compareItems SortDescending a b+  | iIsDir a == iIsDir b = compare (iName b) (iName a)+  | iIsDir a             = LT+  | iIsDir b             = GT+compareItems SortAscending a b+  | iIsDir a == iIsDir b = compare (iName a) (iName b)+  | iIsDir a             = LT+  | iIsDir b             = GT+++data Model+  = Model { mState      :: MVar State+          , mStore      :: ListStore Item+          , mSort       :: TypedTreeModelSort Item+          , mOnLocation :: HandlerMVar ()+          }++locationStore = mStore context+sortModel = mSort context+onLocation = onHandler $ mOnLocation context+state = mState context++getCurrentLocation =+  withMVar state $ return . lCurrent . sLocation++updateLocation change = do+  r <- modifyMVar state $ \s -> do+    let (l, u) = changeLocation change $ sLocation s+    return (s { sLocation = l }, u)+  onLocation $ invoke ()+  return r++canGo = withMVar state $ \s ->+  let Location { lCurrent = c+               , lBack    = b+               , lForward = f+               } = sLocation s+  in return (not $ null b,+             not $ null f,+             not $ null c || isSuffixOf "//" c,+             not $ null c)+++initModel order = do+  context <- initContext order+  let ?context = context++  setSortOrder order++  return ?context+++initContext order = do+  state      <- newMVar $ makeState order+  store      <- listStoreNewDND [] Nothing Nothing+  sort       <- treeModelSortNewWithModel store+  onLocation <- makeHandlerMVar+  return $ augmentContext+    Model { mState      = state+          , mStore      = store+          , mSort       = sort+          , mOnLocation = onLocation+          }++split [] =  []+split s  =+  let (p, s') = break (== '/') s in+  p : case s' of+        []      -> []+        (_:s'') -> split s''++itemByIter' iter = do+  [n]   <- treeModelGetPath locationStore iter+  listStoreGetValue locationStore n++itemByIter iter = do+  citer <- treeModelSortConvertIterToChildIter sortModel iter+  itemByIter' citer++itemByPath path = do+  [n] <- treeModelSortConvertPathToChildPath sortModel path+  listStoreGetValue locationStore n++compareIters order a b =+  compareItems order <$> itemByIter' a <*> itemByIter' b++getSortOrder =+  withMVar state $ return . sOrder++setSortOrder order = do+  modifyMVar_ state $ \s ->+    return s { sOrder = order }+  treeSortableSetDefaultSortFunc sortModel $ compareIters order
+ src/Location/UI.hs view
@@ -0,0 +1,281 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 28 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Location.UI+  ( setupUI+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans++import Graphics.UI.Gtk hiding (add)++import UI+import XMMS+import Handler+import Utils+import Location.Model+import Location.View+import Location.Control+++setupUI browse = do+  addUIActions $ uiActions browse++  srvAG <- actionGroupNew "server"+  actionGroupAddActions srvAG $ srvActions browse+  onServerConnectionAdd . ever $ actionGroupSetSensitive srvAG+  insertActionGroup srvAG 1++  addUIFromFile "location-browser"++  toolbar <- getWidget castToToolbar "ui/toolbar"+  toolbarSetStyle toolbar ToolbarIcons+  boxPackStart contents toolbar PackNatural 0++  item <- toolItemNew+  toolItemSetHomogeneous item False+  toolItemSetExpand item True+  containerAdd item locationEntry+  toolbarInsert toolbar item 6++  load <- getAction srvAG "load"+  locationEntry `onEntryActivate` do+    actionActivate load++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  containerAdd scroll locationView+  boxPackStartDefaults contents scroll++  popup <- getWidget castToMenu "ui/location-popup"+  setupTreeViewPopup locationView popup++  down <- getAction srvAG "down"+  binw <- getAction srvAG "browse-in-new-window"+  addp <- getAction srvAG "add-to-playlist"+  repp <- getAction srvAG "replace-playlist"+  let updateB = do+        rows       <- treeSelectionGetSelectedRows locationSel+        (enp, enn) <- case rows of+          []    ->+            return (False, False)+          [path] -> do+            item <- itemByPath path+            return (True, iIsDir item)+          _     ->+            return (True, False)+        mapM_ (flip actionSetSensitive enp) [addp, repp]+        mapM_ (flip actionSetSensitive enn) [down, binw]+  locationSel `onSelectionChanged` updateB+  updateB++  locationView `onRowActivated` \_ _ ->+    actionActivate down++  locationView `on` buttonPressEvent $ tryEvent $ do+    MiddleButton <- eventButton+    SingleClick  <- eventClick+    (x, y)       <- eventCoordinates+    liftIO $ do+      maybePath <- treeViewGetPathAtPos locationView (round x, round y)+      case maybePath of+        Just (path, _, _) -> do+          treeViewSetCursor locationView path Nothing+          actionActivate binw+        Nothing           ->+          return ()++  back    <- getAction srvAG "back"+  forward <- getAction srvAG "forward"+  up      <- getAction srvAG "up"+  refresh <- getAction srvAG "refresh"+  let updateN = do+        (eb, ef, eu, er) <- canGo+        actionSetSensitive back eb+        actionSetSensitive forward ef+        actionSetSensitive up eu+        actionSetSensitive refresh er+  onLocation . add . ever . const $ updateN+  updateN++  updateWindowTitle++  return ()+++uiActions browse =+  [ ActionEntry+    { actionEntryName        = "location"+    , actionEntryLabel       = "_Location"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "new-window"+    , actionEntryLabel       = "_New window"+    , actionEntryStockId     = Just stockNew+    , actionEntryAccelerator = Just "<Control>n"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = newWindow browse+    }+  , ActionEntry+    { actionEntryName        = "open-location"+    , actionEntryLabel       = "_Open location"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Just "<Control>l"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = openLocation+    }+  , ActionEntry+    { actionEntryName        = "go"+    , actionEntryLabel       = "_Go"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "location-popup"+    , actionEntryLabel       = ""+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "clear"+    , actionEntryLabel       = ""+    , actionEntryStockId     = Just stockClear+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = clearLocationEntry+    }+  ]++srvActions browse =+  [ ActionEntry+    { actionEntryName        = "load"+    , actionEntryLabel       = ""+    , actionEntryStockId     = Just stockJumpTo+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = loadCurrentLocation+    }+  , ActionEntry+    { actionEntryName        = "down"+    , actionEntryLabel       = ""+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = loadAtCursor (loadLocation . Go)+    }+  , ActionEntry+    { actionEntryName        = "browse-in-new-window"+    , actionEntryLabel       = "_Browse in new window"+    , actionEntryStockId     = Just stockOpen+    , actionEntryAccelerator = Just "<Control>Return"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = browseInNewWindow browse+    }+  , ActionEntry+    { actionEntryName        = "add-to-playlist"+    , actionEntryLabel       = "_Add to playlist"+    , actionEntryStockId     = Just stockAdd+    , actionEntryAccelerator = Just "<Control>p"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = addToPlaylist+    }+  , ActionEntry+    { actionEntryName        = "replace-playlist"+    , actionEntryLabel       = "_Replace playlist"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Just "<Control><Shift>p"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = replacePlaylist+    }+  , ActionEntry+    { actionEntryName        = "back"+    , actionEntryLabel       = "Go _back"+    , actionEntryStockId     = Just stockGoBack+    , actionEntryAccelerator = Just "<Alt>Left"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = loadLocation Back+    }+  , ActionEntry+    { actionEntryName        = "forward"+    , actionEntryLabel       = "Go _forward"+    , actionEntryStockId     = Just stockGoForward+    , actionEntryAccelerator = Just "<Alt>Right"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = loadLocation Forward+    }+  , ActionEntry+    { actionEntryName        = "up"+    , actionEntryLabel       = "Go _up"+    , actionEntryStockId     = Just stockGoUp+    , actionEntryAccelerator = Just "<Alt>Up"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = loadLocation Up+    }+  , ActionEntry+    { actionEntryName        = "refresh"+    , actionEntryLabel       = "_Refresh"+    , actionEntryStockId     = Just stockRefresh+    , actionEntryAccelerator = Just "F5"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = loadLocation Refresh+    }+  ]++loadCurrentLocation = do+  text <- trim <$> entryGetText locationEntry+  case text of+    [] -> do+      cur <- getCurrentLocation+      case cur of+        [] -> return ()+        _  -> do+          entrySetText locationEntry cur+          widgetGrabFocus locationView+    _  -> loadLocation . Go $ makeURL text++loadAtCursor func = do+  (path, _) <- treeViewGetCursor locationView+  case path of+    [_] -> do+      item <- itemByPath path+      when (iIsDir item) $ func $ iPath item+    _   ->+      return ()++clearLocationEntry = do+  entrySetText locationEntry ""+  widgetGrabFocus locationEntry++browseInNewWindow browse = do+  order <- getSortOrder+  loadAtCursor (browse order . Just)++newWindow browse = do+  order <- getSortOrder+  browse order Nothing
+ src/Location/View.hs view
@@ -0,0 +1,105 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 28 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Location.View+  ( initView+  , locationView+  , locationSel+  , locationEntry+  ) where++import Data.List+import Data.Char++import Graphics.UI.Gtk++import Context+import Location.Model+import Location.History+++data View+  = View { vView  :: TreeView+         , vSel   :: TreeSelection+         , vEntry :: Entry+         }++locationView  = vView context+locationSel   = vSel context+locationEntry = vEntry context+++initView = do+  context <- initContext+  let ?context = context++  treeViewSetRulesHint locationView True++  treeSelectionSetMode locationSel SelectionMultiple++  column <- treeViewColumnNew+  treeViewAppendColumn locationView column+  treeViewColumnSetTitle column "Name"+  treeViewColumnSetSortOrder column =<< getSortOrder+  treeViewColumnSetSortIndicator column True+  treeViewColumnSetClickable column True+  column `onColClicked` do+    order <- treeViewColumnGetSortOrder column+    let order' = case order of+          SortAscending  -> SortDescending+          SortDescending -> SortAscending+    treeViewColumnSetSortOrder column order'+    setSortOrder order'++  cell <- cellRendererPixbufNew+  treeViewColumnPackStart column cell False+  cellLayoutSetAttributeFunc column cell sortModel $ \iter -> do+    item <- itemByIter iter+    cell `set` [ cellPixbufStockId :=+                 if iIsDir item+                 then stockDirectory+                 else stockFile ]++  cell <- cellRendererTextNew+  treeViewColumnPackStart column cell True+  cellLayoutSetAttributeFunc column cell sortModel $ \iter -> do+    item <- itemByIter iter+    cell `set` [ cellText := iName item ]++  treeViewSetEnableSearch locationView True+  treeViewSetSearchEqualFunc locationView $ Just $ \str iter -> do+    item <- itemByIter iter+    return $ isInfixOf (map toLower str) (map toLower $ iName item)++  comp <- makeHistoryCompletion+  entrySetCompletion locationEntry comp++  return ?context+++initContext = do+  view  <- treeViewNewWithModel sortModel+  sel   <- treeViewGetSelection view+  entry <- entryNew+  return $ augmentContext+    View { vView  = view+         , vSel   = sel+         , vEntry = entry+         }+
+ src/Medialib.hs view
@@ -0,0 +1,168 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 18 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Medialib+  ( Stamp+  , MediaInfo+  , initMedialib+  , requestInfo+  , onMediaInfo+  , getInfo+  , retrieveProperties+  ) where++import Control.Concurrent.MVar+import Control.Monad+import Control.Monad.Trans++import Data.Map (Map)+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap+import Data.Maybe+import Data.List+import Data.IORef++import Graphics.UI.Gtk hiding (add, remove)++import XMMS2.Client+import XMMS2.Client.Bindings (propdictToDict)++import Utils+import Context+import XMMS+import Handler+++type Stamp = Int+type MediaInfo = Map String Property+++data CacheEntry+  = CEReady Stamp MediaInfo+  | CERetrieving++data Cache+  = Cache { cEntries   :: IntMap CacheEntry+          , cNextStamp :: Stamp+          }++emptyCache =+  Cache { cEntries   = IntMap.empty+        , cNextStamp = 1+        }+++data MLib+  = MLib { mCache       :: MVar Cache+         , mOnMediaInfo :: HandlerMVar (MediaId, Stamp, MediaInfo)+         }++cache = mCache context+++onMediaInfo = onHandler $ mOnMediaInfo context++initMedialib = do+  context <- initContext+  let ?context = context++  onServerConnectionAdd . ever $ \conn ->+    if conn+    then do+      broadcastMedialibEntryChanged xmms >>* do+        id <- result+        let id' = fromIntegral id+        liftIO $ do+          withMVar cache $ \cache ->+            when (isJust . IntMap.lookup id' $ cEntries cache) $+              medialibGetInfo xmms id >>* handleInfo id'+        return True+    else+      modifyMVar_ cache $ \cache ->+        return cache { cEntries = IntMap.empty }++  return ?context++requestInfo id = do+  modifyMVar_ cache $ \cache ->+    let id'     = fromIntegral id+        entries = cEntries cache in+    case IntMap.lookup id' entries of+      Nothing -> do+        medialibGetInfo xmms id >>* handleInfo id'+        return cache { cEntries = IntMap.insert id' CERetrieving $ cEntries cache }+      Just (CEReady s i) -> do+        idleAdd (onMediaInfo (invoke (id, s, i)) >> return False) priorityHighIdle+        return cache+      _ ->+        return cache+++initContext = do+  cache       <- newMVar emptyCache+  onMediaInfo <- makeHandlerMVar+  return $ augmentContext+    MLib { mCache       = cache+         , mOnMediaInfo = onMediaInfo }++handleInfo id = do+  rawv <- resultRawValue+  liftIO $ do+    info  <- valueGet =<< propdictToDict rawv []+    stamp <- modifyMVar cache $ \cache ->+      let stamp   = cNextStamp cache+          entries = cEntries cache+          entry   = CEReady stamp info in+      return (Cache { cEntries   = IntMap.insert id entry entries+                    , cNextStamp = succ stamp }, stamp)+    onMediaInfo $ invoke (fromIntegral id, stamp, info)+  return False++getInfo id =+  withMVar cache $ \cache ->+    return $ case IntMap.lookup (fromIntegral id) $ cEntries cache of+      Just (CEReady _ info) -> Just info+      _                     -> Nothing++retrieveProperties ids f = do+  let ids'       = nub ids+      len        = length ids'+      step       = len `div` 100++  ref <- newIORef (0, ids', [])+  hid <- onMediaInfo . add $ \(id, _, info) -> do+    (ctr, todo, ready) <- readIORef ref+    case todo of+      (i:is) | i == id -> do+        if null is+          then do+          f . Right $ reverse ((id, info) : ready)+          return False+          else do+          let ctr' = ctr + 1+          when (step == 0 || ctr' `mod` step == 0) $+            f . Left $ fromIntegral ctr' / fromIntegral len+          requestInfo $ head is+          writeIORef ref (ctr', is, (id, info) : ready)+          return True+      _ ->+        return True++  requestInfo $ head ids+  return . onMediaInfo $ remove hid
+ src/Playback.hs view
@@ -0,0 +1,174 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playback+  ( initPlayback+  , onPlaybackStatus+  , onPlaybackStatusAdd+  , onCurrentTrack+  , getPlaybackStatus+  , getCurrentTrack+  , startPlayback+  , pausePlayback+  , stopPlayback+  , restartPlayback+  , prevTrack+  , nextTrack+  , requestCurrentTrack+  ) where++import Control.Concurrent.MVar+import Control.Monad.Trans++import XMMS2.Client++import XMMS+import Handler+import Context+import Utils+++data State+  = State { sCurrentTrack :: Maybe (Int, String)+          , sStatus       :: Maybe PlaybackStatus+          }++data Playback+  = Playback { pState            :: MVar State+             , pOnPlaybackStatus :: HandlerMVar (Maybe PlaybackStatus)+             , pOnCurrentTrack   :: HandlerMVar (Maybe (Int, String))+             }++state = pState context++onPlaybackStatus = onHandler (pOnPlaybackStatus context)+onPlaybackStatusAdd f = do+  id <- onPlaybackStatus . add $ f+  f =<< getPlaybackStatus+  return id++onCurrentTrack = onHandler (pOnCurrentTrack context)++getPlaybackStatus =+  withMVar state $ return . sStatus++getCurrentTrack =+  withMVar state $ return . sCurrentTrack+++initPlayback = do+  context <- initContext+  let ?context = context++  onServerConnectionAdd . ever $ \conn ->+    if conn+    then do+      broadcastPlaybackStatus xmms >>* do+        liftIO requestStatus+        return True+      requestStatus+      broadcastPlaylistCurrentPos xmms >>* do+        liftIO $ requestCurrentTrack+        return True+      requestCurrentTrack+    else+      resetState++  return ?context+++initContext = do+  state            <- newMVar makeState+  onPlaybackStatus <- makeHandlerMVar+  onCurrentTrack   <- makeHandlerMVar+  return $ augmentContext+    Playback { pState            = state+             , pOnPlaybackStatus = onPlaybackStatus+             , pOnCurrentTrack   = onCurrentTrack+             }++makeState =+  State { sCurrentTrack = Nothing+        , sStatus       = Nothing+        }++resetState = do+  modifyMVar_ state $ const $ return makeState+  invokeOnPlaybackStatus++setStatus s = do+  modifyMVar_ state $ \state ->+    return state { sStatus = s }+  invokeOnPlaybackStatus++requestStatus =+  playbackStatus xmms >>* do+    status <- result+    liftIO . setStatus $ Just status+    return False++requestCurrentTrack =+  playlistCurrentPos xmms Nothing >>* do+    new <- catchResult Nothing (Just . mapFst fromIntegral)+    liftIO $ do+      old <- modifyMVar state $ \state ->+        return (state { sCurrentTrack = new }, sCurrentTrack state)+      onCurrentTrack $ invoke old+    return False++startPlayback False = do+  playbackStart xmms+  return ()+startPlayback True = do+  ps <- getPlaybackStatus+  case ps of+    Just StatusPlay ->+      playbackTickle xmms+    Just StatusPause -> do+      playbackTickle xmms+      playbackStart xmms+      playbackTickle xmms+    _ ->+      playbackStart xmms+  return ()++pausePlayback = do+  playbackPause xmms+  return ()++stopPlayback = do+  playbackStop xmms+  return ()++nextTrack = do+  playlistSetNextRel xmms 1+  playbackTickle xmms+  return ()++prevTrack = do+  playlistSetNextRel xmms (-1)+  playbackTickle xmms+  return ()++invokeOnPlaybackStatus =+  onPlaybackStatus . invoke =<< getPlaybackStatus++restartPlayback = do+  playbackTickle xmms+  return ()
+ src/Playlist.hs view
@@ -0,0 +1,64 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist+  ( initPlaylist+  , showPlaylist+  ) where++import Graphics.UI.Gtk++import UI++import Playlist.Model+import Playlist.Index+import Playlist.Format+import Playlist.View+import Playlist.Config+import Playlist.Search+import Playlist.Update+import Playlist.DnD+import Playlist.UI+++initPlaylist =+  initFormat++showPlaylist = do+  context <- initUI+  let ?context = context++  context <- initModel+  let ?context = context++  context <- initIndex+  let ?context = context++  context <- initView+  let ?context = context++  context <- initPlaylistConfig+  let ?context = context++  setupSearch+  setupUpdate+  setupDnD+  setupUI++  widgetShowAll window
+ src/Playlist/Config.hs view
@@ -0,0 +1,51 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 1 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist.Config+  ( initPlaylistConfig+  , showPlaylistConfigDialog+  ) where++import System.IO.Unsafe++import Graphics.UI.Gtk++import UI+import Editor+import Context+import Compound+import Playlist.Format+import Playlist.Format.Config+++data Config+  = Config { cDialog :: EditorDialog FormatView }++initPlaylistConfig = do+  dialog <- unsafeInterleaveIO $ makeEditorDialog+            [(stockApply, ResponseApply)]+            makePlaylistFormatView $ \m -> do+    let outerw = outer m+    windowSetTitle outerw "Configure playlist"+    windowSetDefaultSize outerw 500 400+  return $ augmentContext+    Config { cDialog = dialog }++showPlaylistConfigDialog =+  runEditorDialog (cDialog context) getFormatDefs putFormatDefs False window
+ src/Playlist/Control.hs view
@@ -0,0 +1,79 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 2 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist.Control+  ( clearPlaylist+  , currentTrackThisPlaylist+  , removeTracks+  , insertIds+  , moveTracks+  , playTrack+  , showPropertyEditor+  , showPropertyExport+  ) where++import Control.Monad++import XMMS2.Client++import XMMS+import Playback+import qualified Properties as P+import Playlist.Model+import Playlist.View+++clearPlaylist = do+  playlistClear xmms =<< getPlaylistName+  return ()++currentTrackThisPlaylist = do+  maybeName <- getPlaylistName+  maybeCPos <- getCurrentTrack+  return $ case (maybeName, maybeCPos) of+    (Just pname, Just (track, cname)) | pname == cname ->+      Just track+    _ ->+      Nothing++removeTracks tracks = do+  name <- getPlaylistName+  mapM_ (playlistRemoveEntry xmms name) $ reverse tracks++insertIds ids pos = do+  start <- case pos of+    Just n  -> return n+    Nothing -> getPlaylistSize+  name <- getPlaylistName+  zipWithM_ (playlistInsertId xmms name) [start .. ] ids++moveTracks tracks = do+  name <- getPlaylistName+  mapM_ (uncurry (playlistMoveEntry xmms name)) tracks++playTrack n = do+  playlistSetNext xmms $ fromIntegral n+  startPlayback True++showPropertyEditor = withSelectedIds P.showPropertyEditor++showPropertyExport = withSelectedIds P.showPropertyExport++withSelectedIds f =+  f =<< playlistGetIds =<< getSelectedTracks
+ src/Playlist/DnD.hs view
@@ -0,0 +1,32 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 21 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist.DnD+  ( setupDnD+  ) where++import Atoms+import DnD+import Playlist.Model+import Playlist.View+import Playlist.Control+++setupDnD =+  setupDnDReorder xmms2PosList playlistStore playlistView moveTracks
+ src/Playlist/Edit.hs view
@@ -0,0 +1,82 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 26 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist.Edit+  ( editDelete+  , editCopy+  , editPaste+  , editSelectAll+  , editInvertSelection+  , editCheckClipboard+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans++import Graphics.UI.Gtk++import Atoms+import Utils+import Clipboard+import Playback+import Playlist.Model+import Playlist.View+import Playlist.Control+++editDelete cut = do+  tracks <- getSelectedTracks+  when cut $ copyIds tracks+  removeTracks tracks+  maybeTrack <- currentTrackThisPlaylist+  fmaybeM_ maybeTrack $ \t ->+    when (t `elem` tracks) restartPlayback++editCopy = copyIds =<< getSelectedTracks++editPaste append =+  clipboardRequestContents clipboard xmms2MlibId $ do+    maybeIds <- selectionDataGet selectionTypeInteger+    fmaybeM_ maybeIds $ \ids -> liftIO $ do+      (path, _) <- treeViewGetCursor playlistView+      insertIds ids $ case path of+        [n] | not append -> Just n+        _                -> Nothing++editSelectAll =+  treeSelectionSelectAll playlistSel++editInvertSelection = do+  rows <- treeSelectionGetSelectedRows playlistSel+  treeSelectionSelectAll playlistSel+  mapM_ (treeSelectionUnselectPath playlistSel) rows++editCheckClipboard =+  elem xmms2MlibId <$> getClipboardTargets+++copyIds tracks = do+  ids <- playlistGetIds tracks+  clipboardSetWithData clipboard+    [(xmms2MlibId, 0)]+    (const $ selectionDataSet selectionTypeInteger ids)+    (return ())+  return ()+
+ src/Playlist/Format.hs view
@@ -0,0 +1,170 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 22 Feb. 2010+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE TupleSections #-}++module Playlist.Format+  ( initFormat+  , makeTrackInfo+  , getFormatDefs+  , putFormatDefs+  , TrackInfo (..)+  , trackInfoAttrs+  , trackInfoText+  , trackInfoDuration+  , onFormatsChanged+  ) where++import Prelude hiding (lookup)++import Control.Applicative+import Control.Monad++import Data.IORef+import Data.Maybe+import Data.Either+import Data.Char (toLower)++import Graphics.UI.Gtk hiding (add)+import System.Glib.GError++import Medialib+import Properties+import Config+import Utils+import Context+import Handler+import Playlist.Format.Format+import Playlist.Format.Parser+++data TrackInfo+  = TrackInfo { tAttrs    :: [AttrOp CellRendererText]+              , tText     :: String+              , tDuration :: String }++trackInfoAttrs Nothing  = [ cellTextMarkup := Just "" ]+trackInfoAttrs (Just i) = tAttrs i++trackInfoText Nothing  = ""+trackInfoText (Just i) = tText i++trackInfoDuration Nothing  = ""+trackInfoDuration (Just i) = tDuration i+++data Format+  = Format { fMakeInfoRef      :: IORef (MediaInfo -> IO ([AttrOp CellRendererText], String))+           , fFormatDefsRef    :: IORef [String]+           , fLookupDuration   :: MediaInfo -> String+           , fLookupURL        :: MediaInfo -> String+           , fOnFormatsChanged :: HandlerMVar ()+           }++getMakeInfo = readIORef (fMakeInfoRef context)+putMakeInfo = writeIORef (fMakeInfoRef context)++getFormatDefs  = readIORef (fFormatDefsRef context)+putFormatDefs' = writeIORef (fFormatDefsRef context)+putFormatDefs defs = do+  putFormatDefs' defs+  saveFormatDefs+  updateFormats True++lookupDuration = fLookupDuration context+lookupURL      = fLookupURL context++onFormatsChanged = onHandler $ fOnFormatsChanged context+++initFormat = do+  context <- initContext+  let ?context = context++  loadFormatDefs+  onProperties . add . ever . const $+    updateFormats True++  return ?context++initContext = do+  formatDefsRef    <- newIORef []+  makeInfoRef      <- newIORef $ const $ return ([], "")+  duration         <- fromJust <$> property "Duration"+  url              <- fromJust <$> property "URL"+  onFormatsChanged <- makeHandlerMVar+  return $ augmentContext+    Format { fMakeInfoRef      = makeInfoRef+           , fFormatDefsRef    = formatDefsRef+           , fLookupDuration   = maybe "" escapeMarkup . lookup duration+           , fLookupURL        = maybe "" escapeMarkup . lookup url+           , fOnFormatsChanged = onFormatsChanged+           }+++loadFormatDefs = do+  putFormatDefs' . map trim =<< config "playlist-formats.conf" builtinFormats+  updateFormats False+  where builtinFormats =+          [ "<b>{Movement}[: {Title}]</b>\n\+            \{Composer} — {Work}[, {Catalog}]"+          , "<b>{Work}</b>[<b>, </b>{Catalog}]\n\+            \{Composer}"+          , "<b>{Movement}[: {Title}]</b>\n\+            \{Composer} — {Work}[, {Catalog}][\n\+            \{Performer}][\n\+            \[{Conductor}, ]{Orchestra}][\n\+            \[{Chorus master}, ]{Chorus}]"+          , "<b>{Work}</b>[<b>, </b>{Catalog}]\n\+            \{Composer}[\n\+            \{Performer}][\n\+            \[{Conductor}, ]{Orchestra}][\n\+            \[{Chorus master}, ]{Chorus}]"+          , "[{Track} ]<b>{Title}</b>\n\+            \{Artist} — {Album}" ]++saveFormatDefs = do+  writeConfig "playlist-formats.conf" =<< getFormatDefs+  return ()++getFormats = (rights . map parseFormat) <$> getFormatDefs++updateFormats notify = do+  putMakeInfo =<< makeMakeInfo =<< getFormats+  when notify $ onFormatsChanged $ invoke ()++makeTrackInfo info = do+  makeInfo      <- getMakeInfo+  (attrs, text) <- makeInfo info+  return TrackInfo { tAttrs    = attrs+                   , tText     = text+                   , tDuration = lookupDuration info }++makeMakeInfo fs = do+  fs' <- rights <$> mapM cookFormat fs+  return $ \pm -> do+    let (text, ellipsize) =+          maybe (lookupURL pm, EllipsizeMiddle) (, EllipsizeEnd) $+          formatMediaInfo fs' pm+    search <- map toLower <$> plain text+    return ( [ cellTextMarkup    := Just text+             , cellTextEllipsize := ellipsize ]+           , search )+  where plain text =+          (trd <$> parseMarkup text '\0') `catchGError` \_ -> return ""
+ src/Playlist/Format/Config.hs view
@@ -0,0 +1,253 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 1 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE TupleSections #-}++module Playlist.Format.Config+  ( FormatView+  , makePlaylistFormatView+  ) where++import Control.Monad++import Data.IORef++import System.IO.Unsafe++import Graphics.UI.Gtk++import Utils+import Compound+import Editor+++data FormatView+  = FormatView { fBox          :: HBox+               , fStore        :: ListStore String+               , fView         :: TreeView+               , fChanged      :: IORef Bool+               , fCids         :: [ConnectId (ListStore String)]+               }++instance CompoundWidget FormatView where+  type Outer FormatView = HBox+  outer = fBox++instance EditorWidget FormatView where+  type Data FormatView = [String]+  setData       = formatViewSetData+  getData       = formatViewGetData+  clearData     = formatViewClearData+  setupView     = formatViewSetupView+  focusView     = formatViewFocusView+  getState      = formatViewGetState+  resetModified = formatViewResetModified++formatViewSetData f d =+  withoutChanged f $ do+    let store = fStore f+    listStoreClear store+    mapM_ (listStoreAppend store) d++formatViewGetData =+  listStoreToList . fStore++formatViewClearData f =+  withoutChanged f . listStoreClear $ fStore f++formatViewSetupView f =+  treeViewSetCursor (fView f) [0] Nothing++formatViewFocusView =+  widgetGrabFocus . fView++formatViewGetState =+  liftM (True, ) . readIORef . fChanged++formatViewResetModified =+  flip writeIORef False . fChanged++withoutChanged FormatView { fCids = cids } =+  bracket_ (mapM_ signalBlock cids) (mapM_ signalUnblock cids)++makePlaylistFormatView parent onChanged = do+  box <- hBoxNew False 5+  containerSetBorderWidth box 7++  bbox <- vButtonBoxNew+  buttonBoxSetLayout bbox ButtonboxStart+  boxSetSpacing bbox 5+  boxPackEnd box bbox PackNatural 0++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  scrolledWindowSetShadowType scroll ShadowIn+  boxPackStartDefaults box scroll++  let mkButton m = do+        button <- buttonNewWithMnemonic m+        widgetSetCanFocus button False+        containerAdd bbox button+        return button++  addB    <- mkButton "_Add"+  editB   <- mkButton "_Edit"+  deleteB <- mkButton "_Delete"++  changedRef <- newIORef False+  store      <- listStoreNew []++  view  <- treeViewNewWithModel store+  treeViewSetRulesHint view True+  treeViewSetHeadersVisible view False+  treeViewSetReorderable view True+  containerAdd scroll view++  column <- treeViewColumnNew+  treeViewAppendColumn view column++  cell <- cellRendererTextNew+  treeViewColumnPackStart column cell True+  cellLayoutSetAttributes column cell store $ \t -> [ cellText := t ]++  sel <- treeViewGetSelection view+  treeSelectionSetMode sel SelectionBrowse+  sel `onSelectionChanged` do+    n <- treeSelectionCountSelectedRows sel+    let enable = n > 0+    widgetSetSensitive editB enable+    widgetSetSensitive deleteB enable++  let handleChange path _ = do+        treeViewSetCursor view path Nothing+        handleChange'+      handleChange' = do+        writeIORef changedRef True+        onChanged++  insId <- store `on` rowInserted $ handleChange+  chgId <- store `on` rowChanged  $ handleChange+  delId <- store `on` rowDeleted  $ \[n] -> do+    size <- listStoreGetSize store+    case size of+      0 -> return ()+      k -> treeViewSetCursor view [if k > n then n else k - 1] Nothing+    handleChange'++  editor <- unsafeInterleaveIO $ makeEditorDialog []+            makeFormatEditor $ \fe -> do+    let outerw = outer fe+    windowSetTitle outerw "Edit format"+    windowSetDefaultSize outerw 500 400++  let startEditing pos =+        runEditorDialog editor+        (case pos of+            Just pos -> listStoreGetValue store pos+            Nothing  -> return "")+        (\text -> case pos of+            Just pos -> do+              oldText <- listStoreGetValue store pos+              unless (text == oldText) $+                listStoreSetValue store pos text+            Nothing  -> do+              listStoreAppend store text+              return ())+        True parent++  view `onRowActivated` \[n] _ -> startEditing $ Just n+  addB    `onClicked` startEditing Nothing+  editB   `onClicked` do+    ([n], _) <- treeViewGetCursor view+    startEditing $ Just n+  deleteB `onClicked` do+    ([n], _) <- treeViewGetCursor view+    listStoreRemove store n++  return FormatView { fBox     = box+                    , fStore   = store+                    , fView    = view+                    , fChanged = changedRef+                    , fCids    = [insId, chgId, delId]+                    }+++data FormatEditor+  = FormatEditor+    { eScroll :: ScrolledWindow+    , eBuff   :: TextBuffer+    , eView   :: TextView+    , eCid    :: ConnectId TextBuffer+    }++instance CompoundWidget FormatEditor where+  type Outer FormatEditor = ScrolledWindow+  outer = eScroll++instance EditorWidget FormatEditor where+  type Data FormatEditor = String+  setData       = formatEditorSetData+  getData       = formatEditorGetData+  clearData     = formatEditorClearData+  setupView     = formatEditorSetupView+  focusView     = formatEditorFocusView+  getState      = formatEditorGetState+  resetModified = formatEditorResetModified++formatEditorSetData =+  textBufferSetText . eBuff++formatEditorGetData FormatEditor { eBuff = buff } = do+  start <- textBufferGetStartIter buff+  end   <- textBufferGetEndIter buff+  textBufferGetText buff start end False++formatEditorClearData =+  flip textBufferSetText "" . eBuff++formatEditorSetupView FormatEditor { eBuff = buff } = do+  start <- textBufferGetStartIter buff+  textBufferPlaceCursor buff start++formatEditorFocusView =+  widgetGrabFocus . eView++formatEditorGetState =+  liftM (True, ) . textBufferGetModified . eBuff++formatEditorResetModified e =+  withSignalBlocked (eCid e) $ textBufferSetModified (eBuff e) False++makeFormatEditor _ onStateChanged = do+  buff <- textBufferNew Nothing+  cid <- buff `on` modifiedChanged $ onStateChanged++  view <- textViewNewWithBuffer buff++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  scrolledWindowSetShadowType scroll ShadowIn+  containerSetBorderWidth scroll 7+  containerAdd scroll view++  return FormatEditor { eScroll = scroll+                      , eBuff   = buff+                      , eView   = view+                      , eCid    = cid+                      }
+ src/Playlist/Format/Format.hs view
@@ -0,0 +1,57 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 23 Feb. 2010+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--+--  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.+--++module Playlist.Format.Format+  ( Fe (..)+  , cookFormat+  , formatMediaInfo+  ) where++import Prelude hiding (lookup)++import Control.Applicative+import Control.Monad+import Control.Monad.Writer+import Control.Monad.Error++import Graphics.UI.Gtk (escapeMarkup)++import Properties+++data Fe a+  = FeP a+  | FeL String+  | FeO [Fe a]+++cookFormat fmt = runErrorT (mapM f fmt)+  where f (FeP n) =+          maybe (throwError "") (return . FeP) =<< (liftIO $ property n)+        f (FeL s) =+          return $ FeL s+        f (FeO l) =+          FeO <$> mapM f l++formatMediaInfo [] _         = Nothing+formatMediaInfo (fmt:fmts) m =+  execWriterT (mapM_ f fmt) `mplus` formatMediaInfo fmts m+  where f (FeP p) = tell . escapeMarkup =<< (lift $ lookup p m)+        f (FeL s) = tell s+        f (FeO l) = mapM_ f l `mplus` return ()
+ src/Playlist/Format/Parser.hs view
@@ -0,0 +1,52 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 23 Feb. 2010+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--+--  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.+--++module Playlist.Format.Parser+  ( parseFormat+  ) where++import Control.Applicative hiding (many, optional, (<|>))++import Text.Parsec+import Text.Parsec.String++import Playlist.Format.Format (Fe (..))+++parseFormat = parse format ""++format :: Parser [Fe String]+format = do+  fes <- many fe+  eof+  return fes++fe :: Parser (Fe String)+fe = feP <|> feO <|> feL++feP :: Parser (Fe String)+feP = FeP <$> between (char '{') (char '}') (many1 (noneOf "{}"))++feL :: Parser (Fe String)+feL = FeL <$> many1 (esc <|> noneOf "{}[]")++feO :: Parser (Fe String)+feO = FeO <$> between (char '[') (char ']') (many fe)++esc = char '\\' >> anyChar
+ src/Playlist/Index.hs view
@@ -0,0 +1,119 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 21 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module Playlist.Index+  ( initIndex+  , getInfo+  , addToIndex+  ) where++import Control.Applicative+import Control.Concurrent.MVar+import Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap++import Graphics.UI.Gtk hiding (add)++import Medialib hiding (getInfo)+import Context+import Handler+import Playlist.Model+import Playlist.Format+++data IndexEntry+  = IENone+  | IERetrieving+  | IEReady Stamp MediaInfo TrackInfo++data Index+  = Index { iTable :: MVar (IntMap (IndexEntry, [TreeRowReference])) }++index = iTable context+++initIndex = do+  context <- initContext+  let ?context = context++  onMediaInfo . add . ever $ handleInfo+  onFormatsChanged . add . ever . const $ handleFormats++  return ?context+++initContext = do+  table <- newMVar IntMap.empty+  return $ augmentContext+    Index { iTable = table }++handleInfo (id, stamp, info) = do+  let id' = fromIntegral id+  modifyMVar_ index $ \ix ->+    case IntMap.lookup id' ix of+      Just (entry, list) -> updateIndex ix id' stamp info entry list+      Nothing            -> return ix++handleFormats =+  modifyMVar_ index $ \ix ->+    IntMap.fromList <$> mapM update (IntMap.toList ix)+  where update (i, (IEReady s m _, l)) = do+          t <- makeTrackInfo m+          mapM touch l+          return (i, (IEReady s m t, l))+        update other =+          return other++updateIndex ix id stamp info old list =+  if upd+  then do+    ti <- makeTrackInfo info+    mapM_ touch list+    return $ IntMap.insert id (IEReady stamp info ti, list) ix+  else+    return ix+  where upd = case old of+          IEReady oldStamp _ _ -> stamp /= oldStamp+          _                    -> True++touch ref = do+  path <- treeRowReferenceGetPath ref+  case path of+    [n] -> touchPlaylist n+    _   -> return ()++getInfo id force = do+  let id' = fromIntegral id+  modifyMVar index $ \ix ->+    case IntMap.lookup id' ix of+      Just (IEReady _ _ info, _) ->+        return (ix, Just info)+      Just (IENone, list) | force -> do+        requestInfo id+        return (IntMap.insert id'(IERetrieving, list) ix, Nothing)+      _ ->+        return (ix, Nothing)++addToIndex id n =+  modifyMVar_ index $ \ix -> do+    Just ref <- treeRowReferenceNew playlistStore [n]+    return $ IntMap.insertWith iw (fromIntegral id) (IENone, [ref]) ix+  where iw (_, [new]) (entry, old) = (entry, new : old)
+ src/Playlist/Model.hs view
@@ -0,0 +1,91 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist.Model+  ( initModel+  , clearModel+  , playlistStore+  , getPlaylistName+  , setPlaylistName+  , getPlaylistSize+  , touchPlaylist+  , onPlaylistUpdated+  , playlistGetIds+  ) where++import Control.Concurrent.MVar++import Data.Int++import Graphics.UI.Gtk++import Context+import Utils+++data State+  = State { sName :: Maybe String }++data Model+  = Model { mStore             :: ListStore Int32+          , mOnPlaylistUpdated :: HandlerMVar ()+          , mState             :: MVar State+          }++playlistStore = mStore context+onPlaylistUpdated = onHandler (mOnPlaylistUpdated context)+state = mState context++getPlaylistName      = withMVar state (return . sName)+setPlaylistName name = modifyMVar_ state $ \s ->+  return s { sName = name }++getPlaylistSize = listStoreGetSize playlistStore++touchPlaylist n = do+  Just iter <- treeModelGetIter playlistStore [n]+  treeModelRowChanged playlistStore [n] iter++playlistGetIds =+  mapM (listStoreGetValue playlistStore)+++initModel = do+  context <- initContext+  let ?context = context++  return ?context++clearModel =+  listStoreClear playlistStore+++initContext = do+  store             <- listStoreNewDND [] Nothing Nothing+  onPlaylistUpdated <- makeHandlerMVar+  state             <- newMVar makeState+  return $ augmentContext+    Model { mStore             = store+          , mOnPlaylistUpdated = onPlaylistUpdated+          , mState             = state+          }++makeState =+  State { sName = Nothing }+
+ src/Playlist/Search.hs view
@@ -0,0 +1,41 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 23 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist.Search+  ( setupSearch+  ) where++import Data.List+import Data.Char++import Graphics.UI.Gtk++import Playlist.Model+import Playlist.Index+import Playlist.View+import Playlist.Format+++setupSearch = do+  treeViewSetEnableSearch playlistView True+  treeViewSetSearchEqualFunc playlistView $ Just $ \str iter -> do+    [n]  <- treeModelGetPath playlistStore iter+    mid  <- listStoreGetValue playlistStore n+    info <- getInfo mid True+    return $ isInfixOf (map toLower str) (trackInfoText info)
+ src/Playlist/UI.hs view
@@ -0,0 +1,366 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 22 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist.UI+  ( setupUI+  ) where++import Graphics.UI.Gtk hiding (add)++import XMMS2.Client++import UI+import XMMS+import Handler+import Playback+import Playtime+import Volume+import Utils+import Clipboard+import Location+import Collection+import Properties hiding (showPropertyEditor, showPropertyExport)+import Playlist.Model+import Playlist.View+import Playlist.Edit+import Playlist.Config+import Playlist.Control+++setupUI = do+  addUIActions uiActions++  srvAG <- actionGroupNew "server"+  actionGroupAddActions srvAG srvActions+  onServerConnectionAdd . ever $ actionGroupSetSensitive srvAG+  insertActionGroup srvAG 1++  play  <- getAction srvAG "play"+  pause <- getAction srvAG "pause"+  stop  <- getAction srvAG "stop"+  let setupPPS = do+        ps <- getPlaybackStatus+        let (ePlay, ePause, eStop) = case ps of+              Just StatusPlay  -> (False, True, True)+              Just StatusPause -> (True, False, True)+              _                -> (True, False, False)+        actionSetSensitive play ePlay+        actionSetVisible play ePlay+        actionSetSensitive pause ePause+        actionSetVisible pause ePause+        actionSetSensitive stop eStop++  prev <- getAction srvAG "prev"+  next <- getAction srvAG "next"+  let setupPN = do+        size <- getPlaylistSize+        name <- getPlaylistName+        cpos <- getCurrentTrack+        let (ep, en) = case (name, cpos) of+              (Just n, Just (ct, cn)) ->+                (n == cn && ct > 0, n == cn && ct < size - 1)+              _ ->+                (False, False)+        actionSetSensitive prev ep+        actionSetSensitive next en++  cut    <- getAction srvAG "cut"+  copy   <- getAction srvAG "copy"+  delete <- getAction srvAG "delete"+  editp  <- getAction srvAG "edit-properties"+  expp   <- getAction srvAG "export-properties"+  let setupSel = do+        n <- treeSelectionCountSelectedRows playlistSel+        mapM_ (flip actionSetSensitive (n /= 0))+          [cut, copy, delete, editp, expp]++  paste  <- getAction srvAG "paste"+  append <- getAction srvAG "append"+  let setupPA = do+        en <- editCheckClipboard+        mapM_ (flip actionSetSensitive en) [paste, append]++  onPlaybackStatus   . add . ever . const $ setupPPS+  onCurrentTrack     . add . ever . const $ setupPN+  onPlaylistUpdated  . add . ever . const $ setupPN+  onClipboardTargets . add . ever . const $ setupPA+  playlistSel `onSelectionChanged` setupSel+  flip timeoutAdd 0 $ do+    setupPPS+    setupPN+    setupSel+    setupPA+    return False++  addUIFromFile "playlist"++  playlistView `onRowActivated` \[n] _ ->+    playTrack n++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  containerAdd scroll playlistView+  boxPackStartDefaults contents scroll++  playbar <- getWidget castToToolbar "ui/playbar"+  toolbarSetStyle playbar ToolbarIcons+  boxPackEnd contents playbar PackNatural 0++  sep <- separatorToolItemNew+  separatorToolItemSetDraw sep False+  toolbarInsert playbar sep (-1)++  seekView <- makeSeekControl+  seekItem <- toolItemNew+  toolItemSetHomogeneous seekItem False+  toolItemSetExpand seekItem True+  containerAdd seekItem seekView+  toolbarInsert playbar seekItem (-1)++  sep <- separatorToolItemNew+  separatorToolItemSetDraw sep False+  toolbarInsert playbar sep (-1)++  volView <- makeVolumeControl+  volumeItem <- toolItemNew+  toolItemSetHomogeneous volumeItem False+  toolItemSetExpand volumeItem False+  widgetSetSizeRequest volumeItem 100 (-1)+  containerAdd volumeItem volView+  toolbarInsert playbar volumeItem (-1)++  popup <- getWidget castToMenu "ui/playlist-popup"+  setupTreeViewPopup playlistView popup++  window `onDestroy` mainQuit+++uiActions =+  [ ActionEntry+    { actionEntryName        = "music"+    , actionEntryLabel       = "_Music"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "edit"+    , actionEntryLabel       = "_Edit"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "browse"+    , actionEntryLabel       = "_Browse"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "playlist"+    , actionEntryLabel       = "_Playlist"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "configure-playlist"+    , actionEntryLabel       = "C_onfigure playlist"+    , actionEntryStockId     = Just stockPreferences+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showPlaylistConfigDialog+    }+  , ActionEntry+    { actionEntryName        = "properties"+    , actionEntryLabel       = "P_roperties"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "manage-properties"+    , actionEntryLabel       = "_Manage properties"+    , actionEntryStockId     = Just stockPreferences+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showPropertyManager+    }+  , ActionEntry+    { actionEntryName        = "playlist-popup"+    , actionEntryLabel       = ""+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  ]++srvActions =+  [ ActionEntry+    { actionEntryName        = "play"+    , actionEntryLabel       = "_Play"+    , actionEntryStockId     = Just stockMediaPlay+    , actionEntryAccelerator = Just "<Control>space"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = startPlayback False+    }+  , ActionEntry+    { actionEntryName        = "pause"+    , actionEntryLabel       = "_Pause"+    , actionEntryStockId     = Just stockMediaPause+    , actionEntryAccelerator = Just "<Control>space"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = pausePlayback+    }+  , ActionEntry+    { actionEntryName        = "stop"+    , actionEntryLabel       = "_Stop"+    , actionEntryStockId     = Just stockMediaStop+    , actionEntryAccelerator = Just "<Control>s"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = stopPlayback+    }+  , ActionEntry+    { actionEntryName        = "prev"+    , actionEntryLabel       = "P_revious track"+    , actionEntryStockId     = Just stockMediaPrevious+    , actionEntryAccelerator = Just "<Control>p"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = prevTrack+    }+  , ActionEntry+    { actionEntryName        = "next"+    , actionEntryLabel       = "_Next track"+    , actionEntryStockId     = Just stockMediaNext+    , actionEntryAccelerator = Just "<Control>n"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = nextTrack+    }+  , ActionEntry+    { actionEntryName        = "cut"+    , actionEntryLabel       = "Cu_t"+    , actionEntryStockId     = Just stockCut+    , actionEntryAccelerator = Just "<Control>x"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editDelete True+    }+  , ActionEntry+    { actionEntryName        = "copy"+    , actionEntryLabel       = "_Copy"+    , actionEntryStockId     = Just stockCopy+    , actionEntryAccelerator = Just "<Control>c"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editCopy+    }+  , ActionEntry+    { actionEntryName        = "paste"+    , actionEntryLabel       = "_Paste"+    , actionEntryStockId     = Just stockPaste+    , actionEntryAccelerator = Just "<Control>v"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editPaste False+    }+  , ActionEntry+    { actionEntryName        = "append"+    , actionEntryLabel       = "_Append"+    , actionEntryStockId     = Just stockPaste+    , actionEntryAccelerator = Just "<Control><Shift>v"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editPaste True+    }+  , ActionEntry+    { actionEntryName        = "delete"+    , actionEntryLabel       = "_Delete"+    , actionEntryStockId     = Just stockDelete+    , actionEntryAccelerator = Just "Delete"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editDelete False+    }+  , ActionEntry+    { actionEntryName        = "select-all"+    , actionEntryLabel       = "_Select all"+    , actionEntryStockId     = Just stockSelectAll+    , actionEntryAccelerator = Just "<Control>a"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editSelectAll+    }+  , ActionEntry+    { actionEntryName        = "invert-selection"+    , actionEntryLabel       = "_Invert selection"+    , actionEntryStockId     = Just stockSelectAll+    , actionEntryAccelerator = Just "<Control><Shift>a"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = editInvertSelection+    }+  , ActionEntry+    { actionEntryName        = "browse-location"+    , actionEntryLabel       = "Browse _location"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = browseLocation SortAscending Nothing+    }+  , ActionEntry+    { actionEntryName        = "browse-collection"+    , actionEntryLabel       = "Browse _collection"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = browseCollection Nothing+    }+  , ActionEntry+    { actionEntryName        = "clear-playlist"+    , actionEntryLabel       = "_Clear playlist"+    , actionEntryStockId     = Just stockClear+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = clearPlaylist+    }+  , ActionEntry+    { actionEntryName        = "edit-properties"+    , actionEntryLabel       = "_Edit properties"+    , actionEntryStockId     = Just stockEdit+    , actionEntryAccelerator = Just "<Alt>Return"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showPropertyEditor+    }+  , ActionEntry+    { actionEntryName        = "export-properties"+    , actionEntryLabel       = "E_xport properties"+    , actionEntryStockId     = Just stockSave+    , actionEntryAccelerator = Just ""+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showPropertyExport+    }+  , ActionEntry+    { actionEntryName        = "import-properties"+    , actionEntryLabel       = "_Import properties"+    , actionEntryStockId     = Just stockOpen+    , actionEntryAccelerator = Just ""+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showPropertyImport+    }+  ]
+ src/Playlist/Update.hs view
@@ -0,0 +1,132 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist.Update+  ( setupUpdate+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Data.Maybe++import Graphics.UI.Gtk hiding (add)++import XMMS2.Client++import XMMS+import Handler+import Playback+import Playlist.Model+import Playlist.Index+import Playlist.View+++setupUpdate = do+  onServerConnectionAdd . ever $ \conn ->+    if conn+    then do+      playlistCurrentActive xmms >>* do+        setupPlaylist+        liftIO $ broadcastPlaylistChanged xmms >>* handleChange+        return False+      broadcastPlaylistLoaded xmms >>* do+        setupPlaylist+        return True+    else do+      setPlaylistName Nothing+      updateWindowTitle+      clearModel++  onPlaybackStatus . add . ever . const $ do+    maybeCT <- getCurrentTrack+    name    <- fromMaybe "" <$> getPlaylistName+    size    <- getPlaylistSize+    case maybeCT of+      Just (ct, cname) | cname == name && ct < size ->+        touchPlaylist ct+      _ ->+        return ()++  onCurrentTrack . add . ever $ \old -> do+    name <- fromMaybe "" <$> getPlaylistName+    size <- getPlaylistSize+    case old of+      Just (ot, oname) | oname == name && ot < size ->+        touchPlaylist ot+      _ ->+        return ()+    new <- getCurrentTrack+    case new of+      Just (nt, nname) | nname == name && nt < size ->+        touchPlaylist nt+      _ ->+        return ()++setupPlaylist = do+  name <- result+  liftIO $ do+    setPlaylistName $ Just name+    updateWindowTitle+    requestPlaylist name++requestPlaylist name =+  playlistListEntries xmms (Just name) >>* handlePlaylist++handlePlaylist = do+  ids <- result+  liftIO $ do+    clearModel+    mapM_ addToPlaylist ids+    requestCurrentTrack+    onPlaylistUpdated $ invoke ()+  return False++addToPlaylist id = do+  n <- listStoreAppend playlistStore id+  addToIndex id n++handleChange = do+  change <- result+  liftIO $ do+    name <- fromMaybe "" <$> getPlaylistName+    when (name == playlist change) $+      case change of+        PlaylistRemove { position = p } -> do+          listStoreRemove playlistStore p+          onPlaylistUpdated $ invoke ()+        PlaylistAdd { mlibId = id } -> do+          n <- listStoreAppend playlistStore id+          addToIndex id n+          onPlaylistUpdated $ invoke ()+        PlaylistInsert { mlibId = id, position = n } -> do+          listStoreInsert playlistStore n id+          addToIndex id n+          onPlaylistUpdated $ invoke ()+        PlaylistMove { mlibId = id, position = o, newPosition = n } -> do+          listStoreRemove playlistStore o+          listStoreInsert playlistStore n id+          addToIndex id n+          onPlaylistUpdated $ invoke ()+        PlaylistClear {} -> do+          clearModel+          onPlaylistUpdated $ invoke ()+        _ ->+          requestPlaylist name+  return True
+ src/Playlist/View.hs view
@@ -0,0 +1,125 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playlist.View+  ( initView+  , playlistView+  , playlistSel+  , updateWindowTitle+  , getSelectedTracks+  ) where++import Control.Applicative++import Data.Maybe++import Graphics.UI.Gtk++import XMMS2.Client++import Context+import UI+import Playback+import Playlist.Model+import Playlist.Index+import Playlist.Format+--import Playlist.Control+++data View+  = View { vView :: TreeView+         , vSel  :: TreeSelection }++playlistView = vView context+playlistSel  = vSel context+++initView = do+  context <- initContext+  let ?context = context++  treeViewSetRulesHint playlistView True+  treeViewSetReorderable playlistView True+  treeViewSetHeadersVisible playlistView False++  treeSelectionSetMode playlistSel SelectionMultiple++  column <- treeViewColumnNew+  treeViewInsertColumn playlistView column 0++  cell <- cellRendererPixbufNew+  cell `set` [ cellWidth := 30 ]+  treeViewColumnPackStart column cell False+  cellLayoutSetAttributeFunc column cell playlistStore $ \iter -> do+    [n] <- treeModelGetPath playlistStore iter+    maybeCT <- getCurrentTrack+    name <- fromMaybe "" <$> getPlaylistName+    cell `set` [ cellPixbufStockId :=>+                 case maybeCT of+                   Just (cp, cname) | cp == n && cname == name -> do+                     maybeStatus <- getPlaybackStatus+                     case maybeStatus of+                       Just StatusPlay  -> return stockMediaPlay+                       Just StatusPause -> return stockMediaPause+                       Just StatusStop  -> return stockMediaStop+                       _                -> return ""+                   _ ->+                     return ""+               ]++  cell <- cellRendererTextNew+  treeViewColumnPackStart column cell True+  cellLayoutSetAttributeFunc column cell playlistStore $ \iter -> do+    info <- getInfoIfNeeded iter+    cell `set` trackInfoAttrs info++  cell <- cellRendererTextNew+  treeViewColumnPackStart column cell False+  cellLayoutSetAttributeFunc column cell playlistStore $ \iter -> do+    info <- getInfoIfNeeded iter+    cell `set` [ cellText := trackInfoDuration info ]++  return ?context+++getInfoIfNeeded iter = do+  [n] <- treeModelGetPath playlistStore iter+  mid <- listStoreGetValue playlistStore n+  rng <- treeViewGetVisibleRange playlistView+  getInfo mid $ case rng of+    ([f], [t]) -> n >= f && t >= n+    _          -> False+++updateWindowTitle = do+  maybeName <- getPlaylistName+  setWindowTitle $ case maybeName of+    Nothing   -> "Vision playlist"+    Just name -> name ++ " - Vision playlist"++initContext = do+  view <- treeViewNewWithModel playlistStore+  sel  <- treeViewGetSelection view+  return $ augmentContext+    View { vView = view+         , vSel  = sel }+++getSelectedTracks =+  map head <$> treeSelectionGetSelectedRows playlistSel
+ src/Playtime.hs view
@@ -0,0 +1,196 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 22 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Playtime+  ( initPlaytime+  , makeSeekControl+  ) where++import Control.Concurrent.MVar+import Control.Applicative+import Control.Monad+import Control.Monad.Trans++import qualified Data.Map as Map+import Data.IORef+import Data.Word+import Data.Maybe++import Graphics.UI.Gtk hiding (add, remove)++import XMMS2.Client++import XMMS+import Handler+import Medialib+import Context+import Utils+import Playback+++data State+  = State { sCurrentId :: Maybe MediaId }++data Playtime+  = Playtime { pState :: MVar State+             , pAdj   :: Adjustment+             , pCId   :: ConnectId Adjustment }++state = pState context+cId   = pCId context+adj   = pAdj context++getCurrentId    = withMVar state $ return . sCurrentId+setCurrentId id = modifyMVar_ state $ \s -> return  s { sCurrentId = id }++initPlaytime = do+  updateRef <- initUpdate+  let ?updateRef = updateRef++  context <- initContext+  let ?context = context++  onServerConnectionAdd . ever $ \conn ->+    if conn+    then do+      playbackCurrentId xmms >>* handleCurrentId False+      broadcastPlaybackCurrentId xmms >>* handleCurrentId True+      playbackPlaytime xmms >>* handlePlaytime 0 False+      signalPlaybackPlaytime xmms >>* handlePlaytime 1000 True+    else do+      resetState+      setValue 0+      resetUpdate (+ 1)++  onMediaInfo . add . ever $ handleInfo+  onPlaybackStatusAdd . ever $ \status ->+    when (fromMaybe StatusStop status == StatusStop) $+      setValue 0++  return ?context+++initContext = do+  state <- newMVar makeState+  adj <- adjustmentNew 0 0 bigNum 5000 5000 0+  cId <- adj `onValueChanged` do+    pos <- adjustmentGetValue adj+    seek pos++  return $ augmentContext+    Playtime { pState = state+             , pAdj   = adj+             , pCId   = cId }++makeState =+  State { sCurrentId = Nothing }++resetState =+  modifyMVar_ state $ const $ return makeState++handleCurrentId ret = do+  cid <- result+  liftIO $ do+    setCurrentId $+      if cid == 0+      then Nothing+      else Just cid+    requestInfo cid+  return ret++handleInfo (id, _, info) = do+  cid <- getCurrentId+  when (cid == Just id) $ do+    case Map.lookup "duration" info of+      Just (PropInt32 d) -> setUpper $ fromIntegral d+      _                  -> return ()++bigNum = 10000000000.0++seek pos = do+  putStrLn $ "seek to " ++ show pos+  eid <- disableUpdate+  playbackSeekMs xmms (round pos) SeekSet >>* do+    liftIO $ scheduleEnableUpdate eid+    return False+  return ()++data Update+  = Update { uEnabled   :: Bool+           , uEnablerId :: Maybe HandlerId+           , uStamp     :: Word32 }++initUpdate =+  newIORef Update { uEnabled   = True+                  , uEnablerId = Nothing+                  , uStamp     = 0 }++resetUpdate f =+  modifyIORef ?updateRef $ \up ->+    up { uEnabled   = True+       , uEnablerId = Nothing+       , uStamp     = f $ uStamp up }++updateEnabled = uEnabled <$> readIORef ?updateRef++disableUpdate = do+  up <- readIORef ?updateRef+  maybe (return ()) timeoutRemove $ uEnablerId up+  let stamp = uStamp up + 1+  writeIORef ?updateRef Update { uEnabled   = False+                               , uEnablerId = Nothing+                               , uStamp     = stamp }+  return stamp++scheduleEnableUpdate stamp = do+  eid <- (flip timeoutAdd) 500 $ do+    stamp' <- uStamp <$> readIORef ?updateRef+    when (stamp == stamp') $ resetUpdate id+    return False+  modifyIORef ?updateRef $ \up -> up { uEnablerId = Just eid }++getValue = adjustmentGetValue adj+setValue = withoutSeek . adjustmentSetValue adj+setUpper = withoutSeek . adjustmentSetUpper adj++withoutSeek =+  bracket_ (signalBlock cId) (signalUnblock cId)++handlePlaytime diff ret = do+  newPt <- catchResult 0 fromIntegral+  liftIO $ do+    en <- updateEnabled+    ps <- getPlaybackStatus+    when (en && fromMaybe StatusStop ps /= StatusStop) $ do+      oldPt <- getValue+      when (abs (newPt - oldPt) >= diff) $ setValue newPt+  return ret++makeSeekControl = do+  view <- hScaleNew adj+  scaleSetDrawValue view False+  rangeSetUpdatePolicy view UpdateContinuous+  widgetSetCanFocus view False++  id <- onPlaybackStatusAdd . ever $+    widgetSetSensitive view . (Just StatusPlay ==)+  view `onDestroy` do+    onPlaybackStatus $ remove id++  return view
+ src/Properties.hs view
@@ -0,0 +1,60 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 22 Sep. 2009+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--+--  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.+--++module Properties+  ( PropertyType (..)+  , Property (..)+  , readValue+  , showValue+  , lookup+  , initProperties+  , property+  , showPropertyManager+  , showPropertyEditor+  , onProperties+  , showPropertyExport+  , showPropertyImport+  , module Properties.View+  ) where++import Prelude hiding (lookup)++import Properties.Property+import Properties.Model+import Properties.View+import Properties.Manager+import Properties.Editor+import Properties.Impex+++initProperties = do+  context <- initModel+  let ?context = context++  context <- initPropertyManager+  let ?context = context++  context <- initPropertyEditor+  let ?context = context++  context <- initImpex+  let ?context = context++  return ?context+
+ src/Properties/Editor.hs view
@@ -0,0 +1,41 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 6 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Properties.Editor+  ( initPropertyEditor+  , showPropertyEditor+  ) where++import Properties.Editor.Model+import Properties.Editor.View+import Properties.Editor.UI+++initPropertyEditor = do+  context <- initEditorModel+  let ?context = context++  context <- initEditorView+  let ?context = context++  context <- initEditorUI+  let ?context = context++  return ?context+
+ src/Properties/Editor/Model.hs view
@@ -0,0 +1,264 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 6 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Properties.Editor.Model+  ( initEditorModel+  , store+  , populateModel+  , resetModel+  , propertyText+  , getNavEnables+  , prevTrack+  , nextTrack+  , togglePerTrack+  , changeProperty+  , writeProperties+  ) where++import Prelude hiding (lookup)++import Control.Concurrent.MVar+import Control.Monad.State hiding (State, withState)+import Control.Applicative++import Data.Maybe+import Data.List hiding (lookup)+import Data.Array+import Data.Map (Map)+import qualified Data.Map as Map++import Graphics.UI.Gtk hiding (add, get, Entry)++import qualified XMMS2.Client as X++import XMMS+import Context+import Config+import Utils+import Handler+import Medialib+import Properties.Property+import Properties.Model+++type Entry = (MediaInfo, MediaInfo)++data State+  = State { sPos      :: Int+          , sSize     :: Int+          , sIds      :: Array Int X.MediaId+          , sEntries  :: Map X.MediaId Entry+          , sCurrent  :: Entry+          , sPerTrack :: Bool+          }++makeState list =+  let size    = length list+      ids     = array (0, size - 1) $ zip [0 .. ] $ map fst list+      entries = Map.fromList $+        map (\(id, info) -> (id, (info, Map.empty))) list+      current = fromJust $ Map.lookup (ids ! 0) entries+  in State { sPos      = 0+           , sSize     = size+           , sIds      = ids+           , sEntries  = entries+           , sCurrent  = current+           , sPerTrack = True+           }++data Model+  = Model { mState :: MVar (Maybe State)+          , mStore :: ListStore Property+          }++state = mState context+store = mStore context++setupState list =+  modifyMVar_ state . const . return . Just $ makeState list++resetState =+  modifyMVar_ state . const $ return Nothing++withState d f =+  modifyMVar state $ \state ->+    case state of+      Just s  -> do+        (a, s') <- runStateT f s+        return (Just s', a)+      Nothing ->+        return (Nothing, d)++initEditorModel = do+  context <- initContext+  let ?context = context++  cid <- store `on` rowDeleted $ const saveConfig+  onProperties . add . ever . const $+    withSignalBlocked cid updateProperties++  onServerConnection . add . ever $ \conn ->+    unless conn $ do+      resetModel+      touchAll++  loadConfig++  return ?context++initContext = do+  state <- newMVar Nothing+  store <- listStoreNew []+  return $ augmentContext+    Model { mState = state+          , mStore = store+          }++loadConfig = do+  cfg <- mapM property =<< config configFile []+  populateStore cfg++saveConfig = do+  names <- map propName <$> listStoreToList store+  writeConfig configFile names+  return ()++updateProperties = do+  cur <- mapM (property . propName) =<< listStoreToList store+  listStoreClear store+  populateStore cur++populateStore cur = do+  all <- getProperties+  mapM_ (listStoreAppend store) $+    unionBy (eqBy propName) (catMaybes cur) all++configFile = "property-editor.conf"++populateModel list = do+  setupState list+  touchAll++resetModel =+  resetState++propertyText prop = withState "" $ do+  (b, c) <- gets sCurrent+  let key = propKey prop+      val = Map.lookup key c `mplus` Map.lookup key b+  return $ maybe "" (showValue prop) val++getNavEnables = withState (False, False) $ do+  t <- gets sPerTrack+  p <- gets sPos+  s <- gets sSize+  return (t && p > 0, t && p < s - 1)++prevTrack = stepTrack (-1)+nextTrack = stepTrack 1++stepTrack inc = do+  withState () $ modify $ \s ->+    let e = Map.insert (sIds s ! sPos s) (sCurrent s) (sEntries s)+        p = sPos s + inc+        c = e Map.! (sIds s ! p) in+    s { sEntries = e+      , sPos     = p+      , sCurrent = c+      }+  touchAll++touchAll = do+  s <- listStoreGetSize store+  mapM_ touch [0 .. s - 1]++touch n = do+  Just iter <- treeModelGetIter store [n]+  treeModelRowChanged store [n] iter++togglePerTrack = do+  withState () $ modify $ \s ->+    if sPerTrack s+    then let+      e = Map.insert (sIds s ! sPos s) (sCurrent s) (sEntries s)+      c = (common $ Map.elems e, Map.empty)+      in s { sPerTrack = False+           , sEntries  = e+           , sCurrent  = c+           }+    else let+      u = snd $ sCurrent s+      e = Map.map (\(b, c) -> (b, Map.union u c)) $ sEntries s+      c = e Map.! (sIds s ! sPos s)+      in s { sPerTrack = True+           , sEntries  = e+           , sCurrent  = c+           }+  touchAll++common e =+  let (c, i)     = foldl g (h, h) t+      f a b      = if a == b then Just a else Nothing+      g (c, i) e = (Map.differenceWith f c e, Map.intersection i e)+      (h : t)    = map (uncurry $ flip Map.union) e+  in Map.intersection c i++changeProperty n prop text = do+  maybeVal <- case trim text of+    [] -> return . Just $ X.PropString ""+    st -> readValue prop st+  case maybeVal of+    Nothing  -> return False+    Just val -> withState False $ do+      (b, c) <- gets sCurrent+      let key = propKey prop+          cur = Map.lookup key c `mplus` Map.lookup key b+          res = maybeVal /= cur+      when res $ do+        modify $ \s -> s { sCurrent = (b, Map.insert key val c) }+        liftIO $ touch n+      return res++writeProperties = do+  changes <- withState [] extractChanges+  mapM_ writeForId changes+  where writeForId (id, cs) =+          mapM_ (writeProperty id) cs++writeProperty id (key, val) =+  X.medialibEntryPropertySet xmms id+  (Just "client/generic/override")+  key val++extractChanges = do+  s <- get+  let c = sCurrent s+      e = case sPerTrack s of+        True  ->+          Map.insert (sIds s ! sPos s) c (sEntries s)+        False ->+          let u = snd c in+          Map.map (\(b, c) -> (b, Map.union u c)) $ sEntries s+      e' = Map.map (\(b, c) -> (Map.union c b, Map.empty)) e+  put s { sEntries = e'+        , sCurrent = (Map.union (snd c) (fst c), Map.empty)+        }+  return $ map (\(id, (_, c)) -> (id, Map.toList c)) $ Map.toList e++
+ src/Properties/Editor/UI.hs view
@@ -0,0 +1,224 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 6 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Properties.Editor.UI+  ( initEditorUI+  , showPropertyEditor+  ) where++import Control.Concurrent.MVar+import Control.Monad++import Data.IORef++import Graphics.UI.Gtk hiding (add, remove)++import Context+import Utils+import Handler+import UI+import XMMS+import Medialib+import Properties.Editor.Model+import Properties.Editor.View+++data UI+  = UI { uLock    :: MVar ()+       , uDialog  :: Dialog+       , uPrevB   :: Button+       , uNextB   :: Button+       , uPtrkB   :: ToggleButton+       , uPBar    :: ProgressBar+       , uCancel  :: IORef (Maybe (IO ()))+       }++tryLock f =+  maybe (return False) (const $ f >> return True)+  =<< (tryTakeMVar $ uLock context)+unlock  = tryPutMVar (uLock context) () >> return ()++dialog = uDialog context++prevB = uPrevB context+nextB = uNextB context+ptrkB = uPtrkB context+pBar  = uPBar  context++setRetrievalCancel = writeIORef (uCancel context) . Just+cancelRetrieval    = do+  cancel' <- readIORef (uCancel context)+  fmaybeM_ cancel' id+  writeIORef (uCancel context) Nothing+++initEditorUI = do+  context <- initContext+  let ?context = context++  hideOnDeleteEvent dialog+  windowSetModal dialog False+  windowSetTitle dialog "Edit properties"+  windowSetDefaultSize dialog 800 600+  dialogSetHasSeparator dialog False++  dialogAddButton   dialog stockApply  ResponseApply+  dialogAddButton   dialog stockCancel ResponseCancel+  dialogAddButtonCR dialog stockOk     ResponseOk++  box <- vBoxNew False 0+  containerSetBorderWidth box 7+  upper <- dialogGetUpper dialog+  boxPackStartDefaults upper box++  hbox <- hBoxNew False 15+  boxPackStart box hbox PackNatural 7++  bbox <- hButtonBoxNew+  buttonBoxSetLayout bbox ButtonboxStart+  boxSetSpacing bbox 7+  boxPackStart hbox bbox PackNatural 0++  boxPackStartDefaults hbox pBar++  prevB `onClicked` (prevTrack >> updateNavButtons)+  widgetSetCanFocus prevB False+  containerAdd bbox prevB++  nextB `onClicked` (nextTrack >> updateNavButtons)+  widgetSetCanFocus nextB False+  containerAdd bbox nextB++  ptrkB `onToggled` (togglePerTrack >> updateNavButtons)+  widgetSetCanFocus ptrkB False+  containerAdd bbox ptrkB++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  scrolledWindowSetShadowType scroll ShadowIn+  containerAdd scroll view+  boxPackStartDefaults box scroll++  onPropertyEdited $ \[n] t -> do+    prop <- listStoreGetValue store n+    chok <- changeProperty n prop t+    when chok $ do+      dialogSetResponseSensitive dialog ResponseApply True+      updateTitle True False++  dialog `onResponse` \resp ->+    case resp of+      ResponseApply -> do+        doWriteProperties+        dialogSetResponseSensitive dialog ResponseOk True+        widgetGrabFocus view+      ResponseOk    -> do+        doWriteProperties+        hideEditor+      _             -> do+        cancelRetrieval+        hideEditor++  onServerConnection . add . ever $ \conn ->+    unless conn $ do+      cancelRetrieval+      widgetSetSensitive prevB False+      widgetSetSensitive nextB False+      widgetSetSensitive ptrkB False+      dialogSetResponseSensitive dialog ResponseApply False+      dialogSetResponseSensitive dialog ResponseOk False+      progressBarSetFraction pBar 0+      progressBarSetText pBar "Disconnected"+      updateTitle False False+      unlock++  widgetShowAll box+  return ?context++doWriteProperties = do+  dialogSetResponseSensitive dialog ResponseApply False+  dialogSetResponseSensitive dialog ResponseOk False+  writeProperties+  updateTitle False False++hideEditor = do+  widgetHide dialog+  resetModel+  unlock++updateTitle m r = do+  c <- connected+  windowSetTitle dialog $ case c of+    False    -> "Edit properties (disconnected)"+    True | m -> "Edit properties (modified)"+    _    | r -> "Edit properties (retrieving)"+    _        -> "Edit properties"++showPropertyEditor ids = do+  retr <- tryLock $ do+    dialogSetResponseSensitive dialog ResponseApply False+    dialogSetResponseSensitive dialog ResponseOk False+    widgetSetSensitive ptrkB False+    updateNavButtons+    widgetShow pBar+    resetView+    setRetrievalCancel =<< do+      progressBarSetFraction pBar 0+      progressBarSetText pBar "Retrieving properties"+      retrieveProperties ids $ \prog ->+        case prog of+          Left frac  ->+            progressBarSetFraction pBar frac+          Right list -> do+            toggleButtonSetActive ptrkB True+            widgetSetSensitive ptrkB True+            populateModel list+            dialogSetResponseSensitive dialog ResponseApply False+            dialogSetResponseSensitive dialog ResponseOk True+            updateNavButtons+            widgetHide pBar+            updateTitle False False+  widgetHide dialog+  windowSetTransientFor dialog window+  updateTitle False retr+  windowPresent dialog++initContext = do+  lock    <- newMVar ()+  dialog  <- dialogNew+  prevB   <- buttonNewWithMnemonic "_Previous track"+  nextB   <- buttonNewWithMnemonic "_Next track"+  ptrkB   <- toggleButtonNewWithMnemonic "Per _track"+  pBar    <- progressBarNew+  cancel  <- newIORef Nothing+  return $ augmentContext+    UI { uLock    = lock+       , uDialog  = dialog+       , uPrevB   = prevB+       , uNextB   = nextB+       , uPtrkB   = ptrkB+       , uPBar    = pBar+       , uCancel  = cancel+       }++updateNavButtons = do+  (ep, en) <- getNavEnables+  widgetSetSensitive prevB ep+  widgetSetSensitive nextB en+
+ src/Properties/Editor/View.hs view
@@ -0,0 +1,88 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 6 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Properties.Editor.View+  ( initEditorView+  , view+  , resetView+  , onPropertyEdited+  ) where++import Graphics.UI.Gtk++import Context+import XMMS+import Properties.Property+import Properties.Editor.Model+++data View+  = View { vView    :: TreeView+         , vValCol  :: TreeViewColumn+         , vValCell :: CellRendererText+         }++view    = vView context+valCol  = vValCol context+valCell = vValCell context++onPropertyEdited = valCell `on` edited++resetView = do+  treeViewSetCursor view [0] $ Just (valCol, False)+  widgetGrabFocus view+++initEditorView = do+  context <- initContext+  let ?context = context++  treeViewSetRulesHint view True+  treeViewSetHeadersVisible view False+  treeViewSetReorderable view True++  column <- treeViewColumnNew+  treeViewAppendColumn view column+  cell <- cellRendererTextNew+  treeViewColumnPackStart column cell True+  cellLayoutSetAttributes column cell store $ \prop ->+    [ cellText       := propName prop+    , cellTextWeight := 800+    ]++  treeViewAppendColumn view valCol+  treeViewColumnPackStart valCol valCell True+  cellLayoutSetAttributes valCol valCell store $ \prop ->+    [ cellText         :=> propertyText prop+    , cellTextEditable :=> do+      c <- connected+      return $ c && (not $ propReadOnly prop)+    ]++  return ?context++initContext = do+  view    <- treeViewNewWithModel store+  valCol  <- treeViewColumnNew+  valCell <- cellRendererTextNew+  return $ augmentContext+    View { vView    = view+         , vValCol  = valCol+         , vValCell = valCell+         }
+ src/Properties/Impex.hs view
@@ -0,0 +1,203 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 12 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE DoRec, TupleSections #-}+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module Properties.Impex+  ( initImpex+  , showPropertyExport+  , showPropertyImport+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Trans+import Control.Concurrent.MVar++import Data.Char+import qualified Data.Map as Map+import Data.Maybe+import Data.List++import Codec.Binary.UTF8.String++import System.FilePath+import System.IO.Error+import System.IO.Unsafe++import Text.JSON++import Graphics.UI.Gtk++import XMMS2.Client hiding (Property)+import qualified XMMS2.Client as X++import UI+import Context+import Medialib+import Utils+import XMMS+++data Impex+  = Impex { iExportDlg :: Chooser+          , iImportDlg :: Chooser+          }+++showPropertyExport =+  runChooser (iExportDlg context) . exportProps++showPropertyImport =+  runChooser (iImportDlg context) importProps+++initImpex = do+  context <- initContext+  let ?context = context++  return ?context++initContext = do+  exportDlg <- unsafeInterleaveIO makeExportDlg+  importDlg <- unsafeInterleaveIO makeImportDlg+  return $ augmentContext+    Impex { iExportDlg = exportDlg+          , iImportDlg = importDlg+          }++makeExportDlg =+  makeChooser "Export properties" FileChooserActionSave stockSave++exportProps ids file = do+  pbar <- progressBarNew -- FIXME+  retrieveProperties ids $ \prog ->+    case prog of+      Left _     -> return ()+      Right list -> do+        let base = dropFileName $ decodeString file+            text = encodeStrict $ showJSON $ map (exConv base . snd) list+        widgetDestroy pbar -- FIXME+        writeFile file text `catch` \e ->+          putStrLn $ "Export failed" +++          (decodeString file) ++ ": " ++ ioeGetErrorString e++exConv base info = ((url', args), Map.difference info readOnlyProps)+  where url'             = stripBase $ decodeURL path+        (path, args)     = break (== '?') url+        X.PropString url = fromJust $ Map.lookup "url" info+        stripBase url+          | Just path <- stripPrefix "file://" url+          , Just tail <- stripPrefix base path = tail+          | otherwise = url++readOnlyProps =+  Map.fromList $ map (, undefined)+  [ "added", "bitrate", "chain", "channels", "duration"+  , "id", "laststarted", "lmod", "mime", "sample_format"+  , "samplerate", "size", "status", "timesplayed", "url"+  , "startms", "stopms", "isdir", "intsort" ]++makeImportDlg =+  makeChooser "Import properties" FileChooserActionOpen stockOpen++importProps name =+  importAll `catch` (erep . ioeGetErrorString)+  where importAll = do+          text <- readFile name+          case decodeStrict text of+            Ok recs -> mapM_ (importOne base) recs+            Error _ -> erep "invalid file format"+        base = dropFileName decn+        decn = decodeString name+        erep = putStrLn . (("Import failed: " ++ decn ++ ": ") ++)++importOne base ((url, args), props) =+  medialibAddEntryEncoded xmms enc >>* do+    liftIO $ medialibGetIdEncoded xmms enc >>* do+      id <- result+      unless (id == 0) $+        liftIO $ setProps id props+      return False+    return False+  where enc  = (encodeURL url') ++ args+        url' | isInfixOf "://" url = url+             | otherwise           = "file://" ++ joinPath [base, url]++setProps id props = mapM_ set $ Map.toList props+  where set (k, v) = medialibEntryPropertySet xmms id src k v+        src        = Just "client/generic/override/vision"++++data Chooser+  = Chooser { cLock    :: MVar ()+            , cChooser :: FileChooserDialog+            }++makeChooser title action stockId = do+  lock    <- newMVar ()+  chooser <- fileChooserDialogNew+             (Just title)+             Nothing+             action+             [ (stockCancel, ResponseCancel)+             , (stockId,     ResponseAccept) ]+  hideOnDeleteEvent chooser++  filter <- fileFilterNew+  fileFilterSetName filter "Vision property files"+  fileFilterAddCustom filter [FileFilterFilename] $ \name _ _ _ ->+    return $ maybe False ((==) ".vpf" . map toLower . takeExtension) name+  fileChooserAddFilter chooser filter++  filter <- fileFilterNew+  fileFilterSetName filter "All files"+  fileFilterAddCustom filter [] $ \_ _ _ _ -> return True+  fileChooserAddFilter chooser filter++  return Chooser { cLock    = lock+                 , cChooser = chooser+                 }++runChooser Chooser { cLock = lock, cChooser = chooser } onAccept = do+  locked <- isJust <$> tryTakeMVar lock+  when locked $ do+    windowSetTransientFor chooser window+    rec { cid <- chooser `onResponse` \resp -> do+             signalDisconnect cid+             case resp of+               ResponseAccept -> do+                 name <- fileChooserGetFilename chooser+                 fmaybeM_ name onAccept+               _ ->+                 return ()+             widgetHide chooser+             putMVar lock ()+        }+    return ()+  windowPresent chooser+++instance JSON X.Property where+  showJSON (X.PropInt32 i)  = showJSON i+  showJSON (X.PropString s) = showJSON s+  readJSON (JSRational _ i) = return $ X.PropInt32  $ truncate i+  readJSON (JSString s)     = return $ X.PropString $ fromJSString s
+ src/Properties/Manager.hs view
@@ -0,0 +1,377 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 5 Jul. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE TupleSections #-}++module Properties.Manager+  ( initPropertyManager+  , showPropertyManager+  ) where++import Control.Applicative+import Control.Monad++import Data.IORef+import qualified Data.Map as Map+import Data.Set (Set)+import qualified Data.Set as Set+import Data.Ord+import Data.Char++import System.IO.Unsafe++import Graphics.UI.Gtk++import Utils+import Compound+import Context+import UI+import Editor+import Properties.Property+import Properties.Model+++data Manager+  = Manager { pManager :: EditorDialog PropertyManager }++manager = pManager context+++initPropertyManager = do+  manager <- unsafeInterleaveIO $ makeEditorDialog+             [(stockApply, ResponseApply)]+             makePropertyManager $ \m -> do+    let outerw = outer m+    windowSetTitle outerw "Manage properties"+    windowSetDefaultSize outerw 500 400+  return $ augmentContext+    Manager { pManager = manager }++showPropertyManager =+  runEditorDialog manager getProperties setProperties False window+++data PropertyManager+  = PropertyManager { pStore   :: ListStore Property+                    , pView    :: TreeView+                    , pBox     :: VBox+                    , pChanged :: IORef Bool+                    , pNames   :: IORef (Set String)+                    }++instance CompoundWidget PropertyManager where+  type Outer PropertyManager = VBox+  outer = pBox++instance EditorWidget PropertyManager where+  type Data PropertyManager = [Property]+  getData       = propertyManagerGetData+  setData       = propertyManagerSetData+  clearData     = propertyManagerClearData+  setupView     = propertyManagerSetupView+  focusView     = propertyManagerFocusView+  getState      = propertyManagerGetState+  resetModified = propertyManagerResetModified++propertyManagerGetData =+  listStoreToList . pStore++propertyManagerSetData pm props = do+  let store = pStore pm+  listStoreClear store+  writeIORef (pNames pm) =<<+    foldM (\names prop -> do+              listStoreAppend store prop+              return $ Set.insert (propName prop) names+          ) Set.empty props++propertyManagerClearData pm = do+  listStoreClear $ pStore pm+  writeIORef (pNames pm) Set.empty++propertyManagerSetupView pm =+  treeViewSetCursor (pView pm) [0] Nothing++propertyManagerFocusView =+  widgetGrabFocus . pView++propertyManagerGetState =+  liftM (True, ) . readIORef . pChanged++propertyManagerResetModified =+  flip writeIORef False . pChanged++makePropertyManager parent notify = do+  names <- newIORef Set.empty++  store  <- listStoreNewDND [] Nothing Nothing+  sorted <- treeModelSortNewWithModel store++  let getByIter iter = do+        [n] <- treeModelGetPath store iter+        listStoreGetValue store n+      compBy f a b =+        comparing f <$> getByIter a <*> getByIter b++  treeSortableSetDefaultSortFunc sorted $ compBy (map toLower . propName)+  treeSortableSetSortFunc sorted 0 $ compBy (map toLower . propName)+  treeSortableSetSortFunc sorted 1 $ compBy (map toLower . propKey)+  treeSortableSetSortFunc sorted 2 $ compBy (fromEnum . propType)+  treeSortableSetSortFunc sorted 3 $ compBy (fromEnum . propReadOnly)+  treeSortableSetSortFunc sorted 4 $ compBy (fromEnum . propCustom)++  view <- treeViewNewWithModel sorted+  treeViewSetRulesHint view True++  let showType p =+        case propType p of+          PropertyInt    -> "integer"+          PropertyString -> "string"+      showBool acc p =+        if acc p then "yes" else "no"+      addColumn title id acc = do+        column <- treeViewColumnNew+        treeViewColumnSetSortColumnId column id+        treeViewAppendColumn view column+        treeViewColumnSetTitle column title+        cell <- cellRendererTextNew+        treeViewColumnPackStart column cell True+        cellLayoutSetAttributes column cell store+          (\p -> [ cellText := acc p ])++  addColumn "Name"      0   propName+  addColumn "Key"       1   propKey+  addColumn "Type"      2   showType+  addColumn "Read-only" 3 $ showBool propReadOnly+  addColumn "Custom"    4 $ showBool propCustom++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  scrolledWindowSetShadowType scroll ShadowIn+  containerAdd scroll view++  changed <- newIORef False++  let setChanged = do+        writeIORef changed True+        notify+      addProperty prop = do+        listStoreAppend store prop+        modifyIORef names $ Set.insert (propName prop)+        setChanged+        return ()+      exists name = Set.member name <$> readIORef names++  edlg <- unsafeInterleaveIO $ makeEditorDialog []+          (makePropertyEntry exists) (const $ return ())+  addB <- buttonNewFromStock stockAdd+  addB `onClicked`+    runEditorDialog edlg (return nullProperty) addProperty True parent++  delB <- buttonNewFromStock stockRemove+  delB `onClicked` do+    (path, _) <- treeViewGetCursor view+    case path of+      [n] -> do+        [n'] <- treeModelSortConvertPathToChildPath sorted path+        prop <- listStoreGetValue store n'+        when (propCustom prop) $ do+          listStoreRemove store n'+          modifyIORef names $ Set.delete (propName prop)+          s <- listStoreGetSize store+          unless (s < 1) $+            treeViewSetCursor view [min (s - 1) n] Nothing+          setChanged+      _ ->+        return ()++  view `on` cursorChanged $ do+    (path, _) <- treeViewGetCursor view+    case path of+      [_] -> do+        [n'] <- treeModelSortConvertPathToChildPath sorted path+        prop <- listStoreGetValue store n'+        widgetSetSensitive delB $ propCustom prop+      _ ->+        widgetSetSensitive delB False++  bbox <- hBoxNew True 5+  boxPackStartDefaults bbox addB+  boxPackStartDefaults bbox delB++  vbox <- vBoxNew False 5+  containerSetBorderWidth vbox 7+  boxPackStart vbox scroll PackGrow 0+  boxPackStart vbox bbox PackNatural 0++  return PropertyManager { pStore   = store+                         , pView    = view+                         , pBox     = vbox+                         , pChanged = changed+                         , pNames   = names+                         }+++data PropertyEntry+  = PropertyEntry+    { eTable  :: Table+    , eName   :: Entry+    , eKey    :: Entry+    , eType   :: ComboBox+    , eRO     :: ComboBox+    , eExists :: String -> IO Bool+    }++instance CompoundWidget PropertyEntry where+  type Outer PropertyEntry = Table+  outer = eTable++instance EditorWidget PropertyEntry where+  type Data PropertyEntry = Property+  setData       = propertyEntrySetData+  getData       = propertyEntryGetData+  focusView     = propertyEntryFocusView+  getState      = propertyEntryGetState+  resetModified = const $ return ()++propertyEntrySetData e p = do+  entrySetText (eName e) (propName p)+  entrySetText (eKey e) (propKey p)+  comboSet (eType e) Nothing (propType p)+  comboSet (eRO e) Nothing (propReadOnly p)++propertyEntryGetData e = do+  pname  <- entryGetText $ eName e+  pkey   <- entryGetText $ eKey e+  ptype  <- comboGet $ eType e+  pro    <- comboGet $ eRO e+  return Property { propName      = trim pname+                  , propKey       = trim pkey+                  , propType      = ptype+                  , propReadOnly  = pro+                  , propCustom    = True+                  , propReadValue = Nothing+                  , propShowValue = Nothing+                  }++propertyEntryFocusView =+  widgetGrabFocus . eName++propertyEntryGetState e = do+  name <- trim <$> entryGetText (eName e)+  key  <- trim <$> entryGetText (eKey e)+  (, True) <$> propertyEntryValid (eExists e) name key++propertyEntryValid exists name key = do+  e <- exists name+  return . not $ e || null name || null key++makePropertyEntry exists _ notify = do+  table <- tableNew 4 2 False+  containerSetBorderWidth table 7+  tableSetColSpacings table 15+  tableSetRowSpacings table 5++  let addPair m w b = do+        l <- labelNewWithMnemonic m+        miscSetAlignment l 0.0 0.5+        labelSetMnemonicWidget l w+        tableAttach table l 0 1 b (b + 1) [Fill] [] 0 0+        tableAttach table w 1 2 b (b + 1) [Expand, Fill] [] 0 0++  nameE <- entryNew+  addPair "_Name" nameE 0++  keyE <- entryNew+  addPair "_Key" keyE 1++  typeC <- comboBoxNewText+  comboBoxInsertText typeC (fromEnum PropertyString) "string"+  comboBoxInsertText typeC (fromEnum PropertyInt) "integer"+  typeRef <- newIORef PropertyString+  typeCid <- setupCombo typeC typeRef+  addPair "_Type" typeC 2++  roC <- comboBoxNewText+  comboBoxInsertText roC (fromEnum False) "no"+  comboBoxInsertText roC (fromEnum True) "yes"+  roRef <- newIORef False+  roCid <- setupCombo roC roRef+  addPair "_Read-only" roC 3++  let check = do+        notify+        key <- trim <$> entryGetText keyE+        case Map.lookup key builtinPropertyMap of+          Just prop -> do+            comboSet typeC (Just typeCid) $ propType prop+            widgetSetSensitive typeC False+            comboSet roC (Just roCid) $ propReadOnly prop+            widgetSetSensitive roC False+          Nothing   -> do+            comboSet typeC (Just typeCid) =<< readIORef typeRef+            widgetSetSensitive typeC True+            comboSet roC (Just roCid) =<< readIORef roRef+            widgetSetSensitive roC True++      checkInsert str pos = do+        check+        return $ (length str) + pos++      checkDelete _ _ = check++  nameE `afterInsertText` checkInsert+  nameE `afterDeleteText` checkDelete+  keyE  `afterInsertText` checkInsert+  keyE  `afterDeleteText` checkDelete++  return PropertyEntry { eTable  = table+                       , eName   = nameE+                       , eKey    = keyE+                       , eType   = typeC+                       , eRO     = roC+                       , eExists = exists+                       }+++nullProperty =+  Property { propName      = ""+           , propKey       = ""+           , propType      = PropertyString+           , propReadOnly  = False+           , propCustom    = True+           , propReadValue = Nothing+           , propShowValue = Nothing+           }+++comboGet combo =+  toEnum <$> comboBoxGetActive combo++comboSet ::+  Enum a                     =>+  ComboBox                   ->+  Maybe (ConnectId ComboBox) ->+  a                          ->+  IO ()+comboSet combo cid =+  maybe id withSignalBlocked cid . comboBoxSetActive combo . fromEnum++setupCombo combo ref =+  combo `on` changed $ (writeIORef ref =<< comboGet combo)
+ src/Properties/Model.hs view
@@ -0,0 +1,100 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 4 Mar. 2009+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--+--  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.+--++module Properties.Model+  ( lookup+  , initModel+  , property+  , propertyMap+  , propertyStore+  , getProperties+  , setProperties+  , onProperties+  ) where++import Prelude hiding (lookup)++import Control.Concurrent.MVar++import Data.Map (Map)+import qualified Data.Map as Map++import Graphics.UI.Gtk++import Context+import Config+import Handler+import Utils+import Properties.Property+++data Model+  = Model { mMap          :: MVar (Map String Property)+          , mStore        :: ListStore Property+          , mOnProperties :: HandlerMVar ()+          }++propertyMap   = mMap context+propertyStore = mStore context+onProperties  = onHandler $ mOnProperties context+++initModel = do+  context <- initContext+  let ?context = context++  loadProperties++  return ?context++initContext = do+  npmap   <- newMVar $ mkMap builtinProperties+  -- The store will be populated in loadProperties.+  store   <- listStoreNewDND [] Nothing Nothing+  onprops <- makeHandlerMVar+  return $ augmentContext+    Model { mMap          = npmap+          , mStore        = store+          , mOnProperties = onprops+          }++property name =+  withMVar propertyMap $ return . Map.lookup name++loadProperties = do+  props  <- config "properties.conf" []+  mapM_ (listStoreAppend propertyStore) =<<+    (modifyMVar propertyMap $ \m -> do+        let m' = Map.union m $ mkMap props+        return (m', Map.elems m'))++getProperties =+  withMVar propertyMap $ return . Map.elems++setProperties props = do+  listStoreClear propertyStore+  mapM_ (listStoreAppend propertyStore) =<<+    (modifyMVar propertyMap $ const $ do+        let m = mkMap props+        return (m, Map.elems m))+  writeConfig "properties.conf" props+  onProperties $ invoke ()+++mkMap = Map.fromList . map (\p -> (propName p, p))
+ src/Properties/Property.hs view
@@ -0,0 +1,175 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 2 Mar. 2010+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--+--  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.+--++{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}++module Properties.Property+  ( PropertyType (..)+  , Property (..)+  , readValue+  , showValue+  , lookup+  , builtinProperties+  , builtinPropertyMap+  ) where++import Prelude hiding (lookup)++import Control.Applicative+import Control.Monad++import qualified Data.Map as Map++import Text.Printf+import Text.JSON++import qualified XMMS2.Client.Types as X++import Utils+++data PropertyType+  = PropertyString+  | PropertyInt+    deriving (Read, Show, Enum)++instance JSON PropertyType where+  showJSON PropertyInt    = showJSON "int"+  showJSON PropertyString = showJSON "string"+  readJSON (JSString s) =+    case fromJSString s of+      "int"    -> return PropertyInt+      "string" -> return PropertyString+      _        -> fail "Unable to read PropertyType"+  readJSON _ = fail "Unable to read PropertyType"+++type PropertyShow = X.Property -> String+type PropertyRead = String -> IO X.Property++data Property+  = Property { propName      :: String+             , propKey       :: String+             , propType      :: PropertyType+             , propCustom    :: Bool+             , propReadOnly  :: Bool+             , propReadValue :: Maybe PropertyRead+             , propShowValue :: Maybe PropertyShow }++instance Read Property where+  readsPrec x s = map (mapFst mk) (readsPrec x s)++instance Show Property where+  show p = show (propName p, propKey p, propType p, propReadOnly p)++instance JSON Property where+  showJSON p = showJSON (propName p, propKey p, propType p, propReadOnly p)+  readJSON v = mk <$> readJSON v `mplus` fail "Unable to read Property"++mk (pn, pk, pt, pr) =+  case Map.lookup pk builtinPropertyMap of+    Just prop ->+      prop { propName   = pn+           , propCustom = True }+    _ ->+      Property { propName      = pn+               , propKey       = pk+               , propType      = pt+               , propCustom    = True+               , propReadOnly  = pr+               , propReadValue = Nothing+               , propShowValue = Nothing }+++++readValue p s  = liftM Just read `catch` \_ -> return Nothing+  where read   = maybe rdef id (propReadValue p) $ s+        rdef s = case (propType p) of+                   PropertyInt    -> X.PropInt32 <$> readIO s+                   PropertyString -> return $ X.PropString s++showValue p v = maybe sdef id (propShowValue p) $ v+  where sdef (X.PropInt32  n) = show n+        sdef (X.PropString s) = s+++lookup p m = do+  res <- (showValue p) <$> Map.lookup (propKey p) m+  when (null res) mzero+  return res+++builtinPropertyMap =+  Map.fromList $ map (\p -> (propKey p, p)) builtinProperties++builtinProperties =+  map (\(pn, pk, pt, ro, pr, ps) ->+         Property { propName      = pn+                  , propKey       = pk+                  , propType      = pt+                  , propCustom    = False+                  , propReadOnly  = ro+                  , propReadValue = pr+                  , propShowValue = ps })+      [ ("Artist", "artist",+         PropertyString, False, Nothing, Nothing)+      , ("Album", "album",+         PropertyString, False, Nothing, Nothing)+      , ("Date", "date",+         PropertyString, False, Nothing, Nothing)+      , ("Track", "tracknr",+         PropertyInt, False, Nothing, Nothing)+      , ("Title", "title",+         PropertyString, False, Nothing, Nothing)+      , ("Comment", "comment",+         PropertyString, False, Nothing, Nothing)+      , ("Duration", "duration",+         PropertyInt, True, Nothing, Just showDuration)+      , ("URL", "url",+         PropertyString, True,  Nothing, Just showURL)+      , ("Composer", "composer",+         PropertyString, False, Nothing, Nothing)+      , ("Work", "work",+         PropertyString, False, Nothing, Nothing)+      , ("Catalog", "catalog",+         PropertyString, False, Nothing, Nothing)+      , ("Movement", "movement",+         PropertyString, False, Nothing, Nothing)+      , ("Performer", "performer",+         PropertyString, False, Nothing, Nothing)+      , ("Conductor", "conductor",+         PropertyString, False, Nothing, Nothing)+      , ("Orchestra", "orchestra",+         PropertyString, False, Nothing, Nothing)+      , ("Chorus master", "chorus_master",+         PropertyString, False, Nothing, Nothing)+      , ("Chorus", "chorus",+         PropertyString, False, Nothing, Nothing) ]+++showDuration (X.PropInt32  n) =+  if h == 0 then mss else (show h) ++ (':' : mss)+  where d   = n `div` 1000+        h   = d `div` 3600+        m   = (d - (h * 3600)) `div` 60+        s   = d - h * 3600 - m * 60+        mss = printf "%02d:%02d" m s++showURL (X.PropString u) = decodeURL u
+ src/Properties/View.hs view
@@ -0,0 +1,175 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 22 Mar. 2010+--+--  Copyright (C) 2009-2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE TupleSections #-}++module Properties.View+  ( PropertyView+  , makePropertyView+  , propertyViewStore+  , propertyViewRight+  ) where++import Control.Monad+import Control.Monad.Trans++import Data.IORef++import Graphics.UI.Gtk++import Atoms+import DnD+import Compound+import Editor+import Properties.Property+import Properties.Model+++data PropertyView a+  = PropertyView+    { vPaned            :: HPaned+    , vLeft             :: TreeView+    , propertyViewStore :: ListStore (Property, a)+    , propertyViewRight :: TreeView+    , vModified         :: IORef Bool+    }++instance CompoundWidget (PropertyView a) where+  type Outer (PropertyView a) = HPaned+  outer = vPaned++instance EditorWidget (PropertyView a) where+  type Data (PropertyView a) = [(Property, a)]+  getData       = propertyViewGetData+  setData       = propertyViewSetData+  clearData     = propertyViewClearData+  setupView     = propertyViewSetupView+  focusView     = propertyViewFocusView+  getState      = propertyViewGetState+  resetModified = propertyViewResetModified++propertyViewGetData =+  listStoreToList . propertyViewStore++propertyViewSetData v d = do+  listStoreClear $ propertyViewStore v+  mapM_ (listStoreAppend $ propertyViewStore v) d++propertyViewClearData =+  listStoreClear . propertyViewStore++propertyViewSetupView pm =+  treeViewSetCursor (vLeft pm) [0] Nothing++propertyViewFocusView =+  widgetGrabFocus . vLeft++propertyViewGetState =+  liftM (True, ) . readIORef . vModified++propertyViewResetModified =+  flip writeIORef False . vModified++makePropertyView make _ notify = do+  modified <- newIORef False+  let onChanged = do+        writeIORef modified True+        notify++  paned <- hPanedNew+  containerSetBorderWidth paned 7++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  scrolledWindowSetShadowType scroll ShadowIn+  panedPack1 paned scroll True False++  left <- treeViewNewWithModel propertyStore+  treeViewSetHeadersVisible left False++  sel <- treeViewGetSelection left+  treeSelectionSetMode sel SelectionMultiple++  column <- treeViewColumnNew+  treeViewAppendColumn left column+  cell <- cellRendererTextNew+  treeViewColumnPackStart column cell True+  cellLayoutSetAttributes column cell propertyStore $ \prop ->+    [ cellText := propName prop ]++  containerAdd scroll left++  scroll <- scrolledWindowNew Nothing Nothing+  scrolledWindowSetPolicy scroll PolicyAutomatic PolicyAutomatic+  scrolledWindowSetShadowType scroll ShadowIn+  panedPack2 paned scroll True False++  store <- listStoreNew []+  store `on` rowChanged $ const $ const onChanged+  store `on` rowInserted $ const $ const onChanged+  store `on` rowDeleted $ const onChanged++  right <- treeViewNewWithModel store+  treeViewSetHeadersVisible right False+  treeViewSetReorderable right True++  sel <- treeViewGetSelection right+  treeSelectionSetMode sel SelectionMultiple++  column <- treeViewColumnNew+  treeViewAppendColumn right column+  cell <- cellRendererTextNew+  treeViewColumnPackStart column cell True+  cellLayoutSetAttributes column cell store $ \(prop, _) ->+    [ cellText := propName prop ]++  containerAdd scroll right++  left `on` keyPressEvent $ tryEvent $ do+    []       <- eventModifier+    "Return" <- eventKeyName+    liftIO $ do+      sel  <- treeViewGetSelection left+      rows <- treeSelectionGetSelectedRows sel+      forM_ rows $ \[n] ->+        listStoreAppend store . make =<<+        listStoreGetValue propertyStore n++  right `on` keyPressEvent $ tryEvent $ do+    []       <- eventModifier+    "Delete" <- eventKeyName+    liftIO $ do+      sel  <- treeViewGetSelection right+      rows <- treeSelectionGetSelectedRows sel+      mapM_ (listStoreRemove store . head) $ reverse rows++  setupDnDReorder propPosList store right $+    mapM_ $ \(f, t) -> do+      v <- listStoreGetValue store f+      listStoreRemove store f+      listStoreInsert store t v++  return PropertyView { vPaned            = paned+                      , vLeft             = left+                      , propertyViewStore = store+                      , propertyViewRight = right+                      , vModified         = modified+                      }++
+ src/UI.hs view
@@ -0,0 +1,149 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 20 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++{-# LANGUAGE RankNTypes #-}++module UI+  ( initUI+  , window+  , contents+  , setWindowTitle+  , getWidget+  , addUIFromFile+  , insertActionGroup+  , addUIActions+  , getAction+  , windowGroup+  ) where++import Control.Applicative++import Data.Maybe++import Graphics.UI.Gtk++import Context+import Environment+import About+++data UI+  = UI { uWindow      :: Window+       , uContents    :: VBox+       , uManager     :: UIManager+       , uActionGroup :: ActionGroup+       , uWindowGroup :: WindowGroup+       }++window        = uWindow context+contents      = uContents context+uiManager     = uManager context+uiActionGroup = uActionGroup context+windowGroup   = uWindowGroup context++initUI = do+  context <- initContext+  let ?context = context++  windowGroupAddWindow windowGroup window+  containerAdd window contents++  windowAddAccelGroup window =<< uiManagerGetAccelGroup uiManager+  insertActionGroup uiActionGroup 1+  addUIActions uiActions+  addUIFromFile "common"++  menubar <- getWidget castToMenuBar "ui/menubar"+  boxPackStart contents menubar PackNatural 0++  return ?context+++initContext = do+  window        <- windowNew+  contents      <- vBoxNew False 0+  uiManager     <- uiManagerNew+  uiActionGroup <- actionGroupNew "ui"+  windowGroup   <- windowGroupNew+  return $ augmentContext+    UI { uWindow      = window+       , uContents    = contents+       , uManager     = uiManager+       , uActionGroup = uiActionGroup+       , uWindowGroup = windowGroup+       }++setWindowTitle = windowSetTitle window+addUIActions = actionGroupAddActions uiActionGroup+insertActionGroup = uiManagerInsertActionGroup uiManager+addUIFromFile = uiManagerAddUiFromFile uiManager . uiFilePath+maybeGetWidget cast name = fmap cast <$> uiManagerGetWidget uiManager name+getWidget cast name = fromJust <$> maybeGetWidget cast name+getAction group name = fromJust <$> actionGroupGetAction group name++uiActions =+  [ ActionEntry+    { actionEntryName        = "menubar"+    , actionEntryLabel       = ""+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "toolbar"+    , actionEntryLabel       = ""+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "quit"+    , actionEntryLabel       = "_Quit"+    , actionEntryStockId     = Just stockQuit+    , actionEntryAccelerator = Just "<Control>q"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = mainQuit+    }+  , ActionEntry+    { actionEntryName        = "close-window"+    , actionEntryLabel       = "_Close window"+    , actionEntryStockId     = Just stockClose+    , actionEntryAccelerator = Just "<Control>w"+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = widgetDestroy window+    }+  , ActionEntry+    { actionEntryName        = "help"+    , actionEntryLabel       = "_Help"+    , actionEntryStockId     = Nothing+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = return ()+    }+  , ActionEntry+    { actionEntryName        = "about"+    , actionEntryLabel       = "_About"+    , actionEntryStockId     = Just stockAbout+    , actionEntryAccelerator = Nothing+    , actionEntryTooltip     = Nothing+    , actionEntryCallback    = showAbout window+    }+  ]
+ src/Utils.hs view
@@ -0,0 +1,177 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 17 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Utils+  ( HandlerMVar+  , makeHandlerMVar+  , onHandler+  , mapFst+  , mapSnd+  , encodeURL+  , decodeURL+  , trd+  , trim+  , bracket_+  , catchResult+  , setupTreeViewPopup+  , dialogAddButtonCR+  , fmaybeM_+  , withSignalBlocked+  , hideOnDeleteEvent+  , eqBy+  , tryModifyMVar_+  ) where++import Prelude hiding (catch)+import Control.Monad.CatchIO hiding (Handler)++import Control.Monad+import Control.Monad.Trans+import Control.Applicative+import Control.Concurrent.MVar+import Data.Char hiding (Control)+import Codec.Binary.UTF8.String++import Graphics.UI.Gtk++import XMMS2.Client++import Handler+++type HandlerMVar a = MVar (Handler IO a)++makeHandlerMVar = newMVar make++onHandler = modifyMVar++mapFst f (a, b) = (f a, b)+mapSnd f (a, b) = (a, f b)++encodeURL = encodeURL' . encodeString+encodeURL' [] = []+encodeURL' (' ':cs) = '+' : encodeURL' cs+encodeURL' (c:cs)+  | goodChar c =+    c : encodeURL' cs+  | otherwise  =+    let code = ord c+        c1   = intToDigit $ code `div` 16+        c2   = intToDigit $ code `rem` 16 in+    '%' : c1 : c2 : encodeURL' cs++goodChar ':' = True+goodChar '/' = True+goodChar '-' = True+goodChar '.' = True+goodChar '_' = True+goodChar c   = isAsciiUpper c || isAsciiLower c || isDigit c++decodeURL = decodeString . decodeURL'+decodeURL' []         = []+decodeURL' ('+' : cs) = ' ' : decodeURL' cs+decodeURL' ('%' : cs) = let (c, cs') = decodeByte cs in c : decodeURL' cs'+decodeURL' (c : cs)   = c : decodeURL' cs++decodeByte (d1 : d0 : cs)+  | isHexDigit d1 && isHexDigit d0 = (chr $ (digitToInt d1) * 16 + (digitToInt d0), cs)+decodeByte _ = error "invalid URL"++trd (_, _, c) = c++trim = f . f where f = reverse . dropWhile isSpace++bracket_ f g = bracket f (const g) . const++catchResult def conv =+  (conv <$> result) `catch` \(_ :: XMMSException) -> return def++setupTreeViewPopup view popup = do+  view `on` popupMenuSignal $ (menuPopup popup Nothing >> return True)++  sel     <- treeViewGetSelection view+  selMode <- treeSelectionGetMode sel+  let cond =+        case selMode of+          SelectionMultiple ->+            (2 >) <$> (liftIO $ treeSelectionCountSelectedRows sel)+          SelectionNone     ->+            return False+          _                 ->+            return True+      setCursor = do+        doIt <- cond+        when doIt $ do+          (x, y)    <- eventCoordinates+          maybePath <- liftIO $ treeViewGetPathAtPos view (round x, round y)+          case maybePath of+            Just (path, _, _) ->+              liftIO $ treeViewSetCursor view path Nothing+            Nothing           ->+              return ()++  view `on` buttonPressEvent $ tryEvent $ do+    RightButton <- eventButton+    SingleClick <- eventClick+    stamp       <- eventTime+    setCursor+    liftIO $ menuPopup popup $ Just (RightButton, stamp)++dialogAddButtonCR dialog label response = do+  button <- dialogAddButton dialog label response+  dialog `on` keyPressEvent $ tryEvent $ do+    "Return"  <- eventKeyName+    [Control] <- eventModifier+    liftIO $ do+      doIt <- button `get` widgetSensitive+      when doIt $ do+        widgetActivate button+        return ()++fmaybe :: b -> Maybe a -> (a -> b) -> b+fmaybe = flip . maybe++fmaybeM_ :: Monad m => Maybe a -> (a -> m b) -> m ()+fmaybeM_ m f = fmaybe (return ()) m $ \a -> f a >> return ()++withSignalBlocked s f =+  block $ do+    signalBlock s+    r <- unblock f `onException` signalUnblock s+    signalUnblock s+    return r++hideOnDeleteEvent window =+  window `on` deleteEvent $ do+    liftIO $ widgetHide window+    return True++eqBy f a b = f a == f b++{-# INLINE tryModifyMVar_ #-}+tryModifyMVar_ :: MVar a -> (a -> IO a) -> IO ()+tryModifyMVar_ m io =+  block $ do+    maybeA <- tryTakeMVar m+    case maybeA of+      Just a  -> do+        a' <- unblock (io a) `onException` putMVar m a+        putMVar m a'+      Nothing ->+        return ()
+ src/Vision.hs view
@@ -0,0 +1,80 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 11 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Main+  where++import Graphics.UI.Gtk++import Environment+import About+import Properties+import XMMS+import Medialib+import Playback+import Volume+import Playtime+import Clipboard+import Location+import Collection+import Playlist+++main = do+  initGUI++  context <- initEnvironment+  let ?context = context++  context <- initAbout+  let ?context = context++  context <- initXMMS+  let ?context = context++  context <- initMedialib+  let ?context = context++  context <- initProperties+  let ?context = context++  context <- initPlayback+  let ?context = context++  context <- initVolume+  let ?context = context++  context <- initPlaytime+  let ?context = context++  context <- initClipboard+  let ?context = context++  context <- initLocation+  let ?context = context++  context <- initCollection+  let ?context = context++  context <- initPlaylist+  let ?context = context++  showPlaylist++  mainGUI
+ src/Volume.hs view
@@ -0,0 +1,99 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 22 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module Volume+  ( initVolume+  , makeVolumeControl+  ) where++import Control.Monad.Trans++import qualified Data.Map as Map++import Graphics.UI.Gtk hiding (add, remove)++import XMMS2.Client++import XMMS+import Handler+import Utils+import Context+++data Volume+  = Volume { vAdj :: Adjustment+           , vCid :: ConnectId Adjustment }++adj = vAdj context+cId = vCid context++initVolume = do+  context <- initContext+  let ?context = context++  onServerConnectionAdd . ever $ \conn ->+    if conn+    then do+      playbackVolumeGet xmms >>* do+        handleVolume+        lift $ broadcastPlaybackVolumeChanged xmms >>* handleVolume+        return False+      signalUnblock cId+    else do+      signalBlock cId+      withoutVolumeChange $ adjustmentSetValue (adj) 0++  return ?context+++initContext = do+  adj <- adjustmentNew 0 0 100 5 5 0+  cId <- adj `onValueChanged` do+    vol <- adjustmentGetValue adj+    setVolume $ round vol+  return $ augmentContext+    Volume { vAdj = adj, vCid = cId }+++makeVolumeControl = do+  view <- hScaleNew $ adj+  scaleSetDrawValue view False+  rangeSetUpdatePolicy view UpdateContinuous+  widgetSetCanFocus view False++  id <- onServerConnectionAdd . ever $ widgetSetSensitive view+  view `onDestroy` do onServerConnection $ remove id++  return view+++handleVolume = do+  vol <- catchResult 0 (maximum . Map.elems)+  liftIO $ withoutVolumeChange $+    adjustmentSetValue (adj) $ fromIntegral vol+  return True++setVolume vol =+  playbackVolumeGet xmms >>* do+    vols <- catchResult Map.empty id+    lift $ mapM_ ((flip (playbackVolumeSet xmms)) vol) $ Map.keys vols+    return False++withoutVolumeChange =+  bracket_ (signalBlock $ cId) (signalUnblock $ cId)
+ src/XMMS.hs view
@@ -0,0 +1,107 @@+-- -*-haskell-*-+--  Vision (for the Voice): an XMMS2 client.+--+--  Author:  Oleg Belozeorov+--  Created: 18 Jun. 2010+--+--  Copyright (C) 2010 Oleg Belozeorov+--+--  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.+--++module XMMS+  ( xmms+  , initXMMS+  , connected+  , onServerConnection+  , onServerConnectionAdd+  ) where++import Prelude hiding (init)+import Control.Concurrent.MVar++import Graphics.UI.Gtk hiding (add)++import XMMS2.Client+import XMMS2.Client.Glib++import Environment+import Handler+import Utils+import Context+++data State+  = State { sConnected :: Bool }++makeState = State { sConnected = False }+++data XMMS+  = XMMS { xXMMS               :: Connection+         , xOnServerConnection :: HandlerMVar Bool+         , xState              :: MVar State+         }++xmms               = xXMMS context+onServerConnection = onHandler (xOnServerConnection context)+state              = xState context++connected = withMVar state $ return . sConnected++initXMMS = do+  context <- initContext+  let ?context = context++  scheduleTryConnect 100++  return ?context+++initContext = do+  xmms               <- init "Vision"+  onServerConnection <- makeHandlerMVar+  state              <- newMVar makeState+  return $ augmentContext+    XMMS { xXMMS               = xmms+         , xOnServerConnection = onServerConnection+         , xState              = state+         }++scheduleTryConnect = timeoutAdd tryConnect++tryConnect = do+  putStr "connecting... "+  success <- connect xmms xmmsPath+  if success+    then do+    putStrLn "connected!"+    disconnectCallbackSet xmms disconnectCallback+    mainLoopGMainInit xmms+    modifyMVar_ state $ \s -> return s { sConnected = True }+    onServerConnection $ invoke True+    return False+    else do+    putStrLn "failed."+    scheduleTryConnect 1000+    return False++disconnectCallback = do+  putStrLn "disconnected."+  modifyMVar_ state $ \s -> return s { sConnected = False }+  onServerConnection $ invoke False+  scheduleTryConnect 1000+  return ()++onServerConnectionAdd f = do+  id <- onServerConnection . add $ f+  f =<< connected+  return id
+ ui/collection-browser.xml view
@@ -0,0 +1,59 @@+<ui>+  <menubar action="menubar">+    <placeholder name="entries">+      <menu action="collection">+        <menuitem action="new-window"/>+        <menuitem action="edit-filter"/>+        <menuitem action="browse-in-new-window"/>+        <menuitem action="all-media"/>+        <separator/>+        <menuitem action="save-collection"/>+        <menuitem action="rename-collection"/>+        <menuitem action="remove-collection"/>+        <separator/>+        <menuitem action="add-to-playlist"/>+        <menuitem action="replace-playlist"/>+        <separator/>+        <menuitem action="close-window"/>+        <menuitem action="quit"/>+      </menu>+      <menu action="edit">+        <menuitem action="copy"/>+        <separator/>+        <menuitem action="select-all"/>+        <menuitem action="invert-selection"/>+      </menu>+      <menu action="view">+        <menuitem action="configure-columns"/>+        <menuitem action="configure-ordering"/>+      </menu>+      <menu action="properties">+        <menuitem action="edit-properties"/>+        <menuitem action="export-properties"/>+        <menuitem action="import-properties"/>+        <separator/>+        <menuitem action="manage-properties"/>+      </menu>+    </placeholder>+  </menubar>+  <popup action="collection-popup">+    <menuitem action="coll-add-to-playlist"/>+    <menuitem action="coll-replace-playlist"/>+    <separator/>+    <menuitem action="copy"/>+    <separator/>+    <menuitem action="select-all"/>+    <menuitem action="invert-selection"/>+    <separator/>+    <menuitem action="edit-properties"/>+  </popup>+  <popup action="list-popup">+    <menuitem action="list-add-to-playlist"/>+    <menuitem action="list-replace-playlist"/>+    <separator/>+    <menuitem action="rename-collection"/>+    <menuitem action="remove-collection"/>+    <separator/>+    <menuitem action="browse-in-new-window"/>+  </popup>+</ui>
+ ui/common.xml view
@@ -0,0 +1,8 @@+<ui>+  <menubar name="menubar">+    <placeholder name="entries"/>+    <menu action="help">+      <menuitem action="about"/>+    </menu>+  </menubar>+</ui>
+ ui/location-browser.xml view
@@ -0,0 +1,39 @@+<ui>+  <menubar action="menubar">+    <placeholder name="entries">+      <menu action="location">+        <menuitem action="new-window"/>+        <menuitem action="open-location"/>+        <menuitem action="browse-in-new-window"/>+        <separator/>+        <menuitem action="add-to-playlist"/>+        <menuitem action="replace-playlist"/>+        <separator/>+        <menuitem action="close-window"/>+        <menuitem action="quit"/>+      </menu>+      <menu action="go">+        <menuitem action="back"/>+        <menuitem action="forward"/>+        <menuitem action="up"/>+        <separator/>+        <menuitem action="refresh"/>+      </menu>+    </placeholder>+  </menubar>+  <toolbar action="toolbar">+    <toolitem action="back"/>+    <toolitem action="forward"/>+    <toolitem action="up"/>+    <toolitem action="refresh"/>+    <separator/>+    <toolitem action="clear"/>+    <toolitem action="load"/>+  </toolbar>+  <popup action="location-popup">+    <menuitem action="add-to-playlist"/>+    <menuitem action="replace-playlist"/>+    <separator/>+    <menuitem action="browse-in-new-window"/>+  </popup>+</ui>
+ ui/playlist.xml view
@@ -0,0 +1,60 @@+<ui>+  <menubar name="menubar">+    <placeholder name="entries">+      <menu action="music">+        <menuitem action="prev"/>+        <menuitem action="play"/>+        <menuitem action="pause"/>+        <menuitem action="stop"/>+        <menuitem action="next"/>+        <separator/>+        <menuitem action="quit"/>+      </menu>+      <menu action="edit">+        <menuitem action="cut"/>+        <menuitem action="copy"/>+        <menuitem action="paste"/>+        <menuitem action="append"/>+        <menuitem action="delete"/>+        <separator/>+        <menuitem action="select-all"/>+        <menuitem action="invert-selection"/>+      </menu>+      <menu action="browse">+        <menuitem action="browse-location"/>+        <menuitem action="browse-collection"/>+      </menu>+      <menu action="playlist">+        <menuitem action="clear-playlist"/>+        <separator/>+        <menuitem action="configure-playlist"/>+      </menu>+      <menu action="properties">+        <menuitem action="edit-properties"/>+        <menuitem action="export-properties"/>+        <menuitem action="import-properties"/>+        <separator/>+        <menuitem action="manage-properties"/>+      </menu>+    </placeholder>+  </menubar>+  <toolbar name="playbar">+    <toolitem action="prev"/>+    <toolitem action="play"/>+    <toolitem action="pause"/>+    <toolitem action="stop"/>+    <toolitem action="next"/>+  </toolbar>+  <popup action="playlist-popup">+    <menuitem action="cut"/>+    <menuitem action="copy"/>+    <menuitem action="paste"/>+    <menuitem action="append"/>+    <menuitem action="delete"/>+    <separator/>+    <menuitem action="select-all"/>+    <menuitem action="invert-selection"/>+    <separator/>+    <menuitem action="edit-properties"/>+  </popup>+</ui>
+ vision.cabal view
@@ -0,0 +1,103 @@+name:               vision+version:            0.0.2.2++author:             Oleg Belozeorov+maintainer:         Oleg Belozeorov <upwawet@gmail.com>+copyright:          (C) 2010 Oleg Belozeorov+license:            GPL-3+license-file:       COPYING++category:           Sound+synopsis:           An XMMS2 client.+description:+  Vision (for the Voice) is an X-platform Music Multiplexing System 2+  (http://xmms2.xmms.se) client aiming to eventually fit its author's+  views on listening to music, managing a music library etc. Only the+  time can tell what will come of that :]++cabal-version:      >= 1.6+build-type:         Simple+extra-tmp-files:    config.status, config.log, autom4te.cache+data-files:         ui/*.xml++executable vision+  main-is:          Vision.hs+  other-modules:    Handler,+                    Utils,+                    Context,+                    XMMS,+                    Environment,+                    Medialib,+                    UI,+                    Atoms,+                    DnD,+                    Config,+                    Compound,+                    Editor,+                    Properties,+                    Properties.Property,+                    Properties.Model,+                    Properties.View,+                    Properties.Manager,+                    Properties.Editor,+                    Properties.Editor.Model,+                    Properties.Editor.View,+                    Properties.Editor.UI,+                    Properties.Impex,+                    Playback,+                    Volume,+                    Playtime,+                    Clipboard,+                    Index,+                    Location,+                    Location.History,+                    Location.Model,+                    Location.View,+                    Location.Control,+                    Location.UI,+                    Collection,+                    Collection.List,+                    Collection.List.Model,+                    Collection.List.View,+                    Collection.Common,+                    Collection.Model,+                    Collection.View,+                    Collection.Control,+                    Collection.Order,+                    Collection.UI,+                    Playlist,+                    Playlist.Model,+                    Playlist.View,+                    Playlist.UI,+                    Playlist.Update,+                    Playlist.DnD,+                    Playlist.Index,+                    Playlist.Search,+                    Playlist.Edit,+                    Playlist.Config,+                    Playlist.Control,+                    Playlist.Format,+                    Playlist.Format.Format,+                    Playlist.Format.Parser,+                    Playlist.Format.Config+  hs-source-dirs:   src+  build-depends:    base >= 4 && < 5, xmms2-client >= 0.0.3.6,+                    xmms2-client-glib >= 0.0.3.6,+                    gtk, containers, mtl, utf8-string,+                    filepath, directory, glib, array,+                    MonadCatchIO-mtl, json, parsec >= 3.0.1+  extensions:       ImplicitParams, NoMonomorphismRestriction,+                    FlexibleContexts, FlexibleInstances,+                    TypeFamilies, ScopedTypeVariables,+                    PatternGuards+  ghc-options:      -W+++source-repository head+  type:             git+  location:         git://github.com/upwawet/vision.git++source-repository head+  type:             git+  location:         git://github.com/upwawet/vision.git+  tag:              v0.0.2.2