himerge (empty) → 0.17.9

raw patch · 48 files changed

+3604/−0 lines, 48 filesdep +basedep +directorydep +glibsetup-changedbinary-added

Dependencies added: base, directory, glib, gtk, haskell98, mozembed, old-time, parallel, process, unix

Files

• ChangeLog +103/−0
• LICENSE +340/−0
• Setup.hs +2/−0
• data/himerge/doc/himerge.css +20/−0
• data/himerge/doc/himerge_doc.html +61/−0
• data/himerge/icons/add.png binary
• data/himerge/icons/all.png binary
• data/himerge/icons/binary.png binary
• data/himerge/icons/category.png binary
• data/himerge/icons/clear.png binary
• data/himerge/icons/ebuild.png binary
• data/himerge/icons/edit.png binary
• data/himerge/icons/emerge.png binary
• data/himerge/icons/fetch.png binary
• data/himerge/icons/himerge-16.png binary
• data/himerge/icons/himerge-22.png binary
• data/himerge/icons/himerge-32.png binary
• data/himerge/icons/himerge-bigger.png binary
• data/himerge/icons/himerge.png binary
• data/himerge/icons/list-add.png binary
• data/himerge/icons/list-remove.png binary
• data/himerge/icons/neworld.png binary
• data/himerge/icons/package.png binary
• data/himerge/icons/process-stop.png binary
• data/himerge/icons/queue.png binary
• data/himerge/icons/refresh.png binary
• data/himerge/icons/remove.png binary
• data/himerge/icons/revdep.png binary
• data/himerge/icons/search.png binary
• data/himerge/icons/small-add.png binary
• data/himerge/icons/small-remove.png binary
• data/himerge/icons/sync.png binary
• data/himerge/icons/system.png binary
• data/himerge/icons/unmerge.png binary
• data/himerge/icons/usepkg.png binary
• data/himerge/icons/world.png binary
• himerge.cabal +63/−0
• install_data.sh +16/−0
• readme.txt +46/−0
• src/Browser.hs +724/−0
• src/Components.hs +64/−0
• src/Emerge.hs +218/−0
• src/Main.hs +259/−0
• src/Menus.hs +439/−0
• src/Render.hs +81/−0
• src/UseFlag.hs +292/−0
• src/Util.hs +799/−0
• src/Web.hs +77/−0

@@ -0,0 +1,103 @@+Himerge -- Haskell Interface for Emerge++-- version 0.17.9 (Mar, 04, 2008)++   1 - The use flags browser has been improved to correctly parse certain use+   flags.+   2 - Himerge is now hackage compliant.++-- version 0.17.3 (Feb, 23, 2008)++   1 - Run update-eix after each Sync and Metadata updating operation, so the+   package database is automatically updated for the browser views and search+   functions.+   2 - Now the web package information window is updated on selecting packages+   from the different package queues and the package versions view.+   3 - A few functions have been refactored for reducing complexity of code.+   4 - A slight bug on showing a package action operation in the package queues +   has been fixed.++-- version 0.17 (Feb, 9, 2008)++   1 - Allow full view of the control panel.+   2 - Added support to show the action type to be processed for each package+   inside the 'Queue' windows.+   3 - Fixed an important bug on the UseFlag browser.+   4 - Slightly improved some processes speed.+   5 - Cabal file improved so it can use the sdist cabal option for packaging.++-- version 0.16.1 (Jan, 15, 2008)++   1 - Fixed an important bug that stopped saving the panel pages.++-- version 0.16 (Jan, 14, 2008)++   1 - GHC 6.8 complaint.+   2 - Added the 'Portage Browser Operations' panel.+   3 - Added the 'Browser Editor' panel for editing the contents shown by the+   browser in a given time. This helps dealing with special cases like for+   example, accessing removed packages information from the portage tree.+   4 - Added the option to 'Refresh' the browser views.+   5 - Interactive searching enabled for the packages 'Queue' list. Now+   packages can be easily searched and located interactively from any queue+   list.+   6 - Text buffer operations improved. It avoids gtk+ warning about invalid+   iterators while updating text buffers.+   7 - Scroll to the current processed package in the 'Queue' lists.+   8 - Avoid the web browser panel to shrink smaller than its allowed size.+   This fixes a gtk+ warning.+   9 - Now Himerge allows to work with the branching operations+   keyword/mask/unmask over all the versions of a package at once.+   10 - Removed some un-used functions.++-- version 0.15 (Nov, 3, 2007)++   1 - Multi-Tab support added. This feature allows to show several panel+   pages (package queues, command views) for different processes at the same+   time.+   2 - Process handling support improved. Processes can now independently be stopped.+   3 - Log support added. Now himerge will log all (or most of) the operations+   in the new 'Log' panel page.+   4 - An important bug in the text buffers has been fixed.+   5 - Himerge now asks for confirmation for many essential operations.+   6 - Some code refactoring and small bugs fixes done.++-- version 0.14.7 (Sep, 29, 2007)++   1 - Package queue status notification added.+   2 - USE flag browser layout improved.+   3 - Package search feature is now more flexible. It can match exact package+   names or it can match all the packages containing a specific sub-string.+   4 - New button added to list all the current packages installed in the+   system. (portage-utils dependency introduced for this feature.)+   5 - Question dialogs added to confirm installation/un-installation operations.+   6 - Several slight bugs fixed.++-- version 0.14 (Sep, 07, 2007)++   1 - Tooltips added to the buttons's operations.+   2 - Support for /etc/portage/ directories. For example, now you can have+   package.keywords/ as a directory containing more files.+   3 - Added support for calculating the direct reverse dependencies of a+   package.+   4 - Now the views will scroll to the cell of a specific package when this+   one is found using the package search feature.+   5 - Now Himerge will automatically move and show the notebook pages+   when they are initially created with an operation.+   6 - Fixed an important bug that avoided finding the first packages in a+   treeview using the package search option.+   7 - The synchronization speed between the processes output and the current+   operations have been slightly improved.+   8 - Package search box improved with a dropdown list for search history.+   9 - Added a new accelerator to show documentation.+   10 - The USE flag browser has been improved to match correct local use+   flags option for a package.+   11 - Fixed an USE flag browser bug that made the browser crashes with output +   containing an empty list.+   12 - Added the Himerge logo in some part of the application and components.+   13 - Some bugs fixed and slight code refactoring in several functions.++-- version 0.13++   1 - First release.+

@@ -0,0 +1,340 @@+		    GNU GENERAL PUBLIC LICENSE+		       Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.+                       51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+ Everyone is permitted to copy and distribute verbatim copies+ of this license document, but changing it is not allowed.++			    Preamble++  The licenses for most software are designed to take away your+freedom to share and change it.  By contrast, the GNU General Public+License is intended to guarantee your freedom to share and change free+software--to make sure the software is free for all its users.  This+General Public License applies to most of the Free Software+Foundation's software and to any other program whose authors commit to+using it.  (Some other Free Software Foundation software is covered by+the GNU Library General Public License instead.)  You can apply it to+your programs, too.++  When we speak of free software, we are referring to freedom, not+price.  Our General Public Licenses are designed to make sure that you+have the freedom to distribute copies of free software (and charge for+this service if you wish), that you receive source code or can get it+if you want it, that you can change the software or use pieces of it+in new free programs; and that you know you can do these things.++  To protect your rights, we need to make restrictions that forbid+anyone to deny you these rights or to ask you to surrender the rights.+These restrictions translate to certain responsibilities for you if you+distribute copies of the software, or if you modify it.++  For example, if you distribute copies of such a program, whether+gratis or for a fee, you must give the recipients all the rights that+you have.  You must make sure that they, too, receive or can get the+source code.  And you must show them these terms so they know their+rights.++  We protect your rights with two steps: (1) copyright the software, and+(2) offer you this license which gives you legal permission to copy,+distribute and/or modify the software.++  Also, for each author's protection and ours, we want to make certain+that everyone understands that there is no warranty for this free+software.  If the software is modified by someone else and passed on, we+want its recipients to know that what they have is not the original, so+that any problems introduced by others will not reflect on the original+authors' reputations.++  Finally, any free program is threatened constantly by software+patents.  We wish to avoid the danger that redistributors of a free+program will individually obtain patent licenses, in effect making the+program proprietary.  To prevent this, we have made it clear that any+patent must be licensed for everyone's free use or not licensed at all.++  The precise terms and conditions for copying, distribution and+modification follow.++		    GNU GENERAL PUBLIC LICENSE+   TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++  0. This License applies to any program or other work which contains+a notice placed by the copyright holder saying it may be distributed+under the terms of this General Public License.  The "Program", below,+refers to any such program or work, and a "work based on the Program"+means either the Program or any derivative work under copyright law:+that is to say, a work containing the Program or a portion of it,+either verbatim or with modifications and/or translated into another+language.  (Hereinafter, translation is included without limitation in+the term "modification".)  Each licensee is addressed as "you".++Activities other than copying, distribution and modification are not+covered by this License; they are outside its scope.  The act of+running the Program is not restricted, and the output from the Program+is covered only if its contents constitute a work based on the+Program (independent of having been made by running the Program).+Whether that is true depends on what the Program does.++  1. You may copy and distribute verbatim copies of the Program's+source code as you receive it, in any medium, provided that you+conspicuously and appropriately publish on each copy an appropriate+copyright notice and disclaimer of warranty; keep intact all the+notices that refer to this License and to the absence of any warranty;+and give any other recipients of the Program a copy of this License+along with the Program.++You may charge a fee for the physical act of transferring a copy, and+you may at your option offer warranty protection in exchange for a fee.++  2. You may modify your copy or copies of the Program or any portion+of it, thus forming a work based on the Program, and copy and+distribute such modifications or work under the terms of Section 1+above, provided that you also meet all of these conditions:++    a) You must cause the modified files to carry prominent notices+    stating that you changed the files and the date of any change.++    b) You must cause any work that you distribute or publish, that in+    whole or in part contains or is derived from the Program or any+    part thereof, to be licensed as a whole at no charge to all third+    parties under the terms of this License.++    c) If the modified program normally reads commands interactively+    when run, you must cause it, when started running for such+    interactive use in the most ordinary way, to print or display an+    announcement including an appropriate copyright notice and a+    notice that there is no warranty (or else, saying that you provide+    a warranty) and that users may redistribute the program under+    these conditions, and telling the user how to view a copy of this+    License.  (Exception: if the Program itself is interactive but+    does not normally print such an announcement, your work based on+    the Program is not required to print an announcement.)++These requirements apply to the modified work as a whole.  If+identifiable sections of that work are not derived from the Program,+and can be reasonably considered independent and separate works in+themselves, then this License, and its terms, do not apply to those+sections when you distribute them as separate works.  But when you+distribute the same sections as part of a whole which is a work based+on the Program, the distribution of the whole must be on the terms of+this License, whose permissions for other licensees extend to the+entire whole, and thus to each and every part regardless of who wrote it.++Thus, it is not the intent of this section to claim rights or contest+your rights to work written entirely by you; rather, the intent is to+exercise the right to control the distribution of derivative or+collective works based on the Program.++In addition, mere aggregation of another work not based on the Program+with the Program (or with a work based on the Program) on a volume of+a storage or distribution medium does not bring the other work under+the scope of this License.++  3. You may copy and distribute the Program (or a work based on it,+under Section 2) in object code or executable form under the terms of+Sections 1 and 2 above provided that you also do one of the following:++    a) Accompany it with the complete corresponding machine-readable+    source code, which must be distributed under the terms of Sections+    1 and 2 above on a medium customarily used for software interchange; or,++    b) Accompany it with a written offer, valid for at least three+    years, to give any third party, for a charge no more than your+    cost of physically performing source distribution, a complete+    machine-readable copy of the corresponding source code, to be+    distributed under the terms of Sections 1 and 2 above on a medium+    customarily used for software interchange; or,++    c) Accompany it with the information you received as to the offer+    to distribute corresponding source code.  (This alternative is+    allowed only for noncommercial distribution and only if you+    received the program in object code or executable form with such+    an offer, in accord with Subsection b above.)++The source code for a work means the preferred form of the work for+making modifications to it.  For an executable work, complete source+code means all the source code for all modules it contains, plus any+associated interface definition files, plus the scripts used to+control compilation and installation of the executable.  However, as a+special exception, the source code distributed need not include+anything that is normally distributed (in either source or binary+form) with the major components (compiler, kernel, and so on) of the+operating system on which the executable runs, unless that component+itself accompanies the executable.++If distribution of executable or object code is made by offering+access to copy from a designated place, then offering equivalent+access to copy the source code from the same place counts as+distribution of the source code, even though third parties are not+compelled to copy the source along with the object code.++  4. You may not copy, modify, sublicense, or distribute the Program+except as expressly provided under this License.  Any attempt+otherwise to copy, modify, sublicense or distribute the Program is+void, and will automatically terminate your rights under this License.+However, parties who have received copies, or rights, from you under+this License will not have their licenses terminated so long as such+parties remain in full compliance.++  5. You are not required to accept this License, since you have not+signed it.  However, nothing else grants you permission to modify or+distribute the Program or its derivative works.  These actions are+prohibited by law if you do not accept this License.  Therefore, by+modifying or distributing the Program (or any work based on the+Program), you indicate your acceptance of this License to do so, and+all its terms and conditions for copying, distributing or modifying+the Program or works based on it.++  6. Each time you redistribute the Program (or any work based on the+Program), the recipient automatically receives a license from the+original licensor to copy, distribute or modify the Program subject to+these terms and conditions.  You may not impose any further+restrictions on the recipients' exercise of the rights granted herein.+You are not responsible for enforcing compliance by third parties to+this License.++  7. If, as a consequence of a court judgment or allegation of patent+infringement or for any other reason (not limited to patent issues),+conditions are imposed on you (whether by court order, agreement or+otherwise) that contradict the conditions of this License, they do not+excuse you from the conditions of this License.  If you cannot+distribute so as to satisfy simultaneously your obligations under this+License and any other pertinent obligations, then as a consequence you+may not distribute the Program at all.  For example, if a patent+license would not permit royalty-free redistribution of the Program by+all those who receive copies directly or indirectly through you, then+the only way you could satisfy both it and this License would be to+refrain entirely from distribution of the Program.++If any portion of this section is held invalid or unenforceable under+any particular circumstance, the balance of the section is intended to+apply and the section as a whole is intended to apply in other+circumstances.++It is not the purpose of this section to induce you to infringe any+patents or other property right claims or to contest validity of any+such claims; this section has the sole purpose of protecting the+integrity of the free software distribution system, which is+implemented by public license practices.  Many people have made+generous contributions to the wide range of software distributed+through that system in reliance on consistent application of that+system; it is up to the author/donor to decide if he or she is willing+to distribute software through any other system and a licensee cannot+impose that choice.++This section is intended to make thoroughly clear what is believed to+be a consequence of the rest of this License.++  8. If the distribution and/or use of the Program is restricted in+certain countries either by patents or by copyrighted interfaces, the+original copyright holder who places the Program under this License+may add an explicit geographical distribution limitation excluding+those countries, so that distribution is permitted only in or among+countries not thus excluded.  In such case, this License incorporates+the limitation as if written in the body of this License.++  9. The Free Software Foundation may publish revised and/or new versions+of the General Public License from time to time.  Such new versions will+be similar in spirit to the present version, but may differ in detail to+address new problems or concerns.++Each version is given a distinguishing version number.  If the Program+specifies a version number of this License which applies to it and "any+later version", you have the option of following the terms and conditions+either of that version or of any later version published by the Free+Software Foundation.  If the Program does not specify a version number of+this License, you may choose any version ever published by the Free Software+Foundation.++  10. If you wish to incorporate parts of the Program into other free+programs whose distribution conditions are different, write to the author+to ask for permission.  For software which is copyrighted by the Free+Software Foundation, write to the Free Software Foundation; we sometimes+make exceptions for this.  Our decision will be guided by the two goals+of preserving the free status of all derivatives of our free software and+of promoting the sharing and reuse of software generally.++			    NO WARRANTY++  11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY+FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW.  EXCEPT WHEN+OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES+PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED+OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF+MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.  THE ENTIRE RISK AS+TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU.  SHOULD THE+PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,+REPAIR OR CORRECTION.++  12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR+REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,+INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING+OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED+TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY+YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER+PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE+POSSIBILITY OF SUCH DAMAGES.++		     END OF TERMS AND CONDITIONS++	    How to Apply These Terms to Your New Programs++  If you develop a new program, and you want it to be of the greatest+possible use to the public, the best way to achieve this is to make it+free software which everyone can redistribute and change under these terms.++  To do so, attach the following notices to the program.  It is safest+to attach them to the start of each source file to most effectively+convey the exclusion of warranty; and each file should have at least+the "copyright" line and a pointer to where the full notice is found.++    <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 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+++Also add information on how to contact you by electronic and paper mail.++If the program is interactive, make it output a short notice like this+when it starts in an interactive mode:++    Gnomovision version 69, Copyright (C) year name of author+    Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.+    This is free software, and you are welcome to redistribute it+    under certain conditions; type `show c' for details.++The hypothetical commands `show w' and `show c' should show the appropriate+parts of the General Public License.  Of course, the commands you use may+be called something other than `show w' and `show c'; they could even be+mouse-clicks or menu items--whatever suits your program.++You should also get your employer (if you work as a programmer) or your+school, if any, to sign a "copyright disclaimer" for the program, if+necessary.  Here is a sample; alter the names:++  Yoyodyne, Inc., hereby disclaims all copyright interest in the program+  `Gnomovision' (which makes passes at compilers) written by James Hacker.++  <signature of Ty Coon>, 1 April 1989+  Ty Coon, President of Vice++This General Public License does not permit incorporating your program into+proprietary programs.  If your program is a subroutine library, you may+consider it more useful to permit linking proprietary applications with the+library.  If this is what you want to do, use the GNU Library General+Public License instead of this License.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,20 @@+BODY {+	color: black; +	font-family: sans-serif, Verdana, Arial, Helvetica; +	font-size: 0.8em;+  	padding:0;+}++li {margin-bottom: 5px;}+ol,ul {margin-top: 5px;}++.newshead {+  background-color: #7a5ada;+	padding-top: 0.4em;+	padding-bottom: 0.4em;+	padding-left: 1.0em;+	padding-right: 1.0em; +  color: white;+  text-align: left;+  clear:both;+}

@@ -0,0 +1,61 @@+<html>+<head>+<link title=\"new\" rel="stylesheet" href="himerge.css" type="text/css">+</head>+<body>+<p class="newshead" lang="en"><b>Himerge 0.17</b></p>+<ul>+  <li><strong>Himerge</strong></li>+	<p>Himerge is a graphical user interface for emerge (Gentoo's Portage system) written in Haskell using gtk2hs.</p>+	<p>The main idea is to simplify browsing the entire portage tree as well as of running the most basic and common options from the emerge command. Himerge also offers several handy tools, like global and local use flags browsers, pretty much inspired on UFED (Gentoo Linux USE flags editor). It also uses eix (Small utility for searching ebuilds with indexing for fast results) as a back-end command to show package information on html/css format, so you can access the package web-site for a quick-glance.</p>++  <li><strong>Features on Himerge 0.17</strong></li>+  <ol>+  	<li>Access the whole portage tree using the 'Category', 'Package', 'Version' views.</li>+	<li>Category: List all the categories of the repository. This is /usr/portage by default, but you can specify a new one (overlays.)</li>+	<li>Package: List all the packages inside a category.</li>+	<li>Version: List all the available versions of a specific package.</li>+	<li>Run the most common 'emerge' operations with just one click: emerge, unmerge, binpkg, fetch, usepkg and more.</li>+	<li>Sync the tree pressing a button.</li>+	<li>Himerge makes you working around a queue of packages, so you can easily remove and add packages to this queue, and choose what operations you want to apply on them.</li>	+	<li>Update world. The package queue method of Himerge makes it very flexible to select which package to remove or add on a system updating.</li>+	<li>Quick access through the information window to the web site of each package. (Himerge will open a firefox or mozilla compatible browser for this, just be sure you have a binary named 'firefox' on the path)</li>+	<li>See what it is happening. Himerge has a 'View' system that allows to watch the output of each operation, so, you 'as' a Gentoo user, don't miss anything ;-)</li>+	<li>Resizable windows. You can change the size of the main panels of Himerge, so you can get a complete view for any operation you are doing.</li>+	<li>USE Flag Browser. Himerge has an USE Flag browser that lets you to choose with just one click if you want to add or remove a flag.</li>+	<li>Package Branch Browser. This is a browser that makes editing easy for the files inside /etc/portage/. The functionality of this browser is connected to the view of packages of Himerge, so you can easily 'keyword', 'mask', 'unmask', or even specify which use flags to select for a package from a single right click over a package name.</li>+	<li>Access some extra operations like: update metadata, rebuild dependencies.</li>+	<li>Himerge uses 'eix' as a back-end for fast indexing and searching of packages.</li>+	<li>Himerge uses 'equery' as a back-end for reverse dependencies calculation. (new since version 0.14)</li>+	<li>You can easily save the log of the output of 'any' operation from Himerge, use "Save Current Page" , or "Save All Pages" from the menu , choose a file name and done. This comes in handy when you have to report package bugs or information to developers.</li>+	<li>Himerge allows you to check the ebuild file for a package and even edit it. It also shows the Changelog file for each selected package.</li>+	<li>Himerge supports overlays. All the operations are equally available for your own repositories too.</li>+	<li>And more!</li>+  </ol>++  <li><strong>How-to</strong></li>+  <ol>+  	<p>Himerge works around a queue system. This queue contains all the packages upon which you are going to act with a specific emerge option. For example, to install package A-1.1, you go to the 'Version' view, select the package, and press the button queue. Now it will calculate all the necessary dependencies for A-1.1 and they will be added to the 'Queue' page inside the panel under the portage tree views, including the package A-1.1 too.</p>+  	<p>This queue will also show all the use flags options for every package, in other words, it shows the output from the command 'emerge --verbose --pretend' for the given package.</p>+  	<p>After calculating the queue, you can choose the action you want to apply for these packages. In this specific example, the most common choice would be to install the package with all of its dependencies, so we press the emerge button.</p>+  	<p>In the same way, the following buttons work around this queue:</p>+	<ul>+      		<li>unmerge = un-install package (--unmerge)</li>+          	<li>binary = install and build a binary package (--buildpkg)</li>+	      	<li>usepkg = install a binary package if available (--usepkg)</li>+	        <li>fetch = fetch only these (queued) packages. (--nodeps --fetchonly)</li>+	</ul>+	<p>Other buttons are used alone (independent of the queue contents), for example, the world and sync buttons update both the system and portage tree respectively.</p>+  </ol>++  <li><strong>Documentation</strong></li>+  	<p>You can access this help any time through Himerge from the Menu list (Help - Help) or with the keys combination 'Ctrl+H'.</p>+	<p>You also can visit the official Himerge web site at <a href="//http://www.haskell.org/himerge">http://www.haskell.org/himerge</a> for further information about this program or project.</p>+  <li><strong>Wiki</strong></li>+  	<p>Himerge has now a wiki site at <a href="//http://www.haskell.org/haskellwiki/Himerge">http://www.haskell.org/haskellwiki/Himerge</a>.This site is intended to contain the latest information and documentation about Himerge, everyone is welcome to participate and cooperate with it.</p>+</ul>++<hr><center><a href="//http://www.haskell.org/himerge">himerge</a></center>++</body>+</html>

binary file changed (absent → 601 bytes)

binary file changed (absent → 2544 bytes)

binary file changed (absent → 1675 bytes)

binary file changed (absent → 498 bytes)

binary file changed (absent → 1788 bytes)

binary file changed (absent → 2577 bytes)

binary file changed (absent → 1088 bytes)

binary file changed (absent → 1502 bytes)

binary file changed (absent → 1971 bytes)

binary file changed (absent → 746 bytes)

binary file changed (absent → 1072 bytes)

binary file changed (absent → 1456 bytes)

binary file changed (absent → 14471 bytes)

binary file changed (absent → 11453 bytes)

binary file changed (absent → 323 bytes)

binary file changed (absent → 247 bytes)

binary file changed (absent → 2464 bytes)

binary file changed (absent → 540 bytes)

binary file changed (absent → 697 bytes)

binary file changed (absent → 1606 bytes)

binary file changed (absent → 1364 bytes)

binary file changed (absent → 317 bytes)

binary file changed (absent → 2024 bytes)

binary file changed (absent → 1267 bytes)

binary file changed (absent → 323 bytes)

binary file changed (absent → 247 bytes)

binary file changed (absent → 2216 bytes)

binary file changed (absent → 2240 bytes)

binary file changed (absent → 1601 bytes)

binary file changed (absent → 1490 bytes)

binary file changed (absent → 2483 bytes)

@@ -0,0 +1,63 @@+Name:           himerge+Version:        0.17.9+License:        GPL+License-File:	LICENSE+Author:         Luis Francisco Araujo+Maintainer:	araujo@gentoo.org+Stability:	Beta+Synopsis:       Haskell Graphical User Interface for Emerge+Description:+		Himerge is a graphical user interface for emerge (Gentoo's Portage system) +		written in Haskell using gtk2hs.+Category:	GUI+Build-Type:	Simple+Build-Depends:  haskell98, base, unix, directory, process, +		old-time, parallel, gtk, mozembed, glib+Extra-Source-Files:+	ChangeLog install_data.sh readme.txt+	data/himerge/doc/himerge.css data/himerge/doc/himerge_doc.html+	data/himerge/icons/add.png+	data/himerge/icons/all.png+	data/himerge/icons/binary.png+	data/himerge/icons/category.png+	data/himerge/icons/clear.png+	data/himerge/icons/ebuild.png+	data/himerge/icons/edit.png+	data/himerge/icons/emerge.png+	data/himerge/icons/fetch.png+	data/himerge/icons/himerge-16.png+	data/himerge/icons/himerge-22.png+	data/himerge/icons/himerge-32.png+	data/himerge/icons/himerge-bigger.png+	data/himerge/icons/himerge.png+	data/himerge/icons/list-add.png+	data/himerge/icons/list-remove.png+	data/himerge/icons/neworld.png+	data/himerge/icons/package.png+	data/himerge/icons/process-stop.png+	data/himerge/icons/queue.png+	data/himerge/icons/refresh.png+	data/himerge/icons/remove.png+	data/himerge/icons/revdep.png+	data/himerge/icons/search.png+	data/himerge/icons/small-add.png+	data/himerge/icons/small-remove.png+	data/himerge/icons/sync.png+	data/himerge/icons/system.png+	data/himerge/icons/unmerge.png+	data/himerge/icons/usepkg.png+	data/himerge/icons/world.png++Executable: 	himerge+Main-Is:        Main.hs+Hs-Source-Dirs: src+Other-Modules:	+	Browser,+	Components,+	Emerge,+	Menus,+	Render,+	UseFlag,+	Util,+	Web+Ghc-Options:	-O2 -Wall

@@ -0,0 +1,16 @@+# +# himerge 0.17+#+VERSION="0.17.9"+HIMERGE_DATA="/usr/share/himerge"+HIMERGE_DOC="/usr/share/doc/himerge-${VERSION}/"+HIMERGE_ICONS="$HIMERGE_DATA/icons/"++mkdir -p $HIMERGE_DOC+mkdir -p $HIMERGE_ICONS++cp ./data/himerge/doc/* $HIMERGE_DOC+cp ./data/himerge/icons/* $HIMERGE_ICONS++echo "Files installed on:" $HIMERGE_DOC "and" $HIMERGE_ICONS "successfully for himerge ${VERSION}."+echo "** Please, don't change these files location **"

@@ -0,0 +1,46 @@+-------------------------------------------------------+Himerge: A Haskell Graphical User Interface for Emerge.+-------------------------------------------------------+Version: 0.17.9 (Lotus)+Status: Beta++Dependencies:++The Glasgow Haskell Compiler >= 6.8	http://www.haskell.org/ghc+The GHC Parallel Programming Library	http://www.haskell.org/ghc+Cabal (any version should work fine)	http://haskell.org/cabal+gtk2hs >= 0.9.12 (darcs version)	http://haskell.org/gtk2hs/+gentoolkit >= 0.2.3			http://www.gentoo.org/proj/en/portage/tools/index.xml+portage-utils >= 0.1.28			http://www.gentoo.org++Building:++   $ runhaskell Setup.hs configure+   $ runhaskell Setup.hs build+   # runhaskell Setup.hs install+   #./install_data+   (you may need to be root)++You need to have Cabal installed in your system.+Cabal gets installed with newer versions of GHC,+you also can get a stand-alone version of Cabal +from http://haskell.org/cabal.++Visit the Himerge web-site and wiki for further information and+updates:++	http://www.haskell.org/himerge+	http://www.haskell.org/haskellwiki/Himerge++Use:++   $ himerge++License:+   GPL++Author:+   Luis Francisco Araujo+   araujo@gentoo.org+ +Tue Mar  4 11:21:15 VET 2008

@@ -0,0 +1,724 @@+{-+    Main Browser.+    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+-}++module Browser+    where++import Emerge+import Menus+import Util+import Web+import Render+import Graphics.UI.Gtk+import System.Directory+import Control.Monad+import Control.Concurrent+import Data.List+import Data.Char (isAlpha, isNumber)+import Data.Maybe+import System.Exit+import qualified Control.Exception as E +import System.IO+import System.Process+import Graphics.UI.Gtk.MozEmbed++-- | Browser type.+type Browser = (VBox, Notebook, TextView, Statusbar, +		ProgressBar, MozEmbed, Tooltips)++buttonIconList :: [(String, String)]+buttonIconList = +    [ ("queue", "Calculate the dependencies for a selected package and add them into the package queue")+    , ("revdep", "Calculate the direct reverse dependencies for a selected package and add them into the package queue")+    , ("add", "Add selected package to the processing queue")+    , ("remove", "Remove a selected package from the queue")+    , ("clear", "Clear the main package queue")+    , ("world", "Calculate the world dependencies and add them into the main package queue")+    , ("neworld", "Calculate the world dependencies with the 'newuse' flag enabled and add them into the main package queue")+    , ("sync", "Synchronize the portage tree with the remote repositories (sync)")+    , ("emerge", "Install the packages listed on the queue")+    , ("unmerge", "Uninstall the packages listed on the queue")+    , ("binary", "Install and make binary tarballs from the package listed on the queue")+    , ("usepkg", "Install and use binary tarballs (if available) from the packages listed on the queue")+    , ("fetch", "Only fetch the packages listed on the queue. Do not install them")+    , ("system", "Caculate the 'system' packages and add them into the queue")+    , ("all", "List all packages installed in the system into the queue")+    ]++browserIcon :: [(String, String)]+browserIcon = [ ("refresh", "Refresh the browser view")+	      , ("edit", "Edit the browser view") ]++cquestions :: [String]+cquestions = [ "Do you want to install queded packages?"+	     , "Do you want to un-install queded packages?" +	     , "Do you want to install and build binary tarballs for queded packages?"+	     , "Do you want to install queded packages?\n(using available binary tarballs)"+	     , "Do you only want to fetch queded packages?" ]++portageBrowser :: FilePath -> IO Browser+portageBrowser prepo = +    do+    timeoutAddFull (yield >> return True) priorityDefaultIdle 50+    let portagerepo = prepo ++ "/"+    -- This is the main vertical box containing+    -- all the widgets.+    mainvbox <- vBoxNew False 3+    browservbox <- vBoxNew False 3+    -- Logo.+    image <- imageNewFromFile windowlogo+    -- Let's use ToolBars for the buttons.+    buttonstoolbar <- toolbarNew+    tooltips <- tooltipsNew+    toolbarSetTooltips buttonstoolbar True+    [ queuebutton , revdepbutton,  addqueuebutton, removequeuebutton+      , clearqueuebutton, worldbutton, neworldbutton, syncbutton+      , emergebutton, unmergebutton, binarybutton, usepkgbutton+      , fetchbutton, systembutton, allbutton ]+         <- mapM (toolButton tooltips buttonstoolbar) buttonIconList+    -- eix entry text search.+    checkbox <- checkButtonNew+    searchbox <- comboBoxEntryNewText+    searchlabel <- imageNewFromFile searchicon+    searchbutton <- buttonNew+    containerAdd searchbutton searchlabel+    -- Tell what some of these options do.+    tooltipsSetTip tooltips checkbox "Search package matching exact name" []+    tooltipsSetTip tooltips searchbutton "Search package" []+    labelsearchbox <- hBoxNew False 5+    opt <- labelNew Nothing+    labelSetMarkup opt ("<i><u>" ++ portagerepo ++ "</u></i>")+    boxPackStart labelsearchbox image PackNatural 0+    boxPackStart labelsearchbox opt PackNatural 0+    boxPackEnd labelsearchbox checkbox PackNatural 0+    boxPackEnd labelsearchbox searchbutton PackNatural 0+    boxPackEnd labelsearchbox searchbox PackNatural 0+    boxPackStart browservbox labelsearchbox PackNatural 0+    -- Add the main toolbar with toolbuttons to the window.+    boxPackStart browservbox buttonstoolbar PackNatural 5++    -- Browser Start.+    -- Add he Portage Command options to the browser.+    expander <- expanderNew "Portage Browser Operations"+    boxPackStart browservbox expander PackNatural 0+    {- | Start adding the Portage Tree Views.+       Get the portage tree root contents. -}+    portagetree <- (getDirectory portagerepo >>= return . filterDirs removeddirs . removeOddDirs)+    -- initialize all three liststore.+    (categorytv, categoryscroll, _) <- createStore "Category" SelectionSingle False+				       (Just (categoryicon, portagetree))+    (packagetv, packagescroll, _) <- createStore "Package" SelectionSingle False Nothing+    (versiontv, versionscroll, _) <- createStore "Version" SelectionSingle False Nothing+    -- Portage tree view main box.+    viewbrowser <- hBoxNew False 0+    mapM_ (flip (flip (boxPackStart viewbrowser) PackGrow) 3)+	      [categoryscroll, packagescroll, versionscroll]+    containerSetBorderWidth viewbrowser 5+    -- Create a frame around the whole browser: (text, scroll).+    treeframe <- makeFrame "Portage Browser" 0.50 0.50+    containerAdd treeframe viewbrowser+    boxPackStart browservbox treeframe PackGrow 0+    -- Browser Options.+    -- This is the control panel containing the browser view options.+    browsertoolbar <- toolbarNew+    [ refreshbutton , showeditbutton ] +	<- mapM (toolButton tooltips browsertoolbar) browserIcon+    containerAdd expander browsertoolbar+    -- Editable Text Browser. +    -- This allows to do extra things like for example+    -- removing un-existing packages on the package tree.+    -- It also allows to edit the browser view entries.    +    editbrowser <- hBoxNew False 3+    browsertext <- entryNew+    -- Radio buttons to choose what scroll panel to edit.+    rcategory <- radioButtonNewWithLabel "category"+    rpackage <- radioButtonNewWithLabelFromWidget rcategory "package"+    rversion <- radioButtonNewWithLabelFromWidget rcategory "version"+    let radiolist = [(rcategory, "category"), (rpackage, "package"), (rversion, "version")]+    let treeviewlist = [categorytv, packagetv, versiontv]+    -- Add/Remove buttons.+    addtobrowser <- buttonNewFromStock stockAdd+    removefrombrowser <- buttonNewFromStock stockRemove+    closeeditbrowser <- buttonNewFromStock stockClose+    -- Say what these buttons do.+    tooltipsSetTip tooltips addtobrowser "Add element to the specified browser category." []+    tooltipsSetTip tooltips removefrombrowser "Remove selected element from its browser category." []+    tooltipsSetTip tooltips closeeditbrowser "Close the edit browser options." []+    -- Build the Editable Text Browser.+    boxPackStart editbrowser browsertext PackGrow 3+    boxPackStart editbrowser rcategory PackNatural 1+    boxPackStart editbrowser rpackage PackNatural 1+    boxPackStart editbrowser rversion PackNatural 1+    -- button box.+    radiobuttons <- hBoxNew True 0+    boxPackStart radiobuttons addtobrowser PackNatural 0+    boxPackStart radiobuttons removefrombrowser PackNatural 0+    boxPackStart radiobuttons closeeditbrowser PackNatural 0+    boxPackStart editbrowser radiobuttons PackNatural 3+    editbrowserframe <- makeFrame "Browser Editor" 0.50 0.50+    containerAdd editbrowserframe editbrowser+    -- Connect buttons.+    addtobrowser `onClicked` addToBrowserView radiolist treeviewlist browsertext+    removefrombrowser `onClicked` removeFromBrowserView radiolist treeviewlist+    closeeditbrowser `onClicked` +		     (containerRemove expander editbrowserframe >>+		      containerAdd expander browsertoolbar >>+		      widgetShowAll browservbox)+    -- Browser Options.+    showeditbutton `onToolButtonClicked`+		       (containerRemove expander browsertoolbar >>+			containerAdd expander editbrowserframe >> +			widgetShowAll browservbox)+    refreshbutton `onToolButtonClicked`+		  refreshBrowser portagerepo categorytv packagetv versiontv+    -- Browser End.++    -- Let's use paneds to allow widgets to be resized.+    -- Vertical paned.+    vpaned <- vPanedNew+    -- Horizontal paned.+    hpaned <- hPanedNew+    panedSetPosition hpaned 390+    -- Makes the browser box resizable.+    panedPack1 vpaned browservbox True True+    -- Start creating the notebook panel.+    processpanel <- notebookNew+    notebookSetScrollable processpanel True+    notebookSetPopup processpanel True+    -- Different boxes containing the information windows+    -- for the notebook pages.+    (mozbox, mozwindow) <- webBrowser+    -- Load the initial documentation.+    mozEmbedLoadUrl mozwindow hdoc+    -- Package mozilla browser.+    panedPack1 hpaned mozbox True True+    (logscroll, logview) <- makeView False+    (ebuildscroll, ebuildview) <- makeView True+    (clogscroll, clogview) <- makeView False+    (pkgqueuetv, pkgqueuescroll) <- createQueueStore+    -- Set the name of this widget to make it accessible to the+    -- 'queue' operations.+    widgetSetName pkgqueuescroll "scrollview"+    widgetSetName pkgqueuetv "treeview"+    -- Notebook pages.+    -- Log view.+    notebookAppendPage processpanel logscroll "Log"+    notebookSetMenuLabelText processpanel logscroll "Log"+    -- Queue package window.+    notebookAppendPage processpanel pkgqueuescroll "Main Queue"+    notebookSetMenuLabelText processpanel pkgqueuescroll "Main Queue"+    -- Ebuild text window.+    notebookAppendPage processpanel ebuildscroll "Ebuild"+    notebookSetMenuLabelText processpanel ebuildscroll "Ebuild"+    -- ChangeLog text window.+    notebookAppendPage processpanel clogscroll "Changelog"+    notebookSetMenuLabelText processpanel clogscroll "ChangeLog"+    -- Add the notebook panel into a frame+    controlframe <- makeFrame "Control Panel" 0.0 0.50+    containerSetBorderWidth processpanel 5+    containerAdd controlframe processpanel+    -- Add the controlframe into the horizontal paned.+    panedPack2 hpaned controlframe True False+    -- Packs the horizontal paned inside the vertical one.+    -- This allows resizing both the browser box and the info/mozilla widgets.+    panedPack2 vpaned hpaned True False+    -- Add the vertical paned to the main box.+    boxPackStart mainvbox vpaned PackGrow 0+    -- Build the status display box.+    statusbox <- hBoxNew False 0+    progbar <- progressBarNew+    statbar <- statusbarNew+    updateStatBar statbar "Welcome to himerge!"+    boxPackStart statusbox statbar PackGrow 0+    boxPackEnd statusbox progbar PackNatural 0+    -- Add the last box into the main box.+    boxPackStart mainvbox statusbox PackNatural 0+    -- Search the package using eix.+    searchbutton `onClicked` comboBoxSearchEntry searchbox+		     (search portagerepo packagetv categorytv versiontv statbar checkbox mozwindow)+    searchbox `onKeyRelease` comboBoxSearchEntryEvent searchbox+		  (search portagerepo packagetv categorytv versiontv statbar checkbox mozwindow)+    -- Update the category view.+    categorytv `onCursorChanged` +	       updateCategory packageicon portagerepo categorytv packagetv+    -- Update the package version view and information mozilla browser.+    packagetv `onCursorChanged`+		  (updatePackage ebuildicon portagerepo packagetv versiontv >>=+		   (\ pkgname -> do+		    (Just tvc) <- treeViewGetColumn packagetv 0+		    (Just cat) <- treeViewColumnGetTitle tvc+		    updateMozilla mozwindow (" -e " ++ cat ++ "/" ++ pkgname)))+    -- Update package specific information views.+    versiontv `onCursorChanged` +	      (updateInfo portagerepo versiontv (ebuildview, clogview) statbar >>+	       updateMozillaFromQueue versiontv mozwindow 1)+    -- Package popup menu.+    versiontv `onButtonRelease` packagePopupMenu portagerepo versiontv statbar+    -- Update the mozilla browser when selected a package from the Main Queue.+    pkgqueuetv `onCursorChanged` (updateMozillaFromQueue pkgqueuetv mozwindow 3)+    -- Queue operations.+    queuebutton `onToolButtonClicked` pkgDependency versiontv processpanel logview statbar mozwindow progbar+    revdepbutton `onToolButtonClicked` pkgReverseDependency versiontv processpanel logview statbar mozwindow progbar+    addqueuebutton `onToolButtonClicked` addAtQueue versiontv processpanel statbar+    removequeuebutton `onToolButtonClicked` removePageElement processpanel+    clearqueuebutton `onToolButtonClicked` clearQueue processpanel statbar+    worldbutton `onToolButtonClicked` +		(writeLog logview msgworld >>+		 emergeQueue "--deep --update world" msgworld processpanel logview statbar mozwindow progbar)+    neworldbutton `onToolButtonClicked`+		  (writeLog logview msgworldnewuse >>+		   emergeQueue "--newuse --deep --update world" msgworldnewuse processpanel logview statbar mozwindow progbar)+    systembutton `onToolButtonClicked`+		 (writeLog logview msgsystem >>+		  emergeQueue "--newuse --deep --update system" msgsystem processpanel logview statbar mozwindow progbar)+    allbutton `onToolButtonClicked` +		  (writeLog logview msginstalled >> pkgInstalled processpanel logview msginstalled statbar mozwindow progbar)+    -- Main emerge operations.+    syncbutton `onToolButtonClicked` sync processpanel logview statbar progbar+    emergebutton `onToolButtonClicked`+		 popSelectWindow (cquestions !! 0) (emergePackages processpanel logview statbar progbar)+    unmergebutton `onToolButtonClicked`+		  popSelectWindow (cquestions !! 1) (unmergePackages processpanel logview statbar progbar)+    binarybutton `onToolButtonClicked` +		 popSelectWindow (cquestions !! 2) (binaryPackages processpanel logview statbar progbar)+    usepkgbutton `onToolButtonClicked` +		 popSelectWindow (cquestions !! 3) (useBinaryPackages processpanel logview statbar progbar)+    fetchbutton `onToolButtonClicked`+		popSelectWindow (cquestions !! 4) (fetchPackages processpanel logview statbar progbar)+    -- return this main vbox.+    return (mainvbox, processpanel, logview, statbar, progbar, mozwindow, tooltips)+	where+	msgworld = "Calculating world dependencies."+	msgworldnewuse = "Calculating world dependencies (newuse)."+	msgsystem = "Calculating system dependencies."+	msginstalled = "Calculating installed packages."++addToBrowserView :: [(RadioButton, String)] -> [TreeView] -> Entry -> IO ()+addToBrowserView radiolist tvs combotext =+    do+    t <- entryGetText combotext+    case words t of+       [] -> return ()+       (text:_) -> do+		   option <- findRadioButton radiolist	      +		   let (icon, tv) = case option of+				       "category" -> (categoryicon, tvs !! 0)+				       "package" -> (packageicon, tvs !! 1)+				       "version" -> (ebuildicon, tvs !! 2)+				       _ -> error "addToBrowserView: This shouldn't ever happen!"+		   [(store,_)] <- storeAndSelector [tv]+		   storeObjects store icon [text]++removeFromBrowserView :: [(RadioButton, String)] -> [TreeView] -> IO ()+removeFromBrowserView radiolist tvs =+    do+    option <- findRadioButton radiolist+    let tv = case option of+	        "category" -> tvs !! 0+		"package" -> tvs !! 1+		"version" -> tvs !! 2+		_ -> error "removeFromBrowserView: This shouldn't ever happen!"+    removeSelectedPkg tv++removeSelectedPkg :: TreeView -> IO ()+removeSelectedPkg tv =+    do+    [(store, sel)] <- storeAndSelector [tv] +    maybeiter <- treeSelectionGetSelected sel+    case maybeiter of+      Nothing -> return ()+      Just node -> do+		   (GVstring (Just name)) <- treeModelGetValue store node textColumn+		   popSelectWindow ("WARNING: Do you really want to remove [" ++ name ++ "] ?")+		                   (listStoreRemove store node >> return ())++refreshBrowser :: FilePath -> TreeView -> TreeView -> TreeView -> IO ()+refreshBrowser repo category package version =+    do+    dirs <- getDirectory repo >>= return . filterDirs removeddirs . removeOddDirs+    [(cat,_), (pkg,_), (ver,_)] <- storeAndSelector [category, package, version]+    mapM_ listStoreClear [cat, pkg, ver]+    storeObjects cat categoryicon dirs+    iter <- treeModelGetIter cat [0]+    case iter of+       Nothing -> popErrorWindow "refreshBrowser: No value to scroll to?"+       Just iter' -> scrollViewToCell cat iter' category++getSelectedPkg :: TreeView -> IO (Maybe String)+{- | Get the package name from a tree view (fromtv). -}+getSelectedPkg fromtv =+    do+    [(fromstore, sel)] <- storeAndSelector [fromtv] +    maybeiter <- treeSelectionGetSelected sel+    case maybeiter of+      Nothing -> return Nothing+      (Just node) -> getCategoryPackage fromtv fromstore node >>= (return . Just)++runForPkgQueue :: TreeView -> TextView -> (String -> String -> IO ())+	       -> Statusbar -> String -> IO ()+runForPkgQueue fromtv logview func statbar extramsg =+    do+    selectedpkg <- getSelectedPkg fromtv+    case selectedpkg of+      Nothing -> updateStatBar statbar "No package version selected."+      (Just pkg) -> -- =cat/pkg-ver+		     do+		     let loginfo = ("Calculating" ++ extramsg ++ " dependencies for " ++ pkg)+		     -- Write operation log.+		     writeLog logview loginfo+		     func ("=" ++ pkg) loginfo++makeQueueFromCommand :: String -> String -> (Handle -> IO [(String, String)]) -> String +		     -> Notebook -> TextView -> Statusbar -> ProgressBar -> MozEmbed -> String -> IO ()+{- | Apply a command over a package name and gets its output into+   the package Queue. -}+makeQueueFromCommand command statmsg func pkgtoken panel logview statbar progbar mozwindow extramsg =+    do+    (_,out,err,ph) <- runInteractiveCommand command+    barthread <- forkIO $ updateBar progbar+    nout <- E.evaluate out+    statid <- forkIO $ refreshStatBar statbar statmsg+    forkIO $ onExit ph ((.) ((>>) (killThread statid)) (handleExitCode nout err barthread))+    return ()+    where+    handleExitCode handle errhandle barthread exitcode =+	killThread barthread >>+	case exitcode of+	  ExitSuccess -> do+		      let pkg = last $ words pkgtoken+		      pkglist <- func handle+                      case pkglist of+		         [] -> do+			       let rlog = ("No valid dependencies for " ++ pkg)+			       writeLog logview rlog+			       updateStatBar statbar rlog+			       progressBarSetFraction progbar 0.0+			 pkglist' -> do+			             -- Make a new Queue for each process.+				     (pkgqueuetv, pkgqueuescroll) <- createQueueStore+				     -- Name this widget to keep track of the correct package values.+				     widgetSetName pkgqueuetv "treeview"+				     widgetSetName pkgqueuescroll "scrollview"+				     -- Build the panel page.+				     (tooltips, _, (Just closebutton))+					 <- buildPanelTab pkgqueuescroll panel ("Queue: " ++ pkgtoken) CloseButton+				     widgetShowAll pkgqueuescroll+				     notebookSetCurrentPage panel (-1)+				     -- Connect this button to the close signal.+				     (Just text) <- notebookGetMenuLabelText panel pkgqueuescroll+				     closebutton `onClicked`	    +						     (popSelectWindow ("Do you really want to close [" ++ text ++ "]?")+                 				      (tooltipsEnable tooltips >> closeTab panel pkgqueuescroll))+				     -- Update mozilla browser when selecting a package from the queue.+                                     pkgqueuetv `onCursorChanged` (updateMozillaFromQueue pkgqueuetv mozwindow 3)+				     depst <- getStoreFromView pkgqueuetv+				     listStoreClear depst+				     -- Add packages into the queue.+				     pixbuf <- pixbufNewFromFile ebuildicon+				     storeQueueObjects depst pixbuf pkglist'+				     let rlog = (pkg ++ extramsg ++ " dependencies successfully calculated.")+				     writeLog logview rlog+				     updateStatBar statbar rlog+				     progressBarSetFraction progbar 1.0+	  _ -> do+	       hGetContents errhandle >>= hPutStr stderr+	       let rlog = ("Error calculating package" ++ extramsg ++ " dependencies.")+	       writeLog logview rlog+	       emergeError rlog handle+	       updateStatBar statbar rlog+	       progressBarSetFraction progbar 0.0++emergeQueue :: String -> String -> Notebook -> TextView+	    -> Statusbar -> MozEmbed -> ProgressBar -> IO ()+emergeQueue pkgtoken statmsg panel logview statbar mozwindow progbar =+    makeQueueFromCommand (emergepath ++ " --verbose --pretend " ++ pkgtoken)+                         statmsg emergeDeps pkgtoken panel logview statbar progbar mozwindow []++pkgDependency :: TreeView -> Notebook -> TextView +	      -> Statusbar -> MozEmbed -> ProgressBar -> IO ()+{- | Calculate the dependency queue of a package. -}+pkgDependency fromtv panel logview statbar mozwindow progbar =+    runForPkgQueue fromtv logview func statbar []+	where+	func pkgtoken statmsg = +	    makeQueueFromCommand (emergepath ++ " --verbose --pretend " ++ pkgtoken) statmsg+				 emergeDeps pkgtoken panel logview statbar progbar mozwindow []++pkgReverseDependency :: TreeView -> Notebook -> TextView +		     -> Statusbar -> MozEmbed -> ProgressBar -> IO ()+{- | Calculte the reverse dependency queue of a package. -}+pkgReverseDependency fromtv panel logview statbar mozwindow progbar =+    runForPkgQueue fromtv logview func statbar " reverse"+	where+	func pkgtoken statmsg =+	    makeQueueFromCommand (equerypath ++ "depends " ++ pkgtoken) statmsg+				 equeryOutput pkgtoken panel logview statbar progbar mozwindow " reverse"++pkgInstalled :: Notebook -> TextView -> String -> Statusbar -> MozEmbed -> ProgressBar -> IO ()+pkgInstalled panel logview statmsg statbar mozwindow progbar =+    makeQueueFromCommand (qlistpath ++ "--verbose --nocolor --installed") statmsg+                         equeryOutput "all-packages" panel logview statbar progbar mozwindow []++addAtQueue :: TreeView -> Notebook -> Statusbar -> IO ()+addAtQueue fromtv panel statbar =+    isCurrentPagePackagePanel panel func+    where+    func totv =+	do+	[(fromstore, sel), (tostore,_)] <- storeAndSelector [fromtv, totv]+	maybeiter <- treeSelectionGetSelected sel+	case maybeiter of+	   Nothing -> updateStatBar statbar "No package version selected."+	   (Just node) -> do+      	                  catpkg <- getCategoryPackage fromtv fromstore node+			  updateStatBar statbar (catpkg ++ " added to queue.")+			  pixbuf <- pixbufNewFromFile ebuildicon+			  storeQueueObjects tostore pixbuf [("A", catpkg)]++clearQueue :: Notebook -> Statusbar -> IO ()+{- | Removed all the packages in the queue if any. -}+clearQueue panel statbar =+    isCurrentPagePackagePanel panel+	     (\ pkgtv -> getStoreFromView pkgtv >>= listStoreClear >> +	      updateStatBar statbar "Cleared package queue.")++updateCategory :: FilePath -> FilePath -> TreeView +	       -> TreeView -> IO ()+{- | Update the packages views with the category+   information available. -}+updateCategory image repopath tv newtv =+    do+    [(store, sel), (newstore, _)] <- storeAndSelector [tv, newtv]+    rows <- treeSelectionGetSelectedRows sel+    case rows of+     [[node]] -> do+	     (GVstring (Just catname)) <- valueWithIterTreeModel store node textColumn+             let directory = (repopath ++ catname ++ "/")+             dirb <- doesDirectoryExist directory+	     if dirb +		then do+		     dir <- getDirectory directory+		     initStoringObj newtv newstore catname image dir+		     iter <- treeModelGetIter newstore [0]+		     if isJust iter +			then scrollViewToCell newstore (fromJust iter) newtv+			else popErrorWindow "No valid category."+		else popErrorWindow (directory ++ " does not exist.")+     _ -> return ()++updatePackage :: FilePath -> FilePath -> TreeView -> TreeView -> IO String+{- | Update the package versions views with the package+   information available. -}+updatePackage image repopath tv newtv =+    do+    [(store, sel), (newstore, _)] <- storeAndSelector [tv, newtv]+    rows <- treeSelectionGetSelectedRows sel+    case rows of+     [[node]] -> do+		 (GVstring (Just pkgname)) <- valueWithIterTreeModel store node textColumn+		 (Just tvc) <- treeViewGetColumn tv 0+		 (Just cat) <- treeViewColumnGetTitle tvc+		 let fullcatpkg = cat ++ "/" ++ pkgname+		 let directory = (repopath ++ fullcatpkg ++ "/")+		 dirb <- doesDirectoryExist directory+		 if dirb +		    then do+			 dir <- getVersion directory+			 initStoringObj newtv newstore fullcatpkg image dir+			 return pkgname+		    else popErrorWindow (fullcatpkg ++ " does not exist.") >> return []+     _ -> return []++updateMozilla :: MozEmbed -> String -> IO ()+updateMozilla mozweb pkgname =+    do+    eix <- eixOutput pkgname+    (tmpfile, tmphandle) <- writeTempFile htmltemp+    hPutStr tmphandle $ render eix+    hFlush tmphandle+    mozEmbedLoadUrl mozweb tmpfile+    removeFile tmpfile `E.catch`+		   \ e -> popErrorWindow $ show e+    hClose tmphandle++updateMozillaFromQueue :: TreeView -> MozEmbed -> Int -> IO ()+updateMozillaFromQueue pkgtv mozwindow column = +    do+    [(store, sel)] <- storeAndSelector [pkgtv]+    row <- treeSelectionGetSelectedRows sel+    case row of+       [[node]] -> do+		   (GVstring (Just pkginfo)) <- valueWithIterTreeModel store node column+		   let p = (extractpkg $ splitpkg $ takeWhile (/= ' ') pkginfo)+		   updateMozilla mozwindow (" -e " ++ p)+		       where+		       splitpkg = splitStr '-'+		       extractpkg spkg = +			   if (f $ last $ spkg)+			      then joinStr '-' $ init $ init spkg+			      else joinStr '-' $ init spkg+		       f ('r':xs) = all isNumber xs+		       f _ = False+       _ -> return ()++updateInfo :: FilePath -> TreeView -> (TextView, TextView)+	   -> Statusbar -> IO ()+{- | Update the different panel views with the +   version treeview information available. -}+updateInfo repopath tv (ebuildv, clogv) statbar =+   do +   [(store, sel)] <- storeAndSelector [tv]+   rows <- treeSelectionGetSelectedRows sel+   case rows of+     [[n]] -> do+	      (Just tvc) <- treeViewGetColumn tv 0+	      (Just cat) <- treeViewColumnGetTitle tvc+	      (GVstring (Just package)) <- valueWithIterTreeModel store n textColumn+              let parsedpath = repopath ++ cat ++ "/"+              let changelogpath = parsedpath ++ "ChangeLog"+	      let ebuildpath = parsedpath ++ package ++ ".ebuild"+	      -- Test for the ebuild (just in case) and Changelog file existence.+              [ebuild, changelog] <- +		  mapM (\ (file, msg) -> do+			b <- doesFileExist file+			if b then readFile file else return msg)+					 [ (ebuildpath, "No ebuild file!!!.")+					 , (changelogpath, "No Changelog file available.") ] ++	      updateTextBuffer ebuildv ebuild+	      updateTextBuffer clogv changelog+     _ -> updateStatBar statbar "Incorrect option."++initStoringObj :: TreeView -> ListStore -> FilePath -> FilePath +	       -> [FilePath] -> IO ()+{- Add new objects to a tree store. +   Used for updating the category and package treeviews. -}+initStoringObj tv newstore pkgorcatname image dir =+    do+    listStoreClear newstore+    (Just tvc) <- treeViewGetColumn tv 0+    treeViewColumnSetTitle tvc pkgorcatname+    storeObjects newstore image dir+    return ()++comboBoxSearchEntryEvent :: ComboBoxEntry -> (String -> String -> IO ())+			 -> Event -> IO Bool+comboBoxSearchEntryEvent sbox func (Key { eventKeyName = "Return" }) =+    comboBoxSearchEntry sbox func >> return True+comboBoxSearchEntryEvent _ _ _ = return False++comboBoxSearchEntry :: ComboBoxEntry -> (String -> String -> IO ()) -> IO ()+{- Entry function for the package search box operation. -}+comboBoxSearchEntry sbox func =+    do+    text <- comboBoxGetActiveText sbox+    case text of+       Nothing -> return ()+       Just [] -> return ()+       Just jtext | null $ words jtext -> return ()+		  | otherwise -> do+				 model <- comboBoxGetModel sbox+				 let textval = stripspaces jtext+				 case model of+				    Nothing -> return ()+				    Just m -> comboboxgetstrings m >>=+					      \ s -> if any (== textval) s+						        then return ()+							else comboBoxPrependText sbox textval+				 out <- eixOutput textval+				 forkIO $ (func textval out >> return ())+				 return ()+	where+	comboboxgetstrings model' = collectIters model' 0 >>= collectStringValues model' 0+	stripspaces = unwords . words++search :: FilePath -> TreeView -> TreeView -> TreeView+       -> Statusbar -> CheckButton -> MozEmbed -> String -> String -> IO ()+search repopath pkgtv cattv vertv statbar checkb mozwindow pkgname eixoutput =+    do+    cb <- toggleButtonGetActive checkb+    let parsed = parseEixOutput pkgname cb eixoutput+    if null (fst parsed)+       then updateStatBar statbar ("Package " ++ pkgname ++ " not found.")+       else searchOn pkgname repopath cattv pkgtv vertv parsed statbar cb mozwindow++parseEixOutput :: String -> Bool -> String -> ([String], [String])+{- Return structure of the form: ([categories], [packages]) -}+parseEixOutput pkgname cbool = findpkg pkgname (if cbool then (==) else findSubstring) [] []+			       . filter (\ c -> if (not . null) c then ((/= ' ') . (!! 0)) c else False)+			       . lines+    where+    findpkg _ _ cats pkgs [] = (nub (cats ++ []), nub (pkgs ++ []))+    findpkg pkgname' func cats pkgs (ps:pss) = +    -- Break at '/' for "* category/package"+	    if (not . any (== '/')) catpkg+	       then findpkg pkgname' func cats pkgs pss+	       else (if func pkgname' pkg || func pkgname' catpkg+		        then findpkg pkgname' func (cats ++ [cat]) (pkgs ++ [pkg]) pss+		        else findpkg pkgname' func cats pkgs pss)+		   where+		   stripr = takeWhile (/= ' ')+		   stripl = dropWhile (not . isAlpha)+		   catpkg = stripr $ stripl $ ps+		   (cat, (_:pkg)) = break (== '/') catpkg++searchOn :: String -> FilePath -> TreeView -> TreeView -> TreeView +	 -> ([String], [String]) -> Statusbar -> Bool -> MozEmbed -> IO ()+{- | Search the package on the views. -}+searchOn pkgname repopath cattv pkgtv vertv (cats, pkgs) statbar checkbool mozwindow =+    do+    [(catstore, catsel)] <- storeAndSelector [cattv]+    generalfind findcat 0 catstore catsel "category" (cats, pkgs)+    where+    generalfind _ _ _ _ _ ([], []) = updateStatBar statbar "Package not found."+    generalfind _ _ _ _ _ ([], _) = updateStatBar statbar "Package not found."+    generalfind _ _ _ _ _ (_, []) = searchOn pkgname repopath cattv pkgtv vertv (tail cats, pkgs) +				             statbar checkbool mozwindow+    generalfind func num store sel label (catss, pkgss) =+	do+	jiter <- treeModelGetIter store [num]+	case jiter of+	   Nothing -> if label == "category" +		          then generalfind func 0 store sel label (tail catss, pkgss)+			  else generalfind func 0 store sel label (catss, tail pkgss)+	   Just iter ->+	       do+	       (GVstring (Just value)) <- treeModelGetValue store iter textColumn+               let mvalue = if label == "category" then (head catss) else (head pkgss)+	       if (==) value mvalue+		  then func iter sel value store (catss, pkgss) >>+		       -- Exact query for eix if it is enabled the checkbutton.+		       case checkbool of { True -> return " -e " ; False -> return []} >>=+		       \ c -> updateMozilla mozwindow (c ++ pkgname)+		  else generalfind func (num + 1) store sel label (catss, pkgss)+    findcat iter' sel' _ store' xs = +	do+	treeSelectionSelectIter sel' iter'+	-- Scroll to the category found.+	scrollViewToCell store' iter' cattv+	updateCategory packageicon repopath cattv pkgtv+	[(pkgstore, pkgsel)] <- storeAndSelector [pkgtv]+	generalfind findpkg 0 pkgstore pkgsel "package" xs+    findpkg iter' sel' value' store' _ =+	do+	treeSelectionSelectIter sel' iter'+	-- Scroll to the package found.+	scrollViewToCell store' iter' pkgtv+	updatePackage ebuildicon repopath pkgtv vertv+	updateStatBar statbar ("Package " ++ value' ++ " found.")

@@ -0,0 +1,64 @@+{-+    Extra components.+    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+-}++module Components +    where++import Util+import Graphics.UI.Gtk++logoicon :: FilePath+logoicon = iconpath ++ "himerge.png"++aboutHimerge :: IO ()+{- | Show hImerge programm information. -}+aboutHimerge =+    do+    about <- aboutDialogNew+    aboutDialogSetName about hname+    aboutDialogSetVersion about hversion+    aboutDialogSetComments about "Haskell Graphical User Interface for Emerge."+    aboutDialogSetWebsite about "http://www.haskell.org/himerge/"+    aboutDialogSetCopyright about "Copyright 2007-2008 Luis Francisco Araujo\n\+				  \ <araujo@gentoo.org>"+    pix <- pixbufNewFromFile logoicon+    aboutDialogSetLogo about (Just pix)+    aboutDialogSetLicense about (Just license)+    aboutDialogSetArtists about ["Josef Vybíral <cornelius@vybiral.info>"+				, "Most of the icons designed by the Tango Project \+				 \on\n<http://tango.freedesktop.org> under the \+				 \\nCC License <http://creativecommons.org/licenses/by-sa/2.5/>" ]++    about `onResponse` +	  \ _ -> widgetDestroy about+    widgetShowAll about++license :: String+license =  +    "This program is free software; you can redistribute it and/or modify\n\+    \ it under the terms of the GNU General Public License as published by\n\+    \ the Free Software Foundation; either version 2 of the License, or\n\+    \ (at your option) any later version.\n\n\+    \This program is distributed in the hope that it will be useful,\n\+    \but WITHOUT ANY WARRANTY; without even the implied warranty of\n\+    \MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n\+    \GNU General Public License for more details.\n\n\+    \You should have received a copy of the GNU General Public License\n\+    \along with this program; if not, write to the Free Software\n\+    \nFoundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA"

@@ -0,0 +1,218 @@+{-+    Portage's emerge command entry functions.+    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+-}++module Emerge+    where++import Util+import Graphics.UI.Gtk+import Data.Char (isAlpha)+import System.IO+import System.Process+import Control.Concurrent+import System.Exit+import qualified Control.Exception as E+++data EmergeParse = EmergeSuccessDep | EmergeBlockError String +		   deriving Show++blockerrormsg :: String+blockerrormsg = "\nFor more information about Blocked Packages, please refer to the following\n\+		 \section of the Gentoo Linux x86 Handbook (architecture is irrelevant):\n\+		 \\n\      +                 \http://www.gentoo.org/doc/en/handbook/handbook-x86.xml?full=1#blocked"++emergepath :: FilePath+emergepath = envbin ++ " emerge --color=n "++equerypath :: FilePath+equerypath = envbin ++ " equery "++qlistpath :: FilePath+qlistpath = envbin ++ " qlist "++emergeDeps :: Handle -> IO [(String, String)]+emergeDeps out =+    do+    output <- hGetContents out+    E.evaluate output    +    let pkgs = lines output+    case checkDepOutput pkgs of+       EmergeSuccessDep -> return $ map f $ takeWhile (not . null) $ lines $ dropWhile (/= '[') output+       EmergeBlockError xs -> popErrorWindow xs >> return []+    where+	f pkg = let (s:rs) = words $ dropWhile (/= ' ') pkg+		       in+		       let p = dropWhile (not . isAlpha) $ unwords rs in (filter isAlpha s, p)++checkDepOutput :: [String] -> EmergeParse+checkDepOutput [] = EmergeSuccessDep+checkDepOutput (('[':'b':'l':'o':'c':'k':'s':xs):_) = +		EmergeBlockError ((drop 2 $ dropWhile (/= ']') xs) ++ blockerrormsg)+checkDepOutput (_:xs) = checkDepOutput xs++equeryOutput :: Handle -> IO [(String, String)]+equeryOutput out = +    do+    output <- hGetContents out+    E.evaluate output+    let xs = filter (not . null) $ map (takeWhile (/= ' ')) $ lines output+    return $ map ((,) "Y") xs++emergeError :: String -> Handle -> IO ()+emergeError = flip ((>>=) . hGetContents) . (popErrorWindow .) . (++)++sync :: Notebook -> TextView -> Statusbar -> ProgressBar -> IO ()+sync = commandView (emergepath ++ "--sync", "Updating portage tree",+		    "Portage tree successfully updated.", "Error updating portage tree.") EmergeSync++emergeInfo, emergeMetadata :: Notebook -> TextView -> Statusbar -> ProgressBar -> IO ()+emergeInfo = commandView (emergepath ++ "--info", "Showing portage information",+			  "Portage information.", "Error showing portage information.") Emerge+emergeMetadata = commandView (emergepath ++ "--metadata", "Regenerating metadata",+			      "Portage metadata regenerated.", "Error regenerating metadata.") EmergeSync++emerge :: [String] -> Notebook -> TextView -> Statusbar -> ProgressBar +       -> String -> (TreeView, ListStore, [(String, TreeIter)]) -> IO ()+emerge _ _ _ statbar _ [] (_, _, []) = +    updateStatBar statbar "No package on queue." >> return ()+emerge _ _ _ statbar _ pkgmsg (_, _, []) =+    updateStatBar statbar pkgmsg+emerge msgs panel logview statbar progbar _ (tv, st, ((package, pkgiter):ps)) =+    do+    -- Create the notebook page.+    (pkgscroll, pkgview) <- makeView False+    -- Build the page panel with the proper tab buttons.+    (tooltips, (Just stopbutton), (Just closebutton))+	<- buildPanelTab pkgscroll panel package StopCloseButton+    widgetShowAll pkgscroll+    -- Jump to the page processing the operation.+    notebookSetCurrentPage panel (-1)+    -- Start emerge operation.+    -- Set package status on queue.+    progressBarSetFraction progbar 0.0+    -- Log information.+    let loginfo = ((msgs !! 1) ++ " " ++ package)+    -- Write the log.+    writeLog logview loginfo+    -- Keep updating the status bar with the log information.+    statid <- forkIO $ refreshStatBar statbar (loginfo ++ " ...")+    listStoreSetValue st pkgiter 0 (GVstring $ Just (setQueueColor "green" (msgs !! 1)))+    listStoreSetValue st pkgiter 4 (GVstring $ Just "purple")+    scrollViewToCell st pkgiter tv+    (_,out,err,ph) <- runInteractiveCommand ((msgs !! 0) ++ " =" ++ package)+    barthread <- forkIO $ updateBar progbar+    -- show stdout buffer.+    ebuf <- textViewGetBuffer pkgview+    forkIO $ showEmergeBuffer Emerge out pkgview ebuf+    -- show stderr buffer.+    forkIO $ showEmergeBuffer Emerge err pkgview ebuf+    -- Connect signal to the stop-process and close-tab buttons.+    stopbutton `onClicked`+	       (do+		exitcode <- getProcessExitCode ph+		case exitcode of+		   Nothing -> popSelectWindow ("Stop " ++ (msgs !! 1) ++ " " ++ package)+		                        (terminateProcess ph)+		   Just _ -> popInfoWindow "This process is already stopped.")+    closebutton `onClicked`+		    (do+		     exitcode <- getProcessExitCode ph+		     case exitcode of+	                Nothing -> popWarningWindow "The process is still running.\n\+						    \Stop this process first and then close the tab."+	                Just _ -> do+		                  (Just text) <- notebookGetMenuLabelText panel pkgscroll+		                  popSelectWindow ("Do you really want to close [" ++ text ++ "]?")+                 		         (tooltipsEnable tooltips >> closeTab panel pkgscroll))+    -- Test for process termination.+    forkIO $ onExit ph ((.) ((>>) (killThread statid)) (handleExitCode barthread))+    -- Avoid individual tooltips to be GC'ed.+    return ()+	where+	handleExitCode thread exitcode =+	    killThread thread >>+	    case exitcode of+	      ExitSuccess -> do+			     progressBarSetFraction progbar 1.0 +			     listStoreSetValue st pkgiter 0 (GVstring $ Just (setQueueColor "purple" (msgs !! 2)))+			     listStoreSetValue st pkgiter 4 (GVstring $ Just "lightgreen")+			     scrollViewToCell st pkgiter tv+			     let rlog = (package ++ " => " ++ (msgs !! 2) ++ " successfully.") +			     writeLog logview rlog+			     emerge msgs panel logview statbar progbar rlog (tv, st, ps)+	      ExitFailure 115 -> do+				 listStoreSetValue st pkgiter 0 (GVstring $ Just (setQueueColor "blue" "Stopped"))+				 listStoreSetValue st pkgiter 4 (GVstring $ Just "red")+				 scrollViewToCell st pkgiter tv+				 let rlog =  ((msgs !! 1) ++ " " ++ package ++ " stopped.")+				 writeLog logview rlog+				 updateStatBar statbar rlog+				 progressBarSetFraction progbar 0.0+	      ExitFailure _ -> do +			       listStoreSetValue st pkgiter 0 (GVstring $ Just (setQueueColor "black" (msgs !! 3)))+			       listStoreSetValue st pkgiter 4 (GVstring $ Just "red")+			       scrollViewToCell st pkgiter tv+			       let rlog = ((msgs !! 3) ++ " " ++ package ++ ".")+			       popErrorWindow rlog+			       writeLog logview rlog+			       updateStatBar statbar rlog+			       progressBarSetFraction progbar 0.0++packagesToEmerge :: ListStore -> IO (ListStore, [(String, TreeIter)])+packagesToEmerge st = collectIters st 0 >>= mapM f >>= return . (,) st+	where f i = do+		    (GVstring (Just pkgatom)) <- treeModelGetValue st i 3+		    return $ (takeWhile (/= ' ') pkgatom, i)++{- | Emerge functions. -}+emergePackages, unmergePackages, fetchPackages+    :: Notebook -> TextView -> Statusbar -> ProgressBar -> IO ()+binaryPackages, useBinaryPackages+    :: Notebook -> TextView -> Statusbar -> ProgressBar -> IO ()++emergeOperation :: Notebook -> TextView -> Statusbar +		-> ProgressBar -> [String] -> IO ()+emergeOperation panel logview statbar progbar info =+    isCurrentPagePackagePanel panel+       (\ pkgtv -> getStoreFromView pkgtv >>= packagesToEmerge >>=+	\ (st, xs) -> emerge info panel logview statbar progbar [] (pkgtv, st, xs))++emergePackages panel logview statbar progbar =+    emergeOperation panel logview statbar progbar+       [emergepath, "Installing", "Installed", "Error installing"]++unmergePackages panel logview statbar progbar =+    emergeOperation panel logview statbar progbar+       [emergepath ++ " --unmerge" , "Uninstalling", "Uninstalled", "Error uninstalling"]+	+fetchPackages panel logview statbar progbar =+    emergeOperation panel logview statbar progbar+       [emergepath ++ " --nodeps --fetchonly", "Fetching", "Fetched", "Error fetching"]++binaryPackages panel logview statbar progbar =+    emergeOperation panel logview statbar progbar+       [emergepath ++ " --buildpkg", "Installing (building binary package too)"+       , "Installed", "Error installing"]++useBinaryPackages panel logview statbar progbar =+    emergeOperation panel logview statbar progbar+       [emergepath ++ " --usepkg", "Installing (using binary package if available)"+       , "Installed", "Error installing"]

@@ -0,0 +1,259 @@+{-+    Himerge: A simple Haskell GUI front-end for Portage.+    This is the module implementing the entry functions+    for hte program.+    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+-}++module Main (Main.main) +    where++import Browser+import Menus+import Components+import Emerge+import UseFlag+import Util+import Graphics.UI.Gtk+import System.IO+import Control.Concurrent+import System.Directory (doesDirectoryExist)+import Graphics.UI.Gtk.MozEmbed +    (MozEmbed, mozEmbedLoadUrl)++main :: IO ()+main = mainBrowser portageroot++mainBrowser :: FilePath -> IO ()+mainBrowser portagerepo =+    do+    initGUI+    timeoutAddFull (yield >> return True) priorityDefaultIdle 50+    -- Check for valid repository path.+    b <- doesDirectoryExist portagerepo+    if not b +       then popErrorWindow "Repository doesn't exist."+       else do+       mainwindow <- windowNew+       onDestroy mainwindow mainQuit+       vbox <- vBoxNew False 0+       -- portage browser.+       (browser, infopanel, logview, statbar, progbar, mozwindow, tooltips)+	   <- portageBrowser portagerepo+       -- menu bar.+       menubar <- menu mainwindow infopanel logview mozwindow statbar progbar+       -- build main widget.+       boxPackStart vbox menubar PackNatural 0+       boxPackStart vbox browser PackGrow 0+       -- main widget.+       set mainwindow [ windowTitle := "Himerge"+		      , windowDefaultWidth := 930+		      , windowDefaultHeight := 730+		      , containerChild := vbox+		      , containerBorderWidth := 5 ]+       widgetShowAll mainwindow+       let delmsg = "Are you sure you want to close this Himerge window?"+       mainwindow `onDelete`+		  (\ _ -> popSelectWindow delmsg (widgetDestroy mainwindow) >>+		   return True)+       mainwindow `onKeyPress` acceOpenNew+       mainwindow `onKeyPress` acceOpenNewRepo+       mainwindow `onKeyPress` acceUseFlag+       mainwindow `onKeyPress` acceSaveCurrentPage infopanel+       mainwindow `onKeyPress` acceSaveAllPages infopanel+       mainwindow `onKeyPress` accePackagesBranch+       mainwindow `onKeyPress` acceUpdateEix infopanel logview statbar progbar+       mainwindow `onKeyPress` accePortageInfo infopanel logview statbar progbar+       mainwindow `onKeyPress` acceMetadata infopanel logview statbar progbar+       mainwindow `onKeyPress` acceHelp mozwindow+       mainGUI+       -- Enable tooltips.+       -- Call this function at this point to avoid GC.+       tooltipsEnable tooltips+		      +uiLabel :: String+uiLabel =+  "<ui>\+  \  <menubar>\+  \    <menu name=\"File\" action=\"FileAction\">\+  \      <menuitem name=\"New\" action=\"NewAction\" />\+  \      <menuitem name=\"New Repo\" action=\"NewRepoAction\" />\+  \      <separator/>\+  \      <menuitem name=\"Save Current Page\" action=\"SaveCurrentPageAction\" />\+  \      <menuitem name=\"Save All Pages\" action=\"SaveAllPagesAction\" />\+  \      <separator/>\+  \      <menuitem name=\"Exit\" action=\"ExitAction\"/>\+  \      <placeholder name=\"FileMenuAdditions\" />\+  \    </menu>\+  \    <menu name=\"Edit\" action=\"EditAction\">\+  \      <menuitem name=\"Packages Branch\" action=\"PackagesBranch\"/>\+  \      <menuitem name=\"Use Flags\" action=\"UseFlagAction\"/>\+  \    </menu>\+  \    <menu name=\"Tools\" action=\"ToolsAction\">\+  \      <menuitem name=\"Update Eix\" action=\"UpdateEixAction\"/>\+  \      <menuitem name=\"Info\" action=\"InfoAction\"/>\+  \      <menuitem name=\"Metadata\" action=\"MetadataAction\"/>\+  \    </menu>\+  \    <menu name=\"Help\" action=\"HelpAction\">\+  \      <menuitem name=\"Help\" action=\"HelpDocAction\"/>\+  \      <menuitem name=\"About himerge\" action=\"AboutAction\"/>\+  \    </menu>\+  \  </menubar>\+  \</ui>"++menu :: Window -> Notebook -> TextView -> MozEmbed +     -> Statusbar -> ProgressBar -> IO Widget+menu window panel logview mozwindow statbar progbar = +    do+    -- Create the menus.+    fileAct <- actionNew "FileAction" "File" Nothing Nothing+    editAct <- actionNew "EditAction" "Edit" Nothing Nothing+    toolsAct <- actionNew "ToolsAction" "Tools" Nothing Nothing+    helpAct <- actionNew "HelpAction" "Help" Nothing Nothing+    -- Create menu items.+    -- File items.+    newAct <- actionNew "NewAction" "New"+	      (Just "Clear the spreadsheet area.") (Just stockNew)+    newAct `onActionActivate` main+    newRepoAct <- actionNew "NewRepoAction" "New Repo"+		  (Just "Change portage repository.") (Just stockNew)+    newRepoAct `onActionActivate` openRepository+    saveCurrentPageAct <- actionNew "SaveCurrentPageAction" "Save Current Page"+			  (Just "Save current page contents.") (Just stockSaveAs)+    saveCurrentPageAct `onActionActivate` savePage (pageContents panel)+    saveAllPagesAct <- actionNew "SaveAllPagesAction" "Save All Pages"+		       (Just "Save all the panel pages.") (Just stockSaveAs)+    saveAllPagesAct `onActionActivate` savePage (allPages panel)+    exitAct <- actionNew "ExitAction" "Exit" (Just "Exit this application.") +	       (Just stockSaveAs)+    exitAct `onActionActivate` widgetDestroy window+    -- Edit items.+    packagesBranchAct <- actionNew "PackagesBranch" "Packages Branch"+			 (Just "Show branch information.") (Just stockProperties)+    packagesBranchAct `onActionActivate` packageBranch+    useFlagsAct <- actionNew "UseFlagAction" "Use Flag Editor"+		   (Just "Edit use flags.") (Just stockProperties)+    useFlagsAct `onActionActivate` (forkIO globalUseFlags >> return ())+    -- Tools items.+    updateEixAct <- actionNew "UpdateEixAction" "Update Eix"+		    (Just "Update the eix package database.") (Just stockExecute)+    updateEixAct `onActionActivate` updateEix panel logview statbar progbar+    infoAct <- actionNew "InfoAction" "Portage Info"+	       (Just "Show portage information.") (Just stockExecute)+    infoAct `onActionActivate` emergeInfo panel logview statbar progbar+    metadataAct <- actionNew "MetadataAction" "Metadata"+		   (Just "Regenerate portage metadata.") (Just stockExecute)+    metadataAct `onActionActivate` emergeMetadata panel logview statbar progbar+    -- Help items.+    docAct <- actionNew "HelpDocAction" "Help" (Just "Help Documentation") (Just stockHelp)+    docAct `onActionActivate` mozEmbedLoadUrl mozwindow hdoc+    aboutAct <- actionNew "AboutAction" "About Himerge" (Just "About this tool.") (Just stockAbout)+    aboutAct `onActionActivate` aboutHimerge+    -- Add accelerators.+    standardGroup <- actionGroupNew "standard"+    mapM_ (actionGroupAddAction standardGroup) [fileAct, editAct, toolsAct, helpAct]+    mapM_ (\ act -> actionGroupAddActionWithAccel standardGroup act Nothing)+	      [ newAct, exitAct, docAct, aboutAct ]+    mapM_ (\ (act, acc) -> actionGroupAddActionWithAccel standardGroup act acc)+              [ (newRepoAct, (Just "<Control>r"))+	      , (useFlagsAct, (Just "<Control>f"))+	      , (updateEixAct, (Just "<Control>u"))+	      , (metadataAct, (Just "<Control>m"))+	      , (infoAct, (Just "<Control>i"))+	      , (packagesBranchAct, (Just "<Control>b"))+	      , (saveCurrentPageAct, (Just "<Control>s"))+	      , (saveAllPagesAct, (Just "<Control>a")) ]+    ui <- uiManagerNew+    uiManagerAddUiFromString ui uiLabel+    uiManagerInsertActionGroup ui standardGroup 0+    (Just menuBar) <- uiManagerGetWidget ui "/ui/menubar"+    return menuBar++{- | Accelerators code starts from here. -}+acceOpenNew, acceOpenNewRepo :: Event -> IO Bool+acceSaveCurrentPage, acceSaveAllPages+    :: Notebook -> Event -> IO Bool+acceUseFlag, accePackagesBranch :: Event -> IO Bool+acceUpdateEix, accePortageInfo, acceMetadata +    :: Notebook -> TextView -> Statusbar -> ProgressBar -> Event -> IO Bool++acceHelp :: MozEmbed -> Event -> IO Bool+acceHelp mozw (Key { eventModifier = [Control], eventKeyName = "h" }) = +    mozEmbedLoadUrl mozw hdoc >> return True+acceHelp _ _ = return False++acceOpenNew (Key { eventModifier = [Control], eventKeyName = "n" }) = +    main >> return True+acceOpenNew _ = return False++acceOpenNewRepo (Key { eventModifier = [Control], eventKeyName = "r" }) =+   openRepository >> return True+acceOpenNewRepo _ = return False++acceSaveCurrentPage panel (Key { eventModifier = [Control], eventKeyName = "s" }) =+   savePage (pageContents panel) >> return True+acceSaveCurrentPage _ _ = return False++acceSaveAllPages panel (Key { eventModifier = [Control], eventKeyName = "a" }) = +   forkIO (savePage (allPages panel)) >> return True+acceSaveAllPages _ _ = return False++acceUpdateEix panel logview statbar progbar (Key { eventModifier = [Control]+						 , eventKeyName = "u" }) =+        updateEix panel logview statbar progbar >> return True+acceUpdateEix _ _ _ _ _ = return False++accePortageInfo panel logview statbar progbar (Key { eventModifier = [Control]+						   , eventKeyName = "i" }) =+	 emergeInfo panel logview statbar progbar >> return True+accePortageInfo _ _ _ _ _ = return False++acceMetadata panel logview statbar progbar (Key { eventModifier = [Control]+						, eventKeyName = "m" }) = +	 emergeMetadata panel logview statbar progbar >> return True+acceMetadata _ _ _ _ _ = return False++acceUseFlag (Key { eventModifier = [Control], eventKeyName = "f" }) = +    forkIO globalUseFlags >> return True+acceUseFlag _ = return False++accePackagesBranch (Key { eventModifier = [Control], eventKeyName = "b" }) = +    packageBranch >> return True+accePackagesBranch _ = return False++openRepository :: IO ()+{- | Open Repository dialog chooser. -}+openRepository = getChooser openCRepository fileChooserGetCurrentFolder+		            mainBrowser++openCRepository :: IO FileChooserDialog+openCRepository = fileChooserDialogNew (Just "himerge") Nothing+		 FileChooserActionSelectFolder+		 [("Ok", ResponseOk), ("Cancel", ResponseCancel)]++savePage :: (FilePath -> IO ()) -> IO ()+{- | Open Save File dialog chooser. -}+savePage = getChooser saveCPage fileChooserGetFilename++saveCPage :: IO FileChooserDialog+saveCPage =+    do+    fc <- fileChooserDialogNew (Just "himerge") Nothing FileChooserActionSave+           [("Save", ResponseOk), ("Cancel", ResponseCancel)]+    fileChooserSetDoOverwriteConfirmation fc True+    fileChooserSetCurrentName fc "Untitled Document"+    return fc

@@ -0,0 +1,439 @@+{-+    Code implementing menus windows and operations related to them.+    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+-}++module Menus+    where++import Util+import UseFlag+import Graphics.UI.Gtk+import System.Directory+import qualified Control.Exception as E+import System.IO+import Control.Monad (liftM2)+import Data.List (nub, sort)++{- | File Chooser code. -}++getChooser :: (IO FileChooserDialog) -> (FileChooserDialog -> IO (Maybe String))+	   -> (FilePath -> IO ()) -> IO () +{- | Run specific dialog choosers. (Save pages and Open new repo) -}+getChooser dialog fctype okfunc =+    do+    dialog >>= \ fc ->+	fc `onResponse` (fun fc) >>+	widgetShowAll fc+    where+    fun fc ResponseOk =+        do+        file <- fctype fc+        case file of+           Nothing -> popErrorWindow "No valid file."+           Just filename -> widgetDestroy fc >> okfunc filename+    fun fc _ = widgetDestroy fc++{- | Save pages functions. These functions work together+   with the filechooser functions. -}++allPages :: Notebook -> FilePath -> IO ()+allPages = (\ p s -> mapPanelPages p >>= allPageContents p+	    >>= writeFile s . unlines)++pageContents :: Notebook -> FilePath -> IO ()+pageContents panel filename =+    do+    num <- notebookGetCurrentPage panel+    Just widgetpage <- notebookGetNthPage panel num+    stringFromPage panel widgetpage >>= writeFile filename++storeModelValuesToString :: TreeModel -> IO String+storeModelValuesToString store = f 0 store >>= return . unlines+    where+    f index store' = +	do+	maybeiter <- treeModelGetIter store' [index]+	case maybeiter of+	  Nothing -> return []+	  Just iter -> do +		(GVstring (Just value)) <- treeModelGetValue store' iter 3+		rvalue <- f (index + 1) store'+		return (value : rvalue)++allPageContents :: Notebook -> [Widget] -> IO [String]+allPageContents = f+    where+    f _ [] = return []+    f notebook (page:pagexs) = +	do+	xs <- stringFromPage notebook page+	rxs <- f notebook pagexs+	return (xs:rxs)++stringFromPage :: Notebook -> Widget -> IO String+stringFromPage notebook page =+    do+    scrollw <- return $ castToScrolledWindow page+    text <- notebookGetMenuLabelText notebook scrollw+    (Just c) <- binGetChild scrollw+    case text of+       Nothing -> error "stringFromPage: how this happened?!"+       (Just text') -> do+	               if parse text'+		        then do+			     (Just store) <- treeViewGetModel (castToTreeView c)+			     storeModelValuesToString store+			else do+			     textb <- textViewGetBuffer (castToTextView c)+			     startiter <- textBufferGetStartIter textb+			     enditer <- textBufferGetEndIter textb+			     textBufferGetText textb startiter enditer True+    where+    parse = liftM2 (||) ("Queue:" ==) ("Main" ==) . (!! 0) . words++mapPanelPages :: Notebook -> IO [Widget]+mapPanelPages = f 0+    where +    f num panel =+	do+	maybewidget <- notebookGetNthPage panel num+	case maybewidget of+	  Nothing -> return []+	  Just sp -> do+		     rpage <- f (num + 1) panel+		     return (sp : rpage)++chooseIfDirectoryList :: [FilePath] -> [FilePath]+		      -> ([FilePath] -> IO ()) -> IO ()+{- Open fileChoosers for /etc/portage directories. +   Use the respective files otherwise. -}+chooseIfDirectoryList [] tmpfiles applyfunc = applyfunc tmpfiles+chooseIfDirectoryList (pfile:pxs) tmpfiles applyfunc =+    do+    b <- doesDirectoryExist pfile+    case b of+      True -> do+	      fc <- fileChooserDialogNew (Just pfile) Nothing+		    FileChooserActionOpen+		    [("Ok", ResponseOk), ("Cancel", ResponseCancel)]+	      fileChooserSetCurrentFolder fc pfile+	      fc `onResponse` (fun fc)+	      widgetShowAll fc+		  where+		  fun fc ResponseOk =+		      do+		      file <- fileChooserGetFilename fc+		      case file of+			 Nothing -> widgetDestroy fc >> popErrorWindow "No valid file."+			 Just filename -> widgetDestroy fc >> +					  chooseIfDirectoryList pxs (filename : tmpfiles) applyfunc+		  fun fc _ = widgetDestroy fc+      False -> chooseIfDirectoryList pxs (pfile : tmpfiles) applyfunc++{- | Code for windows showing different menus.+   pop-up menu for packages versions and the package branch editor.-}++packagePopupMenu :: FilePath -> TreeView -> Statusbar -> Event -> IO Bool+{- | Package versions popup menu. -}+packagePopupMenu prepo tv statbar event@(Button { eventClick = ReleaseClick+						, eventButton = RightButton }) = +               getPackage prepo tv >>= flip packageMenuItems statbar >>= +	       flip menuPopup (Just (eventButton event, eventTime event)) >> return True+packagePopupMenu _ _ _ _ = return False++packageMenuItems :: (String, String, String, String) -> Statusbar -> IO Menu+packageMenuItems (ebuildpath, catpkg, pkg, key) statbar =+    do+    pkgmenu <- menuNew+    -- adding package to files.+    keywordall <- imageMenuItemNewWithLabel ("keyword all " ++ catpkg)+    addallicon1 <- imageNewFromFile (iconpath ++ "small-add.png")+    imageMenuItemSetImage keywordall addallicon1++    keyword <- imageMenuItemNewWithLabel ("keyword " ++ pkg)+    addicon1 <- imageNewFromFile (iconpath ++ "small-add.png")+    imageMenuItemSetImage keyword addicon1++    maskall <- imageMenuItemNewWithLabel ("mask all " ++ catpkg)+    addallicon2 <- imageNewFromFile (iconpath ++ "small-add.png")+    imageMenuItemSetImage maskall addallicon2++    mask <- imageMenuItemNewWithLabel ("mask " ++ pkg)+    addicon2 <- imageNewFromFile (iconpath ++ "small-add.png")+    imageMenuItemSetImage mask addicon2++    unmaskall <- imageMenuItemNewWithLabel ("unmask all " ++ catpkg)+    addallicon3 <- imageNewFromFile (iconpath ++ "small-add.png")+    imageMenuItemSetImage unmaskall addallicon3++    unmask <- imageMenuItemNewWithLabel ("unmask " ++ pkg)+    addicon3 <- imageNewFromFile (iconpath ++ "small-add.png")+    imageMenuItemSetImage unmask addicon3+    -- removing package from files.+    rmkeywordall <- imageMenuItemNewWithLabel ("remove keyword all " ++ catpkg)+    removeallicon1 <- imageNewFromFile (iconpath ++ "small-remove.png")+    imageMenuItemSetImage rmkeywordall removeallicon1++    rmkeyword <- imageMenuItemNewWithLabel ("remove keyword " ++ pkg)+    removeicon1 <- imageNewFromFile (iconpath ++ "small-remove.png")+    imageMenuItemSetImage rmkeyword removeicon1++    rmmaskall <- imageMenuItemNewWithLabel ("remove mask all " ++ catpkg)+    removeallicon2 <- imageNewFromFile (iconpath ++ "small-remove.png")+    imageMenuItemSetImage rmmaskall removeallicon2++    rmmask <- imageMenuItemNewWithLabel ("remove mask " ++ pkg)+    removeicon2 <- imageNewFromFile (iconpath ++ "small-remove.png")+    imageMenuItemSetImage rmmask removeicon2++    rmunmaskall <- imageMenuItemNewWithLabel ("remove unmask all " ++ pkg)+    removeallicon3 <- imageNewFromFile (iconpath ++ "small-remove.png")+    imageMenuItemSetImage rmunmaskall removeallicon3++    rmunmask <- imageMenuItemNewWithLabel ("remove keyword " ++ pkg)+    removeicon3 <- imageNewFromFile (iconpath ++ "small-remove.png")+    imageMenuItemSetImage rmunmask removeicon3+    -- Add package use.+    usepkg <- imageMenuItemNewWithLabel ("use package " ++ pkg)+    addicon4 <- imageNewFromFile (iconpath ++ "small-add.png")+    imageMenuItemSetImage usepkg addicon4++    -- Add items to the menu binding to their respectives operations.+    menuShellAppend pkgmenu usepkg+    usepkg `onActivateLeaf` +	   do +	   allflags <- allUseFlags+	   ebuildc <- readFile ebuildpath+	   -- Strip '=' from =cat/pkgname (tail key).+	   -- Find the matched flags between the USE flags and IUSE of a package.    +	   flagsfound <- return $ map (findIUSEonUSEFlags key allflags) +			              (words $ findAtom ebuildc "IUSE")+	   -- Open the use flag editor for this package version.+	   pkgUseFlags key $ concat flagsfound+    -- Add and connect to the respectives operations each of the+    -- menu items.+    menuShellAppend pkgmenu keywordall+    keywordall `onActivateLeaf` +	    chooseIfDirectoryList [packagekeywords] [] +				      (\ (file:_) -> addPackageFor file catpkg >>+				       updateStatBar statbar (catpkg ++ " keyworded."))+    menuShellAppend pkgmenu keyword+    keyword `onActivateLeaf` +	    chooseIfDirectoryList [packagekeywords] [] +				      (\ (file:_) -> addPackageFor file key >>+				       updateStatBar statbar (key ++ " keyworded."))++    menuShellAppend pkgmenu maskall+    maskall `onActivateLeaf`+	 chooseIfDirectoryList [packagemask] []+				   (\ (file:_) -> addPackageFor file catpkg >>+				    updateStatBar statbar (catpkg ++ " masked."))+    menuShellAppend pkgmenu mask+    mask `onActivateLeaf`+	 chooseIfDirectoryList [packagemask] []+				   (\ (file:_) -> addPackageFor file key >>+				    updateStatBar statbar (key ++ " masked."))++    menuShellAppend pkgmenu unmaskall+    unmaskall `onActivateLeaf`+	   chooseIfDirectoryList [packageunmask] []+				     (\ (file:_) -> addPackageFor file catpkg >>+				      updateStatBar statbar (catpkg ++ " unmasked."))+    menuShellAppend pkgmenu unmask+    unmask `onActivateLeaf`+	   chooseIfDirectoryList [packageunmask] []+				     (\ (file:_) -> addPackageFor file key >>+				      updateStatBar statbar (key ++ " unmasked."))++    menuShellAppend pkgmenu rmkeywordall+    rmkeywordall `onActivateLeaf` +	      chooseIfDirectoryList [packagekeywords] []+					(\ (file:_) -> removePackageFrom file catpkg >>+					 updateStatBar statbar (catpkg ++ " removed keyworded."))+    menuShellAppend pkgmenu rmkeyword+    rmkeyword `onActivateLeaf` +	      chooseIfDirectoryList [packagekeywords] []+					(\ (file:_) -> removePackageFrom file key >>+					 updateStatBar statbar (key ++ " removed keyworded."))++    menuShellAppend pkgmenu rmmaskall+    rmmaskall `onActivateLeaf` +	   chooseIfDirectoryList [packagemask] [] +				     (\ (file:_) -> removePackageFrom file catpkg >>+				      updateStatBar statbar (catpkg ++ " removed mask."))+    menuShellAppend pkgmenu rmmask+    rmmask `onActivateLeaf` +	   chooseIfDirectoryList [packagemask] [] +				     (\ (file:_) -> removePackageFrom file key >>+				      updateStatBar statbar (key ++ " removed mask."))++    menuShellAppend pkgmenu rmunmaskall+    rmunmaskall `onActivateLeaf` +	     chooseIfDirectoryList [packageunmask] [] +				       (\ (file:_) -> removePackageFrom file catpkg >>+					updateStatBar statbar (catpkg ++ " removed unmask."))+    menuShellAppend pkgmenu rmunmask+    rmunmask `onActivateLeaf` +	     chooseIfDirectoryList [packageunmask] [] +				       (\ (file:_) -> removePackageFrom file key >>+					updateStatBar statbar (key ++ " removed unmask."))+    -- Show menu.+    widgetShowAll pkgmenu+    return pkgmenu++findIUSEonUSEFlags :: String -> [String] -> String -> [String]+{- This function finds the IUSE flags located either in the+   local use flags and the global use flags list (all flags).+   It tests for local use flags of the form: category/package:use - desc. ;+   and matches against (category/package == catpkgname) and (use == iuse) to find+   the correct local use flags of a package in the list of all flags. -}+findIUSEonUSEFlags catpkgname flags iuseflag =+    filter (not . null) $ map f flags+	where+	f flag = let (h, t) = break (== ':') $ takeWhile (/= ' ') flag+		     in+		     case t of+		        [] -> if h == iuseflag then flag else []+			(_:t') -> if (findSubstring h catpkgname)+				     then (if t' == iuseflag +					      then (tail $ dropWhile (/= ':') flag)+					      else []) +				     else []++addPackageFor, removePackageFrom :: FilePath -> String -> IO ()+addPackageFor = packageFile (\ k -> (k :))+removePackageFrom = packageFile (\ k -> filter (/= k))++packageFile :: (String -> ([String] -> [String]))+	    -> FilePath -> String -> IO ()+packageFile func = f+    where+    f path key = do+	let writehandle wfileh = hPutStr wfileh . unlines . sort . nub . func key+	createDirectoryIfMissing True etcpackage+	fb <- doesFileExist path+	list <- case fb of+		  True -> (do+			   rfileh <- openFile path ReadMode+			   str <- (hGetContents rfileh >>= E.evaluate)+			   hClose rfileh+			   return $ map strip $ lines str)+				     `E.catch`+				           (\ e -> (popErrorWindow $ show e) >> +					    return [])+		  False -> return []+	(do+	 w <- openFile path WriteMode+	 writehandle w list+	 hClose w)+		 `E.catch`+		    (\ e -> popErrorWindow $ show e)++{- | Start code for the package branch editor window. -}+packageBranch :: IO ()+packageBranch = +    chooseIfDirectoryList [ packageuse, packageunmask+			  , packagemask, packagekeywords ] [] showBranch++branchStore :: [FilePath] -> IO [(TreeView, ScrolledWindow, CellRendererText)]+branchStore =+    mapM (\ file -> do+	  contents <- readFileIfExist file+	  createStore file SelectionMultiple True+	     (Just (packageicon, skipBCLines $ lines contents)))+	where+	skipBCLines = filter f+	f [] = False+	f ('#':_) = False+	f _ = True++showBranch :: [FilePath] -> IO ()+{- | Package Branch Window. -}+showBranch [keywordsfile, maskfile, unmaskfile, usefile] =+    do+    window <- windowNew+    panel <- notebookNew+    notebookSetScrollable panel True+    notebookSetPopup panel True+    vbox <- vBoxNew False 9+    [(keyview, keyscroll, keycell), (maskview, maskscroll, maskcell)+      , (unmaskview, unmaskscroll, unmaskcell), (useview, usescroll, usecell)]+        <- branchStore [keywordsfile, maskfile+		       , unmaskfile, usefile]+    -- Add a logo.+    image <- imageNewFromFile windowlogo+    boxPackStart vbox image PackNatural 0+    -- Add a horizontal separator.+    notebookAppendPage panel keyscroll "Package Keywords"+    notebookAppendPage panel maskscroll "Package Mask"+    notebookAppendPage panel unmaskscroll "Package Unmask"+    notebookAppendPage panel usescroll "Package Use"+    -- Add the package branch panel into a frame.+    branchframe <- makeFrame "Package Brach" 0.50 0.50+    containerSetBorderWidth panel 9+    containerAdd branchframe panel+    -- Add the branch frame into the vbox.+    boxPackStart vbox branchframe PackGrow 0+    -- Add a horizontal separator+    buttonbox <- hBoxNew False 0+    removebutton <- buttonNewFromStock stockRemove+    savebutton <- buttonNewFromStock stockSave+    quitbutton <- buttonNewFromStock stockClose +    boxPackStart buttonbox removebutton PackNatural 0+    boxPackStart buttonbox savebutton PackNatural 0 +    boxPackStart buttonbox quitbutton PackNatural 0+    boxPackStart vbox buttonbox PackNatural 0 +    removebutton `onClicked` +		 do+		 c <- notebookGetCurrentPage panel+		 case c of+                   0 -> removeElement keyview+		   1 -> removeElement maskview+		   2 -> removeElement unmaskview+		   3 -> removeElement useview+		   _ -> popErrorWindow "Components.hs - error: weird, how this happened?"+    let list = [ (keyview, keywordsfile), (maskview, maskfile)+	       , (unmaskview, unmaskfile), (useview, usefile) ]+    savebutton `onClicked`+	       popSelectWindow "Do you want to save this packages setup?"+	                       (mapM_ (\ (view, file) -> do+				       store <- getStoreFromView view+				       str <- collectIters store 0 >>= collectStringValues store textColumn+				       writeFileIfExist file $ unlines str) list)+    quitbutton `onClicked` widgetDestroy window+    -- The cells of this treeview are editable.+    keystore <- getStoreFromView keyview+    usestore <- getStoreFromView useview+    maskstore <- getStoreFromView maskview+    unmaskstore <- getStoreFromView unmaskview+    -- Update the tree store contents after edited.+    afterEdited keycell keystore (editOn $ castToListStore keystore)+    afterEdited usecell usestore (editOn $ castToListStore usestore)+    afterEdited maskcell maskstore (editOn $ castToListStore maskstore)+    afterEdited unmaskcell unmaskstore (editOn $ castToListStore unmaskstore)+    set window [ windowTitle := "Himerge Package Branch"+	       , windowDefaultWidth := 600+	       , windowDefaultHeight := 500+	       , containerChild := vbox+	       , containerBorderWidth := 5 ]+    widgetShowAll window+	where+	editOn store = +	    \ iter str ->+		listStoreSetValue store iter textColumn (GVstring $ Just str)+showBranch _ = error "showBranch: How in the world did this happen?"

@@ -0,0 +1,81 @@+{-+    Functions to parse and render the HTML/CSS code.+    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+-}++module Render (render, htmltemp)+    where++import Util+import Data.Char+    (isSpace)++csstemplate, htmltemp :: FilePath+csstemplate = "/usr/share/doc/himerge-" ++ hversion ++ "/himerge.css"+htmltemp = "hweb.html"++render :: String -> String+render = html . concatMap body . splitPackages+	 . lines . cleanOutput++html :: String -> String+html contents = "<html>\n<head>\n" +		++ "<link title=\"new\" rel=\"stylesheet\" \+		   \ href=\"" ++ csstemplate ++ "\" type=\"text/css\">"+		++ "</head>\n<body>"+		++ contents ++ "\n<hr><center><a href=\"//http://www.haskell.org/himerge\">himerge</a>\n</body>\n</html>"++body :: [String] -> String+body [] = []+body (('*':' ':xs):xss) = "<p class=\"newshead\" lang=\"en\"><b>" +			  ++ xs ++ "</b></p>\n<ul>" +			  ++ makeMenu xss+body ((y@('[':_)):xss) = "overlay: " ++ y ++ "<br>" ++ makeMenu xss+body (_:xss) = body xss++makeMenu :: [String] -> String+makeMenu xs@(('[':_):_) = body xs -- check for overlays.+makeMenu ys = concatMap menu ys ++ "</ul>"+    where+    menu xs = let (label, value) = (break (== ':') xs) +		  in+		  if null value+		     then label+		     else "<li><strong>" ++ label ++ "</strong> => " +			  ++ searchValues (tail value) ++ "</li>\n"++splitPackages :: [String] -> [[String]]+splitPackages listp = let (pkg, pkgs) = break (null . words) listp+			  in+			  case pkgs of+			    [] -> [pkg]+			    (_:rst) -> pkg : splitPackages rst++searchValues :: String -> String+{- | Highlight the package link.+   Add '//' to the link name to avoid accesing the page+   from the mozembed. -}+searchValues = makelink . dropWhile isSpace +    where+    makelink xss@('h':'t':'t':'p':':':'/':'/':_) = weblink xss+    makelink xss@('h':'t':'t':'p':'s':':':'/':'/':_) = weblink xss+    makelink xss@('f':'t':'p':':':'/':'/':_) = weblink xss+    makelink xss@('f':'t':'p':'s':':':'/':'/':_) = weblink xss+    makelink xs = xs++weblink :: String -> String+weblink link = "<a href=\"//" ++ link ++ "\">" ++ link ++ "</a>"

@@ -0,0 +1,292 @@+{-+    Functions to work around the USE flags.+    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+-}++module UseFlag where++import Graphics.UI.Gtk+import Util+import Data.List (sort, nub)+import Data.Char (isSpace)++type Variable = String+type Value = String+type AddType = String -> [RadioFlag] -> [EnvValues] -> IO String++data UseFlag = UseFlag String String+data RadioFlag = Radio String [RadioButton]+data EnvValues = EnvValue Variable Value | Comment String+	       deriving Show++instance Eq UseFlag where+    UseFlag use _ == UseFlag use' _ = use == use'++useflagpath, localuseflagpath :: FilePath+useflaglabel :: String+useflagpath = "/usr/portage/profiles/use.desc"+localuseflagpath = "/usr/portage/profiles/use.local.desc"+useflaglabel = "Use Flags Enabled/Disabled:\n"++allUseFlags :: IO [String]+allUseFlags = +    do+    flags <- readGlobalFlagFile useflagpath+    localflags <- readLocalFlagFile localuseflagpath+    return (flags ++ localflags)++globalUseFlags :: IO () +globalUseFlags = allUseFlags >>= +		 mapM (return . parseLocalUSE) >>=+		 useFlag makeconfpath addAtConf "USE"++parseLocalUSE :: String -> String+{- Test for local use flags and parse from <cat/pkg>:<use> <desc> to +   <use> <desc>. -}+parseLocalUSE use = +    let (_, t) = break (== ':') $ takeWhile (/= ' ') use+	in+	case t of+	   [] -> use+	   _ -> tail $ dropWhile(/= ':') use++pkgUseFlags :: String -> [String] -> IO ()+pkgUseFlags = useFlag packageuse addAtPkgUse++useFlag :: FilePath -> AddType +	-> (String -> [String] -> IO ())+{- | Setup the USE flag window with the variable information. -}+useFlag usefile addfunc = usef+    where+    usef token [] =+	popSelectWindow msg (allUseFlags >>= useFlag usefile addfunc token)+	    where+	    msg = "No ebuild use flag information.\nOpen the global use\+		  \ flag editor for this package?."+    usef token useflags =+	do+	(window, label, vbox, textvuf, savebutton, quitbutton)+	    <- useFlagsWindow+	-- take a list of useflags into one of radio buttons.+	radiolist <- takeFlagsToRadio vbox useflags+        -- Read the make.conf or package.use flag, depending+	-- if we are using the global use flag editor or the+	-- package specific use flag editor.+	b <- readFileIfExist usefile+	case b of+          [] -> popErrorWindow (usefile ++ " error reading file.")+	  xs -> do+	       let char = (if token == "USE" then '=' else ' ')+	       -- Parse the configuration files.+               let usefileparsed = parseConf $ map (dropWhile isSpace) $ lines xs+	       envvalues <- mkEnvValues char usefileparsed+	       updateTextBuffer textvuf $ getcurrentflags envvalues+	       -- activate use flags.+	       mapM_ (activateUseFlags token (words $ getEnvValue token envvalues)) radiolist+	       labelSetMarkup label ("<i>Listing " ++ (show (length radiolist))+				   ++ " flags for " ++ token ++ "</i>")+	       savebutton `onClicked`+			  popSelectWindow "Do you want to save this USE flags setup?"+                                          (do+					   addfunc token radiolist envvalues >>= +					       writeFileIfExist usefile+					   ys <- readFileIfExist usefile+					   (if null b+					       then mkEnvValues char usefileparsed+					       else mkEnvValues char (lines ys)) >>=+					       updateTextBuffer textvuf . getcurrentflags)+	       quitbutton `onClicked` widgetDestroy window >> return ()+	       {- Main creation call routine for hUFE -}+               widgetShowAll window+		   where+		   -- Current USE flags setup. Add a newline for pretty printing.+		   getcurrentflags = unwords . map (++ "\n") . words . getEnvValue token++toUseFlag :: String -> UseFlag+toUseFlag xs = let (use, (_:desc)) = break (== ' ') xs+		   in UseFlag use desc++activateUseFlags :: String -> [String] -> RadioFlag -> IO ()+{- Activate the radioflags for each USE flags enabled or disabled.+   Consider local use flags of the form: category/package:useflag to test for validity. -}+activateUseFlags _ [] (Radio _ (_:_:r:[])) = toggleButtonSetActive r True+activateUseFlags varpkg (('-':use):ufxs) radion@(Radio uf (_:n:_:[]))+    | (use == uf) || (use == ((last . splitStr ':') uf)) && (findSubstring ((head . splitStr ':') uf) varpkg) = toggleButtonSetActive n True+    | otherwise = activateUseFlags varpkg ufxs radion+activateUseFlags varpkg (use:ufxs) radiop@(Radio uf (p:_:_:[]))+    | (use == uf) || (use == ((last . splitStr ':') uf)) && (findSubstring ((head . splitStr ':') uf) varpkg)= toggleButtonSetActive p True+    | otherwise = activateUseFlags varpkg ufxs radiop+activateUseFlags _ _ _ = popErrorWindow "Error activating use flag buttons."++checkUseFlags :: RadioFlag -> IO String+checkUseFlags (Radio uf (p:n:_:[])) =+    do+    let f = last $ splitStr ':' uf+    b <- toggleButtonGetActive p+    if b +       then return f+       else do+	    tb <- toggleButtonGetActive n+	    if tb then return ('-':f) else return []+checkUseFlags _ = return []++mkEnvValues :: Char -> [String] -> IO [EnvValues]+mkEnvValues sep = +    mapM (\ xs -> if null xs || head xs == '#' || checkifknown xs+	             then return (Comment xs)+	             else do+	                  let (var, (_:val)) = break (== sep) xs+	                  return (EnvValue var val))+	where+	-- Check if the token is a valid make.conf command,+	-- so we parse correct values between make.conf and package.use+	checkifknown = flip any knowncmd . (==) . head . words+	knowncmd = ["source"]++insertVariable :: EnvValues -> [EnvValues] -> [EnvValues]+insertVariable env [] = env : []+insertVariable ins@(EnvValue var _) (out@(EnvValue var' _):exs)+    | var == var' = ins : exs+    | otherwise = out : insertVariable ins exs+insertVariable env (envvalues:xs) = envvalues : insertVariable env xs++envValuetoString :: String -> EnvValues -> String+envValuetoString _ (EnvValue _ []) = []+envValuetoString s (EnvValue var val) = var ++ s ++ val+envValuetoString _ (Comment xs) = xs++radio :: VBox -> UseFlag -> IO RadioFlag+radio vbox (UseFlag useflag desc) = +    do+    hbox <- hBoxNew False 0+    radio1 <- radioButtonNewWithLabel "+"+    radio2 <- radioButtonNewWithLabel "-"+    radio3 <- radioButtonNewWithLabel (useflag ++ desc)+    radioButtonSetGroup radio1 radio3+    radioButtonSetGroup radio2 radio3+    toggleButtonSetActive radio3 True+    boxPackStart hbox radio1 PackNatural 0+    boxPackStart hbox radio2 PackNatural 0+    boxPackStart hbox radio3 PackNatural 0+    boxPackStartDefaults vbox hbox+    return (Radio useflag [radio1, radio2, radio3])++readGlobalFlagFile, readLocalFlagFile :: FilePath -> IO [String] +readGlobalFlagFile = readFlagFile+readLocalFlagFile = readFlagFile++readFlagFile :: FilePath -> IO [String]+readFlagFile = (=<<) (return . filter (/= []) .+		      map (\ xs -> case xs of +			              { [] -> [] ; ('#':_) -> [] ; ys -> ys }) .+		      lines) . readFile++parseConf :: [String] -> [String]+-- This functions takes care of properly parsing the USE flag+-- enviroment variable from the configuration files.+-- make.conf might have '\' newline separators, so fix that.+parseConf [] = []+parseConf y@(x:xs) | (not . null) x && last x == '\\' = +		       let (a, b) = f y [] in a : parseConf b+		   | otherwise = x : parseConf xs+    where+    f [] str = (str, [])+    f (z:zs) str | last z == '\\' = f zs (str ++ init z)+		 | otherwise = (str ++ z, zs)++takeFlagsToRadio :: VBox -> [String] -> IO [RadioFlag]+takeFlagsToRadio = (. (nub . map toUseFlag . filter (not . null) . sort)) +		   . mapM . radio++useFlagsWindow :: IO (Window, Label, VBox, TextView, Button, Button)+{- | Create USE Flag Window. -}+useFlagsWindow =+    do+    window <- windowNew+    mainbox <- vBoxNew False 5+    mainvbox <- vBoxNew False 9+    mainpaned <- hPanedNew+    cflagbox <- vBoxNew False 5+    (statscroll, statview) <- makeView False+    -- Add logo.+    image <- imageNewFromFile windowlogo+    boxPackStart mainbox image PackNatural 0+    -- List the current setup of USE flags.+    currentflagsvbox <- vBoxNew False 9+    boxPackStart currentflagsvbox statscroll PackGrow 0+    -- Pack the current USE flags inside a box.+    cflag <- labelNew $ Just "Current Flags Setup"+    hsep <- hSeparatorNew+    boxPackStart cflagbox cflag PackNatural 0+    boxPackStart cflagbox hsep PackNatural 0+    cframe <- frameNew+    containerAdd cframe currentflagsvbox+    boxPackStart cflagbox cframe PackGrow 3+    panedAdd1 mainpaned cflagbox+    -- The main radiobutton widget listing all+    -- the USE flags.+    vbox <- vBoxNew False 0+    scroll <- scrolledWindowNew Nothing Nothing+    scrolledWindowAddWithViewport scroll vbox+    panedAdd2 mainpaned scroll+    boxPackStart mainvbox mainpaned PackGrow 5+    -- Make main frame.+    mainframe <- makeFrame "USE Flags" 0.50 0.50+    containerSetBorderWidth mainvbox 9+    containerAdd mainframe mainvbox+    -- Add the main frame to the mainbox.+    boxPackStart mainbox mainframe PackGrow 0+    -- Usage explanation.+    label <- labelNew Nothing+    usagelabel <- labelNew $ Just "[+] Enable | [-] Disable"+    boxPackStart mainbox label PackNatural 0+    boxPackStart mainbox usagelabel PackNatural 0+    -- Create the button box: save, close.+    buttonbox <- hBoxNew False 0+    savebutton <- buttonNewFromStock stockSave+    quitbutton <- buttonNewFromStock stockClose+    -- pack the 'Save' and 'Quit' button.+    boxPackStart buttonbox savebutton PackNatural 0+    boxPackStart buttonbox quitbutton PackNatural 0+    boxPackStart mainbox buttonbox PackNatural 0+    containerAdd window mainbox+    set window [ windowTitle := "Himerge USE Flags Editor"+	       , windowDefaultWidth := 700+	       , windowDefaultHeight := 400+	       , containerBorderWidth := 5 ]+    return (window, label, vbox, statview, savebutton, quitbutton)++getEnvValue :: String -> [EnvValues] -> String+getEnvValue _ [] = []+getEnvValue pkgname ((EnvValue pkg value):xs)+    | pkgname == pkg = filter (/= '"') value+    | otherwise = getEnvValue pkgname xs+getEnvValue pkgname (_:xs) = getEnvValue pkgname xs++addAtConf, addAtPkgUse :: AddType+addAtConf = addAt "=" show id+addAtPkgUse = addAt " " id (sort . filter (/= []))++addAt :: String -> (String -> String)+      -> ([String] -> [String]) -> AddType+addAt sep func funcord = af+    where+    af value radiolist envlist =+	mapM checkUseFlags radiolist >>=+	return . unlines . funcord . map (envValuetoString sep) . +	flip insertVariable envlist . EnvValue value . func . unwords .+	nub . filter (not . null)

@@ -0,0 +1,799 @@+{-+    Functions for basic and common operations.+    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+-}++module Util+    where++import Data.Char+import System.Directory+import Graphics.UI.Gtk+import System.Exit+import System.IO+import System.Time+import System.Process+import Control.Concurrent+import qualified Control.Exception as E+import System.Glib.Types+import System.Glib.Properties+    (objectSetPropertyBool)+import Data.List (sort)+++data ProcessType = Emerge | EmergeSync | Eix+                          deriving (Show, Eq)++data TabButtons = StopButton | CloseButton | StopCloseButton++hname, hversion :: String+hname = "Himerge"+hversion = "0.17.9"++hdoc :: FilePath+hdoc = "/usr/share/doc/himerge-" ++ hversion ++ "/himerge_doc.html"++envbin :: FilePath+envbin = "/bin/env"++revdeprebuild, portageroot, eixpath, updateeix :: FilePath+revdeprebuild = envbin ++ " revdep-rebuild"+updateeix = envbin ++ " update-eix"+eixpath = envbin ++ " eix -n -v -x "+portageroot = "/usr/portage"++makeconfpath, etcpackage :: FilePath+makeconfpath = "/etc/make.conf"+etcpackage = "/etc/portage/"++packagekeywords, packagemask, packageunmask, packageuse :: FilePath+packagekeywords = etcpackage ++ "package.keywords"+packagemask = etcpackage ++ "package.mask"+packageunmask = etcpackage ++ "package.unmask"+packageuse = etcpackage ++ "package.use"++iconpath :: FilePath+iconpath = "/usr/share/himerge/icons/"++categoryicon, packageicon, ebuildicon :: FilePath+searchicon, windowlogo, tabstopicon :: FilePath+packageicon = iconpath ++ "package.png"+ebuildicon = iconpath ++ "ebuild.png"+categoryicon = iconpath ++ "category.png"+windowlogo = iconpath ++ "himerge-32.png"+searchicon = iconpath ++ "search.png"+tabstopicon = iconpath ++ "process-stop.png"++imageColumn, textColumn :: Int+imageColumn = 0+textColumn = 1++removeddirs :: [FilePath]+{-| List of directories to be omitted on the browser views. -}+removeddirs = ["distfiles", "eclass", "profiles", "licenses"+	      , "packages", "metadata", "scripts", "local"]++setQueueColor :: String -> String -> String+setQueueColor color msg = "<span foreground=\"" ++ color ++ "\"><b>" ++ msg ++ "</b></span>"++splitStr :: Char -> String -> [String]+splitStr c = words . map (\ n -> if c == n then ' ' else n)++joinStr :: Char -> [String] -> String+joinStr c xs = let l = last xs in (concat $ map (\ x -> x ++ [c]) $ init xs) ++ l++findSubstring :: String -> String -> Bool+findSubstring a b = f a b a +    where f [] _ _ = True +	  f _ [] _ = False +	  f (x:xs) (y:ys) cs | x == y = f xs ys cs | otherwise = f cs ys cs++getDirectory :: FilePath -> IO [FilePath]+getDirectory xs = +    (mapM (return . (xs ++)) . removeOddDirs+     =<< getDirectoryContents xs) >>=+    mapM (\ d -> do+	  bool <- doesDirectoryExist d+	  if bool == True then return d else return []) >>=+    return . sort . map getDirName . filter (/= [])++getVersion :: FilePath -> IO [String]+getVersion f = getDirectoryContents f >>=+	       return . sort . map removeSuffix +	       . filter isEbuild . removeOddDirs++removeOddDirs :: [String] -> [String]+removeOddDirs = filter (not . flip any ".:_\\'" . (==) . head)++filterDirs :: [String] -> [String] -> [String]+filterDirs = filter . flip (.) ((.) (&&) . (/=)) +	     . (flip $ flip foldr True)++getDirName :: String -> String+getDirName = reverse . takeWhile (/= '/') . reverse++isEbuild :: String -> Bool+isEbuild = ((== "ebuild") . reverse . takeWhile (/= '.') . reverse)++removeSuffix :: String -> String+removeSuffix = init . reverse . dropWhile (/= '.') . reverse++parseLabel :: String -> String+parseLabel = takeWhile (/= ' ') . dropWhile (not . isAlpha)++updateBar :: ProgressBar -> IO a+updateBar pb =+    progressBarPulse pb >> threadDelay 90000 >>+    updateBar pb++updateStatBar :: Statusbar -> String -> IO ()+updateStatBar statbar str = +    statusbarGetContextId statbar "message" >>=+    flip (statusbarPush statbar) str >>+    return ()++refreshStatBar :: Statusbar -> String -> IO ()+refreshStatBar statbar statmsg = +    updateStatBar statbar statmsg >> threadDelay 9000000 >>+    refreshStatBar statbar statmsg++onExit :: ProcessHandle -> (ExitCode -> IO ()) -> IO ()+onExit ph func = +    do+    threadDelay 3000+    exitcode <- getProcessExitCode ph+		     `E.catch` (\ _ -> getProcessExitCode ph)+    case exitcode of+        Nothing -> onExit ph func+	Just status -> func status++makeFrame :: String -> Float -> Float -> IO Frame+makeFrame label xalign yalign =+    do+    frame <- frameNew+    frameSetLabel frame label+    frameSetLabelAlign frame xalign yalign+    return frame++makeTextBuffer, makeView :: Bool -> IO (ScrolledWindow, TextView)+makeTextBuffer bool =+    do+    scroll <- scrolledWindowNew Nothing Nothing    +    texttag <- textTagNew $ Just "emerge"+    set texttag [ textTagEditable := bool ]+    texttable <- textTagTableNew+    textTagTableAdd texttable texttag+    textb <- textBufferNew $ Just texttable+    startiter <- textBufferGetStartIter textb+    -- Create a mark to preserve position across buffer changes.+    textBufferCreateMark textb (Just "emerge") startiter False+    textv <- textViewNewWithBuffer textb+    textViewSetCursorVisible textv bool+    containerAdd scroll textv+    return (scroll, textv)+makeView = makeTextBuffer++showProcessBuffer, showEmergeBuffer :: ProcessType -> Handle -> TextView +				    -> TextBuffer -> IO ()+showProcessBuffer ptype handle textv textb =+    do+    threadDelay 1+    close <- hIsClosed handle+    eof <- hIsEOF handle+    if close || eof+       then return ()+       else hGetLine handle >>= return . formatProcess ptype >>= +	    updateEmergeBuffer textv textb >>+	    showProcessBuffer ptype handle textv textb+showEmergeBuffer = showProcessBuffer++formatProcess :: ProcessType -> String -> String+{- | Formatting options depending on process type. -}+formatProcess ptype xs =+    case ptype of+      Eix -> formatEix $ cleanOutput xs+      EmergeSync -> formatSync $ cleanOutput xs+      _ -> cleanOutput xs++formatEix, formatSync :: String -> String+{- | Avoid those ugly percents characters from the eix updating. -}+formatEix xs = if (take 3 $ reverse xs) == "%00"+	       then "==> Reading Completed <=="+	       else xs+formatSync = formatEix++updateBuffer , updateEmergeBuffer :: TextView -> TextBuffer -> String -> IO ()+updateBuffer textv textb xs =+    do+    (Just mark) <- textBufferGetMark textb "emerge"+    insertiter <- textBufferGetIterAtMark textb mark+    textBufferInsert textb insertiter (xs ++ "\n")+    textViewScrollToIter textv insertiter 0.0 Nothing+    return ()+updateEmergeBuffer = updateBuffer++updateTextBuffer :: (TextViewClass t) => t -> String -> IO ()+{- | Update text view. -}+updateTextBuffer = (. flip textBufferSetText) . (>>=) . textViewGetBuffer++writeLog :: TextView -> String -> IO ()+writeLog tv str =+    do+    time <- getTime+    let hstr = "# " ++ time ++ "\n" ++ str ++ "\n"+    textViewGetBuffer tv >>= flip (updateBuffer tv) hstr++getTime :: IO String+getTime = getClockTime >>= toCalendarTime >>= return . calendarTimeToString++commandView :: (String, String, String, String)+	    -> ProcessType -> Notebook -> TextView +	    -> Statusbar -> ProgressBar -> IO ()+{- | Run the command and update a specific text view buffer. -}+commandView (command, statmsg, successmsg, errormsg)+	    ptype panel logview statbar progbar =+    do+    (viewscroll, view) <- makeView False+    -- Build the panel page with the proper buttons for the tab.+    (tooltips, (Just stopbutton), (Just closebutton)) +	<- buildPanelTab viewscroll panel statmsg StopCloseButton+    widgetShowAll viewscroll+    -- Jump to the page processing the operation.+    notebookSetCurrentPage panel (-1)+    progressBarSetFraction progbar 0.0+    -- Write logs and show status.+    writeLog logview statmsg +    statid <- forkIO $ refreshStatBar statbar (statmsg ++ " ...")+    -- Get the text buffer from the text view.+    ebuf <- textViewGetBuffer view+    textBufferSetText ebuf []+    -- Start command process.+    (_,out,err,ph) <- runInteractiveCommand command+    barthread <- forkIO $ updateBar progbar+    -- Show stdout.+    forkIO $ showProcessBuffer ptype out view ebuf+    -- Show stderr.+    forkIO $ showProcessBuffer ptype err view ebuf+    -- Connect signal to the stop-process and close-tab buttons.+    stopbutton `onClicked`+	       (do+		exitcode <- getProcessExitCode ph+		case exitcode of+		   Nothing -> popSelectWindow ("Stop " ++ command) (terminateProcess ph)+		   Just _ -> popInfoWindow "This process is already stopped.")+    closebutton `onClicked`+		    (do+		     exitcode <- getProcessExitCode ph+		     case exitcode of+	                Nothing -> popWarningWindow "The process is still running.\n\+						    \Stop this process first and then close the tab."+	                Just _ -> do+		                  (Just text) <- notebookGetMenuLabelText panel viewscroll+		                  popSelectWindow ("Do you really want to close [" ++ text ++ "]?")+                                          (tooltipsEnable tooltips >> closeTab panel viewscroll))+    -- Test for process result.+    forkIO $ onExit ph ((.) ((>>) (killThread statid)) (handleExitCode barthread))+    return ()+	where+	handleExitCode thread exitcode = +	    killThread thread >>+	    case exitcode of+	      ExitSuccess -> writeLog logview successmsg >>+			     updateStatBar statbar successmsg >>+			     progressBarSetFraction progbar 1.0 >>+			     if ptype == EmergeSync+				then updateEix panel logview statbar progbar+				else return ()+	      ExitFailure 115 -> writeLog logview (statmsg ++ " : stopped") >>+				 updateStatBar statbar (statmsg ++ " : stopped") >>+				 progressBarSetFraction progbar 0.0+	      _ -> popErrorWindow errormsg >>+		   writeLog logview errormsg >>+		   updateStatBar statbar errormsg >> +		   progressBarSetFraction progbar 0.0++buildPanelTab :: WidgetClass w => w -> Notebook -> String -> TabButtons +	      -> IO (Tooltips, Maybe Button, Maybe Button)+buildPanelTab widget panel msg isbutton =+    do+    tablabel <- labelNew $ Just msg+    menulabel <- labelNew $ Just msg+    tooltips <- tooltipsNew+    tabheader <- hBoxNew False 0+    (isstop, isclose) +	<- case isbutton of+	      StopButton -> stop tabheader tooltips >>= return . flip (,) Nothing . Just+	      CloseButton -> close tabheader tooltips >>= return . (,) Nothing . Just+	      StopCloseButton -> stop tabheader tooltips >>= +				 \ s -> close tabheader tooltips >>=+				 return . (,) (Just s) . Just+    -- Pack the tab header.+    boxPackStart tabheader tablabel PackNatural 0+    notebookAppendPageMenu panel widget tabheader menulabel+    widgetShowAll tabheader+    return (tooltips, isstop, isclose)+	    where+	    stop paneltab tips = do+	           -- Stop button.			     +	           stopbutton <- buttonNew+	           stopicon <- imageNewFromFile tabstopicon+		   boxPackEnd paneltab stopbutton PackNatural 0+	           buttonSetRelief stopbutton ReliefNone+	           buttonSetImage stopbutton stopicon+	           tooltipsSetTip tips stopbutton "Stop process" []+	           return stopbutton+	    close paneltab tips = do +	            -- Close button.+                    closebutton <- buttonNew+                    closeicon <- imageNewFromStock stockClose 1+		    boxPackEnd paneltab closebutton PackNatural 0+                    buttonSetRelief closebutton ReliefNone+                    buttonSetImage closebutton closeicon+	            tooltipsSetTip tips closebutton "Close tab" []+	            return closebutton++updateEix :: Notebook -> TextView -> Statusbar -> ProgressBar -> IO ()+updateEix = commandView (updateeix, "Updating eix cache", "Eix cache successfully updated.",+			 "Error updating eix cache.") Eix++isWidget :: WidgetClass a => a -> String -> IO Bool+isWidget widget str =+    do+    name <- widgetGetName widget+    if name == str+       then return True+       else return False++isCurrentPagePackagePanel :: Notebook -> (TreeView -> IO ()) -> IO ()+isCurrentPagePackagePanel panel func =+    do+    page <- notebookGetCurrentPage panel+    (Just child) <- notebookGetNthPage panel page+    b <- isWidget child "scrollview"+    if b+       then do+	    (Just totv) <- binGetChild (castToScrolledWindow child)+	    b' <- isWidget totv "treeview"+	    if b'+	       then func $ castToTreeView totv -- Apply the function to the treeview.+	       else popErrorWindow "This panel is not a proper list of packages."+       else popErrorWindow "This panel is not a proper package view."++popWindow :: StockId -> String -> IO ()+popWindow stock xs =+    do+    dia <- dialogNew+    diabox <- dialogGetUpper dia+    hbox <- hBoxNew False 5+    image <- imageNewFromStock stock (-1)+    label <- labelNew $ Just xs+    set dia [ windowTitle := "himerge"+	    , windowDefaultWidth := 400+	    , windowDefaultHeight := 90+	    , containerBorderWidth := 9 ]+    boxPackStart hbox image PackNatural 5+    boxPackStart hbox label PackNatural 5+    boxPackStartDefaults diabox hbox+    dialogAddButton dia stockOk ResponseOk+    widgetShow label+    widgetShow image+    widgetShow hbox+    dialogRun dia+    widgetDestroy dia+    return ()++popInfoWindow, popWarningWindow, popErrorWindow :: String -> IO ()+popErrorWindow = popWindow stockDialogError+popWarningWindow = popWindow stockDialogWarning+popInfoWindow = popWindow stockInfo++popSelectWindow :: String -> IO () -> IO ()+popSelectWindow xs f =+    do+    dia <- dialogNew+    diabox <- dialogGetUpper dia+    hbox <- hBoxNew False 5+    image <- imageNewFromStock stockDialogQuestion (-1)+    label <- labelNew (Just xs)+    set dia [ windowTitle := "himerge"+	    , windowDefaultWidth := 400+	    , windowDefaultHeight := 90+	    , containerBorderWidth := 9 ]+    boxPackStart hbox image PackNatural 5+    boxPackStart hbox label PackNatural 5+    boxPackStartDefaults diabox hbox+    dialogAddButton dia stockCancel ResponseCancel+    dialogAddButton dia stockOk ResponseOk+    widgetShow label+    widgetShow image+    widgetShow hbox+    dia `onResponse` (\ response ->+		      case response of +		        ResponseOk -> f+		        _ -> return ())+    dialogRun dia+    widgetDestroy dia+    return ()++createQueueStore :: IO (TreeView, ScrolledWindow)+{- | Create the 'Queue' treeview. -}+createQueueStore =+    do+    scroll <- scrolledWindowNew Nothing Nothing+    -- create the liststore.+    store <- listStoreNew [TMstring, TMstring, TMobject, TMstring, TMstring]+    -- create treeview.+    tv <- treeViewNewWithModel store+    treeViewSetHeadersVisible tv True+    sel <- treeViewGetSelection tv+    treeSelectionSetMode sel SelectionMultiple+    -- cell renderer.+    statcell <- cellRendererTextNew+    actcell <- cellRendererTextNew+    imagecell <- cellRendererPixbufNew+    textcell <- cellRendererTextNew+    tvcstat <- treeViewColumnNew+    tvcact <- treeViewColumnNew+    tvcpkg <- treeViewColumnNew+    -- pack the column inside the view.+    -- stat info.+    treeViewColumnPackStart tvcstat statcell False+    treeViewColumnAddAttributes tvcstat statcell [("markup", 0), ("background", 4)]+    -- action info.+    treeViewColumnPackStart tvcact actcell False+    treeViewColumnAddAttribute tvcact actcell "markup" 1+    -- image cell.+    treeViewColumnPackStart tvcpkg imagecell False+    treeViewColumnAddAttribute tvcpkg imagecell "pixbuf" 2+    -- text cell.+    treeViewColumnPackEnd tvcpkg textcell True+    treeViewColumnAddAttribute tvcpkg textcell "text" 3+    -- Columns title.+    treeViewColumnSetTitle tvcstat "Status"+    treeViewColumnSetTitle tvcact "Action"+    treeViewColumnSetTitle tvcpkg "Packages"+    treeViewAppendColumn tv tvcstat+    treeViewAppendColumn tv tvcact+    treeViewAppendColumn tv tvcpkg+    -- Column to search.+    treeViewSetSearchColumn tv 3+    -- add treeview into the scroll container.+    containerAdd scroll tv+    return (tv, scroll)++storeQueueObjects :: ListStore -> Pixbuf -> [(String, String)] -> IO ()+storeQueueObjects st pixbuf = +    mapM_ (\ (s, p) -> do+	   i <- listStoreAppend st+	   -- Set what color to use for the action letter.+           let actcolor = case s of+	                     "NS" -> "orange"+			     "N" -> "green"+	                     "U" -> "purple"+	                     "D" -> "red"+			     "R" -> "yellow"+			     "F" -> "brown"+			     "f" -> "brown"+			     "A" -> "blue"+			     _ -> "lightblue"+	   listStoreSetValue st i 0 (GVstring (Just $ setQueueColor "blue" "Queued"))+	   listStoreSetValue st i 1 (GVstring (Just $ setQueueColor actcolor ("[ "++s++" ]")))+	   listStoreSetValue st i 2 (GVobject (toGObject pixbuf))+	   listStoreSetValue st i 3 (GVstring (Just p))+	   listStoreSetValue st i 4 (GVstring (Just "lightblue")))++createStore :: String -> SelectionMode -> Bool+	    -> Maybe (FilePath, [String])+	    -> IO (TreeView, ScrolledWindow, CellRendererText)+{- | Create an scrolled tree view with list stores containing an icon +   from the file path and text associated with it from the string list.+   The list stores can be set editable. -}+createStore title selmode iseditable xss =+    do+    scroll <- scrolledWindowNew Nothing Nothing+    -- create the liststore.+    store <- listStoreNew [TMobject, TMstring]+    -- create treeview.+    tv <- treeViewNewWithModel store+    treeViewSetHeadersVisible tv True+    sel <- treeViewGetSelection tv+    treeSelectionSetMode sel selmode+    -- cell renderer.+    imagecell <- cellRendererPixbufNew+    textcell <- cellRendererTextNew+    -- is this cell editable?+    objectSetPropertyBool "editable" textcell iseditable+    tvc <- treeViewColumnNew+    -- Sort columns.+    treeViewColumnSetSortColumnId tvc 1+    -- pack the column inside the view.+    -- image cell.+    treeViewColumnPackStart tvc imagecell False+    treeViewColumnAddAttribute tvc imagecell "pixbuf" 0+    -- text cell.    +    treeViewColumnPackEnd tvc textcell True+    treeViewColumnAddAttribute tvc textcell "text" 1+    treeViewColumnSetTitle tvc title+    treeViewAppendColumn tv tvc+    -- initialize listStore elements.+    case xss of+      Nothing -> return ()+      Just (img, lst) -> storeObjects store img lst+    -- add treeview into the scroll container.+    containerAdd scroll tv+    return (tv, scroll, textcell)++collectIters :: (TreeModelClass self) => self -> Int -> IO [TreeIter]+collectIters st n = +    do+    maybeiter <- treeModelGetIter st [n]+    case maybeiter of+      { Nothing -> return [] +      ; Just s -> collectIters st (n + 1) >>=+	          return . (s :) }++collectStringValues :: (TreeModelClass self) => self -> Int -> [TreeIter] -> IO [String]+collectStringValues store column =+    mapM (\ iter -> do+	  string <- treeModelGetValue store iter column+	  case string of+	     GVstring Nothing -> return []+	     GVstring (Just string') -> return string'+	     _ -> popErrorWindow "collectStringValues: error?!" >> +	          return [])++storeObjects :: ListStore -> FilePath -> [String] -> IO ()+storeObjects st image = +    mapM_ (\ file -> do+	   pixbuf <- pixbufNewFromFile image+	   i <- listStoreAppend st+	   listStoreSetValue st i 0 (GVobject (toGObject pixbuf))+	   listStoreSetValue st i 1 (GVstring (Just file)))++storeAndSelector :: [TreeView] -> IO [(ListStore, TreeSelection)]+storeAndSelector = mapM (\ tv -> do+			 store <- getStoreFromView tv+			 sel <- treeViewGetSelection  tv+			 return (store, sel))++valueWithIterTreeModel :: ListStore -> Int -> Int -> IO GenericValue+valueWithIterTreeModel store node column =+    do+    jiter <- treeModelGetIter store [node]+    case jiter of+       Nothing -> error "valueWithIterTreeModel: error"+       Just iter -> treeModelGetValue store iter column++getStoreFromView :: TreeView -> IO ListStore+getStoreFromView tv = +    treeViewGetModel tv >>= +    (\ s -> case s of +     Nothing -> error "treeview got no valid treemodel."+     Just treemodel -> return (castToListStore treemodel))++scrollViewToCell :: TreeModelClass a => a -> TreeIter -> TreeView -> IO ()+{- Scroll to a specific cell in the view. -}+scrollViewToCell tmodel iter tview =+    do+    treepath <- treeModelGetPath tmodel iter+    (Just tvc) <- treeViewGetColumn tview 0 +    treeViewScrollToCell tview treepath tvc (Just (0,0))++getPackage :: FilePath -> TreeView -> IO (String, String, String, String)+getPackage portagerepo tv =+   do +   let getcategory = takeWhile (/= '/') . dropWhile (== ' ')+   [(store, sel)] <- storeAndSelector [tv]+   rows <- treeSelectionGetSelectedRows sel+   case rows of+     [[node]] -> do+		 (GVstring (Just pkg)) <- valueWithIterTreeModel store node textColumn+		 (Just tvc) <- treeViewGetColumn tv 0+		 (Just cat) <- treeViewColumnGetTitle tvc+    		 return (portagerepo ++ cat ++ "/" ++ pkg ++ ".ebuild",+			 cat, pkg, "=" ++ (getcategory cat) ++ "/" ++ pkg)+     _ -> return ([], [], [], [])++getEbuilds :: FilePath -> IO [String]+getEbuilds xs = +    getDirectoryContents xs >>= \ f ->+	return (filter (\ s -> reverse (fst (break (== '.') (reverse s))) == "ebuild") f)++getCategoryPackage :: TreeView -> ListStore -> TreeIter -> IO String+getCategoryPackage treev store node =+{-| Get the category name from the category+    view column and concatenate it with the package name+    for the full category/package atom. -}+    do+    (Just tvc) <- treeViewGetColumn treev 0+    (Just pathlabel) <- treeViewColumnGetTitle tvc+    (GVstring (Just pkgname)) <- treeModelGetValue store node textColumn+    return $ ((++ "/") $ takeWhile (/= '/') pathlabel) ++ pkgname++removeElement :: TreeView -> IO ()+removeElement pkgtv =+    do+    [(pkgst, sel)] <- storeAndSelector [pkgtv]+    rows <- treeSelectionGetSelectedRows sel+    case rows of+       [] -> return ()+       ((node:[]):nodes) -> f node (length nodes)+	   where+	   f _ num | num < 0 = return ()+	   f node' num = do+	                 a <- treeModelGetIter pkgst [node']+	                 case a of+			    Nothing -> error "removeElement: error"+			    Just iter -> listStoreRemove pkgst iter >>+	                                 f node' (num - 1)+       _ -> popErrorWindow "Util.hs, error: how it happened?"++removePageElement :: Notebook -> IO ()+removePageElement = flip isCurrentPagePackagePanel removeElement++closeTab :: WidgetClass child => Notebook -> child -> IO ()+closeTab nb cd = +    do+    r <- notebookPageNum nb cd+    case r of+       Nothing -> popErrorWindow "Page doesn't exist."+       Just num -> notebookRemovePage nb num++buttonWithIconLabel :: FilePath -> IO (Button, VBox)+{- | Create a button and associate it+   with a respective icon -}+buttonWithIconLabel iconname =+    do+    box <- vBoxNew False 5+    button <- buttonNew+    label <- labelNew $ Just $ getfilename iconname+    image <- imageNewFromFile iconname+    buttonSetImage button image+    buttonSetRelief button ReliefNone+    containerAdd box button+    containerAdd box label+    return (button, box)+	where+	getfilename = takeWhile (/= '.') . reverse +		      . takeWhile (/= '/') . reverse++toolButton :: Tooltips -> Toolbar -> (String, String) -> IO ToolButton+{- | Create a toolbutton with a respective icon -}+toolButton tips toolbar (iconname, tip) =+    do+    image <- imageNewFromFile (iconpath ++ iconname ++ ".png")+    tbutton <- toolButtonNew (Just image) (Just iconname)+    toolbarInsert toolbar tbutton (-1)+    toolItemSetTooltip tbutton tips tip []+    return tbutton++cleanOutput :: String -> String+{- | Remove 'weird' escape characters from strings.+   These are mainly generated by output commands. -}+cleanOutput str =  case (unlines . map clean . lines) str of+	             [] -> []+		     xs -> init xs+    where+    clean [] = []+    clean ('\BS':xs) = clean xs+    clean ('\ESC':'[':'3':'1':';':'0':'1':'m':'q':xs) = clean xs+    clean ('\ESC':'[':'0':'0':';':'0':'0':'m':xs) = clean xs+    clean ('\ESC':'[':'3':'2':';':'0':'1':'m':xs) = clean xs+    clean ('\ESC':'[':'0':'m':xs) = clean xs+    clean ('\ESC':'[':'0':';':'3':'4':'m':xs) = clean xs+    clean (x:xs) = x : clean xs++eixOutput :: String -> IO String+{- | eix operation -}+eixOutput pkg = +    do+    (_,out,_,ph) <- runInteractiveCommand (eixpath ++ pkg)+    forkIO $ onExit ph f+    hGetContents out >>= return . cleanOutput -- Clean weird chars on eix output.+    	where f _ = return ()++popEntryFunc :: String -> (String -> IO ()) -> IO ()+popEntryFunc msg func =+    do+    dia <- dialogNew+    diabox <- dialogGetUpper dia+    entrybox <- entryNew+    set dia [ windowDefaultWidth := 400+	    , windowDefaultHeight := 90+	    , containerBorderWidth := 9 ]+    label <- labelNew (Just msg)+    boxPackStartDefaults diabox label+    boxPackStartDefaults diabox entrybox++    dialogAddButton dia stockOk ResponseOk+    dialogAddButton dia stockCancel ResponseCancel++    widgetShow label+    widgetShow entrybox++    dia `onResponse` onResponseSave dia entrybox+    dialogRun dia+    widgetDestroy dia+    return ()+	where+	onResponseSave dia entrybox response = +	    case response of+	      ResponseCancel -> return ()+	      ResponseOk -> widgetDestroy dia >>+			    entryGetText entrybox >>= func+	      _ -> widgetDestroy dia >> return ()++readConfFile :: FilePath -> IO [String]+readConfFile = (=<<) (return . lines) . readFile++findAtom :: String -> String -> String+findAtom cs ts = f cs ts+    where+    f [] _ = []+    f xs [] = takeWhile (/= '"') $ tail $ dropWhile (/= '"') xs+    f (x:xs) (y:ys) | x == y = f xs ys | otherwise = f xs ts++readFileIfExist :: FilePath -> IO String+{- | Read a file.+   Pops up an error window if it raises an exception. -}+readFileIfExist file =+    do+    b <- doesFileExist file+    case b of+      True -> readFile file+	            `E.catch`+		       (\ e -> (popErrorWindow $ show e) >> return [])+      False -> return []++writeFileIfExist :: FilePath -> String -> IO ()+{- | Write a file.+   Pops up an error window if it raises an exception. -}+writeFileIfExist file xs =+    do+    b <- doesFileExist file+    case b of+      True -> writeFile file xs+	            `E.catch`+		       (\ e -> popErrorWindow $ show e)+      False -> return ()++readIfDirExist :: FilePath -> IO String+readIfDirExist file =+    do+    b <- doesDirectoryExist file+    case b of+       True -> getDirectoryContents file >>=+	       return . map ((file ++ "/") ++) . filterDirs [".",".."] >>=+	       (return . concat =<<) . (\ fl -> (mapM readFile fl)+					     `E.catch`+					       (\ e -> (popErrorWindow $ show e) >> return []))+       False -> return []++writeTempFile :: String -> IO (FilePath, Handle)+writeTempFile = openTempFile "/tmp/"++strip, stripLeft, stripRight :: String -> String+stripLeft = dropWhile (== ' ')+stripRight = reverse . stripLeft . reverse+strip = stripLeft . stripRight++findRadioButton :: [(RadioButton, String)] -> IO String+findRadioButton [] = error "This should never happen!"+findRadioButton ((r,s):xs) = +    do+    active <- toggleButtonGetActive r+    if active then return s else findRadioButton xs

@@ -0,0 +1,77 @@+{-+    Implementation of the Mozilla Embedded Browser.+    Copyright (C) 2007, 2008 Luis Francisco Araujo <araujo@gentoo.org>++    This program is free software; you can redistribute it and/or modify+    it under the terms of the GNU General Public License as published by+    the Free Software Foundation; either version 2 of the License, or+    (at your option) any later version.++    This program is distributed in the hope that it will be useful,+    but WITHOUT ANY WARRANTY; without even the implied warranty of+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the+    GNU General Public License for more details.++    You should have received a copy of the GNU General Public License+    along with this program; if not, write to the Free Software+    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA+-}++module Web where++import Util+import Graphics.UI.Gtk+import Graphics.UI.Gtk.MozEmbed+import System.Process+import System.Exit+import System.Glib.Signals+import Control.Concurrent+import Control.Parallel++webapp :: String+webapp = "firefox"++webBrowser :: IO (Frame, MozEmbed)+{- | Package information widget. (Mozilla) -}+webBrowser = +    do+    mozEmbedSetCompPath mozEmbedDefaultCompPath+    mozbrowser <- mozEmbedNew+    webframe <- frameNew+    containerAdd webframe mozbrowser+    -- Open the web browser links with the mozilla/firefox programs.+    mozbrowser `onMouseDoubleClick` +		   (\ _ -> do+		    forkIO $ mozEmbedStopLoad mozbrowser+		    stopMoz mozbrowser+		    loadUrl mozbrowser >> return 0)+    -- Omit one click.+    mozbrowser `onMouseClick`+		   (\ _ -> do+		    forkIO $ mozEmbedStopLoad mozbrowser+		    (mozEmbedStopLoad mozbrowser)+		           `seq` (stopMoz mozbrowser)+		    return 0)+    return (webframe, mozbrowser)++stopMoz :: MozEmbed -> IO ThreadId+stopMoz moz =+    moz `onOpenURI`+	    (\ _ -> mozEmbedStopLoad moz >>+	     return True) >>=+    forkIO . signalDisconnect++loadUrl :: MozEmbed -> IO ThreadId+loadUrl mb  = forkIO (mozEmbedGetLinkMessage mb >>=+		      runMozilla)++runMozilla :: String -> IO ()+runMozilla ('f':'i':'l':'e':':':'/':'/':url) =+    do+    ph <- runProcess envbin [webapp, url] Nothing Nothing +	             Nothing Nothing Nothing+    ph `onExit` f+	where+	f ExitSuccess = return ()+	f e = popErrorWindow $ show e+runMozilla _ = return ()