vcsgui (empty) → 0.0.1
raw patch · 42 files changed
+4693/−0 lines, 42 filesdep +MissingHdep +basedep +directorysetup-changed
Dependencies added: MissingH, base, directory, filepath, gtk, haskell98, mtl, process, vcswrapper
Files
- LICENSE +339/−0
- Setup.lhs +6/−0
- data/guiCommonAskpass.glade +109/−0
- data/guiCommonCommit.glade +125/−0
- data/guiCommonConflictsResolved.glade +89/−0
- data/guiCommonFilesInConflict.glade +142/−0
- data/guiCommonLog.glade +160/−0
- data/guiCommonMergeTool.glade +125/−0
- data/guiCommonSetupRepo.glade +377/−0
- data/guiSvnAskpass.glade +166/−0
- data/guiSvnCheckout.glade +173/−0
- src/Main.hs +174/−0
- src/VCSGui.hs +20/−0
- src/VCSGui/Common.hs +25/−0
- src/VCSGui/Common/Commit.hs +192/−0
- src/VCSGui/Common/ConflictsResolved.hs +73/−0
- src/VCSGui/Common/Error.hs +28/−0
- src/VCSGui/Common/ExceptionHandler.hs +36/−0
- src/VCSGui/Common/FilesInConflict.hs +262/−0
- src/VCSGui/Common/GtkHelper.hs +348/−0
- src/VCSGui/Common/Helpers.hs +22/−0
- src/VCSGui/Common/Log.hs +181/−0
- src/VCSGui/Common/MergeTool.hs +30/−0
- src/VCSGui/Common/Process.hs +68/−0
- src/VCSGui/Common/SetupConfig.hs +337/−0
- src/VCSGui/Git.hs +30/−0
- src/VCSGui/Git/Commit.hs +76/−0
- src/VCSGui/Git/Helpers.hs +35/−0
- src/VCSGui/Git/Log.hs +83/−0
- src/VCSGui/Git/Pull.hs +33/−0
- src/VCSGui/Mercurial.hs +26/−0
- src/VCSGui/Mercurial/Commit.hs +70/−0
- src/VCSGui/Mercurial/Log.hs +34/−0
- src/VCSGui/Svn.hs +30/−0
- src/VCSGui/Svn/AskPassword.hs +132/−0
- src/VCSGui/Svn/Checkout.hs +88/−0
- src/VCSGui/Svn/Commit.hs +135/−0
- src/VCSGui/Svn/Helper.hs +24/−0
- src/VCSGui/Svn/Log.hs +58/−0
- src/VCSGui/Svn/Update.hs +58/−0
- src/exe/askpass/Main.hs +76/−0
- vcsgui.cabal +98/−0
+ LICENSE view
@@ -0,0 +1,339 @@+ GNU GENERAL PUBLIC LICENSE+ Version 2, June 1991++ Copyright (C) 1989, 1991 Free Software Foundation, Inc.,+ 51 Franklin Street, 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 Lesser 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 Street, 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 Lesser General+Public License instead of this License.
+ Setup.lhs view
@@ -0,0 +1,6 @@+#!/usr/bin/runhaskell +> module Main where+> import Distribution.Simple+> main :: IO ()+> main = defaultMain+
+ data/guiCommonAskpass.glade view
@@ -0,0 +1,109 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <requires lib="gtk+" version="2.24"/>+ <!-- interface-naming-policy project-wide -->+ <object class="GtkActionGroup" id="actiongroup1">+ <child>+ <object class="GtkAction" id="actCancel"/>+ </child>+ <child>+ <object class="GtkAction" id="actOk"/>+ </child>+ </object>+ <object class="GtkWindow" id="windowAskpass">+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Enter Password</property>+ <child>+ <object class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkHBox" id="hbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkLabel" id="lblPw">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Enter Password:</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkEntry" id="entryPw">+ <property name="width_request">300</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="visibility">False</property>+ <property name="invisible_char">•</property>+ <property name="primary_icon_activatable">False</property>+ <property name="secondary_icon_activatable">False</property>+ <property name="primary_icon_sensitive">True</property>+ <property name="secondary_icon_sensitive">True</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkHButtonBox" id="hbuttonbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="layout_style">end</property>+ <child>+ <object class="GtkButton" id="btnCancel">+ <property name="label">gtk-cancel</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCancel</property>+ <property name="use_action_appearance">False</property>+ <property name="use_stock">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btnOk">+ <property name="label">gtk-ok</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actOk</property>+ <property name="use_action_appearance">False</property>+ <property name="use_stock">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="pack_type">end</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ data/guiCommonCommit.glade view
@@ -0,0 +1,125 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <requires lib="gtk+" version="2.24"/>+ <!-- interface-naming-policy project-wide -->+ <object class="GtkAction" id="actCancel">+ <property name="label" translatable="yes">Cancel</property>+ <property name="stock_id">gtk-cancel</property>+ </object>+ <object class="GtkAction" id="actCommit">+ <property name="label" translatable="yes">Commit</property>+ <property name="stock_id">gtk-ok</property>+ </object>+ <object class="GtkTextBuffer" id="bufferMsg">+ <property name="text" translatable="yes">Enter commit message here.</property>+ </object>+ <object class="GtkWindow" id="windowCommit">+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Commit</property>+ <child>+ <object class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkScrolledWindow" id="scrolledwindow2">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">automatic</property>+ <property name="vscrollbar_policy">automatic</property>+ <child>+ <object class="GtkTextView" id="txtViewMsg">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="buffer">bufferMsg</property>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkScrolledWindow" id="scrolledwindow1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">automatic</property>+ <property name="vscrollbar_policy">automatic</property>+ <child>+ <object class="GtkTreeView" id="treeViewFiles">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <object class="GtkHBox" id="bottom">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <placeholder/>+ </child>+ <child>+ <object class="GtkAlignment" id="alignment1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">0</property>+ <property name="xscale">0</property>+ <child>+ <object class="GtkHButtonBox" id="hbuttonbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkButton" id="btCancel">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCancel</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btCommit">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCommit</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="padding">10</property>+ <property name="position">2</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ data/guiCommonConflictsResolved.glade view
@@ -0,0 +1,89 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <requires lib="gtk+" version="2.24"/>+ <object class="GtkAction" id="actBrowsePath">+ <property name="label" translatable="yes">Browse</property>+ </object>+ <object class="GtkAction" id="actConflictsNotResolved">+ <property name="label" translatable="yes">Conflicts not resolved</property>+ <property name="short_label" translatable="yes">Conflicts not resolved</property>+ <property name="stock_id">gtk-no</property>+ </object>+ <object class="GtkAction" id="actConflictsResolved">+ <property name="label" translatable="yes">Conflicts resolved</property>+ <property name="short_label" translatable="yes">Conflicts resolved</property>+ <property name="stock_id">gtk-yes</property>+ </object>+ <object class="GtkWindow" id="windowConflictsResolved">+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Choose Path for Mergetool</property>+ <child>+ <object class="GtkVBox" id="vbox4">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkLabel" id="label1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="yalign">0.47999998927116394</property>+ <property name="label" translatable="yes">Have conflicts been resolved?</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkAlignment" id="alignment5">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">1</property>+ <property name="xscale">0</property>+ <child>+ <object class="GtkHButtonBox" id="hbuttonbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkButton" id="btnCancel">+ <property name="label" translatable="yes">Cancel</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actConflictsNotResolved</property>+ <property name="use_underline">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btnOk">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actConflictsResolved</property>+ <property name="use_underline">True</property>+ <property name="image_position">top</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ data/guiCommonFilesInConflict.glade view
@@ -0,0 +1,142 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <!-- interface-requires gtk+ 3.0 -->+ <object class="GtkAction" id="actBrowsePath">+ <property name="label" translatable="yes">Browse</property>+ <property name="short_label" translatable="yes">Browse</property>+ </object>+ <object class="GtkAction" id="actCancel">+ <property name="label" translatable="yes">Cancel</property>+ <property name="short_label" translatable="yes">Cancel</property>+ </object>+ <object class="GtkAction" id="actResolved">+ <property name="label" translatable="yes">Conflicts Resolved</property>+ <property name="short_label" translatable="yes">Conflicts Resolved</property>+ </object>+ <object class="GtkWindow" id="windowFilesInConflict">+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Files in Conflict</property>+ <child>+ <object class="GtkTable" id="table2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="n_rows">4</property>+ <child>+ <object class="GtkLabel" id="label1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">There is at least one file in conflict. Resolve conflicts first before you can commit.</property>+ <property name="justify">center</property>+ </object>+ </child>+ <child>+ <object class="GtkScrolledWindow" id="scrolledwindow1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <child>+ <object class="GtkTreeView" id="treeViewFiles">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <child internal-child="selection">+ <object class="GtkTreeSelection" id="treeview-selection3"/>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>+ <child>+ <object class="GtkTable" id="table1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="n_columns">3</property>+ <child>+ <object class="GtkLabel" id="lblPath">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">MergeTool</property>+ </object>+ <packing>+ <property name="x_padding">5</property>+ </packing>+ </child>+ <child>+ <object class="GtkEntry" id="entPath">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">●</property>+ <property name="invisible_char_set">True</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="x_padding">5</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btnBrowsePath">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actBrowsePath</property>+ <property name="use_underline">True</property>+ <property name="xalign">0.52999997138977051</property>+ </object>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">3</property>+ <property name="y_options">GTK_EXPAND</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ </packing>+ </child>+ <child>+ <object class="GtkHButtonBox" id="hbuttonbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="layout_style">end</property>+ <child>+ <object class="GtkButton" id="btCancel">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCancel</property>+ <property name="use_underline">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btResolved">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actResolved</property>+ <property name="use_underline">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="top_attach">3</property>+ <property name="bottom_attach">4</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ data/guiCommonLog.glade view
@@ -0,0 +1,160 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <requires lib="gtk+" version="2.24"/>+ <!-- interface-naming-policy project-wide -->+ <object class="GtkActionGroup" id="logActions">+ <child>+ <object class="GtkAction" id="actCancel">+ <property name="label" translatable="yes">Cancel</property>+ <property name="short_label" translatable="yes">Cancel</property>+ <property name="stock_id">gtk-cancel</property>+ </object>+ <accelerator key="c" modifiers="GDK_MOD1_MASK"/>+ </child>+ <child>+ <object class="GtkAction" id="actCheckout">+ <property name="label" translatable="yes">Checkout</property>+ <property name="short_label" translatable="yes">Checkout</property>+ </object>+ <accelerator key="o" modifiers="GDK_MOD1_MASK"/>+ </child>+ </object>+ <object class="GtkWindow" id="logWindow">+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Log viewer</property>+ <child>+ <object class="GtkVBox" id="vbox2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkAlignment" id="alignment2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">0</property>+ <property name="yalign">0</property>+ <property name="xscale">0</property>+ <property name="yscale">0</property>+ <child>+ <object class="GtkHBox" id="hbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkLabel" id="lblBranch">+ <property name="can_focus">False</property>+ <property name="no_show_all">True</property>+ <property name="label" translatable="yes">Branch:</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkComboBox" id="comboBranch">+ <property name="can_focus">False</property>+ <property name="no_show_all">True</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkAlignment" id="alignment3">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkScrolledWindow" id="scrolledwindow1">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="hscrollbar_policy">automatic</property>+ <property name="vscrollbar_policy">automatic</property>+ <child>+ <object class="GtkTreeView" id="historyTreeView">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ </object>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="lblRevisionDetails">+ <property name="can_focus">False</property>+ <property name="no_show_all">True</property>+ <property name="label" translatable="yes">label</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">2</property>+ </packing>+ </child>+ <child>+ <object class="GtkAlignment" id="alignment4">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">1</property>+ <property name="xscale">0</property>+ <child>+ <object class="GtkHButtonBox" id="hbuttonbox2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkButton" id="btnCance">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCancel</property>+ <property name="use_stock">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btnCheckout">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCheckout</property>+ <property name="use_underline">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">3</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ data/guiCommonMergeTool.glade view
@@ -0,0 +1,125 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <requires lib="gtk+" version="2.24"/>+ <object class="GtkAction" id="actBrowsePath">+ <property name="label" translatable="yes">Browse</property>+ </object>+ <object class="GtkAction" id="actCancel">+ <property name="label" translatable="yes">Cancel</property>+ <property name="short_label" translatable="yes">Cancel</property>+ <property name="stock_id">gtk-cancel</property>+ </object>+ <object class="GtkAction" id="actUse">+ <property name="label" translatable="yes">Ok</property>+ <property name="short_label" translatable="yes">Ok</property>+ <property name="stock_id">gtk-ok</property>+ </object>+ <object class="GtkWindow" id="windowMergeTool">+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Choose Path for Mergetool</property>+ <child>+ <object class="GtkVBox" id="vbox4">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkTable" id="table1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="n_columns">3</property>+ <child>+ <object class="GtkLabel" id="lblPath">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Path</property>+ </object>+ </child>+ <child>+ <object class="GtkButton" id="btnBrowsePath">+ <property name="label" translatable="yes">Browse</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actBrowsePath</property>+ <property name="use_action_appearance">False</property>+ <property name="use_underline">True</property>+ <property name="xalign">0.52999997138977051</property>+ </object>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">3</property>+ </packing>+ </child>+ <child>+ <object class="GtkEntry" id="entPath">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">●</property>+ <property name="invisible_char_set">True</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkAlignment" id="alignment5">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">1</property>+ <property name="xscale">0</property>+ <child>+ <object class="GtkHButtonBox" id="hbuttonbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkButton" id="btnCancel">+ <property name="label" translatable="yes">Cancel</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCancel</property>+ <property name="use_underline">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btnOk">+ <property name="label">gtk-ok</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actUse</property>+ <property name="use_action_appearance">False</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ data/guiCommonSetupRepo.glade view
@@ -0,0 +1,377 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <requires lib="gtk+" version="2.24"/>+ <object class="GtkAction" id="actBrowsePathToTool">+ <property name="label" translatable="yes">Browse</property>+ <property name="short_label" translatable="yes">Browse</property>+ </object>+ <object class="GtkActionGroup" id="setupRepoActions">+ <child>+ <object class="GtkAction" id="actBrowseExec"/>+ </child>+ <child>+ <object class="GtkAction" id="actCancel">+ <property name="label" translatable="yes">Cancel</property>+ <property name="short_label" translatable="yes">Cancel</property>+ <property name="stock_id">gtk-cancel</property>+ </object>+ </child>+ <child>+ <object class="GtkAction" id="actBrowseRepo"/>+ </child>+ <child>+ <object class="GtkAction" id="actOk">+ <property name="label" translatable="yes">Ok</property>+ <property name="short_label" translatable="yes">Ok</property>+ <property name="stock_id">gtk-ok</property>+ </object>+ </child>+ </object>+ <object class="GtkListStore" id="liststore1">+ <columns>+ <!-- column-name gchararray1 -->+ <column type="gchararray"/>+ </columns>+ <data>+ <row>+ <col id="0" translatable="yes">GIT</col>+ </row>+ <row>+ <col id="0" translatable="yes">SVN</col>+ </row>+ </data>+ </object>+ <object class="GtkWindow" id="windowSetupRepo">+ <property name="width_request">600</property>+ <property name="height_request">400</property>+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Setup Repository</property>+ <property name="gravity">center</property>+ <child>+ <object class="GtkVBox" id="vbox4">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkTable" id="table1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="n_rows">6</property>+ <property name="n_columns">4</property>+ <child>+ <object class="GtkLabel" id="lblEmail">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Author Email</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">4</property>+ <property name="bottom_attach">5</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="lblAuthor">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Author</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">3</property>+ <property name="bottom_attach">4</property>+ </packing>+ </child>+ <child>+ <object class="GtkEntry" id="entAuthor">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">•</property>+ <property name="invisible_char_set">True</property>+ <property name="primary_icon_activatable">False</property>+ <property name="secondary_icon_activatable">False</property>+ </object>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">4</property>+ <property name="top_attach">3</property>+ <property name="bottom_attach">4</property>+ </packing>+ </child>+ <child>+ <object class="GtkEntry" id="entEmail">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">•</property>+ <property name="invisible_char_set">True</property>+ <property name="primary_icon_activatable">False</property>+ <property name="secondary_icon_activatable">False</property>+ </object>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">4</property>+ <property name="top_attach">4</property>+ <property name="bottom_attach">5</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btnBrowseRepo">+ <property name="label" translatable="yes">Browse</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actBrowseRepo</property>+ <property name="use_action_appearance">False</property>+ <property name="use_underline">True</property>+ </object>+ <packing>+ <property name="left_attach">3</property>+ <property name="right_attach">4</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="lblVCSType">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Type of VCS</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ </packing>+ </child>+ <child>+ <object class="GtkComboBox" id="comboBoxVCSType">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="model">liststore1</property>+ </object>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">4</property>+ <property name="top_attach">1</property>+ <property name="bottom_attach">2</property>+ <property name="x_options">GTK_FILL</property>+ <property name="y_options"></property>+ </packing>+ </child>+ <child>+ <object class="GtkEntry" id="entRepo">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="editable">False</property>+ <property name="has_frame">False</property>+ <property name="invisible_char">•</property>+ <property name="primary_icon_activatable">False</property>+ <property name="secondary_icon_activatable">False</property>+ </object>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">3</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="lblExec">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Executable</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ </packing>+ </child>+ <child>+ <object class="GtkEntry" id="entExec">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">•</property>+ <property name="primary_icon_activatable">False</property>+ <property name="secondary_icon_activatable">False</property>+ </object>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">3</property>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btnBrowseExec">+ <property name="label" translatable="yes">Browse</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actBrowseExec</property>+ <property name="use_action_appearance">False</property>+ <property name="use_underline">True</property>+ </object>+ <packing>+ <property name="left_attach">3</property>+ <property name="right_attach">4</property>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ <property name="y_options">GTK_EXPAND</property>+ </packing>+ </child>+ <child>+ <object class="GtkCheckButton" id="checkbtAuthor">+ <property name="label" translatable="yes">Custom author</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="use_action_appearance">False</property>+ <property name="draw_indicator">True</property>+ </object>+ <packing>+ <property name="top_attach">3</property>+ <property name="bottom_attach">5</property>+ </packing>+ </child>+ <child>+ <object class="GtkCheckButton" id="checkbtExec">+ <property name="label" translatable="yes">Custom executable</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="use_action_appearance">False</property>+ <property name="draw_indicator">True</property>+ </object>+ <packing>+ <property name="top_attach">2</property>+ <property name="bottom_attach">3</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="lblRepository">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Repository</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="lblPath">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">MergeTool</property>+ </object>+ <packing>+ <property name="left_attach">1</property>+ <property name="right_attach">2</property>+ <property name="top_attach">5</property>+ <property name="bottom_attach">6</property>+ <property name="x_padding">5</property>+ </packing>+ </child>+ <child>+ <placeholder/>+ </child>+ <child>+ <placeholder/>+ </child>+ <child>+ <placeholder/>+ </child>+ <child>+ <object class="GtkEntry" id="entPathToTool">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="invisible_char">●</property>+ <property name="invisible_char_set">True</property>+ </object>+ <packing>+ <property name="left_attach">2</property>+ <property name="right_attach">3</property>+ <property name="top_attach">5</property>+ <property name="bottom_attach">6</property>+ <property name="x_padding">5</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btnBrowsePathToTool">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actBrowsePathToTool</property>+ <property name="use_underline">True</property>+ <property name="xalign">0.52999997138977051</property>+ </object>+ <packing>+ <property name="left_attach">3</property>+ <property name="right_attach">4</property>+ <property name="top_attach">5</property>+ <property name="bottom_attach">6</property>+ <property name="y_options">GTK_EXPAND</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkAlignment" id="alignment5">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">1</property>+ <property name="xscale">0</property>+ <child>+ <object class="GtkHButtonBox" id="hbuttonbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkButton" id="btnCancel">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCancel</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btnOk">+ <property name="label">gtk-ok</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actOk</property>+ <property name="use_action_appearance">False</property>+ <property name="use_underline">True</property>+ <property name="use_stock">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ data/guiSvnAskpass.glade view
@@ -0,0 +1,166 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <requires lib="gtk+" version="2.24"/>+ <!-- interface-naming-policy project-wide -->+ <object class="GtkAction" id="actCancel">+ <property name="label" translatable="yes">Cancel</property>+ <property name="short_label" translatable="yes">Cancel</property>+ <property name="stock_id">gtk-cancel</property>+ </object>+ <object class="GtkAction" id="actOk">+ <property name="label" translatable="yes">Ok</property>+ <property name="short_label" translatable="yes">Ok</property>+ <property name="stock_id">gtk-ok</property>+ </object>+ <object class="GtkWindow" id="windowAskpass">+ <property name="can_focus">False</property>+ <child>+ <object class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkVBox" id="vbox2">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkCheckButton" id="checkbtUsePw">+ <property name="label" translatable="yes">Use password</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="use_action_appearance">False</property>+ <property name="active">True</property>+ <property name="draw_indicator">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkVBox" id="boxUsePwd">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkHBox" id="hbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkLabel" id="lblPw">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Password</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkEntry" id="entryPw">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="visibility">False</property>+ <property name="invisible_char">•</property>+ <property name="invisible_char_set">True</property>+ <property name="primary_icon_activatable">False</property>+ <property name="secondary_icon_activatable">False</property>+ <property name="primary_icon_sensitive">True</property>+ <property name="secondary_icon_sensitive">True</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <object class="GtkCheckButton" id="checkbtSaveForSession">+ <property name="label" translatable="yes">Save for this session</property>+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">False</property>+ <property name="use_action_appearance">False</property>+ <property name="draw_indicator">True</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">2</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkAlignment" id="alignment1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">1</property>+ <property name="xscale">0</property>+ <child>+ <object class="GtkHButtonBox" id="hbuttonbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkButton" id="btCancel">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCancel</property>+ <property name="use_underline">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btOk">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actOk</property>+ <property name="use_underline">True</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="padding">5</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ data/guiSvnCheckout.glade view
@@ -0,0 +1,173 @@+<?xml version="1.0" encoding="UTF-8"?>+<interface>+ <requires lib="gtk+" version="2.24"/>+ <!-- interface-naming-policy project-wide -->+ <object class="GtkAction" id="actCancel"/>+ <object class="GtkAction" id="actCheckout"/>+ <object class="GtkTextBuffer" id="buffer_path"/>+ <object class="GtkTextBuffer" id="buffer_revision"/>+ <object class="GtkTextBuffer" id="buffer_url"/>+ <object class="GtkWindow" id="windowCheckout">+ <property name="can_focus">False</property>+ <property name="title" translatable="yes">Checkout</property>+ <property name="default_width">440</property>+ <property name="default_height">250</property>+ <child>+ <object class="GtkVBox" id="vbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkHBox" id="hbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkVBox" id="vbox_lbls">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkLabel" id="lbl_url">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">URL</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="lbl_revision">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Revision</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <object class="GtkLabel" id="lbl_path">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="label" translatable="yes">Path</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">2</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="padding">28</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkVBox" id="vbox3">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkTextView" id="txtViewUrl">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="buffer">buffer_url</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkTextView" id="txtViewRevision">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="buffer">buffer_revision</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ <child>+ <object class="GtkTextView" id="txtViewPath">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="buffer">buffer_path</property>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">2</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ <packing>+ <property name="expand">True</property>+ <property name="fill">True</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkAlignment" id="alignment1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <property name="xalign">1</property>+ <property name="xscale">0</property>+ <child>+ <object class="GtkHButtonBox" id="hbuttonbox1">+ <property name="visible">True</property>+ <property name="can_focus">False</property>+ <child>+ <object class="GtkButton" id="btCancel">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCancel</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">0</property>+ </packing>+ </child>+ <child>+ <object class="GtkButton" id="btCheckout">+ <property name="visible">True</property>+ <property name="can_focus">True</property>+ <property name="receives_default">True</property>+ <property name="related_action">actCheckout</property>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">False</property>+ <property name="position">1</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+ <packing>+ <property name="expand">False</property>+ <property name="fill">True</property>+ <property name="position">3</property>+ </packing>+ </child>+ </object>+ </child>+ </object>+</interface>
+ src/Main.hs view
@@ -0,0 +1,174 @@+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module Main (+ main+) where++import VCSGui.Common.MergeTool+import qualified VCSGui.Svn as Svn+import qualified VCSWrapper.Common as Wrapper++import qualified VCSGui.Git.Log as GitLog+import qualified VCSGui.Git.Commit as GitCommit+import qualified VCSGui.Mercurial.Commit as MercurialCommit+import qualified VCSGui.Mercurial.Log as MercurialLog+import Graphics.UI.Gtk+import Control.Monad.Trans(liftIO)+--+--svn+--++--+-- commit+--++{-+cwd = "/home/forste/svnreps/project1_work1"+main = do+ initGUI+ runWithConfig $ Svn.showCommitGUI eMergeToolSetter $ Left handler+ mainGUI+ mainQuit+ where+ eMergeToolSetter = Right (\tool -> putStrLn ("Setter called with " ++ fullPath tool))+ runWithConfig = Wrapper.runVcs $ Wrapper.makeConfig (Just cwd) Nothing Nothing+ handler = (\result -> liftIO $ putStrLn $ show result)++-}++--+-- checkout+--++{-+cwd = "/home/n0s/"+main = do+ initGUI+ runWithConfig $ Svn.showCheckoutGUI+ mainGUI+ mainQuit+ where+ runWithConfig = runVcs $ makeConfig (Just cwd) Nothing Nothing+-}++--+--log+--++{-+cwd = "/home/forste/project1_work"+main = do+ initGUI+ runWithConfig $+ Svn.showLogGUI+ mainGUI+ mainQuit+ where+ runWithConfig = Wrapper.runVcs $ Wrapper.makeConfig (Just cwd) Nothing Nothing+-}++--+--askpass+--+--main = do+-- initGUI+-- runWithConfig $ Svn.showAskpassGUI (\result -> liftIO $ putStrLn $ "Result "++ show result)+-- mainGUI+-- mainQuit+-- where+-- runWithConfig = Wrapper.runVcs $ Wrapper.makeConfig Nothing Nothing Nothing++--+--git+--++--+--log+--++cwdGit = "/home/forste/leksahWorkspace/leksah"+--cwdGit = "/home/n0s-ubuntu/testrepo"+{-+main = do+ initGUI+ runWithConfig $+ GitLog.showLogGUI+ mainGUI+ where+ runWithConfig = Wrapper.runVcs $ Wrapper.makeConfig (Just cwdGit) Nothing Nothing+-}+++--+-- commit+--++{-+main = do+ initGUI+ runWithConfig $+ GitCommit.showCommitGUI+ mainGUI+ where+ runWithConfig = Wrapper.runVcs $ Wrapper.makeConfig (Just cwdGit) Nothing Nothing+-}+++--+-- common+--++-- setup repo+{-+cwd = "/home/forste/svnreps/project1_work1"+main = do+ initGUI+ Svn.showSetupConfigGUI config $ handler+ mainGUI+ where+ handler (Just (x, y, z)) = putStrLn $+ "Config:" ++ show y+ ++ ", Chosen vcs:" ++ show x+ ++ ", MergeTool:" ++ show z+ handler Nothing = putStrLn "Handler got Nothing"+ config = Just (Wrapper.GIT, Wrapper.makeConfig Nothing Nothing Nothing, Nothing)+-- config = Just (Wrapper.GIT, Wrapper.makeConfig (Just cwd) Nothing Nothing)+-}+++--+-- mercurial+--++cwdMercurial = "/home/forste/tmp/testvcs/hgreps/repo1"+{-+main = do+ initGUI+ runWithConfig $+ MercurialCommit.showCommitGUI+ mainGUI+ where+ runWithConfig = Wrapper.runVcs $ Wrapper.makeConfig (Just cwdMercurial) Nothing Nothing+-}++--{-+main = do+ initGUI+ runWithConfig $+ MercurialLog.showLogGUI+ mainGUI+ where+ runWithConfig = Wrapper.runVcs $ Wrapper.makeConfig (Just cwdMercurial) Nothing Nothing+---}
+ src/VCSGui.hs view
@@ -0,0 +1,20 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module VCSGui (++) where+++
+ src/VCSGui/Common.hs view
@@ -0,0 +1,25 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Common gui elements and functions are declared here.+-- This module is not an exposed library, every vcs-main-module should reexport this module instead+--+-----------------------------------------------------------------------------++module VCSGui.Common (+ VCSGui.Common.Error.showErrorGUI+ , VCSGui.Common.SetupConfig.showSetupConfigGUI+ , VCSGui.Common.ExceptionHandler.defaultVCSExceptionHandler+ , module VCSGui.Common.MergeTool+) where+import qualified VCSGui.Common.SetupConfig+import qualified VCSGui.Common.Error+import qualified VCSGui.Common.ExceptionHandler+import VCSGui.Common.MergeTool
+ src/VCSGui/Common/Commit.hs view
@@ -0,0 +1,192 @@+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- TODO select all files checkbox + TODOs below+--+-- | Functions to show a commit window. This mostly hides the window-building tasks from the specific VCS implementation.+-----------------------------------------------------------------------------+module VCSGui.Common.Commit (+ SCFile(..)+ ,Option+ ,showCommitGUI+ ,selected+ ,filePath+ ,status+ ,isLocked+) where++import qualified VCSWrapper.Common as Wrapper+import qualified VCSGui.Common.GtkHelper as H+import Graphics.UI.Gtk+import Control.Monad.Trans(liftIO)+import Control.Monad+import Control.Monad.Reader+import Maybe+import Paths_vcsgui(getDataFileName)++--+-- glade path and object accessors+--++getGladepath = getDataFileName "data/guiCommonCommit.glade"+accessorWindowCommit = "windowCommit"+accessorTreeViewFiles = "treeViewFiles"+accessorActCommit = "actCommit"+accessorActCancel = "actCancel"+accessorActTxtViewMsg = "txtViewMsg"++--+-- types+--++-- | This function will be called after the ok action is called.+type OkCallBack = String -- ^ Commit message as specified in the GUI.+ -> [FilePath] -- ^ List of 'FilePath's of the files that were selected.+ -> [Option] -- ^ options (this is currently not implemented i.e. '[]' is passed)+ -> Wrapper.Ctx ()++-- | fn to set listStore model for treeview+type TreeViewSetter = TreeView+ -> Wrapper.Ctx (ListStore SCFile)+++data CommitGUI = CommitGUI {+ windowCommit :: H.WindowItem+ , treeViewFiles :: H.TreeViewItem SCFile+ , actCommit :: H.ActionItem+ , actCancel :: H.ActionItem+ , txtViewMsg :: H.TextViewItem+}++-- | Represents a file which can be selected for commiting.+data SCFile = GITSCFile Bool FilePath String |+ SVNSCFile Bool FilePath String Bool+ deriving (Show)++-- | Return 'True' if the 'SCFile' is flagged as selected.+selected :: SCFile -> Bool+selected (GITSCFile s _ _) = s+selected (SVNSCFile s _ _ _) = s++-- | Return the 'FilePath' of this file.+filePath :: SCFile -> FilePath+filePath (GITSCFile _ fp _ ) = fp+filePath (SVNSCFile _ fp _ _) = fp++-- | Return the status of this file.+status :: SCFile -> String+status (GITSCFile _ _ s) = s+status (SVNSCFile _ _ s _) = s++-- | Return 'True' if this file is locked. For Git, this returns always 'False'.+isLocked :: SCFile -> Bool+isLocked (SVNSCFile _ _ _ l) = l+isLocked _ = False+++-- | Options to the 'OkCallBack'.+type Option = String+++-- | Display a window to enter a commit message and select files to be commited.+showCommitGUI :: TreeViewSetter+ -> OkCallBack+ -> Wrapper.Ctx()+showCommitGUI setUpTreeView okCallback = do+ liftIO $ putStrLn "Starting gui ..."+ gui <- loadCommitGUI setUpTreeView++ -- connect actions+ liftIO $ H.registerClose $ windowCommit gui+ liftIO $ H.registerCloseAction (actCancel gui) (windowCommit gui)+ config <- ask+ liftIO $ on (H.getItem (actCommit gui)) actionActivated $ do+ let (store,_) = H.getItem (treeViewFiles gui)+ selectedFiles <- getSelectedFiles store+ mbMsg <- H.get (txtViewMsg gui)+ case selectedFiles of+ [] -> return() -- TODO err-message, selected files are empty+ _ -> do+ case mbMsg of+ Nothing -> return() --TODO err-message, message is empty+ Just msg -> Wrapper.runVcs config $ okCallback msg selectedFiles [] -- TODO implement Options+ H.closeWin (windowCommit gui)++ -- present window+ liftIO $ widgetShowAll $ H.getItem $ windowCommit gui++ return ()++++loadCommitGUI :: TreeViewSetter -- ^ fn to set listStore model for treeview+ -> Wrapper.Ctx CommitGUI+loadCommitGUI setUpTreeView = do+ gladepath <- liftIO getGladepath+ builder <- liftIO $ H.openGladeFile gladepath++ win <- liftIO $ H.getWindowFromGlade builder accessorWindowCommit+ treeViewFiles <- getTreeViewFromGladeCustomStore builder accessorTreeViewFiles setUpTreeView+ actCommit <- liftIO $ H.getActionFromGlade builder accessorActCommit+ actCancel <- liftIO $ H.getActionFromGlade builder accessorActCancel+ txtViewMsg <- liftIO $ H.getTextViewFromGlade builder accessorActTxtViewMsg+ return $ CommitGUI win treeViewFiles actCommit actCancel txtViewMsg+----+---- HELPERS+----++getSelectedFiles :: ListStore SCFile -> IO [FilePath]+getSelectedFiles listStore = do+ listedFiles <- listStoreToList listStore+ let selectedFiles = map (\scf -> filePath scf )+ $ filter (\scf -> selected scf) listedFiles+ return (selectedFiles)++getTreeViewFromGladeCustomStore :: Builder+ -> String+ -> TreeViewSetter+ -> Wrapper.Ctx (H.TreeViewItem SCFile)+getTreeViewFromGladeCustomStore builder name setupListStore = do+ (_, tView) <- liftIO $ wrapWidget builder castToTreeView name+ store <- setupListStore tView+ let getter = getFromListStore (store, tView)+ setter = setToListStore (store, tView)+ return (name, (store, tView), (getter, setter))++---+--- same as gtkhelper, but avoiding exposing it+---+wrapWidget :: GObjectClass objClass =>+ Builder+ -> (GObject -> objClass)+ -> String -> IO (String, objClass)+wrapWidget builder cast name = do+ putStrLn $ " cast " ++ name+ gobj <- builderGetObject builder cast name+ return (name, gobj)++getFromListStore :: (ListStore a, TreeView)+ -> IO (Maybe [a])+getFromListStore (store, _) = do+ list <- listStoreToList store+ if null list+ then return Nothing+ else return $ Just list++setToListStore :: (ListStore a, TreeView)+ -> [a]+ -> IO ()+setToListStore (store, view) newList = do+ listStoreClear store+ mapM_ (listStoreAppend store) newList+ return ()+++
+ src/VCSGui/Common/ConflictsResolved.hs view
@@ -0,0 +1,73 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.ConflictsResolved+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Provides a VCS-independent GUI to ask a user if conflicts have been resolved.+--+-----------------------------------------------------------------------------++module VCSGui.Common.ConflictsResolved (+ showConflictsResolvedGUI+) where++import qualified VCSWrapper.Common as Wrapper+import Paths_vcsgui(getDataFileName)+import qualified VCSGui.Common.GtkHelper as H+import Control.Monad.Trans(liftIO)+import Graphics.UI.Gtk+import Control.Monad.Reader(ask)++--+-- glade path and object accessors+--++getGladepath = getDataFileName "data/guiCommonConflictsResolved.glade"+accessorWindowConflictsResolved = "windowConflictsResolved"+accessorActConflictsResolved = "actConflictsResolved"+accessorActConflictsNotResolved = "actConflictsNotResolved"+++data ConflictsResolvedGUI = ConflictsResolvedGUI {+ windowConflictsResolved :: H.WindowItem+ , actConflictsResolved :: H.ActionItem+ , actConflictsNotResolved :: H.ActionItem+}++-- | Shows a GUI asking user if conflicts have been resolved.+showConflictsResolvedGUI :: (Bool -> Wrapper.Ctx()) -- ^ Handler for user response. Argument is: True if conflicts have been resolved, False if not.+ -> Wrapper.Ctx ()+showConflictsResolvedGUI handler = do+ liftIO $ putStrLn "Starting conflictsResolvedGUI ..."+ gui <- loadConflictsResolvedGUI++ -- connect actions+ liftIO $ H.registerClose $ windowConflictsResolved gui+ config <- ask+ liftIO $ on (H.getItem (actConflictsNotResolved gui)) actionActivated $ do+ Wrapper.runVcs config $ handler False+ H.closeWin (windowConflictsResolved gui)++ liftIO $ on (H.getItem (actConflictsResolved gui)) actionActivated $ do+ Wrapper.runVcs config $ handler True+ H.closeWin (windowConflictsResolved gui)++ -- present window+ liftIO $ widgetShowAll $ H.getItem $ windowConflictsResolved gui++ return ()++loadConflictsResolvedGUI :: Wrapper.Ctx ConflictsResolvedGUI+loadConflictsResolvedGUI = do+ gladepath <- liftIO getGladepath+ builder <- liftIO $ H.openGladeFile gladepath++ win <- liftIO $ H.getWindowFromGlade builder accessorWindowConflictsResolved+ actConflictsResolved <- liftIO $ H.getActionFromGlade builder accessorActConflictsResolved+ actConflictsNotResolved <- liftIO $ H.getActionFromGlade builder accessorActConflictsNotResolved+ return $ ConflictsResolvedGUI win actConflictsResolved actConflictsNotResolved
+ src/VCSGui/Common/Error.hs view
@@ -0,0 +1,28 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.Error+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Functions to handle errors are found in this module.+--+-----------------------------------------------------------------------------++module VCSGui.Common.Error (+ showErrorGUI+) where+import Graphics.UI.Gtk+++-- | Displays a simple window displaying given 'String' as an error message.+showErrorGUI :: String -- ^ Message to display.+ -> IO ()+showErrorGUI msg = do+ dialog <- messageDialogNew Nothing [] MessageError ButtonsOk msg+ _ <- dialogRun dialog+ widgetDestroy dialog+ return ()
+ src/VCSGui/Common/ExceptionHandler.hs view
@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.ExceptionHandler+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Exception handling functions can be found in this module.+--+-----------------------------------------------------------------------------++module VCSGui.Common.ExceptionHandler (+ defaultVCSExceptionHandler+) where++import qualified Control.Exception as Exc++import VCSWrapper.Common+import VCSGui.Common.Error+++-- | Wraps an IO computation to display an error message if a 'VCSException' occurs.+defaultVCSExceptionHandler :: IO t -> IO ()+defaultVCSExceptionHandler vcsRunner = do+ o <- Exc.try vcsRunner+ putStrLn $ "exception handler called"+ case o of+ Left (VCSException exitCode out err repoLocation (cmd:opts)) -> do+ putStrLn $ "exception caught"+ showErrorGUI $ unlines ["An error occured.", err, "Details:", "command: " ++ cmd, "options: " ++ unwords opts]+ Right _ -> do+ putStrLn $ "no exception"+ return ()
+ src/VCSGui/Common/FilesInConflict.hs view
@@ -0,0 +1,262 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.FilesInConflict+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Provides a GUI to show and resolve conflicts in a VCS.+--+-----------------------------------------------------------------------------++module VCSGui.Common.FilesInConflict (+ showFilesInConflictGUI+) where++import qualified VCSWrapper.Common as Wrapper+import qualified VCSGui.Common.GtkHelper as H+import qualified VCSGui.Common.Commit as Commit+import qualified VCSGui.Common.MergeTool as Merge+import qualified VCSGui.Common.Process as Process+import qualified VCSGui.Common.ConflictsResolved as ConflictsResolvedGUI+import qualified VCSGui.Common.Error as Error+import Graphics.UI.Gtk+import Control.Monad.Trans(liftIO)+import Control.Monad+import Control.Monad.Reader+import Paths_vcsgui(getDataFileName)++--+-- glade path and object accessors+--++getGladepath = getDataFileName "data/guiCommonFilesInConflict.glade"+accessorWindowFilesInConflict = "windowFilesInConflict"+accessorTreeViewFiles = "treeViewFiles"+accessorActResolved = "actResolved"+accessorActCancel = "actCancel"+accessorActBrowsePath = "actBrowsePath"+accessorEntPath = "entPath"++--+-- types+--++-- | Handler being called after all files have been resolved and resolved button is pressed+type Handler = Wrapper.Ctx()++-- fn to set listStore model for treeview+type TreeViewSetter = (Maybe FilePath) -- ^ Maybe cwd+ -> [FilePath] -- ^ conflicting files+ -> (FilePath -> Wrapper.Ctx [FilePath]) -- ^ fn receiving a path to a conflicting file and returning all conflicting files involved in the conflict (max 4)+ -> (FilePath -> Wrapper.Ctx ()) -- ^ fn to mark files as resolved in VCS+ -> (Either Merge.MergeTool Merge.MergeToolSetter) -- ^ either a mergetool or fn to set one+ -> H.TextEntryItem -- ^ the entry to get the path to the mergetool from+ -> TreeView -- ^ the treeview to set the model to+ -> Wrapper.Ctx (ListStore SCFile)++-- GUI storing accessible elements+data GUI = GUI {+ windowFilesInConflict :: H.WindowItem+ , treeViewFiles :: H.TreeViewItem SCFile+ , actResolved :: H.ActionItem+ , actCancel :: H.ActionItem+ , actBrowsePath :: H.ActionItem+ , entPath :: H.TextEntryItem+}++--model for treestore+data SCFile = SCFile {+ filePath :: FilePath+ , isResolved :: Bool+ }+ deriving (Show)+++-- | Shows a GUI showing conflicting files and providing means to resolve the conflicts.+showFilesInConflictGUI :: (Maybe TreeViewSetter) -- ^ fn to set listStore model for treeview, Nothing for default+ -> [FilePath] -- ^ conflicting files+ -> (FilePath -> Wrapper.Ctx [FilePath]) -- ^ fn receiving a path to a conflicting file and returning all conflicting files involved in the conflict (max 4)+ -> (FilePath -> Wrapper.Ctx ()) -- ^ fn to mark files as resolved in VCS+ -> (Either Merge.MergeTool Merge.MergeToolSetter) -- ^ 'MergeTool' is used for any possible conflicts. If not present user will be asked to provide 'MergeTool' on conflicts. 'MergeToolSetter' will be called for response.+ -> Handler -- ^ 'Handler' for action resolved+ -> Wrapper.Ctx ()+showFilesInConflictGUI Nothing f g m e a =+ showFilesInConflictGUI (Just defaultSetUpTreeView) f g m e a+showFilesInConflictGUI (Just setUpTreeView) filesInConflict filesToResolveGetter resolveMarker eMergeToolSetter actResolvedHandler = do+ liftIO $ putStrLn "Starting files in conflict gui ..."+ config <- ask+ let cwd = (Wrapper.configCwd config)+ gui <- loadGUI $ setUpTreeView cwd filesInConflict filesToResolveGetter resolveMarker eMergeToolSetter+ mbMergeToolSetter <- case eMergeToolSetter of+ Left (Merge.MergeTool path) -> do+ liftIO $ H.set (entPath gui) path+ return Nothing+ Right setter -> return $ Just setter++ -- connect actions+ liftIO $ H.registerClose $ windowFilesInConflict gui+ liftIO $ H.registerCloseAction (actCancel gui) (windowFilesInConflict gui)+ config <- ask+ liftIO $ on (H.getItem (actResolved gui)) actionActivated $ do+ --TODO check if all files have been resolved+ Wrapper.runVcs config $ actResolvedHandler+ H.closeWin (windowFilesInConflict gui)+ liftIO $ on (H.getItem (actBrowsePath gui)) actionActivated $ do+ mbPath <- showFolderChooserDialog "Select executable" (H.getItem $ windowFilesInConflict gui) FileChooserActionOpen+ case mbPath of+ Nothing -> return ()+ Just path -> do+ -- update gui+ H.set (entPath gui) path+ -- call setter+ case mbMergeToolSetter of+ Nothing -> return ()+ Just setter -> setter (Merge.MergeTool path)+ return ()+ -- present window+ liftIO $ widgetShowAll $ H.getItem $ windowFilesInConflict gui++ return ()++loadGUI :: (H.TextEntryItem -> TreeView -> Wrapper.Ctx (ListStore SCFile))+ -- ^ (The entry to get the path to the mergetool from. , treeview to setup, fn to set listStore model for treeview+ -> Wrapper.Ctx GUI+loadGUI setUpTreeView = do+ gladepath <- liftIO getGladepath+ builder <- liftIO $ H.openGladeFile gladepath++ win <- liftIO $ H.getWindowFromGlade builder accessorWindowFilesInConflict+ entPath <- liftIO $ H.getTextEntryFromGlade builder accessorEntPath+ treeViewFiles <- getTreeViewFromGladeCustomStore builder accessorTreeViewFiles (setUpTreeView entPath)+ actResolved <- liftIO $ H.getActionFromGlade builder accessorActResolved+ actCancel <- liftIO $ H.getActionFromGlade builder accessorActCancel+ actBrowsePath <- liftIO $ H.getActionFromGlade builder accessorActBrowsePath+ return $ GUI win treeViewFiles actResolved actCancel actBrowsePath entPath++defaultSetUpTreeView :: TreeViewSetter+defaultSetUpTreeView mbcwd conflictingFiles filesToResolveGetter resolveMarker eMergeToolSetter entPath listView = do+ config <- ask+ liftIO $ do+ -- create model+ listStore <- listStoreNew [+ (SCFile fileName+ (False))+ | fileName <- conflictingFiles]+ treeViewSetModel listView listStore++ let treeViewItem = (listStore, listView)++ renderer <- cellRendererTextNew+ H.addColumnToTreeView' treeViewItem+ renderer+ "File"+ $ \scf -> [cellText := filePath scf]++ renderer <- cellRendererToggleNew+ H.addColumnToTreeView' treeViewItem+ renderer+ "Resolved"+ $ \scf -> [cellToggleActive := isResolved scf]++ -- connect select action+ on renderer cellToggled $ \columnId -> do+ putStrLn $ "Checkbutton clicked at column " ++ (show columnId)+ --TODO only call tool if button is not checked, move this code to being called if a click on row is received+ let callTool' = (\path -> Wrapper.runVcs config $ callTool columnId listStore path)+ mbPath <- H.get entPath+ case mbPath of+ Nothing -> Error.showErrorGUI "MergeTool not set. Set MergeTool first."+ Just path -> callTool' path+ return ()+++ return listStore+ where+ callTool columnId listStore pathToTool = do+ config <- ask+ Just treeIter <- liftIO $ treeModelGetIterFromString listStore columnId+ value <- liftIO $ listStoreGetValue listStore $ listStoreIterToIndex treeIter+ filesToResolve <- filesToResolveGetter $ filePath value+ resolvedByTool <- liftIO $ Process.exec mbcwd pathToTool filesToResolve+ let setResolved' = setResolved listStore treeIter value+ case resolvedByTool of+ False -> ConflictsResolvedGUI.showConflictsResolvedGUI+ (\resolved -> setResolved' resolved)+ True -> setResolved listStore treeIter value True+ return()+ setResolved listStore treeIter oldValue isResolved = do+ let fp = filePath oldValue+ case isResolved of+ False -> return ()+ True -> resolveMarker fp+ let newValue = (\(SCFile fp b) -> SCFile fp isResolved)+ oldValue+ liftIO $ listStoreSetValue listStore (listStoreIterToIndex treeIter) newValue+ return ()++----+---- HELPERS+----++getTreeViewFromGladeCustomStore :: Builder+ -> String+ -> (TreeView -> Wrapper.Ctx (ListStore SCFile)) -- ^ fn defining how to setup the liststore+ -> Wrapper.Ctx (H.TreeViewItem SCFile)+getTreeViewFromGladeCustomStore builder name setupListStore = do+ (_, tView) <- liftIO $ wrapWidget builder castToTreeView name+ store <- setupListStore tView+ let getter = getFromListStore (store, tView)+ setter = setToListStore (store, tView)+ return (name, (store, tView), (getter, setter))++---+--- same as gtkhelper, but avoiding exposing it+---+wrapWidget :: GObjectClass objClass =>+ Builder+ -> (GObject -> objClass)+ -> String -> IO (String, objClass)+wrapWidget builder cast name = do+ putStrLn $ " cast " ++ name+ gobj <- builderGetObject builder cast name+ return (name, gobj)++getFromListStore :: (ListStore a, TreeView)+ -> IO (Maybe [a])+getFromListStore (store, _) = do+ list <- listStoreToList store+ if null list+ then return Nothing+ else return $ Just list++setToListStore :: (ListStore a, TreeView)+ -> [a]+ -> IO ()+setToListStore (store, view) newList = do+ listStoreClear store+ mapM_ (listStoreAppend store) newList+ return ()++-- HELPER++-- | shows a dialog to choose a folder, returns Just FilePath to folder if succesfull, Nothing if cancelled+showFolderChooserDialog :: String -- ^ title of the window+ -> Window -- ^ parent window+ -> FileChooserAction+ -> IO (Maybe FilePath)+showFolderChooserDialog title parent fcAction = do+ dialog <- fileChooserDialogNew (Just title) (Just parent) fcAction [("Cancel", ResponseCancel), ("Select", ResponseAccept)]+ response <- dialogRun dialog+ case response of+ ResponseCancel -> widgetDestroy dialog >> return Nothing+ ResponseDeleteEvent -> widgetDestroy dialog >> return Nothing+ ResponseAccept -> do+ f <- fileChooserGetFilename dialog+ widgetDestroy dialog+ return f++
+ src/VCSGui/Common/GtkHelper.hs view
@@ -0,0 +1,348 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.GtkHelper+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | This module contains functions to help building a GTK GUI using GTKBuilder.+--+-----------------------------------------------------------------------------++module VCSGui.Common.GtkHelper (+-- * Typesynonyms to wrap Gtk objects (*Item)+--+-- | These are built after the following scheme:+--+-- @((Name of the item as in the gladefile), (actual gtk object), (getter, setter))@+--+-- Note however that you can (and should) use the functions 'getName', 'getItem', 'get' and 'set'.++ openGladeFile+ , getWindowFromGlade+ , getActionFromGlade+ , getLabelFromGlade+ , getTextEntryFromGlade+ , getTextViewFromGlade+ , getComboBoxFromGlade+ , getCheckButtonFromGlade+ , getButtonFromGlade+ , getTreeViewFromGlade+ , getTreeViewFromGladeCustomStore+ , addColumnToTreeView+ , addColumnToTreeView'+ , addTextColumnToTreeView+ , addTextColumnToTreeView'+++ , getName+ , getItem+ , get+ , set++ , closeWin+ , registerClose+ , registerCloseAction+ , registerQuit+ , registerQuitAction++ , WindowItem+ , ActionItem+ , LabelItem+ , TextEntryItem+ , TextViewItem+ , ComboBoxItem+ , CheckButtonItem+ , TreeViewItem+ , ButtonItem+) where++import qualified Graphics.UI.Gtk as Gtk++import System.Directory+import Control.Monad.Trans(liftIO)+import System.IO (hPutStrLn, stderr)+import VCSGui.Common.Helpers (emptyListToNothing)++-- Typesynonyms+type WindowItem = (String, Gtk.Window, ())+type ActionItem = (String, Gtk.Action, ())+type LabelItem = (String, Gtk.Label, (IO (Maybe String), String -> IO ()))+type TextEntryItem = (String, Gtk.Entry, (IO (Maybe String), String -> IO ()))+type ComboBoxItem = (String, Gtk.ComboBox, (IO (Maybe String), [String] -> IO ()))+type TextViewItem = (String, Gtk.TextView, (IO (Maybe String), String -> IO ()))+type TreeViewItem a = (String, (Gtk.ListStore a, Gtk.TreeView), (IO (Maybe [a]), [a] -> IO ()))+type CheckButtonItem = (String, Gtk.CheckButton, (IO Bool, Bool -> IO()))+type ButtonItem = (String, Gtk.Button, (IO String, String -> IO()))++-- Type accessors++-- | return the name of this item (as in the gladefile)+getName :: (String, a, b) -> String+getName (n, _, _) = n++-- | return the Gtk object wrapped by given item+getItem :: (String, a, b) -> a+getItem (_, item, _) = item++-- | call teh get method of an *Item+get :: (String, a, (b, c)) -> b+get (_, _, (getter, _)) = getter++-- | call the set method of an *Item+set :: (String, a, (b, c)) -> c+set (_,_, (_, setter)) = setter+++----------------------+-- *FromGlade+----------------------++-- | Open a gladefile with a new 'Gtk.Builder'.+openGladeFile :: FilePath -- ^ Gladefile to open.+ -> IO Gtk.Builder+openGladeFile fn = do+ builder <- Gtk.builderNew+ Gtk.builderAddFromFile builder fn+ return builder++-- | Get a 'WindowItem' from a gladefile.+getWindowFromGlade :: Gtk.Builder+ -> String -- ^ name of the window to get as specified in the gladefile.+ -> IO WindowItem+getWindowFromGlade builder name = do+ (a, b) <- wrapWidget builder Gtk.castToWindow name+ return (a, b, ())++-- | Get an 'ActionItem' from a gladefile.+getActionFromGlade :: Gtk.Builder+ -> String -- ^ name of the action to get as specified in the gladefile.+ -> IO ActionItem+getActionFromGlade builder name = do+ (a, b) <- wrapWidget builder Gtk.castToAction name+ return (a, b, ())++-- | Get an 'LabelItem' from a gladefile.+getLabelFromGlade :: Gtk.Builder+ -> String -- ^ name of the label to get as specified in the gladefile.+ -> IO LabelItem+getLabelFromGlade builder name = do+ (_, entry) <- wrapWidget builder Gtk.castToLabel name+ let getter = error "don't call get on a gtk label!" :: IO (Maybe String)+ setter val = Gtk.labelSetText entry val :: IO ()+ return (name, entry, (getter, setter))++-- | Get a 'ButtonItem' from a gladefile.+getButtonFromGlade :: Gtk.Builder+ -> String -- ^ name of the button to get as specified in the gladefile.+ -> IO ButtonItem+getButtonFromGlade builder name = do+ (_,btn) <- wrapWidget builder Gtk.castToButton name+ let getter = Gtk.buttonGetLabel btn :: IO String+ setter val = Gtk.buttonSetLabel btn val+ return (name, btn, (getter,setter))++-- | Get a 'TextEntryItem' from a gladefile.+getTextEntryFromGlade :: Gtk.Builder+ -> String -- ^ name of the text entry to get as specified in the gladefile.+ -> IO TextEntryItem+getTextEntryFromGlade builder name = do+ (_, entry) <- wrapWidget builder Gtk.castToEntry name+ let getter = fmap emptyListToNothing $ Gtk.entryGetText entry :: IO (Maybe String)+ setter val = Gtk.entrySetText entry val :: IO ()+ return (name, entry, (getter, setter))++-- | Get a 'ComboBoxItem' from a gladefile.+getComboBoxFromGlade :: Gtk.Builder+ -> String -- ^ name of the combo box to get as specified in the gladefile.+ -> IO ComboBoxItem+getComboBoxFromGlade builder name = do+ (_, combo) <- wrapWidget builder Gtk.castToComboBox name+ Gtk.comboBoxSetModelText combo+ let getter = Gtk.comboBoxGetActiveText combo :: IO (Maybe String) -- get selected text+ setter entries = do -- fill with new entries+ store <- Gtk.comboBoxGetModelText combo+ Gtk.listStoreClear store+ mapM_ (Gtk.listStoreAppend store) entries+ return ()+ return (name, combo, (getter, setter))++-- | Get a 'TextViewItem' from a gladefile.+getTextViewFromGlade :: Gtk.Builder+ -> String -- ^ name of the text view to get as specified in the gladefile.+ -> IO TextViewItem+getTextViewFromGlade builder name = do+ (_, entry) <- wrapWidget builder Gtk.castToTextView name+ buffer <- Gtk.textViewGetBuffer entry+ let getter = getLongText buffer :: IO (Maybe String)+ setter = (\text -> Gtk.textBufferSetText buffer text) :: String -> IO ()+ return (name, entry, (getter, setter))+ where+ getLongText buffer = do+ start <- Gtk.textBufferGetStartIter buffer+ end <- Gtk.textBufferGetEndIter buffer+ isEmpty <- (Gtk.textIterEqual start end)+ if isEmpty then return Nothing else do+ s <- Gtk.textBufferGetText buffer start end True -- True to inclue hidden char+ return $ Just s++-- | Get a 'CheckButtonItem' from a gladefile.+getCheckButtonFromGlade :: Gtk.Builder+ -> String -- ^ name of the check button to get as specified in the gladefile.+ -> IO CheckButtonItem+getCheckButtonFromGlade builder name = do+ (_,bt) <- wrapWidget builder Gtk.castToCheckButton name+ let getter = Gtk.toggleButtonGetActive bt+ setter = (\bool -> Gtk.toggleButtonSetActive bt bool) :: Bool -> IO()+ return (name,bt, (getter,setter))++---------------------------------+-- TreeView+---------------------------------++-- | Get a 'TreeViewItem' from a gladefile.+getTreeViewFromGlade :: Gtk.Builder+ -> String -- ^ name of the tree view to get as specified in the gladefile.+ -> [a] -- ^ Content of the new tree view.+ -> IO (TreeViewItem a)+getTreeViewFromGlade builder name rows = do+ (_, tView) <- wrapWidget builder Gtk.castToTreeView name+ entry@(store, treeView) <- createStoreForTreeView tView rows+ let getter = getFromListStore entry+ setter = setToListStore entry+ return (name, (store, treeView), (getter, setter))++-- | Get a 'TreeViewItem' from a gladefile.+getTreeViewFromGladeCustomStore :: Gtk.Builder+ -> String -- ^ name of the tree view to get as specified in the gladefile.+ -> (Gtk.TreeView -> IO (Gtk.ListStore a)) -- ^ fn defining how to setup the liststore+ -> IO (TreeViewItem a)+getTreeViewFromGladeCustomStore builder name setupListStore = do+ (_, tView) <- wrapWidget builder Gtk.castToTreeView name+ store <- setupListStore tView+ Gtk.treeViewSetModel tView store+ let getter = getFromListStore (store, tView)+ setter = setToListStore (store, tView)+ return (name, (store, tView), (getter, setter))++-- | Create a new 'Gtk.ListStore' for a 'Gtk.TreeView'.+createStoreForTreeView :: Gtk.TreeView -- ^ The created list store will be set the model for this TreeView.+ -> [a] -- ^ Content of the new store.+ -> IO (Gtk.ListStore a, Gtk.TreeView)+createStoreForTreeView listView rows = do+ listStore <- Gtk.listStoreNew rows+ Gtk.treeViewSetModel listView listStore+ return (listStore, listView)++-- | Get the content of a ListStore.+getFromListStore :: (Gtk.ListStore a, Gtk.TreeView)+ -> IO (Maybe [a]) -- ^ Nothing if the ListStore is empty.+getFromListStore (store, _) = do+ list <- Gtk.listStoreToList store+ if null list+ then return Nothing+ else return $ Just list++-- | Set the content of a ListStore.+setToListStore :: (Gtk.ListStore a, Gtk.TreeView)+ -> [a] -- ^ New content of the ListStore.+ -> IO ()+setToListStore (store, view) newList = do+ Gtk.listStoreClear store+ mapM_ (Gtk.listStoreAppend store) newList+ return ()++--+-- Various helpers+--++-- | Close a window.+closeWin :: WindowItem -> IO ()+closeWin win = (Gtk.widgetHideAll (getItem win))++-- | Close a window if 'Gtk.deleteEvent' occurs on this 'WindowItem'.+registerClose :: WindowItem -> IO ()+registerClose win = Gtk.on (getItem win) Gtk.deleteEvent (liftIO (closeWin win) >> return False) >> return ()++-- | Close a window if the specified action occurs on this 'WindowItem'.+registerCloseAction :: ActionItem -> WindowItem -> IO ()+registerCloseAction act win = Gtk.on (getItem act) Gtk.actionActivated (liftIO (closeWin win)) >> return ()++-- | Call 'Gtk.mainQuit' if 'Gtk.deleteEvent' occurs on this 'WindowItem'.+registerQuit :: WindowItem -> IO ()+registerQuit win = Gtk.on (getItem win) Gtk.deleteEvent (liftIO $ Gtk.mainQuit >> return False) >> return ()++-- | Call 'Gtk.mainQuit' if the specified action occurs on this 'WindowItem'.+registerQuitAction :: ActionItem -> IO ()+registerQuitAction act = Gtk.on (getItem act) Gtk.actionActivated (liftIO (Gtk.mainQuit)) >> return ()++-- TODO fun argument is not used. what was the purpos of this function?+-- | same as 'registerQuitAction' since second argument is ignored (?)+registerQuitWithCustomFun :: WindowItem+ -> IO () -- ^ custom fun+ -> IO ()+registerQuitWithCustomFun win fun = Gtk.on (getItem win) Gtk.deleteEvent (liftIO $ Gtk.mainQuit >> return False) >> return ()++-- | Add a column to given ListStore and TreeView using a mapping.+-- The mapping consists of a CellRenderer, the title and a function, that maps each row to attributes of the column+addColumnToTreeView :: Gtk.CellRendererClass r =>+ TreeViewItem a+ -> r -- ^ CellRenderer+ -> String -- ^ title+ -> (a -> [Gtk.AttrOp r]) -- ^ mapping+ -> IO ()+addColumnToTreeView (_, item, _) = do+ addColumnToTreeView' item+-- newCol <- Gtk.treeViewColumnNew+-- Gtk.set newCol [Gtk.treeViewColumnTitle Gtk.:= title]+-- Gtk.treeViewAppendColumn listView newCol+-- Gtk.treeViewColumnPackStart newCol renderer True+-- Gtk.cellLayoutSetAttributes newCol renderer listStore value2attributes++-- | Same as 'addColumnToTreeView'. This function can be called without a complete 'TreeViewItem'.+addColumnToTreeView' :: Gtk.CellRendererClass r =>+ (Gtk.ListStore a, Gtk.TreeView)+ -> r+ -> String+ -> (a -> [Gtk.AttrOp r])+ -> IO ()+addColumnToTreeView' (listStore, listView) renderer title value2attributes = do+ newCol <- Gtk.treeViewColumnNew+ Gtk.set newCol [Gtk.treeViewColumnTitle Gtk.:= title]+ Gtk.treeViewAppendColumn listView newCol+ Gtk.treeViewColumnPackStart newCol renderer True+ Gtk.cellLayoutSetAttributes newCol renderer listStore value2attributes++-- | Shortcut for adding text columns to a TreeView. See 'addColumnToTreeView'.+addTextColumnToTreeView :: TreeViewItem a+ -> String -- ^ title+ -> (a -> [Gtk.AttrOp Gtk.CellRendererText]) -- ^ mapping+ -> IO ()+addTextColumnToTreeView tree title map = do+ r <- Gtk.cellRendererTextNew+ addColumnToTreeView tree r title map++-- | Shortcut for adding text columns to a TreeView. See 'addColumnToTreeView\''.+addTextColumnToTreeView' :: (Gtk.ListStore a, Gtk.TreeView)+ -> String+ -> (a -> [Gtk.AttrOp Gtk.CellRendererText])+ -> IO ()+addTextColumnToTreeView' item title map = do+ r <- Gtk.cellRendererTextNew+ addColumnToTreeView' item r title map++---------------------------+-- internal helpers+---------------------------++wrapWidget :: Gtk.GObjectClass objClass =>+ Gtk.Builder+ -> (Gtk.GObject -> objClass)+ -> String -> IO (String, objClass)+wrapWidget builder cast name = do+ hPutStrLn stderr $ " cast " ++ name+ gobj <- Gtk.builderGetObject builder cast name+ return (name, gobj)
+ src/VCSGui/Common/Helpers.hs view
@@ -0,0 +1,22 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.Helpers+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL Nothing+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module VCSGui.Common.Helpers (+ emptyListToNothing+) where++-- | Return 'Nothing' if given list is empty, 'Just' the list otherwise.+emptyListToNothing :: [a] -> Maybe [a]+emptyListToNothing [] = Nothing+emptyListToNothing l = Just l
+ src/VCSGui/Common/Log.hs view
@@ -0,0 +1,181 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.Log+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Functions to show a log window. This mostly hides the window-building tasks from the specific VCS implementation.+--+-----------------------------------------------------------------------------+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+module VCSGui.Common.Log (+ showLogGUI+) where++import Control.Monad.Reader+import qualified Graphics.UI.Gtk as Gtk+import Data.Maybe++import VCSGui.Common.GtkHelper+import qualified VCSWrapper.Common as Common+++import Data.Maybe (fromMaybe)+import Paths_vcsgui(getDataFileName)++getGladepath = getDataFileName "data/guiCommonLog.glade"++data LogConfig a = LogConfig {+ options :: [String]+ ,treeViewSetter :: Gtk.TreeView -> TreeViewItem a+}+++--------------------------------------------------+---- LOG VIEWER / CHECKOUT+--------------------------------------------------++data LogGUI = LogGUI {+ logWin :: WindowItem+ , logTreeView :: TreeViewItem Common.LogEntry+ , lblRevisionDetails :: LabelItem+ , actCheckout :: ActionItem+ , actLogCancel :: ActionItem+ , comboBranch :: ComboBoxItem+ , lblBranch :: LabelItem+}++-- | Show the history of a repository.+showLogGUI :: [Common.LogEntry]+ -- ^ logEntries to be displayed initially+ -> [String]+ -- ^ options will be displayed in a menu as checkboxes (TODO this is currently not implemented)+ -> Maybe ((String, [String]), (String -> Common.Ctx [Common.LogEntry]))+ -- ^ (list of branchnames to display, Function called when a different branch is selected)+ --+ -- The function will be called with the selected branchname to repopulate the displayed LogEntries.+ -- If 'Nothing', no branch selection will be displayed.+ -> (Common.LogEntry -> Maybe String -> Common.Ctx ())+ -- ^ (selected line, name of the branch to checkout from)+ --+ -- This function is called on checkout action. The window will be closed afterwards.+ -> Bool -- ^ Add column to display branch name+ -> Common.Ctx ()+showLogGUI logEntries options Nothing doCheckoutFn displayBranchNames = guiWithoutBranches logEntries options doCheckoutFn displayBranchNames >> return ()+showLogGUI logEntries options (Just (branches, changeBranchFn)) doCheckoutFn displayBranchNames = do+ gui <- guiWithoutBranches logEntries options doCheckoutFn displayBranchNames+ guiAddBranches gui branches changeBranchFn+ return ()++guiWithoutBranches :: [Common.LogEntry]+ -> [String]+ -> (Common.LogEntry+ -> (Maybe String)+ -> Common.Ctx ())+ -> Bool -- ^ Add column to display branch name+ -> Common.Ctx LogGUI+guiWithoutBranches logEntries options doCheckoutFn displayBranchNames = do+ gui <- loadLogGui logEntries+ liftIO $ setupLogColumns gui displayBranchNames++ -- connect gui elements+ liftIO $ registerClose $ logWin gui+ liftIO $ registerCloseAction (actLogCancel gui) (logWin gui)++ config <- ask+ liftIO $ Gtk.on (getItem (actCheckout gui)) Gtk.actionActivated $+ doCheckout' config (logTreeView gui) (comboBranch gui)+ >> (closeWin (logWin gui))++ -- show window+ liftIO $ Gtk.widgetShowAll $ getItem $ logWin gui+ return gui+ where+ doCheckout' :: Common.Config -> TreeViewItem Common.LogEntry -> ComboBoxItem -> IO ()+ doCheckout' cfg (_, (store, view), _) combo = do+ (path, _) <- Gtk.treeViewGetCursor view -- TODO fix nothing selected bug here+ Just treeIter <- Gtk.treeModelGetIter store path+ selectedLog <- Gtk.listStoreGetValue store $ Gtk.listStoreIterToIndex treeIter+ selectedBranch <- get combo+ Common.runVcs cfg $ doCheckoutFn selectedLog selectedBranch++ setupLogColumns :: LogGUI -> Bool -> IO ()+ setupLogColumns gui displayBranchNames = do+ let item = (logTreeView gui)+ addTextColumnToTreeView item "Subject" (\Common.LogEntry { Common.subject = t } -> [Gtk.cellText Gtk.:= t])+ addTextColumnToTreeView item "Author" (\Common.LogEntry { Common.author = t, Common.email = mail } -> [Gtk.cellText Gtk.:= (t ++ " <" ++ mail ++ ">")])+ addTextColumnToTreeView item "Date" (\Common.LogEntry { Common.date = t } -> [Gtk.cellText Gtk.:= t])+ case displayBranchNames of+ True -> addTextColumnToTreeView item "Branch" (\Common.LogEntry { Common.mbBranch = t } -> [Gtk.cellText Gtk.:= (fromMaybe "" t)])+ False -> return()+ return ()++guiAddBranches :: LogGUI -> (String, [String]) -> (String -> Common.Ctx [Common.LogEntry]) -> Common.Ctx ()+guiAddBranches gui (curBranch, otherBranches) changeBranchFn = do+ -- set branch selection visible+ liftIO $ Gtk.set (getItem $ lblBranch gui) [Gtk.widgetVisible Gtk.:= True]+ liftIO $ Gtk.set (getItem $ comboBranch gui) [Gtk.widgetVisible Gtk.:= True]++ -- fill with data+ liftIO $ set (comboBranch gui) otherBranches+ liftIO $ Gtk.comboBoxPrependText (getItem $ comboBranch gui) curBranch+ liftIO $ Gtk.comboBoxSetActive (getItem $ comboBranch gui) 0++ -- register branch switch fn+ config <- ask+ liftIO $ Gtk.on (getItem $ comboBranch gui) Gtk.changed $ changeBranchFn' config (fmap (fromMaybe "") $ get $ comboBranch gui)+ return ()+ where+ changeBranchFn' :: Common.Config -> IO String -> IO ()+ changeBranchFn' cfg branchIO = do+ let (store, view) = getItem $ logTreeView gui+ branch <- branchIO+ newLogEntries <- Common.runVcs cfg $ changeBranchFn branch+ set (logTreeView gui) newLogEntries+ -- set cursor to first log entry (so checkoutbutton works)+ Just firstRowIter <- Gtk.treeModelGetIterFirst store+ firstRow <- Gtk.treeModelGetPath store firstRowIter+ Gtk.treeViewSetCursor view firstRow Nothing+++loadLogGui :: [Common.LogEntry] -> Common.Ctx LogGUI+loadLogGui logEntries = do+ liftIO $ do+ gladepath <- getGladepath+ builder <- openGladeFile gladepath+ win <- getWindowFromGlade builder "logWindow"+ revDetails <- getLabelFromGlade builder "lblRevisionDetails"+ actCheck <- getActionFromGlade builder "actCheckout"+ actCanc <- getActionFromGlade builder "actCancel"+ comboBranch <- getComboBoxFromGlade builder "comboBranch"+ lblBranch <- getLabelFromGlade builder "lblBranch"++ treeView <- getTreeViewFromGlade builder "historyTreeView" logEntries+ return $ LogGUI win treeView revDetails actCheck actCanc comboBranch lblBranch+++++++++++++++++++++++
+ src/VCSGui/Common/MergeTool.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.MergeTool+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Types associated with resolving conflicts with a 'Mergetool'.+--+-----------------------------------------------------------------------------+{-# LANGUAGE DeriveDataTypeable #-}+module VCSGui.Common.MergeTool (+ MergeTool (..)+ , MergeToolSetter++) where+++-- | Representation of a mergetool, e.g. kdiff3+data MergeTool = MergeTool {+ fullPath :: FilePath+ } deriving (Show, Read)++-- | Fn to set a 'MergeTool'.+type MergeToolSetter = MergeTool -> IO()++
+ src/VCSGui/Common/Process.hs view
@@ -0,0 +1,68 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.Process+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Provides facilites to execute an external program.+--+-----------------------------------------------------------------------------++module VCSGui.Common.Process (+ exec+) where++import System.Process+import System.Exit+import System.IO (Handle, hFlush, hClose, hGetContents, hPutStr)+import Control.Concurrent+import Control.Monad.Reader+import qualified Control.Exception as Exc++-- | Internal function to execute a vcs command+exec :: Maybe FilePath -- ^ working directory or Nothing if not set+ -> String -- ^ mergetool command, e.g. kdiff3.sh+ -> [String] -- ^ files, last one is output+ -> IO Bool+exec mcwd cmd opts = do+ (ec, out, err) <- readProc mcwd cmd opts+ case ec of+ ExitSuccess -> return $ True+ ExitFailure i -> return $ False -- Left $ Exception i out err (cmd : opts)++-- | same as readProcessWithExitCode but having a configurable cwd and env,+readProc :: Maybe FilePath --working directory or Nothing if not set+ -> String --command+ -> [String] -- ^ files, last one is output+ -> IO (ExitCode, String, String)+readProc mcwd cmd files = do+ putStrLn $ "Executing process, mcwd: "++show mcwd++"cmd: "++show cmd++",files: "++show files+ (_, Just outh, Just errh, pid) <- createProcess (proc cmd files)+ { std_out = CreatePipe,+ std_err = CreatePipe,+ cwd = mcwd+ }++ outMVar <- newEmptyMVar++ out <- hGetContents outh+ _ <- forkIO $ Exc.evaluate (length out) >> putMVar outMVar ()++ err <- hGetContents errh+ _ <- forkIO $ Exc.evaluate (length err) >> putMVar outMVar ()++-- hClose inh++ takeMVar outMVar+ takeMVar outMVar+ hClose outh+ hClose errh++ ex <- waitForProcess pid+ return (ex, out, err)++
+ src/VCSGui/Common/SetupConfig.hs view
@@ -0,0 +1,337 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Common.SetupConfig+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Module for displaying configuration dialogs.+--+-----------------------------------------------------------------------------++module VCSGui.Common.SetupConfig (+ showSetupConfigGUI+) where+import Graphics.UI.Gtk hiding (set, get)+import Control.Monad.Trans(liftIO)+import Data.Maybe+import Monad+import Directory+import System.Directory(doesDirectoryExist)+import Data.List.Utils(elemRIndex)+import Data.List(isInfixOf)+import Paths_vcsgui(getDataFileName)++import VCSGui.Common.Error+import qualified VCSGui.Common.GtkHelper as H+import qualified VCSGui.Common.MergeTool as MergeTool+import qualified VCSWrapper.Common as Wrapper++type Config = Maybe (Wrapper.VCSType, Wrapper.Config, Maybe MergeTool.MergeTool)+ --config for setting up vcs++type Callback = (Config -> IO ())++getGladepath = getDataFileName "data/guiCommonSetupRepo.glade"++accessorWindowSetupRepo = "windowSetupRepo"+accessorActOk = "actOk"+accessorActCancel = "actCancel"+accessorActBrowseRepo = "actBrowseRepo"+accessorActBrowseExec = "actBrowseExec"+accessorEntRepo = "entRepo"+accessorEntExec = "entExec"+accessorEntAuthor = "entAuthor"+accessorEntEmail = "entEmail"+accessorEntComboBoxVCSType = "comboBoxVCSType"+accessorCheckbtExec = "checkbtExec"+accessorCheckbtAuthor = "checkbtAuthor"+accessorLblExec = "lblExec"+accessorBtnBrowseExec = "btnBrowseExec"+accessorLblAuthor = "lblAuthor"+accessorLblEmail = "lblEmail"+accessorActBrowsePathToTool = "actBrowsePathToTool"+accessorentPathToTool= "entPathToTool"+++data SetupRepoGUI = SetupRepoGUI {+ winSetupRepo :: H.WindowItem+ , actOk :: H.ActionItem+ , actCancel :: H.ActionItem+ , actBrowseRepo :: H.ActionItem+ , actBrowseExec :: H.ActionItem+ , entRepo :: H.TextEntryItem+ , entExec :: H.TextEntryItem+ , entAuthor :: H.TextEntryItem+ , entEmail :: H.TextEntryItem+ , comboBoxVCSType :: H.ComboBoxItem+ , checkbtExec :: H.CheckButtonItem+ , checkbtAuthor :: H.CheckButtonItem+ , lblExec :: H.LabelItem+ , btnBrowseExec :: H.ButtonItem+ , lblAuthor :: H.LabelItem+ , lblEmail :: H.LabelItem+ , entPathToTool :: H.TextEntryItem+ , actBrowsePathToTool :: H.ActionItem+}+++{- | Displays a window to setup a repo. Window will be initially filled with content given config+ is not Nothing. Given callback will be called on successful completition.+-}+showSetupConfigGUI :: Config+ -- ^ maybe a tuple (vcstype,config, mbmergetool), which will be used to fill out the form+ -> Callback -- ^ callback, called when dialog is closed+ -> IO ()+showSetupConfigGUI mbConfig callback = loadAndOpenWindow+ (loadSetupRepoGui)+ (connectSetupRepoGui callback)+ winSetupRepo+ (initSetupRepoGui mbConfig)+++loadSetupRepoGui :: IO SetupRepoGUI+loadSetupRepoGui = loadGuiTemplate $ \builder -> do+ winSetupRepo <- H.getWindowFromGlade builder accessorWindowSetupRepo+ actOk <- H.getActionFromGlade builder accessorActOk+ actCancel <- H.getActionFromGlade builder accessorActCancel+ actBrowseRepo <- H.getActionFromGlade builder accessorActBrowseRepo+ actBrowseExec <- H.getActionFromGlade builder accessorActBrowseExec+ entRepo <- H.getTextEntryFromGlade builder accessorEntRepo+ entExec <- H.getTextEntryFromGlade builder accessorEntExec+ entAuthor <- H.getTextEntryFromGlade builder accessorEntAuthor+ entEmail <- H.getTextEntryFromGlade builder accessorEntEmail+ comboBoxVCSType <- H.getComboBoxFromGlade builder accessorEntComboBoxVCSType+ checkbtExec <- H.getCheckButtonFromGlade builder accessorCheckbtExec+ H.set checkbtExec True+ checkbtAuthor <- H.getCheckButtonFromGlade builder accessorCheckbtAuthor+ H.set checkbtAuthor True+ lblExec <- H.getLabelFromGlade builder accessorLblExec+ btnBrowseExec <- H.getButtonFromGlade builder accessorBtnBrowseExec+ lblAuthor <- H.getLabelFromGlade builder accessorLblAuthor+ lblEmail <- H.getLabelFromGlade builder accessorLblEmail+ entPathToTool <- H.getTextEntryFromGlade builder accessorentPathToTool+ actBrowsePathToTool <- liftIO $ H.getActionFromGlade builder accessorActBrowsePathToTool+ return $ SetupRepoGUI winSetupRepo actOk actCancel actBrowseRepo actBrowseExec entRepo entExec entAuthor entEmail comboBoxVCSType checkbtExec checkbtAuthor lblExec btnBrowseExec lblAuthor lblEmail entPathToTool actBrowsePathToTool++connectSetupRepoGui :: Callback+ -> SetupRepoGUI+ -> IO ()+connectSetupRepoGui callback gui = do+ H.registerClose $ winSetupRepo gui+ liftIO $ H.registerCloseAction (actCancel gui) (winSetupRepo gui)++ on (H.getItem (actOk gui)) actionActivated $+ do mbConfig <- createVCSTypAndConfig gui+ case mbConfig of+ Left errorMsg -> showErrorGUI errorMsg+ Right tuple -> do+ callback $ Just tuple+ H.closeWin $ winSetupRepo gui++ on (H.getItem (actBrowseRepo gui)) actionActivated $ liftIO $ do+ mbPath <- showFolderChooserDialog "Choose repository location" (H.getItem $ winSetupRepo gui) FileChooserActionSelectFolder+ case mbPath of+ Nothing -> return ()+ Just path -> do+ -- discover vcs+ availableVCS <- discoverVCS path+ H.set (comboBoxVCSType gui) $ map (\vcs -> show vcs) availableVCS+ -- update gui+ H.set (entRepo gui) path+ return ()+ on (H.getItem (actBrowseExec gui)) actionActivated $ liftIO $ do+ mbExec <- showFolderChooserDialog "Choose executable location" (H.getItem $ winSetupRepo gui) FileChooserActionOpen+ case mbExec of+ Nothing -> return ()+ Just exec -> do+ H.set (entExec gui) exec+ H.set (checkbtExec gui) True+ return ()++ on (H.getItem (checkbtExec gui)) toggled $ do+ putStrLn "checkbtnexec toogled"+ active <- H.get (checkbtExec gui)+ if active then do+ widgetShowAll (H.getItem (lblExec gui))+ widgetShowAll (H.getItem (entExec gui))+ widgetShowAll (H.getItem (btnBrowseExec gui))+ else do+ widgetHideAll (H.getItem (lblExec gui))+ widgetHideAll (H.getItem (entExec gui))+ widgetHideAll (H.getItem (btnBrowseExec gui))++ on (H.getItem (checkbtAuthor gui)) toggled $ do+ putStrLn "checkbtnauthor toogled"+ active <- H.get (checkbtAuthor gui)+ if active then do+ widgetShowAll (H.getItem (lblAuthor gui))+ widgetShowAll (H.getItem (entAuthor gui))+ widgetShowAll (H.getItem (lblEmail gui))+ widgetShowAll (H.getItem (entEmail gui))+ else do+ widgetHideAll (H.getItem (lblAuthor gui))+ widgetHideAll (H.getItem (entAuthor gui))+ widgetHideAll (H.getItem (lblEmail gui))+ widgetHideAll (H.getItem (entEmail gui))+ return ()+ liftIO $ on (H.getItem (actBrowsePathToTool gui)) actionActivated $ do+ mbPath <- showFolderChooserDialog "Select executable" (H.getItem $ winSetupRepo gui) FileChooserActionOpen+ case mbPath of+ Nothing -> return ()+ Just path -> do+ -- update gui+ H.set (entPathToTool gui) path+ return ()+ return ()++ where+ createVCSTypAndConfig :: SetupRepoGUI -> IO (Either String (Wrapper.VCSType, Wrapper.Config, Maybe MergeTool.MergeTool))+ createVCSTypAndConfig gui = do+ path <- H.get (entRepo gui)+++ btExec <- H.get (checkbtExec gui)+ exec <- if btExec then+ H.get (entExec gui)+ else+ return Nothing+ btAuthor <- H.get (checkbtAuthor gui)+ (author,mail) <- if btAuthor then do+ a <- H.get (entAuthor gui)+ m <- H.get (entEmail gui)+ return (a,m)+ else+ return (Nothing,Nothing)+ selectedVCSType <- H.get (comboBoxVCSType gui)+ mbPathToTool <- H.get (entPathToTool gui)+ let tuple = createVCSTypAndConfig' path author mail exec selectedVCSType mbPathToTool+ putStrLn $ "tuple"++show tuple+ return tuple+ where+ createVCSTypAndConfig' Nothing _ _ _ _ _ = Left "You have to set path and type of VCS. Missing path."+ createVCSTypAndConfig' _ _ _ _ Nothing _ = Left "You have to set path and type of VCS. Missing vcs type."+ createVCSTypAndConfig' _ Nothing (Just _) _ _ _ = Left "If you provide an email you have to provide author as well"+ createVCSTypAndConfig' mbPath@(Just path) authorName email executable (Just vcsType) mbPathToTool= Right $+ (read vcsType,+ Wrapper.makeConfig mbPath+ executable+ $ author authorName,+ mergeTool mbPathToTool)+ where+ author (Just name) = (Just (Wrapper.Author name email))+ author Nothing = Nothing+ mergeTool (Just path) = Just $ MergeTool.MergeTool path+ mergeTool Nothing = Nothing+++initSetupRepoGui :: Config+ -> SetupRepoGUI+ -> IO ()+initSetupRepoGui mbConfig gui = do+ case mbConfig of+ Nothing -> return ()+ Just (vcsType, Wrapper.Config mbPath mbExec mbAuthor _, mbMergeTool) -> do+ case mbPath of+ Nothing -> return ()+ Just path -> do+ H.set (entRepo gui) $ path+ availableVCS <- discoverVCS path+ H.set (comboBoxVCSType gui) $ map (\vcs -> show vcs) availableVCS+ if isInfixOf [vcsType] availableVCS+ then do+ --get position (hopefully always index in liststore = index in list)+ let index = elemRIndex vcsType availableVCS++ --set active+ comboBoxSetActive (H.getItem (comboBoxVCSType gui)) $ fromMaybe (-1) index+ else do+ return ()+ case mbExec of+ Nothing -> do+ H.set (checkbtExec gui) False+ return ()+ Just exec -> do+ H.set (checkbtExec gui) True+ H.set (entExec gui) $ exec++ case mbAuthor of+ Nothing -> do+ H.set (checkbtAuthor gui) False+ return ()+ Just (Wrapper.Author author email) -> do+ H.set (checkbtAuthor gui) True+ H.set (entAuthor gui) author+ H.set (entEmail gui) $ fromMaybe "" email+ case mbMergeTool of+ Nothing -> return()+ Just mergeTool -> H.set (entPathToTool gui) (MergeTool.fullPath mergeTool)++ return ()++discoverVCS :: FilePath -- ^ path to root+ -> IO [Wrapper.VCSType] -- ^ vcs discovered+discoverVCS path = do+ exists <- doesDirectoryExist path+ putStrLn $ "Path "++ show exists ++ " Starting discovery."+ case exists of+ True -> do+ content <- getDirectoryContents path+ let vcsFiles = map vcsMapping $ filter vcsFilter content+ putStrLn $ "Available vcs: "++ show vcsFiles+ return vcsFiles+ False -> do+ return []+ where+ vcsFilter :: FilePath -> Bool+ vcsFilter path = case path of+ ".git" -> True+ ".svn" -> True+ ".hg" -> True+ _ -> False+ vcsMapping :: FilePath -> Wrapper.VCSType+ vcsMapping path = case path of+ ".git" -> Wrapper.GIT+ ".svn" -> Wrapper.SVN+ ".hg" -> Wrapper.Mercurial+ _ -> Wrapper.SVN --TODO throw error on this, improve this code++-- | shows a dialog to choose a folder, returns Just FilePath to folder if succesfull, Nothing if cancelled+showFolderChooserDialog :: String -- ^ title of the window+ -> Window -- ^ parent window+ -> FileChooserAction+ -> IO (Maybe FilePath)+showFolderChooserDialog title parent fcAction = do+ dialog <- fileChooserDialogNew (Just title) (Just parent) fcAction [("Cancel", ResponseCancel), ("Select", ResponseAccept)]+ response <- dialogRun dialog+ case response of+ ResponseCancel -> widgetDestroy dialog >> return Nothing+ ResponseDeleteEvent -> widgetDestroy dialog >> return Nothing+ ResponseAccept -> do+ f <- fileChooserGetFilename dialog+ widgetDestroy dialog+ return f++++loadAndOpenWindow :: IO SetupRepoGUI -- ^ load gui fn+ -> (SetupRepoGUI -> IO ()) -- ^ connect gui fn+ -> (SetupRepoGUI -> H.WindowItem) -- ^ get WindowItem from gui+ -> (SetupRepoGUI -> IO ()) -- ^ init gui+ -> IO ()+loadAndOpenWindow loadGui connectGui getWindow initRepo = do+ gui <- loadGui+ connectGui gui+ widgetShowAll $ H.getItem (getWindow gui)+ initRepo gui+ return ()+++loadGuiTemplate :: (Builder -> IO a) -> IO a+loadGuiTemplate builderFn = do+ gladepath <- getGladepath+ builder <- H.openGladeFile gladepath+ builderFn builder
+ src/VCSGui/Git.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Git+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Exports all modules needed to build the Git GUI component.+--+-----------------------------------------------------------------------------++module VCSGui.Git (+ module VCSGui.Git.Commit+ , module VCSGui.Git.Log+ , module VCSGui.Git.Helpers+ , module VCSGui.Common+ , module VCSGui.Git.Pull+) where++import VCSGui.Git.Commit+import VCSGui.Git.Log+import VCSGui.Common+import VCSGui.Git.Helpers+import VCSGui.Git.Pull+++
+ src/VCSGui/Git/Commit.hs view
@@ -0,0 +1,76 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Git.Commit+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Every function related to commiting changes to the Git repository is found in this module.+--+-----------------------------------------------------------------------------++module VCSGui.Git.Commit (+ showCommitGUI+) where++import Control.Monad.Trans(liftIO)+import Control.Monad.Reader(ask)++import Graphics.UI.Gtk++import VCSGui.Common.GtkHelper+import qualified VCSGui.Common.Commit as Commit++import qualified VCSWrapper.Git as Git+import qualified VCSWrapper.Common as Wrapper+++doCommit :: String -> [FilePath] -> [Commit.Option] -> Wrapper.Ctx ()+doCommit commitMsg files _ = do+ Git.add files+ (Wrapper.Config _ _ mbAuthor _) <- ask+ case mbAuthor of+ Nothing -> Git.commit files Nothing commitMsg []+ Just (Wrapper.Author author mbEmail) -> do+ case mbEmail of+ Nothing -> Git.commit files (Just (author, "noEmailSet@noEmailSet")) commitMsg []+ Just m -> Git.commit files (Just (author, m)) commitMsg []++{- | Calls 'Commit.showCommitGUI' with a 'Graphics.UI.Gtk.ListStore' and 'OkCallBack' setup for Git.+ This will display a window to enter a commit message and select the files to be commited by this commit.+-}+showCommitGUI :: Git.Ctx ()+showCommitGUI = do+ Commit.showCommitGUI setupListStore doCommit++setupListStore :: TreeView -> Wrapper.Ctx (ListStore Commit.SCFile)+setupListStore view = do+ repoStatus <- Git.status+ --GITSCFile Bool FilePath String+ let selectedF = [Commit.GITSCFile True fp (show mod) | (Wrapper.GITStatus fp mod) <- repoStatus, mod == Wrapper.Modified || mod == Wrapper.Added]+ notSelectedF = [Commit.GITSCFile False fp (show mod) | (Wrapper.GITStatus fp mod) <- repoStatus, mod /= Wrapper.Modified && mod /= Wrapper.Added]++ liftIO $ do+ store <- listStoreNew (selectedF ++ notSelectedF)+ treeViewSetModel view store+ let item = (store, view)++ toggleRenderer <- cellRendererToggleNew+ addColumnToTreeView' item toggleRenderer "Commit" (\(Commit.GITSCFile s _ _)-> [cellToggleActive := s])+ addTextColumnToTreeView' item "File" (\(Commit.GITSCFile _ p _) -> [cellText := p])+ addTextColumnToTreeView' item "File status" (\(Commit.GITSCFile _ _ m) -> [cellText := m])++ -- register toggle renderer+ on toggleRenderer cellToggled $ \filepath -> do+ putStrLn ("toggle called: " ++ filepath)++ Just treeIter <- treeModelGetIterFromString store filepath+ value <- listStoreGetValue store $ listStoreIterToIndex treeIter+ let newValue = (\(Commit.GITSCFile b fp m) -> Commit.GITSCFile (not b) fp m) value+ listStoreSetValue store (listStoreIterToIndex treeIter) newValue+ return ()+ return store+
+ src/VCSGui/Git/Helpers.hs view
@@ -0,0 +1,35 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Git.Helpers+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Misc helper functions.+--+-----------------------------------------------------------------------------++module VCSGui.Git.Helpers (+ askPassWrapper+) where++import VCSWrapper.Git+import Control.Monad.Reader.Class (asks, MonadReader(..))+import System.Environment (getEnvironment)+import Control.Monad.Reader (liftIO)+++{- | Adds a wrapper to the 'Ctx' so git can ask for a password using a GUI window.+ This is acomplished by setting the GIT_ASKPASS environment variable.+ This is only tested on linux and may not work on MS Windows.+-}+askPassWrapper :: Ctx () -> Ctx ()+askPassWrapper fn = do+ cfgEnv <- asks configEnvironment+ inheritEnv <- liftIO $ getEnvironment+ -- TODO better solution for DISPLAY? TODO will this work on windows?+ local (\cfg -> cfg {configEnvironment = ("GIT_ASKPASS", "vcsgui-askpass"):("DISPLAY", ":0.0"):inheritEnv ++ cfgEnv}) fn+
+ src/VCSGui/Git/Log.hs view
@@ -0,0 +1,83 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Git.Log+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Every function related to displaying the history of a Git repository is found in this module.+--+-----------------------------------------------------------------------------++module VCSGui.Git.Log (+ showLogGUI+) where++import qualified Graphics.UI.Gtk as Gtk+import qualified VCSGui.Common.Log as Common+import qualified VCSWrapper.Git as Git+import Control.Monad.Reader (liftIO)+import Data.Maybe (fromMaybe)+import VCSGui.Common.Helpers (emptyListToNothing)+++{- | Calls 'Common.showLogGUI' using Git. This will display all log entries. The branch to be displayed can be selected.+ Any commit can be checked out, creating a new branch if the commit is not already the HEAD of any branch.+ -}+showLogGUI :: Git.Ctx ()+showLogGUI = do+ log <- Git.simpleLog Nothing+ branches <- Git.localBranches+ Common.showLogGUI log [] (Just (branches, \branch -> Git.simpleLog (Just branch))) checkout False+ where+ checkout log Nothing = Git.checkout (Just $ Git.commitID log) Nothing+ checkout log (Just selBranch) = do+ revBranch <- Git.revparse selBranch+ case ((Git.commitID log) == revBranch) of+ True -> do+ liftIO $ putStrLn "checking out selected Branch"+ Git.checkout (Just selBranch) Nothing+ False -> do+ liftIO $ putStrLn $ "checking out Commit " ++ (Git.commitID log) ++ ", asking for new branchname"+ mbBranchname <- liftIO $ askForNewBranchname+ Git.checkout (Just $ Git.commitID log) (mbBranchname)++ askForNewBranchname :: IO (Maybe String)+ askForNewBranchname = do+ dialog <- Gtk.dialogNew+ Gtk.dialogAddButton dialog "gtk-ok" Gtk.ResponseOk+ upper <- Gtk.dialogGetUpper dialog++ inputBranch <- Gtk.entryNew+ lblBranch <- Gtk.labelNew $ Just "Enter a new branchname (empty for anonym branch):"+ box <- Gtk.hBoxNew False 2+ Gtk.containerAdd upper box+ Gtk.containerAdd box lblBranch+ Gtk.containerAdd box inputBranch++ Gtk.widgetShowAll dialog+ _ <- Gtk.dialogRun dialog+ branchname <- Gtk.entryGetText inputBranch+ Gtk.widgetDestroy dialog+ return $ emptyListToNothing branchname++++++++++++++++++
+ src/VCSGui/Git/Pull.hs view
@@ -0,0 +1,33 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Git.Pull+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Every function related to pulling changes from another Git repository is found in this module.+--+-----------------------------------------------------------------------------++module VCSGui.Git.Pull (+ pull+) where++import Control.Monad.Trans(liftIO)++import qualified VCSWrapper.Git as Git+import qualified VCSWrapper.Common as Wrapper++import VCSGui.Common.Error+++-- | Call 'Git.pull'. If the pull fails or a merge conflict is detected an error message is shown.+pull :: Git.Ctx ()+pull = do+ o <- Git.pull+ case o of+ Right () -> return ()+ Left msg -> liftIO $ showErrorGUI $ "MERGE CONFLICT " ++ msg
+ src/VCSGui/Mercurial.hs view
@@ -0,0 +1,26 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Mercurial+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL Nothing+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module VCSGui.Mercurial (+ module VCSGui.Mercurial.Commit+ , module VCSGui.Mercurial.Log+ , module VCSGui.Common+) where++import VCSGui.Mercurial.Commit+import VCSGui.Mercurial.Log+import VCSGui.Common+++
+ src/VCSGui/Mercurial/Commit.hs view
@@ -0,0 +1,70 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Mercurial.Commit+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL Nothing+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module VCSGui.Mercurial.Commit (+ showCommitGUI+) where++import Control.Monad.Trans(liftIO)+import Control.Monad.Reader(ask)++import Graphics.UI.Gtk++import VCSGui.Common.GtkHelper+import qualified VCSGui.Common.Commit as Commit++import qualified VCSWrapper.Mercurial as Mercurial+import qualified VCSWrapper.Common as Wrapper++doCommit :: String -> [FilePath] -> [Commit.Option] -> Wrapper.Ctx ()+doCommit commitMsg files _ = do+ Mercurial.addremove files+ Mercurial.commit files commitMsg []++{- |+ Calls 'Commit.showCommitGUI' with a 'Graphics.UI.Gtk.ListStore' and 'OkCallBack' setup for Mercurial.+ This will display a window to enter a commit message and select the files to be commited by this commit.+-}+showCommitGUI :: Mercurial.Ctx ()+showCommitGUI = do+ Commit.showCommitGUI setupListStore doCommit++--TODO this is copy&pasted from git implementation refactor it and use abstract version+setupListStore :: TreeView -> Wrapper.Ctx (ListStore Commit.SCFile)+setupListStore view = do+ repoStatus <- Mercurial.status+ --GITSCFile Bool FilePath String+ let selectedF = [Commit.GITSCFile True fp (show mod) | (Wrapper.GITStatus fp mod) <- repoStatus, mod == Wrapper.Modified || mod == Wrapper.Added]+ notSelectedF = [Commit.GITSCFile False fp (show mod) | (Wrapper.GITStatus fp mod) <- repoStatus, mod /= Wrapper.Modified && mod /= Wrapper.Added]++ liftIO $ do+ store <- listStoreNew (selectedF ++ notSelectedF)+ treeViewSetModel view store+ let item = (store, view)++ toggleRenderer <- cellRendererToggleNew+ addColumnToTreeView' item toggleRenderer "Commit" (\(Commit.GITSCFile s _ _)-> [cellToggleActive := s])+ addTextColumnToTreeView' item "File" (\(Commit.GITSCFile _ p _) -> [cellText := p])+ addTextColumnToTreeView' item "File status" (\(Commit.GITSCFile _ _ m) -> [cellText := m])++ -- register toggle renderer+ on toggleRenderer cellToggled $ \filepath -> do+ putStrLn ("toggle called: " ++ filepath)++ Just treeIter <- treeModelGetIterFromString store filepath+ value <- listStoreGetValue store $ listStoreIterToIndex treeIter+ let newValue = (\(Commit.GITSCFile b fp m) -> Commit.GITSCFile (not b) fp m) value+ listStoreSetValue store (listStoreIterToIndex treeIter) newValue+ return ()+ return store
+ src/VCSGui/Mercurial/Log.hs view
@@ -0,0 +1,34 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Mercurial.Log+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL Nothing+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module VCSGui.Mercurial.Log (+ showLogGUI+) where++import qualified Graphics.UI.Gtk as Gtk+import qualified VCSGui.Common.Log as Common+import qualified VCSWrapper.Mercurial as Mercurial+import Control.Monad.Reader (liftIO)+import Data.Maybe (fromMaybe)++{- | Calls 'Common.showLogGUI' using hg. This will display all log entries. The branch to be displayed can be selected.+ Any commit can be checked out, creating a new branch if the commit is not already the HEAD of any branch.+ -}+showLogGUI :: Mercurial.Ctx ()+showLogGUI = do+ log <- Mercurial.simpleLog Nothing+ liftIO $ putStrLn $ "Received log"++show log+ Common.showLogGUI log [] Nothing checkout True+ where+ checkout logEntry Nothing = Mercurial.update (Just $ Mercurial.commitID logEntry)
+ src/VCSGui/Svn.hs view
@@ -0,0 +1,30 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Svn+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Exports all available SVN GUIs such as @checkout@, @log@ and others.+--+-----------------------------------------------------------------------------++module VCSGui.Svn (+ module VCSGui.Svn.Checkout+ , module VCSGui.Svn.Commit+ , module VCSGui.Svn.Log+ , module VCSGui.Common+ , module VCSGui.Svn.AskPassword+ , module VCSGui.Svn.Update+) where++import VCSGui.Svn.AskPassword+import VCSGui.Svn.Checkout+import VCSGui.Svn.Commit+import VCSGui.Svn.Log+import VCSGui.Svn.Update+import VCSGui.Common+
+ src/VCSGui/Svn/AskPassword.hs view
@@ -0,0 +1,132 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Svn.AskPassword+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+-- TODO this should be moved into Common Package+-- | Provides a GUI asking a user for a password.+--+-----------------------------------------------------------------------------++module VCSGui.Svn.AskPassword (+ showAskpassGUI+ ,Handler+) where++import qualified VCSGui.Common.GtkHelper as H+import qualified VCSGui.Common as VCSGUI++import qualified VCSWrapper.Common as Wrapper++import Graphics.UI.Gtk++import Data.Maybe (fromMaybe)+import Control.Monad.Trans(liftIO)+import Paths_vcsgui(getDataFileName)+import Control.Monad.Reader(ask)+--+-- glade path and object accessors+--+getGladepath = getDataFileName "data/guiSvnAskpass.glade"+accessorWindow = "windowAskpass"+accessorActOk = "actOk"+accessorActCancel = "actCancel"+accessorEntryPw = "entryPw"+accessorCheckbtUsePw = "checkbtUsePw"+accessorCheckbtSaveForSession = "checkbtSaveForSession"+accessorboxUsePwd = "boxUsePwd"++{- |+ 'Handler' is a function used as an argument to the 'showAskpassGUI'. It represents a VCS+ command running in a 'Wrapper.Ctx' expecting password data which can be the followingAxis+ * Nothing, if GUI is closed or cancel button is pressed+ * Just (savePasswordSettingForSession, Maybe password)+ where savePasswordSettingForSession indicates if password-settings should be saved for current+ session. Maybe password is either:+ * Nothing, no password given+ * Just password, password has been provided+-}+type Handler = ((Maybe (Bool, Maybe String))+ -> Wrapper.Ctx())++data AskpassGUI = AskpassGUI {+ windowAskpass :: H.WindowItem+ ,actOk :: H.ActionItem+ ,actCancel :: H.ActionItem+ ,entryPw :: H.TextEntryItem+ ,checkbtUsePw :: H.CheckButtonItem+ ,checkbtSaveForSession :: H.CheckButtonItem+ ,boxUsePwd :: VBox+}++-- | Shows a GUI asking the user for a password. 'Handler' will be called with result.+showAskpassGUI :: Handler -- ^ 'Handler' to be called when GUI is closed passing the result.+ -> Wrapper.Ctx ()+showAskpassGUI handler = do+ config <- ask+ liftIO $ do+ gui <- loadAskpassGUI++ -- connect actions+ registerClose (windowAskpass gui) handler config+ registerCloseAction (actCancel gui) (windowAskpass gui) handler config+ on (H.getItem (actOk gui)) actionActivated $ do+ putStrLn "ok clicked"+ usePw <- H.get $ checkbtUsePw gui+ pw <- H.get (entryPw gui)+ saveForSession <- H.get $ checkbtSaveForSession gui++ let args = if usePw then Just (saveForSession, Just $ fromMaybe "" pw)+ else Just (saveForSession, Nothing)+ VCSGUI.defaultVCSExceptionHandler $ Wrapper.runVcs config $ handler args+ H.closeWin (windowAskpass gui)+ on (H.getItem (checkbtUsePw gui)) toggled $ do+ active <- get (H.getItem (checkbtUsePw gui)) toggleButtonActive+ if active then+ widgetShowAll (boxUsePwd gui)+ else+ widgetHideAll (boxUsePwd gui)+ -- present window+ widgetShowAll $ H.getItem $ windowAskpass gui+ return ()++registerClose :: H.WindowItem+ -> Handler+ -> Wrapper.Config+ -> IO()+registerClose win handler config = on (H.getItem win) deleteEvent (liftIO (close win handler config) >> return False) >> return ()++registerCloseAction :: H.ActionItem+ -> H.WindowItem+ -> Handler+ -> Wrapper.Config+ -> IO()+registerCloseAction act win handler config = on (H.getItem act) actionActivated (liftIO (close win handler config)) >> return ()++close :: H.WindowItem+ -> Handler+ -> Wrapper.Config+ -> IO()+close win handler config = do+ liftIO $ H.closeWin win+ VCSGUI.defaultVCSExceptionHandler $ Wrapper.runVcs config $ handler Nothing++loadAskpassGUI :: IO AskpassGUI+loadAskpassGUI = do+ gladepath <- getGladepath+ builder <- H.openGladeFile gladepath++ windowAskpass <- H.getWindowFromGlade builder accessorWindow+ actOk <- H.getActionFromGlade builder accessorActOk+ actCancel <- H.getActionFromGlade builder accessorActCancel+ entryPw <- H.getTextEntryFromGlade builder accessorEntryPw+ checkbtUsePw <- H.getCheckButtonFromGlade builder accessorCheckbtUsePw+ set (H.getItem checkbtUsePw) [toggleButtonActive := True]+ checkbtSaveForSession <- H.getCheckButtonFromGlade builder accessorCheckbtSaveForSession+ set (H.getItem checkbtSaveForSession) [toggleButtonActive := True]+ boxUsePw <- builderGetObject builder castToVBox accessorboxUsePwd+ return $ AskpassGUI windowAskpass actOk actCancel entryPw checkbtUsePw checkbtSaveForSession boxUsePw
+ src/VCSGui/Svn/Checkout.hs view
@@ -0,0 +1,88 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Svn.Checkout+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Provides a GUI for checking out a working copy of a SVN repository.+--+-----------------------------------------------------------------------------++module VCSGui.Svn.Checkout (+ showCheckoutGUI+) where++import Graphics.UI.Gtk+import Control.Monad.Trans(liftIO)+import Control.Monad+import Control.Monad.Reader+import qualified VCSWrapper.Svn as Svn+import qualified VCSGui.Common.GtkHelper as H+import Paths_vcsgui(getDataFileName)+import Maybe+--+-- glade path and object accessors+--++getGladepath = getDataFileName "data/guiSvnCheckout.glade"+accessorWindowCheckout = "windowCheckout"+accessorActCheckout = "actCheckout"+accessorActCancel = "actCancel"+accessorActTxtViewUrl = "txtViewUrl"+accessorActTxtViewRevision = "txtViewRevision"+accessorActTxtViewPath = "txtViewPath"++data CheckoutGUI = CheckoutGUI {+ windowCheckout :: H.WindowItem+ ,actCheckout :: H.ActionItem+ ,actCancel :: H.ActionItem+ ,txtViewUrl :: H.TextViewItem+ ,txtViewRevision :: H.TextViewItem+ ,txtViewPath :: H.TextViewItem+ }++-- | Shows a GUI asking user for data to checkout a working copy of a SVN repository.+showCheckoutGUI :: Svn.Ctx()+showCheckoutGUI = do+ config <- ask+ liftIO $ do+ putStrLn "Starting gui ..."+ gui <- loadCheckoutGUI++ -- connect actions+ H.registerClose $ windowCheckout gui+ H.registerCloseAction (actCancel gui) (windowCheckout gui)+ liftIO $ on (H.getItem (actCheckout gui)) actionActivated $ do+ url <- H.get (txtViewUrl gui)+ realRevision <- H.get (txtViewRevision gui)+ realFilePath <- H.get (txtViewPath gui)+ let mbPwd = Nothing+ Svn.runVcs config $ Svn.checkout [(fromMaybe "" url, realRevision)] realFilePath mbPwd [] -- TODO pw handler+ H.closeWin $ windowCheckout gui+++ liftIO $ widgetShowAll $ H.getItem $ windowCheckout gui++ liftIO $ putStrLn "Finished"+ return ()+++loadCheckoutGUI :: IO CheckoutGUI+loadCheckoutGUI = do+ putStrLn $ "Creating builder from gladefile"+ gladepath <- liftIO getGladepath+ builder <- liftIO $ H.openGladeFile gladepath++ putStrLn $ "Creating gtk widgets from builder"+ win <- liftIO $ H.getWindowFromGlade builder accessorWindowCheckout+ actCheckout <- liftIO $ H.getActionFromGlade builder accessorActCheckout+ actCancel <- liftIO $ H.getActionFromGlade builder accessorActCancel+ txtViewUrl <- liftIO $ H.getTextViewFromGlade builder accessorActTxtViewUrl+ txtViewRevision <- liftIO $ H.getTextViewFromGlade builder accessorActTxtViewRevision+ txtViewPath <- liftIO $ H.getTextViewFromGlade builder accessorActTxtViewPath+ return $ CheckoutGUI win actCheckout actCancel txtViewUrl txtViewRevision txtViewPath+
+ src/VCSGui/Svn/Commit.hs view
@@ -0,0 +1,135 @@+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Provides a GUI to commit to a SVN working copy.+--+-----------------------------------------------------------------------------+module VCSGui.Svn.Commit (+ showCommitGUI+) where++import qualified VCSGui.Common.Commit as C+import qualified VCSGui.Common.GtkHelper as H+import qualified VCSGui.Common.FilesInConflict as FiC+import qualified VCSGui.Common.MergeTool as M+import qualified VCSGui.Svn.Helper as SvnH++import VCSGui.Svn.AskPassword+import VCSGui.Common.ExceptionHandler++import qualified VCSWrapper.Svn as Svn++import Graphics.UI.Gtk+import Control.Monad.Trans(liftIO)++{- |+ Shows a GUI showing status of subversion and possibilites to commit/cancel.+-}+showCommitGUI :: Either M.MergeTool M.MergeToolSetter -- ^ 'MergeTool' is used for any possible conflicts. If not present user will be asked to provide 'MergeTool' on conflicts. 'MergeToolSetter' will be called for response.+ -> Either Handler (Maybe String) -- ^ Either 'Handler' for password request or password (nothing for no password)+ -> Svn.Ctx()+showCommitGUI eMergeToolSetter eitherHandlerOrPw = do+ conflictingFiles <- SvnH.getConflictingFiles+ case conflictingFiles of+ [] -> commonCommit+ _ -> FiC.showFilesInConflictGUI+ Nothing+ (conflictingFiles)+ (Svn.getFilesInConflict)+ (\fileToResolve -> Svn.resolved [fileToResolve] Nothing [])+ eMergeToolSetter+ $ commonCommit+ where+ commonCommit = C.showCommitGUI setUpTreeView (okCallback eitherHandlerOrPw)+++okCallback :: Either Handler (Maybe String) -- ^ either callback for password request or password (nothing for no password)+ -> String -- ^ commit message+ -> [FilePath] -- ^ selected files+ -> [C.Option] -- ^ TODO options+ -> Svn.Ctx ()+okCallback eitherHandlerOrPw msg filesToCommit _ = do+ case eitherHandlerOrPw of+ Left handler -> do+ showAskpassGUI (ownHandler handler)+ return ()+ Right pw -> doCommit msg filesToCommit pw++ where+ doCommit msg filesToCommit mbPw = do+ Svn.add filesToCommit mbPw []+ Svn.commit filesToCommit msg mbPw []+ return()+ ownHandler :: Handler+ -> Handler+ ownHandler handler = \result -> do+ case result of+ Nothing -> handler result+ Just (_,mbPw) -> do+ doCommit msg filesToCommit mbPw+ handler result++++setUpTreeView :: TreeView -> Svn.Ctx (ListStore C.SCFile)+setUpTreeView listView = do+ -- get status+ repoStatus <- Svn.status++ --check files for conflicts++ liftIO $ do+ -- create model+ listStore <- listStoreNew [+ (C.SVNSCFile (ctxSelect (Svn.modification status))+ (Svn.filePath status)+ (show (Svn.modification status))+ (Svn.isLocked status))+ | status <- repoStatus]+ treeViewSetModel listView listStore++ let treeViewItem = (listStore, listView)++ renderer <- cellRendererToggleNew+ H.addColumnToTreeView' treeViewItem+ renderer+ ""+ $ \scf -> [cellToggleActive := C.selected scf]++ -- connect select action+ on renderer cellToggled $ \columnId -> do+ Just treeIter <- treeModelGetIterFromString listStore columnId+ value <- listStoreGetValue listStore $ listStoreIterToIndex treeIter+ let newValue = (\(C.SVNSCFile bool fp s l) -> C.SVNSCFile (not bool) fp s l)+ value+ listStoreSetValue listStore (listStoreIterToIndex treeIter) newValue+ return ()++ renderer <- cellRendererTextNew+ H.addColumnToTreeView' treeViewItem+ renderer+ "Files to commit"+ $ \scf -> [cellText := C.filePath scf]++ renderer <- cellRendererTextNew+ H.addColumnToTreeView' treeViewItem+ renderer+ "Status"+ $ \scf -> [cellText := C.status scf]++ renderer <- cellRendererToggleNew+ H.addColumnToTreeView' treeViewItem+ renderer+ "Locked"+ $ \scf -> [cellToggleActive := C.isLocked scf]+ return listStore+ where+ ctxSelect status = status == Svn.Added || status == Svn.Deleted || status==Svn.Modified ||+ status == Svn.Replaced
+ src/VCSGui/Svn/Helper.hs view
@@ -0,0 +1,24 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Svn.Helper+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module VCSGui.Svn.Helper (+ getConflictingFiles+) where++import qualified VCSWrapper.Svn as Svn++getConflictingFiles :: Svn.Ctx [FilePath]+getConflictingFiles = do+ status <- Svn.status+ return [ Svn.filePath s | s <- status, (Svn.modification s) == Svn.Conflicting];
+ src/VCSGui/Svn/Log.hs view
@@ -0,0 +1,58 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Svn.Log+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Provides a GUI to show log for current working copy.+--+-----------------------------------------------------------------------------++module VCSGui.Svn.Log (+ showLogGUI+) where++import qualified VCSGui.Common.Log as C+import VCSGui.Svn.AskPassword++import qualified VCSWrapper.Svn as Svn+import qualified VCSWrapper.Common as WC++-- | Shows a GUI showing log for current working copy.+showLogGUI :: Either Handler (Maybe String) -- ^ Either 'Handler' for password request or password (nothing for no password)+ -> Svn.Ctx ()+showLogGUI eitherHandlerOrPw = do+ logEntries <- Svn.simpleLog+ C.showLogGUI logEntries [] Nothing (okCallback eitherHandlerOrPw) False++okCallback :: Either Handler (Maybe String) -- ^ either callback for password request or password (nothing for no password)+ -> WC.LogEntry -- ^ chosen logentry+ -> Maybe String -- ^ chosen branch name+ -> WC.Ctx()+okCallback eitherHandlerOrPw logEntry _ = do+ case eitherHandlerOrPw of+ Left handler -> do+ showAskpassGUI (ownHandler handler)+ return ()+ Right pw -> doRevert logEntry pw+++ where+ ownHandler :: Handler+ -> Handler+ ownHandler handler = \result -> do+ case result of+ Nothing -> handler result+ Just (_,mbPw) -> do+ doRevert logEntry mbPw+ handler result+ doRevert logEntry mbPw = do+ Svn.mergeHeadToRevision (revision logEntry) mbPw []+ return()+ revision logEntry = read $ Svn.commitID logEntry :: Integer++
+ src/VCSGui/Svn/Update.hs view
@@ -0,0 +1,58 @@+-----------------------------------------------------------------------------+--+-- Module : VCSGui.Svn.Update+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- | Provides facilities to update a SVN working copy.+--+-----------------------------------------------------------------------------++module VCSGui.Svn.Update (+ showUpdateGUI+) where++import qualified VCSGui.Svn.AskPassword as AskPassword+import qualified VCSGui.Svn.Helper as SvnH+import qualified VCSGui.Common.Error as Error+import qualified VCSGui.Common.MergeTool as M+import qualified VCSGui.Common.FilesInConflict as FiC++import qualified VCSWrapper.Svn as Svn+import qualified VCSWrapper.Common as Wrapper++import Control.Monad.Trans(liftIO)++-- | Initiates an update for current SVN working copy.+showUpdateGUI :: Either M.MergeTool M.MergeToolSetter -- ^ 'MergeTool' is used for any possible conflicts. If not present user will be asked to provide 'MergeTool' on conflicts after updating. 'MergeToolSetter' will be called for response.+ -> Either AskPassword.Handler (Maybe String) -- ^ If a password is provided it will be used, if not a GUI will be shown to ask for password and given @Handler@ will be called.+ -> Wrapper.Ctx()+showUpdateGUI eMergeToolSetter (Left handler) = do+ AskPassword.showAskpassGUI $ ownHandler eMergeToolSetter handler+ return ()+showUpdateGUI eMergeToolSetter (Right mbPwd) = do+ Svn.update mbPwd []+ conflictingFiles <- SvnH.getConflictingFiles+ case conflictingFiles of+ [] -> return ()+ _ -> FiC.showFilesInConflictGUI+ Nothing+ (conflictingFiles)+ (Svn.getFilesInConflict)+ (\fileToResolve -> Svn.resolved [fileToResolve] Nothing [])+ eMergeToolSetter+ $ (return ())++ownHandler :: Either M.MergeTool M.MergeToolSetter -- ^ either a mergetool or a setter for it+ -> (AskPassword.Handler+ -> AskPassword.Handler)+ownHandler eMergeToolSetter handler = \result -> do+ case result of+ Nothing -> handler result+ Just (_,mbPw) -> do+ showUpdateGUI eMergeToolSetter $ Right mbPw+ handler result
+ src/exe/askpass/Main.hs view
@@ -0,0 +1,76 @@+-----------------------------------------------------------------------------+--+-- Module : Main+-- Copyright : 2011 Stephan Fortelny, Harald Jagenteufel+-- License : GPL+--+-- Maintainer : stephanfortelny at gmail.com, h.jagenteufel at gmail.com+-- Stability :+-- Portability :+--+-- TODO since this window has to print the entered password to stdout, nothing else must be printed to stdout. can we fix this? (logging)+-- | A simple window to enter a password. Prints the password to stdout (as required for GIT_ASKPASS).+--+-----------------------------------------------------------------------------++module Main (+ main+) where++import Graphics.UI.Gtk+import qualified VCSGui.Common.GtkHelper as H+import Data.Maybe (fromMaybe)++import Paths_vcsgui(getDataFileName)+--+-- glade path and object accessors+--+getGladepath = getDataFileName "data/guiCommonAskpass.glade"+accessorWindow = "windowAskpass"+accessorActOk = "actOk"+accessorActCancel = "actCancel"+accessorEntryPw = "entryPw"+++data AskpassGUI = AskpassGUI {+ window :: H.WindowItem+ ,actOk :: H.ActionItem+ ,actCancel :: H.ActionItem+ ,entryPw :: H.TextEntryItem+}+++main :: IO ()+main = do+ initGUI+ showAskpassGUI+ mainGUI+++showAskpassGUI :: IO ()+showAskpassGUI = do+ gui <- loadCommitGUI++ -- connect actions+ H.registerQuit $ window gui+ H.registerQuitAction $ actCancel gui+ on (H.getItem (actOk gui)) actionActivated $ do+ pw <- H.get (entryPw gui)+ putStr $ fromMaybe "" pw+ mainQuit+ -- present window+ widgetShowAll $ H.getItem $ window gui+ return ()+++loadCommitGUI :: IO AskpassGUI+loadCommitGUI = do+ gladepath <- getGladepath+ builder <- H.openGladeFile gladepath++ win <- H.getWindowFromGlade builder accessorWindow+ actOk <- H.getActionFromGlade builder accessorActOk+ actCancel <- H.getActionFromGlade builder accessorActCancel+ entryPw <- H.getTextEntryFromGlade builder accessorEntryPw+ return $ AskpassGUI win actOk actCancel entryPw+
+ vcsgui.cabal view
@@ -0,0 +1,98 @@+name: vcsgui+version: 0.0.1+cabal-version: >= 1.8+build-type: Simple+license: GPL+license-file: LICENSE+copyright: 2011 Stephan Fortelny, Harald Jagenteufel+maintainer: stephanfortelny at gmail.com, h.jagenteufel at gmail.com+homepage: https://github.com/forste/haskellVCSGUI+bug-reports: https://github.com/forste/haskellVCSGUI/issues+synopsis: GUI library for source code management systems+description:+ Provides library functions to expose some commonly needed scm tasks to the user.+ Uses GTK+ and GTKBuilder to organize and display windows.+ Uses vcswrapper to acces the scm functions.+ Currently git and SVN are supported.+category: Development+author: Stephan Fortelny, Harald Jagenteufel+tested-with: GHC == 7.0+data-files: LICENSE+ data/guiCommonCommit.glade+ data/guiCommonLog.glade+ data/guiCommonSetupRepo.glade+ data/guiSvnCheckout.glade+ data/guiCommonAskpass.glade+ data/guiSvnAskpass.glade+ data/guiCommonFilesInConflict.glade+ data/guiCommonMergeTool.glade+ data/guiCommonConflictsResolved.glade+data-dir: ""+library+ build-depends: MissingH >=1.1.0.3 && <1.2,+ filepath >=1.2.0.0 && < 1.3,+ base >=4.0.0.0 && <4.4,+ directory >=1.1.0.0 && <1.2,+ haskell98 >=1.1.0.1 && <1.2,+ mtl >=2.0.1.0 && <2.1,+ vcswrapper ==0.0.1,+ process >=1.0.1.5 && <1.1,+ gtk >=0.12.0 && <0.13+ exposed-modules: VCSGui.Common VCSGui.Git VCSGui.Svn VCSGui.Mercurial+ exposed: True+ buildable: True+ hs-source-dirs: src+ other-modules: VCSGui.Svn.Helper VCSGui.Common.Process+ VCSGui.Common.ConflictsResolved VCSGui.Common.MergeTool+ VCSGui.Common.FilesInConflict VCSGui.Git.Pull VCSGui.Svn.Update+ VCSGui.Svn.AskPassword VCSGui VCSGui.Svn.Log VCSGui.Svn.Checkout+ VCSGui.Svn.Commit VCSGui.Git.Log VCSGui.Git.Helpers+ VCSGui.Git.Commit VCSGui.Common.Log+ VCSGui.Common.GtkHelper VCSGui.Common.ExceptionHandler+ VCSGui.Common.SetupConfig VCSGui.Common.Error VCSGui.Common.Commit+ VCSGui.Mercurial.Commit VCSGui.Mercurial.Log+ VCSGui.Common.Helpers+ Paths_vcsgui++executable vcsgui+ main-is: Main.hs+ build-depends: MissingH >=1.1.0.3 && <1.2,+ filepath >=1.2.0.0 && < 1.3,+ base >=4.0.0.0 && <4.4,+ directory >=1.1.0.0 && <1.2,+ haskell98 >=1.1.0.1 && <1.2,+ mtl >=2.0.1.0 && <2.1,+ vcswrapper ==0.0.1,+ process >=1.0.1.5 && <1.1,+ gtk >=0.12.0 && <0.13+ buildable: True+ hs-source-dirs: src+ other-modules: VCSGui.Svn.Helper VCSGui.Common.Process+ VCSGui.Common.ConflictsResolved VCSGui.Common.MergeTool+ VCSGui.Common.FilesInConflict VCSGui.Git.Pull VCSGui.Svn.Update+ VCSGui.Svn.AskPassword VCSGui VCSGui.Svn.Log VCSGui.Svn.Checkout+ VCSGui.Svn.Commit VCSGui.Git.Log VCSGui.Git.Helpers+ VCSGui.Git.Commit VCSGui.Common.Log+ VCSGui.Common.GtkHelper VCSGui.Common.ExceptionHandler+ VCSGui.Common.SetupConfig VCSGui.Common.Error VCSGui.Common.Commit+ VCSGui.Common.Helpers+ Paths_vcsgui++executable vcsgui-askpass+ main-is: Main.hs+ build-depends: MissingH >=1.1.0.3 && <1.2,+ filepath >=1.2.0.0 && < 1.3,+ base >=4.0.0.0 && <4.4,+ directory >=1.1.0.0 && <1.2,+ haskell98 >=1.1.0.1 && <1.2,+ mtl >=2.0.1.0 && <2.1,+ vcswrapper ==0.0.1,+ process >=1.0.1.5 && <1.1,+ gtk >=0.12.0 && <0.13+ buildable: True+ hs-source-dirs: src/exe/askpass src+ other-modules: VCSGui.Svn.Helper VCSGui.Common.Process+ VCSGui.Common.ConflictsResolved VCSGui.Common.MergeTool+ VCSGui.Common.FilesInConflict VCSGui.Git.Pull VCSGui.Svn.Update+ VCSGui.Svn.AskPassword Paths_vcsgui VCSGui.Common.GtkHelper+ VCSGui.Common.Helpers