packages feed

yi 0.10.1 → 0.19.3

raw patch · 714 files changed

Files

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

binary file changed (197 → absent bytes)

− art/dependencies.png

binary file changed (215 → absent bytes)

− art/exposed-file-module.png

binary file changed (213 → absent bytes)

− art/exposed-module.png

binary file changed (254 → absent bytes)

− art/h-source.png

binary file changed (201 → absent bytes)

− art/hidden-file-module.png

binary file changed (229 → absent bytes)

− art/hidden-module.png

binary file changed (216 → absent bytes)

− art/hs-source-folder.png

binary file changed (208 → absent bytes)

− art/license-file.png

binary file changed (214 → absent bytes)

− art/package.png

binary file changed (194 → absent bytes)

− art/plain-folder.png

binary file changed (190 → absent bytes)

− art/project.png

binary file changed (261 → absent bytes)

− art/setup-script.png

binary file changed (245 → absent bytes)

− art/text-file.png

binary file changed (183 → absent bytes)

− art/yi+lambda-fat-128.png

binary file changed (22701 → absent bytes)

− art/yi+lambda-fat-16.png

binary file changed (1483 → absent bytes)

+ art/yi+lambda-fat-16.xpm view
@@ -0,0 +1,278 @@+/* XPM */+static char *yi_lambda_fat_16[] = {+/* columns rows colors chars-per-pixel */+"16 16 256 2 ",+"   c None",+".  c #ABABB2B2EFEF",+"X  c #ABABB2B2EFEF",+"o  c #ABD9B2E2F030",+"O  c #A9F1B0E5ED85",+"+  c #A966B055ECC2",+"@  c #ADF7B516F324",+"#  c #BC60C416FFFF",+"$  c black",+"%  c black",+"&  c black",+"*  c black",+"=  c black",+"-  c black",+";  c black",+":  c black",+">  c #ABABB2B2EFEF",+",  c #ABABB2B2EFEF",+"<  c #ABABB2B2EFEF",+"1  c #ACC2B3D4F174",+"2  c #9AE6A13DD87E",+"3  c #545857CC75E2",+"4  c #86808C01BBFC",+"5  c #8E68943CC709",+"6  c black",+"7  c black",+"8  c black",+"9  c black",+"0  c black",+"q  c black",+"w  c black",+"e  c black",+"r  c #ABABB2B2EFEF",+"t  c #ABABB2B2EFEF",+"y  c #ABA7B2AFEFEE",+"u  c #AF15B608F302",+"i  c #D1CAD89CFFFF",+"p  c #47B34AA063D1",+"a  c #6C287096972E",+"s  c #792E7E24A95F",+"d  c #148D15641CB9",+"f  c black",+"g  c black",+"h  c black",+"j  c black",+"k  c black",+"l  c black",+"z  c black",+"x  c black",+"c  c black",+"v  c black",+"b  c black",+"n  c black",+"m  c #12B313771A23",+"M  c #309F329C43F5",+"N  c #38D63B2A4F70",+"B  c #3A253C875144",+"V  c #002500270034",+"C  c black",+"Z  c black",+"A  c black",+"S  c black",+"D  c black",+"F  c black",+"G  c black",+"H  c black",+"J  c black",+"K  c black",+"L  c black",+"P  c #000E000F0014",+"I  c black",+"U  c #2FFD31F44312",+"Y  c #521A557672C0",+"T  c #27842922373A",+"R  c #39C13C1F50B9",+"E  c black",+"W  c black",+"Q  c black",+"!  c black",+"~  c black",+"^  c black",+"/  c black",+"(  c black",+")  c black",+"_  c black",+"`  c #00400043005A",+"'  c #072E077A0A09",+"]  c #4668494A6268",+"[  c #704374DB9CE7",+"{  c #369538D14C49",+"}  c black",+"|  c black",+" . c black",+".. c black",+"X. c black",+"o. c black",+"O. c black",+"+. c black",+"@. c black",+"#. c black",+"$. c black",+"%. c #0DF90E8B1387",+"&. c #3D033F825546",+"*. c #3F3441CA5856",+"=. c #5B335EEF7F77",+"-. c #52D9563D73CB",+";. c #14FF15DB1D58",+":. c black",+">. c black",+",. c black",+"<. c black",+"1. c black",+"2. c black",+"3. c black",+"4. c black",+"5. c black",+"6. c black",+"7. c #1D521E8528FA",+"8. c #85ED8B69BB2F",+"9. c #37C43A0D4DF1",+"0. c #76167AECA50B",+"q. c #B0CDB80AF718",+"w. c #5C986062811F",+"e. c black",+"r. c black",+"t. c black",+"y. c black",+"u. c black",+"i. c black",+"p. c black",+"a. c black",+"s. c black",+"d. c #0641068208BE",+"f. c #4F9352D56F38",+"g. c #8A218FC8C10E",+"h. c #1BC81CEB26D3",+"j. c #307A327643C1",+"k. c #563659BE787F",+"l. c #69826DD49377",+"z. c #00720076009F",+"x. c black",+"c. c black",+"v. c black",+"b. c black",+"n. c black",+"m. c black",+"M. c black",+"N. c black",+"B. c #084D08A40B99",+"V. c #3B2C3D9852B3",+"C. c #3B403DAD52D0",+"Z. c black",+"A. c #1FC621132C69",+"S. c #8E67943BC708",+"D. c #5A1A5DCA7DEE",+"F. c black",+"G. c #04DE051106CE",+"H. c black",+"J. c black",+"K. c black",+"L. c black",+"P. c black",+"I. c black",+"U. c #1BC31CE626CC",+"Y. c #52A656087384",+"T. c #235E24D0316E",+"R. c #1BB11CD326B3",+"E. c black",+"W. c #0FF6109E164F",+"Q. c #5DD261A98321",+"!. c #29FB2BB33AAC",+"~. c #39BD3C1A50B3",+"^. c #2B5A2D203C97",+"/. c #333735504795",+"(. c black",+"). c black",+"_. c black",+"`. c black",+"'. c black",+"]. c #5AD55E8D7EF4",+"[. c #555458D27742",+"{. c #0D4A0DD61293",+"}. c black",+"|. c black",+" X c black",+".X c #0EB70F511491",+"XX c #75CA7A9DA4A1",+"oX c #AD75B48FF26F",+"OX c #9FECA678DF85",+"+X c black",+"@X c black",+"#X c black",+"$X c black",+"%X c black",+"&X c #12C013851A35",+"*X c #50BC540970D6",+"=X c #6C5570C49769",+"-X c #0D720DFF12CB",+";X c black",+":X c black",+">X c black",+",X c #055D0595077E",+"<X c #56CB5A59794F",+"1X c #A9D6B0CAED5C",+"2X c #7FFE853BB1E3",+"3X c black",+"4X c #00C400CC00E6",+"5X c black",+"6X c black",+"7X c #2B152CD83C36",+"8X c #7EF08423B16B",+"9X c #80228561B317",+"0X c #442D46F75F49",+"qX c black",+"wX c black",+"eX c black",+"rX c black",+"tX c black",+"yX c #0A900AFF0EC3",+"uX c #4B924EAA69A0",+"iX c #4C914FB46B04",+"pX c black",+"aX c #03B203D8052A",+"sX c #ABB0B2B7EFF5",+"dX c #B527BC92FBB3",+"fX c #AEAEB5D4F413",+"gX c #AE54B577F3A7",+"hX c #857A8AF1BA8E",+"jX c #057A05B307A7",+"kX c black",+"lX c black",+"zX c black",+"xX c black",+"cX c #48E74BE265E4",+"vX c #3ED4416757D0",+"bX c #31C933D34595",+"nX c #0B060B790F68",+"mX c #295E2B0F39D1",+"MX c #AE63B586F3BC",+"NX c #ABB8B2C0F002",+"BX c #ABABB2B2EFEF",+"VX c #ABADB2B4EFF1",+"CX c #ABBDB2C5F00B",+"ZX c #AD71B480F178",+"AX c black",+"SX c black",+"DX c black",+"FX c black",+"GX c black",+"HX c #C734CE49FD7F",+"JX c gray100",+"KX c #9C8BA2EBD9CB",+"LX c #720276AD9F5E",+"PX c #71F876A39F4A",+"IX c #AB6DB271EF98",+"UX c #ABCFB2D7F021",+/* pixels */+"  . X o O + @ # $ % & * = - ; : ",+"> , < 1 2 3 4 5 6 7 8 9 0 q w e ",+"r t y u i p a s d f g h j k l z ",+"x c v b n m M N B V C Z A S D F ",+"G H J K L P I U Y T R E W Q ! ~ ",+"^ / ( ) _ ` ' ] [ { } |  ...X.o.",+"O.+.@.#.$.%.&.*.=.-.;.:.>.,.<.1.",+"2.3.4.5.6.7.8.9.0.q.w.e.r.t.y.u.",+"i.p.a.s.d.f.g.h.j.k.l.z.x.c.v.b.",+"n.m.M.N.B.V.C.Z.A.S.D.F.G.H.J.K.",+"L.P.I.U.Y.T.R.E.W.Q.!.~.^./.(.).",+"_.`.'.].[.{.}.|. X.XXXoXOX+X@X#X",+"$X%X&X*X=X-X;X:X>X,X<X1X2X3X4X5X",+"6X7X8X9X0XqXwXeXrXtXyXuXiXpXaXsX",+"dXfXgXhXjXkXlXzXxXcXvXbXnXmXMXNX",+"BXVXCXZXAXSXDXFXGXHXJXKXLXPXIXUX"+};
− art/yi+lambda-fat-32.png

binary file changed (3857 → absent bytes)

+ art/yi+lambda-fat-32.xpm view
@@ -0,0 +1,201 @@+/* XPM */+static char *yi_lambda_fat_32[] = {+/* columns rows colors chars-per-pixel */+"32 32 163 2 ",+"   c #000200020003",+".  c #00700075009D",+"X  c #00D700E0012C",+"o  c #011C0128018E",+"O  c #017D018C0214",+"+  c #01B401C50261",+"@  c #0219022F02EE",+"#  c #02F703160425",+"$  c #03B403DB052E",+"%  c #0438046405E6",+"&  c #04F8052C06F2",+"*  c #05AC05E807EE",+"=  c #06280669089B",+"-  c #066706AA08F2",+";  c #06BB07010968",+":  c #06EE073709B0",+">  c #07D308250AEF",+",  c #086008B80BB5",+"<  c #08BE091A0C38",+"1  c #0B7F0BF81011",+"2  c #0CA70D2B11AF",+"3  c #0D5D0DE912AE",+"4  c #0DEF0E81137A",+"5  c #0E760F0D1436",+"6  c #0FA6104A15DF",+"7  c #102110CA168B",+"8  c #10C21172176C",+"9  c #114C1202182D",+"0  c #135E14291B11",+"q  c #1458152D1C6E",+"w  c #150315DF1D5E",+"e  c #156116411DCE",+"r  c #16DE17CD1FF6",+"t  c #1788187E20E3",+"y  c #18A119A3226D",+"u  c #18F919FE22E6",+"i  c #19941AA023C0",+"p  c #1A621B7724E0",+"a  c #1AA31BBB253B",+"s  c #1B211C3E25EB",+"d  c #1BFE1D23271F",+"f  c #1D491E7C28EE",+"g  c #1E731FB32A8F",+"h  c #1F0020452B55",+"j  c #1F8A20D42C15",+"k  c #1FF621452CAC",+"l  c #20DE22362DEF",+"z  c #220E23732F99",+"x  c #23A5251B31D3",+"c  c #265D27EF359E",+"v  c #284029E63843",+"b  c #29DD2B943A83",+"n  c #2D122EEA3EFE",+"m  c #2EAA30934138",+"M  c #2F4531344210",+"N  c #3090328D43E0",+"B  c #30C032BF4423",+"V  c #313E334244DA",+"C  c #3356357047C0",+"Z  c #349E36C6498B",+"A  c #355737864A8D",+"S  c #36DE391E4CB0",+"D  c #375A399E4D5D",+"F  c #38EF3B444F93",+"G  c #3A883CED51CE",+"H  c #3BD63E4953A1",+"J  c #3CF93F785539",+"K  c #3E3B40C756FA",+"L  c #3F2041B5583C",+"P  c #40A343495A58",+"I  c #4543481960CE",+"U  c #4555482B60E7",+"Y  c #45FA48D861CE",+"T  c #46A7498B62BF",+"R  c #46E249C96312",+"E  c #48694B606534",+"W  c #48E04BDC65DB",+"Q  c #498D4C9066CD",+"!  c #49FF4D06676C",+"~  c #4AC04DCF6879",+"^  c #4BA94EC269C0",+"/  c #4F1552526E87",+"(  c #4FC453086F7C",+")  c #54ED586776B2",+"_  c #55A8592977B7",+"`  c #56C75A547949",+"'  c #574F5AE27A08",+"]  c #59E65D937D8A",+"[  c #5A275DD87E01",+"{  c #5AA25E587EAD",+"}  c #5B105ECA7F46",+"|  c #5BDE5FA08066",+" . c #5CAE60798188",+".. c #5DA7617D82E6",+"X. c #5E6F624C83FC",+"o. c #606C645F86C4",+"O. c #613A653487E3",+"+. c #677A6BB790A0",+"@. c #67EE6C2F9142",+"#. c #6BEB705696D5",+"$. c #6E2872AB99F7",+"%. c #6F9174239BF0",+"&. c #703774CF9CD6",+"*. c #716B76109E86",+"=. c #727A77299FFF",+"-. c #7289773AA023",+";. c #73B37870A1B5",+":. c #73F878B7A216",+">. c #756B7A39A41C",+",. c #76A67B81A5D4",+"<. c #78CB7DBCA8D4",+"1. c #79997E93A9F4",+"2. c #7AE37FE9ABB0",+"3. c #7B108019AC00",+"4. c #7E7483A1B0BC",+"5. c #808A85CDB3A8",+"6. c #8153869EB4C1",+"7. c #83AD8911B80A",+"8. c #86628BE2BBD2",+"9. c #87518CDBBCF9",+"0. c #87B28D40BD7C",+"q. c #890A8EA6BF88",+"w. c #8A71901BC17E",+"e. c #8B4790FAC2A9",+"r. c #8F399516C82D",+"t. c #90859670C9FD",+"y. c #928F988FCCD7",+"u. c #92F098F4CD5E",+"i. c #9372997BCE14",+"p. c #96549C7BD21B",+"a. c #96F49D22D2FC",+"s. c #97B19DE7D403",+"d. c #98A79EE7D55B",+"f. c #993E9F84D62E",+"g. c #9BC1A221D9B0",+"h. c #9BF9A25CD9FF",+"j. c #9C97A300DADC",+"k. c #9DF0A467DCBE",+"l. c #9EF6A577DE2C",+"z. c #9F36A5BBDE94",+"x. c #A081A713E055",+"c. c #A092A724E06C",+"v. c #A0E3A779E0DD",+"b. c #A1BAA858E209",+"n. c #A209A8ABE278",+"m. c #A3F1AAA7E522",+"M. c #A4B5AB73E635",+"N. c #A527ABE9E6D3",+"B. c #A62DACFAE842",+"V. c #A79CAE79EA43",+"C. c #A8C4AFACEBE0",+"Z. c #A986B077ECF0",+"A. c #ABAEB2B6EFF4",+"S. c #AC17B323F086",+"D. c #AC6DB37CF0FA",+"F. c #ACD4B3E7F18E",+"G. c #ADEBB50AF314",+"H. c #AEB5B5DCF42B",+"J. c #AF09B634F4A5",+"K. c #AF17B642F4B7",+"L. c #AF55B682F50E",+"P. c #B09EB7D2F591",+"I. c None",+/* pixels */+"I.I.I.I.I.I.I.I.A.A.A.A.A.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.A.A.D.D.H.H.A.A.I.I.I.    I.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.A.A.A.D.p.} 4.N.D.A.I.I.    I.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.A.A.A.A.I.I.p.m : P v.H...    I.I.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.A.I.I.I.I.I.I.I.C 4 e.v.R I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.I.I.I.=.v.k.6.D       I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.I.I.I.o.! v 9 >       I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.            9 o.7.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.I.I.I.I.# 9 2.=.H I.I.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.I.I.I.I.  $ p l m s I.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.I.        p 8.v.A.I.I.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.I.I.I.I.w v r.2.` m   I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.I.I.I.w w 4 f 0 0 u 6   I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.        > R X.( ;.y.p.h.f.I.I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.I.I.I.H.k.c s $.A.D.H.I.      I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.I.  6 @.D.`   z v.H.H.I.I.      I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.  4 Z %.D.I.  h w.2.+.>.I.I.    I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.      =.D.H.h.I.  - w 4 u E I.I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.I.: H -.! w       P q.h.v.R I.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.I.# ,   f l I.I.I.  D H.L.8.4   I.I.I.I.I.I.I.I.I.",+"I.I.I.I.        s Z - } I.I.I.I.  , t.m.F   - I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.    R h.u.9 w I.  I.I.I.  R ~   x 2.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.P.k.#.4     I.I.I.I.  $ $ A u.H.I.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.I.I.~ l u -   I.I.I.I.I.    u u.L.A.A.I.I.I.I.I.I.I.I.",+"I.I.I.I.I.  $ s } 5.6   I.I.I.        # ( C.S.A.I.I.I.I.I.I.I.I.",+"I.        u ..f.H.0.    I.I.    I.I.I.  - | C.A.H.I.  I.I.I.I.I.",+"I.I.  - E u.x.N.L.I.  I.I.I.I.I.I.I.I.I.  - ) m.L.K   I.I.I.I.I.",+"I.I.I.,.A.H.;.N C     I.I.I.I.I.I.I.I.I.I.  $ m } w   I.I.I.I.I.",+"I.I.I.H.A.A.V.)       I.I.I.I.I.I.I.I.I.I.I.d         I.I.I.I.I.",+"I.I.A.A.A.A.S.m.      I.I.I.I.I.I.I.I.I.I.I.0.L >   - >.L.A.A.A.",+"I.A.A.A.A.A.A.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.B.3.K l 4.H.A.I.I.",+"A.A.A.A.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.I.H.Z.h.V.I.I.I.I."+};
− art/yi+lambda-fat-64.png

binary file changed (10133 → absent bytes)

− art/yi+lambda-fat.pdf

binary file changed (6346 → absent bytes)

+ art/yi+lambda-fat.svg view
@@ -0,0 +1,18 @@+<?xml version="1.0" encoding="UTF-8" standalone="no"?>+<!-- Created with Inkscape (http://www.inkscape.org/) -->+<svg xmlns:dc="http://purl.org/dc/elements/1.1/" xmlns:cc="http://web.resource.org/cc/" xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#" xmlns:svg="http://www.w3.org/2000/svg" xmlns="http://www.w3.org/2000/svg" xmlns:sodipodi="http://sodipodi.sourceforge.net/DTD/sodipodi-0.dtd" xmlns:inkscape="http://www.inkscape.org/namespaces/inkscape" width="256" height="256" id="svg2" sodipodi:version="0.32" inkscape:version="0.45.1" sodipodi:docbase="/home/jp/project/yi/art" sodipodi:docname="yi+lambda-fat.svg" inkscape:output_extension="org.inkscape.output.svg.inkscape" inkscape:export-filename="/home/jp/haskell/repo/yi/art/yi+lambda-fat.png" inkscape:export-xdpi="90" inkscape:export-ydpi="90" version="1.0">+  <defs id="defs4"/>+  <sodipodi:namedview id="base" pagecolor="#ffffff" bordercolor="#666666" borderopacity="1.0" gridtolerance="10000" guidetolerance="10" objecttolerance="10" inkscape:pageopacity="0.0" inkscape:pageshadow="2" inkscape:zoom="1" inkscape:cx="288.27285" inkscape:cy="118.31968" inkscape:document-units="px" inkscape:current-layer="layer1" inkscape:window-width="836" inkscape:window-height="1022" inkscape:window-x="23" inkscape:window-y="0"/>+  <metadata id="metadata7">+    <rdf:RDF>+      <cc:Work rdf:about="">+        <dc:format>image/svg+xml</dc:format>+        <dc:type rdf:resource="http://purl.org/dc/dcmitype/StillImage"/>+      </cc:Work>+    </rdf:RDF>+  </metadata>+  <g inkscape:label="Layer 1" inkscape:groupmode="layer" id="layer1" transform="translate(-38.68,-33.62108)">+    <path style="font-size:526.49438477px;font-style:normal;font-variant:normal;font-weight:normal;font-stretch:normal;text-align:start;line-height:125%;writing-mode:lr-tb;text-anchor:start;fill:#abb2ef;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;font-family:GentiumAlt" d="M 294.68,269.1876 C 282.75057,275.50039 272.88914,280.48416 265.09566,284.13893 C 257.46076,287.79369 250.93949,289.62107 245.53182,289.62108 C 241.39616,289.62107 237.57883,288.9012 234.07981,287.46144 C 230.58039,286.13243 227.1607,283.69592 223.82073,280.1519 C 220.63943,276.60789 217.37879,271.79024 214.03881,265.69895 C 210.69846,259.60769 206.88113,251.79978 202.58681,242.2752 C 198.45119,232.7507 193.75905,221.3434 188.51038,208.05327 C 183.2614,194.65253 177.21729,178.98134 170.37804,161.03964 C 169.10546,157.828 167.83302,154.67161 166.56071,151.57046 C 165.44719,148.46958 164.25427,145.47932 162.98196,142.59967 C 156.93772,153.67486 151.05266,164.63916 145.32678,175.49259 C 139.60067,186.34625 133.87468,197.36592 128.14878,208.55164 C 122.42268,219.73751 116.61716,231.25557 110.73219,243.10583 C 105.00612,254.84543 99.2006,267.1941 93.3156,280.1519 C 90.13444,280.70566 86.39663,281.42554 82.10218,282.31154 C 77.9667,283.08679 73.6722,283.91742 69.21867,284.80343 C 64.76509,285.80018 60.4706,286.68619 56.33518,287.46144 C 52.19971,288.34744 48.70049,289.06732 45.83751,289.62108 L 38.68,284.13893 C 46.47371,277.2724 54.10838,269.40911 61.58401,260.54905 C 69.05959,251.68903 76.29661,242.27524 83.2951,232.30765 C 90.45255,222.34016 97.29193,212.04036 103.81327,201.40823 C 110.33448,190.66552 116.37859,180.08884 121.94561,169.67818 C 127.67152,159.26776 132.92035,149.18947 137.69212,139.44328 C 142.46368,129.69738 146.59911,120.72658 150.09845,112.53088 C 144.84951,101.12375 140.07784,91.98684 135.78345,85.12011 C 131.64791,78.14303 127.75104,72.827 124.09286,69.17202 C 120.59355,65.40672 117.17386,62.97021 113.83378,61.86249 C 110.65259,60.64445 107.39195,60.03532 104.05186,60.0351 C 98.48484,60.03532 92.75884,60.9767 86.87385,62.85924 C 81.1478,64.74222 74.38795,67.78786 66.59426,71.99616 L 60.86826,63.52374 C 68.821,57.87569 75.9785,53.16879 82.34077,49.40304 C 88.86199,45.52701 94.66751,42.426 99.75735,40.09999 C 105.00612,37.77447 109.61872,36.11322 113.59519,35.11622 C 117.73056,34.11971 121.46836,33.62133 124.80861,33.62108 C 128.46679,33.62133 131.88649,34.06433 135.0677,34.95009 C 138.2487,35.72559 141.42982,37.55297 144.61103,40.43225 C 147.95109,43.20125 151.37078,47.29902 154.87012,52.72556 C 158.36922,58.04181 162.34561,65.29597 166.79929,74.48805 C 171.25271,83.5698 176.26295,94.86635 181.83005,108.37774 C 187.5559,121.77871 194.07717,137.94829 201.39389,156.8865 C 207.75594,173.27769 213.80004,188.28438 219.52623,201.90661 C 225.25204,215.529 230.73945,227.21317 235.98848,236.95917 C 241.23711,246.70526 246.24735,254.29167 251.01923,259.71842 C 255.79068,265.03446 260.40329,267.69248 264.85707,267.69246 C 266.76551,267.69248 268.51511,267.6371 270.1059,267.52633 C 271.69622,267.30486 273.44584,266.97261 275.35474,266.52958 C 277.42222,266.0866 279.72852,265.47747 282.27366,264.7022 C 284.97735,263.92696 288.31752,262.9302 292.29416,261.71193 L 294.68,269.1876 L 294.68,269.1876" id="text2198"/>+    <path style="font-size:320.01187134px;font-style:normal;font-variant:normal;font-weight:bold;font-stretch:normal;text-align:start;line-height:125%;writing-mode:lr-tb;text-anchor:start;fill:#000000;fill-opacity:1;stroke:none;stroke-width:1px;stroke-linecap:butt;stroke-linejoin:miter;stroke-opacity:1;font-family:AR PL ZenKai Uni" d="M 116.9321,56.73222 C 116.85129,54.95877 117.09346,53.74947 117.6586,53.10429 C 119.51513,52.45955 123.55126,53.30606 129.76699,55.64385 C 137.19335,58.38513 141.26984,61.16653 141.99646,63.98806 C 144.09512,71.00222 143.57043,75.03323 140.42236,76.08111 C 140.01864,76.24253 139.61502,76.32315 139.21153,76.32297 C 137.19335,76.56502 135.13493,75.67819 133.03625,73.6625 C 130.13014,70.59911 125.81148,66.36654 120.08028,60.96479 C 118.38502,59.4332 117.33563,58.02234 116.9321,56.73222 M 175.41559,43.42986 C 174.85039,41.65643 175.53652,40.64866 177.47402,40.40658 C 179.4112,39.92309 181.95396,40.7696 185.1023,42.94613 C 192.69005,47.5417 195.63642,51.16961 193.94142,53.82988 C 193.45692,54.63629 192.48824,55.28125 191.03541,55.76477 L 159.31144,73.42064 C 157.61614,73.58206 156.88964,73.17896 157.13193,72.21133 C 157.29325,71.80842 157.61614,71.28438 158.1006,70.63923 C 166.89922,59.67506 171.78293,53.42698 172.75175,51.895 C 175.01183,48.50915 175.89978,45.68744 175.41559,43.42986 M 158.1006,106.31375 C 158.26192,106.15266 158.58481,106.07204 159.06928,106.07189 C 172.79196,101.23483 181.9136,100.3077 186.43422,103.29048 C 189.42079,104.49995 190.79308,105.83018 190.55107,107.28119 C 189.58224,108.97438 188.3714,109.74027 186.91856,109.57888 C 171.82329,111.51392 161.89443,113.24725 157.13193,114.77889 C 156.48602,119.45501 156.08241,124.73565 155.9211,130.6208 L 179.16919,125.42078 C 188.12923,122.35735 196.56473,123.56664 204.47571,129.0487 C 206.65504,130.66123 207.54299,132.19303 207.13956,133.64406 C 206.81648,134.93412 205.12132,135.74032 202.05403,136.06267 L 201.5697,136.06267 C 166.45525,136.0628 135.86143,140.01319 109.78816,147.91387 C 102.84595,149.60701 97.39718,148.72019 93.44184,145.2534 C 91.26227,143.07677 91.50444,141.74653 94.16834,141.26269 L 144.78138,132.55569 C 145.02343,132.4752 145.2656,132.4752 145.50789,132.55569 C 145.18488,127.15425 145.02343,122.03487 145.02355,117.19751 C 135.33674,119.21315 129.76689,120.26122 128.31398,120.3417 C 122.90548,120.90618 118.86935,120.01936 116.2056,117.68123 C 113.38023,115.74648 113.78384,114.41625 117.41644,113.69052 C 131.78495,111.4333 140.90659,110.06275 144.78138,109.57888 C 144.05477,100.79142 143.69151,96.15575 143.69163,95.67186 L 125.28689,98.57419 C 115.11576,99.70305 107.8911,98.89684 103.61288,96.15559 C 99.6574,93.41466 100.46463,91.68132 106.03456,90.95557 C 124.19703,89.26272 142.88429,85.95728 162.09637,81.03926 C 180.25879,75.23478 191.39849,72.85648 195.51551,73.90435 C 199.79363,75.19447 202.53819,76.68594 203.7492,78.37878 C 204.39481,79.74952 203.9912,80.95882 202.53837,82.00671 C 201.16591,83.21619 195.79787,84.86891 186.43422,86.96486 L 154.58917,93.49511 C 157.97939,95.75265 159.19023,99.78367 158.22169,105.58817 C 158.22156,105.83018 158.18119,106.07204 158.1006,106.31375 M 174.93126,180.32326 C 176.22267,185.64428 180.86421,195.72182 188.85589,210.55591 L 198.17935,200.51867 C 203.66831,194.14973 206.6954,188.42568 207.26064,183.34653 C 207.26046,181.49234 207.98696,180.56521 209.44015,180.56512 C 213.55681,180.56521 217.35077,182.74196 220.82202,187.09538 C 223.32423,190.23965 224.49471,193.02104 224.33346,195.43959 C 224.0911,196.56834 217.06824,202.73578 203.26487,213.94197 C 199.71291,216.84434 197.04906,218.94047 195.27334,220.23035 C 201.89242,228.85676 205.80745,233.7343 207.01847,234.86296 C 219.20739,247.92347 228.773,254.45371 235.71534,254.45371 C 238.05608,254.61495 240.27595,251.47076 242.37494,245.02112 C 246.16869,234.05678 248.46928,228.17149 249.27672,227.36526 C 249.51867,227.04281 249.8012,226.88158 250.12431,226.88154 C 251.17348,227.28467 251.73854,228.53428 251.81949,230.63038 C 253.19155,253.44596 254.68491,267.07079 256.29959,271.50492 C 257.51019,277.14833 255.85539,280.2119 251.33515,280.69564 C 249.96265,280.29252 248.71145,280.05066 247.58155,279.97006 C 223.92965,272.95607 203.18398,255.34054 185.34446,227.12339 C 165.80947,238.73275 151.52159,243.77152 142.48079,242.23972 C 140.94695,241.59478 140.94695,241.03044 142.48079,240.54669 C 154.66977,234.09709 167.14139,226.68002 179.89569,218.29547 C 173.19557,207.41176 167.90826,195.60089 164.03371,182.8628 C 148.37342,186.00707 136.38613,189.31251 128.07181,192.77911 C 128.95966,197.6164 129.64581,203.13889 130.13024,209.3466 C 143.12646,203.46137 150.4722,201.04277 152.1675,202.09077 C 152.32882,202.17145 152.49026,202.29238 152.65183,202.45356 C 152.81315,204.14664 151.80412,205.51719 149.62473,206.5652 C 146.23427,209.30634 141.1084,212.20868 134.24709,215.27221 C 132.39037,216.15907 131.0988,216.84434 130.37241,217.32802 C 131.17953,234.50019 130.08977,248.81029 127.10315,260.25837 C 124.84282,269.04598 121.61392,274.44755 117.41644,276.46307 C 114.83323,277.75299 112.20975,276.94678 109.54599,274.04446 C 104.86401,267.27234 98.72909,260.33899 91.14124,253.2444 C 88.80023,251.06766 88.15446,249.89866 89.20391,249.73741 C 90.09179,249.17309 91.30263,249.2537 92.83642,249.97927 C 105.42906,252.3979 111.96758,253.56689 112.452,253.48626 C 116.81093,249.6165 118.99044,239.29709 118.99053,222.52803 C 98.0026,231.88002 81.29304,240.58702 68.86183,248.64904 C 66.44011,250.18084 64.70458,250.8258 63.65522,250.58393 C 63.49374,250.58393 63.33229,250.54363 63.17089,250.463 C 54.53354,246.19013 49.60948,243.08625 48.39866,241.15134 C 47.83358,240.26454 47.63177,239.17617 47.79324,237.88622 C 47.87394,236.11259 49.12514,235.06454 51.54684,234.74203 L 60.38595,234.13737 C 62.56543,233.7343 64.62386,233.12964 66.56123,232.32341 L 118.62728,213.82104 C 118.38502,207.37145 117.90068,201.60711 117.17427,196.52796 L 95.01593,204.26752 C 84.92555,207.25052 77.01475,206.96835 71.2835,203.42101 C 68.70033,201.64741 67.65095,199.91408 68.13532,198.22099 C 68.29672,197.17299 68.98287,196.4474 70.19374,196.04423 L 106.51889,189.1512 C 109.3441,188.58692 112.25011,187.98228 115.23693,187.33724 C 112.73444,179.51714 111.16036,175.20395 110.51466,174.39767 C 92.10986,180.52489 82.34244,183.58847 81.21237,183.58839 C 80.4051,183.26599 80.32438,182.5404 80.97021,181.41164 C 106.47845,168.83495 119.2326,159.80547 119.2327,154.3232 C 119.31333,153.03337 119.71694,152.14655 120.44354,151.66272 C 125.20606,150.776 131.30061,153.07368 138.72719,158.55576 C 140.98731,160.97447 141.22948,162.70781 139.4537,163.75578 C 138.8078,164.15897 137.83914,164.40083 136.54768,164.48136 C 133.07651,165.20704 126.05365,167.86751 115.4791,172.46277 C 118.95008,174.80085 122.2597,178.83187 125.40797,184.55583 L 161.1277,174.39767 C 157.25289,160.93416 153.62037,152.42872 150.23015,148.88131 C 149.09992,146.22096 149.58425,144.407 151.68316,143.43943 C 153.45893,142.63335 157.6565,143.80235 164.27588,146.94642 C 169.36126,149.44576 172.26727,151.78375 172.99391,153.9604 C 173.31666,155.00857 173.2763,157.5078 172.87283,161.4581 C 172.63052,164.76363 172.67088,167.94813 172.99391,171.01161 C 186.31298,166.49696 195.71714,165.24736 201.20644,167.26277 C 204.19301,168.55278 205.68637,170.28612 205.68655,172.46277 C 205.60565,173.4303 204.19301,174.1962 201.44861,174.76045 L 179.0481,179.35582 L 174.93126,180.32326 M 208.47148,151.17899 C 208.06769,149.08298 208.22913,147.75274 208.95581,147.18828 C 210.6508,146.22096 215.05018,146.46282 222.15395,147.91387 C 231.84045,149.84887 237.69283,152.67058 239.71111,156.37901 C 241.64823,160.81323 242.37474,164.2799 241.89061,166.77904 C 241.08317,169.76209 239.1862,171.05201 236.19967,170.64882 C 234.66574,170.40704 233.01093,169.68147 231.23523,168.47206 C 226.55313,164.84425 220.29714,160.41013 212.46724,155.16971 C 210.28755,153.71864 208.95563,152.38841 208.47148,151.17899" id="text2170"/>+  </g>+</svg>
− example-configs/yi-cua.hs 
@@ -1,42 +0,0 @@-import Yi---- Import the desired UI as needed.--- Some are not complied in, so we import none here.---- import Yi.UI.Vty (start)--- import Yi.UI.Pango (start)--myConfig :: Config-myConfig = defaultCuaConfig -- replace with defaultVimConfig or defaultCuaConfig--defaultUIConfig :: UIConfig-defaultUIConfig = configUI myConfig---- Change the below to your needs, following the explanation in comments. See--- module Yi.Config for more information on configuration. Other configuration--- examples can be found in the examples directory. You can also use or copy--- another user configuration, which can be found in modules Yi.Users.*--main :: IO ()-main = yi $ myConfig-  {--   -- Keymap Configuration-   defaultKm = defaultKm myConfig,--   -- UI Configuration-   -- Override the default UI as such:-   startFrontEnd = startFrontEnd myConfig,-                    -- Yi.UI.Vty.start -- for Vty-   -- (can be overridden at the command line)-   -- Options:-   configUI = defaultUIConfig-     {-       configFontSize = Nothing,-                        -- 'Just 10' for specifying the size.-       configTheme = configTheme defaultUIConfig,-                     -- darkBlueTheme  -- Change the color scheme here.--       configWindowFill = ' '-     }-  }
− example-configs/yi-simple.hs 
@@ -1,21 +0,0 @@-import           Yi-import qualified Yi.Rope as R-import           Yi.Keymap.Emacs as Emacs-import           Yi.String (mapLines)--increaseIndent :: BufferM ()-increaseIndent = do-   r <- getSelectRegionB-   r' <- unitWiseRegion Line r -- extend the region to full lines.-   modifyRegionB (mapLines (R.cons ' ')) r'---main :: IO ()-main = yi $ defaultEmacsConfig-  { defaultKm =-      Emacs.mkKeymap $ override Emacs.defKeymap $ \parent _self ->-        parent {-           _eKeymap = (_eKeymap parent) ||> (metaCh '>' ?>>! increaseIndent)-        }-      -- bind M-> to increaseIndent and mix with default Emacs keymap.-  }
− example-configs/yi-vim-colemak.hs 
@@ -1,79 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import qualified Data.Text as T-import           Yi hiding (super)-import qualified Yi.Keymap.Vim as V2-import qualified Yi.Keymap.Vim.Common as V2-import qualified Yi.Keymap.Vim.Utils as V2-import qualified Yi.Mode.Haskell as Haskell-import qualified Yi.Rope as R--main :: IO ()-main = yi $ defaultVimConfig {-    modeTable = myModes ++ modeTable defaultVimConfig,-    defaultKm = myKeymapSet,-    configCheckExternalChangesObsessively = False-}--defaultSearchKeymap :: Keymap-defaultSearchKeymap = do-    Event (KASCII c) [] <- anyEvent-    write . isearchAddE $ T.singleton c--myKeymapSet :: KeymapSet-myKeymapSet = V2.mkKeymapSet $ V2.defVimConfig `override` \super this ->-    let eval = V2.pureEval this-    in super {-          -- Here we can add custom bindings.-          -- See Yi.Keymap.Vim.Common for datatypes and-          -- Yi.Keymap.Vim.Utils for useful functions like mkStringBindingE--          -- In case of conflict, that is if there exist multiple bindings-          -- whose prereq function returns WholeMatch,-          -- the first such binding is used.-          -- So it's important to have custom bindings first.-          V2.vimBindings = myBindings eval ++ V2.vimBindings super-        , V2.vimRelayout = colemakRelayout-        }--myBindings :: (V2.EventString -> EditorM ()) -> [V2.VimBinding]-myBindings eval =-    let nmap x y = V2.mkStringBindingE V2.Normal V2.Drop (x, y, id)-        imap x y = V2.VimBindingE (\evs state -> case V2.vsMode state of-                                    V2.Insert _ ->-                                        fmap (const (y >> return V2.Continue))-                                             (evs `V2.matchesString` x)-                                    _ -> V2.NoMatch)-    in [-         -- Tab traversal-         nmap "<C-h>" previousTabE-       , nmap "<C-l>" nextTabE-       , nmap "<C-l>" nextTabE--         -- Press space to clear incremental search highlight-       , nmap " " (eval ":nohlsearch<CR>")--         -- for times when you don't press shift hard enough-       , nmap ";" (eval ":")--       , nmap "<F3>" (withCurrentBuffer deleteTrailingSpaceB)-       , nmap "<F4>" (withCurrentBuffer moveToSol)-       , nmap "<F1>" (withCurrentBuffer readCurrentWordB >>= printMsg . R.toText)--       , imap "<Home>" (withCurrentBuffer moveToSol)-       , imap "<End>" (withCurrentBuffer moveToEol)-       ]--myModes :: [AnyMode]-myModes = [-         AnyMode Haskell.fastMode {-             -- Disable beautification-             modePrettify = const $ return ()-         }-    ]--colemakRelayout :: Char -> Char-colemakRelayout = V2.relayoutFromTo colemakLayout qwertyLayout-    where-        colemakLayout = concat ["qwfpgjluy;[]", "arstdhneio'\\", "zxcvbkm,./"]-        qwertyLayout = concat ["qwertyuiop[]", "asdfghjkl;'\\", "zxcvbnm,./"]
− example-configs/yi-vim.hs 
@@ -1,70 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--import           Data.Monoid-import qualified Data.Text as T-import           Yi hiding (super)-import qualified Yi.Keymap.Vim as V2-import qualified Yi.Keymap.Vim.Common as V2-import qualified Yi.Keymap.Vim.Utils as V2-import qualified Yi.Mode.Haskell as Haskell-import qualified Yi.Rope as R--main :: IO ()-main = yi $ defaultVimConfig {-    modeTable = myModes ++ modeTable defaultVimConfig,-    defaultKm = myKeymapSet,-    configCheckExternalChangesObsessively = False-}--defaultSearchKeymap :: Keymap-defaultSearchKeymap = do-    Event (KASCII c) [] <- anyEvent-    write (isearchAddE $ T.singleton c)--myKeymapSet :: KeymapSet-myKeymapSet = V2.mkKeymapSet $ V2.defVimConfig `override` \super this ->-    let eval = V2.pureEval this-    in super {-          -- Here we can add custom bindings.-          -- See Yi.Keymap.Vim.Common for datatypes and-          -- Yi.Keymap.Vim.Utils for useful functions like mkStringBindingE--          -- In case of conflict, that is if there exist multiple bindings-          -- whose prereq function returns WholeMatch,-          -- the first such binding is used.-          -- So it's important to have custom bindings first.-          V2.vimBindings = myBindings eval <> V2.vimBindings super-        }--myBindings :: (V2.EventString -> EditorM ()) -> [V2.VimBinding]-myBindings eval =-    let nmap x y = V2.mkStringBindingE V2.Normal V2.Drop (x, y, id)-        imap x y = V2.VimBindingE (\evs state -> case V2.vsMode state of-                                    V2.Insert _ ->-                                        fmap (const (y >> return V2.Continue))-                                             (evs `V2.matchesString` x)-                                    _ -> V2.NoMatch)-    in [ nmap "<C-h>" previousTabE-       , nmap "<C-l>" nextTabE-       , nmap "<C-l>" nextTabE--         -- Press space to clear incremental search highlight-       , nmap " " (eval ":nohlsearch<CR>")--         -- for times when you don't press shift hard enough-       , nmap ";" (eval ":")--       , nmap "<F3>" (withCurrentBuffer deleteTrailingSpaceB)-       , nmap "<F4>" (withCurrentBuffer moveToSol)-       , nmap "<F1>" (withCurrentBuffer readCurrentWordB >>= printMsg . R.toText)-       , imap "<Home>" (withCurrentBuffer moveToSol)-       , imap "<End>" (withCurrentBuffer moveToEol)-       ]--myModes :: [AnyMode]-myModes = [-         AnyMode Haskell.fastMode {-             -- Disable beautification-             modePrettify = const $ return ()-         }-    ]
− example-configs/yi.hs 
@@ -1,48 +0,0 @@-import Yi---- Import the desired keymap "template":--- import Yi.Keymap.Emacs (keymap)--- import Yi.Keymap.Cua (keymap)--- import Yi.Keymap.Vim (keymapSet)---- Import the desired UI as needed.--- Some are not complied in, so we import none here.---- import Yi.UI.Vty (start)--- import Yi.UI.Pango (start)--myConfig :: Config-myConfig = defaultEmacsConfig -- replace with defaultVimConfig or defaultCuaConfig--defaultUIConfig :: UIConfig-defaultUIConfig = configUI myConfig---- Change the below to your needs, following the explanation in comments. See--- module Yi.Config for more information on configuration. Other configuration--- examples can be found in the examples directory. You can also use or copy--- another user configuration, which can be found in modules Yi.Users.*--main :: IO ()-main = yi $ myConfig-  {--   -- Keymap Configuration-   defaultKm = defaultKm myConfig,--   -- UI Configuration-   -- Override the default UI as such:-   startFrontEnd = startFrontEnd myConfig,-                    -- Yi.UI.Vty.start -- for Vty-   -- (can be overridden at the command line)-   -- Options:-   configUI = defaultUIConfig-     {-       configFontSize = Nothing,-                        -- 'Just 10' for specifying the size.-       configTheme = configTheme defaultUIConfig,-                     -- darkBlueTheme  -- Change the color scheme here.--       configWindowFill = ' '-                          -- '~'    -- Typical for Vim-     }-  }
− src/executable/Main.hs 
@@ -1,9 +0,0 @@--- | "Real" Frontend to the static binary.--module Main (main) where--import Yi.Boot (yiDriver)-import Yi.Config.Default (defaultConfig)--main :: IO ()-main = yiDriver defaultConfig
− src/library/Control/Exc.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}---- | Utilities for working with new Control.Exception-module Control.Exc (ignoringException, printingException, orException)-where--import Prelude-import Control.Exception (catch, SomeException)---- | Execute IO (Maybe a) action replacing all exceptions with return value of Nothing.-ignoringException :: IO (Maybe a) -> IO (Maybe a)-ignoringException f = f `catch` ignore-  where ignore (_ :: SomeException) = return Nothing---- | Execute IO () action, replacing all exceptions with messages-printingException :: String -> IO a -> IO a-printingException desc f = f `catch` handler-  where handler (err :: SomeException) = fail $ concat [desc, " failed: ", show err]---- | Execute IO () action, replacing all exceptions with messages-orException :: IO a -> IO a -> IO a-orException f g = f `catch` handler-  where handler (_ :: SomeException) = g
− src/library/Data/DelayList.hs 
@@ -1,25 +0,0 @@--- maybe use package event-list instead.-module Data.DelayList (insert, decrease, DelayList) where--type DelayList a = [(Int, a)]---- | Subtraction, but treat maxBound as infinity. i.e. maxBound -? x == maxBound-(-?) :: Int -> Int -> Int-x -? y | x == maxBound = x-       | otherwise = x - y--insert :: (Int, a) -> DelayList a -> DelayList a-insert (d, a) [] = [(d, a)]-insert (d, a) l@(h@(d', _):t)-       | d == d' = (d, a):t-       | d <  d' = (d, a) : decrease d l-       -- d >  d'-       | otherwise = h : insert (d -? d', a) t--decrease :: Int -> DelayList a -> DelayList a-decrease _ [] = []-decrease d l@((d',a):t)-    | d <= 0 = l-    | d < d' = (d' -? d, a):t-    -- d >= d'-    | otherwise = decrease (d - d') t
− src/library/Parser/Incremental.hs 
@@ -1,366 +0,0 @@-{-# LANGUAGE GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-}---- TODO:--- better interface--- have error messages in the right order--- have a message for plain failures as well / remove failure in recoveries---- Optimize profile info (no more Ints)--module Parser.Incremental (Process,-                           recoverWith, symbol, eof, lookNext, testNext, run,-                           mkProcess, profile, pushSyms, pushEof, evalL, evalR, feedZ,-                           Parser(Look, Enter, Yuck), countWidth, fullLog, LogEntry(..),-                           evalL'-                          ) where--import Control.Applicative-import Data.Tree---- Local versions of our Control.Arrow friends (also make sure they are lazy enough)-first :: forall t t1 t2. (t -> t2) -> (t, t1) -> (t2, t1)-first f ~(a,b) = (f a,b)--second :: forall t t1 t2. (t1 -> t2) -> (t, t1) -> (t, t2)-second f ~(a,b) = (a,f b)--(***) :: forall t t1 t2 t3. (t -> t2) -> (t1 -> t3) -> (t, t1) -> (t2, t3)-(f *** g) ~(a,b) = (f a,g b)--data a :< b = (:<) {top :: a, _rest :: b}-infixr :<---- | Parser specification-data Parser s a where-    Pure  :: a                               -> Parser s a-    Appl  :: Parser s (b -> a) -> Parser s b -> Parser s a--    Bind  :: Parser s a -> (a -> Parser s b) -> Parser s b--    Look  :: Parser s a -> (s -> Parser s a) -> Parser s a-    Shif  :: Parser s a                      -> Parser s a-    Empt  ::                                    Parser s a-    Disj  :: Parser s a -> Parser s a        -> Parser s a-    Yuck  :: Parser s a                      -> Parser s a-    Enter :: String -> Parser s a            -> Parser s a---- | Parser process-data Steps s a where-    Val     :: a -> Steps s r                                -> Steps s (a :< r)-    App     :: Steps s ((b -> a) :< (b :< r))                -> Steps s (a :< r)-    Done    ::                                                  Steps s ()-    Shift   :: Steps s a                                     -> Steps s a-    Sh'     :: Steps s a                                     -> Steps s a-    Sus     :: Steps s a -> (s -> Steps s a)                 -> Steps s a-    Best    :: Ordering -> Profile -> Steps s a -> Steps s a -> Steps s a-    Dislike :: Steps s a                                     -> Steps s a-    Log     :: String -> Steps s a                           -> Steps s a-    Fail    ::                                                  Steps s a---- profile !! s = number of Dislikes found to do s Shifts-data Profile = PSusp | PFail | PRes Int | !Int :> Profile-    deriving Show--mapSucc :: Profile -> Profile-mapSucc PSusp = PSusp-mapSucc PFail = PFail-mapSucc (PRes x) = PRes (succ x)-mapSucc (x :> xs) = succ x :> mapSucc xs---- Map lookahead to maximum dislike difference we accept. When looking much further,--- we are more prone to discard smaller differences. It's essential that this drops below 0 when--- its argument increases, so that we can discard things with dislikes using only--- finite lookahead.-dislikeThreshold :: Int -> Int-dislikeThreshold n-    | n < 5 = 0-    | otherwise = -1 -- we looked 5 tokens ahead, and still have no clue who is the best. Pick at random.---- | Compute the combination of two profiles, as well as which one is the best.-better :: Int -> Profile -> Profile -> (Ordering, Profile)-better _ PFail p = (GT, p) -- avoid failure-better _ p PFail = (LT, p)-better _ PSusp _ = (EQ, PSusp) -- could not decide before suspension => leave undecided.-better _ _ PSusp = (EQ, PSusp)-better _ (PRes x) (PRes y) = if x <= y then (LT, PRes x) else (GT, PRes y)  -- two results, just pick the best.-better lk xs@(PRes x) (y:>ys) = if x == 0 || y-x > dislikeThreshold lk then (LT, xs) else min x y +> better (lk+1) xs ys-better lk (y:>ys) xs@(PRes x) = if x == 0 || y-x > dislikeThreshold lk then (GT, xs) else min x y +> better (lk+1) ys xs-better lk (x:>xs) (y:>ys)-    | x == 0 && y == 0 = recur -- never drop things with no error: this ensures to find a correct parse if it exists.-    | x - y > threshold = (GT, y:>ys)-    | y - x > threshold = (LT, x:>xs) -- if at any point something is too disliked, drop it.-    | otherwise = recur-    where threshold = dislikeThreshold lk-          recur = min x y +> better (lk + 1) xs ys--(+>) :: Int -> (t, Profile) -> (t, Profile)-x +> ~(ordering, xs) = (ordering, x :> xs)--data LogEntry = LLog String | LEmpty | LDislike | LShift-                | LDone | LFail | LSusp | LS String-    deriving Show--rightLog :: Steps s r -> Tree LogEntry-rightLog (Val _ p) = rightLog p-rightLog (App p) = rightLog p-rightLog (Shift p) = Node LShift [rightLog p]-rightLog (Done) = Node LDone []-rightLog (Fail) = Node LFail []-rightLog (Dislike p) = Node LDislike [rightLog p]-rightLog (Log msg p) = Node (LLog msg) [rightLog p]-rightLog (Sus _ _) = Node LSusp []-rightLog (Best _ _ l r) = Node LEmpty (rightLog l:[rightLog r])-rightLog (Sh' _) = error "Sh' should be hidden by Sus"--profile :: Steps s r -> Profile-profile (Val _ p) = profile p-profile (App p) = profile p-profile (Shift p) = 0 :> profile p-profile (Done) = PRes 0 -- success with zero dislikes-profile (Fail) = PFail-profile (Dislike p) = mapSucc (profile p)-profile (Log _ p) = profile p-profile (Sus _ _) = PSusp-profile (Best _ pr _ _) = pr-profile (Sh' _) = error "Sh' should be hidden by Sus"--instance Show (Steps s r) where-    show (Val _ p) = 'v' : show p-    show (App p) = '*' : show p-    show (Done) = "1"-    show (Shift p) = '>' : show p-    show (Sh' p) = '\'' : show p-    show (Dislike p) = '?' : show p-    show (Log msg p) = "[" ++ msg ++ "]"  ++ show p-    show (Fail) = "0"-    show (Sus _ _) = "..."-    show (Best _ _ p q) = "(" ++ show p ++ ")" ++ show q--countWidth :: Zip s r -> Int-countWidth (Zip _ _ r) = countWidth' r-  where countWidth' :: Steps s r -> Int-        countWidth' r' = case r' of-            (Best _ _ p q) ->  countWidth' p + countWidth' q-            (Val _ p) -> countWidth' p-            (App p) -> countWidth' p-            (Done) -> 1-            (Shift p) -> countWidth' p-            (Sh' p) -> countWidth' p-            (Dislike p) -> countWidth' p-            (Log _ p) -> countWidth' p-            (Fail) -> 1-            (Sus _ _) -> 1--instance Show (RPolish i o) where-    show (RPush _ p) = show p ++ "^"-    show (RApp p) = show p ++ "@"-    show (RStop) = "!"---apply :: forall t t1 a. ((t -> a) :< (t :< t1)) -> a :< t1-apply ~(f:< ~(a:<r)) = f a :< r---- | Right-eval a fully defined process (ie. one that has no Sus)-evalR' :: Steps s r -> (r, [String])-evalR' Done = ((), [])-evalR' (Val a r) = first (a :<) (evalR' r)-evalR' (App s) = first apply (evalR' s)-evalR' (Shift v) = evalR' v-evalR' (Dislike v) = evalR' v-evalR' (Log err v) = second (err:) (evalR' v)-evalR' (Fail) = error "evalR: No parse!"-evalR' (Sus _ _) = error "evalR: Not fully evaluated!"-evalR' (Sh' _) = error "evalR: Sh' should be hidden by Sus"-evalR' (Best choice _ p q) = case choice of-    LT -> evalR' p-    GT -> evalR' q-    EQ -> error $ "evalR: Ambiguous parse: " ++ show p ++ " ~~~ " ++ show q---instance Functor (Parser s) where-    fmap f = (pure f <*>)--instance Applicative (Parser s) where-    (<*>) = Appl-    pure = Pure--instance Alternative (Parser s) where-    (<|>) = Disj-    empty = Empt--instance Monad (Parser s) where-    (>>=) = Bind-    return = pure-    fail _message = Empt--toQ :: Parser s a -> forall h r. ((h,a) -> Steps s r)  -> h -> Steps s r-toQ (Look a f) = \k h -> Sus (toQ a k h) (\s -> toQ (f s) k h)-toQ (p `Appl` q) = \k -> toQ p $ toQ q $ \((h, b2a), b) -> k (h, b2a b)-toQ (Pure a)     = \k h -> k (h, a)-toQ (Disj p q)   = \k h -> iBest (toQ p k h) (toQ q k h)-toQ (Bind p a2q) = \k -> toQ p (\(h,a) -> toQ (a2q a) k h)-toQ Empt = \_k _h -> Fail-toQ (Yuck p) = \k h -> Dislike $ toQ p k h-toQ (Enter err p) = \k h -> Log err $ toQ p k h-toQ (Shif p) = \k h -> Sh' $ toQ p k h--toP :: Parser s a -> forall r. Steps s r -> Steps s (a :< r)-toP (Look a f) = \fut -> Sus (toP a fut) (\s -> toP (f s) fut)-toP (Appl f x) = App . toP f . toP x-toP (Pure x)   = Val x-toP Empt = const Fail-toP (Disj a b)  = \fut -> iBest (toP a fut) (toP b fut)-toP (Bind p a2q) = \fut -> toQ p (\(_,a) -> toP (a2q a) fut) ()-toP (Yuck p) = Dislike . toP p-toP (Enter err p) = Log err . toP p-toP (Shif p) = Sh' . toP p---- | Intelligent, caching best.-iBest :: Steps s a -> Steps s a -> Steps s a-iBest p q = let ~(choice, pr) = better 0 (profile p) (profile q) in Best choice pr p q--symbol :: forall s. (s -> Bool) -> Parser s s-symbol f = Look empty $ \s -> if f s then Shif $ pure s else empty--eof :: forall s. Parser s ()-eof = Look (pure ()) (const empty)---- | Push a chunk of symbols or eof in the process. This forces some suspensions.-feed :: Maybe [s] -> Steps s r -> Steps s r-feed (Just []) p = p  -- nothing more left to feed-feed ss p = case p of-                  (Sus nil cons) -> case ss of-                      Just [] -> p -- no more info, stop feeding-                      Nothing -> feed Nothing nil -- finish-                      Just (s:_) -> feed ss (cons s)-                  (Shift p') -> Shift (feed ss p')-                  (Sh' p')   -> Shift (feed (fmap (drop 1) ss) p')-                  (Dislike p') -> Dislike (feed ss p')-                  (Log err p') -> Log err (feed ss p')-                  (Val x p') -> Val x (feed ss p')-                  (App p') -> App (feed ss p')-                  Done -> Done-                  Fail -> Fail-                  Best _ _ p' q' -> iBest (feed ss p') (feed ss q')-                  -- TODO: it would be nice to be able to reuse the profile here.---feedZ :: Maybe [s] -> Zip s r -> Zip s r-feedZ x = onRight (feed x)----- Move the zipper to right, and simplify if something is pushed in--- the left part.--evalL :: forall s output. Zip s output -> Zip s output-evalL (Zip errs0 l0 r0) = help errs0 l0 r0-  where-      help :: [String] -> RPolish mid output -> Steps s mid -> Zip s output-      help errs l rhs = case rhs of-          (Val a r) -> help errs (simplify (RPush a l)) r-          (App r)  -> help errs (RApp l) r-          (Shift p) -> help errs l p-          (Log err p) -> help (err:errs) l p-          (Dislike p) -> help errs l p-          (Best choice _ p q) -> case choice of-              LT -> help errs l p-              GT -> help errs l q-              EQ -> reZip errs l rhs -- don't know where to go: don't speculate on evaluating either branch.-          _ -> reZip errs l rhs-      reZip :: [String] -> RPolish mid output -> Steps s mid -> Zip s output-      reZip errs l r = l `seq` Zip errs l r--evalL' :: Zip s output -> Zip s output-evalL' (Zip errs0 l0 r0) = Zip errs0 l0 (simplRhs r0)-    where simplRhs :: Steps s a ->Steps s a-          simplRhs rhs = case rhs of-            (Val a r) -> Val a (simplRhs r)-            (App r)  -> App (simplRhs r)-            (Shift p) -> Shift (simplRhs p)-            (Log err p) -> Log err $ simplRhs p-            (Dislike p) -> Dislike $ simplRhs p-            (Best choice _ p q) -> case choice of-                LT -> simplRhs p-                GT -> simplRhs q-                EQ -> iBest (simplRhs p) (simplRhs q)-            x -> x---- | Push some symbols.-pushSyms :: forall s r. [s] -> Zip s r -> Zip s r-pushSyms x = feedZ (Just x)---- | Push eof-pushEof :: forall s r. Zip s r -> Zip s r-pushEof = feedZ Nothing---- | Make a parser into a process.-mkProcess :: forall s a. Parser s a -> Process s a-mkProcess p = Zip [] RStop (toP p Done)---- | Run a process (in case you do not need the incremental interface)-run :: Process s a -> [s] -> (a, [String])-run p input = evalR $ pushEof $ pushSyms input p--testNext :: (Maybe s -> Bool) -> Parser s ()-testNext f = Look (if f Nothing then ok else empty) (\s ->-   if f $ Just s then ok else empty)-    where ok = pure ()--lookNext :: Parser s (Maybe s)-lookNext = Look (pure Nothing) (pure . Just)------ | Parse the same thing as the argument, but will be used only as--- backup. ie, it will be used only if disjuncted with a failing--- parser.--recoverWith :: Parser s a -> Parser s a-recoverWith = Enter "recoverWith" . Yuck------------------------------------------------------------------------------------------- The zipper for efficient evaluation:---- Arbitrary expressions in Reverse Polish notation.--- This can also be seen as an automaton that transforms a stack.--- RPolish is indexed by the types in the stack consumed by the automaton (input),--- and the stack produced (output)-data RPolish input output where-  RPush :: a -> RPolish (a :< rest) output -> RPolish rest output-  RApp :: RPolish (b :< rest) output -> RPolish ((a -> b) :< a :< rest) output-  RStop :: RPolish rest rest---- Evaluate the output of an RP automaton, given an input stack-evalRP :: RPolish input output -> input -> output-evalRP RStop  acc = acc-evalRP (RPush v r) acc = evalRP r (v :< acc)-evalRP (RApp r) ~(f :< ~(a :< rest)) = evalRP r (f a :< rest)---- execute the automaton as far as possible-simplify :: RPolish s output -> RPolish s output-simplify (RPush x (RPush f (RApp r))) = simplify (RPush (f x) r)-simplify x = x--evalR :: Zip token (a :< rest) -> (a, [String])-evalR (Zip errs l r) = ((top . evalRP l) *** (errs ++)) (evalR' r)---- Gluing a Polish expression and an RP automaton.--- This can also be seen as a zipper of Polish expressions.-data Zip s output where-   Zip :: [String] -> RPolish mid output -> Steps s mid -> Zip s output-   -- note that the Stack produced by the Polish expression matches-   -- the stack consumed by the RP automaton.--fullLog :: Zip s output -> ([String],Tree LogEntry)-fullLog (Zip msg _ rhs) = (reverse msg, rightLog rhs)--instance Show (Zip s output) where-    show (Zip errs l r) = show l ++ "<>" ++ show r ++ ", errs = " ++ show errs--onRight :: (forall r. Steps s r -> Steps s r) -> Zip s a -> Zip s a-onRight f (Zip errs x y) = Zip errs x (f y)---type Process token result = Zip token (result :< ())
− src/library/System/CanonicalizePath.hs 
@@ -1,102 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  System.CanonicalizePath--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ System.Directory.canonicalizePath replacement-module System.CanonicalizePath-  ( canonicalizePath-  , normalisePath-  , replaceShorthands-  ) where--#ifdef mingw32_HOST_OS-import qualified System.Win32 as Win32-import           System.FilePath (normalise)-#endif-import           Control.Applicative-import           Control.Exc          (ignoringException)-import           Control.Monad-import           Data.List.Split     (splitOneOf)-import           Data.Monoid-import qualified Data.Text as T-import           System.Directory    (getCurrentDirectory)-import           System.FilePath     ((</>), isDrive, isAbsolute, takeDirectory, pathSeparator, pathSeparators)-import           System.PosixCompat.Files  (readSymbolicLink)---- | Removes `/./` `//` and `/../` sequences from path,--- doesn't follow symlinks-normalisePath :: FilePath -> IO FilePath-normalisePath path = do-  absPath <- makeAbsolute path-  return $ foldl combinePath "/" $ splitPath absPath---- | Returns absolute name of the file, which doesn't contain--- any `/./`, `/../`, `//` sequences or symlinks-canonicalizePath :: FilePath -> IO FilePath-canonicalizePath path = do-#if !defined(mingw32_HOST_OS)-  absPath <- makeAbsolute path-  foldM (\x y -> expandSym $ combinePath x y) "/" $ splitPath absPath-#else-  Win32.getFullPathName . normalise $ path-#endif---- | Dereferences symbolic links until regular--- file/directory/something_else appears-expandSym :: FilePath -> IO FilePath-expandSym fpath = do-  -- System.Posix.Files.getFileStatus dereferences symlink before-  -- checking its status, so it's useless here-  deref <- ignoringException (Just <$> readSymbolicLink fpath)-  case deref of-    Just slink -> expandSym (if isAbsolute slink-                    then slink-                    else foldl combinePath (takeDirectory fpath) $ splitPath slink)-    Nothing -> return fpath---- | Make a path absolute.-makeAbsolute :: FilePath -> IO FilePath-makeAbsolute f-    | not (null f) && head f `elem` ['~', pathSeparator] = return f-    | otherwise = fmap (</> f) getCurrentDirectory---- | Combines two paths, moves up one level on ..-combinePath :: FilePath -> String -> FilePath-combinePath x "."  = x-combinePath x ".." = takeDirectory x-combinePath "/" y  = "/" </> y-combinePath x y-    | isDrive x = (x ++ [pathSeparator]) </> y -- "C:" </> "bin" = "C:bin"-    | otherwise = x </> y---- Replace utility shorthands, similar to Emacs------ @--- somepath//someotherpath  ≅ /someotherpath--- somepath/~/someotherpath ≅ ~/someotherpath--- @-replaceShorthands :: T.Text -> T.Text-replaceShorthands = r "/~" "~/" . r "//" "/"-  where-    r :: T.Text -> T.Text -> T.Text -> T.Text-    r s r' a = case T.splitOn s a of-      []     -> T.empty-      [a']   -> a'-      _ : as -> r' <> last as---- | Splits path into parts by path separator------ Text version would look like------ @'T.filter' (not . T.null) . T.split (`elem` pathSeparators)@------ But we should move to @system-filepath@ package anyway.-splitPath :: FilePath -> [String]-splitPath = filter (not . null) . splitOneOf pathSeparators
− src/library/System/FriendlyPath.hs 
@@ -1,34 +0,0 @@-module System.FriendlyPath-  ( userToCanonPath-  , expandTilda-  , isAbsolute'-  ) where--import Control.Applicative-import System.FilePath-import System.PosixCompat.User (getUserEntryForName, homeDirectory)-import System.CanonicalizePath-import System.Directory hiding (canonicalizePath)---- canonicalizePath follows symlinks, and does not work if the directory does not exist.---- | Canonicalize a user-friendly path-userToCanonPath :: FilePath -> IO String-userToCanonPath f = canonicalizePath =<< expandTilda f---- | Turn a user-friendly path into a computer-friendly path by expanding the leading tilda.-expandTilda :: String -> IO FilePath-expandTilda ('~':path)-  | null path || (head path == pathSeparator) = (++ path) <$> getHomeDirectory-  -- Home directory of another user, e.g. ~root/-  | otherwise = let username = takeWhile (/= pathSeparator) path-                    dirname = drop (length username) path-                in  (normalise . (++ dirname) . homeDirectory) <$> getUserEntryForName username-expandTilda path = return path---- | Is a user-friendly path absolute?-isAbsolute' :: String -> Bool-isAbsolute' ('~':_) = True-isAbsolute' p = isAbsolute p--
− src/library/Yi.hs 
@@ -1,60 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Facade of the Yi library, for use by confguration file. Just--- re-exports a bunch of modules.------ You should therefore:------ @     import Yi@------ in your @~/.config/yi/yi.hs@.--module Yi-  (-    module Data.Prototype, -- prototypes are mainly there for config; makes sense to export them.-    module Yi.Boot,-    module Yi.Buffer,-    module Yi.Config,-    module Yi.Config.Default,-    module Yi.Core,-    module Yi.Dired,-    module Yi.Editor,-    module Yi.Eval,-    module Yi.File,-    module Yi.Keymap,-    module Yi.Keymap.Keys,-    module Yi.Misc,-    module Yi.Mode.Haskell,-    module Yi.Mode.IReader,-    module Yi.Search,-    module Yi.Style,-    module Yi.Style.Library,-  ) where--import Data.Prototype-import Yi.Boot-import Yi.Buffer-import Yi.Config-import Yi.Config.Default-import Yi.Core-import Yi.Dired-import Yi.Editor-import Yi.Eval-import Yi.File-import Yi.Keymap-import Yi.Keymap.Keys-import Yi.Misc-import Yi.Mode.Haskell (ghciGet, ghciLoadBuffer,-                        ghciSetProcessName, ghciSetProcessArgs)-import Yi.Mode.IReader (ireaderMode, ireadMode)-import Yi.Search-import Yi.Style-import Yi.Style.Library
− src/library/Yi/Boot.hs 
@@ -1,90 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Boot--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Boot process of Yi.------ Uses Dyre to implement the XMonad-style dynamic reconfiguration.--module Yi.Boot (yi, yiDriver, reload) where--import qualified Config.Dyre as Dyre-import qualified Config.Dyre.Options as Dyre-import qualified Config.Dyre.Params as Dyre-import           Config.Dyre.Relaunch-import           Control.Lens-import           Data.Text ()-import           System.Environment-import           System.Exit-import           Yi.Boot.Internal-import           Yi.Buffer.Misc (BufferId(..))-import           Yi.Config-import           Yi.Editor-import           Yi.Keymap-import           Yi.Main-import           Yi.Paths (getCustomConfigPath)-import           Yi.Rope (fromString)---- | Once the custom yi is compiled this restores the editor state (if--- requested) then proceeds to run the editor.-realMain :: (Config, ConsoleConfig) -> IO ()-realMain configs = restoreBinaryState Nothing >>= main configs---- | If the custom yi compile produces errors or warnings then the--- messages are presented as a separate activity in the editor.------ The use of a separate activity prevents any other initial actions--- from immediately masking the output.-showErrorsInConf :: (Config, ConsoleConfig) -> String -> (Config, ConsoleConfig)-showErrorsInConf c errs = c & _1 . initialActionsA %~ (makeAction openErrBuf :)-  where-    openErrBuf = splitE >> newBufferE (MemBuffer "*errors*") (fromString errs)---- | Handy alias for 'yiDriver'.-yi :: Config -> IO ()-yi = yiDriver---- | Used by both the yi executable and the custom yi that is built--- from the user's configuration. The yi executable uses a default--- config.-yiDriver :: Config -> IO ()-yiDriver cfg = do-  args <- Dyre.withDyreOptions Dyre.defaultParams getArgs-  -- we do the arg processing before dyre, so we can extract-  -- '--ghc-option=' and '--help' and so on.-  case do_args cfg args of-    Left (Err err code) -> putStrLn err >> exitWith code-    Right (finalCfg, cfgcon) -> do-      modules <- getCustomConfigPath (userConfigDir cfgcon) "modules"-      let yiParams = Dyre.defaultParams-                      { Dyre.projectName  = "yi"-                      , Dyre.realMain     = realMain-                      , Dyre.showError    = showErrorsInConf-                      , Dyre.configDir    = Just $ userConfigDir cfgcon-                      , Dyre.ghcOpts      = ["-threaded", "-O2", "-rtsopts"]-                                            ++ ["-i" ++ modules]-                                            ++ profilingParams-                                            ++ ghcOptions cfgcon-                      , Dyre.includeCurrentDirectory = False-                      , Dyre.rtsOptsHandling = Dyre.RTSAppend ["-I5"]-                      }-      Dyre.wrapMain yiParams (finalCfg, cfgcon)---- | CPP-guarded profiling params.-profilingParams :: [String]-profilingParams =-#ifdef EVENTLOG-  ["-eventlog", "-rtsopts"] ++-#endif-#ifdef PROFILING-  ["-prof", "-auto-all", "-rtsopts"-  , "-osuf=p_o", "-hisuf=p_hi"] ++-#endif-  []
− src/library/Yi/Boot/Internal.hs 
@@ -1,30 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Boot.Internal--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Internal use for Yi.Boot--module Yi.Boot.Internal where--import Config.Dyre.Relaunch (relaunchWithBinaryState)-import Control.Monad.Base (liftBase)-import Control.Monad.State (get)-import Yi.Types (withEditor)-import Yi.Keymap (YiM, withUI)-import Yi.UI.Common (end)---- | "reloads" the configuration------ Serializes the editor state and relaunches Yi using the serialized--- state. The launch of Yi will result in recompilation of the user's--- custom Yi. This, in effect, "reloads" the configuration.-reload :: YiM ()-reload = do-  editor <- withEditor get-  withUI (`end` False)-  liftBase $ relaunchWithBinaryState (Just editor) Nothing
− src/library/Yi/Buffer.hs 
@@ -1,42 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Buffer--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ The 'Buffer' module defines monadic editing operations over--- one-dimensional buffers, maintaining a current /point/.------ This module acts as a facade for the Buffer.* modules.--module Yi.Buffer-  ( module Yi.Buffer.Basic-  , module Yi.Buffer.HighLevel-  , module Yi.Buffer.Indent-  , module Yi.Buffer.Misc-  , module Yi.Buffer.Normal-  , module Yi.Buffer.Region-  , module Yi.Buffer.TextUnit-  , module Yi.Buffer.Undo-  -- Implementation re-exports (move out of implementation?)-  , UIUpdate (..)-  , Update (..)-  , updateIsDelete-  , markGravityAA-  , markPointAA-  )-where--import Yi.Buffer.Basic-import Yi.Buffer.HighLevel-import Yi.Buffer.Indent-import Yi.Buffer.Misc-import Yi.Buffer.Normal-import Yi.Buffer.Region-import Yi.Buffer.TextUnit-import Yi.Buffer.Undo--import Yi.Buffer.Implementation
− src/library/Yi/Buffer/Adjusted.hs 
@@ -1,96 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Buffer.Adjusted--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ This module re-exports Yi.Buffer overriding insert* and delete* functions--- with their more indent-aware variants. It is intended to be imported--- instead of Yi.Buffer or qualified to avoid name clashes.--module Yi.Buffer.Adjusted-    ( bdeleteB-    , insertB-    , insertN-    , insertNAt-    , deleteB-    , deleteN-    , deleteRegionB-    , deleteRegionWithStyleB-    , module Yi.Buffer-    ) where--import Control.Applicative-import Control.Monad--import Yi.Buffer hiding-    ( bdeleteB-    , insertB-    , insertN-    , insertNAt-    , deleteB-    , deleteN-    , deleteNAt-    , deleteRegionB-    , deleteRegionWithStyleB-    )-import qualified Yi.Buffer as B-import Yi.Misc-import Yi.Utils-import qualified Yi.Rope as R--insertNAt :: R.YiString -> Point -> BufferM ()-insertNAt rope point | R.countNewLines rope > 0 = B.insertNAt rope point-insertNAt rope point = B.insertNAt rope point >> adjBlock (R.length rope)---- | Insert the list at current point, extending size of buffer-insertN :: R.YiString -> BufferM ()-insertN rope = insertNAt rope =<< pointB---- | Insert the char at current point, extending size of buffer-insertB :: Char -> BufferM ()-insertB c = B.insertB c >> adjBlock 1---- | @deleteNAt n p@ deletes @n@ characters forwards from position @p@-deleteNAt :: Direction -> Int -> Point -> BufferM ()-deleteNAt dir n pos = do-  els <- R.take n <$> streamB Forward pos-  applyUpdate (Delete pos dir els)-  when (R.countNewLines els == 0) $-      adjBlock (-(R.length els))--deleteN :: Int -> BufferM ()-deleteN n = pointB >>= deleteNAt Forward n--deleteB :: TextUnit -> Direction -> BufferM ()-deleteB unit dir = deleteRegionB =<< regionOfPartNonEmptyB unit dir--bdeleteB :: BufferM ()-bdeleteB = deleteB Character Backward--deleteRegionB :: Region -> BufferM ()-deleteRegionB r =-    deleteNAt (regionDirection r)-              (fromIntegral (regionEnd r ~- regionStart r))-              (regionStart r)--deleteRegionWithStyleB :: Region -> RegionStyle -> BufferM Point-deleteRegionWithStyleB reg Block = savingPointB $ do-    (start, lengths) <- shapeOfBlockRegionB reg-    moveTo start-    forM_ (zip [1..] lengths) $ \(i, l) -> do-        deleteN l-        moveTo start-        lineMoveRel i-    case lengths of-        [l] -> adjBlock (-l)-        _ -> return ()-    return start--deleteRegionWithStyleB reg style = savingPointB $ do-    effectiveRegion <- convertRegionToStyleB reg style-    deleteRegionB effectiveRegion-    return $! regionStart effectiveRegion
− src/library/Yi/Buffer/HighLevel.hs 
@@ -1,1151 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}-{-# LANGUAGE MultiWayIf #-}---- |--- Module      :  Yi.Buffer.HighLevel--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ High level operations on buffers.--module Yi.Buffer.HighLevel-    ( atEof-    , atEol-    , atLastLine-    , atSol-    , bdeleteB-    , bdeleteLineB-    , bkillWordB-    , botB-    , bufInfoB-    , BufferFileInfo (..)-    , capitaliseWordB-    , deleteBlankLinesB-    , deleteHorizontalSpaceB-    , deleteRegionWithStyleB-    , deleteToEol-    , deleteTrailingSpaceB-    , downFromTosB-    , downScreenB-    , downScreensB-    , exchangePointAndMarkB-    , fillParagraph-    , findMatchingPairB-    , firstNonSpaceB-    , flipRectangleB-    , getBookmarkB-    , getLineAndCol-    , getLineAndColOfPoint-    , getNextLineB-    , getNextNonBlankLineB-    , getRawestSelectRegionB-    , getSelectionMarkPointB-    , getSelectRegionB-    , gotoCharacterB-    , hasWhiteSpaceBefore-    , incrementNextNumberByB-    , insertRopeWithStyleB-    , isCurrentLineAllWhiteSpaceB-    , isCurrentLineEmptyB-    , isNumberB-    , killWordB-    , lastNonSpaceB-    , leftEdgesOfRegionB-    , leftOnEol-    , linePrefixSelectionB-    , lineStreamB-    , lowercaseWordB-    , middleB-    , modifyExtendedSelectionB-    , moveNonspaceOrSol-    , movePercentageFileB-    , moveToEol-    , moveToSol-    , moveXorEol-    , moveXorSol-    , nextCInLineExc-    , nextCInLineInc-    , nextNParagraphs-    , nextWordB-    , prevCInLineExc-    , prevCInLineInc-    , prevNParagraphs-    , prevWordB-    , readCurrentWordB-    , readLnB-    , readPrevWordB-    , readRegionRopeWithStyleB-    , replaceBufferContent-    , revertB-    , rightEdgesOfRegionB-    , scrollB-    , scrollCursorToBottomB-    , scrollCursorToTopB-    , scrollScreensB-    , scrollToCursorB-    , scrollToLineAboveWindowB-    , scrollToLineBelowWindowB-    , setSelectionMarkPointB-    , setSelectRegionB-    , shapeOfBlockRegionB-    , sortLines-    , snapInsB-    , snapScreenB-    , splitBlockRegionToContiguousSubRegionsB-    , swapB-    , switchCaseChar-    , test3CharB-    , testHexB-    , toggleCommentB-    , topB-    , unLineCommentSelectionB-    , upFromBosB-    , uppercaseWordB-    , upScreenB-    , upScreensB-    , vimScrollB-    , vimScrollByB-    ) where--import           Control.Applicative-import           Control.Lens hiding ((-~), (+~), re, transform)-import           Control.Monad-import           Control.Monad.RWS.Strict (ask)-import           Control.Monad.State hiding (forM, forM_, sequence_)-import           Data.Char (isDigit, isHexDigit, isOctDigit,-                            toUpper, isUpper, toLower, isSpace)-import           Data.List (sort, intersperse)-import           Data.Maybe (fromMaybe, listToMaybe, catMaybes)-import           Data.Monoid-import qualified Data.Text as T-import           Data.Time (UTCTime)-import           Data.Tuple (swap)-import           Numeric (showOct, showHex, readOct, readHex)-import           Yi.Buffer.Basic-import           Yi.Buffer.Misc-import           Yi.Buffer.Normal-import           Yi.Buffer.Region-import           Yi.Config.Misc (ScrollStyle(SingleLine))-import           Yi.Rope (YiString)-import qualified Yi.Rope as R-import           Yi.String-import           Yi.Utils-import           Yi.Window---- ------------------------------------------------------------------------ Movement operations---- | Move point to start of line-moveToSol :: BufferM ()-moveToSol = maybeMoveB Line Backward---- | Move point to end of line-moveToEol :: BufferM ()-moveToEol = maybeMoveB Line Forward---- | Move cursor to origin-topB :: BufferM ()-topB = moveTo 0---- | Move cursor to end of buffer-botB :: BufferM ()-botB = moveTo =<< sizeB---- | Move left if on eol, but not on blank line-leftOnEol :: BufferM ()--- @savingPrefCol@ is needed, because deep down @leftB@ contains @forgetPrefCol@--- which messes up vertical cursor motion in Vim normal mode-leftOnEol = savingPrefCol $ do-        eol <- atEol-        sol <- atSol-        when (eol && not sol) leftB---- | Move @x@ chars back, or to the sol, whichever is less-moveXorSol :: Int -> BufferM ()-moveXorSol x = replicateM_ x $ do c <- atSol; unless c leftB---- | Move @x@ chars forward, or to the eol, whichever is less-moveXorEol :: Int -> BufferM ()-moveXorEol x = replicateM_ x $ do c <- atEol; unless c rightB---- | Move to first char of next word forwards-nextWordB :: BufferM ()-nextWordB = moveB unitWord Forward---- | Move to first char of next word backwards-prevWordB :: BufferM ()-prevWordB = moveB unitWord Backward---- * Char-based movement actions.--gotoCharacterB :: Char -> Direction -> RegionStyle -> Bool -> BufferM ()-gotoCharacterB c dir style stopAtLineBreaks = do-    start <- pointB-    let predicate = if stopAtLineBreaks then (`elem` [c, '\n']) else (== c)-        (move, moveBack) = if dir == Forward then (rightB, leftB) else (leftB, rightB)-    doUntilB_ (predicate <$> readB) move-    b <- readB-    if stopAtLineBreaks && b == '\n'-    then moveTo start-    else when (style == Exclusive && b == c) moveBack---- | Move to the next occurence of @c@-nextCInc :: Char -> BufferM ()-nextCInc c = gotoCharacterB c Forward Inclusive False--nextCInLineInc :: Char -> BufferM ()-nextCInLineInc c = gotoCharacterB c Forward Inclusive True---- | Move to the character before the next occurence of @c@-nextCExc :: Char -> BufferM ()-nextCExc c = gotoCharacterB c Forward Exclusive False--nextCInLineExc :: Char -> BufferM ()-nextCInLineExc c = gotoCharacterB c Forward Exclusive True---- | Move to the previous occurence of @c@-prevCInc :: Char -> BufferM ()-prevCInc c = gotoCharacterB c Backward Inclusive False--prevCInLineInc :: Char -> BufferM ()-prevCInLineInc c = gotoCharacterB c Backward Inclusive True---- | Move to the character after the previous occurence of @c@-prevCExc :: Char -> BufferM ()-prevCExc c = gotoCharacterB c Backward Exclusive False--prevCInLineExc :: Char -> BufferM ()-prevCInLineExc c = gotoCharacterB c Backward Exclusive True---- | Move to first non-space character in this line-firstNonSpaceB :: BufferM ()-firstNonSpaceB = do-  moveToSol-  untilB_ ((||) <$> atEol <*> ((not . isSpace) <$> readB)) rightB---- | Move to the last non-space character in this line-lastNonSpaceB :: BufferM ()-lastNonSpaceB = do-  moveToEol-  untilB_ ((||) <$> atSol <*> ((not . isSpace) <$> readB)) leftB---- | Go to the first non space character in the line;--- if already there, then go to the beginning of the line.-moveNonspaceOrSol :: BufferM ()-moveNonspaceOrSol = do-  prev <- readPreviousOfLnB-  if R.all isSpace prev then moveToSol else firstNonSpaceB---- | True if current line consists of just a newline (no whitespace)-isCurrentLineEmptyB :: BufferM Bool-isCurrentLineEmptyB = savingPointB $ moveToSol >> atEol---- | Note: Returns False if line doesn't have any characters besides a newline-isCurrentLineAllWhiteSpaceB :: BufferM Bool-isCurrentLineAllWhiteSpaceB = savingPointB $ do-    isEmpty <- isCurrentLineEmptyB-    if isEmpty-    then return False-    else do-        let go = do-                  eol <- atEol-                  if eol-                  then return True-                  else do-                      c <- readB-                      if isSpace c-                      then rightB >> go-                      else return False-        moveToSol-        go------------------ | Move down next @n@ paragraphs-nextNParagraphs :: Int -> BufferM ()-nextNParagraphs n = replicateM_ n $ moveB unitEmacsParagraph Forward---- | Move up prev @n@ paragraphs-prevNParagraphs :: Int -> BufferM ()-prevNParagraphs n = replicateM_ n $ moveB unitEmacsParagraph Backward---- ! Examples:--- @goUnmatchedB Backward '(' ')'@--- Move to the previous unmatched '('--- @goUnmatchedB Forward '{' '}'@--- Move to the next unmatched '}'-goUnmatchedB :: Direction -> Char -> Char -> BufferM ()-goUnmatchedB dir cStart' cStop' = stepB >> readB >>= go (0::Int)-  where go opened c | c == cStop && opened == 0 = return ()-                    | c == cStop                = stepB >> readB >>= go (opened-1)-                    | c == cStart               = stepB >> readB >>= go (opened+1)-                    | otherwise                 = stepB >> readB >>= go opened-        (stepB, cStart, cStop) | dir == Forward = (rightB, cStart', cStop')-                               | otherwise      = (leftB, cStop', cStart')---------------------------------------------------------------------------- Queries---- | Return true if the current point is the start of a line-atSol :: BufferM Bool-atSol = atBoundaryB Line Backward---- | Return true if the current point is the end of a line-atEol :: BufferM Bool-atEol = atBoundaryB Line Forward---- | True if point at start of file-atSof :: BufferM Bool-atSof = atBoundaryB Document Backward---- | True if point at end of file-atEof :: BufferM Bool-atEof = atBoundaryB Document Forward---- | True if point at the last line-atLastLine :: BufferM Bool-atLastLine = savingPointB $ do-    moveToEol-    (==) <$> sizeB <*> pointB---- | Get the current line and column number-getLineAndCol :: BufferM (Int, Int)-getLineAndCol = (,) <$> curLn <*> curCol--getLineAndColOfPoint :: Point -> BufferM (Int, Int)-getLineAndColOfPoint p = savingPointB $ moveTo p >> getLineAndCol---- | Read the line the point is on-readLnB :: BufferM YiString-readLnB = readUnitB Line--readCharB :: BufferM (Maybe Char)-readCharB = fmap R.head (readUnitB Character)---- | Read from point to end of line-readRestOfLnB :: BufferM YiString-readRestOfLnB = readRegionB =<< regionOfPartB Line Forward---- | Read from point to beginning of line-readPreviousOfLnB :: BufferM YiString-readPreviousOfLnB = readRegionB =<< regionOfPartB Line Backward--hasWhiteSpaceBefore :: BufferM Bool-hasWhiteSpaceBefore = liftM isSpace (prevPointB >>= readAtB)---- | Get the previous point, unless at the beginning of the file-prevPointB :: BufferM Point-prevPointB = do-  sof <- atSof-  if sof then pointB-         else do p <- pointB-                 return $ Point (fromPoint p - 1)---- | Get the next point, unless at the end of the file-nextPointB :: BufferM Point-nextPointB = do-  eof <- atEof-  if eof then pointB-         else do p <- pointB-                 return $ Point (fromPoint p + 1)---- | Reads in word at point.-readCurrentWordB :: BufferM YiString-readCurrentWordB = readUnitB unitWord---- | Reads in word before point.-readPrevWordB :: BufferM YiString-readPrevWordB = readPrevUnitB unitViWordOnLine------------------------------ Deletes---- | Delete one character backward-bdeleteB :: BufferM ()-bdeleteB = deleteB Character Backward---- | Delete forward whitespace or non-whitespace depending on--- the character under point.-killWordB :: BufferM ()-killWordB = deleteB unitWord Forward---- | Delete backward whitespace or non-whitespace depending on--- the character before point.-bkillWordB :: BufferM ()-bkillWordB = deleteB unitWord Backward---- | Delete backward to the sof or the new line character-bdeleteLineB :: BufferM ()-bdeleteLineB = atSol >>= \sol -> if sol then bdeleteB else deleteB Line Backward----- UnivArgument is in Yi.Keymap.Emacs.Utils but we can't import it due--- to cyclic imports.--- | emacs' @delete-horizontal-space@ with the optional argument.-deleteHorizontalSpaceB :: Maybe Int -> BufferM ()-deleteHorizontalSpaceB u = do-  c <- curCol-  reg <- regionOfB Line-  text <- readRegionB reg-  let r = deleteSpaces c text-  modifyRegionB (const r) reg-  -- If we only deleted before point, move back that many characters-  -- too or it feels weird.-  case u of-    Just _ -> moveToColB (c - (R.length text - R.length r))-    Nothing -> return ()-  where-    deleteSpaces :: Int -> R.YiString -> R.YiString-    deleteSpaces c l =-      let (f, b) = R.splitAt c l-      in R.dropWhileEnd isSpace f <> case u of-        Nothing -> R.dropWhile isSpace b-        Just _ -> b--------------------------------------------- Transform operations---- | capitalise the word under the cursor-uppercaseWordB :: BufferM ()-uppercaseWordB = transformB (R.withText T.toUpper) unitWord Forward---- | lowerise word under the cursor-lowercaseWordB :: BufferM ()-lowercaseWordB = transformB (R.withText T.toLower) unitWord Forward---- | capitalise the first letter of this word-capitaliseWordB :: BufferM ()-capitaliseWordB = transformB capitalizeFirst unitWord Forward---- | switch the case of the letter under the cursor-switchCaseCharB :: BufferM ()-switchCaseCharB =-  transformB (R.withText $ T.map switchCaseChar) Character Forward--switchCaseChar :: Char -> Char-switchCaseChar c = if isUpper c then toLower c else toUpper c---- | Delete to the end of line, excluding it.-deleteToEol :: BufferM ()-deleteToEol = deleteRegionB =<< regionOfPartB Line Forward---- | Delete whole line moving to the next line-deleteLineForward :: BufferM ()-deleteLineForward =-  do moveToSol   -- Move to the start of the line-     deleteToEol -- Delete the rest of the line not including the newline char-     deleteN 1   -- Delete the newline character----- | Transpose two characters, (the Emacs C-t action)-swapB :: BufferM ()-swapB = do eol <- atEol-           when eol leftB-           transposeB Character Forward---- | Delete trailing whitespace from all lines-deleteTrailingSpaceB :: BufferM ()-deleteTrailingSpaceB =-  regionOfB Document >>= modifyRegionB (tru . mapLines stripEnd)-  where-    -- Strips the space from the end of each line, preserving-    -- newlines.-    stripEnd :: R.YiString -> R.YiString-    stripEnd x = case R.last x of-      Nothing -> x-      Just '\n' -> (`R.snoc` '\n') $ R.dropWhileEnd isSpace x-      _ -> R.dropWhileEnd isSpace x--    -- | Cut off trailing newlines, making sure to preserve one.-    tru :: R.YiString -> R.YiString-    tru x = if R.length x == 0-            then x-            else (`R.snoc` '\n') $ R.dropWhileEnd (== '\n') x---- ------------------------------------------------------- | Marks---- | Set the current buffer selection mark-setSelectionMarkPointB :: Point -> BufferM ()-setSelectionMarkPointB p = (.= p) . markPointA =<< selMark <$> askMarks---- | Get the current buffer selection mark-getSelectionMarkPointB :: BufferM Point-getSelectionMarkPointB = use . markPointA =<< selMark <$> askMarks---- | Exchange point & mark.-exchangePointAndMarkB :: BufferM ()-exchangePointAndMarkB = do m <- getSelectionMarkPointB-                           p <- pointB-                           setSelectionMarkPointB p-                           moveTo m--getBookmarkB :: String -> BufferM Mark-getBookmarkB = getMarkB . Just----- ------------------------------------------------------------------------ Buffer operations--data BufferFileInfo =-    BufferFileInfo { bufInfoFileName :: FilePath-                   , bufInfoSize     :: Int-                   , bufInfoLineNo   :: Int-                   , bufInfoColNo    :: Int-                   , bufInfoCharNo   :: Point-                   , bufInfoPercent  :: T.Text-                   , bufInfoModified :: Bool-                   }---- | File info, size in chars, line no, col num, char num, percent-bufInfoB :: BufferM BufferFileInfo-bufInfoB = do-    s <- sizeB-    p <- pointB-    m <- gets isUnchangedBuffer-    l <- curLn-    c <- curCol-    nm <- gets identString-    let bufInfo = BufferFileInfo { bufInfoFileName = T.unpack nm-                                 , bufInfoSize     = fromIntegral s-                                 , bufInfoLineNo   = l-                                 , bufInfoColNo    = c-                                 , bufInfoCharNo   = p-                                 , bufInfoPercent  = getPercent p s-                                 , bufInfoModified = not m-                                 }-    return bufInfo---------------------------------- Window-related operations--upScreensB :: Int -> BufferM ()-upScreensB = scrollScreensB . negate--downScreensB :: Int -> BufferM ()-downScreensB = scrollScreensB---- | Scroll up 1 screen-upScreenB :: BufferM ()-upScreenB = scrollScreensB (-1)---- | Scroll down 1 screen-downScreenB :: BufferM ()-downScreenB = scrollScreensB 1---- | Scroll by n screens (negative for up)-scrollScreensB :: Int -> BufferM ()-scrollScreensB n = do-    h <- askWindow height-    scrollB $ n * max 0 (h - 3) -- subtract some amount to get some overlap (emacs-like).---- | Scroll according to function passed. The function takes the--- | Window height in lines, its result is passed to scrollB--- | (negative for up)-scrollByB :: (Int -> Int) -> Int -> BufferM ()-scrollByB f n = do h <- askWindow height-                   scrollB $ n * f h---- | Same as scrollB, but also moves the cursor-vimScrollB :: Int -> BufferM ()-vimScrollB n = do scrollB n-                  void $ lineMoveRel n---- | Same as scrollByB, but also moves the cursor-vimScrollByB :: (Int -> Int) -> Int -> BufferM ()-vimScrollByB f n = do h <- askWindow height-                      vimScrollB $ n * f h---- | Move to middle line in screen-scrollToCursorB :: BufferM ()-scrollToCursorB = do-    MarkSet f i _ <- markLines-    h <- askWindow height-    let m = f + (h `div` 2)-    scrollB $ i - m---- | Move cursor to the top of the screen-scrollCursorToTopB :: BufferM ()-scrollCursorToTopB = do-    MarkSet f i _ <- markLines-    scrollB $ i - f---- | Move cursor to the bottom of the screen-scrollCursorToBottomB :: BufferM ()-scrollCursorToBottomB = do-    MarkSet _ i _ <- markLines-    r <- winRegionB-    t <- lineOf (regionEnd r - 1)-    scrollB $ i - t---- | Scroll by n lines.-scrollB :: Int -> BufferM ()-scrollB n = do-  MarkSet fr _ _ <- askMarks-  savingPointB $ do-    moveTo =<< use (markPointA fr)-    void $ gotoLnFrom n-    (markPointA fr .=) =<< pointB-  w <- askWindow wkey-  (%=) pointFollowsWindowA (\old w' -> ((w == w') || old w'))----- Scroll line above window to the bottom.-scrollToLineAboveWindowB :: BufferM ()-scrollToLineAboveWindowB = do downFromTosB 0-                              replicateM_ 1 lineUp-                              scrollCursorToBottomB---- Scroll line below window to the top.-scrollToLineBelowWindowB :: BufferM ()-scrollToLineBelowWindowB = do upFromBosB 0-                              replicateM_ 1 lineDown-                              scrollCursorToTopB---- | Move the point to inside the viewable region-snapInsB :: BufferM ()-snapInsB = do-    movePoint <- use pointFollowsWindowA-    w <- askWindow wkey-    when (movePoint w) $ do-        r <- winRegionB-        p <- pointB-        moveTo $ max (regionStart r) $ min (regionEnd r) p---- | return index of Sol on line @n@ above current line-indexOfSolAbove :: Int -> BufferM Point-indexOfSolAbove n = pointAt $ gotoLnFrom (negate n)--data  RelPosition = Above | Below | Within-  deriving (Show)---- | return relative position of the point @p@--- relative to the region defined by the points @rs@ and @re@-pointScreenRelPosition :: Point -> Point -> Point -> RelPosition-pointScreenRelPosition p rs re-  | rs > p && p > re = Within-  | p < rs = Above-  | p > re = Below-pointScreenRelPosition _ _ _ = Within -- just to disable the non-exhaustive pattern match warning---- | Move the visible region to include the point-snapScreenB :: Maybe ScrollStyle ->BufferM Bool-snapScreenB style = do-    movePoint <- use pointFollowsWindowA-    w <- askWindow wkey-    if movePoint w then return False else do-        inWin <- pointInWindowB =<< pointB-        if inWin then return False else do-            h <- askWindow actualLines-            r <- winRegionB-            p <- pointB-            let gap = case style of-                        Just SingleLine -> case pointScreenRelPosition p (regionStart r) (regionEnd r) of-                                             Above  -> 0-                                             Below  -> h - 1-                                             Within -> 0 -- Impossible but handle it anyway-                        _               -> h `div` 2-            i <- indexOfSolAbove gap-            f <- fromMark <$> askMarks-            markPointA f .= i-            return True----- | Move to @n@ lines down from top of screen-downFromTosB :: Int -> BufferM ()-downFromTosB n = do-  moveTo =<< use . markPointA =<< fromMark <$> askMarks-  replicateM_ n lineDown---- | Move to @n@ lines up from the bottom of the screen-upFromBosB :: Int -> BufferM ()-upFromBosB n = do-  r <- winRegionB-  moveTo (regionEnd r - 1)-  moveToSol-  replicateM_ n lineUp---- | Move to middle line in screen-middleB :: BufferM ()-middleB = do-  w <- ask-  f <- fromMark <$> askMarks-  moveTo =<< use (markPointA f)-  replicateM_ (height w `div` 2) lineDown--pointInWindowB :: Point -> BufferM Bool-pointInWindowB p = nearRegion p <$> winRegionB---------------------------------- Region-related operations---- | Return the region between point and mark-getRawestSelectRegionB :: BufferM Region-getRawestSelectRegionB = do-  m <- getSelectionMarkPointB-  p <- pointB-  return $ mkRegion p m---- | Return the empty region if the selection is not visible.-getRawSelectRegionB :: BufferM Region-getRawSelectRegionB = do-  s <- use highlightSelectionA-  if s then getRawestSelectRegionB else do-     p <- pointB-     return $ mkRegion p p---- | Get the current region boundaries. Extended to the current selection unit.-getSelectRegionB :: BufferM Region-getSelectRegionB = do-  regionStyle <- getRegionStyle-  r <- getRawSelectRegionB-  convertRegionToStyleB r regionStyle---- | Select the given region: set the selection mark at the 'regionStart'--- and the current point at the 'regionEnd'.-setSelectRegionB :: Region -> BufferM ()-setSelectRegionB region = do-  assign highlightSelectionA True-  setSelectionMarkPointB $ regionStart region-  moveTo $ regionEnd region---- | Extend the selection mark using the given region.-extendSelectRegionB :: Region -> BufferM ()-extendSelectRegionB region = (setSelectRegionB . unionRegion region) =<< getSelectRegionB----------------------------------------------- Some line related movements/operations--deleteBlankLinesB :: BufferM ()-deleteBlankLinesB = do-  isThisBlank <- isBlank <$> readLnB-  when isThisBlank $ do-    p <- pointB-    -- go up to the 1st blank line in the group-    void $ whileB (R.null <$> getNextLineB Backward) lineUp-    q <- pointB-    -- delete the whole blank region.-    deleteRegionB $ mkRegion p q---- | Get a (lazy) stream of lines in the buffer, starting at the /next/ line--- in the given direction.-lineStreamB :: Direction -> BufferM [YiString]-lineStreamB dir = fmap rev . R.lines <$> (streamB dir =<< pointB)-  where-    rev = case dir of-      Forward -> id-      Backward -> R.reverse---- | Get the next line of text in the given direction. This returns--- simply 'Nothing' if there no such line.-getMaybeNextLineB :: Direction -> BufferM (Maybe YiString)-getMaybeNextLineB dir = listToMaybe <$> lineStreamB dir---- | The same as 'getMaybeNextLineB' but avoids the use of the 'Maybe'--- type in the return by returning the empty string if there is no--- next line.-getNextLineB :: Direction -> BufferM YiString-getNextLineB dir = fromMaybe R.empty <$> getMaybeNextLineB dir---- | Get closest line to the current line (not including the current--- line) in the given direction which satisfies the given condition.--- Returns 'Nothing' if there is no line which satisfies the--- condition.-getNextLineWhichB :: Direction -> (YiString -> Bool) -> BufferM (Maybe YiString)-getNextLineWhichB dir cond = listToMaybe . filter cond <$> lineStreamB dir---- | Returns the closest line to the current line which is non-blank,--- in the given direction. Returns the empty string if there is no--- such line (for example if we are on the top line already).-getNextNonBlankLineB :: Direction -> BufferM YiString-getNextNonBlankLineB dir =-  fromMaybe R.empty <$> getNextLineWhichB dir (not . R.null)----------------------------------------------------- Some more utility functions involving--- regions (generally that which is selected)---- | Uses a string modifying function to modify the current selection--- Currently unsets the mark such that we have no selection, arguably--- we could instead work out where the new positions should be--- and move the mark and point accordingly.-modifySelectionB :: (R.YiString -> R.YiString) -> BufferM ()-modifySelectionB = modifyExtendedSelectionB Character--modifyExtendedSelectionB :: TextUnit -> (R.YiString -> R.YiString) -> BufferM ()-modifyExtendedSelectionB unit transform-    = modifyRegionB transform =<< unitWiseRegion unit =<< getSelectRegionB---- | Prefix each line in the selection using the given string.-linePrefixSelectionB :: R.YiString -- ^ The string that starts a line comment-                     ->  BufferM ()-linePrefixSelectionB s =-  modifyExtendedSelectionB Line . overInit $ mapLines (s <>)---- | Uncomments the selection using the given line comment--- starting string. This only works for the comments which--- begin at the start of the line.-unLineCommentSelectionB :: R.YiString -- ^ The string which begins a-                                      -- line comment-                        -> R.YiString -- ^ A potentially shorter-                                      -- string that begins a comment-                        -> BufferM ()-unLineCommentSelectionB s1 s2 =-  modifyExtendedSelectionB Line $ mapLines unCommentLine-  where-  (l1, l2) = (R.length s1, R.length s2)--  unCommentLine :: R.YiString -> R.YiString-  unCommentLine line = case (R.splitAt l1 line, R.splitAt l2 line) of-    ((f, s) , (f', s')) | s1 == f   -> s-                        | s2 == f'  -> s'-                        | otherwise -> line---- | Just like 'toggleCommentSelectionB' but automatically inserts a--- whitespace suffix to the inserted comment string. In fact:-toggleCommentB :: R.YiString -> BufferM ()-toggleCommentB c = toggleCommentSelectionB (c `R.snoc` ' ') c---- | Toggle line comments in the selection by adding or removing a--- prefix to each line.-toggleCommentSelectionB :: R.YiString -> R.YiString -> BufferM ()-toggleCommentSelectionB insPrefix delPrefix = do-  l <- readUnitB Line-  if delPrefix == R.take (R.length delPrefix) l-    then unLineCommentSelectionB insPrefix delPrefix-    else linePrefixSelectionB insPrefix---- | Justifies all the lines of the selection to be the same as--- the top line.--- NOTE: if the selection begins part way along a line, the other--- lines will be justified only with respect to the part of the indentation--- which is selected.-justifySelectionWithTopB :: BufferM ()-justifySelectionWithTopB =-  modifySelectionB justifyLines-  where--  justifyLines :: R.YiString -> R.YiString-  justifyLines input =-    case R.lines input of-      []           -> ""-      [ one ]      -> one-      (top : _)    -> mapLines justifyLine input-        where-          -- The indentation of the top line.-          topIndent = R.takeWhile isSpace top--          -- Justify a single line by removing its current indentation-          -- and replacing it with that of the top line. Note that-          -- this will work even if the indentation contains tab-          -- characters.-          justifyLine :: R.YiString -> R.YiString-          justifyLine "" = ""-          justifyLine l  = topIndent <> R.dropWhile isSpace l---- | Replace the contents of the buffer with some string-replaceBufferContent :: YiString -> BufferM ()-replaceBufferContent newvalue = do-  r <- regionOfB Document-  replaceRegionB r newvalue---- | Fill the text in the region so it fits nicely 80 columns.-fillRegion :: Region -> BufferM ()-fillRegion = modifyRegionB (R.unlines . fillText 80)--fillParagraph :: BufferM ()-fillParagraph = fillRegion =<< regionOfB unitParagraph---- | Sort the lines of the region.-sortLines :: BufferM ()-sortLines = modifyExtendedSelectionB Line (onLines sort)---- | Helper function: revert the buffer contents to its on-disk version-revertB :: YiString -> UTCTime -> BufferM ()-revertB s now = do-    r <- regionOfB Document-    replaceRegionB r s-    markSavedB now---- get lengths of parts covered by block region------ Consider block region starting at 'o' and ending at 'z':------    start---      |---     \|/--- def foo(bar):---     baz------     ab---     xyz0---      /|\---       |---     finish------ shapeOfBlockRegionB returns (regionStart, [2, 2, 0, 1, 2])--- TODO: accept stickToEol flag-shapeOfBlockRegionB :: Region -> BufferM (Point, [Int])-shapeOfBlockRegionB reg = savingPointB $ do-    (l0, c0) <- getLineAndColOfPoint $ regionStart reg-    (l1, c1) <- getLineAndColOfPoint $ regionEnd reg-    let (left, top, bottom, right) = (min c0 c1, min l0 l1, max l0 l1, max c0 c1)-    lengths <- forM [top .. bottom] $ \l -> do-        void $ gotoLn l-        moveToColB left-        currentLeft <- curCol-        if currentLeft /= left-        then return 0-        else do-            moveToColB right-            rightAtEol <- atEol-            leftOnEol-            currentRight <- curCol-            return $ if currentRight == 0 && rightAtEol-                     then 0-                     else currentRight - currentLeft + 1-    startingPoint <- pointOfLineColB top left-    return (startingPoint, lengths)--leftEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]-leftEdgesOfRegionB Block reg = savingPointB $ do-    (l0, _) <- getLineAndColOfPoint $ regionStart reg-    (l1, _) <- getLineAndColOfPoint $ regionEnd reg-    moveTo $ regionStart reg-    fmap catMaybes $ forM [0 .. abs (l0 - l1)] $ \i -> savingPointB $ do-        void $ lineMoveRel i-        p <- pointB-        eol <- atEol-        return (if not eol then Just p else Nothing)-leftEdgesOfRegionB LineWise reg = savingPointB $ do-    lastSol <- do-        moveTo $ regionEnd reg-        moveToSol-        pointB-    let  go acc p = do moveTo p-                       moveToSol-                       edge <- pointB-                       if edge >= lastSol-                       then return $ reverse (edge:acc)-                       else do-                           void $ lineMoveRel 1-                           go (edge:acc) =<< pointB-    go [] (regionStart reg)-leftEdgesOfRegionB _ r = return [regionStart r]--rightEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]-rightEdgesOfRegionB Block reg = savingPointB $ do-    (l0, _) <- getLineAndColOfPoint $ regionStart reg-    (l1, _) <- getLineAndColOfPoint $ regionEnd reg-    moveTo $ 1 + regionEnd reg-    fmap (reverse . catMaybes) $ forM [0 .. abs (l0 - l1)] $ \i -> savingPointB $ do-        void $ lineMoveRel $ -i-        p <- pointB-        eol <- atEol-        return (if not eol then Just p else Nothing)-rightEdgesOfRegionB LineWise reg = savingPointB $ do-    lastEol <- do-        moveTo $ regionEnd reg-        moveToEol-        pointB-    let  go acc p = do moveTo p-                       moveToEol-                       edge <- pointB-                       if edge >= lastEol-                       then return $ reverse (edge:acc)-                       else do-                           void $ lineMoveRel 1-                           go (edge:acc) =<< pointB-    go [] (regionStart reg)-rightEdgesOfRegionB _ reg = savingPointB $ do-    moveTo $ regionEnd reg-    leftOnEol-    fmap return pointB--splitBlockRegionToContiguousSubRegionsB :: Region -> BufferM [Region]-splitBlockRegionToContiguousSubRegionsB reg = savingPointB $ do-    (start, lengths) <- shapeOfBlockRegionB reg-    moveTo start-    forM lengths $ \l -> do-        p0 <- pointB-        moveXorEol l-        p1 <- pointB-        let subRegion = mkRegion p0 p1-        moveTo p0-        void $ lineMoveRel 1-        return subRegion--deleteRegionWithStyleB :: Region -> RegionStyle -> BufferM Point-deleteRegionWithStyleB reg Block = savingPointB $ do-    (start, lengths) <- shapeOfBlockRegionB reg-    moveTo start-    forM_ (zip [1..] lengths) $ \(i, l) -> do-        deleteN l-        moveTo start-        lineMoveRel i-    return start--deleteRegionWithStyleB reg style = savingPointB $ do-    effectiveRegion <- convertRegionToStyleB reg style-    deleteRegionB effectiveRegion-    return $! regionStart effectiveRegion--readRegionRopeWithStyleB :: Region -> RegionStyle -> BufferM YiString-readRegionRopeWithStyleB reg Block = savingPointB $ do-    (start, lengths) <- shapeOfBlockRegionB reg-    moveTo start-    chunks <- forM lengths $ \l ->-        if l == 0-        then lineMoveRel 1 >> return mempty-        else do-            p <- pointB-            r <- readRegionB $ mkRegion p (p +~ Size l)-            void $ lineMoveRel 1-            return r-    return $ R.intersperse '\n' chunks-readRegionRopeWithStyleB reg style = readRegionB =<< convertRegionToStyleB reg style--insertRopeWithStyleB :: YiString -> RegionStyle -> BufferM ()-insertRopeWithStyleB rope Block = savingPointB $ do-  let ls = R.lines rope-      advanceLine = atLastLine >>= \case-        False -> void $ lineMoveRel 1-        True -> do-          col <- curCol-          moveToEol-          newlineB-          insertN $ R.replicateChar col ' '--  sequence_ $ intersperse advanceLine $ fmap (savingPointB . insertN) ls-insertRopeWithStyleB rope LineWise = do-    moveToSol-    savingPointB $ insertN rope-insertRopeWithStyleB rope _ = insertN rope---- consider the following buffer content------ 123456789--- qwertyuio--- asdfgh------ The following examples use characters from that buffer as points.--- h' denotes the newline after h------ 1 r -> 4 q--- 9 q -> 1 o--- q h -> y a--- a o -> h' q--- o a -> q h'--- 1 a -> 1 a------ property: fmap swap (flipRectangleB a b) = flipRectangleB b a-flipRectangleB :: Point -> Point -> BufferM (Point, Point)-flipRectangleB p0 p1 = savingPointB $ do-    (_, c0) <- getLineAndColOfPoint p0-    (_, c1) <- getLineAndColOfPoint p1-    case compare c0 c1 of-        EQ -> return (p0, p1)-        GT -> fmap swap $ flipRectangleB p1 p0-        LT -> do-            -- now we know that c0 < c1-            moveTo p0-            moveXorEol $ c1 - c0-            flippedP0 <- pointB-            return (flippedP0, p1 -~ Size (c1 - c0))--movePercentageFileB :: Int -> BufferM ()-movePercentageFileB i = do-    let f :: Double-        f = case fromIntegral i / 100.0 of-               x | x > 1.0 -> 1.0-                 | x < 0.0 -> 0.0 -- Impossible?-                 | otherwise -> x-    lineCount <- lineCountB-    void $ gotoLn $ floor (fromIntegral lineCount * f)-    firstNonSpaceB--findMatchingPairB :: BufferM ()-findMatchingPairB = do-    let go dir a b = goUnmatchedB dir a b >> return True-        goToMatch = do-          c <- readB-          case c of '(' -> go Forward  '(' ')'-                    ')' -> go Backward '(' ')'-                    '{' -> go Forward  '{' '}'-                    '}' -> go Backward '{' '}'-                    '[' -> go Forward  '[' ']'-                    ']' -> go Backward '[' ']'-                    _   -> otherChar-        otherChar = do eof <- atEof-                       eol <- atEol-                       if eof || eol-                           then return False-                           else rightB >> goToMatch-    p <- pointB-    foundMatch <- goToMatch-    unless foundMatch $ moveTo p---- Vim numbers---- | Increase (or decrease if negative) next number on line by n.-incrementNextNumberByB :: Int -> BufferM ()-incrementNextNumberByB n = do-    start <- pointB-    untilB_ (not <$> isNumberB) (moveXorSol 1)-    untilB_ (isNumberB) (moveXorEol 1)-    begin <- pointB-    beginIsEol <- atEol-    untilB_ (not <$> isNumberB) (moveXorEol 1)-    end <- pointB-    if beginIsEol then moveTo start-    else do modifyRegionB (increment n) (mkRegion begin end)-            moveXorSol 1---- | Increment number in string by n.-increment :: Int -> R.YiString -> R.YiString-increment n l = R.fromString $ go (R.toString l)-  where-    go ('0':'x':xs) = ((\ys -> '0':'x':ys) . (flip showHex "") . (+ n) . (fst . head . readHex)) xs-    go ('0':'o':xs) = ((\ys -> '0':'o':ys) . (flip showOct "") . (+ n) . (fst . head . readOct)) xs-    go s            = (show . (+ n) . (\x -> read x :: Int)) s---- | Is character under cursor a number.-isNumberB :: BufferM Bool-isNumberB = do-    eol <- atEol-    sol <- atSol-    if sol then isDigit <$> readB-    else if eol then return False-         else test3CharB---- | Used by isNumber to test if current character under cursor is a number.-test3CharB :: BufferM Bool-test3CharB = do-    moveXorSol 1-    previous <- readB-    moveXorEol 2-    next <- readB-    moveXorSol 1-    current <- readB-    if | previous == '0' && current == 'o' && isOctDigit next -> return True  -- octal format-       | previous == '0' && current == 'x' && isHexDigit next -> return True  -- hex format-       |                    current == '-' && isDigit next    -> return True  -- negative numbers-       |                    isDigit current                   -> return True  -- all decimal digits-       |                    isHexDigit current                -> testHexB     -- ['a'..'f'] for hex-       | otherwise                                            -> return False---- | Characters ['a'..'f'] are part of a hex number only if preceded by 0x.--- Test if the current occurence of ['a'..'f'] is part of a hex number.-testHexB :: BufferM Bool-testHexB = savingPointB $ do-    untilB_ (not . isHexDigit <$> readB) (moveXorSol 1)-    leftChar <- readB-    moveXorSol 1-    leftToLeftChar <- readB-    if leftChar == 'x' && leftToLeftChar == '0'-    then return True-    else return False
− src/library/Yi/Buffer/Implementation.hs 
@@ -1,444 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE PatternGuards #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Buffer.Implementation--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ 'Buffer' implementation, wrapping Rope--module Yi.Buffer.Implementation-  ( UIUpdate (..)-  , Update (..)-  , updateIsDelete-  , Point-  , Mark, MarkValue(..)-  , Size-  , Direction (..)-  , BufferImpl-  , Overlay, OvlLayer (..)-  , mkOverlay-  , overlayUpdate-  , applyUpdateI-  , isValidUpdate-  , reverseUpdateI-  , nelemsBI-  , sizeBI-  , newBI-  , solPoint-  , solPoint'-  , eolPoint-  , eolPoint'-  , charsFromSolBI-  , regexRegionBI-  , getMarkDefaultPosBI-  , modifyMarkBI-  , getMarkValueBI-  , getMarkBI-  , newMarkBI-  , deleteMarkValueBI-  , setSyntaxBI-  , addOverlayBI-  , delOverlayBI-  , delOverlayLayer-  , updateSyntax-  , getAst, focusAst-  , strokesRangesBI-  , getStream-  , getIndexedStream-  , lineAt-  , SearchExp-  , markPointAA-  , markGravityAA-  , mem-  ) where--import           Control.Applicative-import           Data.Array-import           Data.Binary-#if __GLASGOW_HASKELL__ < 708-import           Data.DeriveTH-#else-import           GHC.Generics (Generic)-#endif-import           Data.Function-import           Data.List (groupBy)-import qualified Data.Map as M-import           Data.Maybe-import           Data.Monoid-import           Yi.Rope (YiString)-import qualified Yi.Rope as R-import qualified Data.Set as Set-import           Data.Typeable-import           Yi.Buffer.Basic-import           Yi.Regex-import           Yi.Region-import           Yi.Style-import           Yi.Syntax-import           Yi.Utils--data MarkValue = MarkValue { markPoint :: !Point-                           , markGravity :: !Direction}-               deriving (Ord, Eq, Show, Typeable)--makeLensesWithSuffix "AA" ''MarkValue--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''MarkValue)-#else-deriving instance Generic MarkValue-instance Binary MarkValue-#endif--type Marks = M.Map Mark MarkValue--data HLState syntax = forall cache. HLState !(Highlighter cache syntax) !cache--data OvlLayer = UserLayer | HintLayer-  deriving (Ord, Eq)-data Overlay = Overlay {-                        overlayLayer :: OvlLayer,-                        -- underscores to avoid 'defined but not used'. Remove if desired-                        _overlayBegin :: MarkValue,-                        _overlayEnd :: MarkValue,-                        _overlayStyle :: StyleName-                       }-instance Eq Overlay where-    Overlay a b c _ == Overlay a' b' c' _ = a == a' && b == b' && c == c'--instance Ord Overlay where-    compare (Overlay a b c _) (Overlay a' b' c' _)-        = compare a a' `mappend` compare b b' `mappend` compare c c'---data BufferImpl syntax =-        FBufferData { mem        :: !YiString          -- ^ buffer text-                    , marks      :: !Marks                 -- ^ Marks for this buffer-                    , markNames  :: !(M.Map String Mark)-                    , hlCache    :: !(HLState syntax)       -- ^ syntax highlighting state-                    , overlays   :: !(Set.Set Overlay) -- ^ set of (non overlapping) visual overlay regions-                    , dirtyOffset :: !Point -- ^ Lowest modified offset since last recomputation of syntax-                    }-        deriving Typeable---dummyHlState :: HLState syntax-dummyHlState = HLState noHighlighter (hlStartState noHighlighter)---- Atm we can't store overlays because stylenames are functions (can't be serialized)--- TODO: ideally I'd like to get rid of overlays entirely; although we could imagine them storing mere styles.-instance Binary (BufferImpl ()) where-    put b = put (mem b) >> put (marks b) >> put (markNames b)-    get = FBufferData <$> get <*> get <*> get <*> pure dummyHlState <*> pure Set.empty <*> pure 0------ | Mutation actions (also used the undo or redo list)------ For the undo/redo, we use the /partial checkpoint/ (Berlage, pg16) strategy to store--- just the components of the state that change.------ Note that the update direction is only a hint for moving the cursor--- (mainly for undo purposes); the insertions and deletions are always--- applied Forward.-data Update = Insert {updatePoint :: !Point, updateDirection :: !Direction, insertUpdateString :: !YiString}-            | Delete {updatePoint :: !Point, updateDirection :: !Direction, deleteUpdateString :: !YiString}-              -- Note that keeping the text does not cost much: we keep the updates in the undo list;-              -- if it's a "Delete" it means we have just inserted the text in the buffer, so the update shares-              -- the data with the buffer. If it's an "Insert" we have to keep the data any way.--              deriving (Show, Typeable)--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''Update)-#else-deriving instance Generic Update-instance Binary Update-#endif--updateIsDelete :: Update -> Bool-updateIsDelete Delete {} = True-updateIsDelete Insert {} = False--updateString :: Update -> YiString-updateString (Insert _ _ s) = s-updateString (Delete _ _ s) = s--updateSize :: Update -> Size-updateSize = Size . fromIntegral . R.length . updateString--data UIUpdate = TextUpdate !Update-              | StyleUpdate !Point !Size-#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''UIUpdate)-#else-deriving instance Generic UIUpdate-instance Binary UIUpdate-#endif------------------------------------------------------- Low-level primitives.---- | New FBuffer filled from string.-newBI :: YiString -> BufferImpl ()-newBI s = FBufferData s M.empty M.empty dummyHlState Set.empty 0---- | Write string into buffer.-insertChars :: YiString -> YiString -> Point -> YiString-insertChars p cs (Point i) = left `R.append` cs `R.append` right-    where (left, right) = R.splitAt i p-{-# INLINE insertChars #-}---- | Write string into buffer.-deleteChars :: YiString -> Point -> Size -> YiString-deleteChars p (Point i) (Size n) = left `R.append` right-    where (left, rest) = R.splitAt i p-          right = R.drop n rest-{-# INLINE deleteChars #-}----------------------------------------------------------------------------- Mid-level insert/delete---- | Shift a mark position, supposing an update at a given point, by a given amount.--- Negative amount represent deletions.-shiftMarkValue :: Point -> Size -> MarkValue -> MarkValue-shiftMarkValue from by (MarkValue p gravity) = MarkValue shifted gravity-    where shifted | p < from  = p-                  | p == from = case gravity of-                                  Backward -> p-                                  Forward -> p'-                  | otherwise {- p > from -} = p'-              where p' = max from (p +~ by)--mapOvlMarks :: (MarkValue -> MarkValue) -> Overlay -> Overlay-mapOvlMarks f (Overlay l s e v) = Overlay l (f s) (f e) v------------------------------------------ * "high-level" (exported) operations---- | Point of EOF-sizeBI :: BufferImpl syntax -> Point-sizeBI = Point . R.length . mem---- | Return @n@ Chars starting at @i@ of the buffer.-nelemsBI :: Int -> Point -> BufferImpl syntax -> YiString-nelemsBI n (Point i) = R.take n . R.drop i . mem--getStream :: Direction -> Point -> BufferImpl syntax -> YiString-getStream Forward  (Point i) = R.drop i . mem-getStream Backward (Point i) = R.reverse . R.take i . mem---- | TODO: This guy is a pretty big bottleneck and only one function--- uses it which in turn is only seldom used and most of the output is--- thrown away anyway. We could probably get away with never--- converting this to String here. The old implementation did so--- because it worked over ByteString but we don't have to.-getIndexedStream :: Direction -> Point -> BufferImpl syntax -> [(Point,Char)]-getIndexedStream Forward  (Point p) = zip [Point p..] . R.toString . R.drop p . mem-getIndexedStream Backward (Point p) = zip (dF (pred (Point p))) . R.toReverseString . R.take p . mem-    where-      dF n = n : dF (pred n)---- | Create an "overlay" for the style @sty@ between points @s@ and @e@-mkOverlay :: OvlLayer -> Region -> StyleName -> Overlay-mkOverlay l r = Overlay l (MarkValue (regionStart r) Backward) (MarkValue (regionEnd r) Forward)---- | Obtain a style-update for a specific overlay-overlayUpdate :: Overlay -> UIUpdate-overlayUpdate (Overlay _l (MarkValue s _) (MarkValue e _) _) = StyleUpdate s (e ~- s)---- | Add a style "overlay" between the given points.-addOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax-addOverlayBI ov fb = fb{overlays = Set.insert ov (overlays fb)}---- | Remove a previously added "overlay"-delOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax-delOverlayBI ov fb = fb{overlays = Set.delete ov (overlays fb)}--delOverlayLayer :: OvlLayer -> BufferImpl syntax -> BufferImpl syntax-delOverlayLayer layer fb = fb{overlays = Set.filter ((/= layer) . overlayLayer) (overlays fb)}--- FIXME: this can be really inefficient.---- | Return style information for the range @(i,j)@ Style information---   is derived from syntax highlighting, active overlays and current regexp.  The---   returned list contains tuples @(l,s,r)@ where every tuple is to---   be interpreted as apply the style @s@ from position @l@ to @r@ in---   the buffer.  In each list, the strokes are guaranteed to be---   ordered and non-overlapping.  The lists of strokes are ordered by---   decreasing priority: the 1st layer should be "painted" on top.-strokesRangesBI :: (Point -> Point -> Point -> [Stroke]) ->-  Maybe SearchExp -> Region -> Point -> BufferImpl syntax -> [[Stroke]]-strokesRangesBI getStrokes regex rgn  point fb = result-  where-    i = regionStart rgn-    j = regionEnd rgn-    dropBefore = dropWhile (\s ->spanEnd s <= i)-    takeIn  = takeWhile (\s -> spanBegin s <= j)--    groundLayer = [Span i mempty j]--    -- zero-length spans seem to break stroking in general, so filter them out!-    syntaxHlLayer = filter (\(Span b _m a) -> b /= a)  $ getStrokes point i j--    layers2 = map (map overlayStroke) $ groupBy ((==) `on` overlayLayer) $  Set.toList $ overlays fb-    layer3 = case regex of-               Just re -> takeIn $ map hintStroke $ regexRegionBI re (mkRegion i j) fb-               Nothing -> []-    result = map (map clampStroke . takeIn . dropBefore) (layer3 : layers2 ++ [syntaxHlLayer, groundLayer])-    overlayStroke (Overlay _ sm  em a) = Span (markPoint sm) a (markPoint em)-    clampStroke (Span l x r) = Span (max i l) x (min j r)-    hintStroke r = Span (regionStart r) (if point `nearRegion` r then strongHintStyle else hintStyle) (regionEnd r)----------------------------------------------------------------------------- Point based editing---- | Checks if an Update is valid-isValidUpdate :: Update -> BufferImpl syntax -> Bool-isValidUpdate u b = case u of-                    (Delete p _ _)   -> check p && check (p +~ updateSize u)-                    (Insert p _ _)   -> check p-    where check (Point x) = x >= 0 && x <= R.length (mem b)---- | Apply a /valid/ update-applyUpdateI :: Update -> BufferImpl syntax -> BufferImpl syntax-applyUpdateI u fb = touchSyntax (updatePoint u) $-                    fb {mem = p', marks = M.map shift (marks fb),-                                   overlays = Set.map (mapOvlMarks shift) (overlays fb)}-                                   -- FIXME: this is inefficient; find a way to use mapMonotonic-                                   -- (problem is that marks can have different gravities)-    where (p', amount) = case u of-                           Insert pnt _ cs -> (insertChars p cs pnt, sz)-                           Delete pnt _ _  -> (deleteChars p pnt sz, negate sz)-          sz = updateSize u-          shift = shiftMarkValue (updatePoint u) amount-          p = mem fb-          -- FIXME: remove collapsed overlays---- | Reverse the given update-reverseUpdateI :: Update -> Update-reverseUpdateI (Delete p dir cs) = Insert p (reverseDir dir) cs-reverseUpdateI (Insert p dir cs) = Delete p (reverseDir dir) cs------------------------------------------------------------------------------ Line based editing---- | Line at the given point. (Lines are indexed from 1)-lineAt :: Point -- ^ Line for which to grab EOL for-       -> BufferImpl syntax -> Int-lineAt (Point p) fb = 1 + R.countNewLines (R.take p $ mem fb)---- | Point that starts the given line (Lines are indexed from 1)-solPoint :: Int -> BufferImpl syntax -> Point-solPoint line fb = Point $ R.length $ fst $ R.splitAtLine (line - 1) (mem fb)---- | Point that's at EOL. Notably, this puts you right before the--- newline character if one exists, and right at the end of the text--- if one does not.-eolPoint :: Int -- ^ Line for which to grab EOL for-         -> BufferImpl syntax -> Point-eolPoint l = Point . checkEol . fst . R.splitAtLine l . mem-  where-    -- In case we're somewhere without trailing newline, we need to stay where we are-    checkEol t = let l' = R.length t in case R.last t of-      Just '\n' -> l' - 1-      _ -> l'---- | Get begining of the line relatively to @point@.-solPoint' :: Point -> BufferImpl syntax -> Point-solPoint' point fb = solPoint (lineAt point fb) fb---- | Get end of the line relative to the point.-eolPoint' :: Point -> BufferImpl s -> Point-eolPoint' p fb = eolPoint (lineAt p fb) fb--charsFromSolBI :: Point -> BufferImpl syntax -> YiString-charsFromSolBI pnt fb = nelemsBI (fromIntegral $ pnt - sol) sol fb-    where sol = solPoint' pnt fb---- | Return indices of all strings in buffer matching regex, inside the given region.-regexRegionBI :: SearchExp -> Region -> forall syntax. BufferImpl syntax -> [Region]-regexRegionBI se r fb = case dir of-     Forward  -> fmap (fmapRegion addPoint . matchedRegion) $ matchAll' $ R.toString        bufReg-     Backward -> fmap (fmapRegion subPoint . matchedRegion) $ matchAll' $ R.toReverseString bufReg-    where matchedRegion arr = let (off,len) = arr!0 in mkRegion (Point off) (Point (off+len))-          addPoint (Point x) = Point (p + x)-          subPoint (Point x) = Point (q - x)-          matchAll' = matchAll (searchRegex dir se)-          dir = regionDirection r-          Point p = regionStart r-          Point q = regionEnd r-          Size s = regionSize r-          bufReg = R.take s . R.drop p $ mem fb--newMarkBI :: MarkValue -> BufferImpl syntax -> (BufferImpl syntax, Mark)-newMarkBI initialValue fb =-    let maxId = fromMaybe 0 $ markId . fst . fst <$> M.maxViewWithKey (marks fb)-        newMark = Mark $ maxId + 1-        fb' = fb { marks = M.insert newMark initialValue (marks fb)}-    in (fb', newMark)--getMarkValueBI :: Mark -> BufferImpl syntax -> Maybe MarkValue-getMarkValueBI m (FBufferData { marks = marksMap } ) = M.lookup m marksMap--deleteMarkValueBI :: Mark -> BufferImpl syntax -> BufferImpl syntax-deleteMarkValueBI m fb = fb { marks = M.delete m (marks fb) }--getMarkBI :: String -> BufferImpl syntax -> Maybe Mark-getMarkBI name FBufferData {markNames = nms} = M.lookup name nms---- | Modify a mark value.-modifyMarkBI :: Mark -> (MarkValue -> MarkValue) -> (forall syntax. BufferImpl syntax -> BufferImpl syntax)-modifyMarkBI m f fb = fb {marks = mapAdjust' f m (marks fb)}--- NOTE: we must insert the value strictly otherwise we can hold to whatever structure the value of the mark depends on.--- (often a whole buffer)--setSyntaxBI :: ExtHL syntax -> BufferImpl oldSyntax -> BufferImpl syntax-setSyntaxBI (ExtHL e) fb = touchSyntax 0 $ fb {hlCache = HLState e (hlStartState e)}--touchSyntax ::  Point -> BufferImpl syntax -> BufferImpl syntax-touchSyntax touchedIndex fb = fb { dirtyOffset = min touchedIndex (dirtyOffset fb)}--updateSyntax :: BufferImpl syntax -> BufferImpl syntax-updateSyntax fb@FBufferData {dirtyOffset = touchedIndex, hlCache = HLState hl cache}-    | touchedIndex == maxBound = fb-    | otherwise-    = fb {dirtyOffset = maxBound,-          hlCache = HLState hl (hlRun hl getText touchedIndex cache)-         }-    where getText = Scanner 0 id (error "getText: no character beyond eof")-                     (\idx -> getIndexedStream Forward idx fb)------------------------------------------------------------------------------ | Returns the requested mark, creating a new mark with that name (at the supplied position) if needed-getMarkDefaultPosBI :: Maybe String -> Point -> BufferImpl syntax -> (BufferImpl syntax, Mark)-getMarkDefaultPosBI name defaultPos fb@FBufferData {marks = mks, markNames = nms} =-  case flip M.lookup nms =<< name of-    Just m' -> (fb, m')-    Nothing ->-           let newMark = Mark (1 + max 1 (markId $ fst (M.findMax mks)))-               nms' = case name of-                        Nothing -> nms-                        Just nm -> M.insert nm newMark nms-               mks' = M.insert newMark (MarkValue defaultPos Forward) mks-           in (fb {marks = mks', markNames = nms'}, newMark)---getAst :: WindowRef -> BufferImpl syntax -> syntax-getAst w FBufferData {hlCache = HLState (SynHL {hlGetTree = gt}) cache} = gt cache w--focusAst ::  M.Map WindowRef Region -> BufferImpl syntax -> BufferImpl syntax-focusAst r b@FBufferData {hlCache = HLState s@(SynHL {hlFocus = foc}) cache} = b {hlCache = HLState s (foc r cache)}
− src/library/Yi/Buffer/Indent.hs 
@@ -1,357 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Buffer.Region--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Handles indentation in the keymaps. Includes:------  * (TODO) Auto-indentation to the previous lines indentation---  * Tab-expansion---  * Shifting of the indentation for a region of text--module Yi.Buffer.Indent-    ( autoIndentB-    , cycleIndentsB-    , indentAsNextB-    , indentAsPreviousB-    , indentAsTheMostIndentedNeighborLineB-    , indentOfB-    , indentOfCurrentPosB-    , indentSettingsB-    , indentToB-    , newlineAndIndentB-    , shiftIndentOfRegionB-    , tabB-    ) where--import           Control.Applicative-import           Control.Monad (when)-import           Data.Char-import           Data.List (sort, nub)-import           Data.Monoid-import           Yi.Buffer.Basic-import           Yi.Buffer.HighLevel-import           Yi.Buffer.Misc-import           Yi.Buffer.Normal-import           Yi.Buffer.Region-import           Yi.Rope (YiString)-import qualified Yi.Rope as R-import           Yi.String--{- |-  Return either a \t or the number of spaces specified by tabSize in the-  IndentSettings. Note that if you actually want to insert a tab character-  (for example when editing makefiles) then you should use: @insertB '\t'@.--}-tabB :: BufferM String-tabB = do-  indentSettings <- indentSettingsB-  return $ if expandTabs indentSettings-    then replicate (tabSize indentSettings) ' '-    else "\t"--{-|-  A specialisation of 'autoIndentHelperB'.-  This is the most basic and the user is encouraged to-  specialise 'autoIndentHelperB' on their own.--}-autoIndentB :: IndentBehaviour -> BufferM ()-autoIndentB = autoIndentHelperB fetchPreviousIndentsB indentsOfString-  where-  -- Returns the indentation hints considering the given-  -- string as the line above the current one.-  -- The hints added are:-  --     The indent of the given string-  --     The indent of the given string plus two-  --     The offset of the last open bracket if any in the line.-  indentsOfString :: YiString -> BufferM [Int]-  indentsOfString input = do-    indent       <- indentOfB input-    bracketHints <- lastOpenBracketHint input-    indentSettings <- indentSettingsB-    return $ indent : (indent + shiftWidth indentSettings) : bracketHints--{-|-  This takes two arguments the first is a function to-  obtain indentation hints from lines above the current one.-  The second is a function to obtain a set of indentation hints-  from the previous line. Both of these are in the 'BufferM'-  monad although the second seems like it is unnecessary.-  However we must take into account the length of tabs which come-  from the the tab settings and hence we must be in the 'BufferM'-  monad.--  To get the straightforward behaviour of the indents of all previous-  lines until one of them has zero indent call this with:-  @autoIndentHelperB fetchPreviousIndentsB (fmap (: []) indentOfB)@-  However commonly we wish to have something more interesting for-  the second argument, in particular we commonly wish to have the-  last opening bracket of the previous line as well as its indent.--}-autoIndentHelperB :: BufferM [ Int ]-                  -- ^ Action to fetch hints from previous lines-                 -> (YiString -> BufferM [ Int ])-                 -- ^ Action to calculate hints from previous line-                 -> IndentBehaviour-                 -- ^ Sets the indent behaviour,-                 -- see 'Yi.Buffer.IndentBehaviour' for a description-                 -> BufferM ()-autoIndentHelperB getUpwards getPrevious indentBehave =-  do upwardHints   <- savingExcursionB getUpwards-     previousLine  <- getNextLineB Backward-     previousHints <- getPrevious previousLine-     let allHints = upwardHints ++ previousHints-     cycleIndentsB indentBehave allHints---- | Cycles through the indentation hints. It does this without--- requiring to set/get any state. We just look at the current--- indentation of the current line and moving to the largest--- indent that is-cycleIndentsB :: IndentBehaviour -> [Int] -> BufferM ()-cycleIndentsB _ [] = return ()-cycleIndentsB indentBehave indents =-    do currentLine   <- readLnB-       currentIndent <- indentOfB currentLine-       indentToB $ chooseIndent currentIndent (sort $ nub indents)-  where-  -- Is the function to choose the indent from the given current-  -- indent to the given list of indentation hints.-  chooseIndent :: Int -> [ Int ] -> Int-  chooseIndent =-    case indentBehave of-      IncreaseCycle -> chooseIncreaseCycle-      DecreaseCycle -> chooseDecreaseCycle-      IncreaseOnly  -> chooseIncreaseOnly-      DecreaseOnly  -> chooseDecreaseOnly----  -- Choose the indentation hint which is one more than the current-  -- indentation hint unless the current is the largest or larger than-  -- all the indentation hints in which case choose the smallest-  -- (which will often be zero)-  chooseIncreaseCycle :: Int -> [ Int ] -> Int-  chooseIncreaseCycle currentIndent hints =-    -- Similarly to 'chooseDecreasing' if 'above' is null then-    -- we will go to the first of below which will be the smallest-    -- indentation hint, if above is not null then we are moving to-    -- the indentation hint which is one above the current.-    head (above ++ below)-    where-    (below, above) = span (<= currentIndent) hints--  -- Note that these functions which follow generally assume that-  -- the list of hints which have been given is already sorted-  -- and that the list is non-empty--  -- Choose the indentation hint one less than the current indentation-  -- unless the current indentation is the smallest (usually zero)-  -- in which case choose the largest indentation hint.-  chooseDecreaseCycle :: Int -> [ Int ] -> Int-  chooseDecreaseCycle currentIndent hints =-    -- So in particular if 'below' is null then we will-    -- go to the largest indentation, if below is not null-    -- we go to the largest indentation which is *not* higher-    -- than the current one.-    last (above ++ below)-    where-    (below, above) = span (< currentIndent) hints--  chooseIncreaseOnly :: Int -> [ Int ] -> Int-  chooseIncreaseOnly currentIndent hints =-    head $ filter (> currentIndent) hints ++ [ currentIndent ]--  chooseDecreaseOnly :: Int -> [ Int ] -> Int-  chooseDecreaseOnly currentIndent hints =-    last $ currentIndent : filter (< currentIndent) hints--{-|-  A function generally useful as the first argument to-  'autoIndentHelperB'. This searches the lines above-  the current line for the indentations of each line-  until we get to a line which has no indentation-  *and* is not empty. Indicating that we have reached-  the outer scope.--}-fetchPreviousIndentsB :: BufferM [Int]-fetchPreviousIndentsB = do-  -- Move up one line,-  moveOffset <- lineMoveRel (-1)-  line       <- readLnB-  indent     <- indentOfB line-  -- So if we didn't manage to move upwards-  -- or the current offset was zero *and* the line-  -- was non-blank then we return just the current-  -- indent (it might be the first line but indented some.)-  if moveOffset == 0 || (indent == 0 && R.any (not . isSpace) line)-    then return [ indent ]-    else (indent :) <$> fetchPreviousIndentsB---- | Returns the position of the last opening bracket on the--- line which is not closed on the same line.--- Note that if we have unmatched parentheses such as "( ]"--- then we may not get the correct answer, but in that case--- then arguably we don't really care if we get the correct--- answer (at least if we get it wrong the user may notice--- their error).--- We return a list here as it's a convenient way of returning--- no hint in the case of there being no non-closed bracket--- and normally such a hint will be part of a list of hints--- anyway.--- NOTE: this could be easily modified to return the indentations--- of *all* the non-closed opening brackets. But I think this is--- not what you generally want.--- TODO: we also do not care whether or not the bracket is within--- a string or escaped. If someone feels up to caring about that--- by all means please fix this.-lastOpenBracketHint :: YiString -> BufferM [ Int ]-lastOpenBracketHint input =-  case getOpen 0 $ R.reverse input of-    Nothing -> return []-    Just s  -> return <$> spacingOfB s-  where-  -- We get the last open bracket by counting through-  -- the reversed line, when we see a closed bracket we-  -- add one to the count. When we see an opening bracket-  -- decrease the count. If we see an opening bracket when the-  -- count is 0 we return the remaining (reversed) string-  -- as the part of the line which preceds the last opening bracket.-  -- This can then be turned into an indentation by calling 'spacingOfB'-  -- on it so that tabs are counted as tab length.-  -- NOTE: that this will work even if tab occur in the middle of the line-  getOpen :: Int -> YiString -> Maybe YiString-  getOpen i s = let rest = R.drop 1 s in case R.head s of-    Nothing -> Nothing-    Just c-        -- If it is opening and we have no closing to match-        -- then we return the rest of the line-      | isOpening c && i == 0 -> Just rest-        -- If i is not zero then we have matched one of the-        -- closing parentheses and we can decrease the nesting count.-      | isOpening c           -> getOpen (i - 1) rest-        -- If the character is a closing bracket then we must increase-        -- the nesting count-      | isClosing c           -> getOpen (i + 1) rest-        -- If it is just a normal character forget about it and move on.-      | otherwise             -> getOpen i rest--  isOpening :: Char -> Bool-  isOpening '(' = True-  isOpening '[' = True-  isOpening '{' = True-  isOpening _   = False--  isClosing :: Char -> Bool-  isClosing ')' = True-  isClosing ']' = True-  isClosing '}' = True-  isClosing _   = False---- | Returns the indentation of a given string. Note that this depends---on the current indentation settings.-indentOfB :: YiString -> BufferM Int-indentOfB = spacingOfB . R.takeWhile isSpace---- | Returns the length of a given string taking into account the--- white space and the indentation settings.-spacingOfB :: YiString -> BufferM Int-spacingOfB text = do-  indentSettings <- indentSettingsB-  return $ countIndent indentSettings text--{-| Indents the current line to the given indentation level.-    In addition moves the point according to where it was on the-    line originally. If we were somewhere within the indentation-    (ie at the start of the line or on an empty line) then we want-    to just go to the end of the (new) indentation.-    However if we are currently pointing somewhere within the text-    of the line then we wish to remain pointing to the same character.--}-indentToB :: Int -> BufferM ()-indentToB level = do-  indentSettings <- indentSettingsB-  r <- regionOfB Line-  when (regionDirection r == Forward) $-    modifyRegionB (rePadString indentSettings level) r---- | Indent as much as the previous line-indentAsPreviousB :: BufferM ()-indentAsPreviousB = indentAsNeighborLineB Backward---- | Indent as much as the next line-indentAsNextB :: BufferM ()-indentAsNextB = indentAsNeighborLineB Forward--indentAsTheMostIndentedNeighborLineB :: BufferM ()-indentAsTheMostIndentedNeighborLineB = do-  prevLine <- getNextNonBlankLineB Backward-  nextLine <- getNextNonBlankLineB Forward-  prevIndent <- indentOfB prevLine-  nextIndent <- indentOfB nextLine-  indentToB (max prevIndent nextIndent)--indentAsNeighborLineB :: Direction -> BufferM ()-indentAsNeighborLineB dir = do-  otherLine   <- getNextNonBlankLineB dir-  otherIndent <- indentOfB otherLine-  indentToB otherIndent---- | Insert a newline at point and indent the new line as the previous one.-newlineAndIndentB :: BufferM ()-newlineAndIndentB = newlineB >> indentAsPreviousB---- | Set the padding of the string to newCount, filling in tabs if--- expandTabs is set in the buffers IndentSettings-rePadString :: IndentSettings -> Int -> R.YiString -> R.YiString-rePadString indentSettings newCount input-    | newCount <= 0 = rest-    | expandTabs indentSettings = R.replicateChar newCount ' ' <> rest-    | otherwise = tabs <> spaces <> rest-    where (_indents,rest) = R.span isSpace input-          tabs   = R.replicateChar (newCount `div` tabSize indentSettings) '\t'-          spaces = R.replicateChar (newCount `mod` tabSize indentSettings) ' '---- | Counts the size of the indent in the given text.------ Assumes nothing but tabs and spaces: uses 'isSpace'.-countIndent :: IndentSettings -> R.YiString -> Int-countIndent i t = R.foldl' (\i' c -> i' + spacing c) 0 indents-  where-    (indents, _) = R.span isSpace t--    spacing '\t' = tabSize i-    spacing _    = 1---- | shifts right (or left if num is negative) num times, filling in tabs if--- expandTabs is set in the buffers IndentSettings-indentString :: IndentSettings -> Int -> R.YiString -> R.YiString-indentString is numOfShifts i = rePadString is newCount i-    where-      newCount = countIndent is i + (shiftWidth is * numOfShifts)---- | Increases the indentation on the region by the given amount of shiftWidth-shiftIndentOfRegionB :: Int -> Region -> BufferM ()-shiftIndentOfRegionB shiftCount region = do-    is <- indentSettingsB-    let i :: R.YiString -> R.YiString-        i = indentString is shiftCount `unless` R.null-    modifyRegionB (mapLines i) region-    moveTo $ regionStart region-    firstNonSpaceB-  where (f `unless` c) x = if c x then x else f x---- | Return the number of spaces at the beginning of the line, up to--- the point.-indentOfCurrentPosB :: BufferM Int-indentOfCurrentPosB = do-  p <- pointB-  moveToSol-  sol <- pointB-  moveTo p-  let region = mkRegion p sol-  readRegionB region >>= spacingOfB
− src/library/Yi/Buffer/Misc.hs 
@@ -1,1062 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ImpredicativeTypes #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE FlexibleContexts #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Buffer.Misc--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ The 'Buffer' module defines monadic editing operations over one-dimensional--- buffers, maintaining a current /point/.--module Yi.Buffer.Misc-  ( FBuffer (FBuffer, bmode)-  , BufferM (..)-  , WinMarks, MarkSet (..)-  , bkey-  , getMarks-  , runBuffer-  , runBufferFull-  , runBufferDummyWindow-  , curLn-  , curCol-  , colOf-  , lineOf-  , lineCountB-  , sizeB-  , pointB-  , pointOfLineColB-  , solPointB-  , eolPointB-  , markLines-  , moveTo-  , moveToColB-  , moveToLineColB-  , lineMoveRel-  , lineUp-  , lineDown-  , newB-  , MarkValue(..)-  , Overlay, OvlLayer(..)-  , mkOverlay-  , gotoLn-  , gotoLnFrom-  , leftB-  , rightB-  , moveN-  , leftN-  , rightN-  , insertN-  , insertNAt-  , insertB-  , deleteN-  , nelemsB-  , writeB-  , writeN-  , newlineB-  , deleteNAt-  , readB-  , elemsB-  , undosA-  , undoB-  , redoB-  , getMarkB-  , setMarkHereB-  , setNamedMarkHereB-  , mayGetMarkB-  , getMarkValueB-  , markPointA-  , modifyMarkB-  , newMarkB-  , deleteMarkB-  , setVisibleSelection-  , isUnchangedBuffer-  , setAnyMode-  , setMode-  , setMode0-  , modifyMode-  , regexRegionB-  , regexB-  , readAtB-  , getModeLine-  , getPercent-  , setInserting-  , savingPrefCol-  , forgetPreferCol-  , movingToPrefCol-  , preferColA-  , markSavedB-  , addOverlayB-  , delOverlayB-  , delOverlayLayerB-  , savingExcursionB-  , savingPointB-  , pendingUpdatesA-  , highlightSelectionA-  , rectangleSelectionA-  , readOnlyA-  , insertingA-  , pointFollowsWindowA-  , revertPendingUpdatesB-  , askWindow-  , clearSyntax-  , focusSyntax-  , Mode (..)-  , modeNameA-  , modeAppliesA-  , modeHLA-  , modePrettifyA-  , modeKeymapA-  , modeIndentA-  , modeAdjustBlockA-  , modeFollowA-  , modeIndentSettingsA-  , modeToggleCommentSelectionA-  , modeGetStrokesA-  , modeOnLoadA-  , modeModeLineA-  , AnyMode (..)-  , IndentBehaviour (..)-  , IndentSettings (..)-  , expandTabsA-  , tabSizeA-  , shiftWidthA-  , modeAlwaysApplies-  , modeNeverApplies-  , emptyMode-  , withModeB-  , withMode0-  , onMode-  , withSyntaxB-  , withSyntaxB'-  , keymapProcessA-  , strokesRangesB-  , streamB-  , indexedStreamB-  , askMarks-  , pointAt-  , SearchExp-  , lastActiveWindowA-  , putBufferDyn-  , getBufferDyn-  , shortIdentString-  , identString-  , miniIdentString-  , identA-  , directoryContentA-  , BufferId(..)-  , file-  , lastSyncTimeA-  , replaceCharB-  , replaceCharWithBelowB-  , replaceCharWithAboveB-  , insertCharWithBelowB-  , insertCharWithAboveB-  , pointAfterCursorB-  , destinationOfMoveB-  , withEveryLineB-  , startUpdateTransactionB-  , commitUpdateTransactionB-  , applyUpdate-  , betweenB-  , decreaseFontSize-  , increaseFontSize-  , indentSettingsB-  ) where--import           Control.Applicative-import           Control.Lens hiding ((+~), Action, reversed, at, act)-import           Control.Monad.RWS.Strict hiding (mapM_, mapM, get, put,-                                                  forM_, forM)-import           Data.Binary-import           Data.Char(ord)-import           Data.Default-import           Data.Foldable-import           Data.Function hiding ((.), id)-import qualified Data.Map as M-import           Data.Maybe-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import           Data.Time-import           Data.Traversable-import           Data.DynamicState.Serializable-import           Numeric(showHex)-import           Prelude hiding (foldr, mapM, notElem)-import           System.FilePath-import           Yi.Buffer.Basic-import           Yi.Buffer.Implementation-import           Yi.Buffer.Undo-import           Yi.Interact as I-import           Yi.Monad-import           Yi.Region-import           Yi.Rope (YiString)-import qualified Yi.Rope as R-import           Yi.Syntax-import           Yi.Types-import           Yi.Utils-import           Yi.Window---- In addition to Buffer's text, this manages (among others):---  * Log of updates mades---  * Undo--makeClassyWithSuffix "A" ''Attributes--instance HasAttributes FBuffer where-    attributesA = lens attributes (\(FBuffer f1 f2 _) a -> FBuffer f1 f2 a)---- | Gets a short identifier of a buffer. If we're given a 'MemBuffer'--- then just wraps the buffer name like so: @*name*@. If we're given a--- 'FileBuffer', it drops the the number of characters specified.------ >>> shortIdentString 3 (MemBuffer "hello")--- "*hello*"--- >>> shortIdentString 3 (FileBuffer "hello")--- "lo"-shortIdentString :: Int -- ^ Number of characters to drop from FileBuffer names-                 -> FBuffer -- ^ Buffer to work with-                 -> T.Text-shortIdentString dl b = case b ^. identA of-  MemBuffer bName -> "*" <> bName <> "*"-  FileBuffer fName -> T.pack . joinPath . drop dl $ splitPath fName---- | Gets the buffer's identifier string, emphasising the 'MemBuffer':------ >>> identString (MemBuffer "hello")--- "*hello*"--- >>> identString (FileBuffer "hello")--- "hello"-identString :: FBuffer -> T.Text-identString b = case b ^. identA of-  MemBuffer bName -> "*" <> bName <> "*"-  FileBuffer fName -> T.pack fName----- TODO: proper instance + de-orphan-instance Show FBuffer where-    show b = Prelude.concat [ "Buffer #", show (bkey b)-                            , " (",  T.unpack (identString b), ")" ]---miniIdentString :: FBuffer -> T.Text-miniIdentString b = case b ^. identA of-  MemBuffer bufName -> bufName-  FileBuffer _ -> "MINIFILE:"---- unfortunately the dynamic stuff can't be read.-instance Binary FBuffer where-    put (FBuffer binmode r attributes_) =-      let strippedRaw :: BufferImpl ()-          strippedRaw = setSyntaxBI (modeHL emptyMode) r-      in do-          put binmode-          put strippedRaw-          put attributes_-    get = do-        FBuffer <$> get <*> getStripped <*> get-      where getStripped :: Get (BufferImpl ())-            getStripped = get---- | update the syntax information (clear the dirty "flag")-clearSyntax :: FBuffer -> FBuffer-clearSyntax = modifyRawbuf updateSyntax--queryRawbuf :: (forall syntax. BufferImpl syntax -> x) -> FBuffer -> x-queryRawbuf f (FBuffer _ fb _) = f fb--modifyRawbuf :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> FBuffer -> FBuffer-modifyRawbuf f (FBuffer f1 f2 f3) = FBuffer f1 (f f2) f3--queryAndModifyRawbuf :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) ->-                     FBuffer -> (FBuffer, x)-queryAndModifyRawbuf f (FBuffer f1 f5 f3) =-    let (f5', x) = f f5-    in (FBuffer f1 f5' f3, x)--file :: FBuffer -> Maybe FilePath-file b = case b ^. identA of-  FileBuffer f -> Just f-  MemBuffer _ -> Nothing--highlightSelectionA :: Lens' FBuffer Bool-highlightSelectionA = selectionStyleA .-  lens highlightSelection (\e x -> e { highlightSelection = x })--rectangleSelectionA :: Lens' FBuffer Bool-rectangleSelectionA = selectionStyleA .-  lens rectangleSelection (\e x -> e { rectangleSelection = x })---- | Just stores the mode name.-instance Binary (Mode syntax) where-    put = put . E.encodeUtf8 . modeName-    get = do-      n <- E.decodeUtf8 <$> get-      return (emptyMode {modeName = n})---- | Increases the font size in the buffer by specified number. What--- this number actually means depends on the front-end.-increaseFontSize :: Int -> BufferM ()-increaseFontSize x = fontsizeVariationA %= \fs -> max 1 (fs + x)---- | Decreases the font size in the buffer by specified number. What--- this number actually means depends on the front-end.-decreaseFontSize :: Int -> BufferM ()-decreaseFontSize x = fontsizeVariationA %= \fs -> max 1 (fs - x)---- | Given a buffer, and some information update the modeline------ N.B. the contents of modelines should be specified by user, and--- not hardcoded.-getModeLine :: [T.Text] -> BufferM T.Text-getModeLine prefix = withModeB (`modeModeLine` prefix)--defaultModeLine :: [T.Text] -> BufferM T.Text-defaultModeLine prefix = do-    col <- curCol-    pos <- pointB-    ln <- curLn-    p <- pointB-    s <- sizeB-    curChar <- readB-    ro <-use readOnlyA-    modeNm <- gets (withMode0 modeName)-    unchanged <- gets isUnchangedBuffer-    let pct-          | pos == 0 || s == 0 = " Top"-          | pos == s = " Bot"-          | otherwise = getPercent p s-        changed = if unchanged then "-" else "*"-        readOnly' = if ro then "%" else changed-        hexxed = T.pack $ showHex (ord curChar) ""-        hexChar = "0x" <> T.justifyRight 2 '0' hexxed-        toT = T.pack . show--    nm <- gets $ shortIdentString (length prefix)-    return $ T.concat [ readOnly', changed, " ", nm-                      , "     ", hexChar, "  "-                      , "L", T.justifyRight 5 ' ' (toT ln)-                      , "  "-                      , "C", T.justifyRight 3 ' ' (toT col)-                      , "  ", pct , "  ", modeNm , "  ", toT $ fromPoint p-                      ]---- | Given a point, and the file size, gives us a percent string-getPercent :: Point -> Point -> T.Text-getPercent a b = T.justifyRight 3 ' ' (T.pack $ show p) `T.snoc` '%'-    where p = ceiling (aa / bb * 100.0 :: Double) :: Int-          aa = fromIntegral a :: Double-          bb = fromIntegral b :: Double--queryBuffer :: (forall syntax. BufferImpl syntax -> x) -> BufferM x-queryBuffer = gets . queryRawbuf--modifyBuffer :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> BufferM ()-modifyBuffer = modify . modifyRawbuf--queryAndModify :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) -> BufferM x-queryAndModify = getsAndModify . queryAndModifyRawbuf---- | Adds an "overlay" to the buffer-addOverlayB :: Overlay -> BufferM ()-addOverlayB ov = do-  pendingUpdatesA %= (++ [overlayUpdate ov])-  modifyBuffer $ addOverlayBI ov---- | Remove an existing "overlay"-delOverlayB :: Overlay -> BufferM ()-delOverlayB ov = do-  pendingUpdatesA %= (++ [overlayUpdate ov])-  modifyBuffer $ delOverlayBI ov--delOverlayLayerB :: OvlLayer -> BufferM ()-delOverlayLayerB l =-  modifyBuffer $ delOverlayLayer l---- | Execute a @BufferM@ value on a given buffer and window.  The new state of--- the buffer is returned alongside the result of the computation.-runBuffer :: Window -> FBuffer -> BufferM a -> (a, FBuffer)-runBuffer w b f =-    let (a, _, b') = runBufferFull w b f-    in (a, b')--getMarks :: Window -> BufferM (Maybe WinMarks)-getMarks = gets . getMarksRaw--getMarksRaw :: Window -> FBuffer -> Maybe WinMarks-getMarksRaw w b = M.lookup (wkey w) (b ^. winMarksA)--runBufferFull :: Window -> FBuffer -> BufferM a -> (a, [Update], FBuffer)-runBufferFull w b f =-    let (a, b', updates) = runRWS (fromBufferM f') w b-        f' = do-            ms <- getMarks w-            when (isNothing ms) $ do-                -- this window has no marks for this buffer yet; have to create them.-                newMarkValues <- if wkey (b ^. lastActiveWindowA) == def-                    then return-                        -- no previous window, create some marks from scratch.-                         MarkSet { insMark = MarkValue 0 Forward,-                                   selMark = MarkValue 0 Backward, -- sel-                                   fromMark = MarkValue 0 Backward } -- from-                    else do-                        Just mrks  <- uses winMarksA (M.lookup $ wkey (b ^. lastActiveWindowA))-                        forM mrks getMarkValueB-                newMrks <- forM newMarkValues newMarkB-                winMarksA %= M.insert (wkey w) newMrks-            assign lastActiveWindowA w-            f-    in (a, updates, pendingUpdatesA %~ (++ fmap TextUpdate updates) $ b')--getMarkValueRaw :: Mark -> FBuffer -> MarkValue-getMarkValueRaw m = fromMaybe (MarkValue 0 Forward) . queryRawbuf (getMarkValueBI m)--getMarkValueB :: Mark -> BufferM MarkValue-getMarkValueB = gets . getMarkValueRaw--newMarkB :: MarkValue -> BufferM Mark-newMarkB v = queryAndModify $ newMarkBI v--deleteMarkB :: Mark -> BufferM ()-deleteMarkB m = modifyBuffer $ deleteMarkValueBI m---- | Execute a @BufferM@ value on a given buffer, using a dummy window.  The new state of--- the buffer is discarded.-runBufferDummyWindow :: FBuffer -> BufferM a -> a-runBufferDummyWindow b = fst . runBuffer (dummyWindow $ bkey b) b----- | Mark the current point in the undo list as a saved state.-markSavedB :: UTCTime -> BufferM ()-markSavedB t = do undosA %= setSavedFilePointU-                  assign lastSyncTimeA t--bkey :: FBuffer -> BufferRef-bkey = view bkey__A--isUnchangedBuffer :: FBuffer -> Bool-isUnchangedBuffer = isAtSavedFilePointU . view undosA--startUpdateTransactionB :: BufferM ()-startUpdateTransactionB = do-  transactionPresent <- use updateTransactionInFlightA-  if transactionPresent-  then error "Already started update transaction"-  else do-    undosA %= addChangeU InteractivePoint-    assign updateTransactionInFlightA True--commitUpdateTransactionB :: BufferM ()-commitUpdateTransactionB = do-  transactionPresent <- use updateTransactionInFlightA-  if not transactionPresent-  then error "Not in update transaction"-  else do-    assign updateTransactionInFlightA False-    transacAccum <- use updateTransactionAccumA-    assign updateTransactionAccumA []--    undosA %= (appEndo . mconcat) (Endo . addChangeU . AtomicChange <$> transacAccum)-    undosA %= addChangeU InteractivePoint---undoRedo :: (forall syntax. Mark -> URList -> BufferImpl syntax-             -> (BufferImpl syntax, (URList, [Update])))-         -> BufferM ()-undoRedo f = do-  m <- getInsMark-  ur <- use undosA-  (ur', updates) <- queryAndModify (f m ur)-  assign undosA ur'-  tell updates--undoB :: BufferM ()-undoB = do-    isTransacPresent <- use updateTransactionInFlightA-    if isTransacPresent-    then error "Can't undo while undo transaction is in progress"-    else undoRedo undoU--redoB :: BufferM ()-redoB = do-    isTransacPresent <- use updateTransactionInFlightA-    if isTransacPresent-    then error "Can't undo while undo transaction is in progress"-    else undoRedo redoU----- | Analogous to const, but returns a function that takes two parameters,--- rather than one.-const2 :: t -> t1 -> t2 -> t-const2 x _ _ = x---- | Mode applies function that always returns True.-modeAlwaysApplies :: a -> b -> Bool-modeAlwaysApplies = const2 True---- | Mode applies function that always returns False.-modeNeverApplies :: a -> b -> Bool-modeNeverApplies = const2 False--emptyMode :: Mode syntax-emptyMode = Mode-  {-   modeName = "empty",-   modeApplies = modeNeverApplies,-   modeHL = ExtHL noHighlighter,-   modePrettify = const $ return (),-   modeKeymap = id,-   modeIndent = \_ _ -> return (),-   modeAdjustBlock = \_ _ -> return (),-   modeFollow = const emptyAction,-   modeIndentSettings = IndentSettings-   { expandTabs = True-   , tabSize = 8-   , shiftWidth = 4-   },-   modeToggleCommentSelection = Nothing,-   modeGetStrokes = \_ _ _ _ -> [],-   modeOnLoad = return (),-   modeGotoDeclaration = return (),-   modeModeLine = defaultModeLine-  }---- | Create buffer named @nm@ with contents @s@-newB :: BufferRef -> BufferId -> YiString -> FBuffer-newB unique nm s =- FBuffer { bmode  = emptyMode-         , rawbuf = newBI s-         , attributes =- Attributes { ident  = nm-            , bkey__ = unique-            , undos  = emptyU-            , preferCol = Nothing-            , bufferDynamic = mempty-            , pendingUpdates = []-            , selectionStyle = SelectionStyle False False-            , keymapProcess = I.End-            , winMarks = M.empty-            , lastActiveWindow = dummyWindow unique-            , lastSyncTime = epoch-            , readOnly = False-            , directoryContent = False-            , inserting = True-            , pointFollowsWindow = const False-            , updateTransactionInFlight = False-            , updateTransactionAccum = []-            , fontsizeVariation = 0-            } }--epoch :: UTCTime-epoch = UTCTime (toEnum 0) (toEnum 0)---- | Point of eof-sizeB :: BufferM Point-sizeB = queryBuffer sizeBI---- | Extract the current point-pointB :: BufferM Point-pointB = use . markPointA =<< getInsMark--nelemsB :: Int -> Point -> BufferM YiString-nelemsB n i = R.take n <$> streamB Forward i--streamB :: Direction -> Point -> BufferM YiString-streamB dir i = queryBuffer $ getStream dir i--indexedStreamB :: Direction -> Point -> BufferM [(Point,Char)]-indexedStreamB dir i = queryBuffer $ getIndexedStream dir i--strokesRangesB :: Maybe SearchExp -> Region -> BufferM [[Stroke]]-strokesRangesB regex r = do-  p <- pointB-  getStrokes <- withSyntaxB modeGetStrokes-  queryBuffer $ strokesRangesBI getStrokes regex r p----------------------------------------------------------------------------- Point based operations---- | Move point in buffer to the given index-moveTo :: Point -> BufferM ()-moveTo x = do-  forgetPreferCol-  (.= x) . markPointA =<< getInsMark----------------------------------------------------------------------------setInserting :: Bool -> BufferM ()-setInserting = assign insertingA--checkRO :: BufferM Bool-checkRO = do-  ro <- use readOnlyA-  when ro (fail "Read Only Buffer")-  return ro--applyUpdate :: Update -> BufferM ()-applyUpdate update = do-  ro    <- checkRO-  valid <- queryBuffer (isValidUpdate update)-  when (not ro && valid) $ do-    forgetPreferCol-    let reversed = reverseUpdateI update-    modifyBuffer (applyUpdateI update)--    isTransacPresent <- use updateTransactionInFlightA-    if isTransacPresent-    then updateTransactionAccumA %= (reversed:)-    else undosA %= addChangeU (AtomicChange reversed)--    tell [update]-   -- otherwise, just ignore.---- | Revert all the pending updates; don't touch the point.-revertPendingUpdatesB :: BufferM ()-revertPendingUpdatesB = do-  updates <- use pendingUpdatesA-  modifyBuffer (flip (foldr (\u bi -> applyUpdateI (reverseUpdateI u) bi)) [u | TextUpdate u <- updates])---- | Write an element into the buffer at the current point.-writeB :: Char -> BufferM ()-writeB c = do-  deleteN 1-  insertB c---- | Write the list into the buffer at current point.-writeN :: YiString -> BufferM ()-writeN cs = do-  off <- pointB-  deleteNAt Forward (R.length cs) off-  insertNAt cs off---- | Insert newline at current point.-newlineB :: BufferM ()-newlineB = insertB '\n'------------------------------------------------------------------------------ | Insert given 'YiString' at specified point, extending size of the--- buffer.-insertNAt :: YiString -> Point -> BufferM ()-insertNAt rope pnt = applyUpdate (Insert pnt Forward rope)---- | Insert the 'YiString' at current point, extending size of buffer-insertN :: YiString -> BufferM ()-insertN cs = pointB >>= insertNAt cs---- | Insert the char at current point, extending size of buffer------ Implementation note: This just 'insertB's a 'R.singleton'. This--- seems sub-optimal because we should be able to do much better--- without spewing chunks of size 1 everywhere. This approach is--- necessary however so an 'Update' can be recorded. A possible--- improvement for space would be to have ‘yi-rope’ package optimise--- for appends with length 1.-insertB :: Char -> BufferM ()-insertB = insertN . R.singleton------------------------------------------------------------------------------ | @deleteNAt n p@ deletes @n@ characters forwards from position @p@-deleteNAt :: Direction -> Int -> Point -> BufferM ()-deleteNAt _ 0 _ = return ()-deleteNAt dir n pos = do-  els <- R.take n <$> streamB Forward pos-  applyUpdate $ Delete pos dir els------------------------------------------------------------------------------ Line based editing---- | Return the current line number-curLn :: BufferM Int-curLn = do-    p <- pointB-    queryBuffer (lineAt p)---- | Return line numbers of marks-markLines :: BufferM (MarkSet Int)-markLines = mapM getLn =<< askMarks-        where getLn m = use (markPointA m) >>= lineOf----- | Go to line number @n@. @n@ is indexed from 1. Returns the--- actual line we went to (which may be not be the requested line,--- if it was out of range)-gotoLn :: Int -> BufferM Int-gotoLn x = do-  moveTo 0-  succ <$> gotoLnFrom (x - 1)-------------------------------------------------------------------------setMode0 :: forall syntax. Mode syntax -> FBuffer -> FBuffer-setMode0 m (FBuffer _ rb at) = FBuffer m (setSyntaxBI (modeHL m) rb) at--modifyMode0 :: (forall syntax. Mode syntax -> Mode syntax) -> FBuffer -> FBuffer-modifyMode0 f (FBuffer m rb f3) = FBuffer m' (setSyntaxBI (modeHL m') rb) f3-  where m' = f m---- | Set the mode-setAnyMode :: AnyMode -> BufferM ()-setAnyMode (AnyMode m) = setMode m--setMode :: Mode syntax -> BufferM ()-setMode m = do-  modify (setMode0 m)-  -- reset the keymap process so we use the one of the new mode.-  assign keymapProcessA I.End-  modeOnLoad m---- | Modify the mode-modifyMode :: (forall syntax. Mode syntax -> Mode syntax) -> BufferM ()-modifyMode f = do-  modify (modifyMode0 f)-  -- reset the keymap process so we use the one of the new mode.-  assign keymapProcessA I.End--onMode :: (forall syntax. Mode syntax -> Mode syntax) -> AnyMode -> AnyMode-onMode f (AnyMode m) = AnyMode (f m)--withMode0 :: (forall syntax. Mode syntax -> a) -> FBuffer -> a-withMode0 f FBuffer {bmode = m} = f m--withModeB :: (forall syntax. Mode syntax -> BufferM a) -> BufferM a-withModeB = join . gets . withMode0--withSyntax0 :: (forall syntax. Mode syntax -> syntax -> a) -> WindowRef -> FBuffer -> a-withSyntax0 f wk (FBuffer bm rb _attrs) = f bm (getAst wk rb)---withSyntaxB :: (forall syntax. Mode syntax -> syntax -> a) -> BufferM a-withSyntaxB f = withSyntax0 f <$> askWindow wkey <*> use id---focusSyntax ::  M.Map WindowRef Region -> FBuffer -> FBuffer-focusSyntax r = modifyRawbuf (focusAst r)--withSyntaxB' :: (forall syntax. Mode syntax -> syntax -> BufferM a) -> BufferM a-withSyntaxB' = join . withSyntaxB---- | Return indices of strings in buffer matched by regex in the--- given region.-regexRegionB :: SearchExp -> Region -> BufferM [Region]-regexRegionB regex region = queryBuffer $ regexRegionBI regex region---- | Return indices of next string in buffer matched by regex in the--- given direction-regexB :: Direction -> SearchExp -> BufferM [Region]-regexB dir rx = do-  p <- pointB-  s <- sizeB-  regexRegionB rx (mkRegion p (case dir of Forward -> s; Backward -> 0))-------------------------------------------------------------------------modifyMarkRaw :: Mark -> (MarkValue -> MarkValue) -> FBuffer -> FBuffer-modifyMarkRaw m f = modifyRawbuf $ modifyMarkBI m f--modifyMarkB :: Mark -> (MarkValue -> MarkValue) -> BufferM ()-modifyMarkB = (modify .) . modifyMarkRaw--setMarkHereB :: BufferM Mark-setMarkHereB = getMarkB Nothing--setNamedMarkHereB :: String -> BufferM ()-setNamedMarkHereB name = do-    p <- pointB-    getMarkB (Just name) >>= (.= p) . markPointA---- | Highlight the selection-setVisibleSelection :: Bool -> BufferM ()-setVisibleSelection = assign highlightSelectionA--getInsMark :: BufferM Mark-getInsMark = insMark <$> askMarks--askMarks :: BufferM WinMarks-askMarks = do-    Just ms <- getMarks =<< ask-    return ms--getMarkB :: Maybe String -> BufferM Mark-getMarkB m = do-  p <- pointB-  queryAndModify (getMarkDefaultPosBI m p)--mayGetMarkB :: String -> BufferM (Maybe Mark)-mayGetMarkB m = queryBuffer (getMarkBI m)---- | Move point by the given number of characters.--- A negative offset moves backwards a positive one forward.-moveN :: Int -> BufferM ()-moveN n = do-    s <- sizeB-    moveTo =<< min s . max 0 . (+~ Size n) <$> pointB---- | Move point -1-leftB :: BufferM ()-leftB = leftN 1---- | Move cursor -n-leftN :: Int -> BufferM ()-leftN n = moveN (-n)---- | Move cursor +1-rightB :: BufferM ()-rightB = rightN 1---- | Move cursor +n-rightN :: Int -> BufferM ()-rightN = moveN---- ------------------------------------------------------------------------ Line based movement and friends---- | Move point down by @n@ lines. @n@ can be negative.--- Returns the actual difference in lines which we moved which--- may be negative if the requested line difference is negative.-lineMoveRel :: Int -> BufferM Int-lineMoveRel = movingToPrefCol . gotoLnFrom--movingToPrefCol :: BufferM a -> BufferM a-movingToPrefCol f = do-  prefCol <- use preferColA-  targetCol <- maybe curCol return prefCol-  r <- f-  moveToColB targetCol-  preferColA .= Just targetCol-  return r--moveToColB :: Int -> BufferM ()-moveToColB targetCol = do-  solPnt <- solPointB =<< pointB-  chrs <- R.toString <$> nelemsB targetCol solPnt-  is <- indentSettingsB-  let cols = scanl (colMove is) 0 chrs    -- columns corresponding to the char-      toSkip = takeWhile (\(char,col) -> char /= '\n' && col < targetCol) (zip chrs cols)-  moveTo $ solPnt +~ fromIntegral (length toSkip)--moveToLineColB :: Int -> Int -> BufferM ()-moveToLineColB line col = gotoLn line >> moveToColB col--pointOfLineColB :: Int -> Int -> BufferM Point-pointOfLineColB line col = savingPointB $ moveToLineColB line col >> pointB--forgetPreferCol :: BufferM ()-forgetPreferCol = preferColA .= Nothing--savingPrefCol :: BufferM a -> BufferM a-savingPrefCol f = do-  pc <- use preferColA-  result <- f-  preferColA .= pc-  return result---- | Move point up one line-lineUp :: BufferM ()-lineUp = void (lineMoveRel (-1))---- | Move point down one line-lineDown :: BufferM ()-lineDown = void (lineMoveRel 1)---- | Return the contents of the buffer.-elemsB :: BufferM YiString-elemsB = queryBuffer mem---- | Returns the contents of the buffer between the two points.------ If the @startPoint >= endPoint@, empty string is returned. If the--- points are out of bounds, as much of the content as possible is--- taken: you're not guaranteed to get @endPoint - startPoint@--- characters.-betweenB :: Point -- ^ Point to start at-         -> Point -- ^ Point to stop at-         -> BufferM YiString-betweenB (Point s) (Point e) =-  if s >= e-  then return mempty-  else snd . R.splitAt s . fst . R.splitAt e <$> elemsB---- | Read the character at the current point-readB :: BufferM Char-readB = pointB >>= readAtB---- | Read the character at the given index--- This is an unsafe operation: character NUL is returned when out of bounds-readAtB :: Point -> BufferM Char-readAtB i = R.head <$> nelemsB 1 i >>= return . \case-  Nothing -> '\0'-  Just c  -> c--replaceCharB :: Char -> BufferM ()-replaceCharB c = do-    writeB c-    leftB--replaceCharWithBelowB :: BufferM ()-replaceCharWithBelowB = replaceCharWithVerticalOffset 1--replaceCharWithAboveB :: BufferM ()-replaceCharWithAboveB = replaceCharWithVerticalOffset (-1)--insertCharWithBelowB :: BufferM ()-insertCharWithBelowB = maybe (return ()) insertB =<< maybeCharBelowB--insertCharWithAboveB :: BufferM ()-insertCharWithAboveB = maybe (return ()) insertB =<< maybeCharAboveB--replaceCharWithVerticalOffset :: Int -> BufferM ()-replaceCharWithVerticalOffset offset =-    maybe (return ()) replaceCharB =<< maybeCharWithVerticalOffset offset--maybeCharBelowB :: BufferM (Maybe Char)-maybeCharBelowB = maybeCharWithVerticalOffset 1--maybeCharAboveB :: BufferM (Maybe Char)-maybeCharAboveB = maybeCharWithVerticalOffset (-1)--maybeCharWithVerticalOffset :: Int -> BufferM (Maybe Char)-maybeCharWithVerticalOffset offset = savingPointB $ do-    l0 <- curLn-    c0 <- curCol-    void $ lineMoveRel offset-    l1 <- curLn-    c1 <- curCol-    curChar <- readB-    return $ if c0 == c1-                && l0 + offset == l1-                && curChar `notElem` ("\n\0" :: String)-             then Just curChar-             else Nothing---- | Delete @n@ characters forward from the current point-deleteN :: Int -> BufferM ()-deleteN n = pointB >>= deleteNAt Forward n------------------------------------------------------------------------------ | Gives the 'IndentSettings' for the current buffer.-indentSettingsB :: BufferM IndentSettings-indentSettingsB = withModeB $ return . modeIndentSettings---- | Current column.--- Note that this is different from offset or number of chars from sol.--- (This takes into account tabs, unicode chars, etc.)-curCol :: BufferM Int-curCol = colOf =<< pointB--colOf :: Point -> BufferM Int-colOf p = do-  is <- indentSettingsB-  R.foldl' (colMove is) 0 <$> queryBuffer (charsFromSolBI p)--lineOf :: Point -> BufferM Int-lineOf p = queryBuffer $ lineAt p--lineCountB :: BufferM Int-lineCountB = lineOf =<< sizeB---- | Decides which column we should be on after the given character.-colMove :: IndentSettings -> Int -> Char -> Int-colMove is col '\t' | tabSize is > 1 = col + tabSize is-colMove _  col _    = col + 1---- | Returns start of line point for a given point @p@-solPointB :: Point -> BufferM Point-solPointB p = queryBuffer $ solPoint' p---- | Returns end of line for given point.-eolPointB :: Point -> BufferM Point-eolPointB p = queryBuffer $ eolPoint' p---- | Go to line indexed from current point--- Returns the actual moved difference which of course--- may be negative if the requested difference was negative.-gotoLnFrom :: Int -> BufferM Int-gotoLnFrom x = do-    l <- curLn-    p' <- queryBuffer $ solPoint (l + x)-    moveTo p'-    l' <- curLn-    return (l' - l)---- | Access to a value into the extensible state, keyed by its type.---   This allows you to retrieve inside a 'BufferM' monad, ie:------ > value <- getBufferDyn-getBufferDyn :: (YiVariable a, MonadState FBuffer m, Functor m) => m a-getBufferDyn = fromMaybe def <$> getDyn (use bufferDynamicA) (assign bufferDynamicA)---- | Access to a value into the extensible state, keyed by its type.---   This allows you to save inside a 'BufferM' monad, ie:------ > putBufferDyn updatedvalue-putBufferDyn :: (YiVariable a, MonadState FBuffer m, Functor m) => a -> m ()-putBufferDyn = putDyn (use bufferDynamicA) (assign bufferDynamicA)---- | perform a @BufferM a@, and return to the current point. (by using a mark)-savingExcursionB :: BufferM a -> BufferM a-savingExcursionB f = do-    m <- getMarkB Nothing-    res <- f-    moveTo =<< use (markPointA m)-    return res--markPointA :: Mark -> Lens' FBuffer Point-markPointA mark = lens getter setter where-  getter b = markPoint $ getMarkValueRaw mark b-  setter b pos = modifyMarkRaw mark (\v -> v {markPoint = pos}) b---- | perform an @BufferM a@, and return to the current point-savingPointB :: BufferM a -> BufferM a-savingPointB f = savingPrefCol $ do-  p <- pointB-  res <- f-  moveTo p-  return res--pointAt :: BufferM a -> BufferM Point-pointAt f = savingPointB (f *> pointB)--pointAfterCursorB :: Point -> BufferM Point-pointAfterCursorB p = pointAt $ do-  moveTo p-  rightB---- | What would be the point after doing the given action?--- The argument must not modify the buffer.-destinationOfMoveB :: BufferM a -> BufferM Point-destinationOfMoveB f = savingPointB (f >> pointB)------------------ Window--askWindow :: (Window -> a) -> BufferM a-askWindow = asks--withEveryLineB :: BufferM () -> BufferM ()-withEveryLineB action = savingPointB $ do-  lineCount <- lineCountB-  forM_ [1 .. lineCount] $ \l -> do-    void $ gotoLn l-    action--makeLensesWithSuffix "A" ''IndentSettings-makeLensesWithSuffix "A" ''Mode
− src/library/Yi/Buffer/Normal.hs 
@@ -1,84 +0,0 @@-{-# LANGUAGE TemplateHaskell, CPP, StandaloneDeriving #-}---- | A normalized API to many buffer operations.---- The idea is that most operations should be parametric in both---  * the textual units they work on---  * the direction towards which they operate (if applicable)--module Yi.Buffer.Normal (TextUnit(Character, Line, VLine, Document, GenUnit),-                         outsideUnit,-                         leftBoundaryUnit,-                         unitWord,-                         unitViWord,-                         unitViWORD,-                         unitViWordAnyBnd,-                         unitViWORDAnyBnd,-                         unitViWordOnLine,-                         unitViWORDOnLine,-                         unitDelimited,-                         unitSentence, unitEmacsParagraph, unitParagraph,-                         isAnySep, unitSep, unitSepThisLine, isWordChar,-                         -- TextUnit is exported abstract intentionally:-                         -- we'd like to move more units to the GenUnit format.-                         moveB, maybeMoveB,-                         transformB, transposeB,-                         regionOfB, regionOfNonEmptyB, regionOfPartB,-                         regionOfPartNonEmptyB, regionOfPartNonEmptyAtB,-                         readPrevUnitB, readUnitB,-                         untilB, doUntilB_, untilB_, whileB, doIfCharB,-                         atBoundaryB,-                         numberOfB,-                         deleteB, genMaybeMoveB,-                         genMoveB, BoundarySide(..), genAtBoundaryB,-                         genEnclosingUnit, genUnitBoundary,-                         checkPeekB-                         , RegionStyle(..)-                         , mkRegionOfStyleB-                         , convertRegionToStyleB-                         , unitWiseRegion-                         , extendRegionToBoundaries-                         , getRegionStyle-                         , putRegionStyle-                         ) where--import Data.List (sort)-import Yi.Buffer.Basic-import Yi.Buffer.Misc-import Yi.Buffer.Region-import Yi.Buffer.TextUnit-import Yi.Types (RegionStyle(..))--getRegionStyle :: BufferM RegionStyle-getRegionStyle = getBufferDyn-putRegionStyle :: RegionStyle -> BufferM ()-putRegionStyle = putBufferDyn--convertRegionToStyleB :: Region -> RegionStyle -> BufferM Region-convertRegionToStyleB r = mkRegionOfStyleB (regionStart r) (regionEnd r)--mkRegionOfStyleB :: Point -> Point -> RegionStyle -> BufferM Region-mkRegionOfStyleB start' stop' regionStyle =-   let [start, stop] = sort [start', stop']-       region = mkRegion start stop in-   case regionStyle of-     LineWise  -> inclusiveRegionB =<< unitWiseRegion Line region-     Inclusive -> inclusiveRegionB region-     Exclusive -> return region-     Block     -> return region--unitWiseRegion :: TextUnit -> Region -> BufferM Region-unitWiseRegion unit = extendRegionToBoundaries unit InsideBound OutsideBound---- | Extend the given region to boundaries of the text unit.--- For instance one can extend the selection to complete lines, or--- paragraphs.-extendRegionToBoundaries :: TextUnit -> BoundarySide -> BoundarySide -> Region -> BufferM Region-extendRegionToBoundaries unit bs1 bs2 region = savingPointB $ do-  moveTo $ regionStart region-  genMaybeMoveB unit (Backward, bs1) Backward-  start <- pointB-  moveTo $ regionEnd region-  genMaybeMoveB unit (Forward, bs2) Forward-  stop <- pointB-  return $ mkRegion' (regionDirection region) start stop
− src/library/Yi/Buffer/Region.hs 
@@ -1,120 +0,0 @@-{-# LANGUAGE CPP #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Buffer.Region--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ This module defines buffer operation on regions--module Yi.Buffer.Region-  (-   module Yi.Region-  , swapRegionsB-  , deleteRegionB-  , replaceRegionB-  , readRegionB-  , mapRegionB-  , modifyRegionB-  , winRegionB-  , inclusiveRegionB-  , blockifyRegion-  , joinLinesB-  , concatLinesB-  )-where--import           Control.Applicative-import           Control.Monad-import           Data.Char (isSpace)-import           Data.Monoid (mconcat)-import           Data.List (sort)-import           Yi.Buffer.Misc-import           Yi.Region-import           Yi.Rope (YiString)-import qualified Yi.Rope as R-import           Yi.String (overInit)-import           Yi.Utils-import           Yi.Window (winRegion)--winRegionB :: BufferM Region-winRegionB = askWindow winRegion---- | Delete an arbitrary part of the buffer-deleteRegionB :: Region -> BufferM ()-deleteRegionB r = deleteNAt (regionDirection r) (fromIntegral (regionEnd r ~- regionStart r)) (regionStart r)--readRegionB :: Region -> BufferM YiString-readRegionB r = nelemsB (fromIntegral (regionEnd r - i)) i-    where i = regionStart r---- | Replace a region with a given rope.-replaceRegionB :: Region -> YiString -> BufferM ()-replaceRegionB r s = do-  deleteRegionB r-  insertNAt s $ regionStart r---- | Map the given function over the characters in the region.-mapRegionB :: Region -> (Char -> Char) -> BufferM ()-mapRegionB r f = do-  text <- readRegionB r-  replaceRegionB r (R.map f text)---- | Swap the content of two Regions-swapRegionsB :: Region -> Region -> BufferM ()-swapRegionsB r r'-    | regionStart r > regionStart r' = swapRegionsB r' r-    | otherwise = do w0 <- readRegionB r-                     w1 <- readRegionB r'-                     replaceRegionB r' w0-                     replaceRegionB r  w1---- | Modifies the given region according to the given--- string transformation function-modifyRegionB :: (R.YiString -> R.YiString)-                 -- ^ The string modification function-              -> Region-                 -- ^ The region to modify-              -> BufferM ()-modifyRegionB f region = f <$> readRegionB region >>= replaceRegionB region---- | Extend the right bound of a region to include it.-inclusiveRegionB :: Region -> BufferM Region-inclusiveRegionB r =-          if regionStart r <= regionEnd r-              then mkRegion (regionStart r) <$> pointAfterCursorB (regionEnd r)-              else mkRegion <$> pointAfterCursorB (regionStart r) <*> pure (regionEnd r)---- | See a region as a block/rectangular region,--- since regions are represented by two point, this returns--- a list of small regions form this block region.-blockifyRegion :: Region -> BufferM [Region]-blockifyRegion r = savingPointB $ do-  [lowCol, highCol] <- sort <$> mapM colOf [regionStart r, regionEnd r]-  startLine <- lineOf $ regionStart r-  endLine   <- lineOf $ regionEnd r-  when (startLine > endLine) $ fail "blockifyRegion: impossible"-  mapM (\line -> mkRegion <$> pointOfLineColB line lowCol-                          <*> pointOfLineColB line (1 + highCol))-       [startLine..endLine]---- | Joins lines in the region with a single space, skipping any empty--- lines.-joinLinesB :: Region -> BufferM ()-joinLinesB = savingPointB . modifyRegionB g'-  where-    g' = overInit $ mconcat . pad . R.lines--    pad :: [R.YiString] -> [R.YiString]-    pad [] = []-    pad (x:xs) = x : fmap (skip (R.cons ' ' . R.dropWhile isSpace)) xs--    skip g x = if R.null x then x else g x---- | Concatenates lines in the region preserving the trailing newline--- if any.-concatLinesB :: Region -> BufferM ()-concatLinesB = savingPointB . modifyRegionB (overInit $ R.filter (/= '\n'))
− src/library/Yi/Buffer/TextUnit.hs 
@@ -1,426 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Buffer.TextUnit--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Working with blocks (units) of text.-----module Yi.Buffer.TextUnit-    ( TextUnit(..)-    , outsideUnit-    , leftBoundaryUnit-    , unitWord-    , unitViWord-    , unitViWORD-    , unitViWordAnyBnd-    , unitViWORDAnyBnd-    , unitViWordOnLine-    , unitViWORDOnLine-    , unitDelimited-    , unitSentence, unitEmacsParagraph, unitParagraph-    , isAnySep, unitSep, unitSepThisLine, isWordChar-    , moveB, maybeMoveB-    , transformB, transposeB-    , regionOfB, regionOfNonEmptyB, regionOfPartB-    , regionWithTwoMovesB-    , regionOfPartNonEmptyB, regionOfPartNonEmptyAtB-    , readPrevUnitB, readUnitB-    , untilB, doUntilB_, untilB_, whileB, doIfCharB-    , atBoundaryB-    , numberOfB-    , deleteB, genMaybeMoveB-    , genMoveB, BoundarySide(..), genAtBoundaryB-    , checkPeekB-    , halfUnit-    , deleteUnitB-    ) where--import           Control.Applicative-import           Control.Monad-import           Data.Char-import           Data.Typeable-import           Yi.Buffer.Basic-import           Yi.Buffer.Misc-import           Yi.Buffer.Region-import           Yi.Rope (YiString)-import qualified Yi.Rope as R---- | Designate a given "unit" of text.-data TextUnit = Character -- ^ a single character-              | Line  -- ^ a line of text (between newlines)-              | VLine -- ^ a "vertical" line of text (area of text between two characters at the same column number)-              | Document -- ^ the whole document-              | GenUnit {genEnclosingUnit :: TextUnit,-                         genUnitBoundary :: Direction -> BufferM Bool}-      -- there could be more text units, like Page, Searched, etc. it's probably a good-      -- idea to use GenUnit though.-                deriving Typeable---- | Turns a unit into its "negative" by inverting the boundaries. For example,--- @outsideUnit unitViWord@ will be the unit of spaces between words. For units--- without boundaries ('Character', 'Document', ...), this is the identity--- function.-outsideUnit :: TextUnit -> TextUnit-outsideUnit (GenUnit enclosing boundary) = GenUnit enclosing (boundary . reverseDir)-outsideUnit x = x -- for a lack of better definition---- | Common boundary checking function: run the condition on @len@--- characters in specified direction shifted by specified offset.-genBoundary :: Int -- ^ Offset from current position-            -> Int -- ^ Look-ahead-            -> (YiString -> Bool) -- ^ predicate-            -> Direction -- ^ Direction to look in-            -> BufferM Bool-genBoundary ofs len condition dir = condition <$> peekB-  where-    peekB = do-      Point p' <- pointB-      let pt@(Point p) = Point (p' + mayNegate ofs)-      case dir of-        Forward -> betweenB pt (Point $ max 0 p + len)-        Backward -> R.reverse <$> betweenB (Point $ p - len) pt--    mayNegate = case dir of-      Forward -> id-      Backward -> negate---- | a word as in use in Emacs (fundamental mode)-unitWord :: TextUnit-unitWord = GenUnit Document $ \direction -> checkPeekB (-1) [isWordChar, not . isWordChar] direction---- ^ delimited on the left and right by given characters, boolean argument tells if whether those are included.-unitDelimited :: Char -> Char -> Bool -> TextUnit-unitDelimited left right included = GenUnit Document $ \direction ->-   case (included,direction) of-       (False, Backward) -> checkPeekB 0 [(== left)] Backward-       (False, Forward)  -> (== right) <$> readB-       (True,  Backward) -> checkPeekB (-1) [(== left)] Backward-       (True,  Forward)  -> checkPeekB 0 [(== right)] Backward--isWordChar :: Char -> Bool-isWordChar x = isAlphaNum x || x == '_'--isNl :: Char -> Bool-isNl = (== '\n')---- | Tells if a char can end a sentence ('.', '!', '?').-isEndOfSentence :: Char -> Bool-isEndOfSentence = (`elem` ".!?")---- | Verifies that the string matches all the predicates, pairwise. If--- the string is "too small", then return 'False'. Note the length of--- predicates has to be finite.-checks :: [Char -> Bool] -> YiString -> Bool-checks ps' t' = go ps' (R.toString t')-  where-    go [] _ = True-    go _ [] = False-    go (p:ps) (x:xs) =  p x && go ps xs--checkPeekB :: Int -> [Char -> Bool] -> Direction -> BufferM Bool-checkPeekB offset conds = genBoundary offset (length conds) (checks conds)---- | Helper that takes first two characters of YiString. Faster than--- take 2 and string conversion.-firstTwo :: YiString -> Maybe (Char, Char)-firstTwo t = case R.head t of-  Nothing -> Nothing-  Just c -> case R.tail t >>= R.head of-    Nothing -> Nothing-    Just c' -> Just (c, c')--atViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool-atViWordBoundary charType = genBoundary (-1) 2 $ \cs -> case firstTwo cs of-  Just (c1, c2) -> isNl c1 && isNl c2 -- stop at empty lines-                   || not (isSpace c1) && (charType c1 /= charType c2)-  Nothing -> True--atAnyViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool-atAnyViWordBoundary charType = genBoundary (-1) 2 $ \cs -> case firstTwo cs of-  Just (c1, c2) -> isNl c1 || isNl c2 || charType c1 /= charType c2-  Nothing -> True--atViWordBoundaryOnLine :: (Char -> Int) -> Direction -> BufferM Bool-atViWordBoundaryOnLine charType = genBoundary (-1) 2 $ \cs -> case firstTwo cs of-  Just (c1, c2)-> isNl c1 || isNl c2 || not (isSpace c1) && charType c1 /= charType c2-  Nothing -> True--unitViWord :: TextUnit-unitViWord = GenUnit Document $ atViWordBoundary viWordCharType--unitViWORD :: TextUnit-unitViWORD = GenUnit Document $ atViWordBoundary viWORDCharType--unitViWordAnyBnd :: TextUnit-unitViWordAnyBnd = GenUnit Document $ atAnyViWordBoundary viWordCharType--unitViWORDAnyBnd :: TextUnit-unitViWORDAnyBnd = GenUnit Document $ atAnyViWordBoundary viWORDCharType--unitViWordOnLine :: TextUnit-unitViWordOnLine = GenUnit Document $ atViWordBoundaryOnLine viWordCharType--unitViWORDOnLine :: TextUnit-unitViWORDOnLine = GenUnit Document $ atViWordBoundaryOnLine viWORDCharType--viWordCharType :: Char -> Int-viWordCharType c | isSpace c    = 1-                 | isWordChar c = 2-                 | otherwise    = 3--viWORDCharType :: Char -> Int-viWORDCharType c | isSpace c = 1-                 | otherwise = 2---- | Separator characters (space, tab, unicode separators). Most of--- the units above attempt to identify "words" with various--- punctuation and symbols included or excluded. This set of units is--- a simple inverse: it is true for "whitespace" or "separators" and--- false for anything that is not (letters, numbers, symbols,--- punctuation, whatever).-isAnySep :: Char -> Bool-isAnySep c = isSeparator c || isSpace c || generalCategory c `elem` seps-  where-    seps = [ Space, LineSeparator, ParagraphSeparator ]--atSepBoundary :: Direction -> BufferM Bool-atSepBoundary = genBoundary (-1) 2 $ \cs -> case firstTwo cs of-  Just (c1, c2) -> isNl c1 || isNl c2 || isAnySep c1 /= isAnySep c2-  Nothing -> True---- | unitSep is true for any kind of whitespace/separator-unitSep :: TextUnit-unitSep = GenUnit Document atSepBoundary---- | unitSepThisLine is true for any kind of whitespace/separator on this line only-unitSepThisLine :: TextUnit-unitSepThisLine = GenUnit Line atSepBoundary----- | Is the point at a @Unit@ boundary in the specified @Direction@?-atBoundary :: TextUnit -> Direction -> BufferM Bool-atBoundary Document Backward = (== 0) <$> pointB-atBoundary Document Forward  = (>=)   <$> pointB <*> sizeB-atBoundary Character _ = return True-atBoundary VLine _ = return True -- a fallacy; this needs a little refactoring.-atBoundary Line direction = checkPeekB 0 [isNl] direction-atBoundary (GenUnit _ atBound) dir = atBound dir--enclosingUnit :: TextUnit -> TextUnit-enclosingUnit (GenUnit enclosing _) = enclosing-enclosingUnit _ = Document--atBoundaryB :: TextUnit -> Direction -> BufferM Bool-atBoundaryB Document d = atBoundary Document d-atBoundaryB u d = (||) <$> atBoundary u d <*> atBoundaryB (enclosingUnit u) d---- | Paragraph to implement emacs-like forward-paragraph/backward-paragraph-unitEmacsParagraph :: TextUnit-unitEmacsParagraph = GenUnit Document $ checkPeekB (-2) [not . isNl, isNl, isNl]---- | Paragraph that begins and ends in the paragraph, not the empty lines surrounding it.-unitParagraph :: TextUnit-unitParagraph = GenUnit Document $ checkPeekB (-1) [not . isNl, isNl, isNl]--unitSentence :: TextUnit-unitSentence = GenUnit unitEmacsParagraph $ \dir -> checkPeekB (if dir == Forward then -1 else 0) (mayReverse dir [isEndOfSentence, isSpace]) dir---- | Unit that have its left and right boundaries at the left boundary of the argument unit.-leftBoundaryUnit :: TextUnit -> TextUnit-leftBoundaryUnit u = GenUnit Document (\_dir -> atBoundaryB u Backward)---- | @genAtBoundaryB u d s@ returns whether the point is at a given boundary @(d,s)@ .--- Boundary @(d,s)@ , taking Word as example, means:---      Word---     ^^  ^^---     12  34--- 1: (Backward,OutsideBound)--- 2: (Backward,InsideBound)--- 3: (Forward,InsideBound)--- 4: (Forward,OutsideBound)------ rules:--- genAtBoundaryB u Backward InsideBound  = atBoundaryB u Backward--- genAtBoundaryB u Forward  OutsideBound = atBoundaryB u Forward-genAtBoundaryB :: TextUnit -> Direction -> BoundarySide -> BufferM Bool-genAtBoundaryB u d s = withOffset (off u d s) $ atBoundaryB u d-    where withOffset 0 f = f-          withOffset ofs f = savingPointB (((ofs +) <$> pointB) >>= moveTo >> f)-          off _    Backward  InsideBound = 0-          off _    Backward OutsideBound = 1-          off _    Forward   InsideBound = 1-          off _    Forward  OutsideBound = 0---numberOfB :: TextUnit -> TextUnit -> BufferM Int-numberOfB unit containingUnit = savingPointB $ do-                   maybeMoveB containingUnit Backward-                   start <- pointB-                   moveB containingUnit Forward-                   end <- pointB-                   moveTo start-                   length <$> untilB ((>= end) <$> pointB) (moveB unit Forward)--whileB :: BufferM Bool -> BufferM a -> BufferM [a]-whileB cond = untilB (not <$> cond)---- | Repeat an action until the condition is fulfilled or the cursor--- stops moving. The Action may be performed zero times.-untilB :: BufferM Bool -> BufferM a -> BufferM [a]-untilB cond f = do-  stop <- cond-  if stop then return [] else doUntilB cond f---- | Repeat an action until the condition is fulfilled or the cursor--- stops moving. The Action is performed at least once.-doUntilB :: BufferM Bool -> BufferM a -> BufferM [a]-doUntilB cond f = loop-  where loop = do-          p <- pointB-          x <- f-          p' <- pointB-          stop <- cond-          (x:) <$> if p /= p' && not stop-            then loop-            else return []--doUntilB_ :: BufferM Bool -> BufferM a -> BufferM ()-doUntilB_ cond f = void (doUntilB cond f) -- maybe do an optimized version?--untilB_ :: BufferM Bool -> BufferM a -> BufferM ()-untilB_ cond f = void (untilB cond f) -- maybe do an optimized version?---- | Do an action if the current buffer character passes the predicate-doIfCharB :: (Char -> Bool) -> BufferM a -> BufferM ()-doIfCharB p o = readB >>= \c -> when (p c) $ void o----- | Boundary side-data BoundarySide = InsideBound | OutsideBound-    deriving Eq---- | Generic move operation--- Warning: moving To the (OutsideBound, Backward) bound of Document is impossible (offset -1!)--- @genMoveB u b d@: move in direction d until encountering boundary b or unit u. See 'genAtBoundaryB' for boundary explanation.-genMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()-genMoveB Document (Forward,InsideBound) Forward = moveTo =<< subtract 1 <$> sizeB-genMoveB Document _                     Forward = moveTo =<< sizeB-genMoveB Document _ Backward = moveTo 0 -- impossible to go outside beginning of doc.-genMoveB Character _ Forward  = rightB-genMoveB Character _ Backward = leftB-genMoveB VLine     _ Forward  =-  do ofs <- lineMoveRel 1-     when (ofs < 1) (maybeMoveB Line Forward)-genMoveB VLine _ Backward = lineUp-genMoveB unit (boundDir, boundSide) moveDir =-  doUntilB_ (genAtBoundaryB unit boundDir boundSide) (moveB Character moveDir)---- | Generic maybe move operation.--- As genMoveB, but don't move if we are at boundary already.-genMaybeMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM ()--- optimized case for Document-genMaybeMoveB Document boundSpec moveDir = genMoveB Document boundSpec moveDir--- optimized case for start/end of Line-genMaybeMoveB Line (Backward, InsideBound) Backward = moveTo =<< solPointB =<< pointB-genMaybeMoveB Line (Forward, OutsideBound) Forward = moveTo =<< eolPointB =<< pointB-genMaybeMoveB unit (boundDir, boundSide) moveDir =-  untilB_ (genAtBoundaryB unit boundDir boundSide) (moveB Character moveDir)----- | Move to the next unit boundary-moveB :: TextUnit -> Direction -> BufferM ()-moveB u d = genMoveB u (d, case d of Forward -> OutsideBound; Backward -> InsideBound) d----- | As 'moveB', unless the point is at a unit boundary---- So for example here moveToEol = maybeMoveB Line Forward;--- in that it will move to the end of current line and nowhere if we--- are already at the end of the current line. Similarly for moveToSol.--maybeMoveB :: TextUnit -> Direction -> BufferM ()-maybeMoveB u d = genMaybeMoveB u (d, case d of Forward -> OutsideBound; Backward -> InsideBound) d--transposeB :: TextUnit -> Direction -> BufferM ()-transposeB unit direction = do-  moveB unit (reverseDir direction)-  w0 <- pointB-  moveB unit direction-  w0' <- pointB-  moveB unit direction-  w1' <- pointB-  moveB unit (reverseDir direction)-  w1 <- pointB-  swapRegionsB (mkRegion w0 w0') (mkRegion w1 w1')-  moveTo w1'---- | Transforms the region given by 'TextUnit' in the 'Direction' with--- user-supplied function.-transformB :: (YiString -> YiString) -> TextUnit -> Direction -> BufferM ()-transformB f unit direction = do-  p <- pointB-  moveB unit direction-  q <- pointB-  let r = mkRegion p q-  replaceRegionB r =<< f <$> readRegionB r---- | Delete between point and next unit boundary, return the deleted region.-deleteB :: TextUnit -> Direction -> BufferM ()-deleteB unit dir = deleteRegionB =<< regionOfPartNonEmptyB unit dir--regionWithTwoMovesB :: BufferM a -> BufferM b -> BufferM Region-regionWithTwoMovesB move1 move2 =-    savingPointB $ mkRegion <$> (move1 >> pointB) <*> (move2 >> pointB)---- | Region of the whole textunit where the current point is.-regionOfB :: TextUnit -> BufferM Region-regionOfB unit = regionWithTwoMovesB (maybeMoveB unit Backward) (maybeMoveB unit Forward)---- An alternate definition would be the following, but it can return two units if the current point is between them.--- eg.  "word1 ^ word2" would return both words.--- regionOfB unit = mkRegion---                  <$> pointAfter (maybeMoveB unit Backward)---                  <*> destinationOfMoveB (maybeMoveB unit Forward)--- | Non empty region of the whole textunit where the current point is.-regionOfNonEmptyB :: TextUnit -> BufferM Region-regionOfNonEmptyB unit = savingPointB $-  mkRegion <$> (maybeMoveB unit Backward >> pointB) <*> (moveB unit Forward >> pointB)---- | Region between the point and the next boundary.--- The region is empty if the point is at the boundary.-regionOfPartB :: TextUnit -> Direction -> BufferM Region-regionOfPartB unit dir = mkRegion <$> pointB <*> destinationOfMoveB (maybeMoveB unit dir)---- | Non empty region between the point and the next boundary,--- In fact the region can be empty if we are at the end of file.-regionOfPartNonEmptyB :: TextUnit -> Direction -> BufferM Region-regionOfPartNonEmptyB unit dir = mkRegion <$> pointB <*> destinationOfMoveB (moveB unit dir)---- | Non empty region at given point and the next boundary,-regionOfPartNonEmptyAtB :: TextUnit -> Direction -> Point -> BufferM Region-regionOfPartNonEmptyAtB unit dir p = do-    oldP <- pointB-    moveTo p-    r <- regionOfPartNonEmptyB unit dir-    moveTo oldP-    return r--readPrevUnitB :: TextUnit -> BufferM YiString-readPrevUnitB unit = readRegionB =<< regionOfPartNonEmptyB unit Backward--readUnitB :: TextUnit -> BufferM YiString-readUnitB = readRegionB <=< regionOfB--halfUnit :: Direction -> TextUnit -> TextUnit-halfUnit dir (GenUnit enclosing boundary) =-  GenUnit enclosing (\d -> if d == dir then boundary d else return False)-halfUnit _dir tu = tu--deleteUnitB :: TextUnit -> Direction -> BufferM ()-deleteUnitB unit dir = deleteRegionB =<< regionOfPartNonEmptyB unit dir
− src/library/Yi/Buffer/Undo.hs 
@@ -1,179 +0,0 @@-{-# LANGUAGE TemplateHaskell, CPP, StandaloneDeriving, DeriveGeneric #-}---- | An implementation of restricted, linear undo, as described in:------ >    T. Berlage, "A selective undo mechanism for graphical user interfaces--- >    based on command objects", ACM Transactions on Computer-Human--- >    Interaction 1(3), pp. 269-294, 1994.------ Implementation based on a proposal by sjw.------ From Berlage:------ >    All buffer-mutating commands are stored (in abstract form) in an--- >    Undo list. The most recent item in this list is the action that--- >    will be undone next. When it is undone, it is removed from the Undo--- >    list, and its inverse is added to the Redo list. The last command--- >    put into the Redo list can be redone, and again prepended to the--- >    Undo list. New commands are added to the Undo list without--- >    affecting the Redo list.------ Now, the above assumes that commands can be _redone_ in a state other--- than that in which it was orginally done. This is not the case in our--- text editor: a user may delete, for example, between an undo and a--- redo. Berlage addresses this in S2.3. A Yi example:------ >    Delete some characters--- >    Undo partialy--- >    Move prior in the file, and delete another _chunk_--- >    Redo some things  == corruption.------ Berlage describes the /stable execution property/:------ >    A command is always redone in the same state that it was originally--- >    executed in, and is always undone in the state that was reached--- >    after the original execution.------ >    The only case where the linear undo model violates the stable--- >    execution property is when _a new command is submitted while the--- >    redo list is not empty_. The _restricted linear undo model_ ...--- >    clears the redo list in this case.------ Also some discussion of this in: /The Text Editor Sam/, Rob Pike, pg 19.-----module Yi.Buffer.Undo (-    emptyU-  , addChangeU-  , setSavedFilePointU-  , isAtSavedFilePointU-  , undoU-  , redoU-  , URList             {- abstractly -}-  , Change(AtomicChange, InteractivePoint)-   ) where--import Data.Binary-#if __GLASGOW_HASKELL__ < 708-import Data.DeriveTH-#else-import GHC.Generics (Generic)-#endif-import Yi.Buffer.Implementation--data Change = SavedFilePoint-            | InteractivePoint-            | AtomicChange !Update--- !!! It's very important that the updates are forced, otherwise--- !!! we'll keep a full copy of the buffer state for each update--- !!! (thunk) put in the URList.-            deriving (Show)-#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''Change)-#else-deriving instance Generic Change-instance Binary Change-#endif--- | A URList consists of an undo and a redo list.-data URList = URList ![Change] ![Change]-            deriving (Show)-#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''URList)-#else-deriving instance Generic URList-instance Binary URList-#endif---- | A new empty 'URList'.--- Notice we must have a saved file point as this is when we assume we are--- opening the file so it is currently the same as the one on disk-emptyU :: URList-emptyU = URList [SavedFilePoint] []---- | Add an action to the undo list.--- According to the restricted, linear undo model, if we add a command--- whilst the redo list is not empty, we will lose our redoable changes.-addChangeU :: Change -> URList -> URList-addChangeU InteractivePoint (URList us rs) = URList (addIP us) rs-addChangeU u (URList us _rs) = URList (u:us) []---- | Add a saved file point so that we can tell that the buffer has not--- been modified since the previous saved file point.--- Notice that we must be sure to remove the previous saved file points--- since they are now worthless.-setSavedFilePointU :: URList -> URList-setSavedFilePointU (URList undos redos) =-  URList (SavedFilePoint : cleanUndos) cleanRedos-  where-  cleanUndos = filter isNotSavedFilePoint undos-  cleanRedos = filter isNotSavedFilePoint redos-  isNotSavedFilePoint :: Change -> Bool-  isNotSavedFilePoint SavedFilePoint = False-  isNotSavedFilePoint _              = True---- | This undoes one interaction step.-undoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update]))-undoU m = undoUntilInteractive m [] . undoInteractive---- | This redoes one iteraction step.-redoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update]))-redoU = asRedo . undoU---- | Prepare undo by moving one interaction point from undoes to redoes.-undoInteractive :: URList -> URList-undoInteractive (URList us rs) = URList (remIP us) (addIP rs)--remIP, addIP :: [Change] -> [Change]---- | Remove an initial interactive point, if there is one-remIP (InteractivePoint:xs) = xs-remIP xs = xs---- | Insert an initial interactive point, if there is none-addIP xs@(InteractivePoint:_) = xs-addIP xs = InteractivePoint:xs---- | Repeatedly undo actions, storing away the inverse operations in the---   redo list.-undoUntilInteractive :: Mark -> [Update] -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update]))-undoUntilInteractive pointMark xs ur@(URList cs rs) b = case cs of-      []                   -> (b, (ur, xs))-      [SavedFilePoint]     -> (b, (ur, xs)) -- Why this special case?-      (InteractivePoint:_) -> (b, (ur, xs))-      (SavedFilePoint:cs') ->-        undoUntilInteractive pointMark xs (URList cs' (SavedFilePoint:rs)) b-      (AtomicChange u:cs') ->-        let ur' = URList cs' (AtomicChange (reverseUpdateI u):rs)-            b' = applyUpdateWithMoveI u b-            (b'', (ur'', xs'')) = undoUntilInteractive pointMark xs ur' b'-        in (b'', (ur'', u:xs''))-    where-      -- Apply a /valid/ update and also move point in buffer to update position-      applyUpdateWithMoveI :: Update -> BufferImpl syntax -> BufferImpl syntax-      applyUpdateWithMoveI u = case updateDirection u of-                                 Forward ->  apply . move-                                 Backward -> move . apply-          where move = modifyMarkBI pointMark (\v -> v {markPoint = updatePoint u})-                apply = applyUpdateI u---- | Run the undo-function @f@ on a swapped URList making it---   operate in a redo fashion instead of undo.-asRedo :: (URList -> t -> (t, (URList, [Update]))) -> URList -> t -> (t, (URList, [Update]))-asRedo f ur x = let (y,(ur',rs)) = f (swapUndoRedo ur) x in (y,(swapUndoRedo ur',rs))-  where-    swapUndoRedo :: URList -> URList-    swapUndoRedo (URList us rs) = URList rs us---- | undoIsAtSavedFilePoint. @True@ if the undo list is at a SavedFilePoint indicating---   that the buffer has not been modified since we last saved the file.--- Note: that an empty undo list does NOT mean that the buffer is not modified since--- the last save. Because we may have saved the file and then undone actions done before--- the save.-isAtSavedFilePointU :: URList -> Bool-isAtSavedFilePointU (URList us _) = isUnchanged us-  where-    isUnchanged cs = case cs of-      []                       -> False-      (SavedFilePoint : _)     -> True-      (InteractivePoint : cs') -> isUnchanged cs'-      _                        -> False
− src/library/Yi/Char/Unicode.hs 
@@ -1,279 +0,0 @@-module Yi.Char.Unicode (greek, symbols, subscripts, superscripts, checkAmbs, disamb) where--import Data.List (isPrefixOf)-import Control.Applicative-{-# ANN module "HLint: ignore Use string literal" #-}--greek :: [(String, String)]-greek = [(name, unicode) | (_,name,unicode) <- greekData] ++-        [ ([leading,shorthand],unicode)-        | (Just shorthand,_,unicode) <- greekData-        , leading                    <- ['\'', 'g'] ]---- | Triples: (shorthand, name, unicode)-greekData :: [(Maybe Char, String, String)]-greekData = [(Just 'a', "alpha", "α")-            ,(Just 'b', "beta", "β")-            ,(Just 'g', "gamma", "γ")-            ,(Just 'G', "Gamma", "Γ")-            ,(Just 'd', "delta", "δ")-            ,(Just 'D', "Delta", "Δ")-            ,(Just 'e' , "epsilon", "ε")-            ,(Just 'z', "zeta", "ζ")-            ,(Just 'N' , "eta", "η") -- N is close to n which is graphically close-            ,(Just 'E' , "eta", "η") -- E is close to e which is the start of eta-            ,(Nothing , "theta", "θ")-            ,(Nothing , "Theta", "Θ")-            ,(Just 'i', "iota", "ι")-            ,(Just 'k', "kapa", "κ")-            ,(Just 'l', "lambda", "λ")-            ,(Just 'L', "Lambda", "Λ")-            ,(Just 'm', "mu", "μ")-            ,(Just 'n', "nu", "ν")-            ,(Just 'x', "xi", "ξ")-            ,(Just 'o', "omicron", "ο")-            ,(Just 'p' , "pi", "π")-            ,(Just 'P' , "Pi", "Π")-            ,(Just 'r', "rho", "ρ")-            ,(Just 's', "sigma", "σ")-            ,(Just 'S', "Sigma", "Σ")-            ,(Just 't', "tau", "τ")-            ,(Just 'f' , "phi", "φ")-            ,(Just 'F' , "Phi", "Φ")-            ,(Just 'c', "chi", "χ")-            ,(Just 'C', "Chi", "Χ")-            ,(Nothing , "psi", "ψ")-            ,(Nothing , "Psi", "Ψ")-            ,(Just 'w', "omega", "ω")-            ,(Just 'O', "Omega", "Ω")-            ]---symbols :: [(String, String)]-symbols =- [- -- parens-  ("<","⟨")- ,(">","⟩")- ,("<>","⟨⟩")- ,(">>","⟫")- ,("<<","⟪")---- These two confuse gnome-terminal.- ,("|(","〖")- ,(")|","〗")-- ,("{|", "⦃")- ,("|}", "⦄")-- ,("[[","⟦")- ,("]]","⟧")-- ,("|_","⌊")- ,("_|","⌋")- ,("|__|","⌊⌋")- ,("r|_","⌈")- ,("r_|","⌉")- ,("r|__|","⌈⌉")--- ,("[]", "∎")-- -- quantifiers- ,("forall", "∀")- ,("all", "∀")- ,("exists", "∃")- ,("rA", "∀") -- reversed A- ,("rE", "∃") -- reversed E- ,("/rE", "∄")-- -- operators- ,("<|","◃")- -- ,("<|","◁") alternative- ,("|>","▹")- ,("><","⋈")- ,("<)", "◅")- ,("(>", "▻")- ,("v","∨")- ,("u","∪")- ,("V","⋁")- ,("+u","⊎")- ,("u[]","⊔")- ,("n[]","⊓")- ,("^","∧")- ,("/\\", "∧")- ,("\\/", "∨")- ,("o","∘")- ,(".","·")- ,("x","×")- ,("neg","¬")-- --- arrows- ,("<-","←")- ,("->","→")- ,("|->","↦")- ,("<-|","↤")- ,("<--","⟵")- ,("-->","⟶")- ,("|-->","⟼")- ,("==>","⟹")- ,("=>","⇒")- ,("<=","⇐")- ,("<=>","⇔")- ,("~>","↝")- ,("<~","↜")- ,("<-<", "↢")- ,(">->", "↣")- ,("<->", "↔")- ,("|<-", "⇤")- ,("->|", "⇥")- ,(">>=","↠")-- --- relations- ,("c=","⊆")- ,("c","⊂")- ,("c-","∈")- ,("in","∈")- ,("/c-","∉")- ,("c/=","⊊")- ,("rc=","⊇") -- r for reversed- ,("rc","⊃") -- r for reversed- ,("rc-","∋") -- r for reversed- ,("r/c-","∌") -- r for reversed- ,("rc/=","⊋") -- r for reversed- ,(">=","≥")- ,("=<","≤")- ,("c[]","⊏")- ,("rc[]","⊐")- ,("c[]=","⊑")- ,("rc[]=","⊒")- ,("/c[]=","⋢")- ,("/rc[]=","⋣")- ,("c[]/=","⋤")- ,("rc[]/=","⋥")-- ---- equal signs- ,("=def","≝")- ,("=?","≟")- ,("==","≡")- ,("~~","≈")- ,("~-","≃")- ,("~=","≅")- ,("~","∼")- ,("~~","≈")- ,("/=","≠")- ,("/==","≢")- ,(":=","≔")- ,("=:","≕")-- -- misc- ,("_|_","⊥")- ,("Top","⊤")- ,("l","ℓ")- ,("::","∷")- ,(":", "∶")- ,("0", "∅")- ,("*", "★") -- or "⋆"- ,("/'l","ƛ")- ,("d","∂")- ,("#b","♭") -- music bemol- ,("#f","♮") -- music flat- ,("##","♯") -- music #- ,("Hot","♨")- ,("Cut","✂")- ,("Pen","✎")- ,("Tick","✓")-- -- dashes- ,("-","−")-- -- quotes- ,("\"","“”")- ,("r`","′")-- -- turnstyles- ,("|-", "⊢")- ,("|/-", "⊬")- ,("-|", "⊣")- ,("|=", "⊨")- ,("|/=", "⊭")- ,("||-", "⊩")--  -- circled/squared operators-  -- ⊝ ⍟ ⎊ ⎉--  ,("o+","⊕")-  ,("o-","⊖")-  ,("ox","⊗")-  ,("o/","⊘")-  ,("o*","⊛")-  ,("o=","⊜")-  ,("o.","⊙")-  ,("oo","⊚")-  ,("[+]","⊞")-  ,("[-]","⊟")-  ,("[x]","⊠")-  ,("[.]","⊡")-  ,("[]","∎")-- ] ++ [ (leading:l, [u]) | leading <- ['|','b'], (l,u) <--- [("N",'ℕ')- ,("H",'ℍ')- ,("P",'ℙ')- ,("R",'ℝ')- ,("D",'ⅅ')- ,("Q",'ℚ')- ,("Z",'ℤ')- ,("gg",'ℽ')- ,("gG",'ℾ')- ,("gP",'ℿ')- ,("gS",'⅀')- ]-- ] ++ [--  ("cP","℘") -- c for cal- ,("cL","ℒ") -- c for cal- ,("cR","ℛ") -- c for cal- ]--checkAmbs :: [(String, String)] -> [(String, String)]-checkAmbs table = check-  where ambs = [ (x, y)-               | v@(x, _) <- table-               , w@(y, _) <- table-               , v /= w-               , x `isPrefixOf` y ]-        check | null ambs = table-              | otherwise = error $ "checkAmbs: ambiguous declarations for " ++ show ambs--disamb :: [(String, String)] -> [(String, String)]-disamb table = map f table-  where f v@(x, vx) =-            let ambs = [ w-                       | w@(y, _) <- table-                       , v /= w-                       , x `isPrefixOf` y ]-            in if null ambs then v else (x ++ " ", vx)----- More:--- arrows: ⇸ ⇆--- circled operators: ⊕ ⊖ ⊗ ⊘ ⊙ ⊚ ⊛ ⊜ ⊝ ⍟  ⎊ ⎉--- squared operators: ⊞ ⊟ ⊠ ⊡--- turnstyles: ⊦ ⊧--- subscript: ₔ--zipscripts :: Char -> String -> String -> [(String, String)]-zipscripts c ascii unicode-  = zip (fmap ((c:) . pure) ascii) (fmap pure unicode)--subscripts, superscripts :: [(String, String)]--subscripts   = zipscripts '_' "0123456789+-=()aeioruvx"-                              "₀₁₂₃₄₅₆₇₈₉₊₋₌₍₎ₐₑᵢₒᵣᵤᵥₓ"--superscripts = zipscripts '^' -- NOTE that qCFQSVXYZ are missing-  "0123456789+-=()abcdefghijklmnoprstuvwxyzABDEGHIJKLMNOPRTUW"-  "⁰¹²³⁴⁵⁶⁷⁸⁹⁺⁻⁼⁽⁾ᵃᵇᶜᵈᵉᶠᵍʰⁱʲᵏˡᵐⁿᵒᵖʳˢᵗᵘᵛʷˣʸᶻᴬᴮᴰᴱᴳᴴᴵᴶᴷᴸᴹᴺᴼᴾᴿᵀᵁᵂ"
− src/library/Yi/Command.hs 
@@ -1,134 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Command--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Various high-level functions to further classify.--module Yi.Command where--import           Control.Applicative-import           Control.Exception(SomeException)-import           Control.Lens-import           Control.Monad-import           Control.Monad.Base-import           Data.Binary-import           Data.Default-import qualified Data.Text as T-import           Data.Typeable-import           System.Exit (ExitCode(..))-import           Yi.Buffer-import           Yi.Core (startSubprocess)-import           Yi.Types (YiVariable)-import           Yi.Editor-import           Yi.Keymap-import           Yi.MiniBuffer-import qualified Yi.Mode.Compilation as Compilation-import qualified Yi.Mode.Interactive as Interactive-import           Yi.Monad-import           Yi.Process-import qualified Yi.Rope as R-import           Yi.UI.Common-import           Yi.Utils-------------------------------- | Changing the buffer name quite useful if you have--- several the same. This also breaks the relation with the file.--changeBufferNameE :: YiM ()-changeBufferNameE = withMinibufferFree "New buffer name:" strFun-  where-    strFun :: T.Text -> YiM ()-    strFun = withCurrentBuffer . assign identA . MemBuffer--------------------------------- | shell-command with argument prompt-shellCommandE :: YiM ()-shellCommandE = withMinibufferFree "Shell command:" shellCommandV--------------------------------- | shell-command with a known argument-shellCommandV :: T.Text -> YiM ()-shellCommandV cmd = do-  (exitCode,cmdOut,cmdErr) <- liftBase $ runShellCommand (T.unpack cmd)-  case exitCode of-    ExitSuccess -> if length (filter (== '\n') cmdOut) > 17-                   then withEditor . void $ -- see GitHub issue #477-                          newBufferE (MemBuffer "Shell Command Output")-                                     (R.fromString cmdOut)-                   else printMsg $ case T.pack cmdOut of-                     "" -> "(Shell command with no output)"-                     -- Drop trailing newline from output-                     xs -> if T.last xs == '\n' then T.init xs else xs-    -- FIXME: here we get a string and convert it back to utf8;-    -- this indicates a possible bug.-    ExitFailure _ -> printMsg $ T.pack cmdErr--------------------------------- Cabal-related commands-newtype CabalBuffer = CabalBuffer {cabalBuffer :: Maybe BufferRef}-    deriving (Default, Typeable, Binary)--instance YiVariable CabalBuffer--------------------------------- | cabal-configure-cabalConfigureE :: CommandArguments -> YiM ()-cabalConfigureE = cabalRun "configure" configureExit--configureExit :: Either SomeException ExitCode -> YiM ()-configureExit (Right ExitSuccess) = reloadProjectE "."-configureExit _ = return ()---reloadProjectE :: String -> YiM ()-reloadProjectE s = withUI $ \ui -> reloadProject ui s---- | Run the given commands with args and pipe the ouput into the build buffer,--- which is shown in an other window.-buildRun :: T.Text -> [T.Text] -> (Either SomeException ExitCode -> YiM x) -> YiM ()-buildRun cmd args onExit = withOtherWindow $ do-   b <- startSubprocess (T.unpack cmd) (T.unpack <$> args) onExit-   maybeM deleteBuffer =<< cabalBuffer <$> getEditorDyn-   putEditorDyn $ CabalBuffer $ Just b-   withCurrentBuffer $ setMode Compilation.mode-   return ()--makeBuild :: CommandArguments -> YiM ()-makeBuild (CommandArguments args) = buildRun "make" args (const $ return ())--cabalRun :: T.Text -> (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()-cabalRun cmd onExit (CommandArguments args) = buildRun "cabal" (cmd:args) onExit---------------------------- | cabal-build-cabalBuildE :: CommandArguments -> YiM ()-cabalBuildE = cabalRun "build" (const $ return ())---shell :: YiM BufferRef-shell = do-    sh <- io shellFileName-    Interactive.spawnProcess sh ["-i"]-    -- use the -i option for interactive mode (assuming bash)---- | Search the source files in the project.-searchSources :: String ::: RegexTag -> YiM ()-searchSources = grepFind (Doc "*.hs")---- | Perform a find+grep operation-grepFind :: String ::: FilePatternTag -> String ::: RegexTag -> YiM ()-grepFind (Doc filePattern) (Doc searchedRegex) = withOtherWindow $ do-    void $ startSubprocess "find" [".",-                                      "-name", "_darcs", "-prune", "-o",-                                      "-name", filePattern, "-exec", "grep", "-Hnie", searchedRegex, "{}", ";"] (const $ return ())-    withCurrentBuffer $ setMode Compilation.mode-    return ()
− src/library/Yi/Completion.hs 
@@ -1,140 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Completion--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Collection of functions for completion and matching.--module Yi.Completion-  ( completeInList, completeInList'-  , completeInListCustomShow-  , commonPrefix-  , prefixMatch, infixMatch-  , subsequenceMatch-  , containsMatch', containsMatch, containsMatchCaseInsensitive-  , mkIsPrefixOf-  )-where--import           Control.Applicative-import           Data.List-import           Data.Maybe-import           Data.Monoid-import qualified Data.Text as T-import           Yi.Editor (EditorM, printMsg, printMsgs)-import           Yi.String (commonTPrefix', showT)-import           Yi.Utils------------------------------------------------ General completion---- | Like usual 'T.isPrefixOf' but user can specify case sensitivity.--- See 'T.toCaseFold' for exotic unicode gotchas.-mkIsPrefixOf :: Bool -- ^ Is case-sensitive?-             -> T.Text-             -> T.Text-             -> Bool-mkIsPrefixOf True = T.isPrefixOf-mkIsPrefixOf False = \x y -> T.toCaseFold x `T.isPrefixOf` T.toCaseFold y---- | Prefix matching function, for use with 'completeInList'-prefixMatch :: T.Text -> T.Text -> Maybe T.Text-prefixMatch prefix s = if prefix `T.isPrefixOf` s then Just s else Nothing---- | Infix matching function, for use with 'completeInList'-infixMatch :: T.Text -> T.Text -> Maybe T.Text-infixMatch needle haystack = case T.breakOn needle haystack of-  (_, t) -> if T.null t then Nothing else Just t---- | Example: "abc" matches "a1b2c"-subsequenceMatch :: String -> String -> Bool-subsequenceMatch needle haystack = go needle haystack-  where go (n:ns) (h:hs) | n == h = go ns hs-        go (n:ns) (h:hs) | n /= h = go (n:ns) hs-        go [] _ = True-        go _ [] = False-        go _ _  = False---- | TODO: this is a terrible function, isn't this just--- case-insensitive infix? – Fūzetsu-containsMatch' :: Bool -> T.Text -> T.Text -> Maybe T.Text-containsMatch' caseSensitive pattern str =-  const str <$> find (pattern `tstPrefix`) (T.tails str)-  where-    tstPrefix = mkIsPrefixOf caseSensitive--containsMatch :: T.Text -> T.Text -> Maybe T.Text-containsMatch = containsMatch' True--containsMatchCaseInsensitive :: T.Text -> T.Text -> Maybe T.Text-containsMatchCaseInsensitive = containsMatch' False----- | Complete a string given a user input string, a matching function--- and a list of possibilites. Matching function should return the--- part of the string that matches the user string.-completeInList :: T.Text -- ^ Input to match on-               -> (T.Text -> Maybe T.Text) -- ^ matcher function-               -> [T.Text] -- ^ items to match against-               -> EditorM T.Text-completeInList = completeInListCustomShow id---- | Same as 'completeInList', but maps @showFunction@ on possible--- matches when printing-completeInListCustomShow :: (T.Text -> T.Text) -- ^ Show function-                         -> T.Text -- ^ Input to match on-                         -> (T.Text -> Maybe T.Text) -- ^ matcher function-                         -> [T.Text] -- ^ items to match against-                         -> EditorM T.Text-completeInListCustomShow showFunction s match possibilities-    | null filtered = printMsg "No match" >> return s-    | prefix /= s = return prefix-    | isSingleton filtered = printMsg "Sole completion" >> return s-    | prefix `elem` filtered =-        printMsg ("Complete, but not unique: " <> showT filtered) >> return s-    | otherwise = printMsgs (map showFunction filtered)-                  >> return (bestMatch filtered s)-    where-      prefix   = commonTPrefix' filtered-      filtered = filterMatches match possibilities--completeInList' :: T.Text-                -> (T.Text -> Maybe T.Text)-                -> [T.Text]-                -> EditorM T.Text-completeInList' s match l = case filtered of-  [] -> printMsg "No match" >> return s-  [x] | s == x    -> printMsg "Sole completion" >> return s-      | otherwise -> return x-  _ -> printMsgs filtered >> return (bestMatch filtered s)-  where-    filtered = filterMatches match l---- | This function attempts to provide a better tab completion result in--- cases where more than one file matches our prefix. Consider directory with--- following files: @["Main.hs", "Main.hi", "Main.o", "Test.py", "Foo.hs"]@.------ After inserting @Mai@ into the minibuffer and attempting to complete, the--- possible matches will be filtered in 'completeInList'' to--- @["Main.hs", "Main.hi", "Main.o"]@ however because of multiple matches,--- the buffer will not be updated to say @Main.@ but will instead stay at @Mai@.------ This is extremely tedious when trying to complete filenames in directories--- with many files so here we try to catch common prefixes of filtered files and--- if the result is longer than what we have, we use it instead.-bestMatch :: [T.Text] -> T.Text -> T.Text-bestMatch fs s = let p = commonTPrefix' fs-                 in if T.length p > T.length s then p else s--filterMatches :: Eq a => (b -> Maybe a) -> [b] -> [a]-filterMatches match = nub . catMaybes . fmap match---- Not really necessary but a bit faster than @(length l) == 1@-isSingleton :: [a] -> Bool-isSingleton [_] = True-isSingleton _   = False
− src/library/Yi/Config.hs 
@@ -1,31 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Config--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Module exposing common user settings. Users most likely want to be starting--- with "Yi.Config.Default".--module Yi.Config ( Config(..), UIConfig(..), UIBoot, CursorStyle(..)-                 , module Yi.Config.Lens-                 , configStyle, configFundamentalMode, configTopLevelKeymap-                 ) where--import Data.Prototype-import Yi.Style-import Yi.Types (Config(..), UIConfig(..), UIBoot, CursorStyle(..),-                 Keymap, extractTopKeymap, AnyMode)-import Yi.Config.Lens--configStyle :: UIConfig -> UIStyle-configStyle = extractValue . configTheme--configFundamentalMode :: Config -> AnyMode-configFundamentalMode = last . modeTable--configTopLevelKeymap :: Config -> Keymap-configTopLevelKeymap = extractTopKeymap . defaultKm
− src/library/Yi/Config/Default.hs 
@@ -1,262 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE OverloadedStrings #-}--module Yi.Config.Default ( defaultConfig, availableFrontends, defaultEmacsConfig-                         , defaultVimConfig, defaultCuaConfig, toVimStyleConfig-                         , toEmacsStyleConfig, toCuaStyleConfig) where--import           Control.Applicative-import           Control.Lens hiding (Action)-import           Control.Monad-import           Data.Default-import qualified Data.HashMap.Strict as HM-import qualified Data.Map as M-import           Data.Monoid-import           Paths_yi-import           System.FilePath--import           Yi.Buffer-import           Yi.Command (cabalBuildE, cabalConfigureE, grepFind, makeBuild,-                             reloadProjectE, searchSources, shell)-import           Yi.Config-import           Yi.Config.Misc-import           Yi.Core (errorEditor, quitEditor)-import           Yi.Editor-import           Yi.Eval(publishedActions)-import           Yi.File-import           Yi.IReader (saveAsNewArticle)-import qualified Yi.Interact as I-import           Yi.Keymap-import qualified Yi.Keymap.Cua  as Cua-import qualified Yi.Keymap.Emacs  as Emacs-import           Yi.Keymap.Keys-import qualified Yi.Keymap.Vim  as Vim-import           Yi.Layout-import qualified Yi.Mode.Abella as Abella-import qualified Yi.Mode.Haskell as Haskell-import           Yi.Mode.IReader (ireaderMode, ireadMode)-import qualified Yi.Mode.JavaScript as JS-import qualified Yi.Mode.Latex as Latex-import           Yi.Modes-import qualified Yi.Rope as R-import           Yi.Search-import           Yi.Style.Library-import qualified Yi.UI.Batch-import           Yi.Utils--#ifdef FRONTEND_VTY-import qualified Graphics.Vty.Config as Vty-import qualified Yi.UI.Vty-#endif-#ifdef FRONTEND_PANGO-import qualified Yi.UI.Pango-#endif---availableFrontends :: [(String, UIBoot)]-availableFrontends =-#ifdef FRONTEND_VTY-   ("vty", Yi.UI.Vty.start) :-#endif-#ifdef FRONTEND_PANGO-   ("pango", Yi.UI.Pango.start) :-#endif-   ("batch", Yi.UI.Batch.start) :-   []---- | List of published Actions---- THIS MUST BE OF THE FORM:--- ("symbol", box symbol")--- ... so we can hope getting rid of this someday.--- Failing to conform to this rule exposes the code to instant deletion.------ TODO: String → Text/YiString-defaultPublishedActions :: HM.HashMap String Action-defaultPublishedActions = HM.fromList-    [-      ("atBoundaryB"            , box atBoundaryB)-    , ("cabalBuildE"            , box cabalBuildE)-    , ("cabalConfigureE"        , box cabalConfigureE)-    , ("closeBufferE"           , box closeBufferE)-    , ("deleteB"                , box deleteB)-    , ("deleteBlankLinesB"      , box deleteBlankLinesB)-    , ("getSelectRegionB"       , box getSelectRegionB)-    , ("grepFind"               , box grepFind)-    , ("insertB"                , box insertB)-    , ("iread"                  , box ireadMode)-    , ("ireadSaveAsArticle"     , box saveAsNewArticle)-    , ("leftB"                  , box leftB)-    , ("linePrefixSelectionB"   , box linePrefixSelectionB)-    , ("lineStreamB"            , box lineStreamB)---    , ("mkRegion"               , box mkRegion) -- can't make 'instance Promptable Region'-    , ("makeBuild"              , box makeBuild)-    , ("moveB"                  , box moveB)-    , ("numberOfB"              , box numberOfB)-    , ("pointB"                 , box pointB)-    , ("regionOfB"              , box regionOfB)-    , ("regionOfPartB"          , box regionOfPartB)-    , ("regionOfPartNonEmptyB"  , box regionOfPartNonEmptyB)-    , ("reloadProjectE"         , box reloadProjectE)-    , ("replaceString"          , box replaceString)-    , ("revertE"                , box revertE)-    , ("shell"                  , box shell)-    , ("searchSources"          , box searchSources)-    , ("setAnyMode"             , box setAnyMode)-    , ("sortLines"              , box sortLines)-    , ("unLineCommentSelectionB", box unLineCommentSelectionB)-    , ("writeB"                 , box writeB)-    , ("ghciGet"                , box Haskell.ghciGet)-    , ("abella"                 , box Abella.abella)-    ]--  where-    box :: (Show x, YiAction a x) => a -> Action-    box = makeAction---defaultConfig :: Config-defaultConfig =-  publishedActions .~ defaultPublishedActions $-  Config { startFrontEnd    = case availableFrontends of-             [] -> error "panic: no frontend compiled in! (configure with -fvty or another frontend.)"-             ((_,f):_) -> f-         , configUI         =  UIConfig-           { configFontSize = Just 10-           , configFontName = Nothing-           , configScrollWheelAmount = 4-           , configScrollStyle = Nothing-           , configCursorStyle = FatWhenFocusedAndInserting-           , configLineWrap = True-           , configLeftSideScrollBar = True-           , configAutoHideScrollBar = False-           , configAutoHideTabBar = True-           , configWindowFill = ' '-           , configTheme = defaultTheme-#ifdef FRONTEND_VTY-           , configVty = def-#endif-           }-         , defaultKm        = modelessKeymapSet nilKeymap-         , startActions     = []-         , initialActions   = []-         , modeTable = [AnyMode Haskell.cleverMode,-                        AnyMode Haskell.preciseMode,-                        AnyMode Latex.latexMode3,-                        AnyMode Latex.fastMode,-                        AnyMode Abella.abellaModeEmacs,-                        AnyMode cMode,-                        AnyMode objectiveCMode,-                        AnyMode cppMode,-                        AnyMode Haskell.literateMode,-                        AnyMode cabalMode,-                        AnyMode gnuMakeMode,-                        AnyMode srmcMode,-                        AnyMode ocamlMode,-                        AnyMode ottMode,-                        AnyMode perlMode,-                        AnyMode (JS.hooks JS.javaScriptMode),-                        AnyMode pythonMode,-                        AnyMode rubyMode,-                        AnyMode javaMode,-                        AnyMode jsonMode,-                        AnyMode ireaderMode,-                        AnyMode svnCommitMode,-                        AnyMode gitCommitMode,-                        AnyMode whitespaceMode,-                        AnyMode fundamentalMode]-         , debugMode = False-         , configKillringAccumulate = False-         , configCheckExternalChangesObsessively = True-         , configRegionStyle = Exclusive-         , configInputPreprocess = I.idAutomaton-         , bufferUpdateHandler = []-         , layoutManagers = [hPairNStack 1, vPairNStack 1, tall, wide]-         , configVars = mempty-         }--defaultEmacsConfig, defaultVimConfig, defaultCuaConfig :: Config-defaultEmacsConfig = toEmacsStyleConfig defaultConfig-defaultVimConfig = toVimStyleConfig defaultConfig-defaultCuaConfig = toCuaStyleConfig defaultConfig--toEmacsStyleConfig, toVimStyleConfig, toCuaStyleConfig :: Config -> Config-toEmacsStyleConfig cfg-    = cfg {-            configUI = (configUI cfg)-                       { configScrollStyle = Just SnapToCenter-#ifdef FRONTEND_VTY-                       -- corey: does this actually matter? escToMeta appears to perform all the-                       -- meta joining required. I'm not an emacs user and cannot evaluate feel. For-                       -- me these settings join esc;key to meta-key OK. The 100 millisecond lag in-                       -- ESC is terrible for me. Maybe that's just how it is under emacs...-                       , configVty = def { Vty.vtime = Just 100, Vty.vmin = Just 2 }-#endif-                       },-            defaultKm = Emacs.keymap,-            startActions = makeAction openScratchBuffer : startActions cfg,-            configInputPreprocess = escToMeta,-            configKillringAccumulate = True-          }---- | Input preprocessor: Transform Esc;Char into Meta-Char--- Useful for emacs lovers ;)-escToMeta :: I.P Event Event-escToMeta = mkAutomaton $ forever $ (anyEvent >>= I.write) ||> do-    void $ event (spec KEsc)-    c <- printableChar-    I.write (Event (KASCII c) [MMeta])--toVimStyleConfig cfg = cfg-  { defaultKm = Vim.keymapSet-  , configUI = (configUI cfg)-      { configScrollStyle = Just SingleLine-#ifdef FRONTEND_VTY-      , configVty = (configVty (configUI cfg)) { Vty.vtime = Just 0 }-#endif-      }-  , configRegionStyle = Inclusive-  }--toCuaStyleConfig cfg = cfg {defaultKm = Cua.keymap}---- | Open an emacs-like scratch buffer if no file is open.-openScratchBuffer :: YiM ()-openScratchBuffer = withEditor $ do-  fileBufOpen <- any isFileOrDir . M.elems <$> use buffersA-  unless fileBufOpen $-    void . newBufferE (MemBuffer "scratch") $ R.unlines-            [ "This buffer is for notes you don't want to save."-            , "If you want to create a file, open that file,"-            , "then enter the text in that file's own buffer."-            , ""-            ]-  where-    isFileOrDir :: FBuffer -> Bool-    isFileOrDir attrs = case attrs ^. identA of-      MemBuffer  _ -> attrs ^. directoryContentA-      FileBuffer _ -> True--nilKeymap :: Keymap-nilKeymap = choice [-             char 'q' ?>>! quitEditor,-             char 'h' ?>>! configHelp-            ]-            <|| (anyEvent >>! errorEditor "Keymap not defined, 'q' to quit, 'h' for help.")-    where-      configHelp :: YiM ()-      configHelp = do-        dataDir <- io getDataDir-        let x <//> y = R.fromString (x </> y)-            welcomeText = R.unlines-              [ "This instance of Yi is not configured."-              , ""-              , "To get a standard reasonable keymap, you can run yi with"-              , "either --as=cua, --as=vim or --as=emacs."-              , ""-              , "You should however create your own ~/.config/yi/yi.hs file."-              , "As a starting point it's recommended to use one of the configs"-              , "from " <> (dataDir <//> "example-configs/")-              , ""-              ]-        withEditor_ $ newBufferE (MemBuffer "configuration help") welcomeText
− src/library/Yi/Config/Lens.hs 
@@ -1,26 +0,0 @@-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Config.Lens--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Lenses for types exported in Yi.Config. This module serves as a--- convenience module, for easy re-exporting.--module Yi.Config.Lens where--import Yi.Types (Config(..), UIConfig(..), YiConfigVariable)-import Yi.Utils (makeLensesWithSuffix)-import Control.Lens-import Data.DynamicState (_dyn)-import Data.Default--makeLensesWithSuffix "A" ''Config-makeLensesWithSuffix "A" ''UIConfig--configVariable :: YiConfigVariable a => Lens Config Config a a-configVariable = configVarsA . _dyn def
− src/library/Yi/Config/Misc.hs 
@@ -1,3 +0,0 @@-module Yi.Config.Misc where--data ScrollStyle = SnapToCenter | SingleLine
− src/library/Yi/Config/Simple.hs 
@@ -1,403 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE Rank2Types #-}-{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Config.Simple--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ A simplified configuration interface for Yi.------ This module provides a simple configuration API, allowing users to--- start with an initial configuration and imperatively (monadically)--- modify it. Some common actions (keybindings, selecting modes,--- choosing the frontend) have been given special commands--- ('globalBindKeys', 'setFrontendPreferences', 'addMode', and so on).------ A simple configuration might look like the following:------ @--- import Yi.Config.Simple--- import qualified Yi.Mode.Haskell as Haskell--- -- note: don't import "Yi", or else there will be name clashes------ main = 'configMain' 'defaultEmacsConfig' $ do---   'setFrontendPreferences' ["pango", "vty"]---   'fontSize' '%=' 'Just' 10---   'modeBindKeys' Haskell.cleverMode ('metaCh' \'q\' '?>>!' 'reload')---   'globalBindKeys' ('metaCh' \'r\' '?>>!' 'reload')--- @------ A lot of the fields here are specified with the 'Field' type. To write--- a field, use ('%='). To read, use 'get'. For modification, use--- ('modify'). For example, the functions @foo@ and @bar@ are equivalent:------ @--- foo = 'modify' 'layoutManagers' 'reverse'--- bar = do---  lms <- 'get' 'layoutManagers'---  'layoutManagers' '%=' 'reverse' lms--- @--module Yi.Config.Simple (-  -- * The main interface-  ConfigM,-  configMain,-  Field,-  -- * Frontend-  setFrontendPreferences,-  setFrontend,-  -- * Modes, commands, and keybindings-  globalBindKeys,-  modeBindKeys,-  modeBindKeysByName,-  addMode,-  modifyMode,-  modifyModeByName,-  -- * Evaluation of commands-  evaluator,-  ghciEvaluator,-  publishedActionsEvaluator,-  publishAction,-  publishedActions,-  -- * Appearance-  fontName,-  fontSize,-  scrollWheelAmount,-  scrollStyle,-  ScrollStyle(..),-  cursorStyle,-  CursorStyle(..),-  Side(..),-  scrollBarSide,-  autoHideScrollBar,-  autoHideTabBar,-  lineWrap,-  windowFill,-  theme,-  -- ** Layout-  layoutManagers,-  -- * Debugging-  debug,-  -- * Startup hooks-  runOnStartup,-  runAfterStartup,-  -- * Advanced-  -- $advanced-  startActions,-  initialActions,-  defaultKm,-  inputPreprocess,-  modes,-  regionStyle,-  killringAccumulate,-  bufferUpdateHandler,-  -- * Module exports--  -- we can't just export 'module Yi', because then we would get-  -- clashes with Yi.Config-  module Yi.Boot,-  module Yi.Buffer,-  module Yi.Core,-  module Yi.Dired,-  module Yi.Editor,-  module Yi.File,-  module Yi.Config,-  module Yi.Config.Default,-  module Yi.Keymap,-  module Yi.Keymap.Keys,-  module Yi.Layout,-  module Yi.Search,-  module Yi.Style,-  module Yi.Style.Library,-  module Yi.Misc,-  module Yi.Mode.Haskell,- ) where--import           Control.Applicative-import           Control.Lens hiding (Action)-import           Control.Monad.State hiding (modify, get)-import           Data.Maybe(mapMaybe)-import qualified Data.Text as T-import           Text.Printf(printf)-import           Yi.Boot-import           Yi.Buffer hiding (modifyMode)-import           Yi.Config.Default-import           Yi.Config.Misc-import           Yi.Config.Simple.Types-import           Yi.Core-import           Yi.Dired-import           Yi.Editor-import           Yi.Eval-import           Yi.File-import           Yi.Keymap-import           Yi.Keymap.Keys-import           Yi.Layout-import           Yi.Misc-import           Yi.Mode.Haskell-import           Yi.Search-import           Yi.Style-import           Yi.Style.Library-import           Yi.Utils---- we do explicit imports because we reuse a lot of the names-import           Yi.Config(Config, UIConfig, startFrontEndA, configUIA,-                           startActionsA, initialActionsA, defaultKmA,-                           configInputPreprocessA, modeTableA, debugModeA,-                           configRegionStyleA, configKillringAccumulateA,-                           bufferUpdateHandlerA, configFontNameA,-                           configFontSizeA, configScrollWheelAmountA,-                           configScrollStyleA, configCursorStyleA,-                           CursorStyle(..), configLeftSideScrollBarA,-                           configAutoHideScrollBarA, configAutoHideTabBarA,-                           configLineWrapA, configWindowFillA, configThemeA,-                           layoutManagersA, configVarsA,-#ifdef FRONTEND_VTY-                           configVtyA-#endif-                           )------------------ Main interface--- newtype ConfigM a   (imported)---- | Starts with the given initial config, makes the described--- modifications, then starts yi.-configMain :: Config -> ConfigM () -> IO ()-configMain c m = yi =<< execStateT (runConfigM m) c------------------------------------ Frontend--- | Sets the frontend to the first frontend from the list which is--- installed.------ Available frontends are a subset of: \"vty\", \"pango\", and--- \"batch\".-setFrontendPreferences :: [String] -> ConfigM ()-setFrontendPreferences fs =-   case mapMaybe (`lookup` availableFrontends) fs of-       (f:_) -> startFrontEndA .= f-       [] -> return ()---- | Sets the frontend, if it is available.-setFrontend :: String -> ConfigM ()-setFrontend f = case lookup f availableFrontends of-  Nothing -> return ()-  Just x  -> startFrontEndA .= x--------------------------- Modes, commands, and keybindings--- | Adds the given key bindings to the `global keymap'. The bindings--- will override existing bindings in the case of a clash.-globalBindKeys :: Keymap -> ConfigM ()-globalBindKeys a = (defaultKmA . topKeymapA) %= (||> a)---- | @modeBindKeys mode keys@ adds the keybindings in @keys@ to all--- modes with the same name as @mode@.------ As with 'modifyMode', a mode by the given name must already be--- registered, or the function will have no effect, and issue a--- command-line warning.-modeBindKeys :: Mode syntax -> Keymap -> ConfigM ()-modeBindKeys mode keys =-  ensureModeRegistered "modeBindKeys" (modeName mode) boundKeys-  where-    boundKeys = modeBindKeysByName (modeName mode) keys---- | @modeBindKeysByName name keys@ adds the keybindings in @keys@ to--- all modes with name @name@ (if it is registered). Consider using--- 'modeBindKeys' instead.-modeBindKeysByName :: T.Text -> Keymap -> ConfigM ()-modeBindKeysByName name k =-  ensureModeRegistered "modeBindKeysByName" name modMode-  where-    f :: (KeymapSet -> KeymapSet) -> KeymapSet -> KeymapSet-    f mkm km = topKeymapA %~ (||> k) $ mkm km--    modMode = modifyModeByName name (modeKeymapA %~ f)---- | Register the given mode. It will be preferred over any modes--- already defined.-addMode :: Mode syntax -> ConfigM ()-addMode m = modeTableA %= (AnyMode m :)---- | @modifyMode mode f@ modifies all modes with the same name as--- @mode@, using the function @f@.------ Note that the @mode@ argument is only used by its 'modeName'. In--- particular, a mode by the given name must already be registered, or--- this function will have no effect, and issue a command-line--- warning.------ @'modifyMode' mode f = 'modifyModeByName' ('modeName' mode) f@-modifyMode :: Mode syntax-           -> (forall syntax'. Mode syntax' -> Mode syntax')-           -> ConfigM ()-modifyMode mode f = ensureModeRegistered "modifyMode" (modeName mode) modMode-  where-    modMode = modifyModeByName (modeName mode) f---- | @modifyModeByName name f@ modifies the mode with name @name@--- using the function @f@. Consider using 'modifyMode' instead.-modifyModeByName :: T.Text-                 -> (forall syntax. Mode syntax -> Mode syntax)-                 -> ConfigM ()-modifyModeByName name f =-    ensureModeRegistered "modifyModeByName" name $ modeTableA %= fmap (onMode g)-        where-            g :: forall syntax. Mode syntax -> Mode syntax-            g m | modeName m == name = f m-                | otherwise          = m---- helper functions-warn :: String -> String -> ConfigM ()-warn caller msg = io $ putStrLn $ printf "Warning: %s: %s" caller msg--- the putStrLn shouldn't be necessary, but it doesn't print anything--- if it's not there...--isModeRegistered :: T.Text -> ConfigM Bool-isModeRegistered name =-  any (\(AnyMode mode) -> modeName mode == name) <$> use modeTableA---- ensure the given mode is registered, and if it is, then run the given action.-ensureModeRegistered :: String -> T.Text -> ConfigM () -> ConfigM ()-ensureModeRegistered caller name m = do-  isRegistered <- isModeRegistered name-  if isRegistered-   then m-   else warn caller (printf "mode \"%s\" is not registered." (T.unpack name))----------------------- Appearance--- | 'Just' the font name, or 'Nothing' for default.-fontName :: Field (Maybe String)-fontName = configUIA . configFontNameA---- | 'Just' the font size, or 'Nothing' for default.-fontSize :: Field (Maybe Int)-fontSize = configUIA . configFontSizeA---- | Amount to move the buffer when using the scroll wheel.-scrollWheelAmount :: Field Int-scrollWheelAmount = configUIA . configScrollWheelAmountA---- | 'Just' the scroll style, or 'Nothing' for default.-scrollStyle :: Field (Maybe ScrollStyle)-scrollStyle = configUIA . configScrollStyleA---- | See 'CursorStyle' for documentation.-cursorStyle :: Field CursorStyle-cursorStyle = configUIA . configCursorStyleA--data Side = LeftSide | RightSide---- | Which side to display the scroll bar on.-scrollBarSide :: Field Side-scrollBarSide = configUIA . configLeftSideScrollBarA . fromBool-  where-    fromBool :: Lens' Bool Side-    fromBool = lens (\b -> if b then LeftSide else RightSide)-                    (\_ s -> case s of { LeftSide -> True; RightSide -> False })---- | Should the scroll bar autohide?-autoHideScrollBar :: Field Bool-autoHideScrollBar = configUIA . configAutoHideScrollBarA---- | Should the tab bar autohide?-autoHideTabBar :: Field Bool-autoHideTabBar = configUIA . configAutoHideTabBarA---- | Should lines be wrapped?-lineWrap :: Field Bool-lineWrap = configUIA . configLineWrapA---- | The character with which to fill empty window space. Usually--- \'~\' for vi-like editors, \' \' for everything else.-windowFill :: Field Char-windowFill = configUIA . configWindowFillA---- | UI colour theme.-theme :: Field Theme-theme = configUIA . configThemeA------------ Layout--- | List of registered layout managers. When cycling through layouts,--- this list will be consulted.-layoutManagers :: Field [AnyLayoutManager]-layoutManagers = layoutManagersA-------------------------- Debugging--- | Produce a .yi.dbg file with debugging information?-debug :: Field Bool-debug = debugModeA------------- Startup hooks--- | Run when the editor is started (this is run after all actions--- which have already been registered)-runOnStartup :: Action -> ConfigM ()-runOnStartup action = runManyOnStartup [action]---- | List version of 'runOnStartup'.-runManyOnStartup :: [Action] -> ConfigM ()-runManyOnStartup actions = startActions %= (++ actions)---- | Run after the startup actions have completed, or on reload (this--- is run after all actions which have already been registered)-runAfterStartup :: Action -> ConfigM ()-runAfterStartup action = runManyAfterStartup [action]---- | List version of 'runAfterStartup'.-runManyAfterStartup :: [Action] -> ConfigM ()-runManyAfterStartup actions = initialActions %= (++ actions)-------------------------- Advanced-{- $advanced--These fields are here for completeness -- that is, to expose all the-functionality of the "Yi.Config" module. However, most users probably-need not use these fields, typically because they provide advanced-functinality, or because a simpler interface for the common case is-available above.---}---- | Actions to run when the editor is started. Consider using--- 'runOnStartup' or 'runManyOnStartup' instead.-startActions :: Field [Action]-startActions = startActionsA---- | Actions to run after startup or reload. Consider using--- 'runAfterStartup' or 'runManyAfterStartup' instead.-initialActions :: Field [Action]-initialActions = initialActionsA---- | Default keymap to use.-defaultKm :: Field KeymapSet-defaultKm = defaultKmA---- | ?-inputPreprocess :: Field (P Event Event)-inputPreprocess = configInputPreprocessA---- | List of modes by order of preference. Consider using 'addMode',--- 'modeBindKeys', or 'modifyMode' instead.-modes :: Field [AnyMode]-modes = modeTableA---- | Set to 'Exclusive' for an emacs-like behaviour. Consider starting--- with 'defaultEmacsConfig', 'defaultVimConfig', or--- 'defaultCuaConfig' to instead.-regionStyle :: Field RegionStyle-regionStyle = configRegionStyleA---- | Set to 'True' for an emacs-like behaviour, where all deleted text--- is accumulated in a killring. Consider starting with--- 'defaultEmacsConfig', 'defaultVimConfig', or 'defaultCuaConfig'--- instead.-killringAccumulate :: Field Bool-killringAccumulate = configKillringAccumulateA---- | ?-bufferUpdateHandler :: Field [[Update] -> BufferM ()]-bufferUpdateHandler = bufferUpdateHandlerA
− src/library/Yi/Config/Simple/Types.hs 
@@ -1,39 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE Rank2Types #-}---- | exports from "Yi.Config.Simple" which are useful to \"core yi\" rather than just config files.-module Yi.Config.Simple.Types- where--import Control.Monad.State hiding (modify, get)-import Control.Monad.Base-import Control.Applicative-import Control.Lens-import Yi.Config-import Yi.Types---- | The configuration monad. Run it with 'configMain'.-newtype ConfigM a = ConfigM {-    runConfigM :: StateT Config IO a-  } deriving (Monad, Functor, Applicative, MonadState Config, MonadBase IO)---- | Fields that can be modified with all lens machinery.-type Field a = Lens' Config a--{- | Accessor for any 'YiConfigVariable', to be used by modules defining-'YiConfigVariable's. Such modules should provide a custom-named field.-For instance, take the following hypothetical 'YiConfigVariable':--@newtype UserName = UserName { unUserName :: String }-  deriving(Typeable, Binary, Default)-instance YiConfigVariable UserName--$(nameDeriveAccessors ''UserName (\n -> Just (n ++ \"A\")))--userName :: 'Field' 'String'-userName = unUserNameA '.' 'customVariable'@--Here, the hypothetical library would provide the field @userName@ to be used in preference to @customVariable@.--}-customVariable :: YiConfigVariable a => Field a-customVariable = configVariable
− src/library/Yi/Core.hs 
@@ -1,530 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE RecursiveDo #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Core--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ The core actions of Yi. This module is the link between the editor--- and the UI. Key bindings, and libraries should manipulate Yi--- through the interface defined here.--module Yi.Core-  (-  -- * Construction and destruction-    startEditor-  , quitEditor          -- :: YiM ()--  -- * User interaction-  , refreshEditor       -- :: YiM ()-  , suspendEditor       -- :: YiM ()-  , userForceRefresh--  -- * Global editor actions-  , errorEditor         -- :: String -> YiM ()-  , closeWindow         -- :: YiM ()--  -- * Interacting with external commands-  , runProcessWithInput          -- :: String -> String -> YiM String-  , startSubprocess                 -- :: FilePath -> [String] -> YiM ()-  , sendToProcess--  -- * Misc-  , runAction-  , withSyntax-  , focusAllSyntax-  , forkAction-  ) where--import           Control.Applicative-import           Control.Concurrent-import           Control.Exc-import           Control.Exception-import           Control.Lens hiding (Action,act,acts)-import           Control.Monad hiding (mapM_,forM_,forM)-import           Control.Monad.Base-import           Control.Monad.Error ()-import           Control.Monad.Reader hiding (mapM_,forM_,forM)-import qualified Data.DelayList as DelayList-import           Data.Foldable-import           Data.List (partition)-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.PointedList.Circular as PL-import           Data.List.Split (splitOn)-import qualified Data.Map as M-import           Data.Maybe-import           Data.Monoid-import qualified Data.Text as T-import           Data.Time-import           Data.Time.Clock.POSIX-import           Data.Traversable-import           GHC.Conc (labelThread)-import           Prelude hiding (elem,or,mapM_)-import           System.Directory (doesFileExist)-import           System.Exit-import           System.IO (Handle, hWaitForInput, hPutStr)-import           System.PosixCompat.Files-import           System.Process (terminateProcess, getProcessExitCode,-                                 ProcessHandle, readProcessWithExitCode)-import           Yi.Buffer-import           Yi.Config-import           Yi.Debug-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Keys-import           Yi.KillRing (krEndCmd)-import           Yi.Monad-import           Yi.Process (createSubprocess, readAvailable,-                             SubprocessId, SubprocessInfo(..))-import qualified Yi.Rope as R-import           Yi.String-import           Yi.Style (errorStyle, strongHintStyle)-import qualified Yi.UI.Common as UI-import           Yi.Utils-import           Yi.Window (dummyWindow, bufkey, wkey, winRegion)-import           Yi.PersistentState (loadPersistentState, savePersistentState)---- | Make an action suitable for an interactive run.--- UI will be refreshed.-interactive :: IsRefreshNeeded -> [Action] -> YiM ()-interactive isRefreshNeeded action = do-  evs <- withEditor $ use pendingEventsA-  logPutStrLn $ ">>> interactively" <> showEvs evs-  withEditor $ (%=) buffersA (fmap $  undosA %~ addChangeU InteractivePoint)-  mapM_ runAction action-  withEditor $ (%=) killringA krEndCmd-  when (isRefreshNeeded == MustRefresh) refreshEditor-  logPutStrLn "<<<"-  return ()---- ------------------------------------------------------------------------ | Start up the editor, setting any state with the user preferences--- and file names passed in, and turning on the UI----startEditor :: Config -> Maybe Editor -> IO ()-startEditor cfg st = do-    let uiStart = startFrontEnd cfg--    logPutStrLn "Starting Core"--    -- Use an empty state unless resuming from an earlier session and-    -- one is already available-    let editor = fromMaybe emptyEditor st-    -- here to add load history etc?--    -- Setting up the 1st window is a bit tricky because most-    -- functions assume there exists a "current window"-    newSt <- newMVar $ YiVar editor 1 M.empty-    (ui, runYi) <- mdo-        let handler (exception :: SomeException) =-              runYi $ errorEditor (showT exception) >> refreshEditor--            inF []     = return ()-            inF (e:es) = handle handler $ runYi $ dispatch (e :| es)--            outF refreshNeeded acts =-                handle handler $ runYi $ interactive refreshNeeded acts-            runYi f   = runReaderT (runYiM f) yi-            yi        = Yi ui inF outF cfg newSt-        ui <- uiStart cfg inF (outF MustRefresh) editor-        return (ui, runYi)--    runYi loadPersistentState--    runYi $ do-      if isNothing st-        -- process options if booting for the first time-        then postActions NoNeedToRefresh $ startActions cfg-        -- otherwise: recover the mode of buffers-        else withEditor $ buffersA.mapped %= recoverMode (modeTable cfg)-      postActions NoNeedToRefresh $ initialActions cfg ++ [makeAction showErrors]--    runYi refreshEditor--    UI.main ui -- transfer control to UI---- | Runs a 'YiM' action in a separate thread.------ Notes:------ * It seems to work but I don't know why------ * Maybe deadlocks?------ * If you're outputting into the Yi window, you should really limit--- the rate at which you do so: for example, the Pango front-end will--- quite happily segfault/double-free if you output too fast.------ I am exporting this for those adventurous to play with but I have--- only discovered how to do this a night before the release so it's--- rather experimental. A simple function that prints a message once a--- second, 5 times, could be written like this:------ @--- printer :: YiM ThreadId--- printer = do---   mv <- io $ newMVar (0 :: Int)---   forkAction (suicide mv) MustRefresh $ do---     c <- io $ do---       modifyMVar_ mv (return . succ)---       tryReadMVar mv---     case c of---       Nothing -> printMsg "messaging unknown time"---       Just x -> printMsg $ "message #" <> showT x---   where---     suicide mv = tryReadMVar mv >>= \case---       Just i | i >= 5 -> return True---       _ -> threadDelay 1000000 >> return False--- @-forkAction :: (YiAction a x, Show x)-           => IO Bool-              -- ^ runs after we insert the action: this may be a-              -- thread delay or a thread suicide or whatever else;-              -- when delay returns False, that's our signal to-              -- terminate the thread.-           -> IsRefreshNeeded-              -- ^ should we refresh after each action-           -> a-              -- ^ The action to actually run-           -> YiM ThreadId-forkAction delay ref ym = onYiVar $ \yi yv -> do-  let loop = do-        yiOutput yi ref [makeAction ym]-        delay >>= \b -> when b loop-  t <- forkIO loop-  return (yv, t)--recoverMode :: [AnyMode] -> FBuffer -> FBuffer-recoverMode tbl buffer  = case fromMaybe (AnyMode emptyMode) (find (\(AnyMode m) -> modeName m == oldName) tbl) of-    AnyMode m -> setMode0 m buffer-  where oldName = case buffer of FBuffer {bmode = m} -> modeName m--postActions :: IsRefreshNeeded -> [Action] -> YiM ()-postActions refreshNeeded actions = do yi <- ask; liftBase $ yiOutput yi refreshNeeded actions---- | Display the errors buffer if it is not already visible.-showErrors :: YiM ()-showErrors = withEditor $ do-               bs <- gets $ findBufferWithName "*errors*"-               case bs of-                 [] -> return ()-                 _  -> do splitE-                          switchToBufferWithNameE "*errors*"---- | Process events by advancing the current keymap automaton and--- executing the generated actions.-dispatch :: NonEmpty Event -> YiM ()-dispatch (ev :| evs) = do-  yi <- ask-  (userActions, _p') <- withCurrentBuffer $ do-    keymap <- gets (withMode0 modeKeymap)-    p0 <- use keymapProcessA-    let km = extractTopKeymap $ keymap $ defaultKm $ yiConfig yi-    let freshP = Chain (configInputPreprocess $ yiConfig yi) (mkAutomaton km)-        p = case computeState p0 of-              Dead  -> freshP-              _     -> p0-        (actions, p') = processOneEvent p ev-        state = computeState p'-        ambiguous = case state of-            Ambiguous _ -> True-            _ -> False-    assign keymapProcessA (if ambiguous then freshP else p')-    let actions0 = case state of-          Dead -> [EditorA $ do-                      evs' <- use pendingEventsA-                      printMsg ("Unrecognized input: " <> showEvs (evs' ++ [ev]))]-          _ -> actions--        actions1 = [ EditorA (printMsg "Keymap was in an ambiguous state! Resetting it.")-                   | ambiguous]--    return (actions0 ++ actions1, p')--  let decay, pendingFeedback :: EditorM ()-      decay = statusLinesA %= DelayList.decrease 1-      pendingFeedback = do pendingEventsA %= (++ [ev])-                           if null userActions-                               then printMsg . showEvs =<< use pendingEventsA-                               else assign pendingEventsA []-      allActions = [makeAction decay] ++ userActions ++ [makeAction pendingFeedback]--  case evs of-    [] -> postActions MustRefresh allActions-    (e:es) -> postActions NoNeedToRefresh allActions >> dispatch (e :| es)---showEvs :: [Event] -> T.Text-showEvs = T.unwords . fmap (T.pack . prettyEvent)---- ------------------------------------------------------------------------ Meta operations---- | Quit.-quitEditor :: YiM ()-quitEditor = do-    savePersistentState-    onYiVar $ terminateSubprocesses (const True)-    withUI (`UI.end` True)---- | Update (visible) buffers if they have changed on disk.--- FIXME: since we do IO here we must catch exceptions!-checkFileChanges :: Editor -> IO Editor-checkFileChanges e0 = do-        now <- getCurrentTime-        -- Find out if any file was modified "behind our back" by-        -- other processes.-        newBuffers <- forM (buffers e0) $ \b ->-          let nothing = return (b, Nothing)-          in if bkey b `elem` visibleBuffers-          then-            case b ^.identA of-               FileBuffer fname -> do-                  fe <- doesFileExist fname-                  if not fe then nothing else do-                  modTime <- fileModTime fname-                  if b ^. lastSyncTimeA < modTime-                     then if isUnchangedBuffer b-                       then do newContents <- R.readFile fname-                               return (snd $ runBuffer (dummyWindow $ bkey b) b (revertB newContents now), Just msg1)-                       else return (b, Just msg2)-                     else nothing-               _ -> nothing-          else nothing-        -- show appropriate update message if applicable-        return $ case getFirst (foldMap (First . snd) newBuffers) of-               Just msg -> (statusLinesA %~ DelayList.insert msg) e0 {buffers = fmap fst newBuffers}-               Nothing -> e0-    where msg1 = (1, (["File was changed by a concurrent process, reloaded!"], strongHintStyle))-          msg2 = (1, (["Disk version changed by a concurrent process"], strongHintStyle))-          visibleBuffers = fmap bufkey $ windows e0-          fileModTime f = posixSecondsToUTCTime . realToFrac . modificationTime <$> getFileStatus f---- | Hide selection, clear "syntax dirty" flag (as appropriate).-clearAllSyntaxAndHideSelection :: Editor -> Editor-clearAllSyntaxAndHideSelection = buffersA %~ fmap (clearSyntax . clearHighlight)-  where-    clearHighlight fb =-      -- if there were updates, then hide the selection.-      let h = view highlightSelectionA fb-          us = view pendingUpdatesA fb-      in highlightSelectionA .~ (h && null us) $ fb----- Focus syntax tree on the current window, for all visible buffers.-focusAllSyntax :: Editor -> Editor-focusAllSyntax e6 = buffersA %~ fmap (\b -> focusSyntax (regions b) b) $ e6-    where regions b = M.fromList [(wkey w, winRegion w) | w <- toList $ windows e6, bufkey w == bkey b]-          -- Why bother filtering the region list? After all the trees-          -- are lazily computed. Answer: focusing is an incremental-          -- algorithm. Each "focused" path depends on the previous-          -- one. If we left unforced focused paths, we'd create a-          -- long list of thunks: a memory leak.---- | Redraw-refreshEditor :: YiM ()-refreshEditor = onYiVar $ \yi var -> do-        let cfg = yiConfig yi-            runOnWins a = runEditor cfg-                                    (do ws <- use windowsA-                                        forM ws $ flip withWindowE a)-            style = configScrollStyle $ configUI cfg-        let scroll e3 = let (e4, relayout) = runOnWins (snapScreenB style) e3 in-                -- Scroll windows to show current points as appropriate-                -- Do another layout pass if there was any scrolling;-                (if or relayout then UI.layout (yiUi yi) else return) e4--        e7 <- (if configCheckExternalChangesObsessively cfg-               then checkFileChanges-               else return) (yiEditor var) >>=-             return . clearAllSyntaxAndHideSelection >>=-             -- Adjust window sizes according to UI info-             UI.layout (yiUi yi) >>=-             scroll >>=-             -- Adjust point according to the current layout;-             return . (fst . runOnWins snapInsB) >>=-             return . focusAllSyntax >>=-             -- Clear "pending updates" and "followUp" from buffers.-             return . (buffersA %~ fmap (clearUpdates . clearFollow))-        -- Display the new state of the editor-        UI.refresh (yiUi yi) e7-        -- Terminate stale processes.-        terminateSubprocesses (staleProcess $ buffers e7) yi var {yiEditor = e7}-  where-    clearUpdates = pendingUpdatesA .~ []-    clearFollow = pointFollowsWindowA .~ const False-    -- Is this process stale? (associated with a deleted buffer)-    staleProcess bs p = not (bufRef p `M.member` bs)----- | Suspend the program-suspendEditor :: YiM ()-suspendEditor = withUI UI.suspend------------------------------------------------------------------------------------------------------------------------------------------------------- | Pipe a string through an external command, returning the stdout--- chomp any trailing newline (is this desirable?)------ Todo: varients with marks?----runProcessWithInput :: String -> String -> YiM String-runProcessWithInput cmd inp = do-    let (f:args) = splitOn " " cmd-    (_,out,_err) <- liftBase $ readProcessWithExitCode f args inp-    return (chomp "\n" out)------------------------------------------------------------------------------ | Same as 'Yi.Editor.printMsg', but do nothing instead of printing @()@-msgEditor :: T.Text -> YiM ()-msgEditor "()" = return ()-msgEditor s = printMsg s--runAction :: Action -> YiM ()-runAction (YiA act) = act >>= msgEditor . showT-runAction (EditorA act) = withEditor act >>= msgEditor . showT-runAction (BufferA act) = withCurrentBuffer act >>= msgEditor . showT---- | Show an error on the status line and log it.-errorEditor :: T.Text -> YiM ()-errorEditor s = do-  printStatus (["error: " <> s], errorStyle)-  logPutStrLn $ "errorEditor: " <> s---- | Close the current window.--- If this is the last window open, quit the program.------ CONSIDER: call quitEditor when there are no other window in the--- 'interactive' function. (Not possible since the windowset type--- disallows it -- should it be relaxed?)-closeWindow :: YiM ()-closeWindow = do-    winCount <- withEditor $ uses windowsA PL.length-    tabCount <- withEditor $ uses tabsA PL.length-    when (winCount == 1 && tabCount == 1) quitEditor-    withEditor tryCloseE--onYiVar :: (Yi -> YiVar -> IO (YiVar, a)) -> YiM a-onYiVar f = do-  yi <- ask-  io $ modifyMVar (yiVar yi) (f yi)---- | Kill a given subprocess-terminateSubprocesses :: (SubprocessInfo -> Bool) -> Yi -> YiVar -> IO (YiVar, ())-terminateSubprocesses shouldTerminate _yi var = do-  let (toKill, toKeep) =-        partition (shouldTerminate . snd) $ M.assocs $ yiSubprocesses var-  void $ forM toKill $ terminateProcess . procHandle . snd-  return (var & yiSubprocessesA .~ M.fromList toKeep, ())---- | Start a subprocess with the given command and arguments.-startSubprocess :: FilePath-                -> [String]-                -> (Either SomeException ExitCode -> YiM x)-                -> YiM BufferRef-startSubprocess cmd args onExit = onYiVar $ \yi var -> do-        let (e', bufref) = runEditor-                              (yiConfig yi)-                              (printMsg ("Launched process: " <> T.pack cmd)-                               >> newEmptyBufferE (MemBuffer bufferName))-                              (yiEditor var)-            procid = yiSubprocessIdSupply var + 1-        procinfo <- createSubprocess cmd args bufref-        startSubprocessWatchers procid procinfo yi onExit-        return (var & yiEditorA .~ e'-                    & yiSubprocessIdSupplyA .~ procid-                    & yiSubprocessesA %~ M.insert procid procinfo-               , bufref)-  where-    bufferName = T.unwords [ "output from", T.pack cmd, showT args ]--startSubprocessWatchers :: SubprocessId-                        -> SubprocessInfo-                        -> Yi-                        -> (Either SomeException ExitCode -> YiM x)-                        -> IO ()-startSubprocessWatchers procid procinfo yi onExit =-    mapM_ (\(labelSuffix, run) -> do-              threadId <- forkOS run-              labelThread threadId (procCmd procinfo ++ labelSuffix))-          ([("Err", pipeToBuffer (hErr procinfo) (send . append True)) | separateStdErr procinfo] ++-           [("Out", pipeToBuffer (hOut procinfo) (send . append False)),-            ("Exit", waitForExit (procHandle procinfo) >>= reportExit)])-  where-    send :: YiM () -> IO ()-    send a = yiOutput yi MustRefresh [makeAction a]--    -- TODO: This 'String' here is due to 'pipeToBuffer' but I don't-    -- know how viable it would be to read from a process as Text.-    -- Probably not worse than String but needs benchmarking.-    append :: Bool -> String -> YiM ()-    append atMark =-      withEditor . appendToBuffer atMark (bufRef procinfo) . R.fromString--    reportExit :: Either SomeException ExitCode -> IO ()-    reportExit ec = send $ do-      append True $ "Process exited with " <> show ec-      removeSubprocess procid-      void $ onExit ec--removeSubprocess :: SubprocessId -> YiM ()-removeSubprocess procid = asks yiVar >>= liftBase . flip modifyMVar_ (pure . (yiSubprocessesA %~ M.delete procid))---- | Appends a 'R.YiString' to the given buffer.------ TODO: Figure out and document the Bool here. Probably to do with--- 'startSubprocessWatchers'.-appendToBuffer :: Bool      -- Something to do with stdout/stderr?-               -> BufferRef -- ^ Buffer to append to-               -> R.YiString  -- ^ Text to append-               -> EditorM ()-appendToBuffer atErr bufref s = withGivenBuffer bufref $ do-    -- We make sure stdout is always after stderr. This ensures that-    -- the output of the two pipe do not get interleaved. More-    -- importantly, GHCi prompt should always come after the error-    -- messages.-    me <- getMarkB (Just "StdERR")-    mo <- getMarkB (Just "StdOUT")-    let mms = if atErr then [mo, me] else [mo]-    forM_ mms (`modifyMarkB` (markGravityAA .~ Forward))-    insertNAt s =<< use (markPointA (if atErr then me else mo))-    forM_ mms (`modifyMarkB` (markGravityAA .~ Backward))--sendToProcess :: BufferRef -> String -> YiM ()-sendToProcess bufref s = do-    yi <- ask-    find ((== bufref) . bufRef) . yiSubprocesses <$> liftBase (readMVar (yiVar yi)) >>= \case-      Just subProcessInfo -> io $ hPutStr (hIn subProcessInfo) s-      Nothing -> printMsg "Could not get subProcessInfo in sendToProcess"--pipeToBuffer :: Handle -> (String -> IO ()) -> IO ()-pipeToBuffer h append = void . ignoringException . forever $ do-  _ <- hWaitForInput h (-1)-  r <- readAvailable h-  append r--waitForExit :: ProcessHandle -> IO (Either SomeException ExitCode)-waitForExit ph =-    handle (\e -> return (Left (e :: SomeException))) $ do-      mec <- getProcessExitCode ph-      case mec of-          Nothing -> threadDelay (500*1000) >> waitForExit ph-          Just ec -> return (Right ec)--withSyntax :: (Show x, YiAction a x) => (forall syntax. Mode syntax -> syntax -> a) -> YiM ()-withSyntax f = do-            b <- gets currentBuffer-            act <- withGivenBuffer b $ withSyntaxB f-            runAction $ makeAction act--userForceRefresh :: YiM ()-userForceRefresh = withUI UI.userForceRefresh
− src/library/Yi/Debug.hs 
@@ -1,92 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Debug--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Debug utilities used throughout Yi.--module Yi.Debug ( initDebug, trace, traceM, traceM_, logPutStrLn-                , logError, logStream, Yi.Debug.error ) where--import           Control.Concurrent-import           Control.Monad.Base-import           Data.IORef-import           Data.Monoid-import qualified Data.Text as T-import           Data.Time-import           GHC.Conc (labelThread)-import           System.IO-import           System.IO.Unsafe (unsafePerformIO)-import           System.Locale--dbgHandle :: IORef (Maybe Handle)-dbgHandle = unsafePerformIO $ newIORef Nothing-{-# NOINLINE dbgHandle #-}---- | Set the file to which debugging output should be written. Though this--- is called /init/Debug.--- Debugging output is not created by default (i.e., if this function--- is never called.)--- The target file can not be changed, nor debugging disabled.-initDebug :: FilePath -> IO ()-initDebug f = do-  hndl <- readIORef dbgHandle-  case hndl of-    Nothing -> do openFile f WriteMode >>= writeIORef dbgHandle . Just-                  logPutStrLn "Logging initialized."-    Just _ -> logPutStrLn "Attempt to re-initialize the logging system."----- | Outputs the given string before returning the second argument.-trace :: T.Text -> a -> a-trace s e = unsafePerformIO $ logPutStrLn s >> return e-{-# NOINLINE trace #-}--error :: T.Text -> a-error s = unsafePerformIO $ logPutStrLn s >> Prelude.error (T.unpack s)--logPutStrLn :: MonadBase IO m => T.Text -> m ()-logPutStrLn s = liftBase $ do-  readIORef dbgHandle >>= \case-    Nothing -> return ()-    Just h -> do-      time <-  getCurrentTime-      tId <- myThreadId-      let m = show tId ++ " " ++ T.unpack s-      hPutStrLn h $ formatTime defaultTimeLocale rfc822DateFormat' time ++ m-      hFlush h-  where-    -- A bug in rfc822DateFormat makes us use our own format string-    rfc822DateFormat' = "%a, %d %b %Y %H:%M:%S %Z"--logError :: MonadBase IO m => T.Text -> m ()-logError s = logPutStrLn $ "error: " <> s--logStream :: Show a => T.Text -> Chan a -> IO ()-logStream msg ch = do-  logPutStrLn $ "Logging stream " <> msg-  logThreadId <- forkIO $ logStreamThread msg ch-  labelThread logThreadId "LogStream"--logStreamThread :: Show a => T.Text -> Chan a -> IO ()-logStreamThread msg ch = do-  stream <- getChanContents =<< dupChan ch-  mapM_ logPutStrLn [ msg `T.snoc` '(' <> T.pack (show i) `T.snoc` ')'-                     <> T.pack (show event)-                    | (event, i) <- zip stream [(0::Int)..]-                    ]---- | Traces @x@ and returns @y@.-traceM :: Monad m => T.Text -> a -> m a-traceM x y = trace x $ return y---- | Like traceM, but returns ().-traceM_ :: Monad m => T.Text -> m ()-traceM_ x = traceM x ()
− src/library/Yi/Dired.hs 
@@ -1,1093 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}--{-|-Module      :  Yi.Dired-License     :  GPL-2-Maintainer  :  yi-devel@googlegroups.com-Stability   :  experimental-Portability :  portable--A simple-<https://www.gnu.org/software/emacs/manual/html_node/emacs/Dired.html dired>-implementation for Yi.--= TODO--* add more comments-* Support symlinks-* Mark operations--    * search--* Improve the colouring to show--    * loaded buffers-    * .hs files-    * marked files--* Fix old mod dates (> 6months) to show year-* Fix the 'number of links' field to show actual values not just 1...-* Automatic support for browsing .zip, .gz files etc...--}--module Yi.Dired-  ( dired-  , diredDir-  , diredDirBuffer-  , editFile-  ) where--import           Control.Category ((>>>))-import           Control.Applicative-import           Control.Exc-import           Control.Lens hiding (act, op, pre)-import           Control.Monad.Reader hiding (mapM)-import           Data.Binary-import           Data.Char (toLower)-import           Data.Default-#if __GLASGOW_HASKELL__ < 708-import           Data.DeriveTH-#else-import           GHC.Generics (Generic)-#endif-import           Data.Foldable (find)-import           Data.List hiding (find, maximum, concat)-import qualified Data.Map as M-import           Data.Monoid-import qualified Data.Text as T-import           Data.Time-import           Data.Time.Clock.POSIX-import           Data.Typeable-import           System.CanonicalizePath (canonicalizePath)-import           System.Directory hiding (canonicalizePath)-import           System.FilePath-import           System.FriendlyPath-import           System.Locale-import           System.PosixCompat.Files-import           System.PosixCompat.Types-import           System.PosixCompat.User-import           Text.Printf-import           Yi.Buffer-import           Yi.Config-import           Yi.Core-import           Yi.Types (YiVariable)-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Keys-import           Yi.MiniBuffer (spawnMinibufferE, withMinibufferFree, noHint,-                                withMinibuffer)-import           Yi.Misc (getFolder, promptFile)-import           Yi.Monad-import           Yi.Regex-import qualified Yi.Rope as R-import           Yi.String (showT)-import           Yi.Style-import           Yi.Utils---- Have no idea how to keep track of this state better, so here it is ...-data DiredOpState = DiredOpState-    { _diredOpSucCnt :: !Int -- ^ keep track of the num of successful operations-    , _diredOpForAll :: Bool -- ^ if True, DOChoice will be bypassed-    }-    deriving (Show, Eq, Typeable)--instance Default DiredOpState where-    def = DiredOpState { _diredOpSucCnt = 0, _diredOpForAll = False }--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''DiredOpState)-#else-deriving instance Generic DiredOpState-instance Binary DiredOpState-#endif--instance YiVariable DiredOpState--makeLenses ''DiredOpState--data DiredFileInfo = DiredFileInfo {  permString :: R.YiString-                                    , numLinks :: Integer-                                    , owner :: R.YiString-                                    , grp :: R.YiString-                                    , sizeInBytes :: Integer-                                    , modificationTimeString :: R.YiString-                                 }-                deriving (Show, Eq, Typeable)--data DiredEntry = DiredFile DiredFileInfo-                | DiredDir DiredFileInfo-                | DiredSymLink DiredFileInfo R.YiString-                | DiredSocket DiredFileInfo-                | DiredBlockDevice DiredFileInfo-                | DiredCharacterDevice DiredFileInfo-                | DiredNamedPipe DiredFileInfo-                | DiredNoInfo-                deriving (Show, Eq, Typeable)---- | Alias serving as documentation of some arguments. We keep most--- paths as 'R.YiString' for the sole reason that we'll have to render--- them.-type DiredFilePath = R.YiString---- | Handy alias for 'DiredEntry' map.-type DiredEntries = M.Map DiredFilePath DiredEntry--data DiredState = DiredState-  { diredPath :: FilePath -- ^ The full path to the directory being viewed-    -- FIXME Choose better data structure for Marks...-   , diredMarks :: M.Map FilePath Char-     -- ^ Map values are just leafnames, not full paths-   , diredEntries :: DiredEntries-     -- ^ keys are just leafnames, not full paths-   , diredFilePoints :: [(Point,Point,FilePath)]-     -- ^ position in the buffer where filename is-   , diredNameCol :: Int-     -- ^ position on line where filename is (all pointA are this col)-   , diredCurrFile :: FilePath-     -- ^ keep the position of pointer (for refreshing dired buffer)-  } deriving (Show, Eq, Typeable)--makeLensesWithSuffix "A" ''DiredState--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''DiredState)-#else-deriving instance Generic DiredState-instance Binary DiredState-#endif--instance Default DiredState where-    def = DiredState { diredPath       = mempty-                     , diredMarks      = mempty-                     , diredEntries    = mempty-                     , diredFilePoints = mempty-                     , diredNameCol    = 0-                     , diredCurrFile   = mempty-                     }--instance YiVariable DiredState--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''DiredEntry)-$(derive makeBinary ''DiredFileInfo)-#else-deriving instance Generic DiredEntry-deriving instance Generic DiredFileInfo-instance Binary DiredEntry-instance Binary DiredFileInfo-#endif---- | If file exists, read contents of file into a new buffer, otherwise--- creating a new empty buffer. Replace the current window with a new--- window onto the new buffer.------ If the file is already open, just switch to the corresponding buffer.------ Need to clean up semantics for when buffers exist, and how to attach--- windows to buffers.------ @Yi.File@ module re-exports this, you probably want to import that--- instead.-editFile :: FilePath -> YiM BufferRef-editFile filename = do-    f <- io $ userToCanonPath filename--    dupBufs <- filter (maybe False (equalFilePath f) . file) <$> gets bufferSet--    dirExists  <- io $ doesDirectoryExist f-    fileExists <- io $ doesFileExist f--    b <- case dupBufs of-      [] -> if dirExists-               then diredDirBuffer f-               else setupMode f =<< if fileExists-                                       then fileToNewBuffer f-                                       else newEmptyBuffer f-      (h:_) -> return $ bkey h--    withEditor $ switchToBufferE b >> addJumpHereE-    return b-  where-    fileToNewBuffer :: FilePath -> YiM BufferRef-    fileToNewBuffer f = do-      now <- io getCurrentTime-      contents <- io $ R.readFile f-      permissions <- io $ getPermissions f--      b <- stringToNewBuffer (FileBuffer f) contents-      withGivenBuffer b $ markSavedB now--      unless (writable permissions) (withGivenBuffer b $ assign readOnlyA True)--      return b--    newEmptyBuffer :: FilePath -> YiM BufferRef-    newEmptyBuffer f =-      stringToNewBuffer (FileBuffer f) mempty--    setupMode :: FilePath -> BufferRef -> YiM BufferRef-    setupMode f b = do-      tbl <- asks (modeTable . yiConfig)-      content <- withGivenBuffer b elemsB--      let header = R.take 1024 content-          rx = "\\-\\*\\- *([^ ]*) *\\-\\*\\-" :: String-          hmode = case R.toString header =~ rx of-              AllTextSubmatches [_,m] -> T.pack m-              _ -> ""-          Just mode = find (\(AnyMode m) -> modeName m == hmode) tbl <|>-                      find (\(AnyMode m) -> modeApplies m f header) tbl <|>-                      Just (AnyMode emptyMode)-      case mode of-          AnyMode newMode -> withGivenBuffer b $ setMode newMode--      return b---bypassReadOnly :: BufferM a -> BufferM a-bypassReadOnly f = do ro <- use readOnlyA-                      assign readOnlyA False-                      res <- f-                      assign readOnlyA ro-                      return res--filenameColOf :: BufferM () -> BufferM ()-filenameColOf f = getBufferDyn >>= assign preferColA . Just . diredNameCol >> f--resetDiredOpState :: YiM ()-resetDiredOpState = withCurrentBuffer $ putBufferDyn (def :: DiredOpState)--incDiredOpSucCnt :: YiM ()-incDiredOpSucCnt =-  withCurrentBuffer $ getBufferDyn >>= putBufferDyn . (diredOpSucCnt %~ succ)--getDiredOpState :: YiM DiredOpState-getDiredOpState = withCurrentBuffer $ getBufferDyn--modDiredOpState :: (DiredOpState -> DiredOpState) -> YiM ()-modDiredOpState f = withCurrentBuffer $ getBufferDyn >>= putBufferDyn . f---- | Execute the operations------ Pass the list of remaining operations down, insert new ops at the--- head if needed-procDiredOp :: Bool -> [DiredOp] -> YiM ()-procDiredOp counting (DORemoveFile f:ops) = do-  io $ printingException ("Remove file " <> f) (removeLink f)-  when counting postproc-  procDiredOp counting ops-    where postproc = do incDiredOpSucCnt-                        withCurrentBuffer $ diredUnmarkPath (takeFileName f)-procDiredOp counting (DORemoveDir f:ops) = do-  io $ printingException ("Remove directory " <> f) (removeDirectoryRecursive f)-  -- document suggests removeDirectoryRecursive will follow-  -- symlinks in f, but it seems not the case, at least on OS X.-  when counting postproc-  procDiredOp counting ops-    where postproc = do-            incDiredOpSucCnt-            withCurrentBuffer $ diredUnmarkPath (takeFileName f)-procDiredOp _counting (DORemoveBuffer _:_) = undefined -- TODO-procDiredOp counting  (DOCopyFile o n:ops) = do-  io $ printingException ("Copy file " <> o) (copyFile o n)-  when counting postproc-  procDiredOp counting ops-    where postproc = do-            incDiredOpSucCnt-            withCurrentBuffer $ diredUnmarkPath (takeFileName o)-            -- TODO: mark copied files with "C" if the target dir's-            -- dired buffer exists-procDiredOp counting (DOCopyDir o n:ops) = do-  contents <- io $ printingException-              (concat ["Copy directory ", o, " to ", n]) doCopy-  subops <- io $ mapM builder $ filter (`notElem` [".", ".."]) contents-  procDiredOp False subops-  when counting postproc-  procDiredOp counting ops-    where postproc = do-            incDiredOpSucCnt-            withCurrentBuffer $ diredUnmarkPath (takeFileName o)-          -- perform dir copy: create new dir and create other copy ops-          doCopy :: IO [FilePath]-          doCopy = do-            exists <- doesDirectoryExist n-            when exists $ removeDirectoryRecursive n-            createDirectoryIfMissing True n-            getDirectoryContents o-          -- build actual copy operations-          builder :: FilePath -> IO DiredOp-          builder name = do-            let npath = n </> name-            let opath = o </> name-            isDir <- doesDirectoryExist opath-            return $ DOCkOverwrite npath $ getOp isDir opath npath-                where getOp isDir = if isDir then DOCopyDir else DOCopyFile---procDiredOp counting (DORename o n:ops) = do-  io $ printingException (concat ["Rename ", o, " to ", n]) (rename o n)-  when counting postproc-  procDiredOp counting ops-    where postproc = do-            incDiredOpSucCnt-            withCurrentBuffer $ diredUnmarkPath (takeFileName o)-procDiredOp counting r@(DOConfirm prompt eops enops:ops) =-  withMinibuffer (R.toText $ prompt <> " (yes/no)") noHint (act . T.unpack)-  where act s = case map toLower s of-                  "yes" -> procDiredOp counting (eops <> ops)-                  "no"  -> procDiredOp counting (enops <> ops)-                  _     -> procDiredOp counting r-                             -- TODO: show an error msg-procDiredOp counting (DOCheck check eops enops:ops) = do-  res <- io check-  procDiredOp counting (if res then eops <> ops else enops <> ops)-procDiredOp counting (DOCkOverwrite fp op:ops) = do-  exists <- io $ fileExist fp-  procDiredOp counting (if exists then newOp:ops else op:ops)-      where newOp = DOChoice ("Overwrite " <> R.fromString fp <> " ?") op-procDiredOp counting (DOInput prompt opGen:ops) =-  promptFile (R.toText prompt) (act . T.unpack)-    where act s = procDiredOp counting $ opGen s <> ops-procDiredOp counting (DONoOp:ops) = procDiredOp counting ops-procDiredOp counting (DOFeedback f:ops) =-  getDiredOpState >>= f >> procDiredOp counting ops-procDiredOp counting r@(DOChoice prompt op:ops) = do-  st <- getDiredOpState-  if st ^. diredOpForAll-    then proceedYes-    else withEditor_ $ spawnMinibufferE msg (const askKeymap)-    where msg = R.toText $ prompt <> " (y/n/!/q/h)"-          askKeymap = choice [ char 'n' ?>>! noAction-                             , char 'y' ?>>! yesAction-                             , char '!' ?>>! allAction-                             , char 'q' ?>>! quit-                             , char 'h' ?>>! help-                             ]-          noAction = cleanUp >> proceedNo-          yesAction = cleanUp >> proceedYes-          allAction = do cleanUp-                         modDiredOpState (diredOpForAll .~ True)-                         proceedYes-          quit = cleanUp >> printMsg "Quit"-          help = do-            printMsg $-              "y: yes, n: no, !: yes on all remaining items, q: quit, h: help"-            cleanUp-            procDiredOp counting r -- repeat-          -- use cleanUp to get back the original buffer-          cleanUp = withEditor closeBufferAndWindowE-          proceedYes = procDiredOp counting (op:ops)-          proceedNo = procDiredOp counting ops-procDiredOp _ _ = return ()----- | Delete a list of file in the given directory------ 1. Ask for confirmation, if yes, perform deletions, otherwise--- showNothing------ 2. Confirmation is required for recursive deletion of non-empty--- directry, but only the top level one------ 3. Show the number of successful deletions at the end of the excution------ 4. TODO: ask confirmation for wether to remove the associated--- buffers when a file is removed-askDelFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()-askDelFiles dir fs =-  case fs of-    (_x:_) -> do-            resetDiredOpState-            -- TODO: show the file name list in new tmp window-            opList <- io $ sequence ops-            -- a deletion command is mapped to a list of deletions-            -- wrapped up by DOConfirm-            -- TODO: is `counting' necessary here?-            let ops' = opList <> [DOFeedback showResult]-            procDiredOp True [DOConfirm prompt ops' [DOFeedback showNothing]]-    -- no files listed-    []     -> procDiredOp True [DOFeedback showNothing]-    where-      prompt = R.concat [ "Delete "-                        , R.fromString . show $ length fs-                        , " file(s)?"-                        ]-      ops = map opGenerator fs-      showResult st = do-        diredRefresh-        printMsg $ showT (st ^. diredOpSucCnt) <> " of "-                    <> showT total <> " deletions done"-      showNothing _ = printMsg "(No deletions requested)"-      total = length fs-      opGenerator :: (FilePath, DiredEntry) -> IO DiredOp-      opGenerator (fn, de) = do-                   exists <- fileExist path-                   if exists then case de of-                     (DiredDir _dfi) -> do-                       isNull <- liftM nullDir $ getDirectoryContents path-                       return $ if isNull then DOConfirm recDelPrompt-                                               [DORemoveDir path] [DONoOp]-                                else DORemoveDir path-                     _               -> return (DORemoveFile path)-                     else return DONoOp-          where path = dir </> fn-                recDelPrompt = "Recursive delete of " <> R.fromString fn <> "?"-                -- Test the emptyness of a folder-                nullDir :: [FilePath] -> Bool-                nullDir = Data.List.any (not . flip Data.List.elem [".", ".."])--diredDoDel :: YiM ()-diredDoDel = do-  dir <- currentDir-  maybefile <- withCurrentBuffer fileFromPoint-  case maybefile of-    Just (fn, de) -> askDelFiles dir [(fn, de)]-    Nothing       -> noFileAtThisLine--diredDoMarkedDel :: YiM ()-diredDoMarkedDel = do-  dir <- currentDir-  fs <- markedFiles (`Data.List.elem` "D")-  askDelFiles dir fs--diredKeymap :: Keymap -> Keymap-diredKeymap = important $ withArg mainMap-  where-    -- produces a copy of the map allowing for C-u-    withArg :: (Maybe Int -> Keymap) -> Keymap-    withArg k = choice [ ctrlCh 'u' ?>> k (Just 1) , k Nothing ]--    mainMap :: Maybe Int -> Keymap-    mainMap univArg = choice-      [ char 'p'                   ?>>! filenameColOf lineUp-      , oneOf [char 'n', char ' ']  >>! filenameColOf lineDown-      , char 'd'                   ?>>! diredMarkDel-      , char 'g'                   ?>>! diredRefresh-      , char 'm'                   ?>>! diredMark-      , char '^'                   ?>>! diredUpDir-      , char '+'                   ?>>! diredCreateDir-      , char 'q'                   ?>>!-          ((deleteBuffer =<< gets currentBuffer) :: EditorM ())-      , char 'x'                   ?>>! diredDoMarkedDel-      , oneOf [ctrl $ char 'm', spec KEnter, char 'f', char 'e'] >>! diredLoad-        -- Currently ‘o’ misbehaves, seems this naive method loses-        -- track of buffers.-      , char 'o'                   ?>>! withOtherWindow diredLoad-      , char 'u'                   ?>>! diredUnmark Forward-      , spec KBS                   ?>>! diredUnmark Backward-      , char 'D'                   ?>>! diredDoDel-      , char 'U'                   ?>>! diredUnmarkAll-      , char 'R'                   ?>>! diredRename-      , char 'C'                   ?>>! diredCopy-      , char '*'                   ?>>  multiMarks univArg-      ]--    multiMarks :: Maybe Int -> Keymap-    multiMarks univArg = choice-      [ char '!' ?>>! diredUnmarkAll-      , char '@' ?>>! diredMarkSymlinks univArg-      , char '/' ?>>! diredMarkDirectories univArg-      , char 't' ?>>! diredToggleAllMarks-      ]--dired :: YiM ()-dired = do-    printMsg "Dired..."-    maybepath <- withCurrentBuffer $ gets file-    dir <- io $ getFolder maybepath-    void $ editFile dir--diredDir :: FilePath -> YiM ()-diredDir dir = void (diredDirBuffer dir)--diredDirBuffer :: FilePath -> YiM BufferRef-diredDirBuffer d = do-    -- Emacs doesn't follow symlinks, probably Yi shouldn't do too-    dir <- io $ canonicalizePath d-    b <- stringToNewBuffer (FileBuffer dir) mempty-    withEditor $ switchToBufferE b-    withCurrentBuffer $ do-      state <- getBufferDyn-      putBufferDyn (state & diredPathA .~ dir)-      directoryContentA .= True-    diredRefresh-    return b---- | Write the contents of the supplied directory into the current--- buffer in dired format-diredRefresh :: YiM ()-diredRefresh = do-    dState <- withCurrentBuffer getBufferDyn-    let dir = diredPath dState-    -- Scan directory-    di <- io $ diredScanDir dir-    currFile <- if null (diredFilePoints dState)-                then return ""-                else do maybefile <- withCurrentBuffer fileFromPoint-                        case maybefile of-                          Just (fp, _) -> return fp-                          Nothing      -> return ""-    let ds = diredEntriesA .~ di $ diredCurrFileA .~ currFile $ dState-    -- Compute results-    let dlines = linesToDisplay ds-        (strss, stys, strs) = unzip3 dlines-        strss' = transpose $ map doPadding $ transpose strss-        namecol = if null strss' then 0 else-                  let l1details = init $ head strss'-                  in Data.List.sum (map R.length l1details) + length l1details--    -- Set buffer contents-    withCurrentBuffer $ do -- Clear buffer-      assign readOnlyA False-      ---- modifications begin here-      deleteRegionB =<< regionOfB Document-      -- Write Header-      insertN $ R.fromString dir <> ":\n"-      p <- pointB-      -- paint header-      addOverlayB $ mkOverlay UserLayer (mkRegion 0 (p-2)) headStyle-      ptsList <- mapM insertDiredLine $ zip3 strss' stys strs-      putBufferDyn $ diredFilePointsA .~ ptsList $ diredNameColA .~ namecol $ ds--      -- Colours for Dired come from overlays not syntax highlighting-      modifyMode $ modeKeymapA .~  topKeymapA %~ diredKeymap-                   >>> modeNameA .~ "dired"-      diredRefreshMark-      ---- no modifications after this line-      assign readOnlyA True-      when (null currFile) $ moveTo (p-2)-      case getRow currFile ptsList of-        Just rpos -> filenameColOf $ moveTo rpos-        Nothing   -> filenameColOf lineDown-    where-    getRow fp recList = lookup fp (map (\(a,_b,c)->(c,a)) recList)-    headStyle = const (withFg grey)-    doPadding :: [DRStrings] -> [R.YiString]-    doPadding drs = map (pad ((maximum . map drlength) drs)) drs--    pad _n (DRPerms s)  = s-    pad n  (DRLinks s)  = R.replicate (max 0 (n - R.length s)) " " <> s-    pad n  (DROwners s) = s <> R.replicate (max 0 (n - R.length s)) " " <> " "-    pad n  (DRGroups s) = s <> R.replicate (max 0 (n - R.length s)) " "-    pad n  (DRSizes s)  = R.replicate (max 0 (n - R.length s)) " " <> s-    pad n  (DRDates s)  = R.replicate (max 0 (n - R.length s)) " " <> s-    pad _n (DRFiles s)  = s       -- Don't right-justify the filename--    drlength = R.length . undrs---- | Returns a tuple containing the textual region (the end of) which--- is used for 'click' detection and the FilePath of the file--- represented by that textual region-insertDiredLine :: ([R.YiString], StyleName, R.YiString)-                -> BufferM (Point, Point, FilePath)-insertDiredLine (fields, sty, filenm) = bypassReadOnly $ do-  insertN . R.unwords $ init fields-  p1 <- pointB-  insertN  $ ' ' `R.cons` last fields-  p2 <- pointB-  newlineB-  addOverlayB (mkOverlay UserLayer (mkRegion p1 p2) sty)-  return (p1, p2, R.toString filenm)--data DRStrings = DRPerms {undrs :: R.YiString}-               | DRLinks {undrs :: R.YiString}-               | DROwners {undrs :: R.YiString}-               | DRGroups {undrs :: R.YiString}-               | DRSizes {undrs :: R.YiString}-               | DRDates {undrs :: R.YiString}-               | DRFiles {undrs :: R.YiString}---- | Return a List of (prefix,--- fullDisplayNameIncludingSourceAndDestOfLink, style, filename)-linesToDisplay :: DiredState -> [([DRStrings], StyleName, R.YiString)]-linesToDisplay dState = map (uncurry lineToDisplay) (M.assocs entries)-  where-    entries = diredEntries dState--    lineToDisplay k (DiredFile v)      =-      (l " -" v <> [DRFiles k], defaultStyle, k)-    lineToDisplay k (DiredDir v)       =-      (l " d" v <> [DRFiles k], const (withFg blue), k)-    lineToDisplay k (DiredSymLink v s) =-      (l " l" v <> [DRFiles $ k <> " -> " <> s], const (withFg cyan), k)-    lineToDisplay k (DiredSocket v) =-      (l " s" v <> [DRFiles k], const (withFg magenta), k)-    lineToDisplay k (DiredCharacterDevice v) =-      (l " c" v <> [DRFiles k], const (withFg yellow), k)-    lineToDisplay k (DiredBlockDevice v) =-      (l " b" v <> [DRFiles k], const (withFg yellow), k)-    lineToDisplay k (DiredNamedPipe v) =-      (l " p" v <> [DRFiles k], const (withFg brown), k)-    lineToDisplay k DiredNoInfo        =-      ([DRFiles $ k <> " : Not a file/dir/symlink"], defaultStyle, k)--    l pre v = [DRPerms $ pre <> permString v,-               DRLinks . R.fromString $ printf "%4d" (numLinks v),-               DROwners $ owner v,-               DRGroups $ grp v,-               DRSizes . R.fromString $ printf "%8d" (sizeInBytes v),-               DRDates $ modificationTimeString v]---- | Return dired entries for the contents of the supplied directory-diredScanDir :: FilePath -> IO DiredEntries-diredScanDir dir = do-    files <- getDirectoryContents dir-    foldM (lineForFile dir) M.empty files-    where-    lineForFile :: FilePath-                -> DiredEntries-                -> FilePath-                -> IO DiredEntries-    lineForFile d m f = do-      let fp = d </> f-      fileStatus <- getSymbolicLinkStatus fp-      dfi <- lineForFilePath fp fileStatus-      let islink = isSymbolicLink fileStatus-      linkTarget <- if islink then readSymbolicLink fp else return mempty-      let de-            | isDirectory fileStatus = DiredDir dfi-            | isRegularFile fileStatus = DiredFile dfi-            | islink = DiredSymLink dfi (R.fromString linkTarget)-            | isSocket fileStatus = DiredSocket dfi-            | isCharacterDevice fileStatus = DiredCharacterDevice dfi-            | isBlockDevice fileStatus = DiredBlockDevice dfi-            | isNamedPipe fileStatus = DiredNamedPipe dfi-            | otherwise = DiredNoInfo-      return $ M.insert (R.fromString f) de m--    lineForFilePath :: FilePath -> FileStatus -> IO DiredFileInfo-    lineForFilePath fp fileStatus = do-      let modTimeStr = R.fromString . shortCalendarTimeToString-                       . posixSecondsToUTCTime . realToFrac-                       $ modificationTime fileStatus-      let uid = fileOwner fileStatus-          gid = fileGroup fileStatus-          fn = takeFileName fp-      _filenm <- if isSymbolicLink fileStatus-                 then return . ((fn <> " -> ") <>) =<< readSymbolicLink fp-                 else return fn-      ownerEntry <- orException (getUserEntryForID uid)-                    (liftM (scanForUid uid) getAllUserEntries)-      groupEntry <- orException (getGroupEntryForID gid)-                    (liftM (scanForGid gid) getAllGroupEntries)-      let fmodeStr = (modeString . fileMode) fileStatus-          sz = toInteger $ fileSize fileStatus-          ownerStr   = R.fromString $ userName ownerEntry-          groupStr   = R.fromString $ groupName groupEntry-          numOfLinks = toInteger $ linkCount fileStatus-      return DiredFileInfo { permString = fmodeStr-                           , numLinks = numOfLinks-                           , owner = ownerStr-                           , grp = groupStr-                           , sizeInBytes = sz-                           , modificationTimeString = modTimeStr}----- | Needed on Mac OS X 10.4-scanForUid :: UserID -> [UserEntry] -> UserEntry-scanForUid uid entries = case find ((== uid) . userID) entries of-  Nothing -> UserEntry "?" mempty uid 0 mempty mempty mempty-  Just x -> x---- | Needed on Mac OS X 10.4-scanForGid :: GroupID -> [GroupEntry] -> GroupEntry-scanForGid gid entries = case find ((== gid) . groupID) entries of-  Nothing -> GroupEntry "?" mempty gid mempty-  Just x -> x--modeString :: FileMode -> R.YiString-modeString fm = ""-                <> strIfSet "r" ownerReadMode-                <> strIfSet "w" ownerWriteMode-                <> strIfSet "x" ownerExecuteMode-                <> strIfSet "r" groupReadMode-                <> strIfSet "w" groupWriteMode-                <> strIfSet "x" groupExecuteMode-                <> strIfSet "r" otherReadMode-                <> strIfSet "w" otherWriteMode-                <> strIfSet "x" otherExecuteMode-    where-    strIfSet s mode = if fm == (fm `unionFileModes` mode) then s else "-"--shortCalendarTimeToString :: UTCTime -> String-shortCalendarTimeToString = formatTime defaultTimeLocale "%b %d %H:%M"---- Default Filter: omit files ending in '~' or '#' and also '.' and '..'.--- TODO: customizable filters?---diredOmitFile :: String -> Bool---diredOmitFile = undefined--diredMark :: BufferM ()-diredMark = diredMarkWithChar '*' lineDown--diredMarkDel :: BufferM ()-diredMarkDel = diredMarkWithChar 'D' lineDown---- | Generic mark toggler.-diredMarkKind :: Maybe Int-                 -- ^ universal argument, usually indicating whether-                 -- to mark or unmark. Here ‘Just …’ is taken as-                 -- unmark.-              -> (DiredFilePath -> DiredEntry -> Bool)-                 -- ^ Picks which entries to consider-              -> Char-                 -- ^ Character used for marking. Pass garbage if-                 -- unmarking.-              -> BufferM ()-diredMarkKind m p c = bypassReadOnly $ do-  dState <- getBufferDyn-  let es = M.assocs $ diredEntries dState-      ms = M.fromList [ (R.toString fp, c) | (fp, e) <- es, p fp e ]-  putBufferDyn (dState & diredMarksA %~ run ms)-  diredRefreshMark-  where-    run :: M.Map FilePath Char -> M.Map FilePath Char -> M.Map FilePath Char-    run ms cms = case m of-      Nothing -> M.union ms cms-      Just _ -> deleteKeys cms (M.keys ms)--diredMarkSymlinks :: Maybe Int -> BufferM ()-diredMarkSymlinks m = diredMarkKind m p '*'-  where-    p _ DiredSymLink {} = True-    p _ _ = False--diredMarkDirectories :: Maybe Int -> BufferM ()-diredMarkDirectories m = diredMarkKind m p '*'-  where-    p "." DiredDir {} = False-    p ".." DiredDir {} = False-    p _ DiredDir {} = True-    p _ _ = False--diredToggleAllMarks :: BufferM ()-diredToggleAllMarks = bypassReadOnly $ do-  dState <- getBufferDyn-  let es = diredEntries dState-  putBufferDyn (dState & diredMarksA %~ tm es)-  diredRefreshMark-  where-    -- Get all entries, filter out the ones that are marked already,-    -- then mark everything that remains, in effect toggling the-    -- marks.-    tm :: DiredEntries -> M.Map FilePath Char -> M.Map FilePath Char-    tm de ms = let unmarked = deleteKeys (M.mapKeys R.toString de) (M.keys ms)-               in M.map (const '*') unmarked---- | Delete all the keys from the map.-deleteKeys :: Ord k => M.Map k v -> [k] -> M.Map k v-deleteKeys = foldl' (flip M.delete)--diredMarkWithChar :: Char -> BufferM () -> BufferM ()-diredMarkWithChar c mv = bypassReadOnly $ do-  fileFromPoint >>= \case-    Just (fn, _de) -> do-      state <- getBufferDyn-      putBufferDyn (state & diredMarksA %~ M.insert fn c)-      filenameColOf mv-      diredRefreshMark-    Nothing -> filenameColOf mv--diredRefreshMark :: BufferM ()-diredRefreshMark = do-  b <- pointB-  dState <- getBufferDyn-  let posDict = diredFilePoints dState-      markMap = diredMarks dState-      draw (pos, _, fn) = case M.lookup fn markMap of-        Just mark -> do-          moveTo pos >> moveToSol >> insertB mark >> deleteN 1-          e <- pointB-          addOverlayB $-            mkOverlay UserLayer (mkRegion (e - 1) e) (styleOfMark mark)-        Nothing ->-          -- for deleted marks-          moveTo pos >> moveToSol >> insertN " " >> deleteN 1-  mapM_ draw posDict-  moveTo b-    where-      styleOfMark '*' = const (withFg green)-      styleOfMark 'D' = const (withFg red)-      styleOfMark  _  = defaultStyle---- | Removes mark from current file (if any) and moves in the--- specified direction.-diredUnmark :: Direction -- ^ Direction to move in after unmarking-            -> BufferM ()-diredUnmark d = bypassReadOnly $ do-  let lineDir = case d of { Forward -> lineDown; Backward -> lineUp; }-  fileFromPoint >>= \case-    Just (fn, _de) -> do-      diredUnmarkPath fn-      filenameColOf lineDir-      diredRefreshMark-    Nothing        -> filenameColOf lineDir---diredUnmarkPath :: FilePath -> BufferM()-diredUnmarkPath fn = getBufferDyn >>= putBufferDyn.(diredMarksA %~ M.delete fn)--diredUnmarkAll :: BufferM ()-diredUnmarkAll = bypassReadOnly $ do-                   getBufferDyn >>= putBufferDyn.(diredMarksA .~ M.empty)-                   filenameColOf $ return ()-                   diredRefreshMark--currentDir :: YiM FilePath-currentDir = fmap diredPath $ withCurrentBuffer $ getBufferDyn---- | move selected files in a given directory to the target location given--- by user input------ if multiple source--- then if target is not a existing dir---      then error---      else move source files into target dir--- else if target is dir---      then if target exist---           then move source file into target dir---           else if source is dir and parent of target exists---                then move source to target---                else error---      else if parent of target exist---           then move source to target---           else error-askRenameFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()-askRenameFiles dir fs = case fs of-  (_x:[]) -> do resetDiredOpState-                procDiredOp True [DOInput prompt sOpIsDir]-  (_x:_)  -> do resetDiredOpState-                procDiredOp True [DOInput prompt mOpIsDirAndExists]-  []      -> procDiredOp True [DOFeedback showNothing]-  where-    mkErr t = return . DOFeedback . const $ errorEditor t-    prompt = "Move " <> R.fromString (show total) <> " item(s) to:"-    mOpIsDirAndExists t = [DOCheck (doesDirectoryExist t) posOps negOps]-      where-        posOps = map builder fs <> [DOFeedback showResult]-        negOps = mkErr $ T.pack t <> " is not directory!"-        builder (fn, _de) = let old = dir </> fn-                                new = t </> fn-                            in DOCkOverwrite new (DORename old new)-    sOpIsDir t = [DOCheck (doesDirectoryExist t) posOps sOpDirRename]-        where (fn, _) = head fs -- the only item-              posOps = [DOCkOverwrite new (DORename old new),-                        DOFeedback showResult]-                  where new = t </> fn-                        old = dir </> fn-              sOpDirRename = [DOCheck ckParentDir posOps' negOps,-                              DOFeedback showResult]-                  where posOps' = [DOCkOverwrite new (DORename old new)]-                        p = "Cannot move " <> T.pack old-                            <> " to " <> T.pack new-                        negOps = mkErr p-                        new = t-                        old = dir </> fn-                        ps = dropTrailingPathSeparator t-                        ckParentDir = doesDirectoryExist $ takeDirectory ps-    showResult st = do-      diredRefresh-      printMsg $ showT (st ^. diredOpSucCnt) <> " of "-                  <> showT total <> " item(s) moved."-    showNothing _ = (withEditor . printMsg) "Quit"-    total = length fs---- | copy selected files in a given directory to the target location given--- by user input------ askCopyFiles follow the same logic as askRenameFiles,--- except dir and file are done by different DiredOP-askCopyFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM ()-askCopyFiles dir fs =-  case fs of-    (_x:[]) -> do resetDiredOpState-                  procDiredOp True [DOInput prompt sOpIsDir]-    (_x:_)  -> do resetDiredOpState-                  procDiredOp True [DOInput prompt mOpIsDirAndExists]-    []      -> procDiredOp True [DOFeedback showNothing]-  where-    prompt = "Copy " <> R.fromString (show total) <> " item(s) to:"-    mOpIsDirAndExists t = [DOCheck (doesDirectoryExist t) posOps negOps]-      where-        posOps = map builder fs <> [DOFeedback showResult]-        negOps = [DOFeedback . const $-                  errorEditor (T.pack t <> " is not directory!")]-        builder (fn, de) = let old = dir </> fn-                               new = t </> fn-                           in DOCkOverwrite new (op4Type de old new)-    sOpIsDir t = [DOCheck (doesDirectoryExist t) posOps sOpDirCopy]-      where (fn, de) = head fs -- the only item-            posOps = [DOCkOverwrite new (op4Type de old new),-                      DOFeedback showResult]-                where new = t </> fn-                      old = dir </> fn-            sOpDirCopy = [DOCheck ckParentDir posOps' negOps,-                          DOFeedback showResult]-                where posOps' = [DOCkOverwrite new (op4Type de old new)]-                      p = "Cannot copy " <> T.pack old <> " to " <> T.pack new-                      negOps =-                          [DOFeedback . const $ errorEditor p]-                      new = t-                      old = dir </> fn-                      ckParentDir = doesDirectoryExist $-                                    takeDirectory (dropTrailingPathSeparator t)-    showResult st = do-      diredRefresh-      printMsg $ showT (st ^. diredOpSucCnt) <> " of "-                  <> showT total <> " item(s) copied."-    showNothing _ = printMsg "Quit"-    total = length fs-    op4Type :: DiredEntry -> FilePath -> FilePath -> DiredOp-    op4Type (DiredDir _) = DOCopyDir-    op4Type _            = DOCopyFile--diredRename :: YiM ()-diredRename = do-  dir <- currentDir-  fs <- markedFiles (`Data.List.elem` "*")-  if null fs then do maybefile <- withCurrentBuffer fileFromPoint-                     case maybefile of-                       Just (fn, de) -> askRenameFiles dir [(fn, de)]-                       Nothing       -> noFileAtThisLine-             else askRenameFiles dir fs--diredCopy :: YiM ()-diredCopy = do-  dir <- currentDir-  fs <- markedFiles (`Data.List.elem` "*")-  if null fs then do maybefile <- withCurrentBuffer fileFromPoint-                     case maybefile of-                       Just (fn, de) -> askCopyFiles dir [(fn, de)]-                       Nothing       -> noFileAtThisLine-             else askCopyFiles dir fs--diredLoad :: YiM ()-diredLoad = do-  dir <- currentDir-  withCurrentBuffer fileFromPoint >>= \case-    Just (fn, de) -> do-      let sel = dir </> fn-          sel' = T.pack sel-      case de of-        (DiredFile _dfi) -> do-          exists <- io $ doesFileExist sel-          if exists-            then void $ editFile sel-            else printMsg $ sel' <> " no longer exists"-        (DiredDir _dfi)  -> do-          exists <- io $ doesDirectoryExist sel-          if exists-            then diredDir sel-            else printMsg $ sel' <> " no longer exists"-        (DiredSymLink _dfi dest') -> do-          let dest = R.toString dest'-              target = if isAbsolute dest then dest else dir </> dest-          existsFile <- io $ doesFileExist target-          existsDir <- io $ doesDirectoryExist target-          printMsg $ "Following link:" <> T.pack target-          if existsFile then void $ editFile target else-            if existsDir then diredDir target else-              printMsg $ T.pack target <> " does not exist"-        (DiredSocket _dfi) -> do-          exists <- io $ doesFileExist sel-          printMsg (if exists-                    then "Can't open Socket " <> sel'-                    else sel' <> " no longer exists")-        (DiredBlockDevice _dfi) -> do-          exists <- io $ doesFileExist sel-          printMsg (if exists-                    then "Can't open Block Device " <> sel'-                    else sel' <> " no longer exists")-        (DiredCharacterDevice _dfi) -> do-          exists <- io $ doesFileExist sel-          printMsg (if exists-                    then "Can't open Character Device " <> sel'-                    else sel' <> " no longer exists")-        (DiredNamedPipe _dfi) -> do-          exists <- io $ doesFileExist sel-          printMsg (if exists-                    then "Can't open Pipe " <> sel'-                    else sel' <> " no longer exists")-        DiredNoInfo -> printMsg $ "No File Info for:" <> sel'-    Nothing        -> noFileAtThisLine---noFileAtThisLine :: YiM ()-noFileAtThisLine = printMsg "(No file at this line)"---- | Extract the filename at point. NB this may fail if the buffer has--- been edited. Maybe use Markers instead.-fileFromPoint :: BufferM (Maybe (FilePath, DiredEntry))-fileFromPoint = do-    p <- pointB-    dState <- getBufferDyn-    let candidates = filter (\(_,p2,_)->p <= p2) (diredFilePoints dState)-        finddef f = M.findWithDefault DiredNoInfo (R.fromString f)-    return $ case candidates of-      ((_, _, f):_) -> Just (f, finddef f $ diredEntries dState)-      _             -> Nothing--markedFiles :: (Char -> Bool) -> YiM [(FilePath, DiredEntry)]-markedFiles cond = do-  dState <- withCurrentBuffer getBufferDyn-  let fs = fst . unzip $ filter (cond . snd) (M.assocs $ diredMarks dState)-  return $ map (\f -> (f, diredEntries dState M.! R.fromString f)) fs--diredUpDir :: YiM ()-diredUpDir = do-    dir <- currentDir-    diredDir $ takeDirectory dir--diredCreateDir :: YiM ()-diredCreateDir =-  withMinibufferFree "Create Dir:" $ \nm -> do-    dir <- currentDir-    let newdir = dir </> T.unpack nm-    printMsg $ "Creating " <> T.pack newdir <> "..."-    io $ createDirectoryIfMissing True newdir-    diredRefresh----- | Elementary operations for dired file operations--- Map a dired mark operation (e.g. delete, rename, copy) command--- into a list of DiredOps, and use procDiredOp to excute them.--- Logic and implementation of each operation are packaged in procDiredOp--- See askDelFiles for example.--- If new elem op is added, just add corresponding procDiredOp to handle it.-data DiredOp = DORemoveFile FilePath-             | DORemoveDir FilePath-             | DOCopyFile FilePath FilePath-             | DOCopyDir FilePath FilePath-             | DORename FilePath FilePath-             | DORemoveBuffer FilePath-             -- ^ remove the buffers that associate with the file-             | DOConfirm R.YiString [DiredOp] [DiredOp]-             -- ^ prompt a "yes/no" question. If yes, execute the-             -- first list of embedded DiredOps otherwise execute the-             -- second list of embedded DiredOps-             | DOCheck (IO Bool) [DiredOp] [DiredOp]-             -- ^ similar to DOConfirm, but no user interaction. Could-             -- be used to check file existence-             | DOCkOverwrite FilePath DiredOp-             -- ^ this is a shortcut, it invokes DCChoice if file exists-             | DOInput R.YiString (String -> [DiredOp])-             -- ^ prompt a string and collect user input.-             -- the embedded list of DiredOps is generated based on input,-             -- Remember that the input should be checked with DOCheck-             | DOChoice R.YiString DiredOp-             -- ^ prompt a string, provide keybindings for 'y', 'n',-             -- '!', 'q' and optional 'h' (help) this is useful when-             -- overwriting of existing files is required to complete-             -- the op choice '!' will bypass following DOChoice-             -- prompts.-             | DOFeedback (DiredOpState -> YiM ())-             -- ^ to feedback, given the state. such as show the result.-             | DONoOp-             -- ^ no operation
− src/library/Yi/Editor.hs 
@@ -1,827 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Editor--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ The top level editor state, and operations on it. This is inside an--- internal module for easy re-export with Yi.Types bits.--module Yi.Editor ( Editor(..), EditorM(..), MonadEditor(..)-                 , runEditor-                 , acceptedInputsOtherWindow-                 , addJumpAtE-                 , addJumpHereE-                 , alternateBufferE-                 , askConfigVariableA-                 , bufferSet-                 , buffersA-                 , closeBufferAndWindowE-                 , closeBufferE-                 , closeOtherE-                 , clrStatus-                 , commonNamePrefix-                 , currentBuffer-                 , currentRegexA-                 , currentWindowA-                 , deleteBuffer-                 , deleteTabE-                 , emptyEditor-                 , findBuffer-                 , findBufferWith-                 , findBufferWithName-                 , findWindowWith-                 , focusWindowE-                 , getBufferStack-                 , getBufferWithName-                 , getBufferWithNameOrCurrent-                 , getEditorDyn-                 , getRegE-                 , jumpBackE-                 , jumpForwardE-                 , killringA-                 , layoutManagerNextVariantE-                 , layoutManagerPreviousVariantE-                 , layoutManagersNextE-                 , layoutManagersPreviousE-                 , moveTabE-                 , moveWinNextE-                 , moveWinPrevE-                 , newBufferE-                 , newEmptyBufferE-                 , newTabE-                 , newTempBufferE-                 , newWindowE-                 , nextTabE-                 , nextWinE-                 , pendingEventsA-                 , prevWinE-                 , previousTabE-                 , printMsg-                 , printMsgs-                 , printStatus-                 , pushWinToFirstE-                 , putEditorDyn-                 , searchDirectionA-                 , setDividerPosE-                 , setRegE-                 , setStatus-                 , shiftOtherWindow-                 , splitE-                 , statusLine-                 , statusLineInfo-                 , statusLinesA-                 , stringToNewBuffer-                 , swapWinWithFirstE-                 , switchToBufferE-                 , switchToBufferWithNameE-                 , tabsA-                 , tryCloseE-                 , windows-                 , windowsA-                 , windowsOnBufferE-                 , withCurrentBuffer-                 , withEveryBuffer-                 , withGivenBuffer-                 , withGivenBufferAndWindow-                 , withOtherWindow-                 , withWindowE-                 ) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad-import           Control.Monad.Reader hiding (mapM, forM_ )-import           Control.Monad.State hiding (get, put, mapM, forM_)-import           Data.Binary-import           Data.Default-import qualified Data.DelayList as DelayList-import           Data.DynamicState.Serializable-import           Data.Foldable hiding (forM_)-import           Data.List (delete, (\\))-import           Data.List.NonEmpty (fromList, NonEmpty(..), nub)-import qualified Data.List.NonEmpty as NE-import qualified Data.List.PointedList as PL (atEnd, moveTo)-import qualified Data.List.PointedList.Circular as PL-import qualified Data.Map as M-import           Data.Maybe-import qualified Data.Monoid as Mon-import           Data.Semigroup-import qualified Data.Text as T-import           Prelude hiding (foldl,concatMap,foldr,all)-import           System.FilePath (splitPath)-import           Yi.Buffer-import           Yi.Config-import           Yi.Interact as I-import           Yi.JumpList-import           Yi.KillRing-import           Yi.Layout-import           Yi.Monad-import           Yi.Rope (YiString, fromText, empty)-import qualified Yi.Rope as R-import           Yi.String-import           Yi.Style (defaultStyle)-import           Yi.Tab-import           Yi.Types-import           Yi.Utils hiding ((+~))-import           Yi.Window--liftEditor :: MonadEditor m => EditorM a -> m a-liftEditor = withEditor--instance Binary Editor where-  put (Editor bss bs supply ts dv _sl msh kr _re _dir _ev _cwa ) =-    let putNE (x :| xs) = put x >> put xs-    in putNE bss >> put bs >> put supply >> put ts-       >> put dv >> put msh >> put kr-  get = do-    bss <- (:|) <$> get <*> get-    bs <- get-    supply <- get-    ts <- get-    dv <- get-    msh <- get-    kr <- get-    return $ emptyEditor { bufferStack = bss-                         , buffers = bs-                         , refSupply = supply-                         , tabs_ = ts-                         , dynamic = dv-                         , maxStatusHeight = msh-                         , killring = kr-                         }---- | The initial state-emptyEditor :: Editor-emptyEditor = Editor-  { buffers      = M.singleton (bkey buf) buf-  , tabs_        = PL.singleton tab-  , bufferStack  = bkey buf :| []-  , refSupply    = 3-  , currentRegex = Nothing-  , searchDirection = Forward-  , dynamic      = mempty-  , statusLines  = DelayList.insert (maxBound, ([""], defaultStyle)) []-  , killring     = krEmpty-  , pendingEvents = []-  , maxStatusHeight = 1-  , onCloseActions = M.empty-  }-  where buf = newB 0 (MemBuffer "console") mempty-        win = (dummyWindow (bkey buf)) { wkey = WindowRef 1 , isMini = False }-        tab = makeTab1 2 win----- -----------------------------------------------------------------------makeLensesWithSuffix "A" ''Editor--windows :: Editor -> PL.PointedList Window-windows e = e ^. windowsA--windowsA :: Lens' Editor (PL.PointedList Window)-windowsA = currentTabA . tabWindowsA--tabsA :: Lens' Editor (PL.PointedList Tab)-tabsA = fixCurrentBufferA_ . tabs_A--currentTabA :: Lens' Editor Tab-currentTabA = tabsA . PL.focus--askConfigVariableA :: (YiConfigVariable b, MonadEditor m) => m b-askConfigVariableA = do cfg <- askCfg-                        return $ cfg ^. configVariable---- ------------------------------------------------------------------------ Buffer operations--newRef :: MonadEditor m => m Int-newRef = withEditor (refSupplyA %= (+ 1) >> use refSupplyA)--newBufRef :: MonadEditor m => m BufferRef-newBufRef = liftM BufferRef newRef---- | Create and fill a new buffer, using contents of string.--- | Does not focus the window, or make it the current window.--- | Call newWindowE or switchToBufferE to take care of that.-stringToNewBuffer :: MonadEditor m-                  => BufferId -- ^ The buffer indentifier-                  -> YiString -- ^ The contents with which to populate-                              -- the buffer-                  -> m BufferRef-stringToNewBuffer nm cs = withEditor $ do-    u <- newBufRef-    defRegStyle <- configRegionStyle <$> askCfg-    insertBuffer $ newB u nm cs-    m <- asks configFundamentalMode-    withGivenBuffer u $ do-        putRegionStyle defRegStyle-        setAnyMode m-    return u--insertBuffer :: MonadEditor m => FBuffer -> m ()-insertBuffer b = withEditor . modify $ \e ->-    -- insert buffers at the end, so that-    -- "background" buffers do not interfere.-    e { bufferStack = nub (bufferStack e <> (bkey b :| []))-      , buffers = M.insert (bkey b) b (buffers e)}----- Prevent possible space leaks in the editor structure-forceFold1 :: Foldable t => t a -> t a-forceFold1 x = foldr seq x x--forceFoldTabs :: Foldable t => t Tab -> t Tab-forceFoldTabs x = foldr (seq . forceTab) x x---- | Delete a buffer (and release resources associated with it).-deleteBuffer :: MonadEditor m => BufferRef -> m ()-deleteBuffer k = withEditor $ do-  -- If the buffer has an associated close action execute that now.-  -- Unless the buffer is the last buffer in the editor. In which case-  -- it cannot be closed and, I think, the close action should not be-  -- applied.-  ---  -- The close actions seem dangerous, but I know of no other simple-  -- way to resolve issues related to what buffer receives actions-  -- after the minibuffer closes.-  gets bufferStack >>= \case-    _ :| [] -> return ()-    _ -> M.lookup k <$> gets onCloseActions-         >>= \m_action -> fromMaybe (return ()) m_action-  -- Now try deleting the buffer. Checking, once again, that it is not-  -- the last buffer.-  bs <- gets bufferStack-  ws <- use windowsA-  case bs of-    b0 :| nextB : _ -> do-      let pickOther w = if bufkey w == k then w {bufkey = other} else w-          visibleBuffers = bufkey <$> toList ws--          -- This ‘head’ always works because we witness that length of-          -- bs ≥ 2 (through case) and ‘delete’ only deletes up to 1-          -- element so we at worst we end up with something like-          -- ‘head $ [] ++ [foo]’ when bs ≡ visibleBuffers-          bs' = NE.toList bs-          other = head $ (bs' \\ visibleBuffers) ++ delete k bs'-      when (b0 == k) $-        -- we delete the currently selected buffer: the next buffer-        -- will become active in the main window, therefore it must be-        -- assigned a new window.-        switchToBufferE nextB--      -- NOTE: This *only* works if not all bufferStack buffers are-      -- equivalent to ‘k’. Assuring that there are no duplicates in-      -- the bufferStack is equivalent in this case because of its-      -- length.-      modify $ \e ->-        e & bufferStackA %~ fromList . forceFold1 . NE.filter (k /=)-          & buffersA %~ M.delete k-          & tabs_A %~ forceFoldTabs . fmap (mapWindows pickOther)-          -- all windows open on that buffer must switch to another-          -- buffer.--      windowsA . mapped . bufAccessListA %= forceFold1 . filter (k /=)-    _ -> return () -- Don't delete the last buffer.---- | Return the buffers we have, /in no particular order/-bufferSet :: Editor -> [FBuffer]-bufferSet = M.elems . buffers---- | Return a prefix that can be removed from all buffer paths while--- keeping them unique.-commonNamePrefix :: Editor -> [FilePath]-commonNamePrefix = commonPrefix . fmap (dropLast . splitPath)-                   . fbufs . fmap (^. identA) . bufferSet-  where dropLast [] = []-        dropLast x = init x-        fbufs xs = [ x | FileBuffer x <- xs ]-          -- drop the last component, so that it is never hidden.--getBufferStack :: MonadEditor m => m (NonEmpty FBuffer)-getBufferStack = withEditor $ do-  bufMap <- gets buffers-  gets $ fmap (bufMap M.!) . bufferStack--findBuffer :: MonadEditor m => BufferRef -> m (Maybe FBuffer)-findBuffer k = withEditor (gets (M.lookup k . buffers))---- | Find buffer with this key-findBufferWith :: BufferRef -> Editor -> FBuffer-findBufferWith k e = case M.lookup k (buffers e) of-  Just x -> x-  Nothing -> error "Editor.findBufferWith: no buffer has this key"---- | Find buffers with this name-findBufferWithName :: T.Text -> Editor -> [BufferRef]-findBufferWithName n e =-  let bufs = M.elems $ buffers e-      sameIdent b = shortIdentString (length $ commonNamePrefix e) b == n-  in map bkey $ filter sameIdent bufs---- | Find buffer with given name. Fail if not found.-getBufferWithName :: MonadEditor m => T.Text -> m BufferRef-getBufferWithName bufName = withEditor $ do-  bs <- gets $ findBufferWithName bufName-  case bs of-    [] -> fail ("Buffer not found: " ++ T.unpack bufName)-    b:_ -> return b---- | Make all buffers visible by splitting the current window list.--- FIXME: rename to displayAllBuffersE; make sure buffers are not open twice.-openAllBuffersE :: EditorM ()-openAllBuffersE = do-  bs <- gets bufferSet-  forM_ bs $ ((%=) windowsA . PL.insertRight =<<) . newWindowE False . bkey----------------------------------------------------------------------------- | Perform action with any given buffer, using the last window that--- was used for that buffer.-withGivenBuffer :: MonadEditor m => BufferRef -> BufferM a -> m a-withGivenBuffer k f = do-    b <- gets (findBufferWith k)--    withGivenBufferAndWindow (b ^. lastActiveWindowA) k f---- | Perform action with any given buffer-withGivenBufferAndWindow :: MonadEditor m-    => Window -> BufferRef -> BufferM a -> m a-withGivenBufferAndWindow w k f = withEditor $ do-  accum <- asks configKillringAccumulate-  let edit e = let b = findBufferWith k e-                   (v, us, b') = runBufferFull w b f-               in (e & buffersA .~ mapAdjust' (const b') k (buffers e)-                     & killringA %~-                        if accum && all updateIsDelete us-                        then foldl (.) id $ reverse [ krPut dir s-                                                    | Delete _ dir s <- us ]-                        else id--                  , (us, v))-  (us, v) <- getsAndModify edit--  updHandler <- return . bufferUpdateHandler =<< ask-  unless (null us || null updHandler) $-    forM_ updHandler (\h -> withGivenBufferAndWindow w k (h us))-  return v---- | Perform action with current window's buffer-withCurrentBuffer :: MonadEditor m => BufferM a -> m a-withCurrentBuffer f = withEditor $ do-  w <- use currentWindowA-  withGivenBufferAndWindow w (bufkey w) f--withEveryBuffer :: MonadEditor m => BufferM a -> m [a]-withEveryBuffer action =-    withEditor (gets bufferStack) >>= mapM (`withGivenBuffer` action) . NE.toList--currentWindowA :: Lens' Editor Window-currentWindowA = windowsA . PL.focus---- | Return the current buffer-currentBuffer :: Editor -> BufferRef-currentBuffer = NE.head . bufferStack---------------------------- Handling of status---- | Prints a message with 'defaultStyle'.-printMsg :: MonadEditor m => T.Text -> m ()-printMsg s = printStatus ([s], defaultStyle)---- | Prints a all given messages with 'defaultStyle'.-printMsgs :: MonadEditor m => [T.Text] -> m ()-printMsgs s = printStatus (s, defaultStyle)--printStatus :: MonadEditor m => Status -> m ()-printStatus = setTmpStatus 1---- | Set the "background" status line-setStatus :: MonadEditor m => Status -> m ()-setStatus = setTmpStatus maxBound---- | Clear the status line-clrStatus :: EditorM ()-clrStatus = setStatus ([""], defaultStyle)--statusLine :: Editor -> [T.Text]-statusLine = fst . statusLineInfo--statusLineInfo :: Editor -> Status-statusLineInfo = snd . head . statusLines--setTmpStatus :: MonadEditor m => Int -> Status -> m ()-setTmpStatus delay s = withEditor $ do-  statusLinesA %= DelayList.insert (delay, s)-  -- also show in the messages buffer, so we don't loose any message-  bs <- gets (filter ((== MemBuffer "messages") . view identA) . M.elems . buffers)--  b <- case bs of-         (b':_) -> return $ bkey b'-         [] -> stringToNewBuffer (MemBuffer "messages") mempty-  let m = '(' `R.cons` listify (R.fromText <$> fst s) Mon.<> ", <function>)"-  withGivenBuffer b $ botB >> insertN m---- ------------------------------------------------------------------------ kill-register (vim-style) interface to killring.------ Note that our vim keymap currently has its own registers--- and doesn't use killring.---- | Put string into yank register-setRegE :: R.YiString -> EditorM ()-setRegE s = killringA %= krSet s---- | Return the contents of the yank register-getRegE :: EditorM R.YiString-getRegE = uses killringA krGet---- ------------------------------------------------------------------------ | Dynamically-extensible state components.------ These hooks are used by keymaps to store values that result from--- Actions (i.e. that restult from IO), as opposed to the pure values--- they generate themselves, and can be stored internally.------ The `dynamic' field is a type-indexed map.------- | Retrieve a value from the extensible state-getEditorDyn :: (MonadEditor m, YiVariable a, Default a, Functor m) => m a-getEditorDyn = fromMaybe def <$> getDyn (use dynamicA) (assign dynamicA)---- | Insert a value into the extensible state, keyed by its type-putEditorDyn :: (MonadEditor m, YiVariable a, Functor m) => a -> m ()-putEditorDyn = putDyn (use dynamicA) (assign dynamicA)---- | Like fnewE, create a new buffer filled with the String @s@,--- Switch the current window to this buffer. Doesn't associate any--- file with the buffer (unlike fnewE) and so is good for popup--- internal buffers (like scratch)-newBufferE :: BufferId   -- ^ buffer name-           -> YiString -- ^ buffer contents-           -> EditorM BufferRef-newBufferE f s = do-    b <- stringToNewBuffer f s-    switchToBufferE b-    return b---- | Like 'newBufferE' but defaults to empty contents.-newEmptyBufferE :: BufferId -> EditorM BufferRef-newEmptyBufferE f = newBufferE f Yi.Rope.empty--alternateBufferE :: Int -> EditorM ()-alternateBufferE n = do-    Window { bufAccessList = lst } <- use currentWindowA-    if null lst || (length lst - 1) < n-      then fail "no alternate buffer"-      else switchToBufferE $ lst!!n---- | Create a new zero size window on a given buffer-newZeroSizeWindow :: Bool -> BufferRef -> WindowRef -> Window-newZeroSizeWindow mini bk ref = Window mini bk [] 0 emptyRegion ref 0 Nothing---- | Create a new window onto the given buffer.-newWindowE :: Bool -> BufferRef -> EditorM Window-newWindowE mini bk = newZeroSizeWindow mini bk . WindowRef <$> newRef---- | Attach the specified buffer to the current window-switchToBufferE :: BufferRef -> EditorM ()-switchToBufferE bk = windowsA . PL.focus %= \w ->-  w & bufkeyA .~ bk-    & bufAccessListA %~ forceFold1 . (bufkey w:) . filter (bk /=)---- | Attach the specified buffer to some other window than the current one-switchToBufferOtherWindowE :: BufferRef -> EditorM ()-switchToBufferOtherWindowE b = shiftOtherWindow >> switchToBufferE b---- | Switch to the buffer specified as parameter. If the buffer name--- is empty, switch to the next buffer.-switchToBufferWithNameE :: T.Text -> EditorM ()-switchToBufferWithNameE "" = alternateBufferE 0-switchToBufferWithNameE bufName = switchToBufferE =<< getBufferWithName bufName---- | Close a buffer.--- Note: close the current buffer if the empty string is given-closeBufferE :: T.Text -> EditorM ()-closeBufferE nm = deleteBuffer =<< getBufferWithNameOrCurrent nm--getBufferWithNameOrCurrent :: MonadEditor m => T.Text -> m BufferRef-getBufferWithNameOrCurrent t = withEditor $-    case T.null t of-        True -> gets currentBuffer-        False -> getBufferWithName t------------------------------------------------------------------------------- | Close current buffer and window, unless it's the last one.-closeBufferAndWindowE :: EditorM ()-closeBufferAndWindowE = do-  -- Fetch the current buffer *before* closing the window. Required-  -- for the onCloseBufferE actions to work as expected by the-  -- minibuffer. The tryCloseE, since it uses tabsA, will have the-  -- current buffer "fixed" to the buffer of the window that is-  -- brought into focus. If the current buffer is accessed after the-  -- tryCloseE then the current buffer may not be the same as the-  -- buffer before tryCloseE. This would be bad.-  b <- gets currentBuffer-  tryCloseE-  deleteBuffer b---- | Rotate focus to the next window-nextWinE :: EditorM ()-nextWinE = windowsA %= PL.next---- | Rotate focus to the previous window-prevWinE :: EditorM ()-prevWinE = windowsA %= PL.previous---- | Swaps the focused window with the first window. Useful for--- layouts such as 'HPairOneStack', for which the first window is the--- largest.-swapWinWithFirstE :: EditorM ()-swapWinWithFirstE = windowsA %= swapFocus (fromJust . PL.moveTo 0)---- | Moves the focused window to the first window, and moves all other--- windows down the stack.-pushWinToFirstE :: EditorM ()-pushWinToFirstE = windowsA %= pushToFirst-  where-      pushToFirst ws = case PL.delete ws of-          Nothing -> ws-          Just ws' -> PL.insertLeft (ws ^. PL.focus) (fromJust $ PL.moveTo 0 ws')---- | Swap focused window with the next one-moveWinNextE :: EditorM ()-moveWinNextE = windowsA %= swapFocus PL.next---- | Swap focused window with the previous one-moveWinPrevE :: EditorM ()-moveWinPrevE = windowsA %= swapFocus PL.previous---- | A "fake" accessor that fixes the current buffer after a change of--- the current window.------ Enforces invariant that top of buffer stack is the buffer of the--- current window.-fixCurrentBufferA_ :: Lens' Editor Editor-fixCurrentBufferA_ = lens id (\_old new -> let-  ws = windows new-  b = findBufferWith (bufkey $ PL._focus ws) new-  newBufferStack = nub (bkey b NE.<| bufferStack new)-  -- make sure we do not hold to old versions by seqing the length.-  in NE.length newBufferStack `seq` new & bufferStackA .~ newBufferStack)---- | Counterpart of fixCurrentBufferA_: fix the current window to point to the--- right buffer.-fixCurrentWindowE :: EditorM ()-fixCurrentWindowE =-  gets currentBuffer >>= \b -> windowsA . PL.focus . bufkeyA .= b--withWindowE :: Window -> BufferM a -> EditorM a-withWindowE w = withGivenBufferAndWindow w (bufkey w)--findWindowWith :: WindowRef -> Editor -> Window-findWindowWith k e =-    head $ concatMap (\win -> [win | wkey win == k]) $ windows e---- | Return the windows that are currently open on the buffer whose--- key is given-windowsOnBufferE :: BufferRef -> EditorM [Window]-windowsOnBufferE k = do-  ts <- use tabsA-  let tabBufEq = concatMap (\win -> [win | bufkey win == k]) . (^. tabWindowsA)-  return $ concatMap tabBufEq ts---- | bring the editor focus the window with the given key.------ Fails if no window with the given key is found.-focusWindowE :: WindowRef -> EditorM ()-focusWindowE k = do-    -- Find the tab index and window index-    ts <- use tabsA-    let check (False, i) win = if wkey win == k-                                    then (True, i)-                                    else (False, i + 1)-        check r@(True, _) _win = r--        searchWindowSet (False, tabIndex, _) ws =-            case foldl check (False, 0) (ws ^. tabWindowsA) of-                (True, winIndex) -> (True, tabIndex, winIndex)-                (False, _)       -> (False, tabIndex + 1, 0)-        searchWindowSet r@(True, _, _) _ws = r--    case foldl searchWindowSet  (False, 0, 0) ts of-        (False, _, _) -> fail $ "No window with key " ++ show wkey ++ "found. (focusWindowE)"-        (True, tabIndex, winIndex) -> do-            assign tabsA (fromJust $ PL.moveTo tabIndex ts)-            windowsA %= fromJust . PL.moveTo winIndex---- | Split the current window, opening a second window onto current buffer.--- TODO: unfold newWindowE here?-splitE :: EditorM ()-splitE = do-  w <- gets currentBuffer >>= newWindowE False-  windowsA %= PL.insertRight w---- | Cycle to the next layout manager, or the first one if the current--- one is nonstandard.-layoutManagersNextE :: EditorM ()-layoutManagersNextE = withLMStackE PL.next---- | Cycle to the previous layout manager, or the first one if the--- current one is nonstandard.-layoutManagersPreviousE :: EditorM ()-layoutManagersPreviousE = withLMStackE PL.previous---- | Helper function for 'layoutManagersNext' and 'layoutManagersPrevious'-withLMStackE :: (PL.PointedList AnyLayoutManager-                -> PL.PointedList AnyLayoutManager)-            -> EditorM ()-withLMStackE f = askCfg >>= \cfg ->-  currentTabA . tabLayoutManagerA %= go (layoutManagers cfg)-  where-   go [] lm = lm-   go lms lm =-     case findPL (layoutManagerSameType lm) lms of-       Nothing -> head lms-       Just lmsPL -> f lmsPL ^. PL.focus---- | Next variant of the current layout manager, as given by 'nextVariant'-layoutManagerNextVariantE :: EditorM ()-layoutManagerNextVariantE = currentTabA . tabLayoutManagerA %= nextVariant---- | Previous variant of the current layout manager, as given by--- 'previousVariant'-layoutManagerPreviousVariantE :: EditorM ()-layoutManagerPreviousVariantE =-  currentTabA . tabLayoutManagerA %= previousVariant---- | Sets the given divider position on the current tab-setDividerPosE :: DividerRef -> DividerPosition -> EditorM ()-setDividerPosE ref = assign (currentTabA . tabDividerPositionA ref)---- | Creates a new tab containing a window that views the current buffer.-newTabE :: EditorM ()-newTabE = do-    bk <- gets currentBuffer-    win <- newWindowE False bk-    ref <- newRef-    tabsA %= PL.insertRight (makeTab1 ref win)---- | Moves to the next tab in the round robin set of tabs-nextTabE :: EditorM ()-nextTabE = tabsA %= PL.next---- | Moves to the previous tab in the round robin set of tabs-previousTabE :: EditorM ()-previousTabE = tabsA %= PL.previous---- | Moves the focused tab to the given index, or to the end if the--- index is not specified.-moveTabE :: Maybe Int -> EditorM ()-moveTabE Nothing  = do-    count <- uses tabsA PL.length-    tabsA %= fromJust . PL.moveTo (pred count)-moveTabE (Just n) = do-    newTabs <- uses tabsA (PL.moveTo n)-    when (isNothing newTabs) failure-    assign tabsA $ fromJust newTabs-  where failure = fail $ "moveTab " ++ show n ++ ": no such tab"---- | Deletes the current tab. If there is only one tab open then error out.---   When the last tab is focused, move focus to the left, otherwise---   move focus to the right.-deleteTabE :: EditorM ()-deleteTabE = tabsA %= fromMaybe failure . deleteTab-  where failure = error "deleteTab: cannot delete sole tab"-        deleteTab tabs = if PL.atEnd tabs-                         then PL.deleteLeft tabs-                         else PL.deleteRight tabs---- | Close the current window. If there is only one tab open and the tab--- contains only one window then do nothing.-tryCloseE :: EditorM ()-tryCloseE = do-    ntabs <- uses tabsA PL.length-    nwins <- uses windowsA PL.length-    unless (ntabs == 1 && nwins == 1) $ if nwins == 1-      -- Could the Maybe response from deleteLeft be used instead of the-      -- def 'if'?-      then tabsA %= fromJust . PL.deleteLeft-      else windowsA %= fromJust . PL.deleteLeft---- | Make the current window the only window on the screen-closeOtherE :: EditorM ()-closeOtherE = windowsA %= PL.deleteOthers---- | Switch focus to some other window. If none is available, create one.-shiftOtherWindow :: MonadEditor m => m ()-shiftOtherWindow = withEditor $ do-  len <- uses windowsA PL.length-  if len == 1-    then splitE-    else nextWinE---- | Execute the argument in the context of an other window. Create--- one if necessary. The current window is re-focused after the--- argument has completed.-withOtherWindow :: MonadEditor m => m a -> m a-withOtherWindow f = do-  shiftOtherWindow-  x <- f-  withEditor prevWinE-  return x--acceptedInputs :: EditorM [T.Text]-acceptedInputs = do-  km <- defaultKm <$> askCfg-  keymap <- withCurrentBuffer $ gets (withMode0 modeKeymap)-  let l = I.accepted 3 . I.mkAutomaton . extractTopKeymap . keymap $ km-  return $ fmap T.unwords l---- | Shows the current key bindings in a new window-acceptedInputsOtherWindow :: EditorM ()-acceptedInputsOtherWindow = do-  ai <- acceptedInputs-  b <- stringToNewBuffer (MemBuffer "keybindings") (fromText $ T.unlines ai)-  w <- newWindowE False b-  windowsA %= PL.insertRight w---- | Defines an action to be executed when the current buffer is closed.------ Used by the minibuffer to assure the focus is restored to the--- buffer that spawned the minibuffer.------ todo: These actions are not restored on reload.------ todo: These actions should probably be very careful at what they--- do.------ TODO: All in all, this is a very ugly way to achieve the purpose.--- The nice way to proceed is to somehow attach the miniwindow to the--- window that has spawned it.-onCloseBufferE :: BufferRef -> EditorM () -> EditorM ()-onCloseBufferE b a =-  onCloseActionsA %= M.insertWith' (\_ old_a -> old_a >> a) b a--addJumpHereE :: EditorM ()-addJumpHereE = addJumpAtE =<< withCurrentBuffer pointB--addJumpAtE :: Point -> EditorM ()-addJumpAtE point = do-  w <- use currentWindowA-  shouldAddJump <- case jumpList w of-    Just (PL.PointedList _ (Jump mark bf) _) -> do-      bfStillAlive <- gets (M.lookup bf . buffers)-      case bfStillAlive of-        Nothing -> return False-        _ -> do-          p <- withGivenBuffer bf . use $ markPointA mark-          return $! (p, bf) /= (point, bufkey w)-    _ -> return True-  when shouldAddJump $ do-    m <- withCurrentBuffer setMarkHereB-    let bf = bufkey w-        j = Jump m bf-    assign currentWindowA $ w & jumpListA %~ addJump j-    return ()--jumpBackE :: EditorM ()-jumpBackE = addJumpHereE >> modifyJumpListE jumpBack--jumpForwardE :: EditorM ()-jumpForwardE = modifyJumpListE jumpForward--modifyJumpListE :: (JumpList -> JumpList) -> EditorM ()-modifyJumpListE f = do-  w <- use currentWindowA-  case f $ w ^. jumpListA of-    Nothing -> return ()-    Just (PL.PointedList _ (Jump mark bf) _) -> do-      switchToBufferE bf-      withCurrentBuffer $ use (markPointA mark) >>= moveTo-      currentWindowA . jumpListA %= f---- | Creates an in-memory buffer with a unique name.-newTempBufferE :: EditorM BufferRef-newTempBufferE = do-  e <- gets id-  -- increment the index of the hint until no buffer is found with that name-  let find_next currentName (nextName:otherNames) =-          case findBufferWithName currentName e of-            (_b : _) -> find_next nextName otherNames-            []      -> currentName-      find_next _ [] = error "Looks like nearly infinite list has just ended."-      next_tmp_name = find_next name names-      (name : names) = (fmap (("tmp-" Mon.<>) . T.pack . show) [0 :: Int ..])--  newEmptyBufferE (MemBuffer next_tmp_name)
− src/library/Yi/Eval.hs 
@@ -1,275 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Eval--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Evaluator for actions ('Action', 'YiAction'). Uses a @GHCi@ session--- under the hood.--module Yi.Eval (-        -- * Main (generic) evaluation interface-        execEditorAction,-        getAllNamesInScope,-        Evaluator(..),-        evaluator,-        -- ** Standard evaluators-        ghciEvaluator,-        publishedActionsEvaluator,-        publishedActions,-        publishAction,-        -- * Eval/Interpretation-        jumpToErrorE,-        jumpToE,-        consoleKeymap-) where--import           Control.Applicative ((<$>), (<*>))-import           Control.Lens hiding (Action)-import           Control.Monad hiding (mapM_)-import           Data.Array-import           Data.Binary-import           Data.Default-import           Data.Foldable (mapM_)-import qualified Data.HashMap.Strict as M-import           Data.List-import           Data.Monoid-import           Data.Typeable-import qualified Language.Haskell.Interpreter as LHI-import           Prelude hiding (error, mapM_)-import           System.Directory (doesFileExist)-import           Text.Read (readMaybe)-import           Yi.Boot.Internal (reload)-import           Yi.Buffer-import           Yi.Config.Simple.Types-import           Yi.Core (errorEditor, runAction)-import           Yi.Debug-import           Yi.Types (YiVariable,YiConfigVariable)-import           Yi.Editor-import           Yi.File-import           Yi.Hooks-import           Yi.Keymap-import           Yi.Keymap.Keys-import qualified Yi.Paths (getEvaluatorContextFilename)-import           Yi.Regex-import qualified Yi.Rope as R-import           Yi.String-import           Yi.Utils---- TODO: should we be sticking Text here?---- | Runs the action, as written by the user.------ The behaviour of this function can be customised by modifying the--- 'Evaluator' variable.-execEditorAction :: String -> YiM ()-execEditorAction = runHook execEditorActionImpl---- | Lists the action names in scope, for use by 'execEditorAction'.------ The behaviour of this function can be customised by modifying the--- 'Evaluator' variable.-getAllNamesInScope :: YiM [String]-getAllNamesInScope = runHook getAllNamesInScopeImpl---- | Config variable for customising the behaviour of--- 'execEditorAction' and 'getAllNamesInScope'.------ Set this variable using 'evaluator'. See 'ghciEvaluator' and--- 'finiteListEvaluator' for two implementation.-data Evaluator = Evaluator-  { execEditorActionImpl :: String -> YiM ()-    -- ^ implementation of 'execEditorAction'-  , getAllNamesInScopeImpl :: YiM [String]-    -- ^ implementation of 'getAllNamesInScope'-  } deriving (Typeable)---- | The evaluator to use for 'execEditorAction' and--- 'getAllNamesInScope'.-evaluator :: Field Evaluator-evaluator = customVariable--instance Default Evaluator where def = ghciEvaluator-instance YiConfigVariable Evaluator---- * Evaluator based on GHCi--newtype NamesCache = NamesCache [String] deriving (Typeable, Binary)--instance Default NamesCache where-    def = NamesCache []-instance YiVariable NamesCache---- Evaluator implemented by calling GHCi. This evaluator can run--- arbitrary expressions in the class 'YiAction'.------ The following two imports are always present:------ > import Yi--- > import qualified Yi.Keymap as Yi.Keymap------ Also, if the file------ > $HOME/.config/yi/local/Env.hs------ exists, it is imported unqualified.-ghciEvaluator :: Evaluator-ghciEvaluator = Evaluator { execEditorActionImpl = execAction-                          , getAllNamesInScopeImpl = getNames-                          }-  where-    execAction :: String -> YiM ()-    execAction "reload" = reload-    execAction s = do-      contextFile <- Yi.Paths.getEvaluatorContextFilename-      haveUserContext <- io $ doesFileExist contextFile-      res <- io $ LHI.runInterpreter $ do-        LHI.set [LHI.searchPath LHI.:= []]--        -- We no longer have Yi.Prelude, perhaps we should remove-        -- NoImplicitPrelude?-        LHI.set [LHI.languageExtensions LHI.:= [ LHI.OverloadedStrings-                                               , LHI.NoImplicitPrelude-                                               ]]-        when haveUserContext $ do-          LHI.loadModules [contextFile]-          LHI.setTopLevelModules ["Env"]--        -- Yi.Keymap: Action lives there-        LHI.setImportsQ [("Yi", Nothing), ("Yi.Keymap",Just "Yi.Keymap")]-        LHI.interpret ("Yi.makeAction (" ++ s ++ ")") (error "as" :: Action)-      case res of-        Left err -> errorEditor (showT err)-        Right action -> runAction action--    getNames :: YiM [String]-    getNames = do-      NamesCache cache <- withEditor $ getEditorDyn-      result <- if null cache-                then do-                  res <- io $ LHI.runInterpreter $ do-                    LHI.set [LHI.searchPath LHI.:= []]-                    LHI.getModuleExports "Yi"-                  return $ case res of-                    Left err ->[show err]-                    Right exports -> flattenExports exports-                else return $ sort cache-      withEditor $ putEditorDyn $ NamesCache result-      return result--    flattenExports :: [LHI.ModuleElem] -> [String]-    flattenExports = concatMap flattenExport--    flattenExport :: LHI.ModuleElem -> [String]-    flattenExport (LHI.Fun x) = [x]-    flattenExport (LHI.Class _ xs) = xs-    flattenExport (LHI.Data _ xs) = xs---- * 'PublishedActions' evaluator--newtype PublishedActions = PublishedActions {-    _publishedActions :: M.HashMap String Action-  } deriving(Typeable, Monoid)--instance Default PublishedActions where def = mempty--makeLensesWithSuffix "A" ''PublishedActions-instance YiConfigVariable PublishedActions---- | Accessor for the published actions. Consider using--- 'publishAction'.-publishedActions :: Field (M.HashMap String Action)-publishedActions = customVariable . _publishedActionsA---- | Publish the given action, by the given name. This will overwrite--- any existing actions by the same name.-publishAction :: (YiAction a x, Show x) => String -> a -> ConfigM ()-publishAction s a = publishedActions %= M.insert s (makeAction a)---- Evaluator based on a fixed list of published actions. Has a few--- differences from 'ghciEvaluator':------ * expressions can't be evaluated------ * all suggested actions are actually valued------ * (related to the above) doesn't contain junk actions from Prelude------ * doesn't require GHCi backend, so uses less memory-publishedActionsEvaluator :: Evaluator-publishedActionsEvaluator = Evaluator-  { getAllNamesInScopeImpl = askCfg <&> M.keys . (^. publishedActions)-  , execEditorActionImpl = \s ->-      askCfg <&> M.lookup s . (^. publishedActions) >>= mapM_ runAction-  }---- * Miscellaneous interpreter---- | Jumps to specified position in a given file.-jumpToE :: FilePath -- ^ Filename to make the jump in.-        -> Int -- ^ Line to jump to.-        -> Int -- ^ Column to jump to.-        -> YiM ()-jumpToE filename line column = do-  _ <- editFile filename-  withCurrentBuffer $ gotoLn line >> moveXorEol column---- | Regex parsing the error message format.-errorRegex :: Regex-errorRegex = makeRegex ("^(.+):([0-9]+):([0-9]+):.*$" :: String)---- | Parses an error message. Fails if it can't parse out the needed--- information, namely filename, line number and column number.-parseErrorMessage :: R.YiString -> Maybe (String, Int, Int)-parseErrorMessage ln = do-  (_ ,result, _) <- matchOnceText errorRegex (R.toString ln)-  case take 3 $ map fst $ elems result of-    [_, fname, l, c] -> (,,) <$> return fname <*> readMaybe l <*> readMaybe c-    _                        -> Nothing---- | Tries to parse an error message at current line using--- 'parseErrorMessage'.-parseErrorMessageB :: BufferM (Maybe (String, Int, Int))-parseErrorMessageB = parseErrorMessage <$> readLnB---- | Tries to jump to error at the current line. See--- 'parseErrorMessageB'.-jumpToErrorE :: YiM ()-jumpToErrorE = withCurrentBuffer parseErrorMessageB >>= \case-  Nothing -> printMsg "Couldn't parse out an error message."-  Just (f, l, c) -> jumpToE f l c--prompt :: R.YiString-prompt = "Yi> "---- | Tries to strip the 'prompt' from the front of the given 'String'.--- If the prompt is not found, returns the input command as-is.-takeCommand :: R.YiString -> R.YiString-takeCommand t = case R.splitAt (R.length prompt) t of-  (f, s) -> if f == prompt then s else t--consoleKeymap :: Keymap-consoleKeymap = do-  _ <- event (Event KEnter [])-  write $ withCurrentBuffer readLnB >>= \x -> case parseErrorMessage x of-    Just (f,l,c) -> jumpToE f l c-    Nothing -> do-      withCurrentBuffer $ do-        p <- pointB-        botB-        p' <- pointB-        when (p /= p') $ insertN ("\n" <> prompt <> takeCommand x)-        insertN "\n"-        pt <- pointB-        insertN prompt-        bm <- getBookmarkB "errorInsert"-        markPointA bm .= pt-      execEditorAction . R.toString $ takeCommand x
− src/library/Yi/Event.hs 
@@ -1,70 +0,0 @@-module Yi.Event-    (-     Event(..), prettyEvent,-     Key(..), Modifier(..),--     -- * Key codes-     eventToChar-    ) where--import Data.Bits-import Data.Char (chr,ord)-import Data.Monoid--data Modifier = MShift | MCtrl | MMeta | MSuper | MHyper-                deriving (Show,Eq,Ord)--data Key = KEsc | KFun Int | KPrtScr | KPause | KASCII Char | KBS | KIns-         | KHome | KPageUp | KDel | KEnd | KPageDown | KNP5 | KUp | KMenu-         | KLeft | KDown | KRight | KEnter | KTab deriving (Eq,Show,Ord)--data Event = Event Key [Modifier] deriving (Eq)--instance Ord Event where-    compare (Event k1 m1) (Event k2 m2) = compare m1 m2 `mappend` compare k1 k2-    -- so, all Ctrl+char, meta+char, etc. all form a continuous range--instance Show Event where-    show = prettyEvent--prettyEvent :: Event -> String-prettyEvent (Event k mods) =-           concatMap ((++ "-") . prettyModifier) mods ++ prettyKey k-  where prettyKey (KFun i) = 'F' : show i-        prettyKey (KASCII c) = [c]-        prettyKey key = tail $ show key-        prettyModifier m = [ show m !! 1]------ | Map an Event to a Char. This is used in the emacs keymap for Ctrl-Q and vim keymap 'insertSpecialChar'-eventToChar :: Event -> Char-eventToChar (Event KEnter _) = '\CR'-eventToChar (Event KEsc _)   = '\ESC'-eventToChar (Event KBS _)    = '\127'-eventToChar (Event KTab _)   = '\t'--eventToChar (Event (KASCII c) mods) = (if MMeta `elem` mods then setMeta else id) $-                                      (if MCtrl `elem` mods then ctrlLowcase else id) c--eventToChar _ev = '?'----remapChar :: Char -> Char -> Char -> Char -> Char -> Char-remapChar a1 b1 a2 _ c-    | a1 <= c && c <= b1 = chr $ ord c - ord a1 + ord a2-    | otherwise          = c--ctrlLowcase :: Char -> Char-ctrlLowcase   = remapChar 'a'   'z'   '\^A' '\^Z'---- set the meta bit, as if Mod1/Alt had been pressed-setMeta :: Char -> Char-setMeta c = chr (setBit (ord c) metaBit)--metaBit :: Int-metaBit = 7---
− src/library/Yi/File.hs 
@@ -1,132 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.File--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.File (-  -- * File-based actions-  editFile,       -- :: YiM BufferRef--  viWrite, viWriteTo, viSafeWriteTo,-  fwriteE,        -- :: YiM ()-  fwriteBufferE,  -- :: BufferM ()-  fwriteAllE,     -- :: YiM ()-  fwriteToE,      -- :: String -> YiM ()-  backupE,        -- :: FilePath -> YiM ()-  revertE,        -- :: YiM ()--  -- * Helper functions-  setFileName- ) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad.Base-import           Data.Monoid-import qualified Data.Text as T-import           Data.Time-import           System.Directory-import           System.FriendlyPath-import           Yi.Buffer-import           Yi.Core-import           Yi.Dired-import           Yi.Editor-import           Yi.Keymap-import           Yi.Monad-import qualified Yi.Rope as R-import           Yi.String-import           Yi.Utils---- | Revert to the contents of the file on disk-revertE :: YiM ()-revertE = do-  withCurrentBuffer (gets file) >>= \case-    Just fp -> do-      now <- io getCurrentTime-      s <- liftBase $ R.readFile fp-      withCurrentBuffer $ revertB s now-      printMsg ("Reverted from " <> showT fp)-    Nothing -> printMsg "Can't revert, no file associated with buffer."----- | Try to write a file in the manner of vi\/vim--- Need to catch any exception to avoid losing bindings-viWrite :: YiM ()-viWrite = do-  withCurrentBuffer (gets file) >>= \case-   Nothing -> errorEditor "no file name associate with buffer"-   Just f  -> do-       bufInfo <- withCurrentBuffer bufInfoB-       let s   = bufInfoFileName bufInfo-       fwriteE-       let message = (showT f <>) (if f == s-                         then " written"-                         else " " <> showT s <> " written")-       printMsg message---- | Try to write to a named file in the manner of vi/vim-viWriteTo :: T.Text -> YiM ()-viWriteTo f = do-  bufInfo <- withCurrentBuffer bufInfoB-  let s   = T.pack $ bufInfoFileName bufInfo-  fwriteToE f-  let message = f `T.append` if f == s-                             then " written"-                             else ' ' `T.cons` s `T.append` " written"-  printMsg message---- | Try to write to a named file if it doesn't exist. Error out if it does.-viSafeWriteTo :: T.Text -> YiM ()-viSafeWriteTo f = do-  existsF <- liftBase $ doesFileExist (T.unpack f)-  if existsF-    then errorEditor $ f <> ": File exists (add '!' to override)"-    else viWriteTo f---- | Write current buffer to disk, if this buffer is associated with a file-fwriteE :: YiM ()-fwriteE = fwriteBufferE =<< gets currentBuffer---- | Write a given buffer to disk if it is associated with a file.-fwriteBufferE :: BufferRef -> YiM ()-fwriteBufferE bufferKey = do-  nameContents <- withGivenBuffer bufferKey ((,) <$> gets file-                                                 <*> streamB Forward 0)-  case nameContents of-    (Just f, contents) -> io (doesDirectoryExist f) >>= \case-      True -> printMsg "Can't save over a directory, doing nothing."-      False -> do-        liftBase $ R.writeFile f contents-        io getCurrentTime >>= withGivenBuffer bufferKey . markSavedB-    (Nothing, _c)      -> printMsg "Buffer not associated with a file"---- | Write current buffer to disk as @f@. The file is also set to @f@.-fwriteToE :: T.Text -> YiM ()-fwriteToE f = do-  b <- gets currentBuffer-  setFileName b (T.unpack f)-  fwriteBufferE b---- | Write all open buffers-fwriteAllE :: YiM ()-fwriteAllE =-  do allBuffs <- gets bufferSet-     let modifiedBuffers = filter (not . isUnchangedBuffer) allBuffs-     mapM_ fwriteBufferE (fmap bkey modifiedBuffers)---- | Make a backup copy of file-backupE :: FilePath -> YiM ()-backupE = error "backupE not implemented"----- | Associate buffer with file; canonicalize the given path name.-setFileName :: BufferRef -> FilePath -> YiM ()-setFileName b filename = do-  cfn <- liftBase $ userToCanonPath filename-  withGivenBuffer b $ assign identA $ FileBuffer cfn
− src/library/Yi/History.hs 
@@ -1,154 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.History--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ ‘Command history’ implementation.--module Yi.History where--import           Control.Applicative-import           Control.Lens-import           Data.Binary-import           Data.Default-import           Data.List-import qualified Data.Map as M-import           Data.Monoid-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import           Data.Typeable-import           Yi.Buffer-import           Yi.Editor-import qualified Yi.Rope as R-import           Yi.Types (YiVariable)--newtype Histories = Histories (M.Map T.Text History)-                  deriving (Show, Eq, Typeable)--instance Binary Histories where-  put (Histories m) = put $ M.mapKeys T.unpack m-  get = Histories . M.mapKeys T.pack <$> get--instance Default Histories where-  def = Histories def--data History = History { _historyCurrent :: Int-                       , _historyContents :: [T.Text]-                       , _historyPrefix :: T.Text-                       } deriving (Show, Eq, Typeable)--instance Default History where-    def = History (-1) [] mempty--instance Binary History where-  put (History cu co pr) =-    put cu >> put (map E.encodeUtf8 co) >> put (E.encodeUtf8 pr)-  get = liftA3 History get (fmap E.decodeUtf8 <$> get) (E.decodeUtf8 <$> get)--instance YiVariable Histories--dynKeyA :: (Default v, Ord k) => k -> Lens' (M.Map k v) v-dynKeyA key = lens (M.findWithDefault def key) (flip (M.insert key))--miniBuffer :: T.Text-miniBuffer = "minibuffer"--historyUp :: EditorM ()-historyUp = historyMove miniBuffer 1--historyDown :: EditorM ()-historyDown = historyMove miniBuffer (-1)--historyStart :: EditorM ()-historyStart = historyStartGen miniBuffer---- | Start an input session with History-historyStartGen :: T.Text -> EditorM ()-historyStartGen ident = do-  Histories histories <- getEditorDyn-  let (History _cur cont pref) = histories ^. dynKeyA ident-  setHistory ident (History 0 (nub ("":cont)) pref) histories--historyFinish :: EditorM ()-historyFinish = historyFinishGen miniBuffer (R.toText <$> withCurrentBuffer elemsB)---- | Finish the current input session with history.-historyFinishGen :: T.Text -> EditorM T.Text -> EditorM ()-historyFinishGen ident getCurValue = do-  Histories histories <- getEditorDyn-  let History _cur cont pref = histories ^. dynKeyA ident-  curValue <- getCurValue-  let cont' = dropWhile (curValue ==) . dropWhile T.null $ cont-  curValue `seq`        -- force the new value, otherwise we'll hold-                        -- on to the buffer from which it's computed-    cont'         `seq` -- force checking the top of the history,-                        -- otherwise we'll build up thunks-    setHistory ident (History (-1) (curValue:cont') pref) histories--historyFind :: [T.Text] -> Int -> Int -> Int -> T.Text -> Int-historyFind cont len cur delta pref =-  case (next < 0, next >= len) of-    (True,_) -> next-    (_,True) -> next-    (_,_) -> if pref `T.isPrefixOf` (cont !! next)-      then next-      else historyFind cont len cur deltaLarger pref-  where-    next = cur + delta-    deltaLarger = delta + signum delta--historyMove :: T.Text -> Int -> EditorM ()-historyMove ident delta = do-  s <- historyMoveGen ident delta (R.toText <$> withCurrentBuffer elemsB)-  withCurrentBuffer . replaceBufferContent . R.fromText $ s--historyMoveGen :: T.Text -> Int -> EditorM T.Text -> EditorM T.Text-historyMoveGen ident delta getCurValue = do-  Histories histories <- getEditorDyn-  let History cur cont pref = histories ^. dynKeyA ident--  curValue <- getCurValue-  let len = length cont-      next = historyFind cont len cur delta pref-      nextValue = cont !! next-  case (next < 0, next >= len) of-    (True, _) -> do-      printMsg $ "end of " <> ident <> " history, no next item."-      return curValue-    (_, True) -> do-      printMsg $ "beginning of " <> ident <> " history, no previous item."-      return curValue-    (_,_) -> do-      let contents = take cur cont ++ [curValue] ++ drop (cur + 1) cont-      setHistory ident (History next contents pref) histories-      return nextValue--historyPrefixSet :: T.Text -> EditorM ()-historyPrefixSet = historyPrefixSet' miniBuffer--historyPrefixSet' :: T.Text -> T.Text -> EditorM ()-historyPrefixSet' ident pref = do-  Histories histories <- getEditorDyn-  let History cur cont _pref = histories ^. dynKeyA ident-  setHistory ident (History cur cont pref) histories---- | Helper that sets the given history at ident and 'putEditorDyn's--- the result.-setHistory :: (MonadEditor m, Functor m) => T.Text -- ^ identifier-           -> History -- ^ History to set-           -> M.Map T.Text History -- ^ Map of existing histories-           -> m ()-setHistory i h = putEditorDyn . Histories . set (dynKeyA i) h
− src/library/Yi/Hoogle.hs 
@@ -1,99 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Hoogle--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Provides functions for calling Hoogle on the commandline, and--- processing results into a form useful for completion or insertion.--module Yi.Hoogle where--import           Control.Applicative-import           Control.Arrow ((&&&))-import           Data.Char (isUpper)-import           Data.List (nub)-import qualified Data.Text as T-import           System.Exit (ExitCode(ExitFailure))-import           Yi.Buffer-import           Yi.Editor-import           Yi.Keymap-import           Yi.Process (runProgCommand)-import qualified Yi.Rope as R-import           Yi.String (showT)-import           Yi.Utils---- | Remove anything starting with uppercase letter. These denote--- either module names or types.-caseSensitize :: [R.YiString] -> [R.YiString]-caseSensitize = filter p-  where-    p :: R.YiString -> Bool-    p t = case R.head t of-      Nothing -> False-      Just c  -> not $ isUpper c---- | Hoogle's output includes a sort of type keyword, telling whether--- a hit is a package name, syntax, a module name, etc. But we care--- primarily about the function names, so we filter out anything--- containing the keywords.-gv :: [R.YiString] -> [R.YiString]-gv = filter f-  where-    ks = ["module ", " type ", "package ", " data ", " keyword "]-    f x = not $ any (`T.isInfixOf` R.toText x) ks---- | Query Hoogle, with given search and options. This errors out on no--- results or if the hoogle command is not on path.-hoogleRaw :: R.YiString -> R.YiString -> IO [R.YiString]-hoogleRaw srch opts = do-  let options = filter (not . R.null) [opts, srch]-  outp@(_status, out, _err) <- runProgCommand "hoogle" (R.toString <$> options)-  case outp of-    (ExitFailure 1, "", "") -> -- no output, probably failed to run binary-      fail "Error running hoogle command.  Is hoogle on path?"-    (ExitFailure 1, xs, _) -> fail $ "hoogle failed with: " ++ xs-    _ -> return ()-  -- TODO: bench ‘R.fromText . T.lines . T.pack’ vs ‘R.lines . R.fromString’-  let results = fmap R.fromText . T.lines $ T.pack out-  if results == ["No results found"]-    then fail "No Hoogle results"-    else return results---- | Filter the output of 'hoogleRaw' to leave just functions.-hoogleFunctions :: R.YiString -> IO [R.YiString]-hoogleFunctions a =-  caseSensitize . gv . nub . map ((!!1) . R.words) <$> hoogleRaw a ""---- | Return module-function pairs.-hoogleFunModule :: R.YiString -> IO [(R.YiString, R.YiString)]-hoogleFunModule a = map ((head &&& (!! 1)) . R.words) . gv <$> hoogleRaw a ""---- | Call out to 'hoogleFunModule', and overwrite the word at point with--- the first returned function.-hoogle :: YiM R.YiString-hoogle = do-    (wordRegion,word) <- withCurrentBuffer $ do-      wordRegion <- regionOfB unitWord-      word <- readRegionB wordRegion-      return (wordRegion, word)-    ((modl,fun):_) <- io $ hoogleFunModule word--    withCurrentBuffer $ replaceRegionB wordRegion fun-    return modl---- | Call out to 'hoogleRaw', and print inside the Minibuffer the results of--- searching Hoogle with the word at point.-hoogleSearch :: YiM ()-hoogleSearch = do-  word <- withCurrentBuffer $ do-    wordRegion <- regionOfB unitWord-    readRegionB wordRegion-  results <- io $ hoogleRaw word ""--  -- The quotes help legibility between closely-packed results-  printMsgs $ map showT results
− src/library/Yi/Hooks.hs 
@@ -1,101 +0,0 @@-{- | This module provides assistance in implementing \"hooks\" in Yi.-This module provides no major new functionality -- only assistance in-using 'YiConfigVariable's more easily to implement hooks.--We consider a simple example. Suppose we have a function--> promptForFile :: Maybe FilePath -> YiM FilePath--which prompts the user to select a file from their file system,-starting with the provided directory (if actually provided). Since-this is a frequent task in Yi, it is important for it to be as-user-friendly as possible. If opinions vary on the meaning of-\"user-friendly\", then we would really like to provide multiple-implementations of @promptForFile@, and allow users to select which-implementation to use in their config files.--A way to achieve this is using hooks, as follows:--> -- create a new type-> newtype FilePrompter = FilePrompter->   { runFilePrompter :: Maybe FilePath -> YiM FilePath }->   deriving (Typeable)-> $(nameDeriveAccessors ''FilePrompter (n -> Just (n ++ "A")))->-> -- give some implementations-> filePrompter1, filePrompter2, filePrompter3 :: FilePrompter-> ...->-> -- declare FilePrompter as a YiConfigVariable (so it can go in the Config)-> instance YiConfigVariable FilePrompter->-> -- specify the default FilePrompter-> instance Default FilePrompter where->    def = filePrompter1->-> -- replace the old promptForFile function with a shim-> promptForFile :: Maybe FilePath -> YiM FilePath-> promptForFile = runHook runFilePrompter->-> -- provide a custom-named Field for Yi.Config.Simple (not-> -- strictly necessary, but user-friendly)-> filePrompter :: Field FilePrompter-> filePrompter = customVariable--The user can write--> ...->    filePrompter %= filePrompter2-> ...--in their config file, and calls to @promptForFile@ will now use the-different prompter. Library code which called @promptForFile@ does not-need to be changed, but it gets the new @filePrompter2@ behaviour-automatically.--See "Yi.Eval" for a real example of hooks.--}-module Yi.Hooks(-  -- * Convenience function 'runHook'-  runHook,-  HookType,-  -- * Re-exports from "Yi.Config.Simple"-  customVariable,-  Field,- )-  where--import Control.Lens-import Yi.Config-import Yi.Editor-import Yi.Keymap-import Yi.Config.Simple.Types(customVariable, Field)-import Yi.Types (YiConfigVariable)---- | Looks up the configured value for the hook, and runs it. The--- argument to 'runHook' will typically be a record accessor. See--- 'HookType' for the valid hook types.-runHook :: (HookType ty, YiConfigVariable var) => (var -> ty) -> ty-runHook = runHookImpl---- | The class of \"valid hooks\". This class is exported abstractly,--- but the instances can be phrased quite simply: the functions (of--- arbitrarily many arguments, including zero) which run in either the--- 'EditorM' or 'YiM' monads.------A typical example would be something like------ @Int -> String -> 'EditorM' String@.-class HookType ty where-    runHookImpl :: YiConfigVariable var => (var -> ty) -> ty--instance HookType (EditorM a) where-    runHookImpl lookupHook = do-        cfg <- askCfg-        lookupHook (cfg ^. configVariable)-instance HookType (YiM a) where-    runHookImpl lookupHook = do-        cfg <- askCfg-        lookupHook (cfg ^. configVariable)-instance HookType b => HookType (a -> b) where-    runHookImpl lookupHook a = runHookImpl (($a) . lookupHook)
− src/library/Yi/IReader.hs 
@@ -1,161 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.IReader--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ This module defines a list type and operations on it; it further--- provides functions which write in and out the list. The goal is to--- make it easy for the user to store a large number of text buffers--- and cycle among them, making edits as she goes. The idea is--- inspired by \"incremental reading\", see--- <http://en.wikipedia.org/wiki/Incremental_reading>.--module Yi.IReader where--import           Control.Exception-import           Control.Monad-import           Data.Binary-import qualified Data.ByteString.Char8 as B (pack, unpack, readFile, ByteString)-import qualified Data.ByteString.Lazy.Char8 as BL (fromChunks)-import           Data.Default-import           Data.Sequence as S-import           Data.Typeable-import           Yi.Buffer.HighLevel (replaceBufferContent, topB)-import           Yi.Buffer.Misc (getBufferDyn, putBufferDyn, elemsB)-import           Yi.Editor (withCurrentBuffer)-import           Yi.Keymap (YiM)-import           Yi.Paths (getArticleDbFilename)-import qualified Yi.Rope as R-import           Yi.Utils-import           Yi.Types (YiVariable)---- | TODO: Why 'B.ByteString'?-type Article = B.ByteString--newtype ArticleDB = ADB { unADB :: Seq Article }-  deriving (Typeable, Binary)--instance Default ArticleDB where-    def = ADB S.empty-instance YiVariable ArticleDB---- | Take an 'ArticleDB', and return the first 'Article' and an--- ArticleDB - *without* that article.-split :: ArticleDB -> (Article, ArticleDB)-split (ADB adb) = case viewl adb of-  EmptyL -> (B.pack "", def)-  (a :< b) -> (a, ADB b)---- | Get the first article in the list. We use the list to express--- relative priority; the first is the most, the last least. We then--- just cycle through - every article gets equal time.-getLatestArticle :: ArticleDB -> Article-getLatestArticle = fst . split -- we only want the article---- | We remove the old first article, and we stick it on the end of the--- list using the presumably modified version.-removeSetLast :: ArticleDB -> Article -> ArticleDB-removeSetLast adb old = ADB (unADB (snd (split adb)) S.|> old)---- we move the last entry to the entry 'length `div` n'from the--- beginning; so 'shift 1' would do nothing (eg. the last index is 50,--- 50 `div` 1 == 50, so the item would be moved to where it is) 'shift--- 2' will move it to the middle of the list, though; last index = 50,--- then 50 `div` 2 will shift the item to index 25, and so on down to--- 50 `div` 50 - the head of the list/Seq.-shift :: Int ->ArticleDB -> ArticleDB-shift n adb = if n < 2 || lst < 2 then adb else ADB $ (r S.|> lastentry) >< s'-  where lst = S.length (unADB adb) - 1-        (r,s) = S.splitAt (lst `div` n) (unADB adb)-        (s' :> lastentry) = S.viewr s---- | Insert a new article with top priority (that is, at the front of the list).-insertArticle :: ArticleDB -> Article -> ArticleDB-insertArticle (ADB adb) new = ADB (new S.<| adb)---- | Serialize given 'ArticleDB' out.-writeDB :: ArticleDB -> YiM ()-writeDB adb = void $ io . join . fmap (`encodeFile` adb) $ getArticleDbFilename---- | Read in database from 'getArticleDbFilename' and then parse it--- into an 'ArticleDB'.-readDB :: YiM ArticleDB-readDB = io $ (getArticleDbFilename >>= r) `catch` returnDefault-  where r = fmap (decode . BL.fromChunks . return) . B.readFile-        -- We read in with strict bytestrings to guarantee the file is-        -- closed, and then we convert it to the lazy bytestring-        -- data.binary expects. This is inefficient, but alas...-        returnDefault (_ :: SomeException) = return def---- | Returns the database as it exists on the disk, and the current Yi--- buffer contents. Note that the Default typeclass gives us an empty--- Seq. So first we try the buffer state in the hope we can avoid a--- very expensive read from disk, and if we find nothing (that is, if--- we get an empty Seq), only then do we call 'readDB'.-oldDbNewArticle :: YiM (ArticleDB, Article)-oldDbNewArticle = do-  saveddb <- withCurrentBuffer getBufferDyn-  newarticle <- fmap (B.pack . R.toString) $ withCurrentBuffer elemsB-  if not $ S.null (unADB saveddb)-    then return (saveddb, newarticle)-    else readDB >>= \olddb -> return (olddb, newarticle)---- | Given an 'ArticleDB', dump the scheduled article into the buffer--- (replacing previous contents).-setDisplayedArticle :: ArticleDB -> YiM ()-setDisplayedArticle newdb = do-  let next = getLatestArticle newdb-  withCurrentBuffer $ do-    replaceBufferContent $ R.fromString (B.unpack next)-    topB -- replaceBufferContents moves us to bottom?-    putBufferDyn newdb---- | Go to next one. This ignores the buffer, but it doesn't remove--- anything from the database. However, the ordering does change.-nextArticle :: YiM ()-nextArticle = do-  (oldb,_) <- oldDbNewArticle-  -- Ignore buffer, just set the first article last-  let newdb = removeSetLast oldb (getLatestArticle oldb)-  writeDB newdb-  setDisplayedArticle newdb---- | Delete current article (the article as in the database), and go--- to next one.-deleteAndNextArticle :: YiM ()-deleteAndNextArticle = do-  (oldb,_) <- oldDbNewArticle -- throw away changes-  let ndb = ADB $ case viewl (unADB oldb) of     -- drop 1st article-        EmptyL -> empty-        (_ :< b) -> b-  writeDB ndb-  setDisplayedArticle ndb---- | The main action. We fetch the old database, we fetch the modified--- article from the buffer, then we call the function 'updateSetLast'--- which removes the first article and pushes our modified article to--- the end of the list.-saveAndNextArticle :: Int -> YiM ()-saveAndNextArticle n = do-  (oldb,newa) <- oldDbNewArticle-  let newdb = shift n $ removeSetLast oldb newa-  writeDB newdb-  setDisplayedArticle newdb---- | Assume the buffer is an entirely new article just imported this--- second, and save it. We don't want to use 'updateSetLast' since--- that will erase an article.-saveAsNewArticle :: YiM ()-saveAsNewArticle = do-  oldb <- readDB -- make sure we read from disk - we aren't in iread-mode!-  (_,newa) <- oldDbNewArticle -- we ignore the fst - the Default is 'empty'-  let newdb = insertArticle oldb newa-  writeDB newdb
− src/library/Yi/IncrementalParse.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}--module Yi.IncrementalParse (recoverWith, symbol, eof, lookNext, testNext,-                            State, P, Parser(..), AlexState (..), scanner) where-import Parser.Incremental hiding (run)-import Yi.Lexer.Alex (AlexState (..))-import Yi.Syntax--type P s a = Parser s a--type State st token result = (st, Process token result)--scanner :: forall st token result. Parser token result -> Scanner st token -> Scanner (State st token result) result-scanner parser input = Scanner-    {-      scanInit = (scanInit input, mkProcess parser),-      scanLooked = scanLooked input . fst,-      scanRun = run,-      scanEmpty = fst $ evalR $ pushEof $ mkProcess parser-    }-    where-        run :: State st token result -> [(State st token result, result)]-        run (st,process) = updateState0 process $ scanRun input st--        updateState0 :: Process token result -> [(st,token)] -> [(State st token result, result)]-        updateState0 _        [] = []-        updateState0 curState toks@((st,tok):rest) = ((st, curState), result) : updateState0 nextState rest-            where nextState =       evalL $           pushSyms [tok]           curState-                  result    = fst $ evalR $ pushEof $ pushSyms (fmap snd toks) curState
− src/library/Yi/Interact.hs 
@@ -1,330 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_HADDOCK show-extensions #-}--{-|-Module      :  Yi.Interact-License     :  GPL-2-Maintainer  :  yi-devel@googlegroups.com-Stability   :  experimental-Portability :  portable--This is a library of interactive processes combinators, usable to-define extensible keymaps.--(Inspired by the Parsec library, written by Koen Claessen)--The processes are:--* composable: in parallel using '<|>', in sequence using monadic bind.--* extensible: it is always possible to override a behaviour by combination of-  'adjustPriority' and '<|>'. (See also '<||' for a convenient combination of the two.)--* monadic: sequencing is done via monadic bind. (leveraging the whole-  battery of monadic tools that Haskell provides)--The processes can parse input, and write output that depends on it.--The semantics are quite obvious; only disjunction-deserve a bit more explanation:--in @p = (a '<|>' b)@, what happens if @a@ and @b@ recognize the same-input (prefix), but produce conflicting output?--* if the output is the same (as by the Eq class), then the processes (prefixes) are "merged"-* if a Write is more prioritized than the other, the one with low priority will be discarded-* otherwise, the output will be delayed until one of the branches can be discarded.-* if there is no way to disambiguate, then no output will be generated anymore.-  This situation can be detected by using 'possibleActions' however.--}--module Yi.Interact-    (-     I, P (Chain,End),-     InteractState (..),-     MonadInteract (..),-     deprioritize,-     important,-     (<||),-     (||>),-     option,-     oneOf,-     processOneEvent,-     computeState,-     event,-     events,-     choice,-     mkAutomaton, idAutomaton,-     runWrite,-     anyEvent,-     eventBetween,-     accepted-    ) where--import           Control.Applicative-import           Control.Arrow (first)-import           Control.Lens-import           Control.Monad.State hiding ( get, mapM )-import           Data.Function (on)-import           Data.List (groupBy)-import           Data.Monoid-import qualified Data.Text as T----------------------------------------------------- Classes---- | Abstraction of monadic interactive processes-class (Eq w, Monad m, Alternative m, Applicative m, MonadPlus m) => MonadInteract m w e | m -> w e where-    write :: w -> m ()-    -- ^ Outputs a result.-    eventBounds :: Ord e => Maybe e -> Maybe e -> m e-    -- ^ Consumes and returns the next character.-    --   Fails if there is no input left, or outside the given bounds.-    adjustPriority :: Int -> m ()------------------------------------------------------- State transformation---- Needs -fallow-undecidable-instances--- TODO: abstract over MonadTransformer-instance MonadInteract m w e => MonadInteract (StateT s m) w e where-    write = lift . write-    eventBounds l h = lift (eventBounds l h)-    adjustPriority p = lift (adjustPriority p)-------------------------------------------------------------------------------- | Interactive process description---- TODO: Replace 'Doc:' by ^ when haddock supports GADTs-data I ev w a where-    Returns :: a -> I ev w a-    Binds :: I ev w a -> (a -> I ev w b) -> I ev w b-    Gets :: Ord ev => Maybe ev -> Maybe ev -> I ev w ev-    -- Doc: Accept any character between given bounds. Bound is ignored if 'Nothing'.-    Fails :: I ev w a-    Writes :: w -> I ev w ()-    Priority :: Int -> I ev w ()-    Plus :: I ev w a -> I ev w a -> I ev w a--instance Functor (I event w) where-  fmap f i = pure f <*> i--instance Applicative (I ev w) where-    pure = return-    a <*> b = do f <- a; x <- b; return (f x)--instance Alternative (I ev w) where-    empty = Fails-    (<|>) = Plus--instance Monad (I event w) where-  return  = Returns-  fail _  = Fails-  (>>=)   = Binds--instance Eq w => MonadPlus (I event w) where-  mzero = Fails-  mplus = Plus--instance Eq w => MonadInteract (I event w) w event where-    write = Writes-    eventBounds = Gets-    adjustPriority = Priority---infixl 3 <||--deprioritize :: (MonadInteract f w e) => f ()-deprioritize = adjustPriority 1--(<||), (||>) :: (MonadInteract f w e) => f a -> f a -> f a-a <|| b = a <|> (deprioritize >> b)--(||>) = flip (<||)---- | Just like '(<||)' but in prefix form. It 'deprioritize's the--- second argument.-important :: MonadInteract f w e => f a -> f a -> f a-important a b = a <|| b---- | Convert a process description to an "executable" process.-mkProcess :: Eq w => I ev w a -> (a -> P ev w) -> P ev w-mkProcess (Returns x) = \fut -> fut x-mkProcess Fails = const Fail-mkProcess (m `Binds` f) = \fut -> mkProcess m (\a -> mkProcess (f a) fut)-mkProcess (Gets l h) = Get l h-mkProcess (Writes w) = \fut -> Write w (fut ())-mkProcess (Priority p) = \fut -> Prior p (fut ())-mkProcess (Plus a b) = \fut -> Best (mkProcess a fut) (mkProcess b fut)---------------------------------------------------------------------------- Process type---- | Operational representation of a process-data P event w-    = Ord event => Get (Maybe event) (Maybe event) (event -> P event w)-    | Fail-    | Write w (P event w)-    | Prior Int (P event w) -- low numbers indicate high priority-    | Best (P event w) (P event w)-    | End-    | forall mid. (Show mid, Eq mid) => Chain (P event mid) (P mid w)--accepted :: (Show ev) => Int -> P ev w -> [[T.Text]]-accepted 0 _ = [[]]-accepted d (Get (Just low) (Just high) k) = do-    t <- accepted (d - 1) (k low)-    let h = if low == high-            then showT low-            else showT low `T.append` ".." `T.append` showT high-    return (h : t)-accepted _ (Get Nothing Nothing _) = [["<any>"]]-accepted _ (Get Nothing (Just e) _) = [[".." `T.append` showT e]]-accepted _ (Get (Just e) Nothing _) = [[showT e `T.append` ".."]]-accepted _ Fail = []-accepted _ (Write _ _) = [[]] -- this should show what action we get...-accepted d (Prior _ p) = accepted d p-accepted d (Best p q) = accepted d p ++ accepted d q-accepted _ End = []-accepted _ (Chain _ _) = error "accepted: chain not supported"---- Utility function-showT :: Show a => a -> T.Text-showT = T.pack . show---- ------------------------------------------------------------------------------ Operations over P--runWrite :: Eq w => P event w -> [event] -> [w]-runWrite _ [] = []-runWrite p (c:cs) = let (ws, p') = processOneEvent p c in ws ++ runWrite p' cs--processOneEvent :: Eq w => P event w -> event -> ([w], P event w)-processOneEvent p e = pullWrites $ pushEvent p e---- | Push an event in the automaton-pushEvent :: P ev w -> ev -> P ev w-pushEvent (Best c d) e = Best (pushEvent c e) (pushEvent d e)-pushEvent (Write w c) e = Write w (pushEvent c e)-pushEvent (Prior p c) e = Prior p (pushEvent c e)-pushEvent (Get l h f) e = if test (e >=) l && test (e <=) h then f e else Fail-    where test = maybe True-pushEvent Fail _ = Fail-pushEvent End _ = End-pushEvent (Chain p q) e = Chain (pushEvent p e) q---- | Abstraction of the automaton state.-data InteractState event w =  Ambiguous [(Int,w,P event w)] | Waiting | Dead | Running w (P event w)--instance Monoid (InteractState event w) where-    -- not used at the moment:-    mappend (Running w c) _ = Running w c-    mappend _ (Running w c) = Running w c-    -- don't die if that can be avoided-    mappend Dead p = p-    mappend p Dead = p-    -- If a branch is not determined, wait for it.-    mappend Waiting _ = Waiting-    mappend _ Waiting = Waiting-    -- ambiguity remains-    mappend (Ambiguous a) (Ambiguous b) = Ambiguous (a ++ b)-    mempty = Ambiguous []----- | find all the writes that are accessible.-findWrites :: Int -> P event w -> InteractState event w-findWrites p (Best c d) = findWrites p c `mappend` findWrites p d-findWrites p (Write w c) = Ambiguous [(p,w,c)]-findWrites p (Prior dp c) = findWrites (p+dp) c-findWrites _ Fail = Dead-findWrites _ End = Dead-findWrites _ (Get{})     = Waiting-findWrites p (Chain a b) = case computeState a of-    Dead -> Dead-    Ambiguous _ -> Dead -- If ambiguity, don't try to do anything clever for now; die.-    Running w c -> findWrites p (Chain c (pushEvent b w)) -- pull as much as possible from the left automaton-    Waiting -> case findWrites p b of-        Ambiguous choices -> Ambiguous [(p',w',Chain a c') | (p',w',c') <- choices]-        Running w' c' -> Running w' (Chain a c') -- when it has nothing more, pull from the right.-        Dead -> Dead-        Waiting -> Waiting--computeState :: Eq w => P event w -> InteractState event  w-computeState a = case findWrites 0 a of-    Ambiguous actions ->-      let prior = minimum $ map (view _1) actions-          bests = groupBy ((==) `on` view _2) $-                    filter ((prior ==) . view _1) actions-      in case bests of-        [(_,w,c):_] -> Running w c-        _ -> Ambiguous $ map head bests-    s -> s----pullWrites :: Eq w => P event w -> ([w], P event w)-pullWrites a = case computeState a of-    Running w c -> first (w:) (pullWrites c)-    _ -> ([], a)---instance (Show w, Show ev) => Show (P ev w) where-    show (Get Nothing Nothing _) = "?"-    show (Get (Just l) (Just h) _p) | l == h = show l -- ++ " " ++ show (p l)-    show (Get l h _) = maybe "" show l ++ ".." ++ maybe "" show h-    show (Prior p c) = ":" ++ show p ++ show c-    show (Write w c) = "!" ++ show w ++ "->" ++ show c-    show (End) = "."-    show (Fail) = "*"-    show (Best p q) = "{" ++ show p ++ "|" ++ show q ++ "}"-    show (Chain a b) = show a ++ ">>>" ++ show b---- ------------------------------------------------------------------------------ Derived operations-oneOf :: (Ord event, MonadInteract m w event) => [event] -> m event-oneOf s = choice $ map event s--anyEvent :: (Ord event, MonadInteract m w event) => m event-anyEvent = eventBounds Nothing Nothing--eventBetween :: (Ord e, MonadInteract m w e) => e -> e -> m e-eventBetween l h = eventBounds (Just l) (Just h)--event :: (Ord event, MonadInteract m w event) => event -> m event--- ^ Parses and returns the specified character.-event e = eventBetween e e--events :: (Ord event, MonadInteract m w event) => [event] -> m [event]--- ^ Parses and returns the specified list of events (lazily).-events = mapM event--choice :: (MonadInteract m w e) => [m a] -> m a--- ^ Combines all parsers in the specified list.-choice []     = fail "No choice succeeds"-choice [p]    = p-choice (p:ps) = p `mplus` choice ps--option :: (MonadInteract m w e) => a -> m a -> m a--- ^ @option x p@ will either parse @p@ or return @x@ without consuming---   any input.-option x p = p `mplus` return x--mkAutomaton :: Eq w => I ev w a -> P ev w-mkAutomaton i = mkProcess i (const End)---- An automaton that produces its input-idAutomaton :: (Ord a, Eq a) => P a a-idAutomaton = Get Nothing Nothing $ \e -> Write e idAutomaton--- It would be much nicer to write:---    mkAutomaton (forever 0 (anyEvent >>= write))--- however this creates a memory leak. Unfortunately I don't understand why.--- To witness:---    dist/build/yi/yi +RTS -hyI -hd--- Then type some characters. (Binds grows linearly)
− src/library/Yi/JumpList.hs 
@@ -1,53 +0,0 @@-{-# LANGUAGE TemplateHaskell, CPP, StandaloneDeriving, DeriveGeneric #-}--module Yi.JumpList-    ( JumpList-    , Jump(..)-    , addJump-    , jumpBack-    , jumpForward-    ) where--import Yi.Buffer.Basic--import Data.Binary-#if __GLASGOW_HASKELL__ < 708-import Data.DeriveTH-#else-import GHC.Generics (Generic)-#endif--import Data.List.PointedList as PL--type JumpList = Maybe (PL.PointedList Jump)--data Jump = Jump {-        jumpMark :: Mark-      , jumpBufferRef :: BufferRef-    }--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''Jump)-#else-deriving instance Generic Jump-instance Binary Jump-#endif--instance Show Jump where-    show (Jump mark bufref) = "<Jump " ++ show mark ++ " " ++ show bufref ++ ">"--addJump :: Jump -> JumpList -> JumpList-addJump j (Just (PL.PointedList past present _future)) = Just $ PL.PointedList (present:past) j []-addJump j Nothing = Just $ PL.PointedList [] j []--jumpBack :: JumpList -> JumpList-jumpBack = modifyJumpList previous--jumpForward :: JumpList -> JumpList-jumpForward = modifyJumpList next--modifyJumpList :: (PointedList Jump -> Maybe (PointedList Jump)) -> JumpList -> JumpList-modifyJumpList f (Just jumps) = case f jumps of-                                Nothing -> Just jumps-                                Just jumps' -> Just jumps'-modifyJumpList _ Nothing = Nothing
− src/library/Yi/Keymap.hs 
@@ -1,143 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE Rank2Types #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ 'Keymap', 'YiM' and 'Action's.---module Yi.Keymap-    ( Action(..)-    , emptyAction-    , Interact-    , KeymapM-    , Keymap-    , KeymapEndo-    , KeymapProcess-    , KeymapSet(..)-    , topKeymapA-    , insertKeymapA-    , extractTopKeymap-    , modelessKeymapSet-    , YiM(..)-    , withUI-    , unsafeWithEditor-    , readEditor-    , catchDynE-    , catchJustE-    , handleJustE-    , YiAction (..)-    , Yi(..)-    , IsRefreshNeeded(..)-    , YiVar(..)-    , write-    , withModeY--    -- * Lenses-    , yiSubprocessesA-    , yiEditorA-    , yiSubprocessIdSupplyA-    , yiConfigA-    , yiInputA-    , yiOutputA-    , yiUiA-    , yiVarA-    ) where--import           Control.Exception-import           Control.Monad.Reader hiding (mapM_)-import           Control.Monad.State hiding (mapM_)-import           Yi.Buffer-import qualified Yi.Editor as Editor-import qualified Yi.Interact as I-import           Yi.Monad-import           Yi.Types-import           Yi.UI.Common-import           Yi.Utils----------------------------- Keymap basics---- | @write a@ returns a keymap that just outputs the action @a@.-write :: (I.MonadInteract m Action ev, YiAction a x, Show x) => a -> m ()-write x = I.write (makeAction x)------------------------------------- Uninteresting glue code--withUI :: (UI Editor -> IO a) -> YiM a-withUI = with yiUi--readEditor :: MonadEditor m => (Editor -> a) -> m a-readEditor f = withEditor (gets f)--catchDynE :: Exception exception => YiM a -> (exception -> YiM a) -> YiM a-catchDynE (YiM inner) handler-    = YiM $ ReaderT (\r -> catch (runReaderT inner r) (\e -> runReaderT (runYiM $ handler e) r))--catchJustE :: (Exception e) => (e -> Maybe b) -- ^ Predicate to select exceptions-           -> YiM a      -- ^ Computation to run-           -> (b -> YiM a) -- ^   Handler-           -> YiM a-catchJustE p (YiM c) h = YiM $ ReaderT (\r -> catchJust p (runReaderT c r) (\b -> runReaderT (runYiM $ h b) r))--handleJustE :: (Exception e) => (e -> Maybe b) -> (b -> YiM a) -> YiM a -> YiM a-handleJustE p h c = catchJustE p c h---- ---------------------------------------------class YiAction a x | a -> x where-    makeAction :: Show x => a -> Action--instance YiAction (IO x) x where-    makeAction = YiA . io--instance YiAction (YiM x) x where-    makeAction = YiA--instance YiAction (EditorM x) x where-    makeAction = EditorA--instance YiAction (BufferM x) x where-    makeAction = BufferA--instance YiAction Action () where-    makeAction = id--makeLensesWithSuffix "A" ''KeymapSet--modelessKeymapSet :: Keymap -> KeymapSet-modelessKeymapSet k = KeymapSet- { insertKeymap = k- , topKeymap = k- }---- | @withModeY f@ runs @f@ on the current buffer's mode. As this runs in--- the YiM monad, we're able to do more than with just 'withModeB' such as--- prompt the user for something before running the action.-withModeY :: (forall syntax. Mode syntax -> YiM ()) -> YiM ()-withModeY f = do-   bufref <- gets Editor.currentBuffer-   mfbuf <- Editor.findBuffer bufref-   case mfbuf of-     Nothing -> return ()-     Just (FBuffer {bmode = m}) -> f m--makeLensesWithSuffix "A" ''YiVar-makeLensesWithSuffix "A" ''Yi
− src/library/Yi/Keymap/Completion.hs 
@@ -1,59 +0,0 @@--- | This is a little helper for completion interfaces.--module Yi.Keymap.Completion (-        CompletionTree(CT),-        stepTree, obvious, mergeTrees, listToTree, complete)-   where--import Control.Arrow (first)-import Data.List---- inside a completion tree, the a's must be unique on each level--data CompletionTree a = CT [(a,CompletionTree a)]--instance (Show a) => Show (CompletionTree a) where-  show = show'--show' :: (Show a) => CompletionTree a -> String-show' (CT []) = []-show' (CT [(a,st)]) = shows a $ show' st-show' (CT trees) = "[" ++ intercalate "|" (map (\(x,y)->shows x $ show' y) trees) ++ "]"--compareBy :: (Ord b) => (a->b)->a->a->Ordering-compareBy f a b = compare (f a) (f b)--listToTree :: [a] -> CompletionTree a-listToTree = foldr (\a b->CT [(a,b)]) (CT [])--stepTree :: Eq a => CompletionTree a->a->Maybe ([a],CompletionTree a)-stepTree (CT completions) letter = Just $ obvious $ CT $ filter-                                   ((letter==).fst) completions--obvious :: CompletionTree a -> ([a],CompletionTree a)-obvious (CT [(letter,moretrees)]) = first ((:) letter) $-                                             obvious moretrees-obvious remainingchoice           = ([],remainingchoice)--mergeTrees :: Ord a => [CompletionTree a] -> CompletionTree a-mergeTrees a = mergeTrees' (map sort' a)-  where sort' = CT . sortBy (compareBy fst) . (\(CT l)->l)--mergeTrees':: Ord a => [CompletionTree a] -> CompletionTree a-mergeTrees' trees = CT $-                    map (\x->(fst $ head x,mergeTrees $ map snd x)) $-                    groupBy (((EQ==).).compareBy fst)  $-                    sortBy (compareBy fst) $-                    concatMap (\(CT x)->x) trees--complete :: Eq a => CompletionTree a -> [a] -> ([a],CompletionTree a)-complete tree    [] = ([],tree)-complete (CT []) _  = ([],CT [])-complete (CT level) (a:ta) = first ((:) a) $-    case match of-       Just m -> complete (snd m) ta-       Nothing -> ([],CT [])-     where match = find ((a==).fst) level-----alternatives :: CompletionTree a->[[a]]
− src/library/Yi/Keymap/Cua.hs 
@@ -1,159 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Cua--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Cua keymap.--module Yi.Keymap.Cua ( keymap-                     , portableKeymap-                     , customizedCuaKeymapSet-                     , cut-                     , paste-                     , copy-                     , del-                     ) where--import           Control.Applicative-import           Control.Lens hiding (act)-import           Control.Monad-import qualified Data.Text as T-import           Yi.Buffer-import           Yi.Editor-import           Yi.File-import           Yi.Keymap-import           Yi.Keymap.Emacs.Utils-import           Yi.Keymap.Keys-import           Yi.MiniBuffer-import           Yi.Misc (adjBlock, selectAll)-import           Yi.Rectangle-import qualified Yi.Rope as R-import           Yi.String--customizedCuaKeymapSet :: Keymap -> KeymapSet-customizedCuaKeymapSet userKeymap =-    modelessKeymapSet $ selfInsertKeymap-                    <|> move-                    <|> select-                    <|> rect-                    <|> userKeymap-                    <|> other ctrl--keymap :: KeymapSet-keymap = portableKeymap ctrl---- | Introduce a keymap that is compatible with both windows and osx,---   by parameterising the event modifier required for commands-portableKeymap :: (Event -> Event) -> KeymapSet-portableKeymap cmd = modelessKeymapSet $ selfInsertKeymap <|> move <|> select <|> rect <|> other cmd--selfInsertKeymap :: Keymap-selfInsertKeymap = do-  c <- printableChar-  let action = (withCurrentBuffer . replaceSel $ R.singleton c) :: EditorM ()-  write action--setMark :: Bool -> BufferM ()-setMark b = do-  isSet <- use highlightSelectionA-  assign rectangleSelectionA b-  unless isSet $ do-       assign highlightSelectionA True-       pointB >>= setSelectionMarkPointB--unsetMark :: BufferM ()-unsetMark = assign highlightSelectionA False--replaceSel :: R.YiString -> BufferM ()-replaceSel s = do-  hasSel <- use highlightSelectionA-  if hasSel-    then getSelectRegionB >>= flip replaceRegionB s-    else do-      when (R.length s == 1) (adjBlock 1)-      insertN s--deleteSel :: BufferM () -> YiM ()-deleteSel act = do-  haveSelection <- withCurrentBuffer $ use highlightSelectionA-  if haveSelection-    then withEditor del-    else withCurrentBuffer (adjBlock (-1) >> act)--cut :: EditorM ()-cut = copy >> del--del :: EditorM ()-del = do-  asRect <- withCurrentBuffer $ use rectangleSelectionA-  if asRect-    then killRectangle-    else withCurrentBuffer $ deleteRegionB =<< getSelectRegionB--copy :: EditorM ()-copy =-  (setRegE =<<) $ withCurrentBuffer $ do-    asRect <- use rectangleSelectionA-    if not asRect-      then getSelectRegionB >>= readRegionB-      else do-        (reg, l, r) <- getRectangle-        let dropOutside = fmap (T.take (r - l) . T.drop l)-        R.withText (unlines' . dropOutside . lines') <$> readRegionB reg--paste :: EditorM ()-paste = do-  asRect <- withCurrentBuffer (use rectangleSelectionA)-  if asRect-    then yankRectangle-    else withCurrentBuffer . replaceSel =<< getRegE--moveKeys :: [(Event, BufferM ())]-moveKeys = [- (spec KHome          , maybeMoveB Line Backward),- (spec KEnd           , maybeMoveB Line Forward),- (super (spec KRight) , maybeMoveB Line Forward),- (super (spec KLeft ) , maybeMoveB Line Backward),- (ctrl (spec KHome)   , maybeMoveB Document Backward),- (ctrl (spec KEnd)    , maybeMoveB Document Forward),- (super (spec KUp)    , maybeMoveB Document Backward),- (super (spec KDown)  , maybeMoveB Document Forward),- (ctrl (spec KRight)  , moveB unitWord Forward),- (ctrl (spec KLeft )  , moveB unitWord Backward),- (spec KUp            , moveB VLine Backward),- (spec KDown          , moveB VLine Forward),- (spec KRight         , moveB Character Forward),- (spec KLeft          , moveB Character Backward)- ]---move, select, rect :: Keymap-other :: (Event -> Event) -> Keymap--move   = choice [            k  ?>>! unsetMark       >> a | (k,a) <- moveKeys]-select = choice [      shift k  ?>>!   setMark False >> a | (k,a) <- moveKeys]-rect   = choice [meta (shift k) ?>>!   setMark True  >> a | (k,a) <- moveKeys]-other  cmd = choice [- spec KBS         ?>>! deleteSel bdeleteB,- spec KDel        ?>>! deleteSel (deleteN 1),- spec KEnter      ?>>! replaceSel $ R.singleton '\n',- cmd (char 'q')   ?>>! askQuitEditor,- cmd (char 'f')   ?>>  isearchKeymap Forward,- cmd (char 'x')   ?>>! cut,- cmd (char 'c')   ?>>! copy,- cmd (char 'v')   ?>>! paste,- cmd (spec KIns)  ?>>! copy,- shift (spec KIns) ?>>! paste,- cmd (char 'z')   ?>>! undoB,- cmd (char 'y')   ?>>! redoB,- cmd (char 's')   ?>>! fwriteE,- cmd (char 'o')   ?>>! findFile,- cmd (char '/')   ?>>! commentRegion,- cmd (char ']')   ?>>! autoIndentB IncreaseOnly,- cmd (char '[')   ?>>! autoIndentB DecreaseOnly,- cmd (char 'a')   ?>>! selectAll- ]
− src/library/Yi/Keymap/Emacs.hs 
@@ -1,282 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UnicodeSyntax #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Emacs--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ This module aims at a mode that should be (mostly) intuitive to--- emacs users, but mapping things into the Yi world when convenient.--- Hence, do not go into the trouble of trying 100% emulation. For--- example, @M-x@ gives access to Yi (Haskell) functions, with their--- native names.--module Yi.Keymap.Emacs ( keymap-                       , mkKeymap-                       , defKeymap-                       , ModeMap(..)-                       , eKeymap-                       , completionCaseSensitive-                       ) where--import Control.Applicative-import Control.Lens-import Control.Monad-import Data.Char-import Data.Maybe-import Data.Prototype-import Data.Text ()-import Yi.Buffer-import Yi.Command (shellCommandE)-import Yi.Core (closeWindow, runAction, suspendEditor, userForceRefresh, withSyntax)-import Yi.Dired-import Yi.Editor-import Yi.File-import Yi.Keymap-import Yi.Keymap.Emacs.KillRing-import Yi.Keymap.Emacs.Utils-  (askQuitEditor, evalRegionE, executeExtendedCommandE, findFile,-   findFileNewTab, promptFile, insertNextC, isearchKeymap, killBufferE,-   queryReplaceE, readUniversalArg, scrollDownE, scrollUpE, switchBufferE,-   askSaveEditor, argToInt, promptTag, justOneSep, joinLinesE, countWordsRegion,-   findFileReadOnly)-import Yi.Keymap.Keys-import Yi.MiniBuffer-import Yi.Misc (adjBlock, adjIndent, selectAll, placeMark)-import Yi.Mode.Buffers ( listBuffers )-import Yi.Rectangle-import Yi.Search (isearchFinishWithE, resetRegexE)-import Yi.TextCompletion--data ModeMap = ModeMap { _eKeymap :: Keymap-                       , _completionCaseSensitive :: Bool-                       }--$(makeLenses ''ModeMap)--keymap :: KeymapSet-keymap = mkKeymap defKeymap--mkKeymap :: Proto ModeMap -> KeymapSet-mkKeymap = modelessKeymapSet . _eKeymap . extractValue--defKeymap :: Proto ModeMap-defKeymap = Proto template-  where-    template self = ModeMap { _eKeymap = emacsKeymap-                            , _completionCaseSensitive = False }-      where-        emacsKeymap :: Keymap-        emacsKeymap = selfInsertKeymap Nothing isDigit <|> completionKm (_completionCaseSensitive self) <|>-             do univArg <- readUniversalArg-                selfInsertKeymap univArg (not . isDigit) <|> emacsKeys univArg--selfInsertKeymap :: Maybe Int -> (Char -> Bool) -> Keymap-selfInsertKeymap univArg condition = do-  c <- printableChar-  unless (condition c) empty-  let n = argToInt univArg-  write (adjBlock n >> replicateM_ n (insertB c))--completionKm :: Bool -> Keymap-completionKm caseSensitive = do void $ some (meta (char '/') ?>>! wordComplete' caseSensitive)-                                deprioritize-                                write resetComplete-           -- 'adjustPriority' is there to lift the ambiguity between "continuing" completion-           -- and resetting it (restarting at the 1st completion).--deleteB' :: BufferM ()-deleteB' = adjBlock (-1) >> deleteN 1---- | Wrapper around 'moveE' which also cancels incremental search. See--- issue #499 for details.-moveE ∷ TextUnit → Direction → EditorM ()-moveE u d = isearchFinishWithE resetRegexE >> withCurrentBuffer (moveB u d)--emacsKeys :: Maybe Int -> Keymap-emacsKeys univArg =-  choice [ -- First all the special key bindings-           spec KTab            ?>>! adjIndent IncreaseCycle-         , shift (spec KTab)    ?>>! adjIndent DecreaseCycle-         , spec KEnter          ?>>! repeatingArg newlineB-         , spec KDel            ?>>! repeatingArg (blockKillring >> deleteB')-         , spec KBS             ?>>! repeatingArg (blockKillring >>-                                                    adjBlock (-1) >>-                                                    bdeleteB)-         , spec KHome           ?>>! repeatingArg moveToSol-         , spec KEnd            ?>>! repeatingArg moveToEol-         , spec KLeft           ?>>! repeatingArg leftB-         , spec KRight          ?>>! repeatingArg rightB-         , spec KUp             ?>>! repeatingArg $ moveE VLine Backward-         , spec KDown           ?>>! repeatingArg $ moveE VLine Forward-         , spec KPageDown       ?>>! repeatingArg downScreenB-         , spec KPageUp         ?>>! repeatingArg upScreenB--         , shift (spec KUp)     ?>>! repeatingArg (scrollB (-1))-         , shift (spec KDown)   ?>>! repeatingArg (scrollB 1)--         -- All the keybindings of the form 'Ctrl + special key'-         , ctrl (spec KLeft)    ?>>! repeatingArg prevWordB-         , ctrl (spec KRight)   ?>>! repeatingArg nextWordB-         , ctrl (spec KHome)    ?>>! repeatingArg topB-         , ctrl (spec KEnd)     ?>>! repeatingArg botB-         , ctrl (spec KUp)      ?>>! repeatingArg (prevNParagraphs 1)-         , ctrl (spec KDown)    ?>>! repeatingArg (nextNParagraphs 1)--         -- All the keybindings of the form "C-c" where 'c' is some character-         , ctrlCh '@'           ?>>! placeMark-         , ctrlCh ' '           ?>>! placeMark-         , ctrlCh '/'           ?>>! repeatingArg undoB-         , ctrlCh '_'           ?>>! repeatingArg undoB-         , ctrlCh 'a'           ?>>! repeatingArg (maybeMoveB Line Backward)-         , ctrlCh 'b'           ?>>! repeatingArg leftB-         , ctrlCh 'd'           ?>>! repeatingArg (blockKillring >> deleteB')-         , ctrlCh 'e'           ?>>! repeatingArg (maybeMoveB Line Forward)-         , ctrlCh 'f'           ?>>! repeatingArg rightB-         , ctrlCh 'g'           ?>>! setVisibleSelection False-         , ctrlCh 'h'           ?>> char 'b' ?>>! acceptedInputsOtherWindow-         , ctrlCh 'i'           ?>>! adjIndent IncreaseOnly-         , ctrlCh 'j'           ?>>! newlineAndIndentB-         , ctrlCh 'k'           ?>>! killLineE univArg-         , ctrlCh 'l'           ?>>! (withCurrentBuffer scrollToCursorB >> userForceRefresh)-         , ctrlCh 'm'           ?>>! repeatingArg (insertB '\n')-         , ctrlCh 'n'           ?>>! repeatingArg (moveE VLine Forward)-         , ctrlCh 'o'           ?>>! repeatingArg (insertB '\n' >> leftB)-         , ctrlCh 'p'           ?>>! repeatingArg (moveE VLine Backward)-         , ctrlCh 'q'           ?>>  insertNextC univArg-         , ctrlCh 'r'           ?>>  isearchKeymap Backward-         , ctrlCh 's'           ?>>  isearchKeymap Forward-         , ctrlCh 't'           ?>>! repeatingArg swapB-         , ctrlCh 'v'           ?>>! scrollDownE univArg-         , ctrlCh 'w'           ?>>! killRegion-         , ctrlCh 'y'           ?>>! yankE-         , ctrlCh 'z'           ?>>! suspendEditor-         , ctrlCh '+'           ?>>! repeatingArg (increaseFontSize 1)-         , ctrlCh '-'           ?>>! repeatingArg (decreaseFontSize 1)--         -- All the keybindings of the form "C-M-c" where 'c' is some character-         , ctrl (metaCh 'w')    ?>>! appendNextKillE-         , ctrl (metaCh ' ')    ?>>! layoutManagersNextE-         , ctrl (metaCh ',')    ?>>! layoutManagerNextVariantE-         , ctrl (metaCh '.')    ?>>! layoutManagerPreviousVariantE-         , ctrl (metaCh 'j')    ?>>! nextWinE-         , ctrl (metaCh 'k')    ?>>! prevWinE-         , ctrl (meta $ spec KEnter) ?>>! swapWinWithFirstE----- All the keybindings of the form "S-C-M-c" where 'c' is some key-         , shift (ctrl $ metaCh 'j') ?>>! moveWinNextE-         , shift (ctrl $ metaCh 'k') ?>>! moveWinPrevE-         , shift (ctrl $ meta $ spec KEnter) ?>>! pushWinToFirstE-         , Event (KASCII ' ') [MShift,MCtrl,MMeta] ?>>! layoutManagersPreviousE--         -- All the key-bindings which are preceded by a 'C-x'-         , ctrlCh 'x' ?>>      ctrlX--         , ctrlCh 'c' ?>>      ctrlC--         -- All The key-bindings of the form M-c where 'c' is some character.-         , metaCh ' '           ?>>! justOneSep-         , metaCh 'v'           ?>>! scrollUpE univArg-         , metaCh '!'           ?>>! shellCommandE-         , metaCh '<'           ?>>! repeatingArg topB-         , metaCh '>'           ?>>! repeatingArg botB-         , metaCh '%'           ?>>! queryReplaceE-         , metaCh '^'           ?>>! joinLinesE univArg-         , metaCh ';'           ?>>! commentRegion-         , metaCh 'a'           ?>>! repeatingArg (moveE unitSentence Backward)-         , metaCh 'b'           ?>>! repeatingArg prevWordB-         , metaCh 'c'           ?>>! repeatingArg capitaliseWordB-         , metaCh 'd'           ?>>! repeatingArg killWordB-         , metaCh 'e'           ?>>! repeatingArg (moveE unitSentence Forward)-         , metaCh 'f'           ?>>! repeatingArg nextWordB-         , metaCh 'h'           ?>>! (setSelectRegionB =<< regionOfB unitParagraph)-         , metaCh 'k'           ?>>! repeatingArg (deleteB unitSentence Forward)-         , metaCh 'l'           ?>>! repeatingArg lowercaseWordB-         , metaCh 'm'           ?>>! firstNonSpaceB-         , metaCh 'q'           ?>>! withSyntax modePrettify-         , metaCh 'u'           ?>>! repeatingArg uppercaseWordB-         , metaCh 't'           ?>>! repeatingArg (transposeB unitWord Forward)-         , metaCh 'w'           ?>>! killRingSaveE-         , metaCh 'x'           ?>>! executeExtendedCommandE-         , metaCh 'y'           ?>>! yankPopE-         , metaCh '.'           ?>>! promptTag-         , metaCh '{'           ?>>! repeatingArg (prevNParagraphs 1)-         , metaCh '}'           ?>>! repeatingArg (nextNParagraphs 1)-         , metaCh '='           ?>>! countWordsRegion-         , metaCh '\\'          ?>>! deleteHorizontalSpaceB univArg--         -- Other meta key-bindings-         , meta (spec KBS)      ?>>! repeatingArg bkillWordB-         , metaCh 'g' ?>>-             optMod meta (char 'g') >>! (gotoLn . fromDoc :: Int ::: LineNumber -> BufferM Int)-         ]-  where-  -- inserting the empty string prevents the deletion from appearing in the killring-  -- which is a good thing when we are deleting individuals characters. See-  -- http://code.google.com/p/yi-editor/issues/detail?id=212-  blockKillring = insertN ""--  withUnivArg :: YiAction (m ()) () => (Maybe Int -> m ()) -> YiM ()-  withUnivArg cmd = runAction $ makeAction (cmd univArg)--  repeatingArg :: (Monad m, YiAction (m ()) ()) => m () -> YiM ()-  repeatingArg f = withIntArg $ \n -> replicateM_ n f--  withIntArg :: YiAction (m ()) () => (Int -> m ()) -> YiM ()-  withIntArg cmd = withUnivArg $ \arg -> cmd (fromMaybe 1 arg)---  ctrlC = choice [ ctrlCh 'c' ?>>! commentRegion ]---  rectangleFunctions = choice [ char 'a' ?>>! alignRegionOn-                              , char 'o' ?>>! openRectangle-                              , char 't' ?>>! stringRectangle-                              , char 'k' ?>>! killRectangle-                              , char 'y' ?>>! yankRectangle-                              ]--  tabFunctions :: Keymap-  tabFunctions = choice [ optMod ctrl (char 'n') >>! nextTabE-                        , optMod ctrl (char 'p') >>! previousTabE-                        , optMod ctrl (char 't') >>! newTabE-                        , optMod ctrl (char 'e') >>! findFileNewTab-                        , optMod ctrl (char 'd') >>! deleteTabE-                        , charOf id '0' '9' >>=! moveTabE . Just . digitToInt-                        ]-  -- These keybindings are all preceded by a 'C-x' so for example to-  -- quit the editor we do a 'C-x C-c'-  ctrlX = choice [ ctrlCh 'o'    ?>>! deleteBlankLinesB-                 , char '0'      ?>>! closeWindow-                 , char '1'      ?>>! closeOtherE-                 , char '2'      ?>>! splitE-                 , char 'h'      ?>>! selectAll-                 , char 's'      ?>>! askSaveEditor-                 , ctrlCh 'b'    ?>>! listBuffers-                 , ctrlCh 'c'    ?>>! askQuitEditor-                 , ctrlCh 'f'    ?>>! findFile-                 , ctrlCh 'r'    ?>>! findFileReadOnly-                 , ctrlCh 'q'    ?>>!-                     ((withCurrentBuffer (readOnlyA %= not)) :: EditorM ())-                 , ctrlCh 's'    ?>>! fwriteE-                 , ctrlCh 'w'    ?>>! promptFile "Write file:" fwriteToE-                 , ctrlCh 'x'    ?>>! (exchangePointAndMarkB >>-                                       assign highlightSelectionA True)-                 , char 'b'      ?>>! switchBufferE-                 , char 'd'      ?>>! dired-                 , char 'e' ?>>-                   char 'e'      ?>>! evalRegionE-                 , char 'o'      ?>>! nextWinE-                 , char 'k'      ?>>! killBufferE-                 , char 'r'      ?>>  rectangleFunctions-                 , char 'u'      ?>>! repeatingArg undoB-                 , optMod ctrl (char 't') >> tabFunctions-                 ]
− src/library/Yi/Keymap/Emacs/KillRing.hs 
@@ -1,77 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Emacs.KillRing--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Emacs.KillRing where--import           Control.Lens-import           Control.Monad (replicateM_)-import           Data.List.NonEmpty-import           Prelude hiding (tail, head)-import           Yi.Buffer-import           Yi.Editor-import           Yi.Keymap-import           Yi.KillRing-import qualified Yi.Rope as R---- * Killring actions----- | C-w------ This is like @kill-region-or-backward-word@.-killRegion :: BufferM ()-killRegion = getSelectRegionB >>= \r ->-  if regionStart r == regionEnd r then bkillWordB else deleteRegionB r---- | C-k-killLineE :: Maybe Int -> YiM ()-killLineE Nothing  = withCurrentBuffer killRestOfLine-killLineE (Just n) = withCurrentBuffer $ replicateM_ (2*n) killRestOfLine--killringPut :: Direction -> R.YiString -> EditorM ()-killringPut dir s = killringA %= krPut dir s---- | Kill the rest of line-killRestOfLine :: BufferM ()-killRestOfLine =-    do eol <- atEol-       if eol then deleteN 1 else deleteToEol---- | C-y-yankE :: EditorM ()-yankE = do-  text :| _ <- uses killringA _krContents-  withCurrentBuffer $ pointB >>= setSelectionMarkPointB >> insertN text---- | M-w-killRingSaveE :: EditorM ()-killRingSaveE = do-  (r, text) <- withCurrentBuffer $ do-    r <- getSelectRegionB-    text <- readRegionB r-    assign highlightSelectionA False-    return (r, text)-  killringPut (regionDirection r) text--- | M-y---- TODO: Handle argument, verify last command was a yank-yankPopE :: EditorM ()-yankPopE = do-  kr <- use killringA-  withCurrentBuffer (deleteRegionB =<< getRawestSelectRegionB)-  killringA .= let x :| xs = _krContents kr-               in kr { _krContents = case xs of-                          [] -> x :| []-                          y:ys -> y :| ys ++ [x]-                     }-  yankE---- | C-M-w-appendNextKillE :: EditorM ()-appendNextKillE = killringA . krKilled .= True
− src/library/Yi/Keymap/Emacs/Utils.hs 
@@ -1,433 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Emacs.Utils--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ This module is aimed at being a helper for the Emacs keybindings.--- In particular this should be useful for anyone that has a custom--- keymap derived from or based on the Emacs one.--module Yi.Keymap.Emacs.Utils-  ( UnivArgument-  , argToInt-  , askQuitEditor-  , askSaveEditor-  , modifiedQuitEditor-  , withMinibuffer-  , queryReplaceE-  , isearchKeymap-  , cabalConfigureE-  , cabalBuildE-  , reloadProjectE-  , executeExtendedCommandE-  , evalRegionE-  , readUniversalArg-  , scrollDownE-  , scrollUpE-  , switchBufferE-  , killBufferE-  , insertNextC-  , findFile-  , findFileReadOnly-  , findFileNewTab-  , promptFile-  , promptTag-  , justOneSep-  , joinLinesE-  , countWordsRegion-  )-where--import           Control.Applicative-import           Control.Lens hiding (re,act)-import           Control.Monad-import           Control.Monad.Base-import           Data.List ((\\))-import           Data.Maybe (fromMaybe)-import           Data.Monoid-import qualified Data.Text as T-import           System.Directory (doesDirectoryExist)-import           System.FilePath (takeDirectory, takeFileName, (</>))-import           System.FriendlyPath ()-import           Yi.Buffer-import           Yi.Command (cabalConfigureE, cabalBuildE, reloadProjectE)-import           Yi.Core (quitEditor)-import           Yi.Editor-import           Yi.Eval-import           Yi.File-import           Yi.Keymap-import           Yi.Keymap.Keys-import           Yi.MiniBuffer-import           Yi.Misc (promptFile)-import           Yi.Monad-import           Yi.Rectangle-import           Yi.Regex-import qualified Yi.Rope as R-import           Yi.Search-import           Yi.String-import           Yi.Tag-import           Yi.Utils--type UnivArgument = Maybe Int--------------------------------- | Quits the editor if there are no unmodified buffers--- if there are unmodified buffers then we ask individually for--- each modified buffer whether or not the user wishes to save--- it or not. If we get to the end of this list and there are still--- some modified buffers then we ask again if the user wishes to--- quit, but this is then a simple yes or no.-askQuitEditor :: YiM ()-askQuitEditor = askIndividualSave True =<< getModifiedBuffers--askSaveEditor :: YiM ()-askSaveEditor = askIndividualSave False =<< getModifiedBuffers--getModifiedBuffers :: YiM [FBuffer]-getModifiedBuffers = filterM deservesSave =<< gets bufferSet--deservesSave :: FBuffer -> YiM Bool-deservesSave b-   | isUnchangedBuffer b = return False-   | otherwise = isFileBuffer b---- | Is there a proper file associated with the buffer?--- In other words, does it make sense to offer to save it?-isFileBuffer :: (Functor m, MonadBase IO m) => FBuffer -> m Bool-isFileBuffer b = case b ^. identA of-  MemBuffer _ -> return False-  FileBuffer fn -> not <$> liftBase (doesDirectoryExist fn)------------------------------------------------------- Takes in a list of buffers which have been identified--- as modified since their last save.--askIndividualSave :: Bool -> [FBuffer] -> YiM ()-askIndividualSave True []  = modifiedQuitEditor-askIndividualSave False [] = return ()-askIndividualSave hasQuit allBuffers@(firstBuffer : others) =-  void (withEditor (spawnMinibufferE saveMessage (const askKeymap)))-  where-  saveMessage = T.concat [ "do you want to save the buffer: "-                         , bufferName-                         , "? (y/n/", if hasQuit then "q/" else "", "c/!)"-                         ]-  bufferName  = identString firstBuffer--  askKeymap = choice ([ char 'n' ?>>! noAction-                      , char 'y' ?>>! yesAction-                      , char '!' ?>>! allAction-                      , oneOf [char 'c', ctrl $ char 'g']-                        >>! closeBufferAndWindowE-                        -- cancel-                      ] ++ [char 'q' ?>>! quitEditor | hasQuit])-  yesAction = do fwriteBufferE (bkey firstBuffer)-                 withEditor closeBufferAndWindowE-                 continue--  noAction = do withEditor closeBufferAndWindowE-                continue--  allAction = do mapM_ fwriteBufferE $ fmap bkey allBuffers-                 withEditor closeBufferAndWindowE-                 askIndividualSave hasQuit []--  continue = askIndividualSave hasQuit others------------------------------------------------------------- | Quits the editor if there are no unmodified buffers--- if there are then simply confirms with the user that they--- with to quit.-modifiedQuitEditor :: YiM ()-modifiedQuitEditor =-  do modifiedBuffers <- getModifiedBuffers-     if null modifiedBuffers-        then quitEditor-        else withEditor $ void (spawnMinibufferE modifiedMessage (const askKeymap))-  where-  modifiedMessage = "Modified buffers exist really quit? (y/n)"--  askKeymap = choice [ char 'n' ?>>! noAction-                     , char 'y' ?>>! quitEditor-                     ]--  noAction        = closeBufferAndWindowE---------------------------------- isearch-selfSearchKeymap :: Keymap-selfSearchKeymap = do-  Event (KASCII c) [] <- anyEvent-  write . isearchAddE $ T.singleton c--searchKeymap :: Keymap-searchKeymap = selfSearchKeymap <|> choice-               [ -- ("C-g", isearchDelE) -- Only if string is not empty.-                 ctrl (char 'r') ?>>! isearchPrevE-               , ctrl (char 's') ?>>! isearchNextE-               , ctrl (char 'w') ?>>! isearchWordE-               , meta (char 'p') ?>>! isearchHistory 1-               , meta (char 'n') ?>>! isearchHistory (-1)-               , spec KBS        ?>>! isearchDelE-               ]--isearchKeymap :: Direction -> Keymap-isearchKeymap dir =-  do write $ isearchInitE dir-     void $ many searchKeymap-     choice [ ctrl (char 'g') ?>>! isearchCancelE-            , oneOf [ctrl (char 'm'), spec KEnter]-              >>! isearchFinishWithE resetRegexE-            ]-       <|| write isearchFinishE--------------------------------- query-replace-queryReplaceE :: YiM ()-queryReplaceE = withMinibufferFree "Replace:" $ \replaceWhat ->-  withMinibufferFree "With:" $ \replaceWith -> do-    b <- gets currentBuffer-    win <- use currentWindowA-    let repStr = R.fromText replaceWith-        replaceKm =-          choice [ char 'n'                  ?>>! qrNext win b re-                 , char '!'                  ?>>! qrReplaceAll win b re repStr-                 , oneOf [char 'y', char ' '] >>! qrReplaceOne win b re repStr-                 , oneOf [char 'q', ctrl (char 'g')] >>! qrFinish-                 ]-        -- TODO: Yi.Regex to Text-        Right re = makeSearchOptsM [] (T.unpack replaceWhat)-        question = T.unwords [ "Replacing", replaceWhat-                             , "with", replaceWith, " (y,n,q,!):"-                             ]-    withEditor $ do-      setRegexE re-      void $ spawnMinibufferE question (const replaceKm)-      qrNext win b re---executeExtendedCommandE :: YiM ()-executeExtendedCommandE = withMinibuffer "M-x" scope act-  where-    act = execEditorAction . T.unpack-    scope = const $ map T.pack <$> getAllNamesInScope--evalRegionE :: YiM ()-evalRegionE = do-  -- FIXME: do something sensible.-  void $ withCurrentBuffer (getSelectRegionB >>= readRegionB)-  return ()---- * Code for various commands--- This ideally should be put in their own module,--- without a prefix, so M-x ... would be easily implemented--- by looking up that module's contents---- | Insert next character, "raw"-insertNextC :: UnivArgument -> KeymapM ()-insertNextC a = do c <- anyEvent-                   write $ replicateM_ (argToInt a) $ insertB (eventToChar c)---- | Convert the universal argument to a number of repetitions-argToInt :: UnivArgument -> Int-argToInt = fromMaybe 1---digit :: (Event -> Event) -> KeymapM Char-digit f = charOf f '0' '9'---- TODO: replace tt by digit meta-tt :: KeymapM Char-tt = do-  Event (KASCII c) _ <- foldr1 (<|>) $ fmap (event . metaCh ) ['0'..'9']-  return c----- doing the argument precisely is kind of tedious.--- read: http://www.gnu.org/software/emacs/manual/html_node/Arguments.html--- and: http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_318.html-readUniversalArg :: KeymapM (Maybe Int)-readUniversalArg = optional ((ctrlCh 'u' ?>> (read <$> some (digit id) <|> pure 4)) <|> (read <$> some tt))----- | Finds file and runs specified action on the resulting buffer-findFileAndDo :: T.Text -- ^ Prompt-              -> (BufferRef -> YiM a) -- ^ Action to run on the resulting buffer-              -> YiM ()-findFileAndDo prompt act = promptFile prompt $ \filename -> do-  (withEditor . printMsg) $ "loading " <> filename-  void $ editFile (T.unpack filename) >>= act---- | Open a file using the minibuffer. We have to set up some stuff to--- allow hints and auto-completion.-findFile :: YiM ()-findFile = findFileAndDo "find file:" return---- | Like 'findFile' but sets the resulting buffer to read-only.-findFileReadOnly :: YiM ()-findFileReadOnly = findFileAndDo "find file (read only):" $ \b ->-  withGivenBuffer b (readOnlyA .= True)---- | Open a file in a new tab using the minibuffer.-findFileNewTab :: YiM ()-findFileNewTab = promptFile "find file (new tab): " $ \filename -> do-  withEditor newTabE-  (withEditor . printMsg) $ "loading " <> filename-  void . editFile $ T.unpack filename---scrollDownE :: UnivArgument -> BufferM ()-scrollDownE a = case a of-                 Nothing -> downScreenB-                 Just n -> scrollB n--scrollUpE :: UnivArgument -> BufferM ()-scrollUpE a = case a of-                 Nothing -> upScreenB-                 Just n -> scrollB (negate n)---- | Prompts the user for a buffer name and switches to the chosen buffer.-switchBufferE :: YiM ()-switchBufferE = promptingForBuffer "switch to buffer:"-                  (withEditor . switchToBufferE) (\o b -> (b \\ o) ++ o)----- | Prompts the user for a buffer name and kills the chosen buffer.--- Prompts about really closing if the buffer is marked as changed--- since last save.-killBufferE :: YiM ()-killBufferE = promptingForBuffer "kill buffer:" k (\o b -> o ++ (b \\ o))-  where-    k :: BufferRef -> YiM ()-    k b = do-      buf <- withEditor . gets $ findBufferWith b-      ch <- deservesSave buf-      let askKeymap = choice [ char 'n' ?>>! closeBufferAndWindowE-                             , char 'y' ?>>! delBuf >> closeBufferAndWindowE-                             , ctrlCh 'g' ?>>! closeBufferAndWindowE-                             ]-          delBuf = deleteBuffer b-          question = identString buf <> " changed, close anyway? (y/n)"-      withEditor $-         if ch-         then void $ spawnMinibufferE question (const askKeymap)-         else delBuf----- | If on separators (space, tab, unicode seps), reduce multiple--- separators to just a single separator. If we aren't looking at a separator,--- insert a single space. This kind of behaves as emacs ‘just-one-space’--- function with the argument of ‘1’ but it prefers to use the separator we're--- looking at instead of assuming a space.-justOneSep :: BufferM ()-justOneSep = readB >>= \c ->-  pointB >>= \point -> case point of-    Point 0 -> if isAnySep c then deleteSeparators else insertB ' '-    Point x ->-      if isAnySep c-      then deleteSeparators-      else readAtB (Point $ x - 1) >>= \d ->-        -- We weren't looking at separator but there might be one behind us-        if isAnySep d-          then moveB Character Backward >> deleteSeparators-          else insertB ' ' -- no separators, insert a space just like emacs does-  where-    deleteSeparators = do-      genMaybeMoveB unitSepThisLine (Backward, InsideBound) Backward-      moveB Character Forward-      doIfCharB isAnySep $ deleteB unitSepThisLine Forward------ | Join this line to previous (or next N if universal)-joinLinesE :: UnivArgument -> BufferM ()-joinLinesE Nothing = return ()-joinLinesE (Just _) = do-  moveB VLine Forward-  moveToSol >> transformB (const " ") Character Backward >> justOneSep---- | Shortcut to use a default list when a blank list is given.--- Used for default values to emacs queries-maybeList :: [a] -> [a] -> [a]-maybeList def [] = def-maybeList _   ls = ls--maybeTag :: Tag -> T.Text -> Tag-maybeTag def t = if T.null t then def else Tag t------------------------------------------------------- TAGS - See Yi.Tag for more info---- | Prompt the user to give a tag and then jump to that tag-promptTag :: YiM ()-promptTag = do-  -- default tag is where the buffer is on-  defaultTag <- withCurrentBuffer $ Tag . R.toText <$> readUnitB unitWord-  -- if we have tags use them to generate hints-  tagTable <- withEditor getTags-  -- Hints are expensive - only lazily generate 10-  let hinter =  return . take 10 . maybe (fail . T.unpack) hintTags tagTable-  -- Completions are super-cheap. Go wild-  let completer =  return . maybe id completeTag tagTable-      p = "Find tag: (default " <> _unTag defaultTag `T.snoc` ')'-  withMinibufferGen "" hinter p completer (const $ return ()) $-    -- if the string is "" use the defaultTag-    gotoTag . maybeTag defaultTag---- | Opens the file that contains @tag@. Uses the global tag table and prompts--- the user to open one if it does not exist-gotoTag :: Tag -> YiM ()-gotoTag tag =-    visitTagTable $ \tagTable ->-        case lookupTag tag tagTable of-          Nothing -> fail $ "No tags containing " ++ unTag' tag-          Just (filename, line) -> do-            void $ editFile filename-            void $ withCurrentBuffer $ gotoLn line-            return ()---- | Call continuation @act@ with the TagTable. Uses the global table--- and prompts the user if it doesn't exist-visitTagTable :: (TagTable -> YiM ()) -> YiM ()-visitTagTable act = do-  posTagTable <- withEditor getTags-  -- does the tagtable exist?-  case posTagTable of-    Just tagTable -> act tagTable-    Nothing -> promptFile "Visit tags table: (default tags)" $ \path -> do-      -- default emacs behavior, append tags-        let p = T.unpack path-            filename = maybeList "tags" $ takeFileName p-        tagTable <- io $ importTagTable $ takeDirectory p </> filename-        withEditor $ setTags tagTable-        act tagTable---- TODO: use TextUnit to count things inside region for better experience--- | Counts the number of lines, words and characters inside selected--- region. Coresponds to emacs' @count-words-region@.-countWordsRegion :: YiM ()-countWordsRegion = do-  (l, w, c) <- withEditor $ do-    t <- withCurrentBuffer $ getRectangle >>= \(reg, _, _) -> readRegionB reg-    let nls = R.countNewLines t-    return (if nls == 0 then 1 else nls, length $ R.words t, R.length t)-  (withEditor . printMsg) $ T.unwords [ "Region has", showT l, p l "line" <> ","-                        , showT w, p w "word" <> ", and"-                        , showT c, p w "character" <> "."-                        ]-  where-    p x w = if x == 1 then w else w <> "s"
− src/library/Yi/Keymap/Keys.hs 
@@ -1,124 +0,0 @@-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Keys--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Combinators for building keymaps.--module Yi.Keymap.Keys-    (-     module Yi.Event,-     module Yi.Interact,-     printableChar, textChar,-     charOf, shift, meta, ctrl, super, hyper, spec, char,-     (>>!), (>>=!), (?>>), (?>>!), (?*>>), (?*>>!),-     ctrlCh, metaCh, hyperCh,-     optMod,-     pString-    ) where--import Prelude hiding (error)--import Control.Monad (unless)-import Data.Char-import Data.List (sort, nub)--import Yi.Event-import Yi.Debug-import Yi.Keymap-import Yi.Interact hiding (write)--printableChar :: (MonadInteract m w Event) => m Char-printableChar = do-  Event (KASCII c) [] <- anyEvent-  unless (isPrint c) $-       fail "unprintable character"-  return c---- | Parse any character that can be inserted in the text.-textChar :: KeymapM Char-textChar = do-    -- Why only ASCII?-    Event (KASCII c) [] <- anyEvent-    return c--pString :: (MonadInteract m w Event) => String -> m [Event]-pString = events . map char--charOf :: (MonadInteract m w Event) => (Event -> Event) -> Char -> Char -> m Char-charOf modifier l h =-    do Event (KASCII c) _ <- eventBetween (modifier $ char l) (modifier $ char h)-       return c--shift,ctrl,meta,super,hyper :: Event -> Event-shift (Event (KASCII c) ms) | isAlpha c = Event (KASCII (toUpper c)) ms-                            | otherwise = error "shift: unhandled event"-shift (Event k ms) = Event k $ nub $ sort (MShift:ms)--ctrl (Event k ms) = Event k $ nub $ sort (MCtrl:ms)--meta (Event k ms) = Event k $ nub $ sort (MMeta:ms)--super (Event k ms) = Event k $ nub $ sort (MSuper:ms)--hyper (Event k ms) = Event k $ nub $ sort (MHyper:ms)--char :: Char -> Event-char '\t' = Event KTab []-char '\r' = Event KEnter []-char '\n' = Event KEnter []-char c = Event (KASCII c) []--ctrlCh :: Char -> Event-ctrlCh = ctrl . char--metaCh :: Char -> Event-metaCh = meta . char--hyperCh :: Char -> Event-hyperCh = hyper . char---- | @optMod f ev@ produces a 'MonadInteract' that consumes @ev@ or @f ev@-optMod ::(MonadInteract m w Event) => (Event -> Event) -> Event -> m Event-optMod f ev = oneOf [ev, f ev]---- | Convert a special key into an event-spec :: Key -> Event-spec k = Event k []---- | > p >>! act = p >> 'write' act-(>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => m b -> a -> m ()-p >>! act = p >> write act---- | > p >>=! act = p >>= 'write' . act-(>>=!) :: (MonadInteract m Action Event, YiAction a x, Show x) => m b -> (b -> a) -> m ()-p >>=! act = p >>= write . act---- | @ ev ?>> proc = 'event' ev >> proc @-(?>>) :: (MonadInteract m action Event) => Event -> m a -> m a-ev ?>> proc = event ev >> proc---- | @ ev ?>>! act = 'event' ev >> 'write' act @-(?>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m ()-ev ?>>! act = event ev >> write act---- | @ ev ?*>> proc = 'events' ev >> proc @-(?*>>) :: (MonadInteract m action Event) => [Event] -> m a -> m a-ev ?*>> proc = events ev >> proc---- | @ ev ?*>>! act = 'events' ev >> 'write' act @-(?*>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => [Event] -> a -> m ()-ev ?*>>! act = events ev >> write act--infixl 1 >>!-infixl 1 >>=!-infixr 0 ?>>!-infixr 0 ?>>-infixr 0 ?*>>!-infixr 0 ?*>>
− src/library/Yi/Keymap/Vim.hs 
@@ -1,192 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ The vim keymap.--module Yi.Keymap.Vim-    ( keymapSet-    , mkKeymapSet-    , defVimConfig-    , VimBinding (..)-    , VimOperator (..)-    , VimConfig (..)-    , pureEval-    , impureEval-    , relayoutFromTo-    ) where--import Control.Applicative-import Data.Char (toUpper)-import Data.List (find)-import Data.Monoid-import Data.Prototype-import Yi.Buffer.Adjusted hiding (Insert)-import Yi.Editor-import Yi.Event-import Yi.Keymap-import Yi.Keymap.Keys (anyEvent)-import Yi.Keymap.Vim.Common-import Yi.Keymap.Vim.Digraph-import Yi.Keymap.Vim.EventUtils-import Yi.Keymap.Vim.Ex-import Yi.Keymap.Vim.ExMap-import Yi.Keymap.Vim.InsertMap-import Yi.Keymap.Vim.NormalMap-import Yi.Keymap.Vim.NormalOperatorPendingMap-import Yi.Keymap.Vim.Operator-import Yi.Keymap.Vim.ReplaceMap-import Yi.Keymap.Vim.ReplaceSingleCharMap-import Yi.Keymap.Vim.SearchMotionMap-import Yi.Keymap.Vim.StateUtils-import Yi.Keymap.Vim.Utils-import Yi.Keymap.Vim.VisualMap--data VimConfig = VimConfig {-    vimKeymap :: Keymap-  , vimBindings :: [VimBinding]-  , vimOperators :: [VimOperator]-  , vimExCommandParsers :: [EventString -> Maybe ExCommand]-  , vimDigraphs :: [(String, Char)]-  , vimRelayout :: Char -> Char-  }--mkKeymapSet :: Proto VimConfig -> KeymapSet-mkKeymapSet = modelessKeymapSet . vimKeymap . extractValue--keymapSet :: KeymapSet-keymapSet = mkKeymapSet defVimConfig--defVimConfig :: Proto VimConfig-defVimConfig = Proto $ \this -> VimConfig {-    vimKeymap = defVimKeymap this-  , vimBindings = concat-        [ defNormalMap (vimOperators this)-        , defNormalOperatorPendingMap (vimOperators this)-        , defExMap (vimExCommandParsers this)-        , defInsertMap (vimDigraphs this)-        , defReplaceSingleMap-        , defReplaceMap-        , defVisualMap (vimOperators this)-        , defSearchMotionMap-        ]-  , vimOperators = defOperators-  , vimExCommandParsers = defExCommandParsers-  , vimDigraphs = defDigraphs-  , vimRelayout = id-  }--defVimKeymap :: VimConfig -> KeymapM ()-defVimKeymap config = do-  e <- anyEvent-  write $ impureHandleEvent config e True---- This is not in Yi.Keymap.Vim.Eval to avoid circular dependency:--- eval needs to know about bindings, which contains normal bindings,--- which contains '.', which needs to eval things--- So as a workaround '.' just saves a string that needs eval in VimState--- and the actual evaluation happens in impureHandleEvent------ TODO: pass through untouched 'EventString' to 'parseEvents' instead--- of converting to 'String'.-pureEval :: VimConfig -> EventString -> EditorM ()-pureEval config = sequence_ . map (pureHandleEvent config) . parseEvents--impureEval :: VimConfig -> EventString -> Bool -> YiM ()-impureEval config s needsToConvertEvents = sequence_ actions-  where actions = map (\e -> impureHandleEvent config e needsToConvertEvents) $ parseEvents s--pureHandleEvent :: VimConfig -> Event -> EditorM ()-pureHandleEvent config ev-    = genericHandleEvent allPureBindings selectPureBinding config ev False--impureHandleEvent :: VimConfig -> Event -> Bool -> YiM ()-impureHandleEvent = genericHandleEvent vimBindings selectBinding--genericHandleEvent :: MonadEditor m => (VimConfig -> [VimBinding])-                   -> (EventString -> VimState -> [VimBinding]-                       -> MatchResult (m RepeatToken))-                   -> VimConfig-                   -> Event-                   -> Bool-                   -> m ()-genericHandleEvent getBindings pick config unconvertedEvent needsToConvertEvents = do-    currentState <- withEditor getEditorDyn-    let event = if needsToConvertEvents-                then convertEvent (vsMode currentState) (vimRelayout config) unconvertedEvent-                else unconvertedEvent-        evs = vsBindingAccumulator currentState <> eventToEventString event-        bindingMatch = pick evs currentState (getBindings config)-        prevMode = vsMode currentState--    case bindingMatch of-        NoMatch -> withEditor dropBindingAccumulatorE-        PartialMatch -> withEditor $ do-            accumulateBindingEventE event-            accumulateEventE event-        WholeMatch action -> do-            repeatToken <- action-            withEditor $ do-                dropBindingAccumulatorE-                accumulateEventE event-                case repeatToken of-                    Drop -> do-                        resetActiveRegisterE-                        dropAccumulatorE-                    Continue -> return ()-                    Finish -> do-                        resetActiveRegisterE-                        flushAccumulatorE--    withEditor $ do-        newMode <- vsMode <$> getEditorDyn--        -- TODO: we should introduce some hook mechanism like autocommands in vim-        case (prevMode, newMode) of-            (Insert _, Insert _) -> return ()-            (Insert _, _) -> withCurrentBuffer commitUpdateTransactionB-            (_, Insert _) -> withCurrentBuffer startUpdateTransactionB-            _ -> return ()--        performEvalIfNecessary config-        updateModeIndicatorE prevMode--performEvalIfNecessary :: VimConfig -> EditorM ()-performEvalIfNecessary config = do-    stateAfterAction <- getEditorDyn--    -- see comment for 'pureEval'-    modifyStateE $ \s -> s { vsStringToEval = mempty }-    pureEval config (vsStringToEval stateAfterAction)--allPureBindings :: VimConfig -> [VimBinding]-allPureBindings config = filter isPure $ vimBindings config-    where isPure (VimBindingE _) = True-          isPure _ = False--convertEvent :: VimMode -> (Char -> Char) -> Event -> Event-convertEvent (Insert _) f (Event (KASCII c) mods)-    | MCtrl `elem` mods || MMeta `elem` mods = Event (KASCII (f c)) mods-convertEvent Ex _ e = e-convertEvent (Insert _) _ e = e-convertEvent InsertNormal _ e = e-convertEvent InsertVisual _ e = e-convertEvent Replace _ e = e-convertEvent ReplaceSingleChar _ e = e-convertEvent (Search _ _) _ e = e-convertEvent _ f (Event (KASCII c) mods) = Event (KASCII (f c)) mods-convertEvent _ _ e = e--relayoutFromTo :: String -> String -> (Char -> Char)-relayoutFromTo keysFrom keysTo = \c ->-    maybe c fst (find ((== c) . snd)-                      (zip (keysTo ++ fmap toUpper' keysTo)-                           (keysFrom ++ fmap toUpper' keysFrom)))-    where toUpper' ';' = ':'-          toUpper' a = toUpper a
− src/library/Yi/Keymap/Vim/Common.hs 
@@ -1,209 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Common--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Common types used by the vim keymap.--module Yi.Keymap.Vim.Common-    ( VimMode(..)-    , VimBinding(..)-    , GotoCharCommand(..)-    , VimState(..)-    , Register(..)-    , RepeatToken(..)-    , RepeatableAction(..)-    , MatchResult(..)-    , EventString(..), unEv-    , OperatorName(..), unOp-    , RegisterName-    , module Yi.Keymap.Vim.MatchResult-    , lookupBestMatch, matchesString-    ) where--import           Control.Applicative-import           Control.Lens-import           Data.Binary-#if __GLASGOW_HASKELL__ < 708-import           Data.DeriveTH-#else-import           GHC.Generics (Generic)-#endif-import           Data.Default-import qualified Data.HashMap.Strict as HM-import           Data.Monoid-import           Data.String (IsString(..))-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import           Data.Typeable-import           Yi.Buffer.Adjusted hiding (Insert)-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Vim.MatchResult-import           Yi.Rope (YiString)-import           Yi.Types (YiVariable)--newtype EventString = Ev { _unEv :: T.Text } deriving (Show, Eq, Ord)--instance IsString EventString where-  fromString = Ev . T.pack--newtype OperatorName = Op { _unOp :: T.Text } deriving (Show, Eq)--instance IsString OperatorName where-  fromString = Op . T.pack--instance Monoid EventString where-  mempty = Ev mempty-  Ev t `mappend` Ev t' = Ev $ t <> t'--instance Monoid OperatorName where-  mempty = Op mempty-  Op t `mappend` Op t' = Op $ t <> t'--instance Binary EventString where-  get = Ev . E.decodeUtf8 <$> get-  put (Ev t) = put $ E.encodeUtf8 t--instance Binary OperatorName where-  get = Op . E.decodeUtf8 <$> get-  put (Op t) = put $ E.encodeUtf8 t--makeLenses ''EventString-makeLenses ''OperatorName---- 'lookupBestMatch' and 'matchesString' pulled out of MatchResult--- module to prevent cyclic dependencies. Screw more bootfiles.-lookupBestMatch :: EventString -> [(EventString, a)] -> MatchResult a-lookupBestMatch key = foldl go NoMatch-    where go m (k, x) = m <|> fmap (const x) (key `matchesString` k)--matchesString :: EventString -> EventString -> MatchResult ()-matchesString (Ev got) (Ev expected)-  | expected == got = WholeMatch ()-  | got `T.isPrefixOf` expected = PartialMatch-  | otherwise = NoMatch--type RegisterName = Char-type MacroName = Char--data RepeatableAction = RepeatableAction {-          raPreviousCount :: !Int-        , raActionString :: !EventString-    }-    deriving (Typeable, Eq, Show)--data Register = Register {-          regRegionStyle :: RegionStyle-        , regContent :: YiString-    }--data VimMode = Normal-             | NormalOperatorPending OperatorName-             | Insert Char -- ^ char denotes how state got into insert mode ('i', 'a', etc.)-             | Replace-             | ReplaceSingleChar-             | InsertNormal -- ^ after C-o-             | InsertVisual -- ^ after C-o and one of v, V, C-v-             | Visual RegionStyle-             | Ex-             | Search { previousMode :: VimMode, direction :: Direction }-    deriving (Typeable, Eq, Show)--data GotoCharCommand = GotoCharCommand !Char !Direction !RegionStyle--data VimState = VimState {-          vsMode :: !VimMode-        , vsCount :: !(Maybe Int)-        , vsAccumulator :: !EventString -- ^ for repeat and potentially macros-        , vsTextObjectAccumulator :: !EventString-        , vsRegisterMap :: !(HM.HashMap RegisterName Register)-        , vsActiveRegister :: !RegisterName-        , vsRepeatableAction :: !(Maybe RepeatableAction)-        , vsStringToEval :: !EventString -- ^ see Yi.Keymap.Vim.vimEval comment-        , vsStickyEol :: !Bool -- ^ is set on $, allows j and k walk the right edge of lines-        , vsOngoingInsertEvents :: !EventString-        , vsLastGotoCharCommand :: !(Maybe GotoCharCommand)-        , vsBindingAccumulator :: !EventString-        , vsSecondaryCursors :: ![Point]-        , vsPaste :: !Bool -- ^ like vim's :help paste-        , vsCurrentMacroRecording :: !(Maybe (MacroName, EventString))-    } deriving (Typeable)--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''RepeatableAction)-$(derive makeBinary ''Register)-$(derive makeBinary ''GotoCharCommand)-#else-deriving instance Generic RepeatableAction-deriving instance Generic Register-deriving instance Generic GotoCharCommand-instance Binary RepeatableAction-instance Binary Register-instance Binary GotoCharCommand-#endif--instance Default VimMode where-    def = Normal--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''VimMode)-#else-deriving instance Generic VimMode-instance Binary VimMode-#endif--instance Default VimState where-    def = VimState-            Normal -- mode-            Nothing -- count-            mempty -- accumulator-            mempty -- textobject accumulator-            mempty -- register map-            '\0' -- active register-            Nothing -- repeatable action-            mempty -- string to eval-            False -- sticky eol-            mempty -- ongoing insert events-            Nothing -- last goto char command-            mempty -- binding accumulator-            mempty -- secondary cursors-            False -- :set paste-            Nothing -- current macro recording--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''VimState)-#else-deriving instance Generic VimState-instance Binary VimState-#endif--instance YiVariable VimState---- Whether an action can be repeated through the use of the '.' key.------ Actions with a RepeatToken of:------  - Finish are repeatable.---  - Drop are not repeatable.---  - Continue are currently in progress. They will become repeatable when---    completed. It is possible to cancel a in progress action, in which case---    it will not be repeatable.-data RepeatToken = Finish-                 | Drop-                 | Continue-    deriving Show---- Distinction between YiM and EditorM variants is for testing.-data VimBinding-    = VimBindingY (EventString -> VimState -> MatchResult (YiM RepeatToken))-    | VimBindingE (EventString -> VimState -> MatchResult (EditorM RepeatToken))
− src/library/Yi/Keymap/Vim/Digraph.hs 
@@ -1,69 +0,0 @@-module Yi.Keymap.Vim.Digraph-    ( charFromDigraph-    , defDigraphs-    ) where--import Control.Applicative--charFromDigraph :: [(String, Char)] -> Char -> Char -> Maybe Char-charFromDigraph digraphTable c1 c2 =-    lookup [c1, c2] digraphTable <|> lookup [c2, c1] digraphTable--defDigraphs :: [(String, Char)]-defDigraphs =-    [ ("ae",  'æ')-    , ("a'",  'á')-    , ("e'",  'é')-    , ("e`",  'è')-    , ("o\"", 'ő')-    , ("o:",  'ö')-    , ("a:",  'ä')-    , ("e:",  'ë')-    , ("u:",  'ü')-    , ("AE",  'Æ')-    , ("Ae",  'Æ')-    , ("A'",  'Á')-    , ("E'",  'É')-    , ("E`",  'È')-    , ("O\"", 'Ő')-    , ("O:",  'Ö')-    , ("A:",  'Ä')-    , ("E:",  'Ë')-    , ("U:",  'Ü')-    , ("=e",  '€')-    , ("Cu",  '¤')-    , ("+-",  '±')-    , ("-+",  '∓')-    , ("^1",  '¹')-    , ("^2",  '²')-    , ("^3",  '³')-    , ("^4",  '⁴')-    , ("^5",  '⁵')-    , ("^6",  '⁶')-    , ("^7",  '⁷')-    , ("^8",  '⁸')-    , ("^9",  '⁹')-    , ("0S",  '⁰')-    , ("1S",  '¹')-    , ("2S",  '²')-    , ("3S",  '³')-    , ("4S",  '⁴')-    , ("5S",  '⁵')-    , ("6S",  '⁶')-    , ("7S",  '⁷')-    , ("8S",  '⁸')-    , ("9S",  '⁹')-    , ("0S",  '⁰')-    , ("0s",  '₀')-    , ("1s",  '₁')-    , ("2s",  '₂')-    , ("3s",  '₃')-    , ("4s",  '₄')-    , ("5s",  '₅')-    , ("6s",  '₆')-    , ("7s",  '₇')-    , ("8s",  '₈')-    , ("9s",  '₉')-    , ("0s",  '₀')-    , ("'0",  '˚')-    ]
− src/library/Yi/Keymap/Vim/Eval.hs 
@@ -1,20 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Eval--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ This module doesn't contains actual eval, see--- 'Yi.Keymap.Vim.vimEval' comment.--module Yi.Keymap.Vim.Eval (scheduleActionStringForEval) where--import Yi.Editor-import Yi.Keymap.Vim.Common-import Yi.Keymap.Vim.StateUtils--scheduleActionStringForEval :: EventString -> EditorM ()-scheduleActionStringForEval s = modifyStateE $ \st -> st { vsStringToEval = s }
− src/library/Yi/Keymap/Vim/EventUtils.hs 
@@ -1,133 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.EventUtils--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.EventUtils-  ( stringToEvent-  , eventToEventString-  , parseEvents-  , stringToRepeatableAction-  , normalizeCount-  , splitCountedCommand-  ) where--import           Data.Char (toUpper, isDigit)-import           Data.List (foldl')-import qualified Data.Map as M-import           Data.Monoid-import qualified Data.Text as T-import           Data.Tuple (swap)-import           Yi.Event-import           Yi.Keymap.Keys (char, spec, ctrl, meta)-import           Yi.Keymap.Vim.Common-import           Yi.String--specMap :: M.Map EventString Key-specMap = M.fromList specList--invSpecMap :: M.Map Key EventString-invSpecMap = M.fromList $ fmap swap specList--specList :: [(EventString, Key)]-specList =-    [ (Ev "Esc", KEsc)-    , (Ev "CR", KEnter)-    , (Ev "BS", KBS)-    , (Ev "Tab", KTab)-    , (Ev "Down", KDown)-    , (Ev "Up", KUp)-    , (Ev "Left", KLeft)-    , (Ev "Right", KRight)-    , (Ev "PageUp", KPageUp)-    , (Ev "PageDown", KPageDown)-    , (Ev "Home", KHome)-    , (Ev "End", KEnd)-    , (Ev "Ins", KIns)-    , (Ev "Del", KDel)-    ]--stringToEvent :: String -> Event-stringToEvent "<" = error "Invalid event string \"<\""-stringToEvent s@('<':'C':'-':_) = stringToEvent' 3 s ctrl-stringToEvent s@('<':'M':'-':_) = stringToEvent' 3 s meta-stringToEvent s@('<':'a':'-':_) = stringToEvent' 3 s meta-stringToEvent "<lt>" = char '<'-stringToEvent [c] = char c-stringToEvent ('<':'F':d:'>':[]) | isDigit d = spec (KFun $ read [d])-stringToEvent ('<':'F':'1':d:'>':[]) | isDigit d = spec (KFun $ 10 + read [d])-stringToEvent s@('<':_) = stringToEvent' 1 s id-stringToEvent s = error ("Invalid event string " ++ show s)--stringToEvent' :: Int -> String -> (Event -> Event) -> Event-stringToEvent' toDrop inputString modifier =-  let analyzedString = drop toDrop inputString-  in case analyzedString of-    [c,'>'] -> modifier (char c)-    _ -> if last analyzedString /= '>'-         then error ("Invalid event string " ++ show inputString)-         else case M.lookup (Ev . T.pack $ init analyzedString) specMap of-           Just k -> modifier (Event k [])-           Nothing -> error $ "Couldn't convert string " ++ show inputString ++ " to event"--eventToEventString :: Event -> EventString-eventToEventString e = case e of-  Event (KASCII '<') []       -> Ev "<lt>"-  Event (KASCII c)   []       -> Ev $ T.singleton c-  Event (KASCII c)   [MCtrl]  -> Ev $ mkMod MCtrl c-  Event (KASCII c)   [MMeta]  -> Ev $ mkMod MMeta c-  Event (KASCII c)   [MShift] -> Ev . T.singleton $ toUpper c-  Event (KFun x)     []       -> Ev $ "<F" <> showT x `T.snoc` '>'-  v@(Event      k    mods)    -> case M.lookup k invSpecMap of-    Just (Ev s) -> case mods of-      []      -> Ev $ '<' `T.cons` s `T.snoc` '>'-      [MCtrl] -> Ev $ "<C-" <> s `T.snoc` '>'-      [MMeta] -> Ev $ "<M-" <> s `T.snoc` '>'-      _ -> error $ "Couldn't convert event <" ++ show v-                   ++ "> to string, because of unknown modifiers"-    Nothing -> error $ "Couldn't convert event <" ++ show v ++ "> to string"--  where-    f MCtrl = 'C'-    f MMeta = 'M'-    f _     = '×'-    mkMod m c = '<' `T.cons` f m `T.cons` '-'-                `T.cons` c `T.cons` T.singleton '>'----parseEvents :: EventString -> [Event]-parseEvents (Ev x) = fst . foldl' go ([], []) $ T.unpack x-    where go (evs, s) '\n' = (evs, s)-          go (evs, []) '<' = (evs, "<")-          go (evs, []) c = (evs ++ [char c], [])-          go (evs, s) '>' = (evs ++ [stringToEvent (s ++ ">")], [])-          go (evs, s) c = (evs, s ++ [c])--stringToRepeatableAction :: EventString -> RepeatableAction-stringToRepeatableAction s = RepeatableAction count command-    where (count, command) = splitCountedCommand s--splitCountedCommand :: EventString -> (Int, EventString)-splitCountedCommand (Ev s) = (count, Ev commandString)-  where (countString, commandString) = T.span isDigit s-        count = case countString of-          "" -> 1-          x  -> read $ T.unpack x---- 2d3w -> 6dw--- 6dw -> 6dw--- dw -> dw-normalizeCount :: EventString -> EventString-normalizeCount s =-  if T.null countedObject-  then s-  else Ev $ showT (operatorCount * objectCount) <> operator <> object-    where (operatorCount, Ev rest1) = splitCountedCommand s-          (operator, countedObject) = T.break isDigit rest1-          (objectCount, Ev object) = splitCountedCommand (Ev countedObject)
− src/library/Yi/Keymap/Vim/Ex.hs 
@@ -1,56 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex-    ( exEvalE-    , exEvalY-    , evStringToExCommand-    , ExCommand(..)-    , defExCommandParsers-    ) where--import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Buffer as Buffer-import qualified Yi.Keymap.Vim.Ex.Commands.BufferDelete as BufferDelete-import qualified Yi.Keymap.Vim.Ex.Commands.Buffers as Buffers-import qualified Yi.Keymap.Vim.Ex.Commands.Cabal as Cabal-import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete-import qualified Yi.Keymap.Vim.Ex.Commands.Edit as Edit-import qualified Yi.Keymap.Vim.Ex.Commands.Global as Global-import qualified Yi.Keymap.Vim.Ex.Commands.GotoLine as GotoLine-import qualified Yi.Keymap.Vim.Ex.Commands.Nohl as Nohl-import qualified Yi.Keymap.Vim.Ex.Commands.Paste as Paste-import qualified Yi.Keymap.Vim.Ex.Commands.Quit as Quit-import qualified Yi.Keymap.Vim.Ex.Commands.Reload as Reload-import qualified Yi.Keymap.Vim.Ex.Commands.Substitute as Substitute-import qualified Yi.Keymap.Vim.Ex.Commands.Tag as Tag-import qualified Yi.Keymap.Vim.Ex.Commands.Write as Write-import qualified Yi.Keymap.Vim.Ex.Commands.Yi as Yi-import           Yi.Keymap.Vim.Ex.Eval-import           Yi.Keymap.Vim.Ex.Types--defExCommandParsers :: [EventString -> Maybe ExCommand]-defExCommandParsers =-    [ Buffer.parse-    , Buffers.parse-    , BufferDelete.parse-    , Cabal.parse-    , Delete.parse-    , Edit.parse-    , Global.parse-    , GotoLine.parse-    , Nohl.parse-    , Paste.parse-    , Quit.parse-    , Reload.parse-    , Substitute.parse-    , Tag.parse-    , Write.parse-    , Yi.parse-    ]
− src/library/Yi/Keymap/Vim/Ex/Commands/Buffer.hs 
@@ -1,74 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Buffer--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ :buffer ex command to switch to named or numbered buffer.--module Yi.Keymap.Vim.Ex.Commands.Buffer (parse) where--import           Control.Applicative-import           Control.Monad-import           Control.Monad.State-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Buffer.Basic-import           Yi.Buffer.Misc-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types--parse :: EventString -> Maybe ExCommand-parse = Common.parseWithBangAndCount nameParser $ \ _ bang mcount -> do-  bufIdent <- P.try ( P.many1 P.digit <|> bufferSymbol) <|>-              P.many1 P.space *> P.many P.anyChar <|>-              P.eof *> return ""-  return $ Common.pureExCommand {-      cmdShow = "buffer"-    , cmdAction = EditorA $ do-        unchanged <- withCurrentBuffer $ gets isUnchangedBuffer-        if bang || unchanged-          then case mcount of-            Nothing -> switchToBuffer bufIdent-            Just i  -> switchByRef $ BufferRef i-          else Common.errorNoWrite-    }-  where-    bufferSymbol = P.string "%" <|> P.string "#"---nameParser :: P.GenParser Char () ()-nameParser = do-    void $ P.try ( P.string "buffer") <|>-           P.try ( P.string "buf")    <|>-           P.try ( P.string "bu")     <|>-           P.try ( P.string "b")---switchToBuffer :: String -> EditorM ()-switchToBuffer s =-    case P.parse bufferRef "" s of-        Right ref -> switchByRef ref-        Left _e   -> switchByName s-  where-    bufferRef = BufferRef . read <$> P.many1 P.digit---switchByName :: String -> EditorM ()-switchByName ""      = return ()-switchByName "%"     = return ()-switchByName "#"     = switchToBufferWithNameE ""-switchByName bufName = switchToBufferWithNameE (T.pack bufName)---switchByRef :: BufferRef -> EditorM ()-switchByRef ref = do-    mBuf <- findBuffer ref-    maybe (return ()) (switchToBufferE . bkey) mBuf
− src/library/Yi/Keymap/Vim/Ex/Commands/BufferDelete.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.BufferDelete--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.BufferDelete (parse) where--import           Control.Applicative-import           Control.Monad-import           Data.Text ()-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types--parse :: EventString -> Maybe ExCommand-parse = Common.parse $ do-    void $ P.try ( P.string "bdelete") <|> P.try ( P.string "bdel") <|> P.try (P.string "bd")-    return $ Common.pureExCommand {-        cmdShow = "bdelete"-      , cmdAction = EditorA closeBufferAndWindowE-      }
− src/library/Yi/Keymap/Vim/Ex/Commands/Buffers.hs 
@@ -1,57 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.BufferDelete--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ :buffers or :ls ex command to list buffers.-module Yi.Keymap.Vim.Ex.Commands.Buffers (parse) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Buffer.Basic-import           Yi.Buffer.Misc-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types-import           Yi.Monad-import           Yi.Rope (fromText)--parse :: EventString -> Maybe ExCommand-parse = Common.parse $ do-    void $ P.try ( P.string "buffers") <|> P.try ( P.string "ls") <|> P.try ( P.string "files" )-    return $ Common.pureExCommand {-        cmdShow = "buffers"-      , cmdAction = EditorA $ withEditor printBuffers-      }--printBuffers :: EditorM ()-printBuffers = do-    -- TODO Don't keep recreating new buffers. Use a pre-existing one.-    --      See the cabal buffer used in Command.hs for an example.-    -- TODO Add some simple keymaps to the buffer, like <CR> to open the buffer?-    bufs <- gets buffers-    let bufLines = M.elems $ M.mapWithKey bufLine bufs-    if length bufLines > 1-      then withEditor . void $-             newBufferE (MemBuffer "Buffer list")-                        (fromText $ T.unlines bufLines)-      else printMsgs bufLines-  where-    tab = T.pack "\t"-    -- TODO shorten this name string perhaps.-    -- TODO Add more information: modified status, line number.-    bufLine (BufferRef bufNum) buf =-        T.intercalate tab [ T.pack . show $ bufNum-                          , T.pack . show . view identA $ buf-                          ]
− src/library/Yi/Keymap/Vim/Ex/Commands/Cabal.hs 
@@ -1,34 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Cabal--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.Cabal (parse) where--import           Control.Applicative-import           Control.Monad-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Command-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types-import           Yi.MiniBuffer---- TODO: Either hack Text into these parsec parsers or use Attoparsec.--- Attoparsec is faster anyway and backtracks by default so we may--- want to use that anyway.--parse :: EventString -> Maybe ExCommand-parse = Common.parse $ do-    void $ P.try (P.string "cabal build") <|> P.try (P.string "cabal")-    args <- map T.pack <$> P.many (P.many1 P.space *> P.many1 P.anyChar)-    return $ Common.impureExCommand {-        cmdShow = T.pack "cabal build"-      , cmdAction = YiA $ cabalBuildE $ CommandArguments args-      }
− src/library/Yi/Keymap/Vim/Ex/Commands/Common.hs 
@@ -1,175 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Common--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Implements common 'ExCommand's for the Vim keymap.--module Yi.Keymap.Vim.Ex.Commands.Common-    ( parse-    , parseWithBang-    , parseWithBangAndCount-    , parseRange-    , OptionAction(..)-    , parseOption-    , filenameComplete-    , forAllBuffers-    , pureExCommand-    , impureExCommand-    , errorNoWrite-    ) where--import           Control.Applicative-import           Control.Monad-import           Data.List.NonEmpty (NonEmpty(..))-import           Data.Monoid-import qualified Data.Text as T-import           System.Directory-import qualified Text.ParserCombinators.Parsec as P-import           Text.Read (readMaybe)-import           Yi.Buffer-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Ex.Types-import           Yi.Misc-import           Yi.Monad-import           Yi.Style (errorStyle)-import           Yi.Utils--parse :: P.GenParser Char () ExCommand -> EventString -> Maybe ExCommand-parse parser (Ev s) =-  either (const Nothing) Just (P.parse parser "" $ T.unpack s)---parseWithBangAndCount :: P.GenParser Char () a-                      -- ^ The command name parser.-                      -> (a -> Bool-                          -> (Maybe Int)-                          -> P.GenParser Char () ExCommand)-                      -- ^ A parser for the remaining command arguments.-                      -> EventString-                      -- ^ The string to parse.-                      -> Maybe ExCommand-parseWithBangAndCount nameParser argumentParser (Ev s) = do-    either (const Nothing) Just (P.parse parser "" $ T.unpack s)-  where-    parser = do-        mcount <- parseCount-        a      <- nameParser-        bang   <- parseBang-        argumentParser a bang mcount--parseWithBang :: P.GenParser Char () a-              -- ^ The command name parser.-              -> (a -> Bool -> P.GenParser Char () ExCommand)-              -- ^ A parser for the remaining command arguments.-              -> EventString-              -- ^ The string to parse.-              -> Maybe ExCommand-parseWithBang nameParser argumentParser (Ev s) = do-    either (const Nothing) Just (P.parse parser "" $ T.unpack s)-  where-    parser = do-        a    <- nameParser-        bang <- parseBang-        argumentParser a bang--parseBang :: P.GenParser Char () Bool-parseBang = P.string "!" *> return True <|> return False--parseRange :: P.GenParser Char () LineRange-parseRange = return CurrentLineRange--parseCount :: P.GenParser Char () (Maybe Int)-parseCount = do-    readMaybe <$> P.many P.digit--data OptionAction = Set !Bool | Invert | Ask--parseOption :: String -> (OptionAction -> Action) -> EventString -> Maybe ExCommand-parseOption name action = parse $ do-    void $ P.string "set "-    nos <- P.many (P.string "no")-    invs <- P.many (P.string "inv")-    void $ P.string name-    bangs <- P.many (P.string "!")-    qs <- P.many (P.string "?")-    return $ pureExCommand {-        cmdShow = T.concat [ "set "-                           , T.pack $ concat nos-                           , T.pack name-                           , T.pack $ concat bangs-                           , T.pack $ concat qs ]-      , cmdAction = action $-          case fmap (not . null) [qs, bangs, invs, nos] of-              [True, _, _, _] -> Ask-              [_, True, _, _] -> Invert-              [_, _, True, _] -> Invert-              [_, _, _, True] -> Set False-              _ -> Set True-      }--removePwd :: T.Text -> YiM T.Text-removePwd path = do-  pwd' <- T.pack <$> io getCurrentDirectory-  return $! if pwd' `T.snoc` '/' `T.isPrefixOf` path-            then T.drop (1 + T.length pwd') path-            else path--filenameComplete :: T.Text -> YiM [T.Text]-filenameComplete f = case f == "%" of-  True -> do-    -- current buffer is minibuffer-    -- actual file is in the second buffer in bufferStack-    gets bufferStack >>= \case-      _ :| [] -> do-        withEditor $ printMsg "filenameComplete: Expected to see minibuffer!"-        return []-      _ :| bufferRef : _ -> do-        currentFileName <- fmap T.pack . withGivenBuffer bufferRef $-            fmap bufInfoFileName bufInfoB--        let sanitizedFileName = if "//" `T.isPrefixOf` currentFileName-                                then '/' `T.cons` currentFileName-                                else currentFileName--        return <$> removePwd sanitizedFileName--  False -> do-    files <- matchingFileNames Nothing f-    case files of-        [] -> return []-        [x] -> return <$> removePwd x-        xs -> sequence $ fmap removePwd xs--forAllBuffers :: MonadEditor m => (BufferRef -> m ()) -> m ()-forAllBuffers f = readEditor bufferStack >>= \(b :| bs) -> f b >> mapM_ f bs--pureExCommand :: ExCommand-pureExCommand = ExCommand {-    cmdIsPure = True-  , cmdComplete = return []-  , cmdAcceptsRange = False-  , cmdAction = undefined-  , cmdShow = undefined-  }--impureExCommand :: ExCommand-impureExCommand = pureExCommand { cmdIsPure = False }----- | Show an error on the status line.-errorEditor :: T.Text -> EditorM ()-errorEditor s = printStatus (["error: " <> s], errorStyle)----- | Show the common error message about an unsaved file on the status line.-errorNoWrite :: EditorM ()-errorNoWrite = errorEditor "No write since last change (add ! to override)"
− src/library/Yi/Keymap/Vim/Ex/Commands/Delete.hs 
@@ -1,31 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Delete--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.Delete (parse) where--import           Control.Applicative-import           Control.Monad-import           Data.Text ()-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Buffer.Adjusted hiding (Delete)-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types--parse :: EventString -> Maybe ExCommand-parse = Common.parse $ do-    void $ P.try ( P.string "delete") <|> P.string "d"-    return $ Common.pureExCommand {-        cmdShow = "delete"-      , cmdAction = BufferA $ do-            deleteUnitB Line Forward-            deleteN 1-      }
− src/library/Yi/Keymap/Vim/Ex/Commands/Edit.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Edit--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Implements quit commands.--module Yi.Keymap.Vim.Ex.Commands.Edit (parse) where--import           Control.Applicative-import           Control.Monad-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Editor-import           Yi.File-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types--parse :: EventString -> Maybe ExCommand-parse = Common.parse $ do-    tab <- P.many (P.string "tab")-    void $ P.try ( P.string "edit") <|> P.string "e"-    void $ P.many1 P.space-    filename <- T.pack <$> P.many1 P.anyChar-    return $! edit (not (null tab)) filename--edit :: Bool -> T.Text -> ExCommand-edit tab f = Common.impureExCommand {-    cmdShow = showEdit tab f-  , cmdAction = YiA $ do-        when tab $ withEditor newTabE-        void . editFile $ T.unpack f-  , cmdComplete = (fmap . fmap)-                    (showEdit tab) (Common.filenameComplete f)-  }--showEdit :: Bool -> T.Text -> T.Text-showEdit tab f = (if tab then "tab" else "") `T.append` "edit " `T.append` f
− src/library/Yi/Keymap/Vim/Ex/Commands/Global.hs 
@@ -1,60 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Global--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.Global (parse) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad-import           Data.Monoid-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Buffer.Adjusted-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete-import qualified Yi.Keymap.Vim.Ex.Commands.Substitute as Substitute-import           Yi.Keymap.Vim.Ex.Types-import qualified Yi.Rope as R-import           Yi.String (showT)--parse :: EventString -> Maybe ExCommand-parse = Common.parse $ do-    void $ P.try (P.string "global/") <|> P.string "g/"-    predicate <- T.pack <$> P.many (P.noneOf "/")-    void $ P.char '/'-    cmdString <- Ev . T.pack <$> P.many P.anyChar-    cmd <- case evStringToExCommand allowedCmds cmdString of-            Just c -> return c-            _ -> fail "Unexpected command argument for global command."-    return $! global predicate cmd--global :: T.Text -> ExCommand -> ExCommand-global p c = Common.pureExCommand {-    cmdShow = "g/" <> p `T.snoc` '/' <> showT c-  , cmdAction = EditorA $ do-        mark <- withCurrentBuffer setMarkHereB-        lineCount <- withCurrentBuffer lineCountB-        forM_ (reverse [1..lineCount]) $ \l -> do-            ln <- withCurrentBuffer $ gotoLn l >> R.toText <$> readLnB-            when (p `T.isInfixOf` ln) $-                case cmdAction c of-                    BufferA action -> withCurrentBuffer $ void action-                    EditorA action -> void action-                    _ -> error "Impure command as an argument to global."-        withCurrentBuffer $ do-            use (markPointA mark) >>= moveTo-            deleteMarkB mark-  }--allowedCmds :: [EventString -> Maybe ExCommand]-allowedCmds = [Delete.parse, Substitute.parse]
− src/library/Yi/Keymap/Vim/Ex/Commands/GotoLine.hs 
@@ -1,27 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.GotoLine--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.GotoLine (parse) where--import           Data.Char (isDigit)-import qualified Data.Text as T-import           Yi.Buffer.Adjusted-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand)-import           Yi.Keymap.Vim.Ex.Types--parse :: EventString -> Maybe ExCommand-parse (Ev s) = if not (T.null s) && T.all isDigit s-    then let l = read $ T.unpack s in-         Just $ pureExCommand {-             cmdAction = BufferA $ gotoLn l >> firstNonSpaceB-           , cmdShow = s-         }-    else Nothing
− src/library/Yi/Keymap/Vim/Ex/Commands/Nohl.hs 
@@ -1,29 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Nohl--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.Nohl (parse) where--import Data.Text ()-import Yi.Keymap-import Yi.Keymap.Vim.Common-import Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand)-import Yi.Keymap.Vim.Ex.Types-import Yi.Search--parse :: EventString -> Maybe ExCommand-parse s = if s == "nohl" || s == "nohlsearch"-    then Just nohl-    else Nothing--nohl :: ExCommand-nohl = pureExCommand {-    cmdAction = EditorA resetRegexE-  , cmdShow = "nohlsearch"-  }
− src/library/Yi/Keymap/Vim/Ex/Commands/Paste.hs 
@@ -1,36 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Paste--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Implements quit commands.--module Yi.Keymap.Vim.Ex.Commands.Paste (parse) where--import Control.Applicative-import Data.Monoid-import Yi.Editor-import Yi.Keymap-import Yi.Keymap.Vim.Common-import Yi.Keymap.Vim.Ex.Commands.Common hiding (parse)-import Yi.Keymap.Vim.Ex.Types-import Yi.Keymap.Vim.StateUtils-import Yi.String (showT)--parse :: EventString -> Maybe ExCommand-parse = parseOption "paste" action--action :: OptionAction -> Action-action Ask = EditorA $ do-    value <- vsPaste <$> getEditorDyn-    printMsg $ "paste = " <> showT value-action (Set b) = modPaste $ const b-action Invert = modPaste not--modPaste :: (Bool -> Bool) -> Action-modPaste f = EditorA . modifyStateE $ \s -> s { vsPaste = f (vsPaste s) }
− src/library/Yi/Keymap/Vim/Ex/Commands/Quit.hs 
@@ -1,102 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Quit--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Implements quit commands.--module Yi.Keymap.Vim.Ex.Commands.Quit (parse) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad-import           Data.Foldable (find)-import           Data.List.NonEmpty (NonEmpty(..))-import           Data.Monoid-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Buffer-import           Yi.Core (quitEditor, errorEditor, closeWindow)-import           Yi.Editor-import           Yi.File-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types-import           Yi.Monad-import           Yi.String (showT)-import           Yi.Window (bufkey)---parse :: EventString -> Maybe ExCommand-parse = Common.parse $ P.choice-    [ do-        _ <- (P.try ( P.string "xit") <|> P.string "x")-        bangs <- P.many (P.char '!')-        return (quit True (not $ null bangs) False)-    , do-        ws <- P.many (P.char 'w')-        void $ P.try ( P.string "quit") <|> P.string "q"-        as <- P.many (P.try ( P.string "all") <|> P.string "a")-        bangs <- P.many (P.char '!')-        return $! quit (not $ null ws) (not $ null bangs) (not $ null as)-    ]--quit :: Bool -> Bool -> Bool -> ExCommand-quit w f a = Common.impureExCommand {-    cmdShow = (if w then "w" else "")-              `T.append` "quit"-              `T.append` (if a then "all" else "")-              `T.append` (if f then "!" else "")-  , cmdAction = YiA $ action w f a-  }--action :: Bool -> Bool -> Bool -> YiM ()-action False False False = quitWindowE-action False False  True = quitAllE-action  True False False = viWrite >> closeWindow-action  True False  True = saveAndQuitAllE-action False  True False = closeWindow-action False  True  True = quitEditor-action  True  True False = viWrite >> closeWindow-action  True  True  True = saveAndQuitAllE--quitWindowE :: YiM ()-quitWindowE = do-    nw <- withCurrentBuffer needsAWindowB-    ws <- withEditor $ use currentWindowA >>= windowsOnBufferE . bufkey-    if length ws == 1 && nw-       then errorEditor "No write since last change (add ! to override)"-       else closeWindow--quitAllE :: YiM ()-quitAllE = do-  a :| as <- readEditor bufferStack-  let needsWindow b = (b,) <$> withEditor (withGivenBuffer b needsAWindowB)-  bs <- mapM needsWindow (a:as)-  -- Vim only shows the first modified buffer in the error.-  case find snd bs of-      Nothing -> quitEditor-      Just (b, _) -> do-          bufferName <- withEditor $ withGivenBuffer b $ gets file-          errorEditor $ "No write since last change for buffer "-                        <> showT bufferName-                        <> " (add ! to override)"--saveAndQuitAllE :: YiM ()-saveAndQuitAllE = Common.forAllBuffers fwriteBufferE >> quitEditor--needsAWindowB :: BufferM Bool-needsAWindowB = do-  isWorthless <- gets (^. identA) >>= return . \case-    MemBuffer _ -> True-    FileBuffer _ -> False-  canClose <- gets isUnchangedBuffer-  return (not (isWorthless || canClose))
− src/library/Yi/Keymap/Vim/Ex/Commands/Reload.hs 
@@ -1,25 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Reload--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.Reload (parse) where--import Data.Text ()-import Yi.Boot.Internal (reload)-import Yi.Keymap-import Yi.Keymap.Vim.Common-import Yi.Keymap.Vim.Ex.Commands.Common (impureExCommand)-import Yi.Keymap.Vim.Ex.Types--parse :: EventString -> Maybe ExCommand-parse "reload" = Just $ impureExCommand {-    cmdShow = "reload"-  , cmdAction = YiA reload-  }-parse _ = Nothing
− src/library/Yi/Keymap/Vim/Ex/Commands/Substitute.hs 
@@ -1,61 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Substitute--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.Substitute (parse) where--import           Control.Applicative-import           Control.Monad-import           Data.Monoid-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Buffer.Adjusted hiding (Delete)-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types-import qualified Yi.Rope as R-import           Yi.Search--parse :: EventString -> Maybe ExCommand-parse = Common.parse $ do-    percents <- P.many (P.char '%')-    void $ P.try (P.string "substitute") <|> P.string "s"-    delimiter <- P.oneOf "!@#$%^&*()[]{}<>/.,~';:?-="-    from <- R.fromString <$> P.many (P.noneOf [delimiter])-    void $ P.char delimiter-    to <- R.fromString <$> P.many (P.noneOf [delimiter])-    void $ P.char delimiter-    flagChars <- P.many (P.oneOf "gi")-    return $! substitute from to delimiter-        ('g' `elem` flagChars)-        ('i' `elem` flagChars)-        (not $ null percents)--substitute :: R.YiString -> R.YiString -> Char -> Bool -> Bool -> Bool -> ExCommand-substitute from to delimiter global caseInsensitive allLines = Common.pureExCommand {-    cmdShow = (if allLines then "%" else "")-              <>       "substitute"-              <>       (delimiter `T.cons` R.toText from)-              <>       (delimiter `T.cons` R.toText to)-              `T.snoc` delimiter-              <>       (if caseInsensitive then "i" else "")-              <>       (if global then "g" else "")-  , cmdAction = BufferA $ do-        let regex = makeSimpleSearch from-            replace = do-                region <- regionOfB Line-                void $ searchAndRepRegion0 regex to global region--        if allLines-        then withEveryLineB replace-        else replace--        moveToSol-  }
− src/library/Yi/Keymap/Vim/Ex/Commands/Tag.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Tag--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.Tag (parse) where--import           Control.Monad-import           Data.Monoid-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types-import           Yi.Keymap.Vim.Tag-import           Yi.Tag--parse :: EventString -> Maybe ExCommand-parse = Common.parse $ do-  void $ P.string "ta"-  void . P.optionMaybe $ P.string "g"-  t <- P.optionMaybe $ do-      void $ P.many1 P.space-      P.many1 P.anyChar-  case t of-    Nothing -> P.eof >> return (tag Nothing)-    Just t' -> return $! tag (Just (Tag (T.pack t')))--tag :: Maybe Tag -> ExCommand-tag Nothing = Common.impureExCommand {-    cmdShow = "tag"-  , cmdAction = YiA unpopTag-  , cmdComplete = return ["tag"]-  }-tag (Just (Tag t)) = Common.impureExCommand {-    cmdShow = "tag " <> t-  , cmdAction = YiA . gotoTag $ Tag t-  , cmdComplete = (fmap . fmap) (mappend "tag ") $ completeVimTag t-  }
− src/library/Yi/Keymap/Vim/Ex/Commands/Write.hs 
@@ -1,48 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Write--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Commands.Write (parse) where--import           Control.Applicative-import           Control.Monad-import           Data.Monoid-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.File-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types--parse :: EventString -> Maybe ExCommand-parse = Common.parse $-               P.choice [parseWrite, parseWriteAs]-    where parseWrite = do-            void $ P.try ( P.string "write") <|> P.string "w"-            alls <- P.many (P.try ( P.string "all") <|> P.string "a")-            return $! writeCmd $ not (null alls)--          parseWriteAs = do-            void $ P.try ( P.string "write") <|> P.string "w"-            void $ P.many1 P.space-            filename <- T.pack <$> P.many1 P.anyChar-            return $! writeAsCmd filename--writeCmd :: Bool -> ExCommand-writeCmd allFlag = Common.impureExCommand {-    cmdShow = "write" <> if allFlag then "all" else ""-  , cmdAction = YiA $ if allFlag then Common.forAllBuffers fwriteBufferE else viWrite-  }--writeAsCmd :: T.Text -> ExCommand-writeAsCmd filename = Common.impureExCommand {-    cmdShow = "write " <> filename-  , cmdAction = YiA $ viWriteTo filename-  }
− src/library/Yi/Keymap/Vim/Ex/Commands/Yi.hs 
@@ -1,30 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Commands.Yi--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable---module Yi.Keymap.Vim.Ex.Commands.Yi (parse) where--import           Control.Monad-import qualified Data.Text as T-import qualified Text.ParserCombinators.Parsec as P-import           Yi.Eval (execEditorAction)-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common-import           Yi.Keymap.Vim.Ex.Types--parse :: EventString -> Maybe ExCommand-parse = Common.parse $ do-    void $ P.string "yi"-    void $ P.many1 P.space-    cmd <- P.many1 P.anyChar-    return $! Common.impureExCommand {-        cmdAction = YiA $ execEditorAction cmd-      , cmdShow = T.pack cmd-      }
− src/library/Yi/Keymap/Vim/Ex/Eval.hs 
@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Eval--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Eval-    ( exEvalE-    , exEvalY-    ) where--import           Control.Monad-import           Data.Monoid-import qualified Data.Text as T-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Ex.Types--exEvalE :: [EventString -> Maybe ExCommand] -> EventString -> EditorM ()-exEvalE cmds cmdString = evalHelper id (const $ error msg) cmds cmdString-    where msg = T.unpack . _unEv $ "exEvalE got impure command" <> cmdString--exEvalY :: [EventString -> Maybe ExCommand] -> EventString -> YiM ()-exEvalY = evalHelper withEditor id--evalHelper :: MonadEditor m =>-    (EditorM () -> m ()) -> (YiM () -> m ()) ->-    [EventString -> Maybe ExCommand] -> EventString -> m ()-evalHelper pureHandler impureHandler cmds cmdString =-    case evStringToExCommand cmds cmdString of-        Just cmd -> case cmdAction cmd of-            BufferA actionB -> pureHandler $ withCurrentBuffer (void actionB)-            EditorA actionE -> pureHandler (void actionE)-            YiA actionY -> impureHandler (void actionY)-        _ -> return ()
− src/library/Yi/Keymap/Vim/Ex/Types.hs 
@@ -1,34 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Ex.Types--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Ex.Types where--import Data.Maybe-import Data.Text (Text, unpack)-import Yi.Keymap-import Yi.Keymap.Vim.Common--data ExCommand = ExCommand {-    cmdComplete :: YiM [Text]-  , cmdIsPure :: Bool-  , cmdAction :: Action-  , cmdAcceptsRange :: Bool-  , cmdShow :: Text-}--instance Show ExCommand where-    show = unpack . cmdShow--data LineRange-    = MarkRange String String -- ^ 'a,'b-    | FullRange               -- ^ %-    | CurrentLineRange--evStringToExCommand :: [EventString -> Maybe ExCommand] -> EventString -> Maybe ExCommand-evStringToExCommand parsers s = listToMaybe . mapMaybe ($ s) $ parsers
− src/library/Yi/Keymap/Vim/ExMap.hs 
@@ -1,195 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.ExMap--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ I'm a module waiting for some kind soul to give me a commentary!--module Yi.Keymap.Vim.ExMap (defExMap) where--import           Control.Applicative-import           Control.Monad (when)-import           Data.Char (isSpace)-import           Data.Maybe (fromJust)-import           Data.Monoid-import qualified Data.Text as T-import           System.FilePath (isPathSeparator)-import           Yi.Buffer.Adjusted hiding (Insert)-import           Yi.Editor-import           Yi.History-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Ex-import           Yi.Keymap.Vim.StateUtils-import           Yi.Keymap.Vim.Utils-import qualified Yi.Rope as R-import           Yi.String--defExMap :: [EventString -> Maybe ExCommand] -> [VimBinding]-defExMap cmdParsers =-    [ exitBinding-    , completionBinding cmdParsers-    , finishBindingY cmdParsers-    , finishBindingE cmdParsers-    , failBindingE-    , historyBinding-    , printable-    ]--completionBinding :: [EventString -> Maybe ExCommand] -> VimBinding-completionBinding commandParsers = VimBindingY f-  where-    f "<Tab>" (VimState { vsMode = Ex }) = WholeMatch $ do-        commandString <- Ev . R.toText <$> withCurrentBuffer elemsB-        case evStringToExCommand commandParsers commandString of-          Just cmd -> complete cmd-          Nothing -> return ()-        return Drop-    f _ _ = NoMatch-    complete :: ExCommand -> YiM ()-    complete cmd = do-        possibilities <- cmdComplete cmd-        case possibilities of-          [] -> return ()-          (s:[]) -> updateCommand s-          ss -> do-              let s = commonTPrefix' ss-              updateCommand s-              withEditor . printMsg . T.unwords . fmap (dropToLastWordOf s) $ ss--    updateCommand :: T.Text -> YiM ()-    updateCommand s = do-        withCurrentBuffer $ replaceBufferContent (R.fromText s)-        withEditor $ do-            historyPrefixSet s-            modifyStateE $ \state -> state {-                vsOngoingInsertEvents = Ev s-            }---- | TODO: verify whether 'T.split' works fine here in place of--- @split@'s 'splitWhen'. If something breaks then you should use--- 'splitWhen' + 'T.pack'/'T.unpack'.-dropToLastWordOf :: T.Text -> T.Text -> T.Text-dropToLastWordOf s = case reverse . T.split isWordSep $ s of-  []     -> id-  [_]    -> id-  _ : ws -> T.drop . succ . T.length . T.unwords $ ws-  where-    isWordSep :: Char -> Bool-    isWordSep c = isPathSeparator c || isSpace c--exitEx :: Bool -> EditorM ()-exitEx success = do-    when success historyFinish-    resetCountE-    switchModeE Normal-    closeBufferAndWindowE--exitBinding :: VimBinding-exitBinding = VimBindingE f-    where-      f "<CR>" (VimState { vsMode = Ex, vsOngoingInsertEvents = Ev "" })-          = WholeMatch action-      f evs (VimState { vsMode = Ex })-          = action <$ matchFromBool (evs `elem` ["<Esc>", "<C-c>"])-      f _ _ = NoMatch-      action = exitEx False >> return Drop--finishBindingY :: [EventString -> Maybe ExCommand] -> VimBinding-finishBindingY commandParsers = VimBindingY f-    where f evs state = finishAction commandParsers exEvalY-                      <$ finishPrereq commandParsers (not . cmdIsPure) evs state---finishBindingE :: [EventString -> Maybe ExCommand] -> VimBinding-finishBindingE commandParsers = VimBindingE f-    where f evs state = finishAction commandParsers exEvalE-                      <$ finishPrereq commandParsers cmdIsPure evs state--finishPrereq :: [EventString -> Maybe ExCommand] -> (ExCommand -> Bool)-    -> EventString -> VimState -> MatchResult ()-finishPrereq commandParsers cmdPred evs s =-    matchFromBool . and $-        [ vsMode s == Ex-        , evs == "<CR>"-        , case evStringToExCommand commandParsers (vsOngoingInsertEvents s) of-            Just cmd -> cmdPred cmd-            _ -> False-        ]--finishAction :: MonadEditor m => [EventString -> Maybe ExCommand] ->-    ([EventString -> Maybe ExCommand] -> EventString -> m ()) -> m RepeatToken-finishAction commandParsers execute = do-  s <- withEditor $ withCurrentBuffer elemsB-  withEditor $ exitEx True-  execute commandParsers (Ev $ R.toText s) -- TODO-  return Drop--failBindingE :: VimBinding-failBindingE = VimBindingE f-    where f evs s | vsMode s == Ex && evs == "<CR>"-            = WholeMatch $ do-                exitEx False-                state <- getEditorDyn-                printMsg . _unEv $ "Not an editor command: " <> vsOngoingInsertEvents state-                return Drop-          f _ _ = NoMatch--printable :: VimBinding-printable = VimBindingE f-    where f evs (VimState { vsMode = Ex }) = WholeMatch $ editAction evs-          f _ _ = NoMatch--historyBinding :: VimBinding-historyBinding = VimBindingE f-    where f evs (VimState { vsMode = Ex }) | evs `elem` fmap fst binds-             = WholeMatch $ do-              fromJust $ lookup evs binds-              command <- withCurrentBuffer elemsB-              modifyStateE $ \state -> state {-                  vsOngoingInsertEvents = Ev $ R.toText command-              }-              return Drop-          f _ _ = NoMatch-          binds =-              [ ("<Up>", historyUp)-              , ("<C-p>", historyUp)-              , ("<Down>", historyDown)-              , ("<C-n>", historyDown)-              ]--editAction :: EventString -> EditorM RepeatToken-editAction (Ev evs) = do-  withCurrentBuffer $ case evs of-      "<BS>"  -> bdeleteB-      "<C-h>" -> bdeleteB-      "<C-w>" -> do-          r <- regionOfPartNonEmptyB unitViWordOnLine Backward-          deleteRegionB r-      "<C-r>" -> return () -- TODO-      "<lt>" -> insertB '<'-      "<Del>" -> deleteB Character Forward-      "<Left>" -> moveXorSol 1-      "<C-b>" -> moveXorSol 1-      "<Right>" -> moveXorEol 1-      "<C-f>" -> moveXorEol 1-      "<Home>" -> moveToSol-      "<C-a>" -> moveToSol-      "<End>" -> moveToEol-      "<C-e>" -> moveToEol-      "<C-u>" -> moveToSol >> deleteToEol-      "<C-k>" -> deleteToEol-      evs' -> case T.length evs' of-        1 -> insertB $ T.head evs'-        _ -> error $ "Unhandled event " ++ show evs' ++ " in ex mode"-  command <- R.toText <$> withCurrentBuffer elemsB-  historyPrefixSet command-  modifyStateE $ \state -> state {-    vsOngoingInsertEvents = Ev command-  }-  return Drop
− src/library/Yi/Keymap/Vim/InsertMap.hs 
@@ -1,221 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.InsertMap--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.InsertMap (defInsertMap) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad-import           Data.Char (isDigit)-import           Data.List.NonEmpty hiding (drop, span, dropWhile)-import           Data.Monoid-import qualified Data.Text as T-import           Prelude hiding (head)-import           Yi.Buffer.Adjusted hiding (Insert)-import           Yi.Editor-import           Yi.Event-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Digraph-import           Yi.Keymap.Vim.EventUtils-import           Yi.Keymap.Vim.Motion-import           Yi.Keymap.Vim.StateUtils-import           Yi.Keymap.Vim.Utils-import           Yi.Monad-import qualified Yi.Rope as R-import           Yi.TextCompletion (completeWordB, CompletionScope(..))--defInsertMap :: [(String, Char)] -> [VimBinding]-defInsertMap digraphs =-    [rawPrintable] <> specials digraphs <> [printable]--specials :: [(String, Char)] -> [VimBinding]-specials digraphs =-    [exitBinding digraphs, pasteRegisterBinding, digraphBinding digraphs-    , oneshotNormalBinding, completionBinding, cursorBinding]--exitBinding :: [(String, Char)] -> VimBinding-exitBinding digraphs = VimBindingE f-  where-    f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)-    f evs (VimState { vsMode = (Insert _) })-      | evs `elem` ["<Esc>", "<C-c>"]-      = WholeMatch $ do-        count <- getCountE-        (Insert starter) <- fmap vsMode getEditorDyn-        when (count > 1) $ do-            inputEvents <- fmap (parseEvents . vsOngoingInsertEvents) getEditorDyn-            replicateM_ (count - 1) $ do-                when (starter `elem` "Oo") $ withCurrentBuffer $ insertB '\n'-                replay digraphs inputEvents-        modifyStateE $ \s -> s { vsOngoingInsertEvents = mempty }-        withCurrentBuffer $ moveXorSol 1-        modifyStateE $ \s -> s { vsSecondaryCursors = mempty }-        resetCountE-        switchModeE Normal-        withCurrentBuffer $ whenM isCurrentLineAllWhiteSpaceB $ moveToSol >> deleteToEol-        return Finish-    f _ _ = NoMatch--rawPrintable :: VimBinding-rawPrintable = VimBindingE f-  where-    f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)-    f evs s@(VimState { vsMode = (Insert _)})-          | vsPaste s && evs `notElem` ["<Esc>", "<C-c>"]-              = WholeMatch . withCurrentBuffer $ do-            case evs of-              "<lt>" -> insertB '<'-              "<CR>" -> newlineB-              "<Tab>" -> insertB '\t'-              "<BS>"  -> bdeleteB-              "<C-h>" -> bdeleteB-              "<Del>" -> deleteB Character Forward-              c -> insertN (R.fromText $ _unEv c)-            return Continue-    f _ _ = NoMatch--replay :: [(String, Char)] -> [Event] -> EditorM ()-replay _ [] = return ()-replay digraphs (e1:es1) = do-    state <- getEditorDyn-    let recurse = replay digraphs-        evs1 = eventToEventString e1-        bindingMatch1 = selectPureBinding evs1 state (defInsertMap digraphs)-    case bindingMatch1 of-        WholeMatch action -> void action >> recurse es1-        PartialMatch -> case es1 of-            [] -> return ()-            (e2:es2) -> do-                let evs2 = evs1 <> eventToEventString e2-                    bindingMatch2 = selectPureBinding evs2 state (defInsertMap digraphs)-                case bindingMatch2 of-                    WholeMatch action -> void action >> recurse es2-                    _ -> recurse es2-        _ -> recurse es1--oneshotNormalBinding :: VimBinding-oneshotNormalBinding = VimBindingE (f . T.unpack . _unEv)-  where-    f "<C-o>" (VimState { vsMode = Insert _ }) = PartialMatch-    f ('<':'C':'-':'o':'>':evs) (VimState { vsMode = Insert _ }) =-        action evs <$ stringToMove (Ev . T.pack $ dropWhile isDigit evs)-    f _ _ = NoMatch-    action evs = do-        let (countString, motionCmd) = span isDigit evs-            WholeMatch (Move _style _isJump move) = stringToMove . Ev . T.pack $ motionCmd-        withCurrentBuffer $ move (if null countString then Nothing else Just (read countString))-        return Continue--pasteRegisterBinding :: VimBinding-pasteRegisterBinding = VimBindingE (f . T.unpack . _unEv)-    where f "<C-r>" (VimState { vsMode = Insert _ }) = PartialMatch-          f ('<':'C':'-':'r':'>':regName:[]) (VimState { vsMode = Insert _ })-              = WholeMatch $ do-                  mr <- getRegisterE regName-                  case mr of-                    Nothing -> return ()-                    Just (Register _style rope) -> withCurrentBuffer $ insertRopeWithStyleB rope Inclusive-                  return Continue-          f _ _ = NoMatch--digraphBinding :: [(String, Char)] -> VimBinding-digraphBinding digraphs = VimBindingE (f . T.unpack . _unEv)-    where f ('<':'C':'-':'k':'>':c1:c2:[]) (VimState { vsMode = Insert _ })-            = WholeMatch $ do-                  maybe (return ()) (withCurrentBuffer . insertB) $ charFromDigraph digraphs c1 c2-                  return Continue-          f ('<':'C':'-':'k':'>':_c1:[]) (VimState { vsMode = Insert _ }) = PartialMatch-          f "<C-k>" (VimState { vsMode = Insert _ }) = PartialMatch-          f _ _ = NoMatch--printable :: VimBinding-printable = VimBindingE f-    where f evs state@(VimState { vsMode = Insert _ } ) =-              case selectBinding evs state (specials undefined) of-                  NoMatch -> WholeMatch (printableAction evs)-                  _ -> NoMatch-          f _ _ = NoMatch--printableAction :: EventString -> EditorM RepeatToken-printableAction evs = do-    saveInsertEventStringE evs-    currentCursor <- withCurrentBuffer pointB-    secondaryCursors <- fmap vsSecondaryCursors getEditorDyn-    let allCursors = currentCursor :| secondaryCursors-    marks <- withCurrentBuffer $ forM' allCursors $ \cursor -> do-        moveTo cursor-        -- getMarkB $ Just $ "v_I" <> show cursor-        getMarkB Nothing--    let bufAction = case T.unpack . _unEv $ evs of-          (c:[]) -> insertB c-          "<CR>" -> do-              isOldLineEmpty <- isCurrentLineEmptyB-              shouldTrimOldLine <- isCurrentLineAllWhiteSpaceB-              if isOldLineEmpty-              then newlineB-              else if shouldTrimOldLine-              then savingPointB $ do-                  moveToSol-                  newlineB-              else do-                  newlineB-                  indentAsTheMostIndentedNeighborLineB-              firstNonSpaceB-          "<Tab>" -> do-              IndentSettings et _ts sw <- indentSettingsB-              if et-              then insertN . R.fromString $ replicate sw ' '-              else insertB '\t'-          "<C-t>" -> shiftIndentOfRegionB 1 =<< regionOfB Line-          "<C-d>" -> shiftIndentOfRegionB (-1) =<< regionOfB Line-          "<C-e>" -> insertCharWithBelowB-          "<C-y>" -> insertCharWithAboveB-          "<BS>"  -> bdeleteB-          "<C-h>" -> bdeleteB-          "<Del>" -> deleteB Character Forward-          "<C-w>" -> deleteRegionB =<< regionOfPartNonEmptyB unitViWordOnLine Backward-          "<C-u>" -> bdeleteLineB-          "<lt>" -> insertB '<'-          evs' -> error $ "Unhandled event " <> show evs' <> " in insert mode"--    updatedCursors <- withCurrentBuffer $ do-        updatedCursors <- forM' marks $ \mark -> do-            moveTo =<< use (markPointA mark)-            bufAction-            pointB-        mapM_ deleteMarkB $ toList marks-        moveTo $ head updatedCursors-        return $ toList updatedCursors-    modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 updatedCursors }-    return Continue-  where-    forM' :: Monad m => NonEmpty a -> (a -> m b) -> m (NonEmpty b)-    forM' (x :| xs) f = liftM2 (:|) (f x) (forM xs f)--completionBinding :: VimBinding-completionBinding = VimBindingE (f . T.unpack . _unEv)-    where f evs (VimState { vsMode = (Insert _) })-            | evs `elem` ["<C-n>", "<C-p>"]-            = WholeMatch $ do-                  let _direction = if evs == "<C-n>" then Forward else Backward-                  completeWordB FromAllBuffers-                  return Continue-          f _ _ = NoMatch--cursorBinding :: VimBinding-cursorBinding = VimBindingE f-    where f evs (VimState { vsMode = (Insert _) })-            | evs `elem` ["<Up>", "<Left>", "<Down>", "<Right>"]-            = WholeMatch $ do-                  let WholeMatch (Move _style _isJump move) = stringToMove evs-                  withCurrentBuffer $ move Nothing-                  return Continue-          f _ _ = NoMatch
− src/library/Yi/Keymap/Vim/MatchResult.hs 
@@ -1,36 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.MatchResult--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.MatchResult where--import Control.Applicative--data MatchResult a = NoMatch-                   | PartialMatch-                   | WholeMatch a-                   deriving Functor--instance Applicative MatchResult where-    pure = WholeMatch-    WholeMatch f <*> WholeMatch x = WholeMatch (f x)-    _ <*> _ = NoMatch--instance Alternative MatchResult where-    empty = NoMatch-    WholeMatch x <|> _ = WholeMatch x-    _ <|> WholeMatch x = WholeMatch x-    PartialMatch <|> _ = PartialMatch-    _ <|> PartialMatch = PartialMatch-    _ <|> _ = NoMatch--instance Show (MatchResult a) where-    show (WholeMatch _) = "WholeMatch"-    show PartialMatch = "PartialMatch"-    show NoMatch = "NoMatch"
− src/library/Yi/Keymap/Vim/Motion.hs 
@@ -1,221 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Operator--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ TODO:------ respecting wrap in gj, g0, etc------ gm, go--- ]], [[, [], ][--- [(, [{, ]), ]}--- ]m, ]M, [m, [M--- [#, ]#--- [*, [/, ]*, ]/------ Traversing changelist---- TODO:--- from vim help:------ Special case: "cw" and "cW" are treated like "ce" and "cE" if the cursor is--- on a non-blank.  This is because "cw" is interpreted as change-word, and a--- word does not include the following white space.  {Vi: "cw" when on a blank--- followed by other blanks changes only the first blank; this is probably a--- bug, because "dw" deletes all the blanks}------ Another special case: When using the "w" motion in combination with an--- operator and the last word moved over is at the end of a line, the end of--- that word becomes the end of the operated text, not the first word in the--- next line.------ The original Vi implementation of "e" is buggy.  For example, the "e" command--- will stop on the first character of a line if the previous line was empty.--- But when you use "2e" this does not happen.  In Vim "ee" and "2e" are the--- same, which is more logical.  However, this causes a small incompatibility--- between Vi and Vim.--module Yi.Keymap.Vim.Motion-    ( Move(..)-    , CountedMove(..)-    , stringToMove-    , regionOfMoveB-    , changeMoveStyle-    ) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad-import           Data.Maybe (fromMaybe)-import           Data.Monoid-import qualified Data.Text as T-import           Prelude hiding (repeat)-import           Yi.Buffer.Adjusted-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.StyledRegion--data Move = Move {-    moveStyle :: !RegionStyle-  , moveIsJump :: !Bool-  , moveAction :: Maybe Int -> BufferM ()-  }--data CountedMove = CountedMove !(Maybe Int) !Move--stringToMove :: EventString -> MatchResult Move-stringToMove s = lookupMove s-                 -- TODO: get rid of unpack-                 <|> matchGotoCharMove (T.unpack . _unEv $ s)-                 <|> matchGotoMarkMove (T.unpack . _unEv $ s)--lookupMove :: EventString -> MatchResult Move-lookupMove s = findMoveWithStyle Exclusive exclusiveMotions-           <|> findMoveWithStyle Inclusive inclusiveMotions-           <|> findMoveWithStyle LineWise linewiseMotions-  where findMoveWithStyle style choices =-          fmap (uncurry (Move style)) (lookupBestMatch s (fmap regroup choices))-        regroup (a, b, c) = (a, (b, c))--changeMoveStyle :: (RegionStyle -> RegionStyle) -> Move -> Move-changeMoveStyle smod (Move s j m) = Move (smod s) j m---- Linewise motions which treat no count as being the same as a count of 1.-linewiseMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]-linewiseMotions = fmap withDefaultCount-    [ ("j", False, void . lineMoveRel)-    , ("k", False, void . lineMoveRel . negate)-    , ("<Down>", False, void . lineMoveRel)-    , ("<Up>", False, void . lineMoveRel . negate)-    , ("-", False, const firstNonSpaceB <=< void . lineMoveRel . negate)-    , ("+", False, const firstNonSpaceB <=< void . lineMoveRel)-    , ("_", False, \n -> do-                when (n > 1) $ void $ lineMoveRel (n - 1)-                firstNonSpaceB)-    , ("gg", True, void . gotoLn) -- TODO: save column-    , ("<C-b>", False, scrollScreensB . negate)-    , ("<PageUp>", False, scrollScreensB . negate)-    , ("<C-f>", False, scrollScreensB)-    , ("<PageDown>", False, scrollScreensB)-    , ("H", True, downFromTosB . pred)-    , ("M", True, const middleB)-    , ("L", True, upFromBosB . pred)-    ]-    <> [ ("G", True, gotoXOrEOF) ]----- Exclusive motions which treat no count as being the same as a count of 1.-exclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]-exclusiveMotions = fmap withDefaultCount-    [ ("h", False, moveXorSol)-    , ("l", False, moveXorEol)-    , ("<Left>", False, moveXorSol)-    , ("<Right>", False, moveXorEol)-    , ("w", False, moveForwardB unitViWord)-    , ("W", False, moveForwardB unitViWORD)-    , ("b", False, moveBackwardB unitViWord)-    , ("B", False, moveBackwardB unitViWORD)-    , ("^", False, const firstNonSpaceB)-    , ("g^", False, const firstNonSpaceB) -- TODO: respect wrapping-    , ("g0", False, const moveToSol) -- TODO: respect wrapping-    , ("<Home>", False, const moveToSol)-    -- "0" sort of belongs here, but is currently handled as a special case in some modes-    , ("|", False, \n -> moveToSol >> moveXorEol (n - 1))-    , ("(", True, moveBackwardB unitSentence)-    , (")", True, moveForwardB unitSentence)-    , ("{", True, moveBackwardB unitEmacsParagraph)-    , ("}", True, moveForwardB unitEmacsParagraph)-    ]---- Inclusive motions which treat no count as being the same as a count of 1.-inclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())]-inclusiveMotions = fmap (\(key, action) -> (key, False, action . fromMaybe 1))-    [-    -- Word motions-      ("e", repeat $ genMoveB unitViWord (Forward, InsideBound) Forward)-    , ("E", repeat $ genMoveB unitViWORD (Forward, InsideBound) Forward)-    , ("ge", repeat $ genMoveB unitViWord (Forward, InsideBound) Backward)-    , ("gE", repeat $ genMoveB unitViWORD (Forward, InsideBound) Backward)--    -- Intraline stuff-    , ("g$", \n -> do-                when (n > 1) $ void $ lineMoveRel (n - 1)-                moveToEol)-    , ("<End>", const $ moveToEol >> leftOnEol)-    , ("$", \n -> do-                when (n > 1) $ void $ lineMoveRel (n - 1)-                moveToEol-                leftOnEol)-    , ("g_", \n -> do-                when (n > 1) $ void $ lineMoveRel (n - 1)-                lastNonSpaceB)-    ]-    <>-    [("%", True,-        \maybeCount -> case maybeCount of-            Nothing -> findMatchingPairB-            Just percent -> movePercentageFileB percent)-    ]--repeat :: BufferM () -> Int -> BufferM ()-repeat = flip replicateM_--regionOfMoveB :: CountedMove -> BufferM StyledRegion-regionOfMoveB = normalizeRegion <=< regionOfMoveB'--regionOfMoveB' :: CountedMove -> BufferM StyledRegion-regionOfMoveB' (CountedMove n (Move style _isJump move)) = do-    region <- mkRegion <$> pointB <*> destinationOfMoveB-        (move n >> when (style == Inclusive) leftOnEol)-    return $! StyledRegion style region--moveForwardB, moveBackwardB :: TextUnit -> Int -> BufferM ()-moveForwardB unit = repeat $ genMoveB unit (Backward,InsideBound) Forward-moveBackwardB unit = repeat $ moveB unit Backward--gotoXOrEOF :: Maybe Int -> BufferM ()-gotoXOrEOF n = case n of-    Nothing -> botB >> moveToSol-    Just n' -> gotoLn n' >> moveToSol--withDefaultCount :: (EventString, Bool, Int -> BufferM ()) -> (EventString, Bool, Maybe Int -> BufferM ())-withDefaultCount = over _3 (. fromMaybe 1)--matchGotoMarkMove :: String -> MatchResult Move-matchGotoMarkMove (m:_) | m `notElem` "'`" = NoMatch-matchGotoMarkMove (_:[]) = PartialMatch-matchGotoMarkMove (m:c:[]) = WholeMatch $ Move style True action-    where style = if m == '`' then Inclusive else LineWise-          action _mcount = do-              mmark <- mayGetMarkB [c]-              case mmark of-                  Nothing -> fail $ "Mark " <> show c <> " not set"-                  Just mark -> moveTo =<< use (markPointA mark)-matchGotoMarkMove _ = NoMatch--matchGotoCharMove :: String -> MatchResult Move-matchGotoCharMove (m:[]) | m `elem` "fFtT" = PartialMatch-matchGotoCharMove (m:c:[]) | m `elem` "fFtT" = WholeMatch $ Move style False action-    where (dir, style, move) =-              case m of-                  'f' -> (Forward, Inclusive, nextCInLineInc c)-                  't' -> (Forward, Inclusive, nextCInLineExc c)-                  'F' -> (Backward, Exclusive, prevCInLineInc c)-                  'T' -> (Backward, Exclusive, prevCInLineExc c)-                  _ -> error "can't happen"-          action mcount = do-                  let count = fromMaybe 1 mcount-                  p0 <- pointB-                  replicateM_ (count - 1) $ do-                      move-                      moveB Character dir-                  p1 <- pointB-                  move-                  p2 <- pointB-                  when (p1 == p2) $ moveTo p0-matchGotoCharMove _ = NoMatch
− src/library/Yi/Keymap/Vim/NormalMap.hs 
@@ -1,509 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.NormalMap--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.NormalMap (defNormalMap) where--import           Control.Applicative-import           Control.Lens hiding (re)-import           Control.Monad-import           Data.Char-import           Data.HashMap.Strict (singleton, lookup)-import           Data.List (group)-import           Data.Maybe (fromMaybe)-import           Data.Monoid-import qualified Data.Text as T-import           Prelude hiding (null, lookup)-import           System.Directory (doesFileExist)-import           Yi.Buffer.Adjusted hiding (Insert)-import           Yi.Core (quitEditor, closeWindow)-import           Yi.Editor-import           Yi.Event-import           Yi.File (editFile, fwriteE)-import           Yi.History-import           Yi.Keymap-import           Yi.Keymap.Keys-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Eval-import           Yi.Keymap.Vim.Motion-import           Yi.Keymap.Vim.Operator-import           Yi.Keymap.Vim.Search-import           Yi.Keymap.Vim.StateUtils-import           Yi.Keymap.Vim.StyledRegion-import           Yi.Keymap.Vim.Tag-import           Yi.Keymap.Vim.Utils-import           Yi.MiniBuffer-import           Yi.Misc-import           Yi.Monad-import           Yi.Regex (seInput, makeSearchOptsM)-import qualified Yi.Rope as R-import           Yi.Search (getRegexE, isearchInitE,-                            setRegexE, makeSimpleSearch)-import           Yi.String-import           Yi.Tag (Tag(..))-import           Yi.Utils (io)--mkDigitBinding :: Char -> VimBinding-mkDigitBinding c = mkBindingE Normal Continue (char c, return (), mutate)-  where-    mutate vs@(VimState {vsCount = Nothing}) = vs { vsCount = Just d }-    mutate vs@(VimState {vsCount = Just count}) =-      vs { vsCount = Just $ count * 10 + d }-    d = ord c - ord '0'--defNormalMap :: [VimOperator] -> [VimBinding]-defNormalMap operators =-    [recordMacroBinding, finishRecordingMacroBinding, playMacroBinding] <>-    [zeroBinding, repeatBinding, motionBinding, searchBinding] <>-    [chooseRegisterBinding, setMarkBinding] <>-    fmap mkDigitBinding ['1' .. '9'] <>-    operatorBindings operators <>-    finishingBingings <>-    continuingBindings <>-    nonrepeatableBindings <>-    jumpBindings <>-    fileEditBindings <>-    [tabTraversalBinding] <>-    [tagJumpBinding, tagPopBinding]--tagJumpBinding :: VimBinding-tagJumpBinding = mkBindingY Normal (Event (KASCII ']') [MCtrl], f, id)-   where f = withCurrentBuffer readCurrentWordB >>= gotoTag . Tag . R.toText--tagPopBinding :: VimBinding-tagPopBinding = mkBindingY Normal (Event (KASCII 't') [MCtrl], f, id)-   where f = popTag--motionBinding :: VimBinding-motionBinding = mkMotionBinding Drop $-    \m -> case m of-        Normal -> True-        _ -> False--chooseRegisterBinding :: VimBinding-chooseRegisterBinding = mkChooseRegisterBinding ((== Normal) . vsMode)--zeroBinding :: VimBinding-zeroBinding = VimBindingE f-    where f "0" (VimState {vsMode = Normal}) = WholeMatch $ do-              currentState <- getEditorDyn-              case vsCount currentState of-                  Just c -> do-                      setCountE (10 * c)-                      return Continue-                  Nothing -> do-                      withCurrentBuffer moveToSol-                      resetCountE-                      setStickyEolE False-                      return Drop-          f _ _ = NoMatch--repeatBinding :: VimBinding-repeatBinding = VimBindingE (f . T.unpack . _unEv)-  where-    f "." (VimState {vsMode = Normal}) = WholeMatch $ do-      currentState <- getEditorDyn-      case vsRepeatableAction currentState of-          Nothing -> return ()-          Just (RepeatableAction prevCount (Ev actionString)) -> do-              let count = showT $ fromMaybe prevCount (vsCount currentState)-              scheduleActionStringForEval . Ev $ count <> actionString-              resetCountE-      return Drop-    f _ _ = NoMatch--jumpBindings :: [VimBinding]-jumpBindings = fmap (mkBindingE Normal Drop)-    [ (ctrlCh 'o', jumpBackE, id)-    , (spec KTab, jumpForwardE, id)-    , (ctrlCh '^', controlCarrot, resetCount)-    , (ctrlCh '6', controlCarrot, resetCount)-    ]-  where-    controlCarrot = alternateBufferE . (+ (-1)) =<< getCountE--finishingBingings :: [VimBinding]-finishingBingings = fmap (mkStringBindingE Normal Finish)-    [ ("x", cutCharE Forward =<< getCountE, resetCount)-    , ("<Del>", cutCharE Forward =<< getCountE, resetCount)-    , ("X", cutCharE Backward =<< getCountE, resetCount)--    , ("D",-        do region <- withCurrentBuffer $ regionWithTwoMovesB (return ()) moveToEol-           void $ operatorApplyToRegionE opDelete 1 $ StyledRegion Exclusive region-        , id)--    -- Pasting-    , ("p", pasteAfter, id)-    , ("P", pasteBefore, id)--    -- Miscellaneous.-    , ("~", do-           count <- getCountE-           withCurrentBuffer $ do-               transformCharactersInLineN count switchCaseChar-               leftOnEol-        , resetCount)-    , ("J", do-        count <- fmap (flip (-) 1 . max 2) getCountE-        withCurrentBuffer $ do-            (StyledRegion s r) <- case stringToMove "j" of-                WholeMatch m -> regionOfMoveB $ CountedMove (Just count) m-                _ -> error "can't happen"-            void $ lineMoveRel $ count - 1-            moveToEol-            joinLinesB =<< convertRegionToStyleB r s-       , resetCount)-    ]--pasteBefore :: EditorM ()-pasteBefore = do-    -- TODO: use count-    register <- getRegisterE . vsActiveRegister =<< getEditorDyn-    case register of-        Nothing -> return ()-        Just (Register LineWise rope) -> withCurrentBuffer $ unless (R.null rope) $-            -- Beware of edge cases ahead-            insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise-        Just (Register style rope) -> withCurrentBuffer $ pasteInclusiveB rope style--pasteAfter :: EditorM ()-pasteAfter = do-    -- TODO: use count-    register <- getRegisterE . vsActiveRegister =<< getEditorDyn-    case register of-        Nothing -> return ()-        Just (Register LineWise rope) -> withCurrentBuffer $ do-            -- Beware of edge cases ahead-            moveToEol-            eof <- atEof-            when eof $ insertB '\n'-            rightB-            insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise-            when eof $ savingPointB $ do-                newSize <- sizeB-                moveTo (newSize - 1)-                curChar <- readB-                when (curChar == '\n') $ deleteN 1-        Just (Register style rope) -> withCurrentBuffer $ do-            whenM (fmap not atEol) rightB-            pasteInclusiveB rope style--operatorBindings :: [VimOperator] -> [VimBinding]-operatorBindings = fmap mkOperatorBinding-  where-    mkT (Op o) = (Ev o, return (), switchMode . NormalOperatorPending $ Op o)-    mkOperatorBinding (VimOperator {operatorName = opName}) =-      mkStringBindingE Normal Continue $ mkT opName--continuingBindings :: [VimBinding]-continuingBindings = fmap (mkStringBindingE Normal Continue)-    [ ("r", return (), switchMode ReplaceSingleChar) -- TODO make it just a binding--    -- Transition to insert mode-    , ("i", return (), switchMode $ Insert 'i')-    , ("<Ins>", return (), switchMode $ Insert 'i')-    , ("I", withCurrentBuffer firstNonSpaceB, switchMode $ Insert 'I')-    , ("a", withCurrentBuffer rightB, switchMode $ Insert 'a')-    , ("A", withCurrentBuffer moveToEol, switchMode $ Insert 'A')-    , ("o", withCurrentBuffer $ do-          moveToEol-          newlineB-          indentAsTheMostIndentedNeighborLineB-        , switchMode $ Insert 'o')-    , ("O", withCurrentBuffer $ do-                     moveToSol-                     newlineB-                     leftB-                     indentAsNextB-        , switchMode $ Insert 'O')--    -- Transition to visual-    , ("v", enableVisualE Inclusive, resetCount . switchMode (Visual Inclusive))-    , ("V", enableVisualE LineWise, resetCount . switchMode (Visual LineWise))-    , ("<C-v>", enableVisualE Block, resetCount . switchMode (Visual Block))-    ]--nonrepeatableBindings :: [VimBinding]-nonrepeatableBindings = fmap (mkBindingE Normal Drop)-    [ (spec KEsc, return (), resetCount)-    , (ctrlCh 'c', return (), resetCount)--    -- Changing-    , (char 'C',-        do region <- withCurrentBuffer $ regionWithTwoMovesB (return ()) moveToEol-           void $ operatorApplyToRegionE opChange 1 $ StyledRegion Exclusive region-        , switchMode $ Insert 'C')-    , (char 's', cutCharE Forward =<< getCountE, switchMode $ Insert 's')-    , (char 'S',-        do region <- withCurrentBuffer $ regionWithTwoMovesB firstNonSpaceB moveToEol-           void $ operatorApplyToRegionE opDelete 1 $ StyledRegion Exclusive region-        , switchMode $ Insert 'S')--    -- Replacing-    , (char 'R', return (), switchMode Replace)--    -- Yanking-    , ( char 'Y'-      , do region <- withCurrentBuffer $ regionWithTwoMovesB (return ()) moveToEol-           void $ operatorApplyToRegionE opYank 1 $ StyledRegion Exclusive region-      , id-      )--    -- Search-    , (char '*', addVimJumpHereE >> searchWordE True Forward, resetCount)-    , (char '#', addVimJumpHereE >> searchWordE True Backward, resetCount)-    , (char 'n', addVimJumpHereE >> withCount (continueSearching id), resetCount)-    , (char 'N', addVimJumpHereE >> withCount (continueSearching reverseDir), resetCount)-    , (char ';', repeatGotoCharE id, id)-    , (char ',', repeatGotoCharE reverseDir, id)--    -- Repeat-    , (char '&', return (), id) -- TODO--    -- Transition to ex-    , (char ':', do-        void (spawnMinibufferE ":" id)-        historyStart-        historyPrefixSet ""-      , switchMode Ex)--    -- Undo-    , (char 'u', withCountOnBuffer0 undoB >> withCurrentBuffer leftOnEol, id)-    , (char 'U', withCountOnBuffer0 undoB >> withCurrentBuffer leftOnEol, id) -- TODO-    , (ctrlCh 'r', withCountOnBuffer0 redoB >> withCurrentBuffer leftOnEol, id)--    -- scrolling-    ,(ctrlCh 'b', getCountE >>= withCurrentBuffer . upScreensB, id)-    ,(ctrlCh 'f', getCountE >>= withCurrentBuffer . downScreensB, id)-    ,(ctrlCh 'u', getCountE >>= withCurrentBuffer . vimScrollByB (negate . (`div` 2)), id)-    ,(ctrlCh 'd', getCountE >>= withCurrentBuffer . vimScrollByB (`div` 2), id)-    ,(ctrlCh 'y', getCountE >>= withCurrentBuffer . vimScrollB . negate, id)-    ,(ctrlCh 'e', getCountE >>= withCurrentBuffer . vimScrollB, id)--    -- unsorted TODO-    , (char '-', return (), id)-    , (char '+', return (), id)-    , (spec KEnter, return (), id)-    ] <> fmap (mkStringBindingE Normal Drop)-    [ ("g*", searchWordE False Forward, resetCount)-    , ("g#", searchWordE False Backward, resetCount)-    , ("gd", withCurrentBuffer $ withModeB modeGotoDeclaration, resetCount)-    , ("gD", withCurrentBuffer $ withModeB modeGotoDeclaration, resetCount)-    , ("<C-g>", printFileInfoE, resetCount)-    , ("<C-w>c", tryCloseE, resetCount)-    , ("<C-w>o", closeOtherE, resetCount)-    , ("<C-w>s", splitE, resetCount)-    , ("<C-w>w", nextWinE, resetCount)-    , ("<C-w><C-w>", nextWinE, resetCount)-    , ("<C-w>W", prevWinE, resetCount)-    , ("<C-w>p", prevWinE, resetCount)-    , ("<C-a>", getCountE >>= withCurrentBuffer . incrementNextNumberByB, resetCount)-    , ("<C-x>", getCountE >>= withCurrentBuffer . incrementNextNumberByB . negate, resetCount)--    -- z commands-    -- TODO Add prefix count-    , ("zt", withCurrentBuffer scrollCursorToTopB, resetCount)-    , ("zb", withCurrentBuffer scrollCursorToBottomB, resetCount)-    , ("zz", withCurrentBuffer scrollToCursorB, resetCount)-    {- -- TODO Horizantal scrolling-    , ("ze", withCurrentBuffer .., resetCount)-    , ("zs", withCurrentBuffer .., resetCount)-    , ("zH", withCurrentBuffer .., resetCount)-    , ("zL", withCurrentBuffer .., resetCount)-    , ("zh", withCurrentBuffer .., resetCount)-    , ("zl", withCurrentBuffer .., resetCount)-    -}-    , ("z.", withCurrentBuffer $ scrollToCursorB >> moveToSol, resetCount)-    , ("z+", withCurrentBuffer scrollToLineBelowWindowB, resetCount)-    , ("z-", withCurrentBuffer $ scrollCursorToBottomB >> moveToSol, resetCount)-    , ("z^", withCurrentBuffer scrollToLineAboveWindowB, resetCount)-    {- -- TODO Code folding-    , ("zf", .., resetCount)-    , ("zc", .., resetCount)-    , ("zo", .., resetCount)-    , ("za", .., resetCount)-    , ("zC", .., resetCount)-    , ("zO", .., resetCount)-    , ("zA", .., resetCount)-    , ("zr", .., resetCount)-    , ("zR", .., resetCount)-    , ("zm", .., resetCount)-    , ("zM", .., resetCount)-    -}--    -- Z commands-    ] <> fmap (mkStringBindingY Normal)-    [ ("ZQ", quitEditor, id)-    -- TODO ZZ should replicate :x not :wq-    , ("ZZ", fwriteE >> closeWindow, id)-    ]--fileEditBindings :: [VimBinding]-fileEditBindings =  fmap (mkStringBindingY Normal)-    [ ("gf", openFileUnderCursor Nothing, resetCount)-    , ("<C-w>gf", openFileUnderCursor $ Just newTabE, resetCount)-    , ("<C-w>f", openFileUnderCursor $ Just (splitE >> prevWinE), resetCount)-    ]--setMarkBinding :: VimBinding-setMarkBinding = VimBindingE (f . T.unpack . _unEv)-    where f _ s | vsMode s /= Normal = NoMatch-          f "m" _ = PartialMatch-          f ('m':c:[]) _ = WholeMatch $ do-              withCurrentBuffer $ setNamedMarkHereB [c]-              return Drop-          f _ _ = NoMatch--searchWordE :: Bool -> Direction -> EditorM ()-searchWordE wholeWord dir = do-  word <- withCurrentBuffer readCurrentWordB--  let search re = do-        setRegexE re-        assign searchDirectionA dir-        withCount $ continueSearching (const dir)--  if wholeWord-  then case makeSearchOptsM [] $ "\\<" <> R.toString word <> "\\>" of-          Right re -> search re-          Left _ -> return ()-  else search $ makeSimpleSearch word--searchBinding :: VimBinding-searchBinding = VimBindingE (f . T.unpack . _unEv)-    where f evs (VimState { vsMode = Normal }) | evs `elem` group "/?"-            = WholeMatch $ do-                  state <- fmap vsMode getEditorDyn-                  let dir = if evs == "/" then Forward else Backward-                  switchModeE $ Search state dir-                  isearchInitE dir-                  historyStart-                  historyPrefixSet T.empty-                  return Continue-          f _ _ = NoMatch--continueSearching :: (Direction -> Direction) -> EditorM ()-continueSearching fdir = do-  getRegexE >>= \case-    Just regex -> do-      dir <- fdir <$> use searchDirectionA-      printMsg . T.pack $ (if dir == Forward then '/' else '?') : seInput regex-      void $ doVimSearch Nothing [] dir-    Nothing -> printMsg "No previous search pattern"--repeatGotoCharE :: (Direction -> Direction) -> EditorM ()-repeatGotoCharE mutateDir = do-    prevCommand <- fmap vsLastGotoCharCommand getEditorDyn-    count <- getCountE-    withCurrentBuffer $ case prevCommand of-        Just (GotoCharCommand c dir style) -> do-            let newDir = mutateDir dir-            let move = gotoCharacterB c newDir style True-            p0 <- pointB-            replicateM_ (count - 1) $ do-                move-                when (style == Exclusive) $ moveB Character newDir-            p1 <- pointB-            move-            p2 <- pointB-            when (p1 == p2) $ moveTo p0-        Nothing -> return ()--enableVisualE :: RegionStyle -> EditorM ()-enableVisualE style = withCurrentBuffer $ do-    putRegionStyle style-    rectangleSelectionA .= (Block == style)-    setVisibleSelection True-    pointB >>= setSelectionMarkPointB--cutCharE :: Direction -> Int -> EditorM ()-cutCharE dir count = do-    r <- withCurrentBuffer $ do-        p0 <- pointB-        (if dir == Forward then moveXorEol else moveXorSol) count-        p1 <- pointB-        let region = mkRegion p0 p1-        rope <- readRegionB region-        deleteRegionB $ mkRegion p0 p1-        leftOnEol-        return rope-    regName <- fmap vsActiveRegister getEditorDyn-    setRegisterE regName Inclusive r--tabTraversalBinding :: VimBinding-tabTraversalBinding = VimBindingE (f . T.unpack . _unEv)-    where f "g" (VimState { vsMode = Normal }) = PartialMatch-          f ('g':c:[]) (VimState { vsMode = Normal }) | c `elem` "tT" = WholeMatch $ do-              count <- getCountE-              replicateM_ count $ if c == 'T' then previousTabE else nextTabE-              resetCountE-              return Drop-          f _ _ = NoMatch--openFileUnderCursor :: Maybe (EditorM ()) -> YiM ()-openFileUnderCursor editorAction = do-  fileName <- fmap R.toString . withEditor . withCurrentBuffer $ readUnitB unitViWORD-  fileExists <- io $ doesFileExist fileName-  if (not fileExists) then-      withEditor . fail $ "Can't find file \"" <> fileName <> "\""-  else do-      maybeM withEditor editorAction-      void . editFile $ fileName--recordMacroBinding :: VimBinding-recordMacroBinding = VimBindingE (f . T.unpack . _unEv)-    where f "q" (VimState { vsMode = Normal-                          , vsCurrentMacroRecording = Nothing })-                = PartialMatch-          f ['q', c] (VimState { vsMode = Normal })-              = WholeMatch $ do-                    modifyStateE $ \s ->-                        s { vsCurrentMacroRecording = Just (c, mempty) }-                    return Finish-          f _ _ = NoMatch--finishRecordingMacroBinding :: VimBinding-finishRecordingMacroBinding = VimBindingE (f . T.unpack . _unEv)-    where f "q" (VimState { vsMode = Normal-                          , vsCurrentMacroRecording = Just (macroName, Ev macroBody) })-                = WholeMatch $ do-                      let reg = Register Exclusive (R.fromText (T.drop 2 macroBody))-                      modifyStateE $ \s ->-                          s { vsCurrentMacroRecording = Nothing-                              , vsRegisterMap = singleton macroName reg-                                              <> vsRegisterMap s-                              }-                      return Finish-          f _ _ = NoMatch--playMacroBinding :: VimBinding-playMacroBinding = VimBindingE (f . T.unpack . _unEv)-    where f "@" (VimState { vsMode = Normal }) = PartialMatch-          f ['@', c] (VimState { vsMode = Normal-                               , vsRegisterMap = registers-                               , vsCount = mbCount }) = WholeMatch $ do-              resetCountE-              case lookup c registers of-                  Just (Register _ evs) -> do-                      let count = fromMaybe 1 mbCount-                          mkAct = Ev . T.replicate count . R.toText-                      scheduleActionStringForEval . mkAct $ evs-                      return Finish-                  Nothing -> return Drop-          f _ _ = NoMatch---- TODO: withCount name implies that parameter has type (Int -> EditorM ())---       Is there a better name for this function?-withCount :: EditorM () -> EditorM ()-withCount action = flip replicateM_ action =<< getCountE--withCountOnBuffer0 :: BufferM () -> EditorM ()-withCountOnBuffer0 action = withCount $ withCurrentBuffer action
− src/library/Yi/Keymap/Vim/NormalOperatorPendingMap.hs 
@@ -1,165 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.NormalOperatorPendingMap--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.NormalOperatorPendingMap-       (defNormalOperatorPendingMap) where--import           Control.Applicative-import           Control.Monad-import           Data.Char (isDigit)-import           Data.List (isPrefixOf)-import           Data.Maybe (fromMaybe, fromJust)-import           Data.Monoid-import qualified Data.Text as T-import           Yi.Buffer.Adjusted hiding (Insert)-import           Yi.Editor-import           Yi.Keymap.Keys-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Motion-import           Yi.Keymap.Vim.Operator-import           Yi.Keymap.Vim.StateUtils-import           Yi.Keymap.Vim.StyledRegion-import           Yi.Keymap.Vim.TextObject-import           Yi.Keymap.Vim.Utils--defNormalOperatorPendingMap :: [VimOperator] -> [VimBinding]-defNormalOperatorPendingMap operators = [textObject operators, escBinding]--textObject :: [VimOperator] -> VimBinding-textObject operators = VimBindingE f-  where-    f evs vs = case vsMode vs of-                        NormalOperatorPending _ -> WholeMatch $ action evs-                        _ -> NoMatch-    action (Ev evs) = do-        currentState <- getEditorDyn--        let partial = vsTextObjectAccumulator currentState-            opChar = Ev . T.pack $ lastCharForOperator op-            op = fromJust $ stringToOperator operators opname-            (NormalOperatorPending opname) = vsMode currentState--        -- vim treats cw as ce-        let evs' = if opname == Op "c" && T.last evs == 'w' &&-                       (case parseOperand opChar (evr evs) of-                           JustMove _ -> True-                           _ -> False)-                   then T.init evs `T.snoc` 'e'-                   else evs-            -- TODO: fix parseOperand to take EventString as second arg-            evr x = T.unpack . _unEv $ partial <> Ev x-            operand = parseOperand opChar (evr evs')--        case operand of-            NoOperand -> do-                dropTextObjectAccumulatorE-                resetCountE-                switchModeE Normal-                return Drop-            PartialOperand -> do-                accumulateTextObjectEventE (Ev evs)-                return Continue-            _ -> do-                count <- getCountE-                dropTextObjectAccumulatorE-                token <- case operand of-                    JustTextObject cto@(CountedTextObject n _) -> do-                        normalizeCountE (Just n)-                        operatorApplyToTextObjectE op 1 $-                            changeTextObjectCount (count * n) cto-                    JustMove (CountedMove n m) -> do-                        mcount <- getMaybeCountE-                        normalizeCountE n-                        region <- withCurrentBuffer $ regionOfMoveB $ CountedMove (maybeMult mcount n) m-                        operatorApplyToRegionE op 1 region-                    JustOperator n style -> do-                        normalizeCountE (Just n)-                        normalizedCount <- getCountE-                        region <- withCurrentBuffer $ regionForOperatorLineB normalizedCount style-                        curPoint <- withCurrentBuffer pointB-                        token <- operatorApplyToRegionE op 1 region-                        when (opname == Op "y") $-                            withCurrentBuffer $ moveTo curPoint-                        return token--                    _ -> error "can't happen"-                resetCountE-                return token--regionForOperatorLineB :: Int -> RegionStyle -> BufferM StyledRegion-regionForOperatorLineB n style = normalizeRegion =<< StyledRegion style <$> savingPointB (do-    current <- pointB-    if n == 1-    then do-        firstNonSpaceB-        p0 <- pointB-        return $! mkRegion p0 current-    else do-        void $ lineMoveRel (n-2)-        moveToEol-        rightB-        firstNonSpaceB-        p1 <- pointB-        return $! mkRegion current p1)--escBinding :: VimBinding-escBinding = mkBindingE ReplaceSingleChar Drop (spec KEsc, return (), resetCount . switchMode Normal)--data OperandParseResult = JustTextObject !CountedTextObject-                         | JustMove !CountedMove-                         | JustOperator !Int !RegionStyle -- ^ like dd and d2vd-                         | PartialOperand-                         | NoOperand--parseOperand :: EventString -> String -> OperandParseResult-parseOperand opChar s = parseCommand mcount styleMod opChar commandString-    where (mcount, styleModString, commandString) = splitCountModifierCommand s-          styleMod = case styleModString of-            "" -> id-            "V" -> const LineWise-            "<C-v>" -> const Block-            "v" -> \style -> case style of-              Exclusive -> Inclusive-              _ -> Exclusive-            _ -> error "Can't happen"---- | TODO: should this String be EventString?-parseCommand :: Maybe Int -> (RegionStyle -> RegionStyle)-             -> EventString -> String -> OperandParseResult-parseCommand _ _ _ "" = PartialOperand-parseCommand _ _ _ "i" = PartialOperand-parseCommand _ _ _ "a" = PartialOperand-parseCommand _ _ _ "g" = PartialOperand-parseCommand n sm o s | o' == s = JustOperator (fromMaybe 1 n) (sm LineWise)-  where o' = T.unpack . _unEv $ o-parseCommand n sm _ s = case stringToMove . Ev $ T.pack s of-  WholeMatch m -> JustMove $ CountedMove n $ changeMoveStyle sm m-  PartialMatch -> PartialOperand-  NoMatch -> case stringToTextObject s of-    Just to -> JustTextObject $ CountedTextObject (fromMaybe 1 n)-               $ changeTextObjectStyle sm to-    Nothing -> NoOperand----- Parse event string that can go after operator--- w -> (Nothing, "", "w")--- 2w -> (Just 2, "", "w")--- V2w -> (Just 2, "V", "w")--- v2V3<C-v>w -> (Just 6, "<C-v>", "w")--- vvvvvvvvvvvvvw -> (Nothing, "v", "w")-splitCountModifierCommand :: String -> (Maybe Int, String, String)-splitCountModifierCommand = go "" Nothing [""]-    where go ds count mods (h:t) | isDigit h = go (ds <> [h]) count mods t-          go ds@(_:_) count mods s@(h:_) | not (isDigit h) = go [] (maybeMult count (Just (read ds))) mods s-          go [] count mods (h:t) | h `elem` "vV" = go [] count ([h]:mods) t-          go [] count mods s | "<C-v>" `isPrefixOf` s = go [] count ("<C-v>":mods) (drop 5 s)-          go [] count mods s = (count, head mods, s)-          go ds count mods [] = (maybeMult count (Just (read ds)), head mods, [])-          go (_:_) _ _ (_:_) = error "Can't happen because isDigit and not isDigit cover every case"
− src/library/Yi/Keymap/Vim/Operator.hs 
@@ -1,175 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Operator--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Implements some operators for the Vim keymap.--module Yi.Keymap.Vim.Operator-    ( VimOperator(..)-    , defOperators-    , opDelete-    , opChange-    , opYank-    , opFormat-    , stringToOperator-    , mkCharTransformOperator-    , operatorApplyToTextObjectE-    , lastCharForOperator-    ) where--import           Control.Monad-import           Data.Char (toLower, toUpper)-import           Data.Foldable (find)-import           Data.Monoid-import qualified Data.Text as T-import           Yi.Buffer.Adjusted hiding (Insert)-import           Yi.Editor-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.EventUtils-import           Yi.Keymap.Vim.StateUtils-import           Yi.Keymap.Vim.StyledRegion-import           Yi.Keymap.Vim.TextObject-import           Yi.Keymap.Vim.Utils-import           Yi.Misc--data VimOperator = VimOperator {-    operatorName :: !OperatorName-  , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken-}--defOperators :: [VimOperator]-defOperators =-    [ opYank-    , opDelete-    , opChange-    , opFormat-    , mkCharTransformOperator "gu" toLower-    , mkCharTransformOperator "gU" toUpper-    , mkCharTransformOperator "g~" switchCaseChar-    , mkCharTransformOperator "g?" rot13Char-    , mkShiftOperator ">" id-    , mkShiftOperator "<lt>" negate-    ]--stringToOperator :: [VimOperator] -> OperatorName -> Maybe VimOperator-stringToOperator ops name = find ((== name) . operatorName) ops--operatorApplyToTextObjectE :: VimOperator -> Int -> CountedTextObject -> EditorM RepeatToken-operatorApplyToTextObjectE op count cto = do-    styledRegion <- withCurrentBuffer $ regionOfTextObjectB cto-    operatorApplyToRegionE op count styledRegion--opYank :: VimOperator-opYank = VimOperator {-    operatorName = "y"-  , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do-        s <- withCurrentBuffer $ readRegionRopeWithStyleB reg style-        regName <- fmap vsActiveRegister getEditorDyn-        setRegisterE regName style s-        withCurrentBuffer $ moveTo . regionStart =<< convertRegionToStyleB reg style-        switchModeE Normal-        return Finish-}--opDelete :: VimOperator-opDelete = VimOperator {-    operatorName = "d"-  , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do-        s <- withCurrentBuffer $ readRegionRopeWithStyleB reg style-        regName <- fmap vsActiveRegister getEditorDyn-        setRegisterE regName style s-        withCurrentBuffer $ do-            point <- deleteRegionWithStyleB reg style-            moveTo point-            eof <- atEof-            if eof-            then do-                leftB-                c <- readB-                when (c == '\n') $ deleteN 1 >> moveToSol-            else leftOnEol-        switchModeE Normal-        return Finish-}--opChange :: VimOperator-opChange = VimOperator {-    operatorName = "c"-  , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do-        s <- withCurrentBuffer $ readRegionRopeWithStyleB reg style-        regName <- fmap vsActiveRegister getEditorDyn-        setRegisterE regName style s-        withCurrentBuffer $ do-            point <- deleteRegionWithStyleB reg style-            moveTo point-        switchModeE $ Insert 'c'-        return Continue-}--opFormat :: VimOperator-opFormat = VimOperator {-    operatorName = "gq"-  , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do-      withCurrentBuffer $ formatRegionB style reg-      switchModeE Normal-      return Finish-}--formatRegionB :: RegionStyle -> Region -> BufferM ()-formatRegionB Block _reg = return ()-formatRegionB _style reg = do-    -- TODO: handle indentation-    -- TODO: break words-    let (start, end) = (regionStart reg, regionEnd reg)-    moveTo start-    let go = do-            rightB-            p <- pointB-            col <- curCol-            char <- readB-            unless (p >= end) $-                if col < 80 && char == '\n'-                then writeB ' ' >> go-                else if col == 80 && char /= '\n'-                then writeB '\n' >> go-                else go-    go-    moveTo start--mkCharTransformOperator :: OperatorName -> (Char -> Char) -> VimOperator-mkCharTransformOperator name f = VimOperator {-    operatorName = name-  , operatorApplyToRegionE = \count sreg -> do-        withCurrentBuffer $ transformCharactersInRegionB sreg-                    $ foldr (.) id (replicate count f)-        switchModeE Normal-        return Finish-}--mkShiftOperator :: OperatorName -> (Int -> Int) -> VimOperator-mkShiftOperator name countMod = VimOperator {-    operatorName = name-  , operatorApplyToRegionE = \count (StyledRegion style reg) -> do-        withCurrentBuffer $-            if style == Block-            then indentBlockRegionB (countMod count) reg-            else do-                reg' <- convertRegionToStyleB reg style-                shiftIndentOfRegionB (countMod count) reg'-        switchModeE Normal-        return Finish-}--lastCharForOperator :: VimOperator -> String-lastCharForOperator (VimOperator { operatorName = name })-    -- This cast here seems stupid, maybe we should only have one-    -- type?-    = case parseEvents (Ev . _unOp $ name) of-        [] -> error $ "invalid operator name " <> T.unpack (_unOp name)-        evs -> T.unpack . _unEv . eventToEventString $ last evs
− src/library/Yi/Keymap/Vim/ReplaceMap.hs 
@@ -1,90 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.ReplaceMap--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.ReplaceMap (defReplaceMap) where--import           Control.Monad-import           Data.Monoid-import qualified Data.Text as T-import           Yi.Buffer.Adjusted-import           Yi.Editor-import           Yi.Keymap.Keys-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.EventUtils-import           Yi.Keymap.Vim.StateUtils-import           Yi.Keymap.Vim.Utils--defReplaceMap :: [VimBinding]-defReplaceMap = specials <> [printable]--specials :: [VimBinding]-specials = fmap (mkBindingE Replace Finish)-             [ (spec KEsc, exitReplaceMode, resetCount . switchMode Normal)-             , (ctrlCh 'c', exitReplaceMode, resetCount . switchMode Normal)-             ]--exitReplaceMode :: EditorM ()-exitReplaceMode = do-  count <- getCountE-  when (count > 1) $ do-      inputEvents <- fmap (parseEvents . vsOngoingInsertEvents) getEditorDyn-      replicateM_ (count - 1) $ mapM_ (printableAction . eventToEventString) inputEvents-  modifyStateE $ \s -> s { vsOngoingInsertEvents = mempty }-  withCurrentBuffer $ moveXorSol 1--printable :: VimBinding-printable = VimBindingE f-    where f evs s | Replace == vsMode s = WholeMatch $ printableAction evs-          f _ _ = NoMatch--printableAction :: EventString -> EditorM RepeatToken-printableAction evs = do-    saveInsertEventStringE evs-    withCurrentBuffer $ case T.unpack . _unEv $ evs of-        [c]    -> insertOrReplaceB c-        "<CR>" -> insertOrReplaceB '\n'-        -- For testing purposes assume noexpandtab, tw=4-        "<Esc>" -> replicateM_ 4 $ insertOrReplaceB ' '-        "<C-t>" -> return () -- TODO-        "<C-d>" -> return () -- TODO-        "<C-e>" -> insertOrReplaceCharWithBelowB-        "<C-y>" -> insertOrReplaceCharWithAboveB-        "<C-h>" -> return () -- TODO-        "<C-j>" -> return () -- TODO-        "<C-o>" -> return () -- TODO-        "<C-w>" -> return () -- TODO-        "<C-r>" -> return () -- TODO-        "<C-k>" -> return () -- TODO-        evs' -> error $ "Unhandled event " <> evs' <> " in replace mode"-    return Continue--insertOrReplaceB :: Char -> BufferM ()-insertOrReplaceB c = do-    currentChar <- readB-    if currentChar == '\n'-    then insertB c-    else replaceCharB c-    rightB--insertOrReplaceCharWithBelowB :: BufferM ()-insertOrReplaceCharWithBelowB = do-    currentChar <- readB-    if currentChar == '\n'-    then insertCharWithBelowB-    else replaceCharWithBelowB-    rightB--insertOrReplaceCharWithAboveB :: BufferM ()-insertOrReplaceCharWithAboveB = do-    currentChar <- readB-    if currentChar == '\n'-    then insertCharWithAboveB-    else replaceCharWithAboveB-    rightB
− src/library/Yi/Keymap/Vim/ReplaceSingleCharMap.hs 
@@ -1,61 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.ReplaceSingleCharMap--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.ReplaceSingleCharMap-    ( defReplaceSingleMap-    ) where--import           Control.Monad--import           Data.Maybe (fromMaybe)--import qualified Data.Text as T-import           Yi.Buffer.Adjusted-import           Yi.Editor-import           Yi.Keymap.Keys-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.StateUtils-import           Yi.Keymap.Vim.Utils-import           Yi.Utils--defReplaceSingleMap :: [VimBinding]-defReplaceSingleMap = [escBinding, actualReplaceBinding]--escBinding :: VimBinding-escBinding = mkBindingE ReplaceSingleChar Drop (spec KEsc, return (), resetCount . switchMode Normal)--actualReplaceBinding :: VimBinding-actualReplaceBinding = VimBindingE (f . T.unpack . _unEv)-  where-    f evs s | ReplaceSingleChar == vsMode s = WholeMatch $ do-        currentState <- getEditorDyn-        let count = fromMaybe 1 $ vsCount currentState-        let replacer = case evs of-                        (c:[]) -> replaceCharB c-                        "<lt>" -> replaceCharB '<'-                        "<C-e>" -> replaceCharWithBelowB-                        "<C-y>" -> replaceCharWithAboveB-                        _ -> return ()-        withCurrentBuffer $ do-            -- Is there more easy way to get distance to eol?-            here <- pointB-            moveToEol-            eol <- pointB-            moveTo here--            let effectiveCount = min count (fromSize $ eol ~- here)--            when (effectiveCount > 0) $ do-                replicateM_ effectiveCount $ replacer >> rightB-                leftB--        resetCountE-        switchModeE Normal-        return Finish-    f _ _ = NoMatch
− src/library/Yi/Keymap/Vim/Search.hs 
@@ -1,45 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Search--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Search (doVimSearch, continueVimSearch) where--import Data.Maybe (listToMaybe)-import Data.Text ()-import Yi.Buffer.Adjusted-import Yi.Editor-import Yi.Search--doVimSearch :: Maybe String -> [SearchOption] -> Direction -> EditorM ()-doVimSearch Nothing _ dir = do-    mbRegex <- getRegexE-    case mbRegex of-        Just regex -> withCurrentBuffer $ continueVimSearch (regex, dir)-        Nothing -> printMsg "No previous search pattern"-doVimSearch (Just needle) opts dir =-    searchInit needle dir opts >>= withCurrentBuffer . continueVimSearch--continueVimSearch :: (SearchExp, Direction) -> BufferM ()-continueVimSearch (searchExp, dir) = do-    mp <- savingPointB $ do-        moveB Character dir  -- start immed. after cursor-        rs <- regexB dir searchExp-        moveB Document (reverseDir dir) -- wrap around-        ls <- regexB dir searchExp-        return $ listToMaybe $ rs ++ ls-    -- regionFirst doesn't work right here, because something inside-    -- Buffer.Implementation.regexRegionBI breaks Region invariant and-    -- may return Region (Forward, A, B) where A > B-    -- TODO: investigate-    maybe (return ()) (moveTo . regionFirst') mp--regionFirst' :: Region -> Point-regionFirst' r = Point $ min a b-    where a = fromPoint $ regionStart r-          b = fromPoint $ regionEnd r
− src/library/Yi/Keymap/Vim/SearchMotionMap.hs 
@@ -1,85 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.SearchMotionMap--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.SearchMotionMap (defSearchMotionMap) where--import           Control.Applicative-import           Control.Monad-import           Data.Maybe (fromMaybe)-import qualified Data.Text as T-import           Yi.Buffer.Adjusted-import           Yi.Editor-import           Yi.History-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Search-import           Yi.Keymap.Vim.StateUtils-import           Yi.Keymap.Vim.Utils-import qualified Yi.Rope as R-import           Yi.Search--defSearchMotionMap :: [VimBinding]-defSearchMotionMap = [enterBinding, editBinding, exitBinding]--enterBinding :: VimBinding-enterBinding = VimBindingE f-    where f "<CR>" (VimState { vsMode = Search {}} ) = WholeMatch $ do-              Search prevMode dir <- fmap vsMode getEditorDyn-              -- TODO: parse cmd into regex and flags-              isearchFinishE-              historyFinish-              switchModeE prevMode--              count <- getCountE-              getRegexE >>= \case-                Nothing -> return ()-                Just regex -> withCurrentBuffer $-                  if count == 1 && dir == Forward-                  then do-                    -- Workaround for isearchFinishE leaving cursor after match-                    continueVimSearch (regex, Backward)-                    continueVimSearch (regex, Forward)-                  else replicateM_ (count - 1) $ continueVimSearch (regex, dir)-              case prevMode of-                  Visual _ -> return Continue-                  _ -> return Finish-          f _ _ = NoMatch--editBinding :: VimBinding-editBinding = VimBindingE (f . T.unpack . _unEv)-  where-    f evs (VimState { vsMode = Search {}} )-      = action evs <$-        matchFromBool (evs `elem` fmap (T.unpack . fst) binds-                       || null (drop 1 evs))-    f _ _ = NoMatch-    action evs = do-      let evs' = T.pack evs-      fromMaybe (isearchAddE evs') (lookup evs' binds)-      withCurrentBuffer elemsB >>= historyPrefixSet . R.toText-      return Continue--    binds = [ ("<BS>", isearchDelE)-            , ("<C-h>", isearchDelE)-            , ("<C-p>", isearchHistory 1)-            , ("<Up>", isearchHistory 1)-            , ("<C-n>", isearchHistory (-1))-            , ("<Down>", isearchHistory (-1))-            , ("<lt>", isearchAddE "<")-            ]--exitBinding :: VimBinding-exitBinding = VimBindingE f-    where f _ (VimState { vsMode = Search {}} ) = WholeMatch $ do-              Search prevMode _dir <- fmap vsMode getEditorDyn-              isearchCancelE-              switchModeE prevMode-              return Drop-          f _ _ = NoMatch
− src/library/Yi/Keymap/Vim/StateUtils.hs 
@@ -1,172 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.StateUtils--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.StateUtils-    ( switchMode-    , switchModeE-    , resetCount-    , resetCountE-    , setCountE-    , modifyStateE-    , getMaybeCountE-    , getCountE-    , accumulateEventE-    , accumulateBindingEventE-    , accumulateTextObjectEventE-    , flushAccumulatorE-    , dropAccumulatorE-    , dropBindingAccumulatorE-    , dropTextObjectAccumulatorE-    , setRegisterE-    , getRegisterE-    , normalizeCountE-    , setStickyEolE-    , maybeMult-    , updateModeIndicatorE-    , saveInsertEventStringE-    , resetActiveRegisterE-    ) where--import           Control.Applicative-import           Control.Monad-import qualified Data.HashMap.Strict as HM-import           Data.Maybe (fromMaybe)-import           Data.Monoid-import qualified Data.Text as T-import           Yi.Buffer.Normal-import           Yi.Editor-import           Yi.Event-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.EventUtils-import           Yi.Rope (YiString)-import           Yi.String (showT)-import           Yi.Style (defaultStyle)--switchMode :: VimMode -> VimState -> VimState-switchMode mode state = state { vsMode = mode }--switchModeE :: VimMode -> EditorM ()-switchModeE mode = modifyStateE $ switchMode mode--modifyStateE :: (VimState -> VimState) -> EditorM ()-modifyStateE f = do-    currentState <- getEditorDyn-    putEditorDyn $ f currentState--resetCount :: VimState -> VimState-resetCount s = s { vsCount = Nothing }--resetCountE :: EditorM ()-resetCountE = modifyStateE resetCount--getMaybeCountE :: EditorM (Maybe Int)-getMaybeCountE = fmap vsCount getEditorDyn--getCountE :: EditorM Int-getCountE = do-    currentState <- getEditorDyn-    return $! fromMaybe 1 (vsCount currentState)--setCountE :: Int -> EditorM ()-setCountE n = modifyStateE $ \s -> s { vsCount = Just n }--accumulateBindingEventE :: Event -> EditorM ()-accumulateBindingEventE e = modifyStateE $-    \s -> s { vsBindingAccumulator = vsBindingAccumulator s <> eventToEventString e }--accumulateEventE :: Event -> EditorM ()-accumulateEventE e = modifyStateE $-    \s -> s { vsAccumulator = vsAccumulator s <> eventToEventString e }--accumulateTextObjectEventE :: EventString -> EditorM ()-accumulateTextObjectEventE evs = modifyStateE $-    \s -> s { vsTextObjectAccumulator = vsTextObjectAccumulator s <> evs }--flushAccumulatorE :: EditorM ()-flushAccumulatorE = do-    accum <- vsAccumulator <$> getEditorDyn-    let repeatableAction = stringToRepeatableAction accum-    modifyStateE $ \s ->-        s { vsRepeatableAction = Just repeatableAction-          , vsAccumulator = mempty-          , vsCurrentMacroRecording = fmap (fmap (<> accum))-                                           (vsCurrentMacroRecording s)-          }--dropAccumulatorE :: EditorM ()-dropAccumulatorE =-    modifyStateE $ \s ->-        let accum = vsAccumulator s-        in s { vsAccumulator = mempty-             , vsCurrentMacroRecording = fmap (fmap (<> accum))-                                              (vsCurrentMacroRecording s)-             }--dropBindingAccumulatorE :: EditorM ()-dropBindingAccumulatorE =-  modifyStateE $ \s -> s { vsBindingAccumulator = mempty }--dropTextObjectAccumulatorE :: EditorM ()-dropTextObjectAccumulatorE =-  modifyStateE $ \s -> s { vsTextObjectAccumulator = mempty }--getRegisterE :: RegisterName -> EditorM (Maybe Register)-getRegisterE name = fmap (HM.lookup name . vsRegisterMap) getEditorDyn--setRegisterE :: RegisterName -> RegionStyle -> YiString -> EditorM ()-setRegisterE name style rope = do-    rmap <- fmap vsRegisterMap getEditorDyn-    let rmap' = HM.insert name (Register style rope) rmap-    modifyStateE $ \state -> state { vsRegisterMap = rmap' }--normalizeCountE :: Maybe Int -> EditorM ()-normalizeCountE n = do-    mcount <- getMaybeCountE-    modifyStateE $ \s -> s {-      vsCount = maybeMult mcount n-      , vsAccumulator = Ev (showT . fromMaybe 1 $ maybeMult mcount n)-          <> snd (splitCountedCommand . normalizeCount $ vsAccumulator s)-      }--maybeMult :: Num a => Maybe a -> Maybe a -> Maybe a-maybeMult (Just a) (Just b) = Just (a * b)-maybeMult Nothing  Nothing = Nothing-maybeMult a        Nothing = a-maybeMult Nothing  b       = b--setStickyEolE :: Bool -> EditorM ()-setStickyEolE b = modifyStateE $ \s -> s { vsStickyEol = b }--updateModeIndicatorE :: VimMode -> EditorM ()-updateModeIndicatorE prevMode = do-  currentState <- getEditorDyn-  let mode = vsMode currentState-      paste = vsPaste currentState-  when (mode /= prevMode) $ do-      let modeName = case mode of-            Insert _ -> "INSERT" <> if paste then " (paste) " else ""-            InsertNormal -> "(insert)"-            InsertVisual -> "(insert) VISUAL"-            Replace -> "REPLACE"-            Visual Block -> "VISUAL BLOCK"-            Visual LineWise -> "VISUAL LINE"-            Visual _ -> "VISUAL"-            _ -> ""-          decoratedModeName = if T.null modeName-                              then mempty-                              else "-- " <> modeName <> " --"-      setStatus ([decoratedModeName], defaultStyle)--saveInsertEventStringE :: EventString -> EditorM ()-saveInsertEventStringE evs = modifyStateE $ \s ->-  s { vsOngoingInsertEvents = vsOngoingInsertEvents s <> evs }--resetActiveRegisterE :: EditorM ()-resetActiveRegisterE = modifyStateE $ \s -> s { vsActiveRegister = '\0' }
− src/library/Yi/Keymap/Vim/StyledRegion.hs 
@@ -1,77 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.StyledRegion--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ I'm a module waiting for some kind soul to give me a commentary!--module Yi.Keymap.Vim.StyledRegion-    ( StyledRegion(..)-    , normalizeRegion-    , transformCharactersInRegionB-    , transformCharactersInLineN-    ) where--import           Control.Monad-import qualified Data.Text as T-import           Yi.Buffer.Adjusted-import qualified Yi.Rope as R-import           Yi.Utils--data StyledRegion = StyledRegion !RegionStyle !Region---- | from vim help:------ 1. If the motion is exclusive and the end of the motion is in---    column 1, the end of the motion is moved to the end of the---    previous line and the motion becomes inclusive. Example: "}"---    moves to the first line after a paragraph, but "d}" will not---    include that line.------ 2. If the motion is exclusive, the end of the motion is in column 1---    and the start of the motion was at or before the first non-blank---    in the line, the motion becomes linewise. Example: If a---    paragraph begins with some blanks and you do "d}" while standing---    on the first non-blank, all the lines of the paragraph are---    deleted, including the blanks. If you do a put now, the deleted---    lines will be inserted below the cursor position.------ TODO: case 2-normalizeRegion :: StyledRegion -> BufferM StyledRegion-normalizeRegion sr@(StyledRegion style reg) =--    if style == Exclusive-    then do-        let end = regionEnd reg-        (_, endColumn) <- getLineAndColOfPoint end-        return (if endColumn == 0-            then StyledRegion Inclusive $ reg { regionEnd = end -~ 2 }-            else sr)-    else return sr--transformCharactersInRegionB :: StyledRegion -> (Char -> Char) -> BufferM ()-transformCharactersInRegionB (StyledRegion Block reg) f = do-    subregions <- splitBlockRegionToContiguousSubRegionsB reg-    forM_ subregions $ \sr ->-        transformCharactersInRegionB (StyledRegion Exclusive sr) f-    case subregions of-        (sr:_) -> moveTo (regionStart sr)-        [] -> error "Should never happen"-transformCharactersInRegionB (StyledRegion style reg) f = do-    reg' <- convertRegionToStyleB reg style-    s <- readRegionB reg'-    replaceRegionB reg' (R.withText (T.map f) s)-    moveTo (regionStart reg')--transformCharactersInLineN :: Int -> (Char -> Char) -> BufferM ()-transformCharactersInLineN count action = do-    p0 <- pointB-    moveXorEol count-    p1 <- pointB-    let sreg = StyledRegion Exclusive $ mkRegion p0 p1-    transformCharactersInRegionB sreg action-    moveTo p1
− src/library/Yi/Keymap/Vim/Tag.hs 
@@ -1,209 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Tag--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Keymap.Vim.Tag-    ( completeVimTag-    , gotoTag-    , popTag-    , unpopTag-    ) where--import           Control.Applicative-import           Control.Monad-import           Data.Binary-import           Data.Default-#if __GLASGOW_HASKELL__ < 708-import           Data.DeriveTH-#else-import           GHC.Generics (Generic)-#endif-import           Data.Maybe-import qualified Data.Text as T-import           Data.Typeable-import           System.Directory (doesFileExist)-import           System.FilePath-import           System.FriendlyPath-import           Yi.Buffer-import           Yi.Core (errorEditor)-import           Yi.Types (YiVariable)-import           Yi.Editor-import           Yi.File-import           Yi.Keymap-import           Yi.Tag-import           Yi.Utils---- | List of tags and the file/line/char that they originate from.--- (the location that :tag or Ctrl-[ was called from).-data VimTagStack = VimTagStack {-        tagStackList :: [(Tag, FilePath, Int, Int)]-      , tagStackIndex :: Int }-    deriving Typeable--instance Default VimTagStack where-    def = VimTagStack [] 0--instance YiVariable VimTagStack--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''VimTagStack)-#else-deriving instance Generic VimTagStack-instance Binary VimTagStack-#endif--getTagList :: EditorM [(Tag, FilePath, Int, Int)]-getTagList = do-    VimTagStack ts _ <- getEditorDyn-    return ts--getTagIndex :: EditorM Int-getTagIndex = do-    VimTagStack _ ti <- getEditorDyn-    return ti--setTagList :: [(Tag, FilePath, Int, Int)] -> EditorM ()-setTagList tl =  do-    t@(VimTagStack _ _) <- getEditorDyn-    putEditorDyn $ t { tagStackList = tl }--setTagIndex :: Int -> EditorM ()-setTagIndex ti = do-    t@(VimTagStack _ _) <- getEditorDyn-    putEditorDyn $ t { tagStackIndex = ti }---- | Push tag at index.-pushTagStack :: Tag -> FilePath -> Int -> Int -> EditorM ()-pushTagStack tag fp ln cn = do-    tl <- getTagList-    ti <- getTagIndex-    setTagList $ (take ti tl) ++ [(tag, fp, ln, cn)]-    setTagIndex $ ti + 1---- | Get tag and decrement index (so that when a new push is done, the current--- tag is popped)-popTagStack :: EditorM (Maybe (Tag, FilePath, Int, Int))-popTagStack = do-    tl <- getTagList-    ti <- getTagIndex-    case tl of-        [] -> return Nothing-        _  -> case ti of-                0 -> return Nothing-                _ -> setTagIndex (ti - 1) >> return (Just $ tl !! (ti - 1))---- | Opens the file that contains @tag@. Uses the global tag table or uses--- the first valid tag file in @TagsFileList@.-gotoTag :: Tag -> YiM ()-gotoTag tag =-    void . visitTagTable $ \tagTable ->-        case lookupTag tag tagTable of-          Nothing -> errorEditor $ "tag not found: " `T.append` _unTag tag-          Just (filename, line) -> do-            bufinf <- withCurrentBuffer bufInfoB-            let ln = bufInfoLineNo bufinf-                cn = bufInfoColNo bufinf-                fn = bufInfoFileName bufinf-            withEditor $ pushTagStack tag fn ln cn-            void $ editFile filename-            void . withCurrentBuffer $ gotoLn line---- | Return to location from before last tag jump.-popTag :: YiM ()-popTag = do-    tl <- withEditor getTagList-    case tl of-        [] -> errorEditor "tag stack empty"-        _ -> do-            posloc <- withEditor popTagStack-            case posloc of-                Nothing -> errorEditor "at bottom of tag stack"-                Just (_, fn, ln, cn) -> do-                    void $ editFile fn-                    void . withCurrentBuffer $ moveToLineColB ln cn---- | Go to next tag in the tag stack. Represents :tag without any--- specified tag.-unpopTag :: YiM ()-unpopTag = do-  tl <- withEditor getTagList-  ti <- withEditor getTagIndex-  if ti >= length tl-    then case tl of-            [] -> errorEditor "at top of tag stack"-            _ -> errorEditor "tag stack empty"-    else let (tag, _, _, _) = tl !! ti-         in void . visitTagTable $ \tagTable ->-             case lookupTag tag tagTable of-               Nothing -> errorEditor $ "tag not found: " `T.append` _unTag tag-               Just (filename, line) -> do-                   bufinf <- withCurrentBuffer bufInfoB-                   let ln = bufInfoLineNo bufinf-                       cn = bufInfoColNo bufinf-                       fn = bufInfoFileName bufinf-                       tl' = take ti tl-                               ++ (tag, fn, ln, cn):(drop (ti + 1) tl)-                   withEditor $ setTagList tl'-                   void $ editFile filename-                   void . withCurrentBuffer $ gotoLn line--completeVimTag :: T.Text -> YiM [T.Text]-completeVimTag s =-  fmap maybeToList . visitTagTable $ return . flip completeTag s---- | Gets the first valid tags file in @TagsFileList@, if such a valid--- file exists.-tagsFile :: YiM (Maybe FilePath)-tagsFile = do-    fs <- withEditor getTagsFileList-    let g f' f = do-        case f' of-            Just _ -> return f'-            Nothing -> tagsFileLocation f-    foldM g Nothing fs---- | Handles paths of the form ./[path], which represents a tags file relative--- to the path of the current directory of a file rather than the directory--- of the process.-tagsFileLocation :: String -> YiM (Maybe FilePath)-tagsFileLocation s-    | length s < 2 || take 2 s /= "./" = check s-    | otherwise = do-       let s' = drop 2 s-       dir <- takeDirectory <$>-                 (withCurrentBuffer $ bufInfoB >>= return . bufInfoFileName)-       check $ dir </> s'-    where check f = do-            f' <- io $ userToCanonPath f-            fileExists <- io $ doesFileExist f'-            if fileExists-                then return $ Just f'-                else return Nothing---- | Call continuation @act@ with the TagTable. Uses the global table--- or, if it doesn't exist, uses the first valid tag file in--- @TagsFileList@.-visitTagTable :: (TagTable -> YiM a) -> YiM (Maybe a)-visitTagTable act = do-    posTagTable <- withEditor getTags-    case posTagTable of-        Just tagTable -> Just <$> act tagTable-        Nothing -> do-            f <- tagsFile-            case f of-                Nothing -> errorEditor "No tags file" >> return Nothing-                Just f' -> do-                    tagTable <- io $ importTagTable f'-                    withEditor $ setTags tagTable-                    Just <$> act tagTable
− src/library/Yi/Keymap/Vim/TextObject.hs 
@@ -1,65 +0,0 @@-module Yi.Keymap.Vim.TextObject-  ( TextObject(..)-  , CountedTextObject(..)-  , regionOfTextObjectB-  , changeTextObjectCount-  , changeTextObjectStyle-  , stringToTextObject-  ) where--import Control.Monad--import Yi.Buffer.Adjusted-import Yi.Keymap.Vim.StyledRegion--data TextObject = TextObject !RegionStyle !TextUnit-data CountedTextObject = CountedTextObject !Int !TextObject--changeTextObjectCount :: Int -> CountedTextObject -> CountedTextObject-changeTextObjectCount n (CountedTextObject _ to) = CountedTextObject n to--regionOfTextObjectB :: CountedTextObject -> BufferM StyledRegion-regionOfTextObjectB = normalizeRegion <=< textObjectRegionB'--textObjectRegionB' :: CountedTextObject -> BufferM StyledRegion-textObjectRegionB' (CountedTextObject count (TextObject style unit)) =-    fmap (StyledRegion style) $ regionWithTwoMovesB-        (maybeMoveB unit Backward)-        (replicateM_ count $ moveB unit Forward)--changeTextObjectStyle :: (RegionStyle -> RegionStyle) -> TextObject -> TextObject-changeTextObjectStyle smod (TextObject s u) = TextObject (smod s) u--stringToTextObject :: String -> Maybe TextObject-stringToTextObject ('i':s) = parseTextObject InsideBound s-stringToTextObject ('a':s) = parseTextObject OutsideBound s-stringToTextObject _ = Nothing--parseTextObject :: BoundarySide -> String -> Maybe TextObject-parseTextObject bs (c:[]) = fmap (TextObject Exclusive . ($ bs == OutsideBound)) mkUnit-    where mkUnit = lookup c-           [('w',  toOuter unitViWord unitViWordAnyBnd)-           ,('W',  toOuter unitViWORD unitViWORDAnyBnd)-           ,('p',  toOuter unitEmacsParagraph unitEmacsParagraph) -- TODO inner could be inproved-           ,('s',  toOuter unitSentence unitSentence) -- TODO inner could be inproved-           ,('"',  unitDelimited '"' '"')-           ,('`',  unitDelimited '`' '`')-           ,('\'', unitDelimited '\'' '\'')-           ,('(',  unitDelimited '(' ')')-           ,(')',  unitDelimited '(' ')')-           ,('b',  unitDelimited '(' ')')-           ,('[',  unitDelimited '[' ']')-           ,(']',  unitDelimited '[' ']')-           ,('{',  unitDelimited '{' '}')-           ,('}',  unitDelimited '{' '}')-           ,('B',  unitDelimited '{' '}')-           ,('<',  unitDelimited '<' '>')-           ,('>',  unitDelimited '<' '>')-           -- TODO: 't'-           ]-parseTextObject _ _ = Nothing---- TODO: this probably belongs to Buffer.TextUnit-toOuter :: TextUnit -> TextUnit -> Bool -> TextUnit-toOuter outer _     True  = leftBoundaryUnit outer-toOuter _     inner False = inner
− src/library/Yi/Keymap/Vim/Utils.hs 
@@ -1,203 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.Utils--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Utils for the Vim keymap.--module Yi.Keymap.Vim.Utils-  ( mkBindingE-  , mkBindingY-  , mkStringBindingE-  , mkStringBindingY-  , splitCountedCommand-  , selectBinding-  , selectPureBinding-  , matchFromBool-  , mkMotionBinding-  , mkChooseRegisterBinding-  , pasteInclusiveB-  , addNewLineIfNecessary-  , indentBlockRegionB-  , addVimJumpHereE-  ) where--import           Control.Applicative-import           Control.Lens hiding (snoc)-import           Control.Monad-import           Data.Char (isSpace)-import           Data.Foldable (asum)-import           Data.List (group)-import qualified Data.Text as T-import           Safe (headDef)-import           Yi.Buffer.Adjusted hiding (Insert)-import           Yi.Editor-import           Yi.Event-import           Yi.Keymap-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.EventUtils-import           Yi.Keymap.Vim.Motion-import           Yi.Keymap.Vim.StateUtils-import           Yi.Monad-import           Yi.Rope (YiString, last, countNewLines)-import qualified Yi.Rope as R---- 'mkBindingE' and 'mkBindingY' are helper functions for bindings--- where VimState mutation is not dependent on action performed--- and prerequisite has form (mode == ... && event == ...)--mkStringBindingE :: VimMode -> RepeatToken-    -> (EventString, EditorM (), VimState -> VimState) -> VimBinding-mkStringBindingE mode rtoken (eventString, action, mutate) = VimBindingE f-    where f _ vs | vsMode vs /= mode = NoMatch-          f evs _ = combineAction action mutate rtoken <$-                    evs `matchesString` eventString--mkStringBindingY :: VimMode-    -> (EventString, YiM (), VimState -> VimState) -> VimBinding-mkStringBindingY mode (eventString, action, mutate) = VimBindingY f-    where f _ vs | vsMode vs /= mode = NoMatch-          f evs _ = combineAction action mutate Drop <$-                    evs `matchesString` eventString--mkBindingE :: VimMode -> RepeatToken -> (Event, EditorM (), VimState -> VimState) -> VimBinding-mkBindingE mode rtoken (event, action, mutate) = VimBindingE f-    where f evs vs = combineAction action mutate rtoken <$-                     matchFromBool (vsMode vs == mode && evs == eventToEventString event)--mkBindingY :: VimMode -> (Event, YiM (), VimState -> VimState) -> VimBinding-mkBindingY mode (event, action, mutate) = VimBindingY f-    where f evs vs = combineAction action mutate Drop <$-                     matchFromBool (vsMode vs == mode && evs == eventToEventString event)--combineAction :: MonadEditor m => m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken-combineAction action mutateState rtoken = do-    action-    withEditor $ modifyStateE mutateState-    return rtoken---- | All impure bindings will be ignored.-selectPureBinding :: EventString -> VimState -> [VimBinding] -> MatchResult (EditorM RepeatToken)-selectPureBinding evs state = asum . fmap try-    where try (VimBindingE matcher) = matcher evs state-          try (VimBindingY _) = NoMatch--selectBinding :: EventString -> VimState -> [VimBinding] -> MatchResult (YiM RepeatToken)-selectBinding input state = asum . fmap try-    where try (VimBindingY matcher) = matcher input state-          try (VimBindingE matcher) = fmap withEditor $ matcher input state--matchFromBool :: Bool -> MatchResult ()-matchFromBool b = if b then WholeMatch () else NoMatch--setUnjumpMarks :: Point -> BufferM ()-setUnjumpMarks p = do-    solP <- solPointB p-    lineStream <- indexedStreamB Forward solP-    let fstNonBlank =-            headDef solP [ p' | (p', ch) <- lineStream, not (isSpace ch) || ch == '\n' ]-    (.= p)           . markPointA =<< getMarkB (Just "`")-    (.= fstNonBlank) . markPointA =<< getMarkB (Just "'")--addVimJumpAtE :: Point -> EditorM ()-addVimJumpAtE p = do-    withCurrentBuffer $ setUnjumpMarks p-    addJumpAtE p--addVimJumpHereE :: EditorM ()-addVimJumpHereE = do-    withCurrentBuffer $ setUnjumpMarks =<< pointB-    addJumpHereE--mkMotionBinding :: RepeatToken -> (VimMode -> Bool) -> VimBinding-mkMotionBinding token condition = VimBindingE f-  where-    -- TODO: stringToMove and go both to EventString-    f :: EventString -> VimState -> MatchResult (EditorM RepeatToken)-    f evs state | condition (vsMode state) =-        fmap (go . T.unpack . _unEv $ evs) (stringToMove evs)-    f _ _ = NoMatch--    go :: String -> Move -> EditorM RepeatToken-    go evs (Move _style isJump move) = do-        state <- getEditorDyn-        count <- getMaybeCountE-        prevPoint <- withCurrentBuffer $ do-            p <- pointB-            move count-            leftOnEol-            return p-        when isJump $ addVimJumpAtE prevPoint-        resetCountE--        -- moving with j/k after $ sticks cursor to the right edge-        when (evs == "$") $ setStickyEolE True-        when (evs `elem` group "jk" && vsStickyEol state) $-            withCurrentBuffer $ moveToEol >> moveXorSol 1-        when (evs `notElem` group "jk$") $ setStickyEolE False--        let m = head evs-        when (m `elem` "fFtT") $ do-            let c = Prelude.last evs-                (dir, style) =-                    case m of-                        'f' -> (Forward, Inclusive)-                        't' -> (Forward, Exclusive)-                        'F' -> (Backward, Inclusive)-                        'T' -> (Backward, Exclusive)-                        _ -> error "can't happen"-                command = GotoCharCommand c dir style-            modifyStateE $ \s -> s { vsLastGotoCharCommand = Just command}--        return token--mkChooseRegisterBinding :: (VimState -> Bool) -> VimBinding-mkChooseRegisterBinding statePredicate = VimBindingE (f . T.unpack . _unEv)-    where f "\"" s | statePredicate s = PartialMatch-          f ['"', c] s | statePredicate s = WholeMatch $ do-              modifyStateE $ \s' -> s' { vsActiveRegister = c }-              return Continue-          f _ _ = NoMatch--indentBlockRegionB :: Int -> Region -> BufferM ()-indentBlockRegionB count reg = do-  indentSettings <- indentSettingsB-  (start, lengths) <- shapeOfBlockRegionB reg-  moveTo start-  forM_ (zip [1..] lengths) $ \(i, _) ->-      whenM (not <$> atEol) $ do-        let w = shiftWidth indentSettings-        if count > 0-        then insertN $ R.replicateChar (count * w) ' '-        else do-            let go 0 = return ()-                go n = do-                    c <- readB-                    when (c == ' ') $-                        deleteN 1 >> go (n - 1)-            go (abs count * w)-        moveTo start-        void $ lineMoveRel i-  moveTo start--pasteInclusiveB :: YiString -> RegionStyle -> BufferM ()-pasteInclusiveB rope style = do-  p0 <- pointB-  insertRopeWithStyleB rope style-  if countNewLines rope == 0 && style `elem` [ Exclusive, Inclusive ]-    then leftB-    else moveTo p0--trailingNewline :: YiString -> Bool-trailingNewline t = case Yi.Rope.last t of-  Just '\n' -> True-  _         -> False--addNewLineIfNecessary :: YiString -> YiString-addNewLineIfNecessary rope =-  if trailingNewline rope then rope else rope `R.snoc` '\n'
− src/library/Yi/Keymap/Vim/VisualMap.hs 
@@ -1,244 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Keymap.Vim.VisualMap--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ I'm a module waiting for some kind soul to give me a commentary!--module Yi.Keymap.Vim.VisualMap ( defVisualMap ) where--import           Control.Applicative-import           Control.Lens hiding ((-~), op)-import           Control.Monad-import           Data.Char (ord)-import           Data.List (group)-import           Data.Maybe (fromJust)-import qualified Data.Text as T-import           Yi.Buffer.Adjusted hiding (Insert)-import           Yi.Editor-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Operator-import           Yi.Keymap.Vim.StateUtils-import           Yi.Keymap.Vim.StyledRegion-import           Yi.Keymap.Vim.Utils-import           Yi.MiniBuffer-import           Yi.Monad-import           Yi.Utils--defVisualMap :: [VimOperator] -> [VimBinding]-defVisualMap operators =-    [escBinding, motionBinding, changeVisualStyleBinding, setMarkBinding]-    ++ [chooseRegisterBinding]-    ++ operatorBindings operators ++ digitBindings ++ [replaceBinding, switchEdgeBinding]-    ++ [insertBinding, exBinding, shiftDBinding]--escAction :: EditorM RepeatToken-escAction = do-    resetCountE-    clrStatus-    withCurrentBuffer $ do-        setVisibleSelection False-        putRegionStyle Inclusive-    switchModeE Normal-    return Drop--escBinding :: VimBinding-escBinding = VimBindingE f-    where f evs (VimState { vsMode = (Visual _) }) = escAction <$-              matchFromBool (evs `elem` ["<Esc>", "<C-c>"])-          f _ _ = NoMatch--exBinding :: VimBinding-exBinding = VimBindingE f-    where f ":" (VimState { vsMode = (Visual _) }) = WholeMatch $ do-              void $ spawnMinibufferE (T.pack ":'<,'>") id-              switchModeE Ex-              return Finish-          f _ _ = NoMatch--digitBindings :: [VimBinding]-digitBindings = zeroBinding : fmap mkDigitBinding ['1' .. '9']--zeroBinding :: VimBinding-zeroBinding = VimBindingE f-    where f "0" (VimState { vsMode = (Visual _) }) = WholeMatch $ do-              currentState <- getEditorDyn-              case vsCount currentState of-                  Just c -> do-                      setCountE (10 * c)-                      return Continue-                  Nothing -> do-                      withCurrentBuffer moveToSol-                      resetCountE-                      setStickyEolE False-                      return Continue-          f _ _ = NoMatch--setMarkBinding :: VimBinding-setMarkBinding = VimBindingE (f . T.unpack . _unEv)-    where f "m" (VimState { vsMode = (Visual _) }) = PartialMatch-          f ('m':c:[]) (VimState { vsMode = (Visual _) }) = WholeMatch $ do-              withCurrentBuffer $ setNamedMarkHereB [c]-              return Continue-          f _ _ = NoMatch--changeVisualStyleBinding :: VimBinding-changeVisualStyleBinding = VimBindingE f-    where f evs (VimState { vsMode = (Visual _) })-            | evs `elem` ["v", "V", "<C-v>"]-            = WholeMatch $ do-                  currentMode <- fmap vsMode getEditorDyn-                  let newStyle = case evs of-                         "v" -> Inclusive-                         "V" -> LineWise-                         "<C-v>" -> Block-                         _ -> error "Just silencing false positive warning."-                      newMode = Visual newStyle-                  if newMode == currentMode-                  then escAction-                  else do-                      modifyStateE $ \s -> s { vsMode = newMode }-                      withCurrentBuffer $ do-                          putRegionStyle newStyle-                          rectangleSelectionA .= (Block == newStyle)-                          setVisibleSelection True-                      return Finish-          f _ _ = NoMatch--mkDigitBinding :: Char -> VimBinding-mkDigitBinding c = VimBindingE (f . T.unpack . _unEv)-    where f [c'] (VimState { vsMode = (Visual _) }) | c == c'-            = WholeMatch $ do-                  modifyStateE mutate-                  return Continue-          f _ _ = NoMatch-          mutate vs@(VimState {vsCount = Nothing}) = vs { vsCount = Just d }-          mutate vs@(VimState {vsCount = Just count}) = vs { vsCount = Just $ count * 10 + d }-          d = ord c - ord '0'--motionBinding :: VimBinding-motionBinding = mkMotionBinding Continue $-    \m -> case m of-        Visual _ -> True-        _ -> False--regionOfSelectionB :: BufferM Region-regionOfSelectionB = savingPointB $ do-    start <- getSelectionMarkPointB-    stop <- pointB-    return $! mkRegion start stop--operatorBindings :: [VimOperator] -> [VimBinding]-operatorBindings operators = fmap mkOperatorBinding $ operators ++ visualOperators-    where visualOperators = fmap synonymOp-                                  [ ("x", "d")-                                  , ("~", "g~")-                                  , ("Y", "y")-                                  , ("u", "gu")-                                  , ("U", "gU")-                                  ]-          synonymOp (newName, existingName) =-                    VimOperator newName . operatorApplyToRegionE . fromJust-                    . stringToOperator operators $ existingName--chooseRegisterBinding :: VimBinding-chooseRegisterBinding = mkChooseRegisterBinding $-    \s -> case s of-        (VimState { vsMode = (Visual _) }) -> True-        _ -> False--shiftDBinding :: VimBinding-shiftDBinding = VimBindingE (f . T.unpack . _unEv)-    where f "D" (VimState { vsMode = (Visual _) }) = WholeMatch $ do-              (Visual style) <- vsMode <$> getEditorDyn-              reg <- withCurrentBuffer regionOfSelectionB-              case style of-                  Block -> withCurrentBuffer $ do-                      (start, lengths) <- shapeOfBlockRegionB reg-                      moveTo start-                      startCol <- curCol-                      forM_ (reverse [0 .. length lengths - 1]) $ \l -> do-                          moveTo start-                          void $ lineMoveRel l-                          whenM (fmap (== startCol) curCol) deleteToEol-                      leftOnEol-                  _ ->  do-                      reg' <- withCurrentBuffer $ convertRegionToStyleB reg LineWise-                      reg'' <- withCurrentBuffer $ mkRegionOfStyleB (regionStart reg')-                                                              (regionEnd reg' -~ Size 1)-                                                              Exclusive-                      void $ operatorApplyToRegionE opDelete 1 $ StyledRegion LineWise reg''-              resetCountE-              switchModeE Normal-              return Finish-          f _ _ = NoMatch--mkOperatorBinding :: VimOperator -> VimBinding-mkOperatorBinding op = VimBindingE f-  where-    f evs (VimState { vsMode = (Visual _) }) =-      action <$ evs `matchesString` Ev (_unOp $ operatorName op)-    f _ _ = NoMatch-    action = do-        (Visual style) <- vsMode <$> getEditorDyn-        region <- withCurrentBuffer regionOfSelectionB-        count <- getCountE-        token <- operatorApplyToRegionE op count $ StyledRegion style region-        resetCountE-        clrStatus-        withCurrentBuffer $ do-            setVisibleSelection False-            putRegionStyle Inclusive-        return token--replaceBinding :: VimBinding-replaceBinding = VimBindingE (f . T.unpack . _unEv)-    where f evs (VimState { vsMode = (Visual _) }) =-              case evs of-                "r" -> PartialMatch-                ('r':c:[]) -> WholeMatch $ do-                    (Visual style) <- vsMode <$> getEditorDyn-                    region <- withCurrentBuffer regionOfSelectionB-                    withCurrentBuffer $ transformCharactersInRegionB (StyledRegion style region)-                                      (\x -> if x == '\n' then x else c)-                    switchModeE Normal-                    return Finish-                _ -> NoMatch-          f _ _ = NoMatch--switchEdgeBinding :: VimBinding-switchEdgeBinding = VimBindingE (f . T.unpack . _unEv)-    where f [c] (VimState { vsMode = (Visual _) }) | c `elem` "oO"-              = WholeMatch $ do-                  (Visual style) <- vsMode <$> getEditorDyn-                  withCurrentBuffer $ do-                      here <- pointB-                      there <- getSelectionMarkPointB-                      (here', there') <- case (c, style) of-                                            ('O', Block) -> flipRectangleB here there-                                            (_, _) -> return (there, here)-                      moveTo here'-                      setSelectionMarkPointB there'-                  return Continue-          f _ _ = NoMatch--insertBinding :: VimBinding-insertBinding = VimBindingE (f . T.unpack . _unEv)-    where f evs (VimState { vsMode = (Visual _) }) | evs `elem` group "IA"-            = WholeMatch $ do-                  (Visual style) <- vsMode <$> getEditorDyn-                  region <- withCurrentBuffer regionOfSelectionB-                  cursors <- withCurrentBuffer $ case evs of-                      "I" -> leftEdgesOfRegionB style region-                      "A" -> rightEdgesOfRegionB style region-                      _ -> error "Just silencing ghc's false positive warning."-                  withCurrentBuffer $ moveTo $ head cursors-                  modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 cursors }-                  switchModeE $ Insert (head evs)-                  return Continue-          f _ _ = NoMatch
− src/library/Yi/KillRing.hs 
@@ -1,102 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.KillRing--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Killring operations.--module Yi.KillRing ( Killring-                   , _krKilled-                   , _krContents-                   , krKilled-                   , krContents-                   , krEndCmd-                   , krPut-                   , krSet, krGet-                   , krEmpty-                   , krLastYank-                   )-    where--import           Control.Applicative-import           Control.Lens-import           Data.Binary-#if __GLASGOW_HASKELL__ < 708-import           Data.DeriveTH-#else-import           GHC.Generics (Generic)-#endif-import           Data.List.NonEmpty hiding (length, drop)-import           Data.Monoid-import           Prelude hiding (head, tail, take)-import           Yi.Buffer.Basic-import qualified Yi.Rope as R---data Killring = Killring { _krKilled :: Bool-                         , _krAccumulate :: Bool-                         , _krContents :: NonEmpty R.YiString-                         , _krLastYank :: Bool-                         } deriving (Show, Eq)--instance Binary Killring where-  put (Killring k a c l) =-    let putNE (x :| xs) = put x >> put xs-    in put k >> put a >> putNE c >> put l-  get = let getNE = (:|) <$> get <*> get-        in Killring <$> get <*> get <*> getNE <*> get--makeLenses ''Killring--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''NonEmpty)-#else-deriving instance Generic Killring-#endif--maxDepth :: Int-maxDepth = 10--krEmpty :: Killring-krEmpty = Killring { _krKilled = False-                   , _krAccumulate = False-                   , _krContents = mempty :| mempty-                   , _krLastYank = False-                   }---- | Finish an atomic command, for the purpose of killring accumulation.-krEndCmd :: Killring -> Killring-krEndCmd kr = kr { _krKilled = False , _krAccumulate = kr ^. krKilled }---- | Put some text in the killring.--- It's accumulated if the last command was a kill too-krPut :: Direction -> R.YiString -> Killring -> Killring-krPut dir s kr@Killring { _krContents = r@(x :| xs) }-    = kr { _krKilled = True-         , _krContents =-           if kr ^. krAccumulate-           then (case dir of Forward  -> x <> s-                             Backward -> s <> x) :| xs-           else push s r-         }---- | Push a string in the killring.-push :: R.YiString -> NonEmpty R.YiString -> NonEmpty R.YiString-push s r@(h :| t) = s :| if R.length h <= 1 then t else take maxDepth r--- Don't save very small cutted text portions.---- | Set the top of the killring. Never accumulate the previous content.-krSet :: R.YiString -> Killring -> Killring-krSet s kr@Killring {_krContents = _ :| xs} = kr {_krContents = s :| xs}---- | Get the top of the killring.-krGet :: Killring -> R.YiString-krGet = head . _krContents
− src/library/Yi/Layout.hs 
@@ -1,367 +0,0 @@-{-# LANGUAGE DeriveDataTypeable, ExistentialQuantification, DeriveFunctor, TupleSections, ViewPatterns #-}-{-# LANGUAGE Rank2Types #-}-{-# OPTIONS_GHC -funbox-strict-fields #-} -- we might as well unbox our Ints.---- | This module defines the layout manager interface (see 'LayoutManager'). To desgin a new layout manager, just make an instance of this class.-module Yi.Layout-  (-    -- * Concrete layouts-    Layout(..),-    Orientation(..),-    DividerPosition,-    DividerRef,-    RelativeSize,-    dividerPositionA,--    -- * Layout managers-    -- ** The interface-    LayoutManager(..),-    AnyLayoutManager(..),-    layoutManagerSameType,-    -- ** Standard managers-    wide,-    tall,-    slidyTall,-    slidyWide,-    hPairNStack,-    vPairNStack,-    -- * Utility functions-    -- ** Layouts as rectangles-    Rectangle(..),-    layoutToRectangles,-    -- ** Transposing things-    Transposable(..),-    Transposed(..),-    -- ** 'DividerRef' combinators-    -- $divRefCombinators-    LayoutM,-    pair,-    singleWindow,-    stack,-    evenStack,-    runLayoutM,-  )- where--import Control.Applicative-import Control.Arrow (first)-import Control.Lens hiding (set')-import Data.Typeable-import Data.Maybe-import Data.Default-import Data.List (mapAccumL, foldl')-import qualified Control.Monad.State.Strict as Monad---------------------------------- Some design notes ------------------------- [Treatment of mini windows]---- Mini windows are not subject to layout; instead, they are always--- placed at the bottom of the screen. There are multiple reasons for--- this, as discussed in--- https://groups.google.com/d/topic/yi-devel/vhTObC25dpY/discussion, one--- being that for many layouts, the bottom (or top) of the screen is the--- only reasonable place for mini windows (for example, think about--- side-by-side layouts).---- [Design of the 'Layout' datatype]---- The 'Layout' datatype is currently implemented in terms of--- horizontal stacks and vertical stacks. An alternative approach,--- which xmonad uses, is the following: a 'Layout a' could be a--- function @a -> Rectangle@ which specifies in coordinates where a--- window should be placed.------ While this alternative is more flexible than the current approach--- in allowing spiral layouts and the like, the vty UI doesn't support--- this: only vertical and horizontal composition of images is--- allowed.--------------------------------------- Concrete 'Layout's.--- | UI-agnostic layout schema. The basic constructs are--- (horizontal/vertical) stacks with fixed ratios between window--- sizes; and (horizontal/vertical) pairs with a slider in between (if--- available).-data Layout a-  = SingleWindow a-  | Stack {-      orientation :: !Orientation,              -- ^ Orientation-      wins        :: [(Layout a, RelativeSize)] -- ^ The layout stack, with the given weights-        -- TODO: fix strictness for stack (it's still lazy)-      }-  | Pair {-       orientation :: !Orientation,     -- ^ Orientation-       divPos      :: !DividerPosition, -- ^ Initial position of the divider-       divRef      :: !DividerRef,      -- ^ Index of the divider (for updating the divider position)-       pairFst     :: !(Layout a),      -- ^ Upper of of the pair-       pairSnd     :: !(Layout a)       -- ^ Lower of the pair-    }-  deriving(Typeable, Eq, Functor)---- | Accessor for the 'DividerPosition' with given reference-dividerPositionA :: DividerRef -> Lens' (Layout a) DividerPosition-dividerPositionA ref = lens getter (flip setter) where-  setter pos = set'-    where-      set' s@(SingleWindow _) = s-      set' p@Pair{} | divRef p == ref = p{ divPos = pos }-                    | otherwise       = p{ pairFst = set' (pairFst p), pairSnd = set' (pairSnd p) }-      set' s@Stack{} = s{ wins = fmap (first set') (wins s) }--  getter = fromMaybe invalidRef . get'--  get' (SingleWindow _) = Nothing-  get' p@Pair{} | divRef p == ref = Just (divPos p)-                | otherwise       = get' (pairFst p) <|> get' (pairSnd p)-  get' s@Stack{} = foldl' (<|>) Nothing (fmap (get' . fst) (wins s))--  invalidRef = error "Yi.Layout.dividerPositionA: invalid DividerRef"--instance Show a => Show (Layout a) where-  show (SingleWindow a) = show a-  show (Stack o s) = show o ++ " stack " ++ show s-  show p@(Pair{}) = show (orientation p) ++ " " ++ show (pairFst p, pairSnd p)---- | The def layout consists of a single window-instance Default a => Default (Layout a) where-  def = SingleWindow def---- | Orientations for 'Stack' and 'Pair'-data Orientation-  = Horizontal-  | Vertical-  deriving(Eq, Show)---- | Divider reference-type DividerRef = Int---- | Divider position, in the range (0,1)-type DividerPosition = Double---- | Relative sizes, for 'Stack'-type RelativeSize = Double------------------------------------------------------- Layout managers--- TODO: add Binary requirement when possible--- | The type of layout managers. See the layout managers 'tall', 'hPairNStack' and 'slidyTall' for some example implementations.-class (Typeable m, Eq m) => LayoutManager m where-  -- | Given the old layout and the new list of windows, construct a-  -- layout for the new list of windows.-  ---  -- If the layout manager uses sliding dividers, then a user will expect that most-  -- of these dividers don't move when adding a new window. It is the layout-  -- manager's responsibility to ensure that this is the case, and this is the-  -- purpose of the @Layout a@ argument.-  ---  -- The old layout may come from a different layout manager, in which case the layout manager is free to ignore it.-  pureLayout :: m -> Layout a -> [a] -> Layout a-  -- | Describe the layout in a form suitable for the user.-  describeLayout :: m -> String-  -- | Cycles to the next variant, if there is one (the default is 'id')-  nextVariant :: m -> m-  nextVariant = id-  -- | Cycles to the previous variant, if there is one (the default is 'id'-  previousVariant :: m -> m-  previousVariant = id---- | Existential wrapper for 'Layout'-data AnyLayoutManager = forall m. LayoutManager m => AnyLayoutManager !m-  deriving(Typeable)--instance Eq AnyLayoutManager where-  (AnyLayoutManager l1) == (AnyLayoutManager l2) = maybe False (== l2) (cast l1)--instance LayoutManager (AnyLayoutManager) where-  pureLayout (AnyLayoutManager l) = pureLayout l-  describeLayout (AnyLayoutManager l) = describeLayout l-  nextVariant (AnyLayoutManager l) = AnyLayoutManager (nextVariant l)-  previousVariant (AnyLayoutManager l) = AnyLayoutManager (previousVariant l)---- | The default layout is 'tallLayout'-instance Default AnyLayoutManager where-  def = hPairNStack 1---- | True if the internal layout managers have the same type (but are not necessarily equal).-layoutManagerSameType :: AnyLayoutManager -> AnyLayoutManager -> Bool-layoutManagerSameType (AnyLayoutManager l1) (AnyLayoutManager l2) = typeOf l1 == typeOf l2-------------------------------- Standard layouts--- | Tall windows (i.e. places windows side-by-side, equally spaced)-data Tall = Tall-  deriving(Eq, Typeable)---- | Windows placed side-by-side, equally spaced.-tall :: AnyLayoutManager-tall = AnyLayoutManager Tall--instance LayoutManager Tall where-  pureLayout Tall _oldLayout ws = runLayoutM $ evenStack Horizontal (fmap singleWindow ws)-  describeLayout Tall = "Windows positioned side-by-side"---- | Wide windows (windows placed on top of one another, equally spaced)-data Wide = Wide-  deriving(Eq, Typeable)--instance LayoutManager Wide where-  pureLayout Wide _oldLayout ws = runLayoutM $ evenStack Vertical (fmap singleWindow ws)-  describeLayout Wide = "Windows positioned above one another"---- | Windows placed on top of one another, equally spaced-wide :: AnyLayoutManager-wide = AnyLayoutManager Wide---- | Tall windows, with arranged in a balanced binary tree with sliders in between them-data SlidyTall = SlidyTall-  deriving(Eq, Typeable)---- | Tall windows, arranged in a balanced binary tree with sliders in between them.-slidyTall :: AnyLayoutManager-slidyTall = AnyLayoutManager SlidyTall--instance LayoutManager SlidyTall where-  -- an error on input [] is easier to debug than an infinite loop.-  pureLayout SlidyTall _oldLayout [] = error "Yi.Layout: empty window list unexpected"-  pureLayout SlidyTall oldLayout xs = runLayoutM (go (Just oldLayout) xs) where-     go _layout [x] = singleWindow x-     go layout (splitList -> (lxs, rxs)) =-       case layout of-           -- if the old layout had a pair in the same point of the tree, use its divider position-           Just (Pair Horizontal pos _ l r) -> pair Horizontal pos (go (Just l) lxs) (go (Just r) rxs)-           -- otherwise, just use divider position 0.5-           _ -> pair Horizontal 0.5 (go Nothing lxs) (go Nothing rxs)--  describeLayout SlidyTall = "Slidy tall windows, with balanced-position sliders"--splitList :: [a] -> ([a], [a])-splitList xs = splitAt ((length xs + 1) `div` 2) xs---- | Transposed version of 'SlidyTall'-newtype SlidyWide = SlidyWide (Transposed SlidyTall)-  deriving(Eq, Typeable)---- | Transposed version of 'slidyTall'-slidyWide :: AnyLayoutManager-slidyWide = AnyLayoutManager (SlidyWide (Transposed SlidyTall))--instance LayoutManager SlidyWide where-    pureLayout (SlidyWide w) = pureLayout w-    describeLayout _ = "Slidy wide windows, with balanced-position sliders"---- | Fixed number of \"main\" windows on the left; stack of windows on the right-data HPairNStack = HPairNStack !Int-  deriving(Eq, Typeable)---- | @n@ windows on the left; stack of windows on the right.-hPairNStack :: Int -> AnyLayoutManager-hPairNStack n | n < 1     = error "Yi.Layout.hPairNStackLayout: n must be at least 1"-                    | otherwise = AnyLayoutManager (HPairNStack n)--instance LayoutManager HPairNStack where-    pureLayout (HPairNStack n) oldLayout (fmap singleWindow -> xs)-          | length xs <= n = runLayoutM $ evenStack Vertical xs-          | otherwise = runLayoutM $ case splitAt n xs of-              (ls, rs) ->  pair Horizontal pos-                 (evenStack Vertical ls)-                 (evenStack Vertical rs)-       where-          pos = case oldLayout of-              Pair Horizontal pos' _ _ _ -> pos'-              _ -> 0.5--    describeLayout (HPairNStack n) = show n ++ " windows on the left; remaining windows on the right"-    nextVariant (HPairNStack n) = HPairNStack (n+1)-    previousVariant (HPairNStack n) = HPairNStack (max (n-1) 1)--newtype VPairNStack = VPairNStack (Transposed HPairNStack)-  deriving(Eq, Typeable)---- | Transposed version of 'hPairNStack'.-vPairNStack :: Int -> AnyLayoutManager-vPairNStack n = AnyLayoutManager (VPairNStack (Transposed (HPairNStack n)))--instance LayoutManager VPairNStack where-    pureLayout (VPairNStack lm) = pureLayout lm-    previousVariant (VPairNStack lm) = VPairNStack (previousVariant lm)-    nextVariant (VPairNStack lm) = VPairNStack (nextVariant lm)-    describeLayout (VPairNStack (Transposed (HPairNStack n))) = show n ++ " windows on top; remaining windows beneath"------------------------- Utils---- | A general bounding box-data Rectangle = Rectangle { rectX, rectY, rectWidth, rectHeight :: !Double }-  deriving(Eq, Show)--layoutToRectangles :: Rectangle -> Layout a -> [(a, Rectangle)]-layoutToRectangles bounds (SingleWindow a) = [(a, bounds)]-layoutToRectangles bounds (Stack o ts) = handleStack o bounds ts-layoutToRectangles bounds (Pair o p _ a b) = handleStack o bounds [(a,p), (b,1-p)]--handleStack :: Orientation -> Rectangle -> [(Layout a, RelativeSize)] -> [(a, Rectangle)]-handleStack o bounds tiles =-      let (totalSpace, startPos, mkBounds) = case o of-            Vertical -> (rectHeight bounds, rectY bounds, \pos size -> bounds{rectY = pos, rectHeight=size})-            Horizontal -> (rectWidth bounds, rectX bounds, \pos size -> bounds{rectX = pos, rectWidth=size})--          totalWeight' = sum (fmap snd tiles)-          totalWeight = if totalWeight' > 0 then totalWeight' else error "Yi.Layout: Stacks must have positive weights"-          spacePerWeight = totalSpace / totalWeight-          doTile pos (t, wt) = (pos + wt * spacePerWeight,-                                layoutToRectangles (mkBounds pos (wt * spacePerWeight)) t)-      in-       concat . snd . mapAccumL doTile startPos $ tiles------------- Flipping things--- | Things with orientations which can be flipped-class Transposable r where transpose :: r -> r-instance Transposable Orientation where { transpose Horizontal = Vertical; transpose Vertical = Horizontal }-instance Transposable (Layout a) where-    transpose (SingleWindow a) = SingleWindow a-    transpose (Stack o ws) = Stack (transpose o) (fmap (first transpose) ws)-    transpose (Pair o p r a b) = Pair (transpose o) p r (transpose a) (transpose b)---- | Same as 'lm', but with all 'Orientation's 'transpose'd. See 'slidyWide' for an example of its use.-newtype Transposed lm = Transposed lm-  deriving(Eq, Typeable)--instance LayoutManager lm => LayoutManager (Transposed lm) where-    pureLayout (Transposed lm) l ws = transpose (pureLayout lm (transpose l) ws)-    describeLayout (Transposed lm) = "Transposed version of: " ++ describeLayout lm-    nextVariant (Transposed lm) = Transposed (nextVariant lm)-    previousVariant (Transposed lm) = Transposed (previousVariant lm)---------------------- 'DividerRef' combinators--- $divRefCombinators--- It is tedious and error-prone for 'LayoutManager's to assign 'DividerRef's themselves. Better is to use these monadic smart constructors for 'Layout'. For example, the layout------ @'Pair' 'Horizontal' 0.5 0 ('Pair' 'Vertical' 0.5 1 ('SingleWindow' w1) ('SingleWindow' w2)) ('SingleWindow' w3)@------ could be with the combinators below as------ @'runLayoutM' $ 'pair' 'Horizontal' 0.5 ('pair' 'Vertical' 0.5 ('singleWindow' w1) ('singleWindow' w2)) ('singleWindow' w3)@------ These combinators do will also ensure strictness of the 'wins' field of 'Stack'. They also tidy up and do some error checking: length-1 stacks are removed (they are unnecessary); length-0 stacks raise errors.---- | A 'Layout a' wrapped in a state monad for tracking 'DividerRef's. This type is /not/ itself a monad, but should rather be thought of as a 'DividerRef'-free version of the 'Layout' type.-newtype LayoutM a = LayoutM (Monad.State DividerRef (Layout a))--singleWindow :: a -> LayoutM a-singleWindow a = LayoutM (pure (SingleWindow a))--pair :: Orientation -> DividerPosition -> LayoutM a -> LayoutM a -> LayoutM a-pair o p (LayoutM l1) (LayoutM l2) = LayoutM $ do-    ref <- Monad.get-    Monad.put (ref+1)-    Pair o p ref <$> l1 <*> l2--stack :: Orientation -> [(LayoutM a, RelativeSize)] -> LayoutM a-stack _ [] = error "Yi.Layout: Length-0 stack"-stack _ [l] = fst l-stack o ls = LayoutM (Stack o <$> mapM (\(LayoutM lm,rs) -> (,rs) <$> lm) ls)---- | Special case of 'stack' with all 'RelativeSize's equal.-evenStack :: Orientation -> [LayoutM a] -> LayoutM a-evenStack o ls = stack o (fmap (\l -> (l,1)) ls)--runLayoutM :: LayoutM a -> Layout a-runLayoutM (LayoutM l) = Monad.evalState l 0
− src/library/Yi/Main.hs 
@@ -1,158 +0,0 @@-{-# LANGUAGE CPP #-}---- | This is the main module of Yi, called with configuration from the user.--- Here we mainly process command line arguments.--module Yi.Main (-                -- * Static main-                main,-                -- * Command line processing-                do_args,-                ConsoleConfig(..),-                Err(..),-               ) where--import Control.Monad.Error-import Data.Char-import Data.List (intercalate)-import Distribution.Text (display)-import System.Console.GetOpt-import System.Exit-#ifndef HLINT-#include "ghcconfig.h"-#endif--import Yi.Buffer-import Yi.Config-import Yi.Config.Default-import Yi.Core (startEditor)-import Yi.Debug-import Yi.Editor-import Yi.File-import Yi.Keymap-import Yi.Paths (getConfigDir)-import Paths_yi--frontendNames :: [String]-frontendNames = fmap fst' availableFrontends-  where fst' :: (a,UIBoot) -> a-        fst' (x,_) = x--data Err = Err String ExitCode--instance Error Err where-    strMsg s = Err s (ExitFailure 1)---- | Configuration information which can be set in the command-line, but not--- in the user's configuration file.-data ConsoleConfig =-  ConsoleConfig {-     ghcOptions :: [String],-     selfCheck :: Bool,-     userConfigDir :: IO FilePath-  }--defaultConsoleConfig :: ConsoleConfig-defaultConsoleConfig =-  ConsoleConfig {-                  ghcOptions = [],-                  selfCheck = False,-                  userConfigDir = Yi.Paths.getConfigDir-                }---- ------------------------------------------------------------------------ | Argument parsing. Pretty standard.--data Opts = Help-          | Version-          | LineNo String-          | EditorNm String-          | File String-          | Frontend String-          | ConfigFile String-          | SelfCheck-          | GhcOption String-          | Debug-          | OpenInTabs---- | List of editors for which we provide an emulation.-editors :: [(String,Config -> Config)]-editors = [("emacs", toEmacsStyleConfig),-           ("vim",  toVimStyleConfig),-           ("cua",   toCuaStyleConfig)]--options :: [OptDescr Opts]-options =-  [ Option []     ["self-check"]  (NoArg  SelfCheck)             "Run self-checks"-  , Option ['f']  ["frontend"]    (ReqArg Frontend   "FRONTEND") frontendHelp-  , Option ['y']  ["config-file"] (ReqArg ConfigFile "PATH")     "Specify a folder containing a configuration yi.hs file"-  , Option ['V']  ["version"]     (NoArg  Version)               "Show version information"-  , Option ['h']  ["help"]        (NoArg  Help)                  "Show this help"-  , Option []     ["debug"]       (NoArg  Debug)                 "Write debug information in a log file"-  , Option ['l']  ["line"]        (ReqArg LineNo     "NUM")      "Start on line number"-  , Option []     ["as"]          (ReqArg EditorNm   "EDITOR")   editorHelp-  , Option []     ["ghc-option"]  (ReqArg GhcOption  "OPTION")   "Specify option to pass to ghc when compiling configuration file"-  , Option [openInTabsShort] [openInTabsLong] (NoArg  OpenInTabs)  "Open files in tabs"-  ] where frontendHelp = "Select frontend, which can be one of:\n" ++ intercalate ", " frontendNames-          editorHelp   = "Start with editor keymap, where editor is one of:\n" ++ (intercalate ", " . fmap fst) editors--openInTabsShort :: Char-openInTabsShort = 'p'--openInTabsLong :: String-openInTabsLong = "open-in-tabs"---- | usage string.-usage, versinfo :: String-usage = usageInfo "Usage: yi [option...] [file]" options--versinfo = "yi " ++ display version---- | Transform the config with options-do_args :: Config -> [String] -> Either Err (Config, ConsoleConfig)-do_args cfg args =-    case getOpt (ReturnInOrder File) options args of-        (os, [], []) -> foldM (getConfig shouldOpenInTabs) (cfg, defaultConsoleConfig) os-        (_, _, errs) -> fail (concat errs)-    where-        shouldOpenInTabs = ("--" ++ openInTabsLong) `elem` args-                         || ('-':[openInTabsShort]) `elem` args---- | Update the default configuration based on a command-line option.-getConfig :: Bool -> (Config, ConsoleConfig) -> Opts -> Either Err (Config, ConsoleConfig)-getConfig shouldOpenInTabs (cfg, cfgcon) opt =-    case opt of-      Frontend f -> case lookup f availableFrontends of-                      Just frontEnd -> return (cfg { startFrontEnd = frontEnd }, cfgcon)-                      Nothing       -> fail "Panic: frontend not found"-      Help          -> throwError $ Err usage ExitSuccess-      Version       -> throwError $ Err versinfo ExitSuccess-      Debug         -> return (cfg { debugMode = True }, cfgcon)-      LineNo l      -> case startActions cfg of-                         x : xs -> return (cfg { startActions = x:makeAction (gotoLn (read l)):xs }, cfgcon)-                         []     -> fail "The `-l' option must come after a file argument"--      File filename -> if shouldOpenInTabs && not (null (startActions cfg)) then-                         prependActions [YiA (editFile filename), EditorA newTabE]-                       else-                         prependAction (editFile filename)--      EditorNm emul -> case lookup (fmap toLower emul) editors of-             Just modifyCfg -> return (modifyCfg cfg, cfgcon)-             Nothing -> fail $ "Unknown emulation: " ++ show emul-      GhcOption ghcOpt -> return (cfg, cfgcon { ghcOptions = ghcOptions cfgcon ++ [ghcOpt] })-      ConfigFile f -> return (cfg, cfgcon { userConfigDir = return f })-      _ -> return (cfg, cfgcon)-  where-    prependActions as = return (cfg { startActions = fmap makeAction as ++ startActions cfg }, cfgcon)-    prependAction a = return (cfg { startActions = makeAction a : startActions cfg}, cfgcon)---- ------------------------------------------------------------------------ | Static main. This is the front end to the statically linked--- application, and the real front end, in a sense. 'dynamic_main' calls--- this after setting preferences passed from the boot loader.----main :: (Config, ConsoleConfig) -> Maybe Editor -> IO ()-main (cfg, _cfgcon) state = do-  when (debugMode cfg) $ initDebug ".yi.dbg"-  startEditor cfg state
− src/library/Yi/MiniBuffer.hs 
@@ -1,441 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE EmptyDataDecls #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators #-}-{-# LANGUAGE TypeSynonymInstances #-}-{-# LANGUAGE UndecidableInstances #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Minibuffer--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Functions working with the minibuffer.--module Yi.MiniBuffer ( spawnMinibufferE, withMinibufferFree, withMinibuffer-                     , withMinibufferGen, withMinibufferFin, noHint-                     , noPossibilities, mkCompleteFn, simpleComplete-                     , infixComplete, infixComplete', anyModeByName-                     , getAllModeNames, matchingBufferNames, anyModeByNameM-                     , anyModeName, (:::)(..), LineNumber, RegexTag-                     , FilePatternTag, ToKill, CommandArguments(..)-                     , commentRegion, promptingForBuffer, debugBufferContent-                     ) where--import           Control.Applicative-import           Control.Concurrent-import           Control.Lens hiding (act)-import           Control.Monad-import           Data.Foldable (find, toList)-import           Data.IORef-import qualified Data.List.PointedList.Circular as PL-import           Data.Maybe-import           Data.Monoid (mempty)-import           Data.Proxy-import           Data.String (IsString)-import qualified Data.Text as T-import           Data.Typeable-import           System.CanonicalizePath (replaceShorthands)-import           Yi.Buffer-import           Yi.Completion (infixMatch, prefixMatch, containsMatch',-                                completeInList, completeInList')-import           Yi.Config-import           Yi.Core-import           Yi.Editor-import           Yi.History-import           Yi.Keymap-import           Yi.Keymap.Keys-import           Yi.Monad-import qualified Yi.Rope as R-import           Yi.Style (defaultStyle)-import           Yi.String (commonTPrefix)-import           Yi.Utils-import           Yi.Window (bufkey)---- | Prints out the rope of the current buffer as-is to stdout.------ The only way to stop it is to close the buffer in question which--- should free up the 'BufferRef'.-debugBufferContent :: YiM ()-debugBufferContent = promptingForBuffer "buffer to trace:"-                     debugBufferContentUsing (\_ x -> x)--debugBufferContentUsing :: BufferRef -> YiM ()-debugBufferContentUsing b = do-  mv <- io $ newIORef mempty-  keepGoing <- io $ newIORef True-  let delay = threadDelay 100000 >> readIORef keepGoing-  void . forkAction delay NoNeedToRefresh $ do-    findBuffer b >>= \case-      Nothing -> io $ writeIORef keepGoing True-      Just _ -> do-        ns <- withGivenBuffer b elemsB :: YiM R.YiString-        io $ readIORef mv >>= \c ->-          when (c /= ns) (print ns >> void (writeIORef mv ns))---- | Prompts for a buffer name, turns it into a 'BufferRef' and passes--- it on to the handler function. Uses all known buffers for hinting.-promptingForBuffer :: T.Text -- ^ Prompt-                   -> (BufferRef -> YiM ()) -- ^ Handler-                   -> ([BufferRef] -> [BufferRef] -> [BufferRef])-                   -- ^ Hint pre-processor. It takes the list of open-                   -- buffers and a list of all buffers, and should-                   -- spit out all the buffers to possibly hint, in-                   -- the wanted order. Note the hinter uses name-                   -- prefix for filtering regardless of what you do-                   -- here.-                   -> YiM ()-promptingForBuffer prompt act hh = do-    openBufs <- fmap bufkey . toList <$> use windowsA-    names <- withEditor $ do-      bs <- toList . fmap bkey <$> getBufferStack-      let choices = hh openBufs bs-      prefix <- gets commonNamePrefix-      forM choices $ \k ->-        gets (shortIdentString (length prefix) . findBufferWith k)-    withMinibufferFin prompt names (withEditor . getBufferWithName >=> act)---- | Prompts the user for comment syntax to use for the current mode.-commentRegion :: YiM ()-commentRegion =-  withCurrentBuffer (gets $ withMode0 modeToggleCommentSelection) >>= \case-    Nothing -> do-      withMinibufferFree "No comment syntax is defined. Use: " $ \cString ->-        withCurrentBuffer $ do-          let toggle = toggleCommentB (R.fromText cString)-          _ <- toggle-          modifyMode $ (\x -> x { modeToggleCommentSelection = Just toggle })-    Just b -> withCurrentBuffer b---- | Open a minibuffer window with the given prompt and keymap--- The third argument is an action to perform after the minibuffer--- is opened such as move to the first occurence of a searched for--- string. If you don't need this just supply @return ()@-spawnMinibufferE :: T.Text -> KeymapEndo -> EditorM BufferRef-spawnMinibufferE prompt kmMod = do-  b <- stringToNewBuffer (MemBuffer prompt) mempty-  -- Now create the minibuffer keymap and switch to the minibuffer window-  withGivenBuffer b $-    modifyMode $ \m -> m { modeKeymap = \kms -> kms { topKeymap = kmMod (insertKeymap kms)-                                                    } }-  -- The minibuffer window must not be moved from the position newWindowE places it!-  -- First: This way the minibuffer is just below the window that was in focus when-  -- the minibuffer was spawned. This clearly indicates what window is the target of-  -- some actions. Such as searching or the :w (save) command in the Vim keymap.-  -- Second: The users of the minibuffer expect the window and buffer that was in-  -- focus when the minibuffer was spawned to be in focus when the minibuffer is closed-  -- Given that window focus works as follows:-  --    - The new window is broguht into focus.-  --    - The previous window in focus is to the left of the new window in the window-  --    set list.-  --    - When a window is deleted and is in focus then the window to the left is brought-  --    into focus.-  ---  -- If the minibuffer is moved then when the minibuffer is deleted the window brought-  -- into focus may not be the window that spawned the minibuffer.-  w <- newWindowE True b-  windowsA %= PL.insertRight w-  return b---- | @withMinibuffer prompt completer act@: open a minibuffer with @prompt@. Once--- a string @s@ is obtained, run @act s@. @completer@ can be used to complete--- functions: it returns a list of possible matches.-withMinibuffer :: T.Text -> (T.Text -> YiM [T.Text]) -> (T.Text -> YiM ()) -> YiM ()-withMinibuffer prompt getPossibilities =-  withMinibufferGen "" giveHint prompt completer (const $ return ())-    where giveHint s = catMaybes . fmap (prefixMatch s) <$> getPossibilities s-          completer = simpleComplete getPossibilities---- | Makes a completion function.-mkCompleteFn :: (T.Text -> (T.Text -> Maybe T.Text)-                 -> [T.Text] -> EditorM T.Text)-                -- ^ List completion, such as 'completeInList'.-                -> (T.Text -> T.Text -> Maybe T.Text)-                -- ^ Matcher such as 'prefixMatch'-                -> (T.Text -> YiM [T.Text])-                -- ^ Function to fetch possibilites for completion.-                -> T.Text-                -- ^ Input to try and complete against-                -> YiM T.Text-mkCompleteFn completeInListFn match getPossibilities s = do-              possibles <- getPossibilities s-              withEditor $ completeInListFn s (match s) possibles--simpleComplete :: (T.Text -> YiM [T.Text]) -> T.Text -> YiM T.Text-simpleComplete = mkCompleteFn completeInList prefixMatch--infixComplete' :: Bool -> (T.Text -> YiM [T.Text]) -> T.Text -> YiM T.Text-infixComplete' caseSensitive = mkCompleteFn completeInList' $ containsMatch' caseSensitive--infixComplete :: (T.Text -> YiM [T.Text]) -> T.Text -> YiM T.Text-infixComplete = infixComplete' True---- | Hint function that does nothing, for use with @'withMinibufferGen'@-noHint :: a -> YiM [a]-noHint = const $ return []--noPossibilities :: String -> YiM [ String ]-noPossibilities _s = return []---- | @withMinibufferFree prompt act@:--- Simple version of @'withMinibufferGen'@-withMinibufferFree :: T.Text -> (T.Text -> YiM ()) -> YiM ()-withMinibufferFree prompt = withMinibufferGen "" noHint prompt-                            return (const $ return ())---- | @withMinibufferGen proposal getHint prompt completer onTyping act@:--- open a minibuffer with @prompt@, and initial content @proposal@. Once--- a string @s@ is obtained, run @act s@. @completer@ can be used to--- complete inputs by returning an incrementally better match, and--- getHint can give an immediate feedback to the user on the current--- input.------ @on Typing@ is an extra action which will fire with every user--- key-press and receives minibuffer contents. Use something like--- @const $ return ()@ if you don't need this.-withMinibufferGen :: T.Text -> (T.Text -> YiM [T.Text]) -> T.Text-                  -> (T.Text -> YiM T.Text) -> (T.Text -> YiM ())-                  -> (T.Text -> YiM ()) -> YiM ()-withMinibufferGen proposal getHint prompt completer onTyping act = do-  initialBuffer <- gets currentBuffer-  initialWindow <- use currentWindowA-  let innerAction :: YiM ()-      -- ^ Read contents of current buffer (which should be the minibuffer), and-      -- apply it to the desired action-      closeMinibuffer = closeBufferAndWindowE >>-                        windowsA %= fromJust . PL.find initialWindow-      showMatchings = showMatchingsOf . R.toText =<< withCurrentBuffer elemsB-      showMatchingsOf userInput =-        printStatus =<< withDefaultStyle <$> (getHint userInput)-      withDefaultStyle msg = (msg, defaultStyle)-      typing = onTyping . R.toText =<< withCurrentBuffer elemsB--      innerAction = do-        lineString <- withEditor $ do-          let bufToText = R.toText <$> withCurrentBuffer elemsB-          historyFinishGen prompt bufToText-          lineString <- bufToText-          closeMinibuffer-          switchToBufferE initialBuffer-          -- The above ensures that the action is performed on the buffer-          -- that originated the minibuffer.-          return lineString-        act lineString--      up   = historyMove prompt 1-      down = historyMove prompt (-1)--      rebindings =-        choice [oneOf [spec KEnter, ctrl $ char 'm'] >>! innerAction,-                oneOf [spec KUp,    meta $ char 'p'] >>! up,-                oneOf [spec KDown,  meta $ char 'n'] >>! down,-                oneOf [spec KTab,   ctrl $ char 'i']-                  >>! completionFunction completer >>! showMatchings,-                ctrl (char 'g')                     ?>>! closeMinibuffer]--  showMatchingsOf ""-  withEditor $ do-      historyStartGen prompt-      void $ spawnMinibufferE (prompt `T.snoc` ' ')-        (\bindings -> rebindings <|| (bindings >> write showMatchings-                                      >> write typing))-      withCurrentBuffer . replaceBufferContent . R.fromText-        $ replaceShorthands proposal---- | Open a minibuffer, given a finite number of suggestions.-withMinibufferFin :: T.Text -> [T.Text] -> (T.Text -> YiM ()) -> YiM ()-withMinibufferFin prompt possibilities act-    = withMinibufferGen "" hinter prompt completer-      (const $ return ()) (act . best)-  where-    -- The function for returning the hints provided to the user underneath-    -- the input, basically all those that currently match.-    hinter s = return $ match s-    -- All those which currently match.-    match s = filter (s `T.isInfixOf`) possibilities--    -- The best match from the list of matches-    -- If the string matches completely then we take that-    -- otherwise we just take the first match.-    best s-      | s `elem` matches = s-      | null matches       = s-      | otherwise          = head matches-      where matches = match s--    -- We still want "TAB" to complete even though the user could just-    -- press return with an incomplete possibility. The reason is we-    -- may have for example two possibilities which share a long-    -- prefix and hence we wish to press tab to complete up to the-    -- point at which they differ.-    completer s = return $ case commonTPrefix $ catMaybes $ fmap (infixMatch s) possibilities of-        Nothing -> s-        Just p  -> p---- | TODO: decide whether we should be keeping 'T.Text' here or moving--- to 'YiString'.-completionFunction :: (T.Text -> YiM T.Text) -> YiM ()-completionFunction f = do-  p <- withCurrentBuffer pointB-  let r = mkRegion 0 p-  text <- withCurrentBuffer $ readRegionB r-  compl <- R.fromText <$> f (R.toText text)--  -- it's important to do this before removing the text, so if the-  -- completion function raises an exception, we don't delete the-  -- buffer contents.-  withCurrentBuffer $ replaceRegionB r compl--class Promptable a where-    getPromptedValue :: T.Text -> YiM a-    getPrompt :: Proxy a -> T.Text-    getMinibuffer :: Proxy a -> T.Text -> (T.Text -> YiM ()) -> YiM ()-    getMinibuffer _ = withMinibufferFree--doPrompt :: forall a. Promptable a => (a -> YiM ()) -> YiM ()-doPrompt act = getMinibuffer witness (getPrompt witness `T.append` ":") (act <=< getPromptedValue)-  where-    witness = undefined-    witness :: Proxy a--instance Promptable String where-    getPromptedValue = return . T.unpack-    getPrompt _ = "String"--instance Promptable Char where-    getPromptedValue x = if T.null x-                         then error "Please supply a character."-                         else return $ T.head x-    getPrompt _ = "Char"--instance Promptable Int where-    getPromptedValue = return . read . T.unpack-    getPrompt _ = "Integer"--instance Promptable T.Text where-  getPromptedValue = return-  getPrompt _ = "Text"--instance Promptable R.YiString where-  getPromptedValue = return . R.fromText-  getPrompt _ = "YiString"---- helper functions:-getPromptedValueList :: [(T.Text, a)] -> T.Text -> YiM a-getPromptedValueList vs s = maybe (error "Invalid choice") return (lookup s vs)--getMinibufferList :: [(T.Text, a)] -> Proxy a -> T.Text-                  -> (T.Text -> YiM ()) -> YiM ()-getMinibufferList vs _ prompt = withMinibufferFin prompt (fmap fst vs)--enumAll :: (Enum a, Bounded a, Show a) => [(T.Text, a)]-enumAll = fmap (\v -> (T.pack $ show v, v)) [minBound..]--instance Promptable Direction where-    getPromptedValue = getPromptedValueList enumAll-    getPrompt _ = "Direction"-    getMinibuffer = getMinibufferList enumAll--textUnits :: [(T.Text, TextUnit)]-textUnits =-       [("Character", Character),-        ("Document", Document),-        ("Line", Line),-        ("Paragraph", unitParagraph),-        ("Word", unitWord),-        ("ViWord", unitViWord)-       ]--instance Promptable TextUnit where-    getPromptedValue = getPromptedValueList textUnits-    getPrompt _ = "Unit"-    getMinibuffer = getMinibufferList textUnits--instance Promptable Point where-    getPromptedValue s = Point <$> getPromptedValue s-    getPrompt _ = "Point"--anyModeName :: AnyMode -> T.Text-anyModeName (AnyMode m) = modeName m---- TODO: Better name-anyModeByNameM :: T.Text -> YiM (Maybe AnyMode)-anyModeByNameM n = find ((n==) . anyModeName) . modeTable <$> askCfg--anyModeByName :: T.Text -> YiM AnyMode-anyModeByName n = anyModeByNameM n >>= \case-  Nothing -> fail $ "anyModeByName: no such mode: " ++ T.unpack n-  Just m  -> return m--getAllModeNames :: YiM [T.Text]-getAllModeNames = fmap anyModeName . modeTable <$> askCfg--instance Promptable AnyMode where-    getPrompt _ = "Mode"-    getPromptedValue = anyModeByName-    getMinibuffer _ prompt act = do-      names <- getAllModeNames-      withMinibufferFin prompt names act--instance Promptable BufferRef where-    getPrompt _ = "Buffer"-    getPromptedValue = getBufferWithNameOrCurrent-    getMinibuffer _ prompt act = do-      bufs <- matchingBufferNames-      withMinibufferFin prompt bufs act---- | Returns all the buffer names-matchingBufferNames :: YiM [T.Text]-matchingBufferNames = withEditor $ do-  p <- gets commonNamePrefix-  bs <- gets bufferSet-  return $ fmap (shortIdentString $ length p) bs--instance (YiAction a x, Promptable r) => YiAction (r -> a) x where-    makeAction f = YiA $ doPrompt (runAction . makeAction . f)---- | Tag a type with a documentation-newtype (:::) t doc = Doc {fromDoc :: t} deriving (Eq, Typeable, Num, IsString)--instance Show x => Show (x ::: t) where-    show (Doc d) = show d--instance (DocType doc, Promptable t) => Promptable (t ::: doc) where-    getPrompt _ = typeGetPrompt (error "typeGetPrompt should not enter its argument" :: doc)-    getPromptedValue x = Doc <$> getPromptedValue x--class DocType t where-    -- | What to prompt the user when asked this type?-    typeGetPrompt :: t -> T.Text--data LineNumber-instance DocType LineNumber where-    typeGetPrompt _ = "Line"--data ToKill-instance DocType ToKill where-    typeGetPrompt _ = "kill buffer"---data RegexTag deriving Typeable-instance DocType RegexTag where-    typeGetPrompt _ = "Regex"--data FilePatternTag deriving Typeable-instance DocType FilePatternTag where-    typeGetPrompt _ = "File pattern"--newtype CommandArguments = CommandArguments [T.Text]-    deriving (Show, Eq, Typeable)--instance Promptable CommandArguments where-    getPromptedValue = return . CommandArguments . T.words-    getPrompt _ = "Command arguments"
− src/library/Yi/Misc.hs 
@@ -1,214 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE TypeOperators #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Misc--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Various high-level functions to further classify.--module Yi.Misc ( getAppropriateFiles, getFolder, cd, pwd, matchingFileNames-               , rot13Char, placeMark, selectAll, adjBlock, adjIndent-               , promptFile , promptFileChangingHints, matchFile, completeFile-               , printFileInfoE, debugBufferContent-               ) where--import           Control.Applicative-import           Control.Lens (assign)-import           Control.Monad ((>=>), filterM)-import           Control.Monad.Base-import           Data.Char (chr, isAlpha, isLower, isUpper, ord)-import           Data.List ((\\))-import           Data.Maybe (isNothing)-import qualified Data.Text as T-import           System.CanonicalizePath (canonicalizePath, replaceShorthands,-                                          replaceShorthands)-import           System.Directory (doesDirectoryExist, getDirectoryContents,-                                   getCurrentDirectory, setCurrentDirectory)-import           System.Environment (lookupEnv)-import           System.FilePath (takeDirectory, (</>), takeFileName,-                                  addTrailingPathSeparator,-                                  hasTrailingPathSeparator)-import           System.FriendlyPath (expandTilda, isAbsolute')-import           Yi.Buffer-import           Yi.Completion (completeInList')-import           Yi.Editor-import           Yi.Keymap-import           Yi.MiniBuffer (withMinibufferGen, mkCompleteFn,-                                debugBufferContent)-import           Yi.Monad-import qualified Yi.Rope as R-import           Yi.Utils (io)---- | Given a possible starting path (which if not given defaults to--- the current directory) and a fragment of a path we find all files--- within the given (or current) directory which can complete the--- given path fragment. We return a pair of both directory plus the--- filenames on their own that is without their directories. The--- reason for this is that if we return all of the filenames then we--- get a 'hint' which is way too long to be particularly useful.-getAppropriateFiles :: Maybe T.Text -> T.Text -> YiM (T.Text, [ T.Text ])-getAppropriateFiles start s' = do-  curDir <- case start of-    Nothing -> do bufferPath <- withCurrentBuffer $ gets file-                  liftBase $ getFolder bufferPath-    Just path -> return $ T.unpack path-  let s = T.unpack $ replaceShorthands s'-      sDir = if hasTrailingPathSeparator s then s else takeDirectory s-      searchDir-        | null sDir = curDir-        | isAbsolute' sDir = sDir-        | otherwise = curDir </> sDir-  searchDir' <- liftBase $ expandTilda searchDir-  let fixTrailingPathSeparator f = do-        isDir <- doesDirectoryExist (searchDir' </> f)-        return . T.pack $ if isDir then addTrailingPathSeparator f else f--  files <- liftBase $ getDirectoryContents searchDir'--  -- Remove the two standard current-dir and parent-dir as we do not-  -- need to complete or hint about these as they are known by users.-  let files' = files \\ [ ".", ".." ]-  fs <- liftBase $ mapM fixTrailingPathSeparator files'-  let matching = filter (T.isPrefixOf . T.pack $ takeFileName s) fs-  return (T.pack sDir, matching)---- | Given a path, trim the file name bit if it exists.  If no path---   given, return current directory.-getFolder :: Maybe String -> IO String-getFolder Nothing     = getCurrentDirectory-getFolder (Just path) = do-  isDir <- doesDirectoryExist path-  let dir = if isDir then path else takeDirectory path-  if null dir then getCurrentDirectory else return dir----- | Given a possible path and a prefix, return matching file names.-matchingFileNames :: Maybe T.Text -> T.Text -> YiM [T.Text]-matchingFileNames start s = do-  (sDir, files) <- getAppropriateFiles start s--  -- There is one common case when we don't need to prepend @sDir@ to @files@:-  ---  -- Suppose user just wants to edit a file "foobar" in current directory-  -- and inputs ":e foo<Tab>"-  ---  -- @sDir@ in this case equals to "." and "foo" would not be-  -- a prefix of ("." </> "foobar"), resulting in a failed completion-  ---  -- However, if user inputs ":e ./foo<Tab>", we need to prepend @sDir@ to @files@-  let results = if isNothing start && sDir == "." && not ("./" `T.isPrefixOf` s)-                   then files-                   else fmap (T.pack . (T.unpack sDir </>) . T.unpack) files--  return results---- | Place mark at current point-placeMark :: BufferM ()-placeMark = do-  assign highlightSelectionA True-  pointB >>= setSelectionMarkPointB---- | Select the contents of the whole buffer-selectAll :: BufferM ()-selectAll = botB >> placeMark >> topB >> setVisibleSelection True--adjBlock :: Int -> BufferM ()-adjBlock x = withSyntaxB' (\m s -> modeAdjustBlock m s x)---- | A simple wrapper to adjust the current indentation using--- the mode specific indentation function but according to the--- given indent behaviour.-adjIndent :: IndentBehaviour -> BufferM ()-adjIndent ib = withSyntaxB' (\m s -> modeIndent m s ib)---- | Generic emacs style prompt file action. Takes a @prompt@ and a continuation--- @act@ and prompts the user with file hints.-promptFile :: T.Text -> (T.Text -> YiM ()) -> YiM ()-promptFile prompt act = promptFileChangingHints prompt (const return) act---- | As 'promptFile' but additionally allows the caller to transform--- the list of hints arbitrarily, such as only showing directories.-promptFileChangingHints :: T.Text -- ^ Prompt-                        -> (T.Text -> [T.Text] -> YiM [T.Text])-                        -- ^ Hint transformer: current path, generated hints-                        -> (T.Text -> YiM ()) -- ^ Action over choice-                        -> YiM ()-promptFileChangingHints prompt ht act = do-  maybePath <- withCurrentBuffer $ gets file-  startPath <- T.pack . addTrailingPathSeparator-               <$> liftBase (canonicalizePath =<< getFolder maybePath)-  -- TODO: Just call withMinibuffer-  withMinibufferGen startPath (\x -> findFileHint startPath x >>= ht x) prompt-    (completeFile startPath) showCanon (act . replaceShorthands)-  where-    showCanon = withCurrentBuffer . replaceBufferContent . R.fromText . replaceShorthands--matchFile :: T.Text -> T.Text -> Maybe T.Text-matchFile path proposedCompletion =-  let realPath = replaceShorthands path-  in T.append path <$> T.stripPrefix realPath proposedCompletion--completeFile :: T.Text -> T.Text -> YiM T.Text-completeFile startPath =-  mkCompleteFn completeInList' matchFile $ matchingFileNames (Just startPath)---- | For use as the hint when opening a file using the minibuffer. We--- essentially return all the files in the given directory which have--- the given prefix.-findFileHint :: T.Text -> T.Text -> YiM [T.Text]-findFileHint startPath s = snd <$> getAppropriateFiles (Just startPath) s--onCharLetterCode :: (Int -> Int) -> Char -> Char-onCharLetterCode f c | isAlpha c = chr (f (ord c - a) `mod` 26 + a)-                     | otherwise = c-                     where a | isUpper c = ord 'A'-                             | isLower c = ord 'a'-                             | otherwise = undefined---- | Like @M-x cd@, it changes the current working directory. Mighty--- useful when we don't start Yi from the project directory or want to--- switch projects, as many tools only use the current working--- directory.-cd :: YiM ()-cd = promptFileChangingHints "switch directory to:" dirs $ \path ->-  io $ getFolder (Just $ T.unpack path) >>= clean . T.pack-       >>= System.Directory.setCurrentDirectory . addTrailingPathSeparator-  where-     replaceHome p@('~':'/':xs) = lookupEnv "HOME" >>= return . \case-       Nothing -> p-       Just h -> h </> xs-     replaceHome p = return p-     clean = replaceHome . T.unpack . replaceShorthands >=> canonicalizePath--     x <//> y = T.pack $ takeDirectory (T.unpack x) </> T.unpack y--     dirs :: T.Text -> [T.Text] -> YiM [T.Text]-     dirs x xs = do-       xsc <- io $ mapM (\y -> (,y) <$> clean (x <//> y)) xs-       filterM (io . doesDirectoryExist . fst) xsc >>= return . map snd---- | Shows current working directory. Also see 'cd'.-pwd :: YiM ()-pwd = io getCurrentDirectory >>= withEditor . printMsg . T.pack--rot13Char :: Char -> Char-rot13Char = onCharLetterCode (+13)--printFileInfoE :: EditorM ()-printFileInfoE = printMsg . showBufInfo =<< withCurrentBuffer bufInfoB-    where showBufInfo :: BufferFileInfo -> T.Text-          showBufInfo bufInfo = T.concat-            [ T.pack $ bufInfoFileName bufInfo-            , " Line "-            , T.pack . show $ bufInfoLineNo bufInfo-            , " ["-            , bufInfoPercent bufInfo-            , "]"-            ]
− src/library/Yi/Mode/Abella.hs 
@@ -1,144 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.Abella--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ 'Mode's and utility function for working with the Abella--- interactive theorem prover.--module Yi.Mode.Abella-  ( abellaModeEmacs-  , abella-  , abellaEval-  , abellaEvalFromProofPoint-  , abellaUndo-  , abellaGet-  , abellaSend-  ) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad-import           Data.Binary-import           Data.Char (isSpace)-import           Data.Default-import           Data.Maybe (isJust)-import qualified Data.Text as T-import           Data.Typeable-import           Yi.Buffer-import           Yi.Core (sendToProcess)-import           Yi.Types (YiVariable)-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Keys-import qualified Yi.Lexer.Abella as Abella-import           Yi.MiniBuffer (CommandArguments(..))-import qualified Yi.Mode.Interactive as Interactive-import           Yi.Modes (TokenBasedMode, styleMode, anyExtension)-import qualified Yi.Rope as R--abellaModeGen :: (Char -> [Event]) -> TokenBasedMode Abella.Token-abellaModeGen abellaBinding = styleMode Abella.lexer-  & modeNameA .~ "abella"-  & modeAppliesA .~ anyExtension ["thm"]-  & modeToggleCommentSelectionA .~ Just (toggleCommentB "%")-  & modeKeymapA .~ topKeymapA %~ (<||)-     (choice-      [ abellaBinding 'p' ?*>>! abellaUndo-      , abellaBinding 'e' ?*>>! abellaEval-      , abellaBinding 'n' ?*>>! abellaNext-      , abellaBinding 'a' ?*>>! abellaAbort-      , abellaBinding '\r' ?*>>! abellaEvalFromProofPoint-      ])--abellaModeEmacs :: TokenBasedMode Abella.Token-abellaModeEmacs = abellaModeGen (\ch -> [ctrlCh 'c', ctrlCh ch])--newtype AbellaBuffer = AbellaBuffer {_abellaBuffer :: Maybe BufferRef}-    deriving (Default, Typeable, Binary)-instance YiVariable AbellaBuffer--getProofPointMark :: BufferM Mark-getProofPointMark = getMarkB $ Just "p"--getTheoremPointMark :: BufferM Mark-getTheoremPointMark = getMarkB $ Just "t"--abellaEval :: YiM ()-abellaEval = do-  reg <- withCurrentBuffer . savingPointB $ do-    join (assign . markPointA <$> getProofPointMark <*> pointB)-    leftB-    readRegionB =<< regionOfNonEmptyB unitSentence-  abellaSend reg--abellaEvalFromProofPoint :: YiM ()-abellaEvalFromProofPoint = abellaSend =<< withCurrentBuffer f-  where f = do mark <- getProofPointMark-               p <- use $ markPointA mark-               cur <- pointB-               markPointA mark .= cur-               readRegionB $ mkRegion p cur--abellaNext :: YiM ()-abellaNext = do-  reg <- withCurrentBuffer $ rightB >> (readRegionB =<< regionOfNonEmptyB unitSentence)-  abellaSend reg-  withCurrentBuffer $ do-    moveB unitSentence Forward-    rightB-    untilB_ (not . isSpace <$> readB) rightB-    untilB_ ((/= '%') <$> readB) $ moveToEol >> rightB >> firstNonSpaceB-    join (assign . markPointA <$> getProofPointMark <*> pointB)--abellaUndo :: YiM ()-abellaUndo = do-  abellaSend "undo."-  withCurrentBuffer $ do-    moveB unitSentence Backward-    join (assign . markPointA <$> getProofPointMark <*> pointB)--abellaAbort :: YiM ()-abellaAbort = do-  abellaSend "abort."-  withCurrentBuffer $ do-    moveTo =<< use . markPointA =<< getTheoremPointMark-    join (assign . markPointA <$> getProofPointMark <*> pointB)---- | Start Abella in a buffer-abella :: CommandArguments -> YiM BufferRef-abella (CommandArguments args) = do-    b <- Interactive.spawnProcess "abella" (T.unpack <$> args)-    withEditor . putEditorDyn . AbellaBuffer $ Just b-    return b---- | Return Abella's buffer; create it if necessary.--- Show it in another window.-abellaGet :: YiM BufferRef-abellaGet = withOtherWindow $ do-    AbellaBuffer mb <- withEditor getEditorDyn-    case mb of-        Nothing -> abella (CommandArguments [])-        Just b -> do-            stillExists <- isJust <$> findBuffer b-            if stillExists-                then do withEditor $ switchToBufferE b-                        return b-                else abella (CommandArguments [])---- | Send a command to Abella-abellaSend :: R.YiString -> YiM ()-abellaSend cmd' = do-  let cmd = R.toText cmd'-  when ("Theorem" `T.isInfixOf` cmd) $-    withCurrentBuffer $ join (assign . markPointA <$> getTheoremPointMark <*> pointB)-  b <- abellaGet-  withGivenBuffer b botB-  sendToProcess b . T.unpack $ cmd `T.snoc` '\n'
− src/library/Yi/Mode/Buffers.hs 
@@ -1,66 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.Buffers--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ A minimalist emulation of emacs buffer menu mode, to be fleshed out later--module Yi.Mode.Buffers (listBuffers) where--import           Control.Applicative ((<$>))-import           Control.Category ((>>>))-import           Control.Lens-import           Data.List.NonEmpty (toList)-import qualified Data.Text as T-import           System.FilePath (takeFileName)-import           Yi.Buffer-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Keys-import qualified Yi.Rope as R---- | Retrieve buffer list and open a them in buffer mode using the--- 'bufferKeymap'.-listBuffers :: YiM ()-listBuffers = do-  withEditor $ do-    bs <- toList <$> getBufferStack-    let bufferList = R.fromText . T.intercalate "\n" $ map identString bs-    bufRef <- stringToNewBuffer (MemBuffer "Buffer List") bufferList-    switchToBufferE bufRef-  withCurrentBuffer $ do-    modifyMode $ modeKeymapA .~ topKeymapA %~ bufferKeymap-                 >>> modeNameA .~ "buffers"-    assign readOnlyA True---- | Switch to the buffer with name at current name. If it it starts--- with a @/@ then assume it's a file and try to open it that way.-switch :: YiM ()-switch = do-  -- the YiString -> FilePath -> Text conversion sucks-  s <- R.toString <$> withCurrentBuffer readLnB-  let short = T.pack $ if take 1 s == "/" then takeFileName s else s-  withEditor $ switchToBufferWithNameE short---- | Keymap for the buffer mode.------ @--- __p__              → line up--- __n__ or __SPACE__ → line down--- __ENTER__ or __f__ → open buffer--- __v__              → open buffer as read-only--- @-bufferKeymap :: Keymap -> Keymap-bufferKeymap = important $ choice-  [ char 'p'                        ?>>! lineUp-  , oneOf [ char 'n', char ' ' ]    >>! lineDown-  , oneOf [ spec KEnter, char 'f' ] >>! (switch >> setReadOnly False)-  , char 'v'                        ?>>! (switch >> setReadOnly True)-  ]-  where-    setReadOnly = withCurrentBuffer . assign readOnlyA
− src/library/Yi/Mode/Compilation.hs 
@@ -1,41 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.Compilation--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ A 'Mode' for working with buffers showing the results of compilations.-module Yi.Mode.Compilation where--import           Control.Lens-import           Data.Text ()-import           Yi.Buffer-import           Yi.Core (withSyntax)-import           Yi.Editor-import           Yi.File (editFile)-import           Yi.Lexer.Alex (Tok(..), Posn(..))-import qualified Yi.Lexer.Compilation as Compilation-import           Yi.Keymap-import           Yi.Keymap.Keys-import           Yi.Modes (styleMode, TokenBasedMode)-import qualified Yi.Syntax.OnlineTree as OnlineTree--mode :: TokenBasedMode Compilation.Token-mode = styleMode Compilation.lexer-  & modeAppliesA .~ modeNeverApplies-  & modeNameA .~ "compilation"-  & modeKeymapA .~ topKeymapA %~ ((spec KEnter ?>>! withSyntax modeFollow) <||)-  & modeFollowA .~ YiA . follow-  where-    follow errs = withCurrentBuffer pointB >>= \point ->-      case OnlineTree.tokAtOrBefore point errs of-        Just t@Tok {tokT = Compilation.Report filename line col _} -> do-          withCurrentBuffer . moveTo . posnOfs $ tokPosn t-          shiftOtherWindow-          _ <- editFile filename-          withCurrentBuffer $ gotoLn line >> rightN col-        _ -> return ()
− src/library/Yi/Mode/GHCi.hs 
@@ -1,94 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.GHCi--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ A mode for GHCi, implemented as tweaks on Interaction mode--module Yi.Mode.GHCi where--import           Control.Lens-import           Data.Binary-import           Data.Default-#if __GLASGOW_HASKELL__ < 708-import           Data.DeriveTH-#else-import           GHC.Generics (Generic)-#endif-import           Data.Text ()-import qualified Data.Text as T-import           Data.Typeable-import           Yi.Buffer-import           Yi.Types (YiVariable)-import           Yi.Keymap-import           Yi.Keymap.Keys-import           Yi.Lexer.Alex (Tok)-import           Yi.Lexer.Compilation (Token())-import qualified Yi.Mode.Interactive as I-import qualified Yi.Rope as R-import           Yi.Syntax.OnlineTree (Tree)---- | The process name to use to spawn GHCi.-data GhciProcessName = GhciProcessName-  { _ghciProcessName :: FilePath-    -- ^ Command to run when spawning GHCi.-  , _ghciProcessArgs :: [String]-    -- ^ Args to pass to the process.-  } deriving (Typeable, Show)---- | The process name defaults to @ghci@.-instance Default GhciProcessName where-  def = GhciProcessName { _ghciProcessName = "ghci"-                        , _ghciProcessArgs = []-                        }--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''GhciProcessName)-#else-deriving instance Generic GhciProcessName-instance Binary GhciProcessName-#endif--makeLenses ''GhciProcessName---- | Setting this is a bit like '(setq haskell-program-name foo)' in--- emacs' @haskell-mode@.-instance YiVariable GhciProcessName---- | Mode used for GHCi. Currently it just overrides 'KHome' key to go--- just before the prompt through the use of 'homeKey'.-mode :: Mode (Tree (Tok Token))-mode = I.mode-  & modeNameA .~ "ghci"-  & modeKeymapA .~ topKeymapA %~ important (spec KHome ?>>! homeKey)---- | The GHCi prompt always begins with ">"; this goes to just before--- it, or if one is already at the start of the prompt, goes to the--- beginning of the line. (If at the beginning of the line, this--- pushes you forward to it.)-homeKey :: BufferM ()-homeKey = readLnB >>= \l -> case T.findIndex ('>' ==) (R.toText l) of-  Nothing -> moveToSol-  Just pos -> do-    (_,mypos) <- getLineAndCol-    moveToSol >> if mypos == (pos + 2)-                 then return ()-                 else moveXorEol (pos + 2)---- | Spawns an interactive process ("Yi.Mode.Interactive") with GHCi--- 'mode' over it.-spawnProcess :: FilePath -- ^ Command to use.-             -> [String] -- ^ Process args.-             -> YiM BufferRef -- ^ Reference to the spawned buffer.-spawnProcess = I.spawnProcessMode mode
− src/library/Yi/Mode/Haskell.hs 
@@ -1,472 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.Haskell--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Collection of 'Mode's for working with Haskell.--module Yi.Mode.Haskell-  (-   -- * Modes-   haskellAbstract,-   cleverMode,-   preciseMode,-   literateMode,-   fastMode,--   -- * IO-level operations-   ghciGet,-   ghciSend,-   ghciLoadBuffer,-   ghciInferType,-   ghciSetProcessName,-   ghciSetProcessArgs-  ) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad hiding (forM_)-import           Data.Binary-import           Data.Default-import           Data.Foldable-import           Data.Maybe (listToMaybe, isJust)-import           Data.Monoid-import qualified Data.Text as T-import           Data.Typeable-import           Prelude hiding (and,error,elem,notElem,all,concatMap,exp)-import           Text.Read (readMaybe)-import           Yi.Buffer-import           Yi.Core (sendToProcess)-import           Yi.Debug-import           Yi.Types (YiVariable)-import           Yi.Editor-import           Yi.File-import qualified Yi.IncrementalParse as IncrParser-import           Yi.Keymap-import           Yi.Lexer.Alex (Tok(..), Posn(..), tokBegin, tokEnd,-                                commonLexer, AlexState, lexScanner, CharScanner)-import           Yi.Lexer.Haskell as Haskell-import qualified Yi.Lexer.LiterateHaskell as LiterateHaskell-import           Yi.MiniBuffer-import qualified Yi.Mode.GHCi as GHCi-import qualified Yi.Mode.Interactive as Interactive-import           Yi.Modes (anyExtension, extensionOrContentsMatch)-import           Yi.Monad-import qualified Yi.Rope as R-import           Yi.String-import           Yi.Syntax-import qualified Yi.Syntax.Driver as Driver-import           Yi.Syntax.Haskell as Hask-import           Yi.Syntax.Layout (State)-import           Yi.Syntax.OnlineTree as OnlineTree-import           Yi.Syntax.Paren as Paren-import           Yi.Syntax.Strokes.Haskell as HS-import           Yi.Syntax.Tree-import           Yi.Utils---- | General ‘template’ for actual Haskell modes.------ It applies over @extensions = ["hs", "x", "hsc", "hsinc"]@ which--- may be a little questionable but for now Yi is mostly used by--- Haskell hackers so it should be fine, at least for now.-haskellAbstract :: Mode (tree TT)-haskellAbstract = emptyMode-  & modeAppliesA .~ extensionOrContentsMatch extensions shebangPattern-  & modeNameA .~ "haskell"-  & modeToggleCommentSelectionA .~ Just (toggleCommentB "--")-  where extensions = ["hs", "x", "hsc", "hsinc"]-        shebangPattern = "^#![[:space:]]*/usr/bin/env[[:space:]]+runhaskell"---- | "Clever" haskell mode, using the paren-matching syntax.-cleverMode :: Mode (Paren.Tree (Tok Haskell.Token))-cleverMode = haskellAbstract-  & modeIndentA .~ cleverAutoIndentHaskellB-  & modeGetStrokesA .~ strokesOfParenTree-  & modeHLA .~ mkParenModeHL (skipScanner 50) haskellLexer-  & modeAdjustBlockA .~ adjustBlock-  & modePrettifyA .~ cleverPrettify . allToks--fastMode :: Mode (OnlineTree.Tree TT)-fastMode = haskellAbstract-  & modeNameA .~ "fast haskell"-  & modeHLA .~ mkOnlineModeHL haskellLexer-  & modeGetStrokesA .~ tokenBasedStrokes Paren.tokenToStroke--literateMode :: Mode (Paren.Tree TT)-literateMode = haskellAbstract-  & modeNameA .~ "literate haskell"-  & modeAppliesA .~ anyExtension ["lhs"]-  & modeHLA .~ mkParenModeHL id literateHaskellLexer-  & modeGetStrokesA .~ strokesOfParenTree-    -- FIXME I think that 'begin' should not be ignored-  & modeAdjustBlockA .~ adjustBlock-  & modeIndentA .~ cleverAutoIndentHaskellB-  & modePrettifyA .~ cleverPrettify . allToks---- | Experimental Haskell mode, using a rather precise parser for the syntax.-preciseMode :: Mode (Hask.Tree TT)-preciseMode = haskellAbstract-  & modeNameA .~ "precise haskell"-  & modeIndentA .~ cleverAutoIndentHaskellC-  & modeGetStrokesA .~ (\ast point begin end -> HS.getStrokes point begin end ast)-  & modeHLA .~ mkHaskModeHL haskellLexer-  & modePrettifyA .~ cleverPrettify . allToks----strokesOfParenTree :: Paren.Tree TT -> Point -> Point -> Point -> [Stroke]-strokesOfParenTree t p b e = Paren.getStrokes p b e t--type CharToTTScanner s = CharScanner -> Scanner (AlexState s) TT--mkParenModeHL :: (IsTree tree, Show state)-              => (Scanner-                  (IncrParser.State (State Token lexState) TT (Paren.Tree TT))-                  (Paren.Tree TT)-                  -> Scanner state (tree (Tok tt)))-              -> CharToTTScanner lexState-              -> ExtHL (tree (Tok tt))-mkParenModeHL f l = ExtHL $ Driver.mkHighlighter scnr-  where-    scnr = f . IncrParser.scanner Paren.parse . Paren.indentScanner . l--mkHaskModeHL :: Show st => CharToTTScanner st -> ExtHL (Exp (Tok Token))-mkHaskModeHL l = ExtHL $ Driver.mkHighlighter scnr-  where-    scnr = IncrParser.scanner Hask.parse . Hask.indentScanner . l--mkOnlineModeHL :: Show st => (CharScanner -> Scanner st (Tok tt))-               -> ExtHL (OnlineTree.Tree (Tok tt))-mkOnlineModeHL l = ExtHL $ Driver.mkHighlighter scnr-  where-    scnr = IncrParser.scanner OnlineTree.manyToks . l--haskellLexer :: CharScanner -> Scanner (AlexState Haskell.HlState) TT-haskellLexer = lexScanner (commonLexer Haskell.alexScanToken Haskell.initState)--literateHaskellLexer :: CharScanner -> Scanner (AlexState LiterateHaskell.HlState) TT-literateHaskellLexer = lexScanner (commonLexer LiterateHaskell.alexScanToken LiterateHaskell.initState)--adjustBlock :: Paren.Tree (Tok Token) -> Int -> BufferM ()-adjustBlock e len = do-  p <- pointB-  l <- curLn-  let t = Paren.getIndentingSubtree e p l-  case t of-    Nothing -> return ()-    Just it -> savingExcursionB $ do-      let (_startOfs, height) = Paren.getSubtreeSpan it-      col <- curCol-      forM_ [1..height] $ const $ do-        lineDown-        indent <- indentOfB =<< readLnB-        -- it might be that we have 1st column comments in the block,-        -- which should not be changed.-        when (indent > col) $-         if len >= 0-          then do-           insertN $ R.replicateChar len ' '-           leftN len-          else deleteN (negate len)---- | Returns true if the token should be indented to look as "inside"--- the group.-insideGroup :: Token -> Bool-insideGroup (Special c) = T.any (== c) "',;})]"-insideGroup _ = True--cleverAutoIndentHaskellB :: Paren.Tree TT -> IndentBehaviour -> BufferM ()-cleverAutoIndentHaskellB e behaviour = do-  indentSettings <- indentSettingsB-  let indentLevel = shiftWidth indentSettings-  previousIndent <- indentOfB =<< getNextNonBlankLineB Backward-  nextIndent     <- indentOfB =<< getNextNonBlankLineB Forward-  solPnt <- pointAt moveToSol-  eolPnt <- pointAt moveToEol-  let onThisLine ofs = ofs >= solPnt && ofs <= eolPnt-      firstTokNotOnLine = listToMaybe .-                              filter (not . onThisLine . posnOfs . tokPosn) .-                              filter (not . isErrorTok . tokT) . concatMap allToks-  let stopsOf :: [Paren.Tree TT] -> [Int]-      stopsOf (g@(Paren.Paren open ctnt close):ts')-          | isErrorTok (tokT close) || getLastOffset g >= solPnt-              = [groupIndent open ctnt]  -- stop here: we want to be "inside" that group.-          | otherwise = stopsOf ts' -- this group is closed before this line; just skip it.-      stopsOf (Paren.Atom (Tok {tokT = t}):_) | startsLayout t = [nextIndent, previousIndent + indentLevel]-        -- of; where; etc. we want to start the block here.-        -- Also use the next line's indent:-        -- maybe we are putting a new 1st statement in the block here.-      stopsOf (Paren.Atom _:ts) = stopsOf ts-         -- any random part of expression, we ignore it.-      stopsOf (t@(Paren.Block _):ts) = shiftBlock + maybe 0 (posnCol . tokPosn) (getFirstElement t) : stopsOf ts-      stopsOf (_:ts) = stopsOf ts-      stopsOf [] = []-      firstTokOnLine = fmap tokT $ listToMaybe $-          dropWhile ((solPnt >) . tokBegin) $-          takeWhile ((eolPnt >) . tokBegin) $ -- for laziness.-          filter (not . isErrorTok . tokT) $ allToks e-      shiftBlock = case firstTokOnLine of-        Just (Reserved t) | t `elem` [Where, Deriving] -> indentLevel-        Just (ReservedOp Haskell.Pipe) -> indentLevel-        Just (ReservedOp Haskell.Equal) -> indentLevel-        _ -> 0-      deepInGroup = maybe True insideGroup firstTokOnLine-      groupIndent (Tok {tokT = Special openChar, tokPosn = Posn _ _ openCol}) ctnt-          | deepInGroup = case firstTokNotOnLine ctnt of-              -- examine the first token of the group (but not on the line we are indenting!)-              Nothing -> openCol + nominalIndent openChar -- no such token: indent normally.-              Just t -> posnCol . tokPosn $ t -- indent along that other token-          | otherwise = openCol-      groupIndent (Tok {}) _ = error "unable to indent code"-  case getLastPath [e] solPnt of-    Nothing -> return ()-    Just path -> let stops = stopsOf path-                 in trace ("Stops = " <> showT stops) $-                    trace ("firstTokOnLine = " <> showT firstTokOnLine) $-                    cycleIndentsB behaviour stops--cleverAutoIndentHaskellC :: Exp TT -> IndentBehaviour -> BufferM ()-cleverAutoIndentHaskellC e behaviour = do-  indentSettings <- indentSettingsB-  let indentLevel = shiftWidth indentSettings-  previousIndent <- indentOfB =<< getNextNonBlankLineB Backward-  nextIndent     <- indentOfB =<< getNextNonBlankLineB Forward-  solPnt <- pointAt moveToSol-  eolPnt <- pointAt moveToEol-  let onThisLine ofs = ofs >= solPnt && ofs <= eolPnt-      firstTokNotOnLine = listToMaybe .-                              filter (not . onThisLine . posnOfs . tokPosn) .-                              filter (not . isErrorTok . tokT) . concatMap allToks-  let stopsOf :: [Hask.Exp TT] -> [Int]-      stopsOf (g@(Hask.Paren (Hask.PAtom open _) ctnt (Hask.PAtom close _)):ts)-          | isErrorTok (tokT close) || getLastOffset g >= solPnt-              = [groupIndent open ctnt]-            -- stop here: we want to be "inside" that group.-          | otherwise = stopsOf ts-           -- this group is closed before this line; just skip it.-      stopsOf (Hask.PAtom (Tok {tokT = t}) _:_) | startsLayout t || (t == ReservedOp Equal)-          = [nextIndent, previousIndent + indentLevel]-        -- of; where; etc. ends the previous line. We want to start the block here.-        -- Also use the next line's indent:-        -- maybe we are putting a new 1st statement in the block here.-      stopsOf (l@(Hask.PLet _ (Hask.Block _) _):ts') = [colOf' l | lineStartsWith (Reserved Haskell.In)] <> stopsOf ts'-                                                       -- offer to align with let only if this is an "in"-      stopsOf (t@(Hask.Block _):ts') = (shiftBlock + colOf' t) : stopsOf ts'-                                       -- offer add another statement in the block-      stopsOf (Hask.PGuard' (PAtom pipe _) _ _:ts') = [tokCol pipe | lineStartsWith (ReservedOp Haskell.Pipe)] <> stopsOf ts'-                                                                 -- offer to align against another guard-      stopsOf (d@(Hask.PData {}):ts') = colOf' d + indentLevel-                                           : stopsOf ts' --FIXME!-      stopsOf (Hask.RHS (Hask.PAtom{}) exp:ts')-          = [case firstTokOnLine of-              Just (Operator op') -> opLength op' (colOf' exp) -- Usually operators are aligned against the '=' sign-              -- case of an operator should check so that value always is at least 1-              _ -> colOf' exp | lineIsExpression ] <> stopsOf ts'-                   -- offer to continue the RHS if this looks like an expression.-      stopsOf [] = [0] -- maybe it's new declaration in the module-      stopsOf (_:ts) = stopsOf ts -- by default, there is no reason to indent against an expression.-       -- calculate indentation of operator (must be at least 1 to be valid)-      opLength ts' r = let l = r - (length ts' + 1) -- I find this dubious...-                       in  if l > 0 then l else 1--      lineStartsWith tok = firstTokOnLine == Just tok-      lineIsExpression   = all (`notElem` [ReservedOp Haskell.Pipe, ReservedOp Haskell.Equal, ReservedOp RightArrow]) toksOnLine-                           && not (lineStartsWith (Reserved Haskell.In))-      -- TODO: check the tree instead of guessing by looking at tokens-      firstTokOnLine = listToMaybe toksOnLine-      toksOnLine = fmap tokT $-          dropWhile ((solPnt >) . tokBegin) $-          takeWhile ((eolPnt >) . tokBegin) $ -- for laziness.-          filter (not . isErrorTok . tokT) $ allToks e-      shiftBlock = case firstTokOnLine of-        Just (Reserved t) | t `elem` [Where, Deriving] -> indentLevel-        Just (ReservedOp Haskell.Pipe) -> indentLevel-        Just (ReservedOp Haskell.Equal) -> indentLevel-        _ -> 0-      deepInGroup = maybe True insideGroup firstTokOnLine-      groupIndent (Tok {tokT = Special openChar, tokPosn = Posn _ _ openCol}) ctnt-          | deepInGroup = case firstTokNotOnLine ctnt of-              -- examine the first token of the group-              -- (but not on the line we are indenting!)-              Nothing -> openCol + nominalIndent openChar-              -- no such token: indent normally.-              Just t -> posnCol . tokPosn $ t -- indent along that other token-          | otherwise = openCol-      groupIndent (Tok{}) _ = error "unable to indent code"-  case getLastPath [e] solPnt of-    Nothing -> return ()-    Just path ->let stops = stopsOf path-                in trace ("Path = " <> showT path) $-                   trace ("Stops = " <> showT stops) $-                   trace ("Previous indent = " <> showT previousIndent) $-                   trace ("Next indent = " <> showT nextIndent) $-                   trace ("firstTokOnLine = " <> showT firstTokOnLine) $-                   cycleIndentsB behaviour stops--colOf' :: Foldable t => t TT -> Int-colOf' = maybe 0 tokCol . getFirstElement--tokCol :: Tok t -> Int-tokCol = posnCol . tokPosn---nominalIndent :: Char -> Int-nominalIndent '{' = 2-nominalIndent _ = 1--tokText :: Tok t -> BufferM R.YiString-tokText = readRegionB . tokRegion--tokRegion :: Tok t -> Region-tokRegion t = mkRegion (tokBegin t) (tokEnd t)--isLineComment :: TT -> Bool-isLineComment = (Just Haskell.Line ==) . tokTyp . tokT--contiguous :: Tok t -> Tok t -> Bool-contiguous a b = lb - la <= 1-    where [la,lb] = fmap (posnLine . tokPosn) [a,b]--coalesce :: Tok Token -> Tok Token -> Bool-coalesce a b = isLineComment a && isLineComment b && contiguous a b--cleverPrettify :: [TT] -> BufferM ()-cleverPrettify toks = do-  pnt <- pointB-  let groups = groupBy' coalesce toks-      isCommentGroup g = tokTyp (tokT $ head g) `elem` fmap Just [Haskell.Line]-      thisCommentGroup = listToMaybe $ dropWhile ((pnt >) . tokEnd . last) $ filter isCommentGroup groups-                         -- FIXME: laziness-  case thisCommentGroup of-    Nothing -> return ()-    Just g -> do-      text <- T.unwords . fmap (T.drop 2 . R.toText) <$> mapM tokText g-      let region = mkRegion (tokBegin . head $ g) (tokEnd . last $ g)-          mkGrp = const . R.unlines $ R.append "-- " <$> fillText 80 (R.fromText text)-      modifyRegionB mkGrp region--tokTyp :: Token -> Maybe Haskell.CommentType-tokTyp (Comment t) = Just t-tokTyp _ = Nothing---- TODO: export or remove--- -- Keyword-based auto-indenter for haskell.--- autoIndentHaskellB :: IndentBehaviour -> BufferM ()--- autoIndentHaskellB =---   autoIndentWithKeywordsB [ "if"---                           , "then"---                           , "else"---                           , "|"---                           , "->"---                           , "case" -- hmm---                           , "in"---                           -- Note tempted by having '=' in here that would---                           -- potentially work well for 'data' declarations---                           -- but I think '=' is so common in other places---                           -- that it would introduce many spurious/annoying---                           -- hints.---                           ]---                           [ "where"---                           , "let"---                           , "do"---                           , "mdo"---                           , "{-"---                           , "{-|"---                           , "--"---                           ]---------------------------------- * Interaction with GHCi---- | Variable storing the possibe buffer reference where GHCi is--- currently running.-newtype GhciBuffer = GhciBuffer {_ghciBuffer :: Maybe BufferRef}-    deriving (Default, Typeable, Binary)--instance YiVariable GhciBuffer---- | Start GHCi in a buffer-ghci :: YiM BufferRef-ghci = do-  g <- getEditorDyn-  b <- GHCi.spawnProcess (g ^. GHCi.ghciProcessName) (g ^. GHCi.ghciProcessArgs)-  withEditor . putEditorDyn . GhciBuffer $ Just b-  return b---- | Return GHCi's buffer; create it if necessary.--- Show it in another window.-ghciGet :: YiM BufferRef-ghciGet = withOtherWindow $ do-    GhciBuffer mb <- withEditor getEditorDyn-    case mb of-        Nothing -> ghci-        Just b -> do-            stillExists <- isJust <$> findBuffer b-            if stillExists-                then do withEditor $ switchToBufferE b-                        return b-                else ghci---- | Send a command to GHCi-ghciSend :: String -> YiM ()-ghciSend cmd = do-    b <- ghciGet-    withGivenBuffer b botB-    sendToProcess b (cmd <> "\n")---- | Load current buffer in GHCi-ghciLoadBuffer :: YiM ()-ghciLoadBuffer = do-    fwriteE-    f <- withCurrentBuffer (gets file)-    case f of-      Nothing -> error "Couldn't get buffer filename in ghciLoadBuffer"-      Just filename -> ghciSend $ ":load " <> show filename---- Tells ghci to infer the type of the identifier at point. Doesn't--- check for errors (yet)-ghciInferType :: YiM ()-ghciInferType = do-    nm <- withCurrentBuffer (readUnitB unitWord)-    unless (R.null nm) $-      withMinibufferGen (R.toText nm) noHint "Insert type of which identifier?"-      return (const $ return ()) (ghciInferTypeOf . R.fromText)--ghciInferTypeOf :: R.YiString -> YiM ()-ghciInferTypeOf nm = do-    buf <- ghciGet-    result <- Interactive.queryReply buf (":t " <> R.toString nm)-    let successful = (not . R.null) nm && nm == result-    when successful . withCurrentBuffer $-      moveToSol *> insertB '\n' *> leftB-      *> insertN result *> rightB--ghciSetProcessName :: YiM ()-ghciSetProcessName = do-  g <- getEditorDyn-  let nm = g ^. GHCi.ghciProcessName-      prompt = T.concat [ "Command to call for GHCi, currently ‘"-                        , T.pack nm, "’: " ]-  withMinibufferFree prompt $ \s ->-    putEditorDyn $ g & GHCi.ghciProcessName .~ T.unpack s--ghciSetProcessArgs :: YiM ()-ghciSetProcessArgs = do-  g <- getEditorDyn-  let nm = g ^. GHCi.ghciProcessName-      args = g ^. GHCi.ghciProcessArgs-      prompt = T.unwords $ [ "List of args to call "-                           , T.pack nm-                           , "with, currently"-                           , T.pack $ show args-                           , ":"-                           ]-  withMinibufferFree prompt $ \arg ->-    case readMaybe $ T.unpack arg of-      Nothing -> printMsg "Could not parse as [String], keep old args."-      Just arg' -> putEditorDyn $ g & GHCi.ghciProcessArgs .~ arg'
− src/library/Yi/Mode/Haskell/Dollarify.hs 
@@ -1,188 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PatternGuards #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.Haskell.Dollarify--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Mode.Haskell.Dollarify where--import           Control.Applicative-import           Control.Monad-import           Data.Function (on)-import           Data.List (sortBy)-import           Data.Maybe (fromMaybe)-import           Data.Monoid-import           Data.Text ()-import           Yi.Buffer hiding (Block)-import           Yi.Debug-import           Yi.Lexer.Alex (posnOfs, Tok(..))-import           Yi.Lexer.Haskell (isComment, TT, Token(..))-import qualified Yi.Rope as R-import           Yi.String-import qualified Yi.Syntax.Haskell as H (Tree, Exp(..))-import           Yi.Syntax.Paren (Expr, Tree(..))-import           Yi.Syntax.Tree (getAllSubTrees, getFirstOffset,-                                 getLastOffset, getLastPath)--dollarify :: Tree TT -> BufferM ()-dollarify t = maybe (return ()) dollarifyWithin . selectedTree [t] =<< getSelectRegionB--dollarifyWithin :: Tree TT -> BufferM ()-dollarifyWithin = trace . ("dollarifyWithin: " <>) . showT <*> runQ . (dollarifyTop =<<) . getAllSubTrees--data QueuedUpdate = QueuedUpdate { qUpdatePoint :: Point-                                 , qInsert      :: R.YiString-                                 , qDelete      :: Int-                                 } deriving (Eq, Ord, Show)--runQ :: [QueuedUpdate] -> BufferM ()-runQ = trace . ("runQ: " <>) . showT <*> mapM_ run1Q . sortBy (flip compare)-    where-       run1Q :: QueuedUpdate -> BufferM ()-       run1Q (QueuedUpdate { qUpdatePoint = p, qInsert = i, qDelete = d })-              = do deleteNAt Forward d p-                   unless (R.null i) $ insertNAt i p--openParen, closeParen :: Token-openParen = Special '('-closeParen = Special ')'--isNormalParen :: Tree TT -> Bool-isNormalParen (Paren t1 xs t2) =-  tokT t1 == openParen && tokT t2 == closeParen && not (any isTuple xs)-isNormalParen _               = False--isTuple ::Tree TT -> Bool-isTuple (Atom t) = tokT t == Special ','-isTuple _ = False---- Assumes length of token is one character-queueDelete :: TT -> QueuedUpdate-queueDelete = queueReplaceWith ""---- Assumes length of token is one character-queueReplaceWith :: R.YiString -> TT -> QueuedUpdate-queueReplaceWith s t = QueuedUpdate { qUpdatePoint = posnOfs $ tokPosn t-                                    , qInsert = s-                                    , qDelete = 1-                                    }---- Only strips comments from the top level-stripComments :: Expr TT -> Expr TT-stripComments = filter $ \t -> case t of { (Atom x) -> not (isComment $ tokT x); _ -> True }--dollarifyTop :: Tree TT -> [QueuedUpdate]-dollarifyTop p@(Paren t1 e t2)-   | isNormalParen p = case stripComments e of-       [Paren{}] -> [queueDelete t2, queueDelete t1]-       e'        -> dollarifyExpr e'-dollarifyTop (Block blk) = dollarifyExpr . stripComments =<< [x | Expr x <- blk]-dollarifyTop _ = []---- Expression must not contain comments-dollarifyExpr :: Expr TT -> [QueuedUpdate]-dollarifyExpr e@(_:_)-    | p@(Paren t e2 t2) <- last e-    , isNormalParen p-    , all isSimple e-    = let dollarifyLoop :: Expr TT -> [QueuedUpdate]-          dollarifyLoop [] = []-          dollarifyLoop e3@[Paren{}] = dollarifyExpr e3-          dollarifyLoop e3 = if isCollapsible e3 then [queueDelete t2, queueReplaceWith "$ " t] else []-          in dollarifyLoop $ stripComments e2-dollarifyExpr _ = []--isSimple :: Tree TT -> Bool-isSimple (Paren{}) = True-isSimple (Block{}) = False-isSimple (Atom t)  = tokT t `elem` [Number, CharTok, StringTok, VarIdent, ConsIdent]-isSimple _         = False---- Expression must not contain comments-isCollapsible :: Expr TT -> Bool-isCollapsible = ((&&) `on` isSimple) . head <*> last--selectedTree :: Expr TT -> Region -> Maybe (Tree TT)-selectedTree e r = findLargestWithin r <$> getLastPath e (regionLast r)---- List must be non-empty-findLargestWithin :: Region -> [Tree TT] -> Tree TT-findLargestWithin r = fromMaybe . head <*> safeLast . takeWhile (within r)--within :: Region -> Tree TT -> Bool-within r t = includedRegion ((mkRegion . getFirstOffset <*> getLastOffset) t) r--safeLast :: [a] -> Maybe a-safeLast [] = Nothing-safeLast s  = return $ last s---- Here follows code for the precise haskell mode--dollarifyP :: H.Tree TT -> BufferM ()-dollarifyP e = maybe (return ()) dollarifyWithinP . selectedTreeP [e] =<< getSelectRegionB--dollarifyWithinP :: H.Exp TT -> BufferM ()-dollarifyWithinP = trace . ("dollarifyWithin: " <>) . showT <*> runQ . (dollarifyTopP =<<) . getAllSubTrees--isNormalParenP :: H.Exp TT -> Bool-isNormalParenP (H.Paren (H.PAtom r _) xs (H.PAtom r' _)) =-  tokT r == openParen && tokT r' == closeParen && not (any isTupleP xs)-isNormalParenP _               = False--isTupleP :: H.Exp TT -> Bool-isTupleP (H.PAtom t _) = tokT t == Special ','-isTupleP _ = False---- Only strips comments from the top level-stripCommentsP :: [H.Exp TT] -> [H.Exp TT]-stripCommentsP = filter $ \t -> case t of { (H.PAtom x _) -> not (isComment $ tokT x); _ -> True }--dollarifyTopP :: H.Exp TT -> [QueuedUpdate]-dollarifyTopP p@(H.Paren (H.PAtom t1 _) e (H.PAtom t2 _))-   | isNormalParenP p = case stripCommentsP e of-       [H.Paren{}] -> [queueDelete t2, queueDelete t1]-       e'          -> dollarifyExprP e'-dollarifyTopP (H.Block bList) = dollarifyExprP . stripCommentsP $ bList-dollarifyTopP _ = []---- Expression must not contain comments-dollarifyExprP :: [H.Exp TT] -> [QueuedUpdate]-dollarifyExprP e@(_:_)-    | p@(H.Paren (H.PAtom t _) e2 (H.PAtom t2 _)) <- last e-    , isNormalParenP p-    , all isSimpleP e-    = let dollarifyLoop :: [H.Exp TT] -> [QueuedUpdate]-          dollarifyLoop [] = []-          dollarifyLoop e3@[H.Paren{}] = dollarifyExprP e3-          dollarifyLoop e3 = if isCollapsibleP e3 then [queueDelete t2, queueReplaceWith "$ " t] else []-          in dollarifyLoop $ stripCommentsP e2-dollarifyExprP _ = []--isSimpleP :: H.Exp TT -> Bool-isSimpleP (H.Paren{})   = True-isSimpleP (H.Block{})   = False-isSimpleP (H.PAtom t _) = tokT t `elem` [Number, CharTok, StringTok, VarIdent, ConsIdent]-isSimpleP _             = False---- Expression must not contain comments-isCollapsibleP :: [H.Exp TT] -> Bool-isCollapsibleP = ((&&) `on` isSimpleP) . head <*> last--selectedTreeP :: [H.Exp TT] -> Region -> Maybe (H.Exp TT)-selectedTreeP e r = findLargestWithinP r <$> getLastPath e (regionLast r)---- List must be non-empty-findLargestWithinP :: Region -> [H.Exp TT] -> H.Exp TT-findLargestWithinP r = fromMaybe . head <*> safeLast . takeWhile (withinP r)--withinP :: Region -> H.Exp TT -> Bool-withinP r t = includedRegion ((mkRegion . getFirstOffset <*> getLastOffset) t) r--safeLastP :: [a] -> Maybe a-safeLastP [] = Nothing-safeLastP s  = return $ last s
− src/library/Yi/Mode/IReader.hs 
@@ -1,44 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.IReader--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ A simple text mode; it does very little besides define a comment--- syntax. We have it as a separate mode so users can bind the--- commands to this mode specifically.--module Yi.Mode.IReader where--import Data.Text ()-import Control.Lens-import Data.Char (intToDigit)-import Yi.Buffer.Misc-import Yi.Editor-import Yi.IReader-import Yi.Keymap-import Yi.Keymap.Keys-import Yi.Modes (anyExtension, fundamentalMode)--abstract :: Mode syntax-abstract = fundamentalMode { modeApplies = anyExtension ["irtxt"]-                           , modeKeymap = topKeymapA %~ ikeys }-  where-    ikeys = important $ choice m-    m = [ metaCh '`' ?>>! saveAsNewArticle-        , metaCh '0' ?>>! deleteAndNextArticle-        ]-        ++ map (\x -> metaCh (intToDigit x) ?>>! saveAndNextArticle x) [1..9]--ireaderMode :: Mode syntax-ireaderMode = abstract { modeName = "interactive reading of text" }--ireadMode ::  YiM ()-ireadMode = do-  withCurrentBuffer $ setAnyMode $ AnyMode ireaderMode-  nextArticle-  printMsg "M-` new; M-0 delete; M-[1-9]: save w/higher priority"
− src/library/Yi/Mode/Interactive.hs 
@@ -1,136 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.Interactive--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Collection of 'Mode's for working with Haskell.--module Yi.Mode.Interactive where--import           Control.Applicative-import           Control.Concurrent (threadDelay)-import           Control.Lens-import           Data.Monoid-import qualified Data.Text as T-import           Yi.Buffer-import           Yi.Core (sendToProcess, startSubprocess, withSyntax)-import           Yi.Editor-import           Yi.History-import           Yi.Keymap-import           Yi.Keymap.Keys-import           Yi.Lexer.Alex (Tok)-import           Yi.Lexer.Compilation (Token)-import qualified Yi.Mode.Compilation as Compilation-import           Yi.Modes-import           Yi.Monad-import qualified Yi.Rope as R-import qualified Yi.Syntax.OnlineTree as OnlineTree-import           Yi.Utils---mode :: Mode (OnlineTree.Tree (Tok Token))-mode = Compilation.mode-  { modeApplies = modeNeverApplies,-    modeName = "interactive",-    modeKeymap = topKeymapA %~ (<||)-     (choice-      [spec KHome ?>>! moveToSol,-       spec KEnter ?>>! do-          eof <- withCurrentBuffer atLastLine-          if eof-            then feedCommand-            else withSyntax modeFollow,-       meta (char 'p') ?>>! interactHistoryMove 1,-       meta (char 'n') ?>>! interactHistoryMove (-1)-      ])-  }--interactId :: T.Text-interactId = "Interact"---- | TODO: we're just converting back and forth here, 'historyMoveGen'--- and friends need to migrate to YiString it seems.-interactHistoryMove :: Int -> EditorM ()-interactHistoryMove delta =-  historyMoveGen interactId delta (R.toText <$> withCurrentBuffer getInput) >>= inp-  where-    inp = withCurrentBuffer . setInput . R.fromText--interactHistoryFinish :: EditorM ()-interactHistoryFinish =-  historyFinishGen interactId (R.toText <$> withCurrentBuffer getInput)--interactHistoryStart :: EditorM ()-interactHistoryStart = historyStartGen interactId--getInputRegion :: BufferM Region-getInputRegion = do mo <- getMarkB (Just "StdOUT")-                    p <- pointAt botB-                    q <- use $ markPointA mo-                    return $ mkRegion p q--getInput :: BufferM R.YiString-getInput = readRegionB =<< getInputRegion--setInput :: R.YiString -> BufferM ()-setInput val = flip replaceRegionB val =<< getInputRegion---- | Open a new buffer for interaction with a process.-spawnProcess :: String -> [String] -> YiM BufferRef-spawnProcess = spawnProcessMode mode---- | open a new buffer for interaction with a process, using any--- interactive-derived mode-spawnProcessMode :: Mode syntax -> FilePath -> [String] -> YiM BufferRef-spawnProcessMode interMode cmd args = do-    b <- startSubprocess cmd args (const $ return ())-    withEditor interactHistoryStart-    mode' <- lookupMode $ AnyMode interMode-    withCurrentBuffer $ do-        m1 <- getMarkB (Just "StdERR")-        m2 <- getMarkB (Just "StdOUT")-        modifyMarkB m1 (\v -> v {markGravity = Backward})-        modifyMarkB m2 (\v -> v {markGravity = Backward})-        setAnyMode mode'-    return b------ | Send the type command to the process-feedCommand :: YiM ()-feedCommand = do-  b <- gets currentBuffer-  withEditor interactHistoryFinish-  cmd <- withCurrentBuffer $ do-      botB-      newlineB-      me <- getMarkB (Just "StdERR")-      mo <- getMarkB (Just "StdOUT")-      p <- pointB-      q <- use $ markPointA mo-      cmd <- readRegionB $ mkRegion p q-      markPointA me .= p-      markPointA mo .= p-      return $ R.toString cmd-  withEditor interactHistoryStart-  sendToProcess b cmd---- | Send command, recieve reply-queryReply :: BufferRef -> String -> YiM R.YiString-queryReply buf cmd = do-    start <- withGivenBuffer buf (botB >> pointB)-    sendToProcess buf (cmd <> "\n")-    io $ threadDelay 50000  -- Hack to let ghci finish writing its output.-    withGivenBuffer buf $ do-      botB-      moveToSol-      leftB -- There is probably a much better way to do this moving around, but it works-      end <- pointB-      result <- readRegionB (mkRegion start end)-      botB-      return result
− src/library/Yi/Mode/JavaScript.hs 
@@ -1,147 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.JavaScript--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Module defining the 'Mode' for JavaScript. 'javaScriptMode' uses--- the parser defined at "Yi.Syntax.JavaScript".--module Yi.Mode.JavaScript (javaScriptMode, hooks) where--import           Control.Applicative-import           Control.Lens-import           Control.Monad.Writer.Lazy (execWriter)-import           Data.Binary-import           Data.DList as D (toList)-import           Data.Default-import           Data.Foldable as F (toList)-import           Data.List (nub)-import           Data.Maybe (isJust)-import           Data.Monoid-import qualified Data.Text as T-import           Data.Typeable-import           System.FilePath.Posix (takeBaseName)-import           Yi.Buffer-import           Yi.Core (withSyntax)-import           Yi.Types (YiVariable)-import           Yi.Editor (withEditor, withOtherWindow, getEditorDyn,-                            stringToNewBuffer , findBuffer, switchToBufferE,-                            withCurrentBuffer, withGivenBuffer)-import           Yi.Event (Key(..), Event(..))-import           Yi.File (fwriteE)-import           Yi.IncrementalParse (scanner)-import           Yi.Interact (choice)-import           Yi.Keymap (YiM, Action(..), topKeymapA)-import           Yi.Keymap.Keys (ctrlCh, (?>>), (?>>!), important)-import           Yi.Lexer.Alex (AlexState, Tok, lexScanner,-                                commonLexer, CharScanner)-import           Yi.Lexer.JavaScript (alexScanToken, TT, initState,-                                      HlState, Token)-import           Yi.Modes (anyExtension)-import           Yi.Monad-import qualified Yi.Rope as R-import           Yi.String-import           Yi.Syntax (ExtHL(..), mkHighlighter, Scanner)-import           Yi.Syntax.JavaScript (Tree, parse, getStrokes)-import           Yi.Syntax.Tree (getLastPath)-import           Yi.Verifier.JavaScript (verify)--javaScriptAbstract :: Mode syntax-javaScriptAbstract = emptyMode-  { modeApplies = anyExtension ["js"]-  , modeName = "javascript"-  , modeToggleCommentSelection = Just (toggleCommentB "//")-  }--javaScriptMode :: Mode (Tree TT)-javaScriptMode = javaScriptAbstract-  { modeIndent = jsSimpleIndent-  , modeHL = ExtHL $ mkHighlighter (scanner parse . jsLexer)-  , modeGetStrokes = getStrokes-  }--jsSimpleIndent :: Tree TT -> IndentBehaviour -> BufferM ()-jsSimpleIndent t behave = do-  indLevel <- shiftWidth <$> indentSettingsB-  prevInd  <- getNextNonBlankLineB Backward >>= indentOfB-  solPnt   <- pointAt moveToSol-  let path = getLastPath (F.toList t) solPnt-  case path of-    Nothing -> indentTo [indLevel, 0]-    Just _  -> indentTo [prevInd,-                         prevInd + indLevel,-                         prevInd - indLevel]-  where-    -- Given a list of possible columns to indent to, removes any-    -- duplicates from it and cycles between the resulting-    -- indentations.-    indentTo :: [Int] -> BufferM ()-    indentTo = cycleIndentsB behave . nub--jsLexer :: CharScanner -> Scanner (AlexState HlState) (Tok Token)-jsLexer = lexScanner (commonLexer alexScanToken initState)-------------------------------------------------------------------------------------- tta :: Yi.Lexer.Alex.Tok Token -> Maybe (Yi.Syntax.Span String)--- tta = sequenceA . tokToSpan . (fmap Main.tokenToText)---- | Hooks for the JavaScript mode.-hooks :: Mode (Tree TT) -> Mode (Tree TT)-hooks mode = mode-  { modeKeymap = topKeymapA %~ important (choice m)-  , modeFollow = YiA . jsCompile-  }-  where-    m = [ ctrlCh 'c' ?>> ctrlCh 'l' ?>>! withSyntax modeFollow-        , Event KEnter []           ?>>! newlineAndIndentB-        ]--newtype JSBuffer = JSBuffer (Maybe BufferRef)-    deriving (Default, Typeable, Binary)--instance YiVariable JSBuffer---- | The "compiler."-jsCompile :: Tree TT -> YiM ()-jsCompile tree = do-  fwriteE-  Just filename <- withCurrentBuffer $ gets file-  buf <- getJSBuffer-  withOtherWindow $ withEditor $ switchToBufferE buf-  jsErrors filename buf (D.toList $ execWriter $ verify tree)---- | Returns the JS verifier buffer, creating it if necessary.-getJSBuffer :: YiM BufferRef-getJSBuffer = withOtherWindow $ do-  JSBuffer mb <- withEditor getEditorDyn-  case mb of-    Nothing -> mkJSBuffer-    Just b  -> do stillExists <- isJust <$> findBuffer b-                  if stillExists-                    then return b-                    else mkJSBuffer---- | Creates a new empty buffer and returns it.-mkJSBuffer :: YiM BufferRef-mkJSBuffer = stringToNewBuffer (MemBuffer "js") mempty---- | Given a filename, a BufferRef and a list of errors, prints the--- errors in that buffer.-jsErrors :: Show a => String -> BufferRef -> [a] -> YiM ()-jsErrors fname buf errs =-  let problems = T.unlines $ map item errs-      item x = "* " <> showT x-      str = if null errs-            then "No problems found!"-            else "Problems in "-                 <> R.fromString (takeBaseName fname)-                 <> ":\n" <> R.fromText problems-  in withGivenBuffer buf (replaceBufferContent str)
− src/library/Yi/Mode/Latex.hs 
@@ -1,64 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Mode.Latex--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Collection of 'Mode's for working with LaTeX.--module Yi.Mode.Latex (latexMode3, latexMode2, fastMode) where--import           Data.Text ()-import           Yi.Buffer-import qualified Yi.IncrementalParse as IncrParser-import           Yi.Lexer.Alex (lexScanner, commonLexer, CharScanner,-                                Tok, AlexState)-import qualified Yi.Lexer.Latex as Latex-import           Yi.Modes (anyExtension, fundamentalMode)-import           Yi.Syntax-import qualified Yi.Syntax.Driver as Driver-import qualified Yi.Syntax.Latex as Latex-import           Yi.Syntax.OnlineTree (manyToks, Tree)-import           Yi.Syntax.Tree--abstract :: Mode syntax-abstract = fundamentalMode- {-   modeApplies = anyExtension ["tex", "sty", "ltx"],-   modeToggleCommentSelection = Just (toggleCommentB "%")- }--fastMode :: Mode (Tree Latex.TT)-fastMode = abstract-  {-    modeName = "fast latex",-    modeHL = ExtHL $ mkHighlighter (IncrParser.scanner manyToks . latexLexer),-    modeGetStrokes = tokenBasedStrokes Latex.tokenToStroke-  }---- | syntax-based latex mode-latexMode2 :: Mode (Latex.Tree Latex.TT)-latexMode2 = abstract-  {-    modeName = "latex",-    modeHL = ExtHL $-       mkHighlighter (IncrParser.scanner Latex.parse . latexLexer),-    modeGetStrokes = \t point begin end -> Latex.getStrokes point begin end t-  }---- | syntax-based latex mode-latexMode3 :: Mode (Latex.Tree Latex.TT)-latexMode3 = abstract-  {-    modeName = "latex",-    modeHL = ExtHL $-       Driver.mkHighlighter (IncrParser.scanner Latex.parse . latexLexer),-    modeGetStrokes = \t point begin end -> Latex.getStrokes point begin end t-  }--latexLexer :: CharScanner -> Scanner (AlexState Latex.HlState) (Tok Latex.Token)-latexLexer = lexScanner (commonLexer Latex.alexScanToken Latex.initState)
− src/library/Yi/Modes.hs 
@@ -1,246 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Modes--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Definitions for the bulk of modes shipped with Yi.--module Yi.Modes (TokenBasedMode, fundamentalMode,-                 cMode, objectiveCMode, cppMode, cabalMode,-                 srmcMode, ocamlMode, ottMode, gnuMakeMode,-                 perlMode, pythonMode, javaMode, jsonMode, anyExtension,-                 extensionOrContentsMatch, linearSyntaxMode,-                 svnCommitMode, hookModes, applyModeHooks,-                 lookupMode, whitespaceMode,-                 gitCommitMode, rubyMode, styleMode-                ) where--import           Control.Applicative-import           Control.Lens-import           Data.List (isPrefixOf)-import           Data.Maybe-import           Data.Text ()-import           System.FilePath-import "regex-tdfa" Text.Regex.TDFA ((=~))-import           Yi.Buffer-import qualified Yi.IncrementalParse as IncrParser-import           Yi.Keymap-import           Yi.Lexer.Alex-import qualified Yi.Lexer.C          as C-import qualified Yi.Lexer.Cabal      as Cabal-import qualified Yi.Lexer.Cplusplus  as Cplusplus-import qualified Yi.Lexer.GNUMake    as GNUMake-import qualified Yi.Lexer.GitCommit  as GitCommit-import qualified Yi.Lexer.JSON       as JSON-import qualified Yi.Lexer.Java       as Java-import qualified Yi.Lexer.OCaml      as OCaml-import qualified Yi.Lexer.ObjectiveC as ObjectiveC-import qualified Yi.Lexer.Ott        as Ott-import qualified Yi.Lexer.Perl       as Perl-import qualified Yi.Lexer.Python     as Python-import qualified Yi.Lexer.Ruby       as Ruby-import qualified Yi.Lexer.SVNCommit  as SVNCommit-import qualified Yi.Lexer.Srmc       as Srmc-import qualified Yi.Lexer.Whitespace as Whitespace-import           Yi.MiniBuffer-import qualified Yi.Rope as R-import           Yi.Style-import           Yi.Syntax hiding (mkHighlighter)-import           Yi.Syntax.Driver (mkHighlighter)-import           Yi.Syntax.OnlineTree (manyToks, Tree)-import           Yi.Syntax.Tree--import Yi.Search (makeSimpleSearch)--type TokenBasedMode tok = Mode (Tree (Tok tok))-type StyleBasedMode = TokenBasedMode StyleName--fundamentalMode :: Mode syntax-fundamentalMode = emptyMode-  { modeName = "fundamental"-  , modeApplies = modeAlwaysApplies-  , modeIndent = const autoIndentB-  , modePrettify = const fillParagraph-  , modeGotoDeclaration = do-       currentPoint <- pointB-       currentWord <- readCurrentWordB-       gotoLn 0-       word <- return $ makeSimpleSearch currentWord-       searchResults <- regexB Forward word-       case searchResults of-           (declarationRegion : _) -> moveTo $ regionStart declarationRegion-           [] -> moveTo currentPoint-  }---- | Creates a 'TokenBasedMode' from a 'Lexer' and a function that--- turns tokens into 'StyleName'.-linearSyntaxMode' :: Show (l s)-                  => Lexer l s (Tok t) i-                  -> (t -> StyleName)-                  -> TokenBasedMode t-linearSyntaxMode' scanToken tts = fundamentalMode-  & modeHLA .~ ExtHL (mkHighlighter $ IncrParser.scanner manyToks . lexer)-  & modeGetStrokesA .~ tokenBasedStrokes tokenToStroke-  where-    tokenToStroke = fmap tts . tokToSpan-    lexer = lexScanner scanToken---- | Specialised version of 'linearSyntaxMode'' for the common case,--- wrapping up into a 'Lexer' with 'commonLexer'.-linearSyntaxMode :: Show s => s -- ^ Starting state-                 -> TokenLexer AlexState s (Tok t) AlexInput-                 -> (t -> StyleName)-                 -> TokenBasedMode t-linearSyntaxMode initSt scanToken =-  linearSyntaxMode' (commonLexer scanToken initSt)--styleMode :: Show (l s) => StyleLexer l s t i-          -> TokenBasedMode t-styleMode l = linearSyntaxMode' (l ^. styleLexer) (l ^. tokenToStyle)--cMode :: StyleBasedMode-cMode = styleMode C.lexer-  & modeNameA .~ "c"-  & modeAppliesA .~ anyExtension [ "c", "h" ]--objectiveCMode :: StyleBasedMode-objectiveCMode = styleMode ObjectiveC.lexer-  & modeNameA .~ "objective-c"-  & modeAppliesA .~ anyExtension [ "m", "mm" ]--cppMode :: StyleBasedMode-cppMode = styleMode Cplusplus.lexer-  & modeAppliesA .~ anyExtension [ "cxx", "cpp", "hxx" ]-  & modeNameA .~ "c++"--cabalMode :: StyleBasedMode-cabalMode = styleMode Cabal.lexer-  & modeNameA .~ "cabal"-  & modeAppliesA .~ anyExtension [ "cabal" ]-  & modeToggleCommentSelectionA .~ Just (toggleCommentB "--")---srmcMode :: StyleBasedMode-srmcMode = styleMode Srmc.lexer-  & modeNameA .~ "srmc"-  & modeAppliesA .~ anyExtension [ "pepa", "srmc" ] -- pepa is a subset of srmc--gitCommitMode :: TokenBasedMode GitCommit.Token-gitCommitMode = styleMode GitCommit.lexer-  & modeNameA .~ "git-commit"-  & modeAppliesA .~ isCommit-  where-    isCommit p _ = case (takeFileName p, takeFileName $ takeDirectory p) of-      ("COMMIT_EDITMSG", ".git") -> True-      _ -> False--svnCommitMode :: StyleBasedMode-svnCommitMode = styleMode SVNCommit.lexer-  & modeNameA .~ "svn-commit"-  & modeAppliesA .~ isCommit-  where-    isCommit p _ = "svn-commit" `isPrefixOf` p && extensionMatches ["tmp"] p--ocamlMode :: TokenBasedMode OCaml.Token-ocamlMode = styleMode OCaml.lexer-  & modeNameA .~ "ocaml"-  & modeAppliesA .~ anyExtension [ "ml", "mli", "mly" , "mll", "ml4", "mlp4" ]--perlMode :: StyleBasedMode-perlMode = styleMode Perl.lexer-  & modeNameA .~ "perl"-  & modeAppliesA .~ anyExtension [ "t", "pl", "pm" ]--rubyMode :: StyleBasedMode-rubyMode = styleMode Ruby.lexer-  & modeNameA .~ "ruby"-  & modeAppliesA .~ anyExtension [ "rb", "ru" ]--pythonMode :: StyleBasedMode-pythonMode = base-  & modeNameA .~ "python"-  & modeAppliesA .~ anyExtension [ "py" ]-  & modeToggleCommentSelectionA .~ Just (toggleCommentB "#")-  & modeIndentSettingsA %~ (\x -> x { expandTabs = True, tabSize = 4 })-  where-    base = styleMode Python.lexer--javaMode :: StyleBasedMode-javaMode = styleMode Java.lexer-  & modeNameA .~ "java"-  & modeAppliesA .~ anyExtension [ "java" ]--jsonMode :: StyleBasedMode-jsonMode = styleMode JSON.lexer-  & modeNameA .~ "json"-  & modeAppliesA .~ anyExtension [ "json" ]--gnuMakeMode :: StyleBasedMode-gnuMakeMode = styleMode GNUMake.lexer-  & modeNameA .~ "Makefile"-  & modeAppliesA .~ isMakefile-  & modeIndentSettingsA %~ (\x -> x { expandTabs = False, shiftWidth = 8 })-  where-    isMakefile :: FilePath -> a -> Bool-    isMakefile path _contents = matches $ takeFileName path-        where matches "Makefile"    = True-              matches "makefile"    = True-              matches "GNUmakefile" = True-              matches filename      = extensionMatches [ "mk" ] filename--ottMode :: StyleBasedMode-ottMode = styleMode Ott.lexer-  & modeNameA .~ "ott"-  & modeAppliesA .~ anyExtension [ "ott" ]--whitespaceMode :: StyleBasedMode-whitespaceMode = styleMode Whitespace.lexer-  & modeNameA .~ "whitespace"-  & modeAppliesA .~ anyExtension [ "ws" ]-  & modeIndentA .~ (\_ _ -> insertB '\t')---- | Determines if the file's extension is one of the extensions in the list.-extensionMatches :: [String]-                 -> FilePath-                 -> Bool-extensionMatches extensions fileName = extension `elem` extensions'-    where extension = takeExtension fileName-          extensions' = ['.' : ext | ext <- extensions]---- | When applied to an extensions list, creates a 'Mode.modeApplies' function.-anyExtension :: [String] -- ^ List of extensions-             -> FilePath -- ^ Path to compare against-             -> a        -- ^ File contents. Currently unused but see-                         -- 'extensionOrContentsMatch'.-             -> Bool-anyExtension extensions fileName _contents-    = extensionMatches extensions fileName---- | When applied to an extensions list and regular expression pattern, creates--- a 'Mode.modeApplies' function.-extensionOrContentsMatch :: [String] -> String -> FilePath -> R.YiString -> Bool-extensionOrContentsMatch extensions pattern fileName contents-    = extensionMatches extensions fileName || contentsMatch-    where contentsMatch = R.toString contents =~ pattern :: Bool---- | Adds a hook to all matching hooks in a list-hookModes :: (AnyMode -> Bool) -> BufferM () -> [AnyMode] -> [AnyMode]-hookModes p h = map $ \am@(AnyMode m) ->-  if p am then AnyMode (m & modeOnLoadA %~ (>> h)) else am---- | Apply a list of mode hooks to a list of AnyModes-applyModeHooks :: [(AnyMode -> Bool, BufferM ())] -> [AnyMode] -> [AnyMode]-applyModeHooks hs ms = flip map ms $ \am -> case filter (($ am) . fst) hs of-    [] -> am-    ls -> onMode (modeOnLoadA %~ \x -> foldr ((>>) . snd) x ls) am---- | Check whether a mode of the same name is already in modeTable and--- returns the original mode, if it isn't the case.-lookupMode :: AnyMode -> YiM AnyMode-lookupMode am@(AnyMode m) = fromMaybe am <$> anyModeByNameM (modeName m)
− src/library/Yi/Monad.hs 
@@ -1,41 +0,0 @@-module Yi.Monad (-                 gets,-                 getsAndModify,-                 maybeM,-                 repeatUntilM,-                 whenM,-                 with,-                ) where--import Control.Monad.Reader-import Control.Monad.State-import Control.Monad.Base---- | Combination of the Control.Monad.State 'modify' and 'gets'-getsAndModify :: MonadState s m => (s -> (s,a)) -> m a-getsAndModify f = do-  e <- get-  let (e',result) = f e-  put e'-  return result--with :: (MonadReader r m, MonadBase b m) => (r -> a) -> (a -> b c) -> m c-with f g = do-    yi <- ask-    liftBase $ g (f yi)--whenM :: Monad m => m Bool -> m () -> m ()-whenM mtest ma = mtest >>= flip when ma--maybeM :: Monad m => (x -> m ()) -> Maybe x -> m ()-maybeM _ Nothing = return ()-maybeM f (Just x) = f x---- | Rerun the monad until the boolean result is false, collecting list of results.-repeatUntilM :: Monad m => m (Bool,a) -> m [a]-repeatUntilM m = do-  (proceed,x) <- m-  if proceed -    then (do xs <- repeatUntilM m -             return (x:xs))-    else return [x]
− src/library/Yi/Paths.hs 
@@ -1,75 +0,0 @@-{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts #-}-module Yi.Paths ( getEvaluatorContextFilename-                , getConfigFilename-                , getConfigModules-                , getArticleDbFilename-                , getPersistentStateFilename-                , getConfigDir-                , getConfigPath-                , getCustomConfigPath-                , getDataPath-                ) where--import System.Directory(getAppUserDataDirectory, -- TODO: phase out in favour of xdg-dir-                        doesDirectoryExist,-                        createDirectoryIfMissing)-import System.FilePath((</>))-import Control.Monad (liftM)-import Control.Monad.Base-import qualified System.Environment.XDG.BaseDir as XDG--appUserDataCond ::(MonadBase IO m) => (String -> IO FilePath) -> m FilePath-appUserDataCond dirQuery = liftBase $-  do oldDir <- getAppUserDataDirectory "yi"-     newDir <- dirQuery "yi"-     oldDirExists <- doesDirectoryExist oldDir-     newDirExists <- doesDirectoryExist newDir-     if newDirExists -- overrides old-style-        then return newDir-        else if oldDirExists -- old-style exists, use it-               then return oldDir-               else do createDirectoryIfMissing True newDir -- none exists, use new style, but create it-                       return newDir--getConfigDir ::(MonadBase IO m) => m FilePath-getConfigDir = appUserDataCond XDG.getUserConfigDir--getDataDir ::(MonadBase IO m) => m FilePath-getDataDir = appUserDataCond XDG.getUserDataDir---- | Given a path relative to application data directory,---   this function finds a path to a given data file.-getDataPath :: (MonadBase IO m) => FilePath -> m FilePath-getDataPath fp = liftM (</> fp) getDataDir---- | Given a path relative to application configuration directory,---   this function finds a path to a given configuration file.-getConfigPath :: MonadBase IO m => FilePath -> m FilePath-getConfigPath = getCustomConfigPath getConfigDir---- | Given an action that retrieves config path, and a path relative to it,--- this function joins the two together to create a config file path.-getCustomConfigPath :: MonadBase IO m => m FilePath -> FilePath -> m FilePath-getCustomConfigPath cd fp = (</> fp) `liftM` cd---- Note: Dyre also uses XDG cache dir - that would be:---getCachePath = getPathHelper XDG.getUserCacheDirectory---- Below are all points that are used in Yi code (to keep it clean.)-getEvaluatorContextFilename, getConfigFilename, getConfigModules,-    getArticleDbFilename, getPersistentStateFilename :: (MonadBase IO m) => m FilePath---- | Get Yi master configuration script.-getConfigFilename = getConfigPath "yi.hs"--getConfigModules = getConfigPath "modules"---- | Get articles.db database of locations to visit (for Yi.IReader.)-getArticleDbFilename = getConfigPath "articles.db"---- | Get path to Yi history that stores state between runs.-getPersistentStateFilename = getDataPath "history"---- | Get path to environment file that defines namespace used by Yi---   command evaluator.-getEvaluatorContextFilename = getConfigPath $ "local" </> "Env.hs"
− src/library/Yi/PersistentState.hs 
@@ -1,121 +0,0 @@-{-# LANGUAGE-  TemplateHaskell,-  ScopedTypeVariables,-  NoMonomorphismRestriction,-  Haskell2010,-  GeneralizedNewtypeDeriving,-  DeriveDataTypeable,-  CPP,-  StandaloneDeriving,-  DeriveGeneric #-}---- | This module implements persistence across different Yi runs.---   It includes minibuffer command history, marks etc.---   Warning: Current version will _not_ check whether two or more instances---   of Yi are run at the same time.--module Yi.PersistentState(loadPersistentState,-                          savePersistentState,-                          maxHistoryEntries)-where--import Data.Typeable-import Data.Binary-#if __GLASGOW_HASKELL__ < 708-import Data.DeriveTH-#else-import GHC.Generics (Generic)-#endif-import Data.Default-import System.Directory(doesFileExist)-import qualified Data.Map as M--import Control.Exc(ignoringException)-import Control.Lens--import Yi.Config.Simple.Types(customVariable, Field)-import Yi.Editor-import Yi.History-import Yi.Keymap(YiM)-import Yi.KillRing(Killring(..))-import Yi.Paths(getPersistentStateFilename)-import Yi.Regex(SearchExp(..))-import Yi.Search.Internal (getRegexE, setRegexE)-import Yi.Utils-import Yi.Types (YiConfigVariable)--data PersistentState = PersistentState { histories     :: !Histories-                                       , aKillring     :: !Killring-                                       , aCurrentRegex :: Maybe SearchExp-                                       }--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''PersistentState)-#else-deriving instance Generic PersistentState-instance Binary PersistentState-#endif--newtype MaxHistoryEntries = MaxHistoryEntries { _unMaxHistoryEntries :: Int }-  deriving(Typeable, Binary)--instance Default MaxHistoryEntries where-  def = MaxHistoryEntries 1000--instance YiConfigVariable MaxHistoryEntries--makeLenses ''MaxHistoryEntries--maxHistoryEntries :: Field Int-maxHistoryEntries = customVariable . unMaxHistoryEntries---- | Trims per-command histories to contain at most N completions each.-trimHistories :: Int -> Histories -> Histories-trimHistories maxHistory (Histories m) = Histories $ M.map trimH m-  where-    trimH (History cur content prefix) = History cur (trim content) prefix-    trim content = drop (max 0 (length content - maxHistory)) content---- | Here is a persistent history saving part.---   We assume each command is a single line.---   To add new components, one has to:------   * add new field in @PersistentState@ structure,---   * add write and read parts in @loadPersistentState@/@savePersistentState@,---   * add a trimming code in @savePersistentState@ to prevent blowing up---     of save file.-savePersistentState :: YiM ()-savePersistentState = do-    MaxHistoryEntries histLimit <- withEditor askConfigVariableA-    pStateFilename      <- getPersistentStateFilename-    (hist :: Histories) <- withEditor $ getEditorDyn-    kr                  <- withEditor $ use killringA-    curRe               <- withEditor   getRegexE-    let pState = PersistentState {-                   histories     = trimHistories histLimit hist-                 , aKillring     = kr    -- trimmed during normal operation-                 , aCurrentRegex = curRe -- just a single value -> no need to trim-                 }-    io $ encodeFile pStateFilename pState---- | Reads and decodes a persistent state in both strict, and exception robust---   way.-readPersistentState :: YiM (Maybe PersistentState)-readPersistentState = do pStateFilename <- getPersistentStateFilename-                         pStateExists <- io $ doesFileExist pStateFilename-                         if not pStateExists-                           then return Nothing-                           else io $ ignoringException $ strictDecoder pStateFilename-  where-    strictDecoder filename = do (state :: PersistentState) <- decodeFile filename-                                state `seq` return (Just state)---- | Loads a persistent state, and sets Yi state variables accordingly.-loadPersistentState :: YiM ()-loadPersistentState = do-    maybePState <- readPersistentState-    case maybePState of-      Nothing     -> return ()-      Just pState -> do withEditor $ putEditorDyn                $ histories     pState-                        withEditor $ assign killringA            $ aKillring     pState-                        withEditor $ maybe (return ()) setRegexE $ aCurrentRegex pState
− src/library/Yi/Process.hs 
@@ -1,105 +0,0 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}-module Yi.Process (runProgCommand, runShellCommand, shellFileName,-                   createSubprocess, readAvailable, SubprocessInfo(..), SubprocessId) where--import System.Exit (ExitCode(ExitFailure))-import System.Directory (findExecutable)-import System.IO-import System.Process-import System.Environment ( getEnv )--import Foreign.Marshal.Alloc(allocaBytes)-import Foreign.C.String--import Control.Exc(orException)-import Yi.Buffer.Basic (BufferRef)-import Yi.Monad--#ifndef mingw32_HOST_OS-import System.Posix.IO-#endif--runProgCommand :: String -> [String] -> IO (ExitCode,String,String)-runProgCommand prog args = do loc <- findExecutable prog-                              case loc of-                                  Nothing -> return (ExitFailure 1,"","")-                                  Just fp -> readProcessWithExitCode fp args ""----------------------------------------------------------------------------- | Run a command using the system shell, returning stdout, stderr and exit code--shellFileName :: IO String-shellFileName = orException (getEnv "SHELL") (return "/bin/sh")--shellCommandSwitch :: String-shellCommandSwitch = "-c"--runShellCommand :: String -> IO (ExitCode,String,String)-runShellCommand cmd = do-      sh <- shellFileName-      readProcessWithExitCode sh [shellCommandSwitch, cmd] ""-------------------------------------------------------------------------------------- Subprocess support (ie. async processes whose output goes to a buffer)--type SubprocessId = Integer--data SubprocessInfo = SubprocessInfo {-      procCmd :: FilePath,-      procArgs :: [String],-      procHandle :: ProcessHandle,-      hIn  :: Handle,-      hOut :: Handle,-      hErr :: Handle,-      bufRef :: BufferRef,-      separateStdErr :: Bool-      }--{--Simon Marlow said this:-- It turns out to be dead easy to bind stderr and stdout to the same pipe. After a couple of minor tweaks the following now works:-- createProcess (proc cmd args){ std_out = CreatePipe,-                                std_err = UseHandle stdout }--Therefore it should be possible to simplifiy the following greatly with the new process package.---}-createSubprocess :: FilePath -> [String] -> BufferRef -> IO SubprocessInfo-createSubprocess cmd args bufref = do--#ifdef mingw32_HOST_OS-    (inp,out,err,handle) <- runInteractiveProcess cmd args Nothing Nothing-    let separate = True-#else-    (inpReadFd,inpWriteFd) <- createPipe-    (outReadFd,outWriteFd) <- createPipe-    [inpRead,inpWrite,outRead,outWrite] <- mapM fdToHandle [inpReadFd,inpWriteFd,outReadFd,outWriteFd]--    handle <- runProcess cmd args Nothing Nothing (Just inpRead) (Just outWrite) (Just outWrite)-    let inp = inpWrite-        out = outRead-        err = outRead-        separate = False-#endif-    hSetBuffering inp NoBuffering-    hSetBuffering out NoBuffering-    hSetBuffering err NoBuffering-    return SubprocessInfo { procCmd=cmd, procArgs=args, procHandle=handle, hIn=inp, hOut=out, hErr=err, bufRef=bufref, separateStdErr=separate }----- Read as much as possible from handle without blocking-readAvailable :: Handle -> IO String-readAvailable handle = fmap concat $ repeatUntilM $ read_chunk handle---- Read a chunk from a handle, bool indicates if there is potentially more data available-read_chunk :: Handle -> IO (Bool,String)-read_chunk handle = do-    let bufferSize = 1024-    allocaBytes bufferSize $ \buffer -> do-                 bytesRead <- hGetBufNonBlocking handle buffer bufferSize-                 s <- peekCStringLen (buffer,bytesRead)-                 let mightHaveMore = bytesRead == bufferSize-                 return (mightHaveMore, s)
− src/library/Yi/Rectangle.hs 
@@ -1,108 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Rectangle--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ emacs-style rectangle manipulation functions.--module Yi.Rectangle where--import           Control.Applicative-import           Control.Monad-import           Data.List (sort, transpose)-import           Data.Monoid-import qualified Data.Text as T-import "regex-tdfa" Text.Regex.TDFA-import           Yi.Buffer-import           Yi.Editor-import qualified Yi.Rope as R-import           Yi.String--alignRegion :: T.Text -> BufferM ()-alignRegion str = do-  s <- getSelectRegionB >>= unitWiseRegion Line-  modifyRegionB (R.fromText . alignText str . R.toText) s-  where-    regexSplit :: String -> String -> [T.Text]-    regexSplit regex l = case l =~ regex of-        AllTextSubmatches (_:matches) -> T.pack <$> matches-        _ -> error "regexSplit: text does not match"--    alignText :: T.Text -> T.Text -> T.Text-    alignText regex text = unlines' ls'-      where ls, ls' :: [T.Text]-            ls = lines' text-            columns :: [[T.Text]]-            columns = regexSplit (T.unpack regex) <$> (T.unpack <$> ls)--            columnsWidth :: [Int]-            columnsWidth = fmap (maximum . fmap T.length) $ transpose columns--            columns' :: [[T.Text]]-            columns' = fmap (zipWith (`T.justifyLeft` ' ') columnsWidth) columns--            ls' = T.concat <$> columns'---- | Align each line of the region on the given regex.--- Fails if it is not found in any line.-alignRegionOn :: T.Text -> BufferM ()-alignRegionOn s = alignRegion $ "^(.*)(" <> s <> ")(.*)"---- | Get the selected region as a rectangle.--- Returns the region extended to lines, plus the start and end columns of the rectangle.-getRectangle :: BufferM (Region, Int, Int)-getRectangle = do-    r <- getSelectRegionB-    extR <- unitWiseRegion Line r-    [lowCol,highCol] <- sort <$> mapM colOf [regionStart r, regionEnd r]-    return (extR, lowCol, highCol)---- | Split text at the boundaries given-multiSplit :: [Int] -> R.YiString -> [R.YiString]-multiSplit [] l = [l]-multiSplit (x:xs) l = left : multiSplit (fmap (subtract x) xs) right-    where (left, right) = R.splitAt x l--onRectangle :: (Int -> Int -> R.YiString -> R.YiString) -> BufferM ()-onRectangle f = do-  (reg, l, r) <- getRectangle-  modifyRegionB (mapLines (f l r)) reg--openRectangle :: BufferM ()-openRectangle = onRectangle openLine-  where-    openLine l r line =-      left <> R.replicateChar (r - l) ' ' <> right-          where (left, right) = R.splitAt l line--stringRectangle :: R.YiString -> BufferM ()-stringRectangle inserted = onRectangle stringLine-  where stringLine l r line = left <> inserted <> right-          where [left,_,right] = multiSplit [l,r] line--killRectangle :: EditorM ()-killRectangle = do-  cutted <- withCurrentBuffer $ do-      (reg, l, r) <- getRectangle-      text <- readRegionB reg-      let (cutted, rest) = unzip $ fmap cut $ R.lines' text--          cut :: R.YiString -> (R.YiString, R.YiString)-          cut line = let [left,mid,right] = multiSplit [l,r] line-                     in (mid, left <> right)-      replaceRegionB reg (R.unlines rest)-      return cutted-  setRegE (R.unlines cutted)--yankRectangle :: EditorM ()-yankRectangle = do-  text <- R.lines' <$> getRegE-  withCurrentBuffer $ forM_ text $ \t -> do-    savingPointB $ insertN t-    lineDown
− src/library/Yi/Search.hs 
@@ -1,441 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Search--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Search/Replace functions--module Yi.Search (-        setRegexE,      -- :: SearchExp -> EditorM ()-        resetRegexE,    -- :: EditorM ()-        getRegexE,      -- :: EditorM (Maybe SearchExp)-        SearchMatch,-        SearchResult(..),-        SearchOption(..),-        doSearch,            -- :: (Maybe String) -> [SearchOption]-                            -- -> Direction -> YiM ()-        searchInit,        -- :: String-                            -- -> [SearchOption]-                            -- -> IO SearchExp-        continueSearch,          -- :: SearchExp-                            -- -> IO SearchResult-        makeSimpleSearch,--        -- * Batch search-replace-        searchReplaceRegionB,-        searchReplaceSelectionB,-        replaceString,-        searchAndRepRegion,-        searchAndRepRegion0,-        searchAndRepUnit, -- :: String -> String -> Bool -> TextUnit -> EditorM Bool--        -- * Incremental Search-        isearchInitE,-        isearchIsEmpty,-        isearchAddE,-        isearchPrevE,-        isearchNextE,-        isearchWordE,-        isearchHistory,-        isearchDelE,-        isearchCancelE,-        isearchFinishE,-        isearchCancelWithE,-        isearchFinishWithE,--        -- * Replace-        qrNext,-        qrReplaceAll,-        qrReplaceOne,-        qrFinish-                 ) where--import           Control.Applicative-import           Control.Lens hiding (re, from, to, act)-import           Control.Monad-import           Data.Binary-import           Data.Char-import           Data.Default-import           Data.Maybe-import           Data.Monoid-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import           Data.Typeable-import           Yi.Buffer-import           Yi.Types (YiVariable)-import           Yi.Editor-import           Yi.History-import           Yi.Regex-import qualified Yi.Rope as R-import           Yi.Search.Internal-import           Yi.String (showT)-import           Yi.Utils-import           Yi.Window---- --------------------------------------------------------------------------- | Global searching. Search for regex and move point to that position.--- @Nothing@ means reuse the last regular expression. @Just s@ means use--- @s@ as the new regular expression. Direction of search can be--- specified as either @Backward@ or @Forward@ (forwards in the buffer).--- Arguments to modify the compiled regular expression can be supplied--- as well.-----type SearchMatch = Region-data SearchResult = PatternFound-                  | PatternNotFound-                  | SearchWrapped-  deriving Eq--doSearch :: Maybe String        -- ^ @Nothing@ means used previous-                                -- pattern, if any. Complain otherwise.-                                -- Use getRegexE to check for previous patterns-        -> [SearchOption]            -- ^ Flags to modify the compiled regex-        -> Direction            -- ^ @Backward@ or @Forward@-        -> EditorM SearchResult--doSearch (Just re) fs d = searchInit re d fs >>= withCurrentBuffer . continueSearch-doSearch Nothing   _  d = do-  mre <- getRegexE-  case mre of-    Nothing -> fail "No previous search pattern" -- NB-    Just r  -> withCurrentBuffer (continueSearch (r,d))---- | Set up a search.-searchInit :: String -> Direction -> [SearchOption] -> EditorM (SearchExp, Direction)-searchInit re d fs = do-    let Right c_re = makeSearchOptsM fs re-    setRegexE c_re-    assign searchDirectionA d-    return (c_re,d)---- | Do a search, placing cursor at first char of pattern, if found.--- Keymaps may implement their own regex language. How do we provide for this?--- Also, what's happening with ^ not matching sol?-continueSearch :: (SearchExp, Direction) -> BufferM SearchResult-continueSearch (c_re, dir) = do-  mp <- savingPointB $ do-    moveB Character dir  -- start immed. after cursor-    rs <- regexB dir c_re-    moveB Document (reverseDir dir) -- wrap around-    ls <- regexB dir c_re-    return $ listToMaybe $ fmap Right rs ++ fmap Left ls-  maybe (return ()) (moveTo . regionStart . either id id) mp-  return $ f mp-    where-        f (Just (Right _)) = PatternFound-        f (Just (Left  _)) = SearchWrapped-        f Nothing          = PatternNotFound----------------------------------------------------------------------------- Batch search and replace------- | Search and Replace all within the current region.--- Note the region is the final argument since we might perform--- the same search and replace over multiple regions however we are--- unlikely to perform several search and replaces over the same region--- since the first such may change the bounds of the region.-searchReplaceRegionB :: R.YiString -- ^ The string to search for-                     -> R.YiString -- ^ The string to replace it with-                     -> Region -- ^ The region to perform this over-                     -> BufferM Int-searchReplaceRegionB from to =-  searchAndRepRegion0 (makeSimpleSearch from) to True----- | Peform a search and replace on the selection-searchReplaceSelectionB :: R.YiString  -- ^ text to search for-                        -> R.YiString  -- ^ text to replace it with-                        -> BufferM Int-searchReplaceSelectionB from to =-  getSelectRegionB >>= searchReplaceRegionB from to---- | Replace a string by another everywhere in the document-replaceString :: R.YiString -> R.YiString -> BufferM Int-replaceString a b = regionOfB Document >>= searchReplaceRegionB a b----------------------------------------------------------------------------- | Search and replace in the given region.------ If the input boolean is True, then the replace is done globally,--- otherwise only the first match is replaced. Returns the number of--- replacements done.-searchAndRepRegion0 :: SearchExp -> R.YiString -> Bool -> Region -> BufferM Int-searchAndRepRegion0 c_re str globally region = do-    mp <- (if globally then id else take 1) <$> regexRegionB c_re region  -- find the regex-    -- mp' is a maybe not reversed version of mp, the goal-    -- is to avoid replaceRegionB to mess up the next regions.-    -- So we start from the end.-    let mp' = mayReverse (reverseDir $ regionDirection region) mp-    mapM_ (`replaceRegionB` str) mp'-    return (length mp)--searchAndRepRegion :: R.YiString -> R.YiString -> Bool -> Region -> EditorM Bool-searchAndRepRegion s str globally region = case R.null s of-  False -> return False-  True -> do-    let c_re = makeSimpleSearch s-    setRegexE c_re     -- store away for later use-    assign searchDirectionA Forward-    withCurrentBuffer $ (/= 0) <$> searchAndRepRegion0 c_re str globally region----------------------------------------------------------------------------- | Search and replace in the region defined by the given unit.--- The rest is as in 'searchAndRepRegion'.-searchAndRepUnit :: R.YiString -> R.YiString -> Bool -> TextUnit -> EditorM Bool-searchAndRepUnit re str g unit =-  withCurrentBuffer (regionOfB unit) >>= searchAndRepRegion re str g------------------------------- Incremental search---newtype Isearch = Isearch [(T.Text, Region, Direction)]-  deriving (Typeable, Show)--instance Binary Isearch where-  put (Isearch ts) = put (map3 E.encodeUtf8 ts)-  get = Isearch . map3 E.decodeUtf8 <$> get--map3 :: (a -> d) -> [(a, b, c)] -> [(d, b, c)]-map3 _ [] = []-map3 f ((a, b, c):xs) = (f a, b, c) : map3 f xs----- This contains: (string currently searched, position where we--- searched it, direction, overlay for highlighting searched text)---- Note that this info cannot be embedded in the Keymap state: the state--- modification can depend on the state of the editor.--instance Default Isearch where-    def = Isearch []--instance YiVariable Isearch--isearchInitE :: Direction -> EditorM ()-isearchInitE dir = do-  historyStartGen iSearch-  p <- withCurrentBuffer pointB-  resetRegexE-  putEditorDyn (Isearch [(T.empty ,mkRegion p p, dir)])-  printMsg "I-search: "--isearchIsEmpty :: EditorM Bool-isearchIsEmpty = do-  Isearch s <- getEditorDyn-  return . not . T.null . fst3 $ head s--isearchAddE :: T.Text -> EditorM ()-isearchAddE inc = isearchFunE (<> inc)---- | Create a SearchExp that matches exactly its argument-makeSimpleSearch :: R.YiString -> SearchExp-makeSimpleSearch s = se-    where Right se = makeSearchOptsM [QuoteRegex] (R.toString s)--makeISearch :: T.Text -> SearchExp-makeISearch s = case makeSearchOptsM opts (T.unpack s) of-                  Left _ -> SearchExp (T.unpack s) emptyRegex emptyRegex []-                  Right search -> search-   where opts = QuoteRegex : if T.any isUpper s then [] else [IgnoreCase]--isearchFunE :: (T.Text -> T.Text) -> EditorM ()-isearchFunE fun = do-  Isearch s <- getEditorDyn-  let (previous,p0,direction) = head s-      current = fun previous-      srch = makeISearch current-  printMsg $ "I-search: " <> current-  setRegexE srch-  prevPoint <- withCurrentBuffer pointB-  matches <- withCurrentBuffer $ do-      moveTo $ regionStart p0-      when (direction == Backward) $-         moveN $ T.length current-      regexB direction srch--  let onSuccess p = do withCurrentBuffer $ moveTo (regionEnd p)-                       putEditorDyn $ Isearch ((current, p, direction) : s)--  case matches of-    (p:_) -> onSuccess p-    [] -> do matchesAfterWrap <- withCurrentBuffer $ do-               case direction of-                 Forward -> moveTo 0-                 Backward -> do-                   bufferLength <- sizeB-                   moveTo bufferLength-               regexB direction srch--             case matchesAfterWrap of-               (p:_) -> onSuccess p-               [] -> do withCurrentBuffer $ moveTo prevPoint -- go back to where we were-                        putEditorDyn $ Isearch ((current, p0, direction) : s)-                        printMsg $ "Failing I-search: " <> current--isearchDelE :: EditorM ()-isearchDelE = do-  Isearch s <- getEditorDyn-  case s of-    (_:(text,p,dir):rest) -> do-      withCurrentBuffer $-        moveTo $ regionEnd p-      putEditorDyn $ Isearch ((text,p,dir):rest)-      setRegexE $ makeISearch text-      printMsg $ "I-search: " <> text-    _ -> return () -- if the searched string is empty, don't try to remove chars from it.--isearchHistory :: Int -> EditorM ()-isearchHistory delta = do-  Isearch ((current,_p0,_dir):_) <- getEditorDyn-  h <- historyMoveGen iSearch delta (return current)-  isearchFunE (const h)--isearchPrevE :: EditorM ()-isearchPrevE = isearchNext0 Backward--isearchNextE :: EditorM ()-isearchNextE = isearchNext0 Forward--isearchNext0 :: Direction -> EditorM ()-isearchNext0 newDir = do-  Isearch ((current,_p0,_dir):_rest) <- getEditorDyn-  if T.null current-    then isearchHistory 1-    else isearchNext newDir---isearchNext :: Direction -> EditorM ()-isearchNext direction = do-  Isearch ((current, p0, _dir) : rest) <- getEditorDyn-  withCurrentBuffer $ moveTo (regionStart p0 + startOfs)-  mp <- withCurrentBuffer $-    regexB direction (makeISearch current)-  case mp of-    [] -> do-      endPoint <- withCurrentBuffer $ do-              moveTo (regionEnd p0) -- revert to offset we were before.-              sizeB-      printMsg "isearch: end of document reached"-      let wrappedOfs = case direction of-                         Forward -> mkRegion 0 0-                         Backward -> mkRegion endPoint endPoint-      putEditorDyn $ Isearch ((current,wrappedOfs,direction):rest) -- prepare to wrap around.-    (p:_) -> do-      withCurrentBuffer $-        moveTo (regionEnd p)-      printMsg $ "I-search: " <> current-      putEditorDyn $ Isearch ((current,p,direction):rest)- where startOfs = case direction of-                      Forward  ->  1-                      Backward -> -1--isearchWordE :: EditorM ()-isearchWordE = do-   -- add maximum 32 chars at a time.-  text <- R.toText <$> withCurrentBuffer (pointB >>= nelemsB 32)--  let (prefix, rest) = T.break isAlpha text-      word = T.takeWhile isAlpha rest-  isearchAddE $ prefix <> word---- | Succesfully finish a search. Also see 'isearchFinishWithE'.-isearchFinishE :: EditorM ()-isearchFinishE = isearchEnd True---- | Cancel a search. Also see 'isearchCancelWithE'.-isearchCancelE :: EditorM ()-isearchCancelE = isearchEnd False---- | Wrapper over 'isearchEndWith' that passes through the action and--- accepts the search as successful (i.e. when the user wants to stay--- at the result).-isearchFinishWithE :: EditorM a -> EditorM ()-isearchFinishWithE act = isearchEndWith act True---- | Wrapper over 'isearchEndWith' that passes through the action and--- marks the search as unsuccessful (i.e. when the user wants to--- jump back to where the search started).-isearchCancelWithE :: EditorM a -> EditorM ()-isearchCancelWithE act = isearchEndWith act False--iSearch :: T.Text-iSearch = "isearch"---- | Editor action describing how to end finish incremental search.--- The @act@ parameter allows us to specify an extra action to run--- before finishing up the search. For Vim, we don't want to do--- anything so we use 'isearchEnd' which just does nothing. For emacs,--- we want to cancel highlighting and stay where we are.-isearchEndWith :: EditorM a -> Bool -> EditorM ()-isearchEndWith act accept = getEditorDyn >>= \case-  Isearch [] -> return ()-  Isearch s@((lastSearched, _, dir):_) -> do-    let (_,p0,_) = last s-    historyFinishGen iSearch (return lastSearched)-    assign searchDirectionA dir-    if accept-       then do void act-               withCurrentBuffer $ setSelectionMarkPointB $ regionStart p0-               printMsg "Quit"-       else do resetRegexE-               withCurrentBuffer $ moveTo $ regionStart p0---- | Specialised 'isearchEndWith' to do nothing as the action.-isearchEnd :: Bool -> EditorM ()-isearchEnd = isearchEndWith (return ())---------------------- Query-Replace---- | Find the next match and select it.--- Point is end, mark is beginning.-qrNext :: Window -> BufferRef -> SearchExp -> EditorM ()-qrNext win b what = do-  mp <- withGivenBufferAndWindow win b $ regexB Forward what-  case mp of-    [] -> do-      printMsg "String to search not found"-      qrFinish-    (r:_) -> withGivenBufferAndWindow win b $ setSelectRegionB r---- | Replace all the remaining occurrences.-qrReplaceAll :: Window -> BufferRef -> SearchExp -> R.YiString -> EditorM ()-qrReplaceAll win b what replacement = do-  n <- withGivenBufferAndWindow win b $ do-    exchangePointAndMarkB -- so we replace the current occurence too-    searchAndRepRegion0 what replacement True =<< regionOfPartB Document Forward-  printMsg $ "Replaced " <> showT n <> " occurrences"-  qrFinish---- | Exit from query/replace.-qrFinish :: EditorM ()-qrFinish = do-  assign currentRegexA Nothing-  closeBufferAndWindowE  -- the minibuffer.---- | We replace the currently selected match and then move to the next--- match.-qrReplaceOne :: Window -> BufferRef -> SearchExp -> R.YiString -> EditorM ()-qrReplaceOne win b reg replacement = do-  qrReplaceCurrent win b replacement-  qrNext win b reg---- | This may actually be a bit more general it replaces the current--- selection with the given replacement string in the given window and--- buffer.-qrReplaceCurrent :: Window -> BufferRef -> R.YiString -> EditorM ()-qrReplaceCurrent win b replacement =-  withGivenBufferAndWindow win b $-   flip replaceRegionB replacement =<< getRawestSelectRegionB
− src/library/Yi/Search/Internal.hs 
@@ -1,36 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Search.Internal--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Internal use for Yi.Search.--module Yi.Search.Internal where--import Control.Lens (assign, use)-import Yi.Editor (EditorM, currentRegexA)-import Yi.Regex (SearchExp)---- ------------------------------------------------------------------------ Searching and substitutions with regular expressions------ The most recent regex is held by the editor. You can get at it with--- getRegeE. This is useful to determine if there was a previous--- pattern.------- | Put regex into regex 'register'-setRegexE :: SearchExp -> EditorM ()-setRegexE re = assign currentRegexA (Just re)---- | Clear the regex 'register'-resetRegexE :: EditorM ()-resetRegexE = assign currentRegexA Nothing---- | Return contents of regex register-getRegexE :: EditorM (Maybe SearchExp)-getRegexE = use currentRegexA
− src/library/Yi/Snippets.hs 
@@ -1,425 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Snippets--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Snippets where--import           Control.Applicative-import           Control.Arrow-import           Control.Lens hiding (Action)-import           Control.Monad-import           Control.Monad.RWS hiding (mapM, mapM_, sequence, get, put)-import           Data.Binary-import           Data.Char (isSpace)-import           Data.Default-#if __GLASGOW_HASKELL__ < 708-import           Data.DeriveTH-#else-import           GHC.Generics (Generic)-#endif-import           Data.Foldable (find)-import           Data.List hiding (find, elem, concat, concatMap)-import           Data.Maybe (catMaybes)-import qualified Data.Text as T-import           Data.Typeable-import           Yi.Buffer-import           Yi.Editor-import           Yi.Keymap-import           Yi.Keymap.Keys-import qualified Yi.Rope as R-import           Yi.TextCompletion-import           Yi.Types (YiVariable)--type SnippetCmd = RWST (Int, Int) [MarkInfo] () BufferM--data SnippetMark = SimpleMark !Int-                 | ValuedMark !Int R.YiString-                 | DependentMark !Int---data MarkInfo = SimpleMarkInfo { userIndex :: !Int-                               , startMark :: !Mark }-              | ValuedMarkInfo { userIndex :: !Int-                               , startMark :: !Mark-                               , endMark :: !Mark }-              | DependentMarkInfo { userIndex :: !Int-                                  , startMark :: !Mark-                                  , endMark :: !Mark }-  deriving (Eq, Show)--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''MarkInfo)-#else-deriving instance Generic MarkInfo-instance Binary MarkInfo-#endif--newtype BufferMarks = BufferMarks { bufferMarks :: [MarkInfo] }-  deriving (Eq, Show, Monoid, Typeable, Binary)--newtype DependentMarks = DependentMarks { marks :: [[MarkInfo]] }-  deriving (Eq, Show, Monoid, Typeable, Binary)--instance Default BufferMarks where-  def = BufferMarks []--instance Default DependentMarks where-  def = DependentMarks []--instance YiVariable BufferMarks-instance YiVariable DependentMarks--instance Ord MarkInfo where-  a `compare` b = userIndex a `compare` userIndex b--cursor :: Int -> SnippetMark-cursor = SimpleMark--cursorWith :: Int -> R.YiString -> SnippetMark-cursorWith = ValuedMark--dep :: Int -> SnippetMark-dep = DependentMark--isDependentMark :: MarkInfo -> Bool-isDependentMark (SimpleMarkInfo{})    = False-isDependentMark (ValuedMarkInfo{})    = False-isDependentMark (DependentMarkInfo{}) = True--bufferMarkers :: MarkInfo -> [Mark]-bufferMarkers (SimpleMarkInfo _ s) = [s]-bufferMarkers m = [startMark m, endMark m]---- used to translate a datatype into a snippet cmd for--- freely combining data with '&'-class MkSnippetCmd a b | a -> b where-  mkSnippetCmd :: a -> SnippetCmd b--instance MkSnippetCmd String () where-  mkSnippetCmd = text . R.fromString--instance MkSnippetCmd R.YiString () where-  mkSnippetCmd = text--instance MkSnippetCmd T.Text () where-  mkSnippetCmd = text . R.fromText--instance MkSnippetCmd (SnippetCmd a) a where-  mkSnippetCmd = id---- mkSnippetCmd for 'cursor...'-functions-instance MkSnippetCmd SnippetMark () where-  mkSnippetCmd (SimpleMark i) = do-      mk <- mkMark-      tell [SimpleMarkInfo i mk]--  mkSnippetCmd (ValuedMark i str) = do-      start <- mkMark-      lift $ insertN str-      end <- mkMark-      tell [ValuedMarkInfo i start end]--  mkSnippetCmd (DependentMark i) = do-      start <- mkMark-      end <- mkMark-      tell [DependentMarkInfo i start end]---- create a mark at current position-mkMark :: MonadTrans t => t BufferM Mark-mkMark = lift $ do p <- pointB-                   newMarkB $ MarkValue p Backward---- Indentation support has been temporarily removed-text :: R.YiString -> SnippetCmd ()-text txt = do-  (_, indent) <- ask-  indentSettings <- lift indentSettingsB-  lift . foldl' (>>) (return ()) .-      intersperse (newlineB >> indentToB indent) .-      map (if expandTabs indentSettings-           then insertN . expand indentSettings ""-           else insertN) $ lines' txt-  where-    lines' txt' = case R.last txt' of-      Just '\n' -> R.lines txt' <> [mempty]-      _         -> R.lines txt--    expand :: IndentSettings -> R.YiString -> R.YiString -> R.YiString-    expand is str rst = case R.head rst of-      Nothing -> R.reverse str-      Just '\t' -> let t = R.replicateChar (tabSize is) ' ' <> str-                   in expand is t (R.drop 1 rst)-      Just s -> expand is (s `R.cons` str) rst---- unfortunatelly data converted to snippets are no monads, but '&' is--- very similar to '>>' and '&>' is similar to '>>=', since--- SnippetCmd's can be used monadically-infixr 5 &-(&) :: (MkSnippetCmd a any , MkSnippetCmd b c) => a -> b -> SnippetCmd c-str & rst = mkSnippetCmd str >> mkSnippetCmd rst--(&>) :: (MkSnippetCmd a b, MkSnippetCmd c d) => a -> (b -> c) -> SnippetCmd d-str &> rst = mkSnippetCmd str >>= mkSnippetCmd . rst--runSnippet :: Bool -> SnippetCmd a -> BufferM a-runSnippet deleteLast s = do-    line <- lineOf =<< pointB-    indent <- indentOfCurrentPosB-    (a, markInfo) <- evalRWST s (line, indent) ()-    unless (null markInfo) $ do-        let newMarks = sort $ filter (not . isDependentMark) markInfo-        let newDepMarks = filter (not . len1) $-                            groupBy belongTogether $-                              sort markInfo-        getBufferDyn >>= putBufferDyn.(BufferMarks newMarks `mappend`)-        unless (null newDepMarks) $-            getBufferDyn >>= putBufferDyn.(DependentMarks newDepMarks `mappend`)-        moveToNextBufferMark deleteLast-    return a-  where-    len1 (_:[]) = True-    len1 _      = False--    belongTogether a b = userIndex a == userIndex b--updateUpdatedMarks :: [Update] -> BufferM ()-updateUpdatedMarks upds = findEditedMarks upds >>=-                          mapM_ updateDependents--findEditedMarks :: [Update] -> BufferM [MarkInfo]-findEditedMarks upds = liftM (nub . concat) (mapM findEditedMarks' upds)-  where-    findEditedMarks' :: Update -> BufferM [MarkInfo]-    findEditedMarks' upd = do-        let p = updatePoint upd-        ms <- return . nub . concat . marks =<< getBufferDyn-        ms' <- forM ms $ \m ->do-                 r <- adjMarkRegion m-                 return $ if (updateIsDelete upd && p `nearRegion` r)-                             || p `inRegion` r-                          then Just m-                          else Nothing-        return . catMaybes $ ms'--dependentSiblings :: MarkInfo -> [[MarkInfo]] -> [MarkInfo]-dependentSiblings mark deps =-  case find (elem mark) deps of-    Nothing -> []-    Just lst -> filter (not . (mark==)) lst--updateDependents :: MarkInfo -> BufferM ()-updateDependents m = getBufferDyn >>= updateDependents' m . marks--updateDependents' :: MarkInfo -> [[MarkInfo]] -> BufferM ()-updateDependents' mark deps =-  case dependentSiblings mark deps of-    []   -> return ()-    deps' -> do-      txt <- markText mark-      forM_ deps' $ \d -> do-        dTxt <- markText d-        when (txt /= dTxt) $ setMarkText txt d--markText :: MarkInfo -> BufferM R.YiString-markText m = markRegion m >>= readRegionB--setMarkText :: R.YiString -> MarkInfo -> BufferM ()-setMarkText txt (SimpleMarkInfo _ start) = do-  p <- use $ markPointA start-  c <- readAtB p-  if isSpace c-    then insertNAt txt p-    else do-      r <- regionOfPartNonEmptyAtB unitViWordOnLine Forward p-      modifyRegionB (const txt) r--setMarkText txt mi = do-    start <- use $ markPointA $ startMark mi-    end   <- use $ markPointA $ endMark mi-    let r = mkRegion start end-    modifyRegionB (const txt) r-    when (start == end) $-      markPointA (endMark mi) .= end + Point (R.length txt)--withSimpleRegion :: MarkInfo -> (Region -> BufferM Region) -> BufferM Region-withSimpleRegion (SimpleMarkInfo _ s) f = do-    p <- use $ markPointA s-    c <- readAtB p-    if isSpace c-      then return $ mkRegion p p  -- return empty region-      else f =<< regionOfPartNonEmptyAtB unitViWordOnLine Forward p-withSimpleRegion r _ = error $ "withSimpleRegion: " <> show r--markRegion :: MarkInfo -> BufferM Region-markRegion m@SimpleMarkInfo{} = withSimpleRegion m $ \r -> do-    os <- findOverlappingMarksWith safeMarkRegion concat True r m-    rOs <- mapM safeMarkRegion os-    return . mkRegion (regionStart r) $ foldl' minEnd (regionEnd r) rOs-  where-    minEnd end r = if regionEnd r < end-                   then end-                   else min end $ regionStart r--markRegion m = liftM2 mkRegion-                   (use $ markPointA $ startMark m)-                   (use $ markPointA $ endMark m)--safeMarkRegion :: MarkInfo -> BufferM Region-safeMarkRegion m@(SimpleMarkInfo _ _) = withSimpleRegion m return-safeMarkRegion m = markRegion m--adjMarkRegion :: MarkInfo -> BufferM Region-adjMarkRegion s@(SimpleMarkInfo _ _) = markRegion s--adjMarkRegion m = do-    s <- use $ markPointA $ startMark m-    e <- use $ markPointA $ endMark m-    c <- readAtB e-    when (isWordChar c) $ do adjustEnding e-                             repairOverlappings e-    e' <- use $ markPointA $ endMark m-    s' <- adjustStart s e'-    return $ mkRegion s' e'-  where-    adjustEnding end = do-        r' <- regionOfPartNonEmptyAtB unitViWordOnLine Forward end-        markPointA (endMark m) .= (regionEnd r')--    adjustStart s e = do-        txt <- readRegionB (mkRegion s e)-        let sP = s + (Point . R.length $ R.takeWhile isSpace txt)-        when (sP > s) $-            markPointA (startMark m) .= sP-        return sP--    -- test if we generated overlappings and repair-    repairOverlappings origEnd = do overlappings <- allOverlappingMarks True m-                                    unless (null overlappings) $-                                        markPointA (endMark m) .= origEnd--findOverlappingMarksWith :: (MarkInfo -> BufferM Region)-                         -> ([[MarkInfo]] -> [MarkInfo])-                         -> Bool -> Region -> MarkInfo -> BufferM [MarkInfo]-findOverlappingMarksWith fMarkRegion flattenMarks border r m =-  let markFilter = filter (m /=) . flattenMarks . marks-      regOverlap = liftM (regionsOverlap border r) . fMarkRegion-  in liftM markFilter getBufferDyn >>= filterM regOverlap--findOverlappingMarks :: ([[MarkInfo]] -> [MarkInfo]) -> Bool -> Region ->-                        MarkInfo -> BufferM [MarkInfo]-findOverlappingMarks = findOverlappingMarksWith markRegion--regionsOverlappingMarks :: Bool -> Region -> MarkInfo -> BufferM [MarkInfo]-regionsOverlappingMarks = findOverlappingMarks concat--overlappingMarks :: Bool -> Bool -> MarkInfo -> BufferM [MarkInfo]-overlappingMarks border belongingTogether mark = do-    r <- markRegion mark-    findOverlappingMarks (if belongingTogether-                          then dependentSiblings mark-                          else concat)-                         border-                         r-                         mark--allOverlappingMarks :: Bool -> MarkInfo -> BufferM [MarkInfo]-allOverlappingMarks border = overlappingMarks border False--dependentOverlappingMarks :: Bool -> MarkInfo -> BufferM [MarkInfo]-dependentOverlappingMarks border = overlappingMarks border True--nextBufferMark :: Bool -> BufferM (Maybe MarkInfo)-nextBufferMark deleteLast = do-  BufferMarks ms <- getBufferDyn-  if null ms-    then return Nothing-    else do-      let mks = if deleteLast then const $ tail ms else (tail ms <>)-      putBufferDyn . BufferMarks . mks $ [head ms]-      return . Just $ head ms--isDependentMarker :: (MonadState FBuffer m, Functor m) => Mark -> m Bool-isDependentMarker bMark = do-    DependentMarks ms <- getBufferDyn-    return . elem bMark . concatMap bufferMarkers . concat $ ms--safeDeleteMarkB :: Mark -> BufferM ()-safeDeleteMarkB m = do-    b <- isDependentMarker m-    unless b (deleteMarkB m)--moveToNextBufferMark :: Bool -> BufferM ()-moveToNextBufferMark deleteLast = nextBufferMark deleteLast >>= \case-  Just p  -> mv p-  Nothing -> return ()-  where-    mv (SimpleMarkInfo _ m)   = do-        moveTo =<< use (markPointA m)-        when deleteLast $ safeDeleteMarkB m--    mv (ValuedMarkInfo _ s e) = do-        sp <- use $ markPointA s-        ep <- use $ markPointA e-        deleteRegionB (mkRegion sp ep)-        moveTo sp-        when deleteLast $ do-            safeDeleteMarkB s-            safeDeleteMarkB e--    mv r = error $ "moveToNextBufferMark.mv: " <> show r---- Keymap support--newtype SupertabExt = Supertab (R.YiString -> Maybe (BufferM ()))--instance Monoid SupertabExt where-  mempty = Supertab $ const Nothing--  (Supertab f) `mappend` (Supertab g) =-    Supertab $ \s -> f s `mplus` g s--superTab :: (MonadInteract m Action Event) => Bool -> SupertabExt -> m ()-superTab caseSensitive (Supertab expander) =-    some (spec KTab ?>>! doSuperTab) >> deprioritize >>! resetComplete-  where-    doSuperTab = do canExpand <- withCurrentBuffer $ do-                                   sol <- atSol-                                   ws  <- hasWhiteSpaceBefore-                                   return $ sol || ws-                    if canExpand-                      then insertTab-                      else runCompleter--    insertTab = withCurrentBuffer $ mapM_ insertB =<< tabB--    runCompleter = do w <- withCurrentBuffer readPrevWordB-                      case expander w of-                        Just cmd -> withCurrentBuffer $ bkillWordB >> cmd-                        _        -> autoComplete--    autoComplete = wordCompleteString' caseSensitive >>=-                   withCurrentBuffer . (bkillWordB >>) . (insertN . R.fromText)---- | Convert snippet description list into a SuperTab extension-fromSnippets :: Bool -> [(R.YiString, SnippetCmd ())] -> SupertabExt-fromSnippets deleteLast snippets =-  Supertab $ \str -> lookup str $ map (second $ runSnippet deleteLast) snippets--snippet :: MkSnippetCmd a b => a -> SnippetCmd b-snippet = mkSnippetCmd
− src/library/Yi/Snippets/Haskell.hs 
@@ -1,23 +0,0 @@--{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Snippets.Haskell--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable--module Yi.Snippets.Haskell where--import qualified Yi.Rope as R-import           Yi.Snippets--hsFunction :: SnippetCmd ()-hsFunction = snippet $-  cursorWith 1 (R.singleton 'f') & " :: " & cursor 2 & "\n" &-  cursor 3 & " = " & cursor 4 & "\n"--hsClass :: SnippetCmd ()-hsClass = snippet $-  "class " & cursor 1 & " " & cursor 2 & " where\n  " & cursor 3
− src/library/Yi/String.hs 
@@ -1,144 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.String--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ String manipulation utilities--module Yi.String (isBlank,-                  chomp,-                  capitalize,-                  capitalizeFirst,-                  dropSpace,-                  fillText,-                  onLines,-                  mapLines,-                  lines',-                  unlines',-                  padLeft, padRight,-                  commonTPrefix,-                  commonTPrefix',-                  listify,-                  showT,-                  overInit, overTail-                 ) where--import           Data.Char (toUpper, toLower, isSpace, isAlphaNum)-import           Data.List (isSuffixOf)-import           Data.Maybe (fromMaybe)-import           Data.Monoid-import qualified Data.Text as T-import qualified Yi.Rope as R---- | Helper that shows then packs the 'Text', for all those cases--- where we use 'show'.-showT :: Show a => a -> T.Text-showT = T.pack . show---- | This is kind of like the default Show instance for lists except--- over 'T.Text'. It does not leave the elements in extra quotes and--- should not be attempted to be 'show'n and 'read' back.-listify :: [R.YiString] -> R.YiString-listify t = '[' `R.cons` R.intercalate ", " t `R.snoc` ']'---- | Works by resupplying the found prefix back into the list,--- eventually either finding the prefix or not matching.-commonTPrefix :: [T.Text] -> Maybe T.Text-commonTPrefix (x:y:xs) = case T.commonPrefixes x y of-  Nothing -> Nothing-  Just (p, _, _) -> commonTPrefix (p : xs)-commonTPrefix [x] = Just x-commonTPrefix _ = Nothing---- | Like 'commonTPrefix' but returns empty text on failure.-commonTPrefix' :: [T.Text] -> T.Text-commonTPrefix' = fromMaybe T.empty . commonTPrefix--capitalize :: String -> String-capitalize [] = []-capitalize (c:cs) = toUpper c : map toLower cs--capitalizeFirst :: R.YiString -> R.YiString-capitalizeFirst = R.withText go-  where-    go x = case T.break isAlphaNum x of-      (f, b) -> f <> case T.splitAt 1 b of-        (h, hs) -> T.toUpper h <> hs---- | Remove any trailing strings matching /irs/ (input record separator)--- from input string. Like perl's chomp(1).-chomp :: String -> String -> String-chomp irs st-    | irs `isSuffixOf` st-    = let st' = reverse $ drop (length irs) (reverse st) in chomp irs st'-    | otherwise = st-{-# INLINE chomp #-}----- | Trim spaces at beginning /and/ end-dropSpace :: String -> String-dropSpace = let f = reverse . dropWhile isSpace in f . f--isBlank :: R.YiString -> Bool-isBlank = R.all isSpace---- | Fills lines up to the given length, splitting the text up if--- necessary.-fillText :: Int -> R.YiString -> [R.YiString]-fillText margin = map (R.unwords . reverse) . fill 0 [] . R.words-  where-    fill _ acc [] = [acc]-    fill n acc (w:ws)-      | n + R.length w >= margin = acc : fill (R.length w) [w] ws-      | otherwise = fill (n + 1 + R.length w) (w:acc) ws---- | @overInit f@ runs f over the 'R.init' of the input if possible,--- preserving the 'R.last' element as-is. If given a string with--- length ≤ 1, it effectively does nothing.------ Also see 'overTail'.-overInit :: (R.YiString -> R.YiString) -> R.YiString -> R.YiString-overInit f t = case (R.init t, R.last t) of-  (Just xs, Just x) -> f xs `R.snoc` x-  _ -> t---- | @overInit f@ runs f over the 'R.tail' of the input if possible,--- preserving the 'R.head' element as-is. If given a string with--- length ≤ 1, it effectively does nothing.------ Also see 'overInit'.-overTail :: (R.YiString -> R.YiString) -> R.YiString -> R.YiString-overTail f t = case (R.head t, R.tail t) of-  (Just x, Just xs) -> x `R.cons` f xs-  _ -> t---- | Inverse of 'lines''. In contrast to 'Prelude.unlines', this does--- not add an empty line at the end.-unlines' :: [T.Text] -> T.Text-unlines' = T.intercalate "\n"---- | Split a Text in lines. Unlike 'Prelude.lines', this does not--- remove any empty line at the end.-lines' :: T.Text -> [T.Text]-lines' = T.splitOn "\n"---- | A helper function for creating functions suitable for--- 'modifySelectionB' and 'modifyRegionB'.--- To be used when the desired function should map across--- the lines of a region.-mapLines :: (R.YiString -> R.YiString) -> R.YiString -> R.YiString-mapLines f = onLines $ fmap f--onLines :: ([R.YiString] -> [R.YiString]) -> R.YiString -> R.YiString-onLines f = mconcat . f . R.lines'--padLeft, padRight :: Int -> String -> String-padLeft n [] = replicate n ' '-padLeft n (x:xs) = x : padLeft (n-1) xs--padRight n = reverse . padLeft n . reverse
− src/library/Yi/Syntax/Driver.hs 
@@ -1,59 +0,0 @@-{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, MultiParamTypeClasses #-}-{-# OPTIONS_GHC -fno-warn-name-shadowing #-}---- | This module defines implementations of syntax-awareness drivers.--module Yi.Syntax.Driver where--import qualified  Data.Map as M-import Data.Map (Map)--import Yi.Buffer.Basic(WindowRef)-import Yi.Lexer.Alex (Tok)-import Yi.Syntax hiding (Cache)-import Yi.Syntax.Tree--type Path = [Int]--data Cache state tree tt = Cache {-                                   path :: M.Map WindowRef Path,-                                   cachedStates :: [state],-                                   root :: tree (Tok tt),-                                   focused :: !(M.Map WindowRef (tree (Tok tt)))-                                 }--mkHighlighter :: forall state tree tt. (IsTree tree, Show state) =>-                 (Scanner Point Char -> Scanner state (tree (Tok tt))) ->-                     Highlighter (Cache state tree tt) (tree (Tok tt))-mkHighlighter scanner =-  Yi.Syntax.SynHL-        { hlStartState   = Cache M.empty [] emptyResult M.empty-        , hlRun          = updateCache-        , hlGetTree      = \(Cache _ _ _ focused) w -> M.findWithDefault emptyResult w focused-        , hlFocus        = focus-        }-    where startState :: state-          startState = scanInit    (scanner emptyFileScan)-          emptyResult = scanEmpty (scanner emptyFileScan)-          updateCache :: Scanner Point Char -> Point -> Cache state tree tt -> Cache state tree tt-          updateCache newFileScan dirtyOffset (Cache path cachedStates oldResult _) = Cache path newCachedStates newResult M.empty-            where newScan = scanner newFileScan-                  reused :: [state]-                  reused = takeWhile ((< dirtyOffset) . scanLooked (scanner newFileScan)) cachedStates-                  resumeState :: state-                  resumeState = if null reused then startState else last reused--                  newCachedStates = reused ++ fmap fst recomputed-                  recomputed = scanRun newScan resumeState-                  newResult :: tree (Tok tt)-                  newResult = if null recomputed then oldResult else snd $ head recomputed-          focus r (Cache path states root _focused) =-              Cache path' states root focused-              where (path', focused) = unzipFM $ zipWithFM (\newpath oldpath -> fromNodeToFinal newpath (oldpath,root)) [] r path--unzipFM :: Ord k => [(k,(u,v))] -> (Map k u, Map k v)-unzipFM l = (M.fromList mu, M.fromList mv)-    where (mu, mv) = unzip [((k,u),(k,v)) | (k,(u,v)) <- l]--zipWithFM :: Ord k => (u -> v -> w) -> v -> Map k u -> Map k v -> [(k,w)]-zipWithFM f v0 mu mv = [ (k,f u (M.findWithDefault v0 k mv) ) | (k,u) <- M.assocs mu]
− src/library/Yi/Syntax/Haskell.hs 
@@ -1,745 +0,0 @@-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TypeFamilies #-}---- we have lots of parsers which don't want signatures; and we have--- uniplate patterns-{-# OPTIONS_GHC -fno-warn-missing-signatures-                -fno-warn-incomplete-patterns-                -fno-warn-name-shadowing #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Syntax.Haskell--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ NOTES:--- Note if the layout of the first line (not comments)--- is wrong the parser will only parse what is in the blocks given by Layout.hs--module Yi.Syntax.Haskell ( PModule-                         , PModuleDecl-                         , PImport-                         , Exp (..)-                         , Tree-                         , parse-                         , indentScanner-                         ) where--import Control.Applicative-import Data.Foldable hiding (elem, notElem)-import Data.Maybe-import Data.List ((\\))-import Yi.IncrementalParse-import Yi.Lexer.Alex-import Yi.Lexer.Haskell-import Yi.Syntax.Layout-import Yi.Syntax.Tree-import Yi.Syntax-import Control.Arrow ((&&&))--indentScanner :: Scanner (AlexState lexState) TT-              -> Scanner (Yi.Syntax.Layout.State Token lexState) TT-indentScanner = layoutHandler startsLayout [(Special '(', Special ')'),-                                            (Reserved Let, Reserved In),-                                            (Special '[', Special ']'),-                                            (Special '{', Special '}')]-                         ignoredToken-                         (Special '<', Special '>', Special '.')-                         isBrace---- HACK: We insert the Special '<', '>', '.', which do not occur in--- normal haskell parsing.---- | Check if a token is a brace, this function is used to--- fix the layout so that do { works correctly-isBrace :: TT -> Bool-isBrace (Tok br _ _) = Special '{' == br---- | Theese are the tokens ignored by the layout handler.-ignoredToken :: TT -> Bool-ignoredToken (Tok t _ (Posn{})) = isComment t || t == CppDirective--type Tree = PModule-type PAtom = Exp-type Block = Exp-type PGuard = Exp-type PModule = Exp-type PModuleDecl = Exp-type PImport = Exp----- | Exp can be expression or declaration-data Exp t-    = PModule { comments :: [t]-              , progMod  :: Maybe (PModule t)-              }-    | ProgMod { modDecl :: PModuleDecl t-              , body    :: PModule t  -- ^ The module declaration part-              }-    | Body { imports :: Exp t -- [PImport t]-           , content :: Block t-           , extraContent :: Block t -- ^ The body of the module-           }-    | PModuleDecl { moduleKeyword :: PAtom t-                                 , name          :: PAtom t-                                 , exports       :: Exp t-                                 , whereKeyword  :: Exp t-                                    }-    | PImport { importKeyword :: PAtom t-                         , qual          :: Exp t-                         , name'         :: PAtom t-                         , as            :: Exp t-                         , specification :: Exp t-                         }--    | TS t [Exp t] -- ^ Type signature-    | PType { typeKeyword :: PAtom t-            , typeCons    :: Exp t-            , equal       :: PAtom t-            , btype       :: Exp t-            } -- ^ Type declaration-    | PData { dataKeyword :: PAtom t-            , dtypeCons   :: Exp t-            , dEqual      :: Exp t-            , dataRhs     :: Exp t-            }  -- ^ Data declaration-    | PData' { dEqual     :: PAtom t-             , dataCons   :: Exp t -- ^ Data declaration RHS-             }-    | PClass { cKeyword   :: PAtom t -- Can be class or instance-             , cHead      :: Exp t-             , cwhere     :: Exp t -- ^ Class declaration-             }-      -- declaration-      -- declarations and parts of them follow-    | Paren (PAtom t) [Exp t] (PAtom t) -- ^ A parenthesized, bracked or braced-    | Block [Exp t] -- ^ A block of things separated by layout-    | PAtom t [t] -- ^ An atom is a token followed by many comments-    | Expr [Exp t] -- ^-    | PWhere (PAtom t) (Exp t) (Exp t) -- ^ Where clause-    | Bin (Exp t) (Exp t)-       -- an error with comments following so we never color comments in wrong-       -- color. The error has an extra token, the Special '!' token to-       -- indicate that it contains an error-    | PError { errorTok    :: t-             , marker      :: t-             , commentList :: [t] -- ^ An wrapper for errors-             }-      -- rhs that begins with Equal-    | RHS (PAtom t) (Exp t) -- ^ Righthandside of functions with =-    | Opt (Maybe (Exp t)) -- ^ An optional-    | Modid t [t] -- ^ Module identifier-    | Context (Exp t) (Exp t) (PAtom t) -- ^-    | PGuard [PGuard t] -- ^ Righthandside of functions with |-      -- the PAtom in PGuard' does not contain any comments-    | PGuard' (PAtom t) (Exp t) (PAtom t)-      -- type constructor is just a wrapper to indicate which highlightning to-      -- use.-    | TC (Exp t) -- ^ Type constructor-      -- data constructor same as with the TC constructor-    | DC (Exp t) -- ^ Data constructor-    | PLet (PAtom t) (Exp t) (Exp t) -- ^ let expression-    | PIn t [Exp t]-  deriving (Show, Foldable)--instance IsTree Exp where-   emptyNode = Expr []-   uniplate tree = case tree of-       (ProgMod a b)     -> ([a,b], \[a,b] -> ProgMod a b)-       (Body x exp exp') -> ([x, exp, exp'], \[x, exp, exp'] -> Body x exp exp')-       (PModule x (Just e)) -> ([e],\[e] -> PModule x (Just e))-       (Paren l g r)  -> -- TODO: improve-         (l:g ++ [r], \(l:gr) -> Paren l (init gr) (last gr))-       (RHS l g)      -> ([l,g],\[l,g] -> (RHS l g))-       (Block s)      -> (s,Block)-       (PLet l s i)   -> ([l,s,i],\[l,s,i] -> PLet l s i)-       (PIn x ts)     -> (ts,PIn x)-       (Expr a)       -> (a,Expr)-       (PClass a b c) -> ([a,b,c],\[a,b,c] -> PClass a b c)-       (PWhere a b c) -> ([a,b,c],\[a,b,c] -> PWhere a b c)-       (Opt (Just x)) -> ([x],\[x] -> (Opt (Just x)))-       (Bin a b) -> ([a,b],\[a,b] -> (Bin a b))-       (PType a b c d) -> ([a,b,c,d],\[a,b,c,d] -> PType a b c d)-       (PData a b c d) -> ([a,b,c,d],\[a,b,c,d] -> PData a b c d)-       (PData' a b) -> ([a,b] ,\[a,b] -> PData' a b)-       (Context a b c) -> ([a,b,c],\[a,b,c] -> Context a b c)-       (PGuard xs) -> (xs,PGuard)-       (PGuard' a b c) -> ([a,b,c],\[a,b,c] -> PGuard' a b c)-       (TC e) -> ([e],\[e] -> TC e)-       (DC e) -> ([e],\[e] -> DC e)-       PModuleDecl a b c d -> ([a,b,c,d],\[a,b,c,d] -> PModuleDecl a b c d)-       PImport a b c d e -> ([a,b,c,d,e],\[a,b,c,d,e] -> PImport a b c d e)-       t              -> ([],const t)---- | The parser-parse :: P TT (Tree TT)-parse = pModule <* eof---- | @pModule@ parse a module-pModule :: Parser TT (PModule TT)-pModule = PModule <$> pComments <*> optional-           (pBlockOf' (ProgMod <$> pModuleDecl-                       <*> pModBody <|> pBody))---- | Parse a body that follows a module-pModBody :: Parser TT (PModule TT)-pModBody = (exact [startBlock] *>-            (Body <$> pImports-             <*> ((pTestTok elems *> pBod)-                  <|> pEmptyBL) <* exact [endBlock]-             <*> pBod-            <|> Body <$> noImports-             <*> ((pBod <|> pEmptyBL) <* exact [endBlock])-             <*> pBod))-       <|> (exact [nextLine] *> pBody)-       <|> Body <$> pure emptyNode <*> pEmptyBL <*> pEmptyBL-    where pBod  = Block <$> pBlocks pTopDecl-          elems = [Special ';', nextLine, startBlock]---- | @pEmptyBL@ A parser returning an empty block-pEmptyBL :: Parser TT (Exp TT)-pEmptyBL = Block <$> pEmpty---- | Parse a body of a program-pBody :: Parser TT (PModule TT)-pBody = Body <$> noImports <*> (Block <$> pBlocks pTopDecl) <*> pEmptyBL-    <|> Body <$> pImports <*> ((pTestTok elems *> (Block <$> pBlocks pTopDecl))-                               <|> pEmptyBL) <*> pEmptyBL-    where elems = [nextLine, startBlock]--noImports :: Parser TT (Exp TT)-noImports = notNext [Reserved Import] *> pure emptyNode-    where notNext f = testNext $ uncurry (||) . (&&&) isNothing-                      (flip notElem f . tokT . fromJust)---- Helper functions for parsing follows--- | Parse Variables-pVarId :: Parser TT (Exp TT)-pVarId = pAtom [VarIdent, Reserved Other, Reserved As]---- | Parse VarIdent and ConsIdent-pQvarid :: Parser TT (Exp TT)-pQvarid = pAtom [VarIdent, ConsIdent, Reserved Other, Reserved As]---- | Parse an operator using please-pQvarsym :: Parser TT (Exp TT)-pQvarsym = pParen ((:) <$> please (PAtom <$> sym isOperator <*> pComments)-                   <*> pEmpty)---- | Parse any operator-isOperator :: Token -> Bool-isOperator (Operator _)     = True-isOperator (ReservedOp _)   = True-isOperator (ConsOperator _) = True-isOperator _                = False---- | Parse a consident-pQtycon :: Parser TT (Exp TT)-pQtycon = pAtom [ConsIdent]---- | Parse many variables-pVars :: Parser TT (Exp TT)-pVars = pMany pVarId---- | Parse a nextline token (the nexLine token is inserted by Layout.hs)-nextLine :: Token-nextLine = Special '.'---- | Parse a startBlock token-startBlock :: Token-startBlock = Special '<'---- | Parse a endBlock token-endBlock :: Token-endBlock = Special '>'--pEmpty :: Applicative f =>  f [a]-pEmpty = pure []--pToList :: Applicative f =>  f a -> f [a]-pToList = (box <$>)-    where box x = [x]---- | @sym f@ returns a parser parsing @f@ as a special symbol-sym :: (Token -> Bool) -> Parser TT TT-sym f = symbol (f . tokT)---- | @exact tokList@ parse anything that is in @tokList@-exact :: [Token] -> Parser TT TT-exact = sym . flip elem----- | @please p@ returns a parser parsing either @p@ or recovers with the--- (Special '!') token.-please :: Parser TT (Exp TT) -> Parser TT (Exp TT)-please = (<|>) (PError <$> recoverWith errTok-                <*> errTok-                <*> pEmpty)---- | Parse anything, as errors-pErr :: Parser TT (Exp TT)-pErr = PError <$> recoverWith (sym $ not . uncurry (||) . (&&&) isComment-                               (== CppDirective))-   <*> errTok-   <*> pComments---- | Parse an ConsIdent-ppCons :: Parser TT (Exp TT)-ppCons = ppAtom [ConsIdent]---- | Parse a keyword-pKW :: [Token] -> Parser TT (Exp TT) -> Parser TT (Exp TT)-pKW k r = Bin <$> pAtom k <*> r---- | Parse an unary operator with and without using please-pOP :: [Token] -> Parser TT (Exp TT) -> Parser TT (Exp TT)-pOP op r = Bin <$> pAtom op <*> r----ppOP op r = Bin <$> ppAtom op <*> r---- | Parse comments-pComments :: Parser TT [TT]-pComments = many $ sym $ uncurry (||) . (&&&) isComment (== CppDirective)---- | Parse something thats optional-pOpt :: Parser TT (Exp TT) -> Parser TT (Exp TT)-pOpt x = Opt <$> optional x---- | Parse an atom with, and without using please-pAtom, ppAtom :: [Token] -> Parser TT (Exp TT)-pAtom = flip pCAtom pComments--ppAtom at =  pAtom at <|> recoverAtom--recoverAtom :: Parser TT (Exp TT)-recoverAtom = PAtom <$> recoverWith errTok <*> pEmpty---- | Parse an atom with optional comments-pCAtom :: [Token] -> Parser TT [TT] -> Parser TT (Exp TT)-pCAtom r c = PAtom <$> exact r <*> c--pBareAtom a = pCAtom a pEmpty---- | @pSepBy p sep@ parse /zero/ or more occurences of @p@, separated--- by @sep@, with optional ending @sep@,--- this is quite similar to the sepBy function provided in--- Parsec, but this one allows an optional extra separator at the end.------ > commaSep p = p `pSepBy` (symbol (==(Special ',')))--pSepBy :: Parser TT (Exp TT) -> Parser TT (Exp TT) -> Parser TT [Exp TT]-pSepBy p sep = pEmpty-           <|> (:) <$> p <*> (pSepBy1 p sep <|> pEmpty)-           <|> pToList sep -- optional ending separator-    where pSepBy1 r p' = (:) <$> p' <*> (pEmpty <|> pSepBy1 p' r)---- | Separate a list of things separated with comma inside of parenthesis-pParenSep :: Parser TT (Exp TT) -> Parser TT (Exp TT)-pParenSep = pParen . flip pSepBy pComma---- | Parse a comma separator-pComma :: Parser TT (Exp TT)-pComma = pAtom [Special ',']---- End of helper functions Parsing different parts follows---- | Parse a Module declaration-pModuleDecl :: Parser TT (PModuleDecl TT)-pModuleDecl = PModuleDecl <$> pAtom [Reserved Module]-          <*> ppAtom [ConsIdent]-          <*> pOpt (pParenSep pExport)-          <*> (optional (exact [nextLine]) *>-               (Bin <$> ppAtom [Reserved Where])-               <*> pMany pErr) <* pTestTok elems-    where elems = [nextLine, startBlock, endBlock]--pExport :: Parser TT (Exp TT)-pExport = optional (exact [nextLine]) *> please-        ( pVarId-          <|> pEModule-          <|> Bin <$> pQvarsym <*> (DC <$> pOpt expSpec) -- typeOperator-          <|> Bin <$> (TC <$> pQtycon) <*> (DC <$> pOpt expSpec)-        )-        where expSpec = pParen (pToList (please (pAtom [ReservedOp DoubleDot]))-                                <|> pSepBy pQvarid pComma)---- | Check if next token is in given list-pTestTok :: [Token] -> Parser TT ()-pTestTok f = testNext (uncurry (||) . (&&&) isNothing-                       (flip elem f . tokT . fromJust))---- | Parse several imports-pImports :: Parser TT (Exp TT) -- [PImport TT]-pImports = Expr <$> many (pImport-                 <* pTestTok pEol-                 <* optional (some $ exact [nextLine, Special ';']))-        where pEol = [Special ';', nextLine, endBlock]---- | Parse one import-pImport :: Parser TT (PImport TT)-pImport = PImport  <$> pAtom [Reserved Import]-      <*> pOpt (pAtom [Reserved Qualified])-      <*> ppAtom [ConsIdent]-      <*> pOpt (pKW [Reserved As] ppCons)-      <*> (TC <$> pImpSpec)-        where pImpSpec = Bin <$> pKW [Reserved Hiding]-                                  (please pImpS) <*> pMany pErr-                     <|> Bin <$> pImpS <*> pMany pErr-                     <|> pMany pErr-              pImpS    = DC <$> pParenSep pExp'-              pExp'    = Bin-                     <$> (PAtom <$> sym-                          (uncurry (||) . (&&&)-                           (`elem` [VarIdent, ConsIdent])-                           isOperator) <*> pComments-                          <|>  pQvarsym)-                     <*> pOpt pImpS---- | Parse simple type synonyms-pType :: Parser TT (Exp TT)-pType = PType <$> (Bin <$> pAtom [Reserved Type]-                   <*> pOpt (pAtom [Reserved Instance]))-     <*> (TC . Expr <$> pTypeExpr')-     <*> ppAtom [ReservedOp Equal]-     <*> (TC . Expr <$> pTypeExpr')---- | Parse data declarations-pData :: Parser TT (Exp TT)-pData = PData <$> pAtom [Reserved Data, Reserved NewType]-     <*> (TC . Expr <$> pTypeExpr')-     <*> pOpt (pDataRHS <|> pGadt)-     <*> pOpt pDeriving---pGadt :: Parser TT (Exp TT)-pGadt = pWhere pTypeDecl---- | Parse second half of the data declaration, if there is one-pDataRHS :: Parser TT (Exp TT)-pDataRHS = PData' <$> pAtom [ReservedOp Equal]  <*> pConstrs----- | Parse a deriving-pDeriving :: Parser TT (Exp TT)-pDeriving = pKW [Reserved Deriving] (TC . Expr <$> pTypeExpr')--pAtype :: Parser TT (Exp TT)-pAtype = pAtype'-     <|> pErr--pAtype' :: Parser TT (Exp TT)-pAtype' = pTypeCons-      <|> pParen (many $ pExprElem [])-      <|> pBrack (many $ pExprElem [])--pTypeCons :: Parser TT (Exp TT)-pTypeCons = Bin <$> pAtom [ConsIdent]-            <*> please (pMany $ pAtom [VarIdent, ConsIdent])--pContext :: Parser TT (Exp TT)-pContext = Context <$> pOpt pForAll-       <*> (TC <$> (pClass' <|> pParenSep pClass'))-       <*> ppAtom [ReservedOp DoubleRightArrow]-        where pClass' :: Parser TT (Exp TT)-              pClass' = Bin <$> pQtycon-                   <*> (please pVarId-                        <|> pParen ((:) <$> please pVarId-                                    <*> many pAtype'))---- | Parse for all-pForAll :: Parser TT (Exp TT)-pForAll = pKW [Reserved Forall]-          (Bin <$> pVars <*> ppAtom [Operator "."])--pConstrs :: Parser TT (Exp TT)-pConstrs = Bin <$> (Bin <$> pOpt pContext <*> pConstr)-       <*> pMany (pOP [ReservedOp Pipe]-                  (Bin <$> pOpt pContext <*> please pConstr))--pConstr :: Parser TT (Exp TT)-pConstr = Bin <$> pOpt pForAll-      <*> (Bin <$>-           (Bin <$> (DC <$> pAtype) <*>-            (TC <$> pMany (strictF pAtype))) <*> pOpt st)-      <|> Bin <$> lrHs <*> pMany (strictF pAtype)-      <|> pErr-    where lrHs = pOP [Operator "!"] pAtype-          st = pEBrace (pTypeDecl `sepBy1` pBareAtom [Special ','])-          -- named fields declarations---- | Parse optional strict variables-strictF :: Parser TT (Exp TT) -> Parser TT (Exp TT)-strictF a = Bin <$> pOpt (pAtom [Operator "!"]) <*> a----- | Exporting module-pEModule ::Parser TT (Exp TT)-pEModule = pKW [Reserved Module]-         $ please (Modid <$> exact [ConsIdent] <*> pComments)---- | Parse a Let expression-pLet :: Parser TT (Exp TT)-pLet = PLet <$> pAtom [Reserved Let]-   <*> pBlock pFunDecl-   <*> pOpt (pBareAtom [Reserved In])---- | Parse a Do block-pDo :: Parser TT (Exp TT)-pDo = Bin <$> pAtom [Reserved Do]-          <*> pBlock (pExpr ((Special ';' : recognizedSometimes)-                             \\ [ReservedOp LeftArrow]))---- | Parse part of a lambda binding.-pLambda :: Parser TT (Exp TT)-pLambda = Bin <$> pAtom [ReservedOp BackSlash]-          <*> (Bin <$> (Expr <$> pPattern)-               <*> please (pBareAtom [ReservedOp RightArrow]))---- | Parse an Of block-pOf :: Parser TT (Exp TT)-pOf = Bin <$> pAtom [Reserved Of]-          <*> pBlock pAlternative--pAlternative = Bin <$> (Expr <$> pPattern)-                   <*> please (pFunRHS (ReservedOp RightArrow))---- | Parse classes and instances--- This is very imprecise, but shall suffice for now.--- At least is does not complain too often.-pClass :: Parser TT (Exp TT)-pClass = PClass <$> pAtom [Reserved Class, Reserved Instance]-                <*> (TC . Expr <$>  pTypeExpr')-                <*> pOpt (please (pWhere pTopDecl))-                -- use topDecl since we have associated types and such.----- | Parse some guards and a where clause-pGuard :: Token -> Parser TT (Exp TT)-pGuard equalSign = PGuard-     <$> some (PGuard' <$> pCAtom [ReservedOp Pipe] pEmpty <*>-               -- comments are by default parsed after this-               pExpr (recognizedSometimes-                      -- these two symbols can appear in guards.-                      \\ [ReservedOp LeftArrow, Special ','])-               <*> please (pEq equalSign))-               -- this must be -> if used in case---- | Right-hand-side of a function or case equation (after the pattern)-pFunRHS :: Token -> Parser TT (Exp TT)-pFunRHS equalSign =-  Bin <$> (pGuard equalSign <|> pEq equalSign) <*> pOpt (pWhere pFunDecl)--pWhere :: Parser TT (Exp TT) -> Parser TT (Exp TT)-pWhere p =-  PWhere <$> pAtom [Reserved Where] <*> please (pBlock p) <*> pMany pErr--- After a where there might "misaligned" code that do not "belong" to anything.--- Here we swallow it as errors.---- Note that this can both parse an equation and a type declaration.--- Since they can start with the same token, the left part is factored here.-pDecl :: Bool -> Bool -> Parser TT (Exp TT)-pDecl acceptType acceptEqu =-  Expr <$> ((Yuck $-               Enter "missing end of type or equation declaration" $ pure [])-            <|> ((:) <$> pElem False recognizedSometimes-                 <*> pToList (pDecl acceptType acceptEqu))-            <|> ((:) <$> pBareAtom [Special ',']-                 <*> pToList (pDecl acceptType False))-                 -- if a comma is found, then the rest must be a type-                 -- declaration.-            <|> (if acceptType then pTypeEnding else empty)-            <|> (if acceptEqu  then pEquEnding else empty))-    where pTypeEnding = (:) <$> (TS <$> exact [ReservedOp DoubleColon]-                                 <*> pTypeExpr') <*> pure []-          pEquEnding =  (:) <$> pFunRHS (ReservedOp Equal) <*> pure []--pFunDecl = pDecl True True-pTypeDecl = pDecl True False---pEquation = pDecl False True----- | The RHS of an equation.-pEq :: Token -> Parser TT (Exp TT)-pEq equalSign = RHS <$> pBareAtom [equalSign] <*> pExpr'---- | Parse many of something-pMany :: Parser TT (Exp TT) -> Parser TT (Exp TT)-pMany p = Expr <$> many p---- | Parse a some of something separated by the token (Special '.')-pBlocks :: Parser TT r -> Parser TT [r]-pBlocks p =  p `sepBy1` exact [nextLine]---- | Parse a some of something separated by the token (Special '.'), or nothing---pBlocks' :: Parser TT r -> Parser TT (BL.BList r)-pBlocks' p =  pBlocks p <|> pure []---- | Parse a block of some something separated by the tok (Special '.')-pBlockOf :: Parser TT (Exp TT) -> Parser TT (Exp TT)-pBlockOf p  = Block <$> pBlockOf' (pBlocks p) -- see HACK above---pBlock :: Parser TT (Exp TT) -> Parser TT (Exp TT)-pBlock p = pBlockOf' (Block <$> pBlocks' p)-       <|> pEBrace (p `sepBy1` exact [Special ';'] <|> pure [])-       <|> (Yuck $ Enter "block expected" pEmptyBL)---- | Parse something surrounded by (Special '<') and (Special '>')-pBlockOf' :: Parser TT a -> Parser TT a-pBlockOf' p = exact [startBlock] *> p <* exact [endBlock] -- see HACK above--- note that, by construction, '<' and '>' will always be matched, so--- we don't try to recover errors with them.---- | Parse something that can contain a data, type declaration or a class-pTopDecl :: Parser TT (Exp TT)-pTopDecl =    pFunDecl-          <|> pType-          <|> pData-          <|> pClass-          <|> pure emptyNode----- | A "normal" expression, where none of the following symbols are acceptable.-pExpr' = pExpr recognizedSometimes--recognizedSometimes = [ReservedOp DoubleDot,-                       Special ',',-                       ReservedOp Pipe,-                       ReservedOp Equal,-                       ReservedOp LeftArrow,-                       ReservedOp RightArrow,-                       ReservedOp DoubleRightArrow,-                       ReservedOp BackSlash,-                       ReservedOp DoubleColon-                      ]---- | Parse an expression, as a concatenation of elements.-pExpr :: [Token] -> Parser TT (Exp TT)-pExpr at = Expr <$> pExprOrPattern True at---- | Parse an expression, as a concatenation of elements.-pExprOrPattern :: Bool -> [Token] -> Parser TT [Exp TT]-pExprOrPattern isExpresssion at =-  pure []-  <|> ((:) <$> pElem isExpresssion at          <*> pExprOrPattern True at)-  <|> ((:) <$> (TS <$> exact [ReservedOp DoubleColon] <*> pTypeExpr')-       <*> pure [])-     -- TODO: not really correct: in (x :: X , y :: Z), all after the-     -- first :: will be a "type".--pPattern = pExprOrPattern False recognizedSometimes--pExprElem = pElem True---- | Parse an "element" of an expression or a pattern.--- "at" is a list of symbols that, if found, should be considered errors.-pElem :: Bool -> [Token] -> Parser TT (Exp TT)-pElem isExpresssion at =-  pCParen (pExprOrPattern isExpresssion-           -- might be a tuple, so accept commas as noise-           (recognizedSometimes \\ [Special ','])) pEmpty-  <|> pCBrack (pExprOrPattern isExpresssion-               (recognizedSometimes \\ [ ReservedOp DoubleDot, ReservedOp Pipe-                                       , ReservedOp LeftArrow-                                       , Special ','])) pEmpty -- list thing-  <|> pCBrace (many $ pElem isExpresssion-               -- record: TODO: improve-               (recognizedSometimes \\ [ ReservedOp Equal, Special ','-                                       , ReservedOp Pipe])) pEmpty-  <|> (Yuck $ Enter "incorrectly placed block" $-        -- no error token, but the previous keyword will be one. (of, where, ...)-         pBlockOf (pExpr recognizedSometimes))-  <|> (PError <$> recoverWith-       (sym $ flip elem $ isNoiseErr at) <*> errTok <*> pEmpty)-  <|> (PAtom <$> sym (`notElem` isNotNoise at) <*> pEmpty)-  <|> if isExpresssion then pLet <|> pDo <|> pOf <|> pLambda else empty-  -- TODO: support type expressions--pTypeExpr at = many (pTypeElem at)-pTypeExpr' = pTypeExpr (recognizedSometimes \\ [ReservedOp RightArrow,-                                                ReservedOp DoubleRightArrow])--pTypeElem :: [Token] -> Parser TT (Exp TT)-pTypeElem at-    = pCParen (pTypeExpr (recognizedSometimes-                          \\ [ ReservedOp RightArrow,-                              ReservedOp DoubleRightArrow,-                              -- might be a tuple, so accept commas as noise-                              Special ','])) pEmpty-  <|> pCBrack pTypeExpr' pEmpty-  <|> pCBrace pTypeExpr' pEmpty -- TODO: this is an error: mark as such.-  <|> (Yuck $ Enter "incorrectly placed block" $-         pBlockOf (pExpr recognizedSometimes))-  <|> (PError <$> recoverWith-       (sym $ flip elem $ isNoiseErr at) <*> errTok <*> pEmpty)-  <|> (PAtom <$> sym (`notElem` isNotNoise at) <*> pEmpty)---- | List of things that always should be parsed as errors-isNoiseErr :: [Token] -> [Token]-isNoiseErr r = recoverableSymbols ++ r--recoverableSymbols = recognizedSymbols \\ fmap Special "([{<>."--- We just don't recover opening symbols (only closing are "fixed").--- Layout symbols "<>." are never recovered, because layout is--- constructed correctly.---- | List of things that should not be parsed as noise-isNotNoise :: [Token] -> [Token]-isNotNoise r = recognizedSymbols ++ r---- | These symbols are always properly recognized, and therefore they--- should never be accepted as "noise" inside expressions.-recognizedSymbols =-    [ Reserved Let-    , Reserved In-    , Reserved Do-    , Reserved Of-    , Reserved Class-    , Reserved Instance-    , Reserved Deriving-    , Reserved Module-    , Reserved Import-    , Reserved Type-    , Reserved Data-    , Reserved NewType-    , Reserved Where] ++ fmap Special "()[]{}<>."---- | Parse parenthesis, brackets and braces containing--- an expression followed by possible comments-pCParen, pCBrace, pCBrack-       :: Parser TT [Exp TT] -> Parser TT [TT] -> Parser TT (Exp TT)--pCParen p c = Paren <$> pCAtom [Special '('] c-          <*> p <*> (recoverAtom <|> pCAtom [Special ')'] c)--pCBrace p c = Paren  <$> pCAtom [Special '{'] c-          <*> p <*> (recoverAtom <|> pCAtom [Special '}'] c)--pCBrack p c = Paren  <$>  pCAtom [Special '['] c-          <*> p <*> (recoverAtom <|> pCAtom [Special ']'] c)--pParen, pBrack :: Parser TT [Exp TT] -> Parser TT (Exp TT)--pParen = flip pCParen pComments----pBrace = flip pCBrace pComments--pBrack = flip pCBrack pComments---- pEBrace parse an opening brace, followed by zero comments--- then followed by an closing brace and some comments-pEBrace p = Paren  <$> pCAtom [Special '{'] pEmpty-        <*> p <*> (recoverAtom <|> pCAtom [Special '}'] pComments)---- | Create a special error token. (e.g. fill in where there is no--- correct token to parse) Note that the position of the token has to--- be correct for correct computation of node spans.-errTok = mkTok <$> curPos-   where curPos = tB <$> lookNext-         tB Nothing = maxBound-         tB (Just x) = tokBegin x-         mkTok p = Tok (Special '!') 0 (startPosn {posnOfs = p})
− src/library/Yi/Syntax/JavaScript.hs 
@@ -1,591 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFoldable #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Syntax.JavaScript--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Parser for the JavaScript language as described at--- <http://publications.lib.chalmers.se/records/fulltext/112284.pdf Dogan 2009>.------ The mode using this parser can be found at "Yi.Mode.JavaScript".--module Yi.Syntax.JavaScript where--import           Prelude hiding (elem,error,any,exp)-import           Control.Applicative hiding (Const)-import           Data.Data (Data)-import           Data.Monoid-import           Data.Foldable-import           Data.Typeable-import           Yi.Buffer.Basic (Point(..))-import           Yi.IncrementalParse (P, eof, symbol, recoverWith)-import           Yi.Lexer.Alex (Stroke, Tok(..), tokToSpan, tokFromT)-import           Yi.Lexer.JavaScript (TT, Token(..), Reserved(..), Operator(..),-                                      tokenToStyle, prefixOperators,-                                      infixOperators, postfixOperators )-import qualified Data.Text as T-import           Yi.Debug hiding (error)-import           Yi.String-import           Yi.Style (errorStyle, StyleName)-import           Yi.Syntax.Tree (IsTree(..), sepBy1, sepBy)---- * Data types, classes and instances---- | Instances of @Strokable@ are datatypes which can be syntax highlighted.-class Strokable a where-    toStrokes :: a -> Endo [Stroke]---- | Instances of @Failable@ can represent failure.  This is a useful class for---   future work, since then we can make stroking much easier.-class Failable f where-    stupid :: t -> f t-    hasFailed :: f t -> Bool--type BList a = [a]--type Tree t = BList (Statement t)--type Semicolon t = Maybe t--data Statement t = FunDecl t t (Parameters t) (Block t)-                 | VarDecl t (BList (VarDecAss t)) (Semicolon t)-                 | Return t (Maybe (Expr t)) (Semicolon t)-                 | While t (ParExpr t) (Block t)-                 | DoWhile t (Block t) t (ParExpr t) (Semicolon t)-                 | For t t (Expr t) (ForContent t) t (Block t)-                 | If t (ParExpr t) (Block t) (Maybe (Statement t))-                 | Else t (Block t)-                 | With t (ParExpr t) (Block t)-                 | Comm t-                 | Expr (Expr t) (Semicolon t)-                   deriving (Show, Data, Typeable, Foldable)--data Parameters t = Parameters t (BList t) t-                  | ParErr t-                    deriving (Show, Data, Typeable, Foldable)--data ParExpr t = ParExpr t (BList (Expr t)) t-               | ParExprErr t-                 deriving (Show, Data, Typeable, Foldable)--data ForContent t = ForNormal t (Expr t) t (Expr t)-                  | ForIn t (Expr t)-                  | ForErr t-                    deriving (Show, Data, Typeable, Foldable)--data Block t = Block t (BList (Statement t)) t-             | BlockOne (Statement t)-             | BlockErr t-               deriving (Show, Data, Typeable, Foldable)---- | Represents either a variable name or a variable name assigned to an---   expression.  @AssBeg@ is a variable name /maybe/ followed by an assignment.---   @AssRst@ is an equals sign and an expression.  @(AssBeg 'x' (Just (AssRst---   '=' '5')))@ means @x = 5@.-data VarDecAss t = AssBeg t (Maybe (VarDecAss t))-                 | AssRst t (Expr t)-                 | AssErr t-                   deriving (Show, Data, Typeable, Foldable)--data Expr t = ExprObj t (BList (KeyValue t)) t-            | ExprPrefix t (Expr t)-            | ExprNew t (Expr t)-            | ExprSimple t (Maybe (Expr t))-            | ExprParen t (Expr t) t (Maybe (Expr t))-            | ExprAnonFun t (Parameters t) (Block t)-            | ExprTypeOf t (Expr t)-            | ExprFunCall t (ParExpr t) (Maybe (Expr t))-            | OpExpr t (Expr t)-            | ExprCond t (Expr t) t (Expr t)-            | ExprArr t (Maybe (Array t)) t (Maybe (Expr t))-            | PostExpr t-            | ExprErr t-              deriving (Show, Data, Typeable, Foldable)--data Array t = ArrCont (Expr t) (Maybe (Array t))-             | ArrRest t (Array t) (Maybe (Array t))-             | ArrErr t-               deriving (Show, Data, Typeable, Foldable)--data KeyValue t = KeyValue t t (Expr t)-                | KeyValueErr t-                  deriving (Show, Data, Typeable, Foldable)---instance IsTree Statement where-    subtrees (FunDecl _ _ _ x) = fromBlock x-    subtrees (While _ _ x) = fromBlock x-    subtrees (DoWhile _ x _ _ _) = fromBlock x-    subtrees (For _ _ _ _ _ x) = fromBlock x-    subtrees (If _ _ x mb) = fromBlock x <> maybe [] subtrees mb-    subtrees (Else _ x) = fromBlock x-    subtrees (With _ _ x) = fromBlock x-    subtrees _ = []--instance Failable ForContent where-    stupid = ForErr-    hasFailed t = case t of-                    ForErr _ -> True-                    _        -> False--instance Failable Block where-    stupid = BlockErr-    hasFailed t = case t of-                    BlockErr _ -> True-                    _          -> False--instance Failable VarDecAss where-    stupid = AssErr-    hasFailed t = case t of-                    AssErr _ -> True-                    _        -> False--instance Failable Parameters where-    stupid = ParErr-    hasFailed t = case t of-                    ParErr _ -> True-                    _        -> False--instance Failable ParExpr where-    stupid = ParExprErr-    hasFailed t = case t of-                    ParExprErr _ -> True-                    _            -> False--instance Failable Expr where-    stupid = ExprErr-    hasFailed t = case t of-                    ExprErr _ -> True-                    _         -> False--instance Failable KeyValue where-    stupid = KeyValueErr-    hasFailed t = case t of-                    KeyValueErr _ -> True-                    _             -> False----- | TODO: This code is *screaming* for some generic programming.------   TODO: Somehow fix Failable and failStroker to be more "generic".  This will---   make these instances much nicer and we won't have to make ad-hoc stuff like---   this.-instance Strokable (Statement TT) where-    toStrokes (FunDecl f n ps blk) =-        let s = if hasFailed blk then error else failStroker [n] in-        s f <> s n <> toStrokes ps <> toStrokes blk-    toStrokes (VarDecl v vs sc) =-        let s = if any hasFailed vs then error else normal in-        s v <> foldMap toStrokes vs <> maybe mempty s sc-    toStrokes (Return t exp sc) = normal t <> maybe mempty toStrokes exp <> maybe mempty normal sc-    toStrokes (While w exp blk) =-        let s = if hasFailed blk || hasFailed blk then error else normal in-        s w <> toStrokes exp <> toStrokes blk-    toStrokes (DoWhile d blk w exp sc) =-        let s1 = if hasFailed blk then error else normal-            s2 = if hasFailed exp then error else normal in-        s1 d <> toStrokes blk <> s2 w <> toStrokes exp <> maybe mempty normal sc-    toStrokes (For f l x c r blk) =-        let s = if hasFailed blk || hasFailed c || hasFailed x-                  then error-                  else failStroker [f, l, r] in-        s f <> s l <> toStrokes x <> toStrokes c <> s r <> toStrokes blk-    toStrokes (If i x blk e) =-        let s = if hasFailed blk then error else normal in-        s i <> toStrokes x <> toStrokes blk <> maybe mempty toStrokes e-    toStrokes (Else e blk) = normal e <> toStrokes blk-    toStrokes (With w x blk) = normal w <> toStrokes x <> toStrokes blk-    toStrokes (Expr exp sc) = toStrokes exp <> maybe mempty normal sc-    toStrokes (Comm t) = normal t--instance Strokable (ForContent TT) where-    toStrokes (ForNormal s1 x2 s2 x3) =-        let s = if any hasFailed [x2, x3] then error else failStroker [s2] in-        s s1 <> toStrokes x2 <> s s2 <> toStrokes x3-    toStrokes (ForIn i x) =-        let s = if hasFailed x then error else normal in-        s i <> toStrokes x-    toStrokes (ForErr t) = error t--instance Strokable (Block TT) where-    toStrokes (BlockOne stmt) = toStrokes stmt-    toStrokes (Block l stmts r) =-        let s = failStroker [l, r] in-        s l <> foldMap toStrokes stmts <> s r-    toStrokes (BlockErr t) = error t--instance Strokable (VarDecAss TT) where-    toStrokes (AssBeg t x) = normal t <> maybe mempty toStrokes x-    toStrokes (AssRst t exp) =-        let s = if hasFailed exp then error else normal in-        s t <> toStrokes exp-    toStrokes (AssErr t) = error t--instance Strokable (Expr TT) where-    toStrokes (ExprSimple x exp) = normal x <> maybe mempty toStrokes exp-    toStrokes (ExprObj l kvs r) =-        let s = failStroker [l, r] in-        s l <> foldMap toStrokes kvs <> s r-    toStrokes (ExprPrefix t exp) = normal t <> toStrokes exp-    toStrokes (ExprNew t x) = normal t <> toStrokes x-    toStrokes (ExprParen l exp r op) =-        let s = failStroker [l, r] in-        s l <> toStrokes exp <> s r <> maybe mempty toStrokes op-    toStrokes (ExprAnonFun f ps blk) =-        normal f <> toStrokes ps <> toStrokes blk-    toStrokes (ExprTypeOf t x) =-        let s = if hasFailed x then error else normal in-        s t <> toStrokes x-    toStrokes (ExprFunCall n x m) =-        let s = if hasFailed x then error else normal in-        s n <> toStrokes x <> maybe mempty toStrokes m-    toStrokes (OpExpr op exp) =-        let s = if hasFailed exp then error else normal in-        s op <> toStrokes exp-    toStrokes (PostExpr t) = normal t-    toStrokes (ExprCond a x b y) =-        let s = failStroker [a, b] in-        s a <> toStrokes x <> s b <> toStrokes y-    toStrokes (ExprArr l x r m) =-        let s = failStroker [l, r] in-        s l <> maybe mempty toStrokes x <> s r <> maybe mempty toStrokes m-    toStrokes (ExprErr t) = error t--instance Strokable (Parameters TT) where-    toStrokes (Parameters l ps r) = normal l <> foldMap toStrokes ps <> normal r-    toStrokes (ParErr t) = error t--instance Strokable (ParExpr TT) where-    toStrokes (ParExpr l xs r) =-        let s = if isError r || any hasFailed xs-                  then error-                  else normal in-        s l <> foldMap toStrokes xs <> s r-    toStrokes (ParExprErr t) = error t--instance Strokable (KeyValue TT) where-    toStrokes (KeyValue n c exp) =-        let s = failStroker [n, c] in-        s n <> s c <> toStrokes exp-    toStrokes (KeyValueErr t) = error t--instance Strokable (Tok Token) where-    toStrokes t = if isError t-                      then one (modStroke errorStyle . tokenToStroke) t-                      else one tokenToStroke t--instance Strokable (Array TT) where-    toStrokes (ArrCont x m) = toStrokes x <> maybe mempty toStrokes m-    toStrokes (ArrRest c a m) = normal c <> toStrokes a <> maybe mempty toStrokes m-    toStrokes (ArrErr t) = error t----- * Helper functions.---- | Normal stroker.-normal :: TT -> Endo [Stroke]-normal = one tokenToStroke---- | Error stroker.-error :: TT -> Endo [Stroke]-error = one (modStroke errorStyle . tokenToStroke)--one :: (t -> a) -> t -> Endo [a]-one f x = Endo (f x :)---- | Given a new style and a stroke, return a stroke with the new style appended---   to the old one.-modStroke :: StyleName -> Stroke -> Stroke-modStroke style = fmap (style <>)----- * Stroking functions---- | Given a list of tokens to check for errors (@xs@) and a list of tokens to---   stroke (@xs'@), returns normal strokes for @xs'@ if there were no errors.---   Otherwise returns error strokes for @xs'@.-nError :: [TT] -> [TT] -> Endo [Stroke]-nError xs = foldMap (failStroker xs)---- | Given a list of @TT@, if any of them is an error, returns an error stroker,---   otherwise a normal stroker.  Using e.g. existentials, we could make this---   more general and have support for heterogeneous lists of elements which---   implement Failable, but I haven't had the time to fix this.-failStroker :: [TT] -> TT -> Endo [Stroke]-failStroker xs = if any isError xs then error else normal---- | Given a @TT@, return a @Stroke@ for it.-tokenToStroke :: TT -> Stroke-tokenToStroke = fmap tokenToStyle . tokToSpan---- | The main stroking function.-getStrokes :: Tree TT -> Point -> Point -> Point -> [Stroke]-getStrokes t0 _point _begin _end = trace ('\n' `T.cons` showT t0) result-    where-      result = appEndo (foldMap toStrokes t0) []----- * The parser---- | Main parser.-parse :: P TT (Tree TT)-parse = many statement <* eof---- | Parser for statements such as "return", "while", "do-while", "for", etc.-statement :: P TT (Statement TT)-statement = FunDecl <$> res Function' <*> plzTok name <*> parameters <*> block-        <|> VarDecl <$> res Var' <*> plz varDecAss `sepBy1` spc ',' <*> semicolon-        <|> Return  <$> res Return' <*> optional expression <*> semicolon-        <|> While   <$> res While' <*> parExpr <*> block-        <|> DoWhile <$> res Do' <*> block <*> plzTok (res While') <*> parExpr <*> semicolon-        <|> For     <$> res For' <*> plzSpc '(' <*> plzExpr <*> forContent-                    <*> plzSpc ')' <*> block-        <|> If      <$> res If' <*> parExpr <*> block <*> optional (Else <$> res Else' <*> block)-        <|> With    <$> res With' <*> parExpr <*> block-        <|> Comm    <$> comment-        <|> Expr    <$> stmtExpr <*> semicolon-    where-      forContent :: P TT (ForContent TT)-      forContent = ForNormal <$> spc ';' <*> plzExpr <*> plzSpc ';' <*> plzExpr-               <|> ForIn     <$> res In' <*> plzExpr-               <|> ForErr    <$> hate 1 (symbol (const True))-               <|> ForErr    <$> hate 2 (pure errorToken)-      varDecAss :: P TT (VarDecAss TT)-      varDecAss = AssBeg <$> name <*> optional (AssRst <$> oper Assign' <*> plzExpr)---- | Parser for "blocks", i.e. a bunch of statements wrapped in curly brackets---   /or/ just a single statement.------   Note that this works for JavaScript 1.8 "lambda" style function bodies as---   well, e.g. "function hello() 5", since expressions are also statements and---   we don't require a trailing semi-colon.------   TODO: function hello() var x; is not a valid program.-block :: P TT (Block TT)-block = Block    <$> spc '{' <*> many statement <*> plzSpc '}'-    <|> BlockOne <$> hate 1 statement-    <|> BlockErr <$> hate 2 (pure errorToken)---- | Parser for expressions which may be statements.  In reality, any expression---   is also a valid statement, but this is a slight compromise to get rid of---   the massive performance loss which is introduced when allowing JavaScript---   objects to be valid statements.-stmtExpr :: P TT (Expr TT)-stmtExpr = ExprSimple <$> simpleTok <*> optional opExpr-       <|> ExprPrefix <$> preOp <*> plzExpr-       <|> ExprNew    <$> res New' <*> plz funCall-       <|> funCall-       -- We hate the parenthesized expression just a tad because otherwise-       -- confirm('hello') will be seen as "confirm; ('hello');"-       <|> hate 1 (ExprParen  <$> spc '(' <*> plzExpr <*> plzSpc ')'-                              <*> optional opExpr)-       <|> ExprErr <$> hate 2 (symbol (const True))-    where-      funCall :: P TT (Expr TT)-      funCall = ExprFunCall <$> name <*> parExpr <*> optional opExpr---- | The basic idea here is to parse "the rest" of expressions, e.g. @+ 3@ in @x---   + 3@ or @[i]@ in @x[i]@.  Anything which is useful in such a scenario goes---   here.  TODO: This accepts [], but shouldn't, since x[] is invalid.-opExpr :: P TT (Expr TT)-opExpr = OpExpr   <$> inOp <*> plzExpr-     <|> ExprCond <$> spc '?' <*> plzExpr <*> plzSpc ':' <*> plzExpr-     <|> PostExpr <$> postOp-     <|> array---- | Parser for expressions.-expression :: P TT (Expr TT)-expression = ExprObj     <$> spc '{' <*> keyValue `sepBy` spc ',' <*> plzSpc '}'-         <|> ExprAnonFun <$> res Function' <*> parameters <*> block-         <|> ExprTypeOf  <$> res TypeOf' <*> plzExpr-         <|> stmtExpr-         <|> array-    where-      keyValue :: P TT (KeyValue TT)-      keyValue = KeyValue    <$> name <*> plzSpc ':' <*> plzExpr-             <|> KeyValueErr <$> hate 1 (symbol (const True))-             <|> KeyValueErr <$> hate 2 (pure errorToken)---- | Parses both empty and non-empty arrays.  Should probably be split up into---   further parts to allow for the separation of @[]@ and @[1, 2, 3]@.-array :: P TT (Expr TT)-array = ExprArr <$> spc '[' <*> optional arrayContents <*> plzSpc ']'-                <*> optional opExpr-    where-      arrayContents :: P TT (Array TT)-      arrayContents = ArrCont <$> expression <*> optional arrRest-      arrRest :: P TT (Array TT)-      arrRest = ArrRest <$> spc ',' <*> (arrayContents-                                     <|> ArrErr <$> hate 1 (symbol (const True))-                                     <|> ArrErr <$> hate 2 (pure errorToken))-                                    <*> optional arrRest----- * Parsing helpers---- | Parses a semicolon if it's there.-semicolon :: P TT (Maybe TT)-semicolon = optional $ spc ';'---- | Parses a comma-separated list of valid identifiers.-parameters :: P TT (Parameters TT)-parameters = Parameters <$> spc '(' <*> plzTok name `sepBy` spc ',' <*> plzSpc ')'-         <|> ParErr <$> hate 1 (symbol (const True))-         <|> ParErr <$> hate 2 (pure errorToken)--parExpr :: P TT (ParExpr TT)-parExpr = ParExpr <$> spc '(' <*> plzExpr `sepBy` spc ',' <*> plzSpc ')'-      <|> ParExprErr <$> hate 1 (symbol (const True))-      <|> ParExprErr <$> hate 2 (pure errorToken)----- * Simple parsers---- | Parses a comment.-comment :: P TT TT-comment = symbol (\t -> case fromTT t of-                          Comment _ -> True-                          _         -> False)---- | Parses a prefix operator.-preOp :: P TT TT-preOp = symbol (\t -> case fromTT t of-                        Op x -> x `elem` prefixOperators-                        _    -> False)---- | Parses a infix operator.-inOp :: P TT TT-inOp = symbol (\t -> case fromTT t of-                       Op x -> x `elem` infixOperators-                       _    -> False)---- | Parses a postfix operator.-postOp :: P TT TT-postOp = symbol (\t -> case fromTT t of-                         Op x -> x `elem` postfixOperators-                         _    -> False)---- | Parses any literal.-opTok :: P TT TT-opTok = symbol (\t -> case fromTT t of-                        Op _ -> True-                        _    -> False)---- | Parses any literal.-simpleTok :: P TT TT-simpleTok = symbol (\t -> case fromTT t of-            Str _       -> True-            Number _    -> True-            ValidName _ -> True-            Const _     -> True-            Rex _       -> True-            Res y       -> y `elem` [True', False', Undefined', Null', This']-            _           -> False)---- | Parses any string.-strTok :: P TT TT-strTok = symbol (\t -> case fromTT t of-                         Str _ -> True-                         _     -> False)---- | Parses any valid number.-numTok :: P TT TT-numTok = symbol (\t -> case fromTT t of-                         Number _ -> True-                         _        -> False)---- | Parses any valid identifier.-name :: P TT TT-name = symbol (\t -> case fromTT t of-                       ValidName _ -> True-                       Const     _ -> True-                       _           -> False)---- | Parses any boolean.-boolean :: P TT TT-boolean = symbol (\t -> case fromTT t of-                          Res y -> y `elem` [True', False']-                          _     -> False)---- | Parses a reserved word.-res :: Reserved -> P TT TT-res x = symbol (\t -> case fromTT t of-                        Res y -> x == y-                        _     -> False)---- | Parses a special token.-spc :: Char -> P TT TT-spc x = symbol (\t -> case fromTT t of-                        Special y -> x == y-                        _         -> False)---- | Parses an operator.-oper :: Operator -> P TT TT-oper x = symbol (\t -> case fromTT t of-                         Op y -> y == x-                         _    -> False)----- * Recovery parsers---- | Expects a token x, recovers with 'errorToken'.-plzTok :: P TT TT -> P TT TT-plzTok x = x-       <|> hate 1 (symbol (const True))-       <|> hate 2 (pure errorToken)---- | Expects a special token.-plzSpc :: Char -> P TT TT-plzSpc x = plzTok (spc x)---- | Expects an expression.-plzExpr :: P TT (Expr TT)-plzExpr = plz expression--plz :: Failable f => P TT (f TT) -> P TT (f TT)-plz x = x-    <|> stupid <$> hate 1 (symbol (const True))-    <|> stupid <$> hate 2 (pure errorToken)---- | General recovery parser, inserts an error token.-anything :: P s TT-anything = recoverWith (pure errorToken)---- | Weighted recovery.-hate :: Int -> P s a -> P s a-hate n = power n recoverWith-    where-      power 0 _ = id-      power m f = f . power (m - 1) f----- * Utility stuff--fromBlock :: Block t -> [Statement t]-fromBlock (Block _ x _) = toList x-fromBlock (BlockOne x) = [x]-fromBlock (BlockErr _) = []--firstTok :: Foldable f => f t -> t-firstTok x = head (toList x)--errorToken :: TT-errorToken = toTT $ Special '!'--isError :: TT -> Bool-isError (Tok (Special '!') _ _) = True-isError _ = False---- | Better name for 'tokFromT'.-toTT :: t -> Tok t-toTT = tokFromT---- | Better name for 'tokT'.-fromTT :: Tok t -> t-fromTT = tokT
− src/library/Yi/Syntax/Latex.hs 
@@ -1,154 +0,0 @@-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveFoldable #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- uniplate patterns-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Syntax.Latex--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Parser used by the LaTeX modes.--module Yi.Syntax.Latex where--import Control.Applicative-import Data.Foldable (Foldable, foldMap)-import Data.Monoid-import Data.Traversable-import Yi.IncrementalParse-import Yi.Lexer.Alex hiding (tokenToStyle)-import Yi.Lexer.Latex-import Yi.Style-import Yi.Syntax-import Yi.Syntax.Tree--isNoise :: Token -> Bool-isNoise Text = True-isNoise Comment = True-isNoise (Command _) = True-isNoise NewCommand = True-isNoise (Special ' ') = True-isNoise (Special _) = False-isNoise (Begin _) = False-isNoise (End _) = False--type TT = Tok Token--type Expr t = [Tree t]--data Tree t-    = Paren t (Tree t) t -- A parenthesized expression (maybe with [ ] ...)-    | Atom t-    | Error t-    | Expr (Expr t)-      deriving (Show, Functor, Foldable)---instance IsTree Tree where-    uniplate (Paren l g r) = ([g], \[g'] -> Paren l g' r)-    uniplate (Expr g) = (g, Expr)-    uniplate t = ([],const t)-    emptyNode = Expr []--parse :: P TT (Tree TT)-parse = pExpr True <* eof-    where-      -- Create a special character symbol-      newT c = tokFromT (Special c)-      -- errT = (\next -> case next of-      --     Nothing -> newT '!'-      --     Just (Tok {tokPosn = posn}) -> Tok { tokT = Special '!', tokPosn = posn-1, tokSize = 1 -- FIXME: size should be 1 char, not one byte!-      --                      }) <$> lookNext-      errT = pure (newT '!')-      -- parse a special symbol-      sym' p = symbol (p . tokT)-      sym t = sym' (== t)--      pleaseSym c = recoverWith errT <|> sym c-      -- pleaseSym' c = recoverWith errT <|> sym' c--      -- pExpr :: P TT [Expr TT]-      pExpr outsideMath = Expr <$> many (pTree outsideMath)--      parens = [(Special x, Special y) | (x,y) <- zip "({[" ")}]"]-      openParens = fmap fst parens--      pBlock = sym' isBegin >>= \beg@Tok {tokT = Begin env} -> Paren <$> pure beg <*> pExpr True <*> pleaseSym (End env)--      pTree :: Bool -> P TT (Tree TT)-      pTree outsideMath =-          (if outsideMath then pBlock <|> (Paren <$> sym (Special '$') <*> pExpr False <*> pleaseSym (Special '$'))-                           else empty)-          <|> foldr1 (<|>) [Paren <$> sym l <*> pExpr outsideMath <*> pleaseSym r | (l,r) <- parens]-          <|> (Atom <$> sym' isNoise)-          <|> (Error <$> recoverWith (sym' (not . ((||) <$> isNoise <*> (`elem` openParens)))))--getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]-getStrokes point _begin _end t0 = appEndo result []-    where getStrokes' :: Tree TT -> Endo [Stroke]-          getStrokes' (Expr g) = getStrokesL g-          getStrokes' (Atom t) = ts id t-          getStrokes' (Error t) = ts (modStroke errorStyle) t -- paint in red-          getStrokes' (Paren l g r)-              -- we have special treatment for (Begin, End) because these blocks are typically very large.-              -- we don't force the "end" part to prevent parsing the whole file.-              | isBegin (tokT l) = if posnOfs (tokPosn l) /= point-                  then normalPaint-                  else case (tokT l, tokT r) of-                         (Begin b, End e) | b == e -> hintPaint-                         _ -> errPaint-              | isErrorTok (tokT r) = errPaint-              -- left paren wasn't matched: paint it in red.-              -- note that testing this on the "Paren" node actually forces the parsing of the-              -- right paren, undermining online behaviour.-              | posnOfs (tokPosn l) == point || posnOfs (tokPosn r) == point - 1 = hintPaint-              | otherwise = normalPaint-              where normalPaint = ts id l <> getStrokes' g <> tsEnd id l r-                    hintPaint = ts (modStroke hintStyle) l <> getStrokes' g <> tsEnd (modStroke hintStyle) l r-                    errPaint = ts (modStroke errorStyle) l <> getStrokes' g--          tsEnd _ (Tok{tokT = Begin b}) t@(Tok{tokT = End e})-              | b /= e = ts (modStroke errorStyle) t-          tsEnd f _ t = ts f t-          getStrokesL :: Expr TT -> Endo [Stroke]-          getStrokesL = foldMap getStrokes'-          ts f t-              | isErrorTok (tokT t) = mempty-              | otherwise = Endo (f (tokenToStroke t) :)-          result = getStrokes' t0--modStroke :: StyleName -> Stroke -> Stroke-modStroke f = fmap (f `mappend`)--tokenToStroke :: TT -> Stroke-tokenToStroke = fmap tokenToStyle . tokToSpan--tokenToAnnot :: TT -> Maybe (Span String)-tokenToAnnot = sequenceA . tokToSpan . fmap tokenToText--tokenToStyle :: Token -> StyleName-tokenToStyle t =-  case t of-    Comment -> commentStyle-    Text -> defaultStyle-    Special _ -> defaultStyle-    Command _ -> typeStyle-    Begin _ -> keywordStyle-    End _ -> keywordStyle-    NewCommand -> keywordStyle--isSpecial :: [Char] -> Token -> Bool-isSpecial cs (Special c) = c `elem` cs-isSpecial _  _ = False--isBegin, isEnd :: Token -> Bool-isBegin (Begin _) = True-isBegin _ = False-isEnd (End _) = True-isEnd _ = False--isErrorTok :: Token -> Bool-isErrorTok = isSpecial "!"
− src/library/Yi/Syntax/Layout.hs 
@@ -1,145 +0,0 @@-{-# LANGUAGE PatternGuards, ScopedTypeVariables #-}--- Note: If the first line of the file has wrong indentation, some of the--- code might be left outside of the blocks-module Yi.Syntax.Layout (layoutHandler, State) where--import Yi.Syntax-import Yi.Lexer.Alex-import Data.Maybe (isJust)-import Data.List (find)--data BlockOpen t = Indent Int -- block opened because of indentation; parameter is the column of it.-                 | Paren t      -- block opened because of parentheses-                 deriving Show--isParen :: BlockOpen t -> Bool-isParen (Paren _) = True-isParen _ = False--data IState t = IState [BlockOpen t]  -- current block nesting-                     Bool   -- should we open a compound now ?-                     Int    -- last line number-  deriving Show-type State t lexState = (IState t, AlexState lexState)----- | Transform a scanner into a scanner that also adds opening,--- closing and "next" tokens to indicate layout.---- @isSpecial@ predicate indicates a token that starts a compound,--- like "where", "do", ...---- @isIgnore@ predicate indicates a token that is to be ignored for--- layout. (eg. pre-processor directive...)---- @parens@ is a list of couple of matching parenthesis-like tokens--- "()[]{}...".---layoutHandler :: forall t lexState. (Show t, Eq t) => (t -> Bool) -> [(t,t)] ->-            (Tok t -> Bool) ->-            (t,t,t) -> (Tok t -> Bool) ->-            Scanner (AlexState lexState) (Tok t) -> Scanner (State t lexState) (Tok t)-layoutHandler isSpecial parens isIgnored (openT, closeT, nextT) isGroupOpen lexSource = Scanner-  {-   scanLooked = scanLooked lexSource . snd,-   scanEmpty = error "layoutHandler: scanEmpty",-   scanInit = (IState [] True (-1), scanInit lexSource),-   scanRun  = \st -> let result = parse (fst st) (scanRun lexSource (snd st))-                     in --trace ("toks = " ++ show (fmap snd result)) $-                        result-  }-    where dummyAlexState = AlexState-              {-               stLexer = error "dummyAlexState: should not be reused for restart!",-               lookedOffset = maxBound, -- setting this to maxBound ensures nobody ever uses it.-               stPosn = startPosn-              }--          deepestIndent [] = -1-          deepestIndent (Indent i:_) = i-          deepestIndent (_:levs) = deepestIndent levs--          deepestParen _ [] = False-          deepestParen p (Paren t:levs) = p == t || deepestParen p levs-          deepestParen p (_:levs) = deepestParen p levs--          findParen f t = find ((== t) . f) parens--          parse :: IState t -> [(AlexState lexState, Tok t)] -> [(State t lexState, Tok t)]-          parse iSt@(IState levels doOpen lastLine)-                toks@((aSt, tok @ Tok {tokPosn = Posn _nextOfs line col}) : tokss)--            -- ignore this token-            | isIgnored tok-              = (st, tok) : parse (IState levels doOpen line) tokss--            -- start a compound if the rest of the line is empty then skip to it!-            | doOpen-              = if isGroupOpen tok -- check so that the do is not followed by a {-                  then parse (IState levels False lastLine) toks-                  else (st', tt openT) : parse (IState (Indent col : levels) False line) toks-                  -- if it's a block opening, we ignore the layout, and just let the "normal" rule-                  -- handle the creation of another level.--            -- close, or prepare to close, a paren block-            | Just (openTok,_) <- findParen snd $ tokT tok,-              deepestParen openTok levels--              = case levels of-                      Indent _:levs -> (st',tt closeT) : parse (IState levs False lastLine) toks-                      -- close an indent level inside the paren block-                      Paren openTok' :levs-                          | openTok == openTok' -> (st', tok) : parse (IState levs False line) tokss-                          | otherwise           ->              parse (IState levs False line) toks-                      -- close one level of nesting.-                      [] -> error $ "Parse: " ++ show iSt--            -- pop an indent block-            | col < deepestIndent levels-              = let (_lev:levs) = dropWhile isParen levels-                in (st', tt closeT) : parse (IState levs doOpen lastLine) toks-                  -- drop all paren levels inside the indent--            -- next item-            | line > lastLine &&-              col == deepestIndent levels-                = (st', tt nextT) : parse (IState (dropWhile isParen levels) doOpen line) toks-                  -- drop all paren levels inside the indent--            -- open a paren block-            | isJust $ findParen fst $ tokT tok-              = (st', tok) : parse (IState (Paren (tokT tok):levels) (isSpecial (tokT tok)) line) tokss-              -- important note: the the token can be both special and an opening. This is the case of the-              -- haskell 'let' (which is closed by 'in'). In that case the inner block is that of the indentation.--            -- prepare to open a compound-            | isSpecial (tokT tok)-                = (st', tok) : parse (IState levels True   line) tokss--            | otherwise-                = (st', tok) : parse (IState levels doOpen line) tokss-                  where st = (iSt, aSt)-                        st' = (iSt, aSt {lookedOffset = max peeked (lookedOffset aSt)})-                        tt t = Tok t 0 (tokPosn tok)-                        peeked = case tokss of-                                   [] -> maxBound-                                   (AlexState {lookedOffset = p},_):_ -> p-                        -- This function checked the position and kind of the-                        -- next token.  We peeked further, and so must-                        -- update the lookedOffset accordingly.--          -- finish by closing all the indent states.-          parse iSt@(IState (Indent _:levs) doOpen posn) []-              = ((iSt,dummyAlexState), Tok closeT 0 maxPosn) : parse (IState levs doOpen posn) []-          parse (IState (Paren _:levs) doOpen posn) []-              = parse (IState levs doOpen posn) []-          parse (IState [] _ _) [] = []---maxPosn :: Posn-maxPosn = Posn (-1) (-1) 0--- HACK! here we have collusion between using (-1) here and the parsing of--- OnlineTrees, which relies on the position of the last token to stop--- the parsing.-
− src/library/Yi/Syntax/OnlineTree.hs 
@@ -1,46 +0,0 @@-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- uniplate patterns-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Syntax.OnlineTree--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Module defining the 'Tree' used as part of many 'Mode's.--module Yi.Syntax.OnlineTree (Tree(..), manyToks,-                             tokAtOrBefore) where--import Control.Applicative-import Data.Foldable-import Data.Traversable-import Yi.IncrementalParse-import Yi.Lexer.Alex-import Yi.Syntax.Tree--data Tree a = Bin (Tree a) (Tree a)-            | Leaf a-            | Tip-              deriving (Show, Functor, Foldable, Traversable)--instance IsTree Tree where-    emptyNode = Tip-    uniplate (Bin l r) = ([l,r],\[l',r'] -> Bin l' r')-    uniplate t = ([],const t)--manyToks :: P (Tok t) (Tree (Tok t))-manyToks = manyToks' 1--manyToks' :: Int -> P a (Tree a)-manyToks' n = Look (pure Tip) (\_ -> Bin <$> subTree n <*> manyToks' (n * 2))--subTree :: Int -> P a (Tree a)-subTree n = Look (pure Tip) . const $ case n of-  0 -> pure Tip-  1 -> Leaf <$> symbol (const True)-  _ -> let m = n `div` 2 in Bin <$> subTree m <*> subTree m
− src/library/Yi/Syntax/Paren.hs 
@@ -1,172 +0,0 @@-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Syntax.Paren--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Parser for Haskell that only cares about parenthesis and layout.--module Yi.Syntax.Paren where--import Control.Applicative-import Data.Foldable-import Data.Maybe-import Data.Monoid-import Data.Traversable-import Prelude hiding (elem)-import Yi.IncrementalParse-import Yi.Lexer.Alex hiding (tokenToStyle)-import Yi.Lexer.Haskell-import Yi.Style (hintStyle, errorStyle, StyleName)-import Yi.Syntax-import Yi.Syntax.Layout-import Yi.Syntax.Tree--indentScanner :: Scanner (AlexState lexState) TT-              -> Scanner (Yi.Syntax.Layout.State Token lexState) TT-indentScanner = layoutHandler startsLayout [(Special '(', Special ')'),-                                            (Special '[', Special ']'),-                                            (Special '{', Special '}')] ignoredToken-                         (Special '<', Special '>', Special '.') isBrace---- HACK: We insert the Special '<', '>', '.', that don't occur in normal haskell--- parsing.--isBrace :: TT -> Bool-isBrace (Tok b _ _) = Special '{' == b--ignoredToken :: TT -> Bool-ignoredToken (Tok t _ _) = isComment t || t == CppDirective--isNoise :: Token -> Bool-isNoise (Special c) = c `elem` (";,`" :: String)-isNoise _ = True--type Expr t = [Tree t]--data Tree t-    = Paren t (Expr t) t -- A parenthesized expression (maybe with [ ] ...)-    | Block ([Tree t])      -- A list of things separated by layout (as in do; etc.)-    | Atom t-    | Error t-    | Expr [Tree t]-      deriving (Show, Foldable, Functor)--instance IsTree Tree where-    emptyNode = Expr []-    uniplate (Paren l g r) = (g,\g' -> Paren l g' r)-    uniplate (Expr g) = (g,Expr)-    uniplate (Block s) = (s,Block)-    uniplate t = ([],const t)---- | Search the given list, and return the 1st tree after the given--- point on the given line.  This is the tree that will be moved if--- something is inserted at the point.  Precondition: point is in the--- given line.---- TODO: this should be optimized by just giving the point of the end--- of the line-getIndentingSubtree :: Tree TT -> Point -> Int -> Maybe (Tree TT)-getIndentingSubtree root offset line =-    listToMaybe [t | (t,posn) <- takeWhile ((<= line) . posnLine . snd) allSubTreesPosn,-                -- it's very important that we do a linear search-                -- here (takeWhile), so that the tree is evaluated-                -- lazily and therefore parsing it can be lazy.-                posnOfs posn > offset, posnLine posn == line]-    where allSubTreesPosn = [(t',posn) | t'@(Block _) <-filter (not . null . toList) (getAllSubTrees root),-                             let (tok:_) = toList t',-                             let posn = tokPosn tok]---- | Given a tree, return (first offset, number of lines).-getSubtreeSpan :: Tree TT -> (Point, Int)-getSubtreeSpan tree = (posnOfs first, lastLine - firstLine)-    where bounds@[first, _last] = fmap (tokPosn . assertJust) [getFirstElement tree, getLastElement tree]-          [firstLine, lastLine] = fmap posnLine bounds-          assertJust (Just x) = x-          assertJust _ = error "assertJust: Just expected"---- dropWhile' f = foldMap (\x -> if f x then mempty else Endo (x :))------ isBefore l (Atom t) = isBefore' l t--- isBefore l (Error t) = isBefore l t--- isBefore l (Paren l g r) = isBefore l r--- isBefore l (Block s) = False------ isBefore' l (Tok {tokPosn = Posn {posnLn = l'}}) =---parse :: P TT (Tree TT)-parse = Expr <$> parse' tokT tokFromT--parse' :: (TT -> Token) -> (Token -> TT) -> P TT [Tree TT]-parse' toTok _ = pExpr <* eof-    where-      -- parse a special symbol-      sym c = symbol (isSpecial [c] . toTok)--      pleaseSym c = recoverWith errTok <|> sym c--      pExpr :: P TT (Expr TT)-      pExpr = many pTree--      pBlocks = (Expr <$> pExpr) `sepBy1` sym '.' -- the '.' is generated by the layout, see HACK above-      -- note that we can have empty statements, hence we use sepBy1.--      pTree :: P TT (Tree TT)-      pTree = (Paren  <$>  sym '(' <*> pExpr  <*> pleaseSym ')')-          <|> (Paren  <$>  sym '[' <*> pExpr  <*> pleaseSym ']')-          <|> (Paren  <$>  sym '{' <*> pExpr  <*> pleaseSym '}')--          <|> (Block <$> (sym '<' *> pBlocks <* sym '>')) -- see HACK above--          <|> (Atom <$> symbol (isNoise . toTok))-          <|> (Error <$> recoverWith (symbol (isSpecial "})]" . toTok)))--      -- note that, by construction, '<' and '>' will always be matched, so-      -- we don't try to recover errors with them.--getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]-getStrokes point _begin _end t0 = -- trace (show t0)-                                  result-    where getStrokes' (Atom t) = one (ts t)-          getStrokes' (Error t) = one (modStroke errorStyle (ts t)) -- paint in red-          getStrokes' (Block s) = getStrokesL s-          getStrokes' (Expr g) = getStrokesL g-          getStrokes' (Paren l g r)-              | isErrorTok $ tokT r = one (modStroke errorStyle (ts l)) <> getStrokesL g-              -- left paren wasn't matched: paint it in red.-              -- note that testing this on the "Paren" node actually forces the parsing of the-              -- right paren, undermining online behaviour.-              | posnOfs (tokPosn l) == point || posnOfs (tokPosn r) == point - 1-               = one (modStroke hintStyle (ts l)) <> getStrokesL g <> one (modStroke hintStyle (ts r))-              | otherwise  = one (ts l) <> getStrokesL g <> one (ts r)-          getStrokesL = foldMap getStrokes'-          ts = tokenToStroke-          result = appEndo (getStrokes' t0) []-          one x = Endo (x :)---tokenToStroke :: TT -> Stroke-tokenToStroke = fmap tokenToStyle . tokToSpan--modStroke :: StyleName -> Stroke -> Stroke-modStroke f = fmap (f `mappend`)--tokenToAnnot :: TT -> Maybe (Span String)-tokenToAnnot = sequenceA . tokToSpan . fmap tokenToText----- | Create a special error token. (e.g. fill in where there is no correct token to parse)--- Note that the position of the token has to be correct for correct computation of--- node spans.-errTok :: Parser (Tok t) (Tok Token)-errTok = mkTok <$> curPos-   where curPos = tB <$> lookNext-         tB Nothing = maxBound-         tB (Just x) = tokBegin x-         mkTok p = Tok (Special '!') 0 (startPosn {posnOfs = p})
− src/library/Yi/Syntax/Strokes/Haskell.hs 
@@ -1,156 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Syntax.Strokes.Haskell--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Produces 'Stroke's from a tree of tokens, used by some of the--- Haskell modes.--module Yi.Syntax.Strokes.Haskell (getStrokes, tokenToAnnot) where--import Data.Foldable hiding (elem)-import Data.Monoid-import Data.Traversable-import Prelude hiding (error,any,exp)-import Yi.Debug-import Yi.Lexer.Alex hiding (tokenToStyle)-import Yi.Lexer.Haskell-import Yi.Style-import Yi.Syntax-import Yi.Syntax.Haskell-import Yi.Syntax.Tree (subtrees)-import Yi.String (showT)---- TODO: (optimization) make sure we take in account the begin, so we--- don't return useless strokes-getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke]-getStrokes point begin _end t0 = trace (showT t0) result-    where result = appEndo (getStr tkDConst point begin _end t0) []---- | Get strokes Module for module-getStrokeMod :: Point -> Point -> Point -> PModuleDecl TT -> Endo [Stroke]-getStrokeMod point begin _end tm@(PModuleDecl m na e w)-    = pKW tm m <> getStr tkImport point begin _end na-   <> getStrokes' e <> getStrokes' w-        where getStrokes' = getStr tkDConst point begin _end-              pKW b word | isErrN b = paintAtom errorStyle word-                         | otherwise = getStrokes' word---- | Get strokes for Imports-getStrokeImp ::  Point -> Point -> Point -> PImport TT -> Endo [Stroke]-getStrokeImp point begin _end imp@(PImport m qu na t t')-    = pKW imp m <> paintQu qu-   <> getStr tkImport point begin _end na <> paintAs t  <> paintHi t'-    where getStrokes' = getStr tkDConst point begin _end-          paintAs (Opt (Just (Bin (PAtom n c) tw)))-              = one ((fmap (const keywordStyle) . tokToSpan) n) <> com c-             <> getStr tkImport point begin _end tw-          paintAs a = getStrokes' a-          paintQu (Opt (Just (PAtom n c))) = one ((fmap (const keywordStyle) . tokToSpan) n) <> com c-          paintQu a = getStrokes' a-          paintHi (TC (Bin (Bin (PAtom n c) tw) r)) = one ((fmap (const keywordStyle) . tokToSpan) n)-                                             <> com c <> getStr tkImport point begin _end tw-                                             <> getStrokes' r-          paintHi a = getStrokes' a-          pKW b word | isErrN b = paintAtom errorStyle word-                     | otherwise = getStrokes' word---- | Get strokes for expressions and declarations-getStr :: (TT -> Endo [Stroke]) -> Point -> Point -> Point -> Exp TT-          -> Endo [Stroke]-getStr tk point begin _end = getStrokes'-    where getStrokes' :: Exp TT -> Endo [Stroke]-          getStrokes' t@(PImport {}) = getStrokeImp point begin _end t-          getStrokes' t@(PModuleDecl {}) = getStrokeMod point begin _end t-          getStrokes' (PModule c m) = com c <> foldMap getStrokes' m-          getStrokes' (PAtom t c) = tk t <> com c-          getStrokes' (TS col ts') = tk col <> foldMap (getStr tkTConst point begin _end) ts'-          getStrokes' (Modid t c) = tkImport t <> com c-          getStrokes' (Paren (PAtom l c) g (PAtom r c'))-              | isErr r = errStyle l <> getStrokesL g-              -- left paren wasn't matched: paint it in red.-              -- note that testing this on the "Paren" node actually forces the parsing of the-              -- right paren, undermining online behaviour.-              | posnOfs (tokPosn l) ==-                    point || posnOfs (tokPosn r) == point - 1-               = pStyle hintStyle l <> com c <> getStrokesL g-                      <> pStyle hintStyle r <> com c'-              | otherwise  = tk l <> com c <> getStrokesL g-                                  <> tk r <> com c'-          getStrokes' (PError t _ c) = errStyle t <> com c-          getStrokes' da@(PData kw na exp eq)-               = pKW da kw <> getStrokes' na-              <> getStrokes' exp <> getStrokes' eq-          getStrokes' (PIn t l) = tk t <> getStrokesL l-          getStrokes' (TC l) = getStr tkTConst point begin _end l-          getStrokes' (DC (PAtom l c)) = tkDConst l <> com c-          getStrokes' (DC r) = getStrokes' r -- do not color operator dc-          getStrokes' g@(PGuard' t e t')-              = pKW g t <> getStrokes' e <> getStrokes' t'-          getStrokes' cl@(PClass e e' exp)-              = pKW cl e <> getStrokes' e'-             <> getStrokes' exp-          getStrokes' t = foldMap getStrokes' (subtrees t) -- by default deal with subtrees-          getStrokesL = foldMap getStrokes'-          pKW b word | isErrN b = paintAtom errorStyle word-                     | otherwise = getStrokes' word---- Stroke helpers follows--tokenToAnnot :: TT -> Maybe (Span String)-tokenToAnnot = sequenceA . tokToSpan . fmap tokenToText--ts :: TT -> Stroke-ts = tokenToStroke--pStyle :: StyleName -> TT -> Endo [Stroke]-pStyle style = one . modStroke style . ts--one :: Stroke -> Endo [Stroke]-one x = Endo (x :)--paintAtom :: StyleName -> Exp TT -> Endo [Stroke]-paintAtom col (PAtom a c) = pStyle col a <> com c-paintAtom _ _ = error "wrong usage of paintAtom"--isErr :: TT -> Bool-isErr = isErrorTok . tokT--isErrN :: (Foldable v) => v TT -> Bool-isErrN t = any isErr t---         || not $ null $ isError' t--errStyle :: TT -> Endo [Stroke]-errStyle = pStyle errorStyle--tokenToStroke :: TT -> Stroke-tokenToStroke = fmap tokenToStyle . tokToSpan--modStroke :: StyleName -> Stroke -> Stroke-modStroke f = fmap (f `mappend`)--com :: [TT] -> Endo [Stroke]-com = foldMap tkDConst--tk' :: (TT -> Bool) -> (TT -> Endo [Stroke]) -> TT -> Endo [Stroke]-tk' f s t | isErr t = errStyle t-          | tokT t `elem` fmap Reserved [As, Qualified, Hiding]-            = one $ (fmap (const variableStyle) . tokToSpan) t-          | f t = s t-          | otherwise = one (ts t)--tkTConst :: TT -> Endo [Stroke]-tkTConst = tk' (const False) (const (Endo id))---tkDConst :: TT -> Endo [Stroke]-tkDConst = tk' ((== ConsIdent) . tokT) (pStyle dataConstructorStyle)--tkImport :: TT -> Endo [Stroke]-tkImport = tk' ((== ConsIdent) . tokT) (pStyle importStyle)
− src/library/Yi/Syntax/Tree.hs 
@@ -1,421 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-- -- the CPP seems to confuse GHC; we have uniplate patterns-{-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-incomplete-patterns #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Syntax.Tree--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable---- Generic syntax tree handling functions-module Yi.Syntax.Tree (IsTree(..), toksAfter, allToks, tokAtOrBefore,-                       toksInRegion, sepBy, sepBy1,-                       getLastOffset, getFirstOffset,-                       getFirstElement, getLastElement,-                       getLastPath,-                       getAllSubTrees,-                       tokenBasedAnnots, tokenBasedStrokes,-                       subtreeRegion,-                       fromLeafToLeafAfter, fromNodeToFinal)-  where---- Some of this might be replaced by a generic package--- such as multirec, uniplace, emgm, ...--import           Control.Applicative-import           Control.Arrow (first)-import           Data.Foldable-import           Data.List.NonEmpty (NonEmpty(..))-import qualified Data.List.NonEmpty as NE-import           Data.Maybe-import           Data.Monoid-import           Prelude hiding (concatMap, error)-import           Yi.Buffer.Basic-import           Yi.Debug-import           Yi.Lexer.Alex-import           Yi.Region-import           Yi.String--#ifdef TESTING-import           Test.QuickCheck-import           Test.QuickCheck.Property (unProperty)-#endif---- Fundamental types-type Path = [Int]-type Node t = (Path, t)--class Foldable tree => IsTree tree where-    -- | Direct subtrees of a tree-    subtrees :: tree t -> [tree t]-    subtrees = fst . uniplate-    uniplate :: tree t -> ([tree t], [tree t] -> tree t)-    emptyNode :: tree t--toksAfter :: Foldable t1 => t -> t1 a -> [a]-toksAfter _begin = allToks--allToks :: Foldable t => t a -> [a]-allToks = toList--tokAtOrBefore :: Foldable t => Point -> t (Tok t1) -> Maybe (Tok t1)-tokAtOrBefore p res =-  listToMaybe $ reverse $ toksInRegion (mkRegion 0 (p+1)) res--toksInRegion :: Foldable t1 => Region -> t1 (Tok t) -> [Tok t]-toksInRegion reg = takeWhile (\t -> tokBegin t <= regionEnd   reg)-                   . dropWhile (\t -> tokEnd t < regionStart reg)-                   . toksAfter (regionStart reg)--tokenBasedAnnots :: (Foldable t1) => (a1 -> Maybe a) -> t1 a1 -> t -> [a]-tokenBasedAnnots tta t begin = catMaybes (tta <$> toksAfter begin t)--tokenBasedStrokes :: (Foldable t3) => (a -> b) -> t3 a -> t -> t2 -> t1 -> [b]-tokenBasedStrokes tts t _point begin _end = tts <$> toksAfter begin t---- | Prune the nodes before the given point.--- The path is used to know which nodes we can force or not.-pruneNodesBefore :: IsTree tree => Point -> Path -> tree (Tok a) -> tree (Tok a)-pruneNodesBefore _ [] t = t-pruneNodesBefore p (x:xs) t = rebuild $ left' <> (pruneNodesBefore p xs c : rs)-    where (children,rebuild) = uniplate t-          (left,c:rs) = splitAt x children-          left' = fmap replaceEmpty left-          replaceEmpty s = if getLastOffset s < p then emptyNode else s---- | Given an approximate path to a leaf at the end of the region,--- return: (path to leaf at the end of the region,path from focused--- node to the leaf, small node encompassing the region)-fromNodeToFinal :: IsTree tree => Region -> Node (tree (Tok a))-                -> Node (tree (Tok a))-fromNodeToFinal r (xs,root) =-    trace ("r = " <> showT r) $-    trace ("focused ~ " <> showT (subtreeRegion focused) ) $-    trace ("pathFromFocusedToLeaf = " <> showT focusedToLeaf) $-    trace ("pruned ~ " <> showT (subtreeRegion focused)) (xs', pruned)--    where n@(xs',_) = fromLeafToLeafAfter (regionEnd r) (xs,root)-          (_,(focusedToLeaf,focused)) = fromLeafAfterToFinal p0 n-          p0 = regionStart r-          pruned = pruneNodesBefore p0 focusedToLeaf focused---- | Return the first element that matches the predicate, or the last--- of the list if none matches.-firstThat :: (a -> Bool) -> NonEmpty a -> a-firstThat _ (x :| []) = x-firstThat p (x :| [y]) = if p x then x else y-firstThat p (x :| y : xs) = if p x then x else firstThat p (y :| xs)---- | Return the element before first element that violates the--- predicate, or the first of the list if that one violates the--- predicate.-lastThat :: (a -> Bool) -> NonEmpty a -> a-lastThat p (x :| xs) = if p x then work x xs else x-    where work x0 [] = x0-          work x0 (y:ys) = if p y then work y ys else x0---- | Given a path to a node, return a path+node which node that--- encompasses the given node + a point before it.-fromLeafAfterToFinal :: IsTree tree => Point -> Node (tree (Tok a))-                     -> (Path, Node (tree (Tok a)))-fromLeafAfterToFinal p n =-    -- trace ("reg = " <> showT (fmap (subtreeRegion . snd) nsPth)) $-      firstThat (\(_,(_,s)) -> getFirstOffset s <= p) ns-    where ns = NE.reverse (nodesOnPath n)---- | Search the tree in pre-order starting at a given node, until--- finding a leaf which is at or after the given point. An effort is--- also made to return a leaf as close as possible to @p@.------ TODO: rename to fromLeafToLeafAt-fromLeafToLeafAfter :: IsTree tree => Point-                    -> Node (tree (Tok a))-                    -> Node (tree (Tok a))-fromLeafToLeafAfter p (xs, root) =-  trace "fromLeafToLeafAfter:" $-  trace ("xs = " <> showT xs) $-  trace ("xsValid = " <> showT xsValid) $-  trace ("p = " <> showT p) $-  trace ("leafBeforeP = " <> showT leafBeforeP) $-  trace ("leaf ~ " <> showT (subtreeRegion leaf)) $-  trace ("xs' = " <> showT xs') result-  where-    xs' = case candidateLeaves of-      [] -> []-      c:cs -> fst $ firstOrLastThat (\(_,s) -> getFirstOffset s >= p) (c :| cs)-    candidateLeaves = allLeavesRelative relChild n-    (firstOrLastThat,relChild) = if leafBeforeP then (firstThat,afterChild)-                                                else (lastThat,beforeChild)-    (xsValid,leaf) = wkDown (xs,root)-    leafBeforeP = getFirstOffset leaf <= p-    n = (xsValid,root)-    result = (xs',root)--allLeavesRelative :: IsTree tree => (Int -> [(Int, tree a)] -> [(Int, tree a)])-                  -> Node (tree a)-                  -> [Node (tree a)]-allLeavesRelative select-   = filter (not . nullSubtree . snd) . allLeavesRelative' select-     . NE.toList . NE.reverse . nodesAndChildIndex-     -- we remove empty subtrees because their region is [0,0].---- | Takes a list of (node, index of already inspected child), and--- return all leaves in this node after the said child).-allLeavesRelative' :: IsTree tree => (Int -> [(Int, tree a)] -> [(Int, tree a)])-                   -> [(Node (tree a), Int)] -> [Node (tree a)]-allLeavesRelative' select l =-  [(xs <> xs', t') | ((xs,t),c) <- l-                   , (xs',t') <- allLeavesRelativeChild select c t]---- | Given a root, return all the nodes encountered along it, their--- paths, and the index of the child which comes next.-nodesAndChildIndex :: IsTree tree => Node (tree a)-                   -> NonEmpty (Node (tree a), Int)-nodesAndChildIndex ([],t) = return (([],t),negate 1)-nodesAndChildIndex (x:xs, t) = case index x (subtrees t) of-  Just c' -> (([],t), x)-             NE.<| fmap (first $ first (x:)) (nodesAndChildIndex (xs,c'))-  Nothing -> return (([],t),negate 1)--nodesOnPath :: IsTree tree => Node (tree a) -> NonEmpty (Path, Node (tree a))-nodesOnPath ([],t) = return ([],([],t))-nodesOnPath (x:xs,t) = ([],(x:xs,t)) NE.<| case index x (subtrees t) of-  Nothing -> error "nodesOnPath: non-existent path"-  Just c -> fmap (first (x:)) (nodesOnPath (xs,c))---beforeChild :: Int -> [a] -> [a]--beforeChild (-1) = reverse -- (-1) indicates that all children should be taken.-beforeChild c = reverse . take (c-1)--afterChild :: Int -> [a] -> [a]-afterChild c = drop (c+1)---- | Return all leaves after or before child depending on the relation--- which is given.-allLeavesRelativeChild :: IsTree tree => (Int -> [(Int, tree a)]-                                          -> [(Int, tree a)])-                       -> Int-                       -> tree a -> [Node (tree a)]-allLeavesRelativeChild select c t-  | null ts = return ([], t)-  | otherwise = [(x:xs,t') | (x,ct) <- select c (zip [0..] ts),-                 (xs, t') <- allLeavesIn select ct]- where ts = subtrees t----- | Return all leaves (with paths) inside a given root.-allLeavesIn :: (IsTree tree) => (Int -> [(Int, tree a)] -> [(Int, tree a)])-            -> tree a -> [Node (tree a)]-allLeavesIn select = allLeavesRelativeChild select (-1)---- | Return all subtrees in a tree; each element of the return list--- contains paths to nodes. (Root is at the start of each path)-getAllPaths :: IsTree tree => tree t -> [[tree t]]-getAllPaths t = fmap (<>[t]) ([] : concatMap getAllPaths (subtrees t))--goDown :: IsTree tree => Int -> tree t -> Maybe (tree t)-goDown i = index i . subtrees--index :: Int -> [a] -> Maybe a-index _ [] = Nothing-index 0 (h:_) = Just h-index n (_:t) = index (n-1) t--walkDown :: IsTree tree => Node (tree t) -> Maybe (tree t)-walkDown ([],t) = return t-walkDown (x:xs,t) = goDown x t >>= curry walkDown xs--wkDown :: IsTree tree => Node (tree a) -> Node (tree a)-wkDown ([],t) = ([],t)-wkDown (x:xs,t) = case goDown x t of-    Nothing -> ([],t)-    Just t' -> first (x:) $ wkDown (xs,t')---- | Search the given list, and return the last tree before the given--- point; with path to the root. (Root is at the start of the path)-getLastPath :: IsTree tree => [tree (Tok t)] -> Point -> Maybe [tree (Tok t)]-getLastPath roots offset =-    case takeWhile ((< offset) . posnOfs . snd) allSubPathPosn of-      [] -> Nothing-      xs -> Just $ fst $ last xs-    where-      allSubPathPosn = [ (p,posn) | root <- roots-                                  , p@(t':_) <- getAllPaths root-                                  , Just tok <- [getFirstElement t']-                                  , let posn = tokPosn tok-                                  ]---- | Return all subtrees in a tree, in preorder.-getAllSubTrees :: IsTree tree => tree t -> [tree t]-getAllSubTrees t = t : concatMap getAllSubTrees (subtrees t)---- | Return the 1st token of a subtree.-getFirstElement :: Foldable t => t a -> Maybe a-getFirstElement tree = getFirst $ foldMap (First . Just) tree--nullSubtree :: Foldable t => t a -> Bool-nullSubtree = null . toList--getFirstTok, getLastTok :: Foldable t => t a -> Maybe a--getFirstTok = getFirstElement-getLastTok = getLastElement---- | Return the last token of a subtree.-getLastElement :: Foldable t => t a -> Maybe a-getLastElement tree = getLast $ foldMap (Last . Just) tree--getFirstOffset, getLastOffset :: Foldable t => t (Tok t1) -> Point-getFirstOffset = maybe 0 tokBegin . getFirstTok-getLastOffset = maybe 0 tokEnd . getLastTok--subtreeRegion :: Foldable t => t (Tok t1) -> Region-subtreeRegion t = mkRegion (getFirstOffset t) (getLastOffset t)---- | Given a tree, return (first offset, number of lines).-getSubtreeSpan :: (Foldable tree) => tree (Tok t) -> (Point, Int)-getSubtreeSpan tree = (posnOfs firstOff, lastLine - firstLine)-    where bounds@[firstOff, _last] = fmap (tokPosn . assertJust)-                                     [getFirstElement tree, getLastElement tree]-          [firstLine, lastLine] = fmap posnLine bounds-          assertJust (Just x) = x-          assertJust _ = error "assertJust: Just expected"------------------------------------------ Should be in Control.Applicative.?--sepBy :: (Alternative f) => f a -> f v -> f [a]-sepBy p s   = sepBy1 p s <|> pure []--sepBy1 :: (Alternative f) => f a -> f v -> f [a]-sepBy1 p s  = (:) <$> p <*> many (s *> p)---------------------------------------------------------- Testing code.--#ifdef TESTING--nodeRegion :: IsTree tree => Node (tree (Tok a)) -> Region-nodeRegion n = subtreeRegion t-    where Just t = walkDown n--data Test a = Empty | Leaf a | Bin (Test a) (Test a) deriving (Show, Eq, Foldable)--instance IsTree Test where-    uniplate (Bin l r) = ([l,r],\[l',r'] -> Bin l' r')-    uniplate t = ([],\[] -> t)-    emptyNode = Empty--type TT = Tok ()--instance Arbitrary (Test TT) where-    arbitrary = sized $ \size -> do-      arbitraryFromList [1..size+1]-    shrink (Leaf _) = []-    shrink (Bin l r) = [l,r] <>  (Bin <$> shrink l <*> pure r) <>  (Bin <$> pure l <*> shrink r)--tAt :: Point -> TT-tAt idx =  Tok () 1 (Posn (idx * 2) 0 0)--arbitraryFromList :: [Int] -> Gen (Test TT)-arbitraryFromList [] = error "arbitraryFromList expects non empty lists"-arbitraryFromList [x] = pure (Leaf (tAt (fromIntegral x)))-arbitraryFromList xs = do-  m <- choose (1,length xs - 1)-  let (l,r) = splitAt m xs-  Bin <$> arbitraryFromList l <*> arbitraryFromList r--newtype NTTT = N (Node (Test TT)) deriving Show--instance Arbitrary NTTT where-    arbitrary = do-      t <- arbitrary-      p <- arbitraryPath t-      return $ N (p,t)--arbitraryPath :: Test t -> Gen Path-arbitraryPath (Leaf _) = return []-arbitraryPath (Bin l r) = do-  c <- choose (0,1)-  let Just n' = index c [l,r]-  (c :) <$> arbitraryPath n'--regionInside :: Region -> Gen Region-regionInside r = do-  b :: Int <- choose (fromIntegral $ regionStart r, fromIntegral $ regionEnd r)-  e :: Int <- choose (b, fromIntegral $ regionEnd r)-  return $ mkRegion (fromIntegral b) (fromIntegral e)--pointInside :: Region -> Gen Point-pointInside r = do-  p :: Int <- choose (fromIntegral $ regionStart r, fromIntegral $ regionEnd r)-  return (fromIntegral p)--prop_fromLeafAfterToFinal :: NTTT -> Property-prop_fromLeafAfterToFinal (N n) = let-    fullRegion = subtreeRegion $ snd n- in forAll (pointInside fullRegion) $ \p -> do-   let final@(_, (_, finalSubtree)) = fromLeafAfterToFinal p n-       finalRegion = subtreeRegion finalSubtree-       initialRegion = nodeRegion n--   whenFail (do putStrLn $ "final = " <> show final-                putStrLn $ "final reg = " <> show finalRegion-                putStrLn $ "initialReg = " <> show initialRegion-                putStrLn $ "p = " <> show p-            )-     ((regionStart finalRegion <= p) && (initialRegion `includedRegion` finalRegion))--prop_allLeavesAfter :: NTTT -> Property-prop_allLeavesAfter (N n@(xs,t)) = property $ do-  let after = allLeavesRelative afterChild n-  (xs',t') <- elements after-  let t'' = walkDown (xs',t)-  unProperty $ whenFail (do-      putStrLn $ "t' = " <> show t'-      putStrLn $ "t'' = " <> show t''-      putStrLn $ "xs' = " <> show xs'-    ) (Just t' == t'' && xs <= xs')--prop_allLeavesBefore :: NTTT -> Property-prop_allLeavesBefore (N n@(xs,t)) = property $ do-  let after = allLeavesRelative beforeChild n-  (xs',t') <- elements after-  let t'' = walkDown (xs',t)-  unProperty $ whenFail (do-      putStrLn $ "t' = " <> show t'-      putStrLn $ "t'' = " <> show t''-      putStrLn $ "xs' = " <> show xs'-    ) (Just t' == t'' && xs' <= xs)--prop_fromNodeToLeafAfter :: NTTT -> Property-prop_fromNodeToLeafAfter (N n) = forAll (pointInside (subtreeRegion $ snd n)) $ \p -> do-   let after = fromLeafToLeafAfter p n-       afterRegion = nodeRegion after-   whenFail (do putStrLn $ "after = " <> show after-                putStrLn $ "after reg = " <> show afterRegion-            )-     (regionStart afterRegion >= p)--prop_fromNodeToFinal :: NTTT -> Property-prop_fromNodeToFinal  (N t) = forAll (regionInside (subtreeRegion $ snd t)) $ \r -> do-   let final@(_, finalSubtree) = fromNodeToFinal r t-       finalRegion = subtreeRegion finalSubtree-   whenFail (do putStrLn $ "final = " <> show final-                putStrLn $ "final reg = " <> show finalRegion-                putStrLn $ "leaf after = " <> show (fromLeafToLeafAfter (regionEnd r) t)-            ) $ do-     r `includedRegion` finalRegion--#endif
− src/library/Yi/Tab.hs 
@@ -1,114 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE Rank2Types #-}--module Yi.Tab- (-  Tab,-  TabRef,-  tabWindowsA,-  tabLayoutManagerA,-  tabDividerPositionA,-  tkey,-  tabMiniWindows,-  tabFocus,-  forceTab,-  mapWindows,-  tabLayout,-  tabFoldl,-  makeTab,-  makeTab1,- )  where--import Prelude hiding (foldr, foldl)-import Control.Lens-import qualified Data.Binary as Binary-import Data.Default-import Data.Typeable-import Data.Foldable-import qualified Data.List.PointedList as PL-import Control.Applicative--import Yi.Buffer.Basic(WindowRef)-import Yi.Layout-import Yi.Window--type TabRef = Int---- | A tab, containing a collection of windows.-data Tab = Tab {-  tkey             :: !TabRef,                  -- ^ For UI sync; fixes #304-  tabWindows       :: !(PL.PointedList Window), -- ^ Visible windows-  tabLayout        :: !(Layout WindowRef),      -- ^ Current layout. Invariant: must be the layout generated by 'tabLayoutManager', up to changing the 'divPos's.-  tabLayoutManager :: !AnyLayoutManager -- ^ layout manager (for regenerating the layout when we add/remove windows)-  }- deriving Typeable--tabFocus :: Tab -> Window-tabFocus = PL._focus . tabWindows---- | Returns a list of all mini windows associated with the given tab-tabMiniWindows :: Tab -> [Window]-tabMiniWindows = Prelude.filter isMini . toList . tabWindows---- | Accessor for the windows. If the windows (but not the focus) have changed when setting, then a relayout will be triggered to preserve the internal invariant.-tabWindowsA :: Functor f =>-    (PL.PointedList Window -> f (PL.PointedList Window)) -> Tab -> f Tab-tabWindowsA f s = (`setter` s) <$> f (getter s)-  where-    setter ws t = relayoutIf (toList ws /= toList (tabWindows t)) (t { tabWindows = ws})-    getter = tabWindows---- | Accessor for the layout manager. When setting, will trigger a relayout if the layout manager has changed.-tabLayoutManagerA :: Functor f =>-    (AnyLayoutManager -> f AnyLayoutManager) -> Tab -> f Tab-tabLayoutManagerA f s = (`setter` s) <$> f (getter s)-  where-    setter lm t = relayoutIf (lm /= tabLayoutManager t) (t { tabLayoutManager = lm })-    getter = tabLayoutManager---- | Gets / sets the position of the divider with the given reference. The caller must ensure that the DividerRef is valid, otherwise an error will (might!) occur.-tabDividerPositionA :: DividerRef -> Lens' Tab DividerPosition-tabDividerPositionA ref = lens tabLayout (\ t l -> t{tabLayout = l}) . dividerPositionA ref--relayoutIf :: Bool -> Tab -> Tab-relayoutIf False t = t-relayoutIf True t = relayout t--relayout :: Tab -> Tab-relayout t = t { tabLayout = buildLayout (tabWindows t) (tabLayoutManager t) (tabLayout t) }--instance Binary.Binary Tab where-  put (Tab tk ws _ _) = Binary.put tk >> Binary.put ws-  get = makeTab <$> Binary.get <*> Binary.get----- | Equality on tab identity (the 'tkey')-instance Eq Tab where-  (==) t1 t2 = tkey t1 == tkey t2--instance Show Tab where-  show t = "Tab " ++ show (tkey t)---- | A specialised version of "fmap".-mapWindows :: (Window -> Window) -> Tab -> Tab-mapWindows f = over tabWindowsA (fmap f)---- | Forces all windows in the tab-forceTab :: Tab -> Tab-forceTab t = foldr seq t (t ^. tabWindowsA)---- | Folds over the windows in the tab-tabFoldl :: (a -> Window -> a) -> a -> Tab -> a-tabFoldl f z t = foldl f z (t ^. tabWindowsA)---- | Run the layout on the given tab, for the given aspect ratio-buildLayout :: PL.PointedList Window -> AnyLayoutManager -> Layout WindowRef -> Layout WindowRef-buildLayout ws m l = pureLayout m l . fmap wkey . Prelude.filter (not . isMini) . toList $ ws---- | Make a tab from multiple windows-makeTab :: TabRef -> PL.PointedList Window -> Tab-makeTab key ws = Tab key ws (buildLayout ws def def) def---- | Make a tab from one window-makeTab1 :: TabRef -> Window -> Tab-makeTab1 key win = makeTab key (PL.singleton win)
− src/library/Yi/Tag.hs 
@@ -1,178 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Tag--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ A module for CTags integration. Note that this reads the ‘tags’--- file produced by @hasktags@, not the ‘TAGS’ file which uses a--- different format (etags).--module Yi.Tag ( lookupTag-              , importTagTable-              , hintTags-              , completeTag-              , Tag(..)-              , mkTag-              , unTag'-              , TagTable(..)-              , getTags-              , setTags-              , resetTags-              , getTagsFileList-              , setTagsFileList-              ) where--import           Control.Applicative-import           Data.Binary-import qualified Data.ByteString as BS-import qualified Data.ByteString.UTF8 as BS8-#if __GLASGOW_HASKELL__ < 708-import           Data.DeriveTH-#else-import           GHC.Generics (Generic)-#endif-import           Data.Default-import           Data.List (isPrefixOf)-import           Data.List.Split (splitOn)-import           Data.Map (Map, fromList, lookup, keys)-import           Data.Maybe (mapMaybe)-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import qualified Data.Trie as Trie-import           Data.Typeable-import           System.FilePath (takeFileName, takeDirectory, (</>))-import           System.FriendlyPath-import           Yi.Editor-import           Yi.Types (YiVariable)---newtype Tags  = Tags (Maybe TagTable) deriving Typeable-instance Default Tags where-    def = Tags Nothing--newtype TagsFileList  = TagsFileList [FilePath] deriving Typeable-instance Default TagsFileList where-    def = TagsFileList ["tags"]--newtype Tag = Tag { _unTag :: T.Text } deriving (Show, Eq, Ord)---- | Helper-mkTag :: String -> Tag-mkTag = Tag . T.pack--unTag' :: Tag -> String-unTag' = T.unpack . _unTag--instance Binary Tag where-  put (Tag t) = put (E.encodeUtf8 t)-  get = Tag . E.decodeUtf8 <$> get--data TagTable = TagTable { tagFileName :: FilePath-                           -- ^ local name of the tag file-                           -- TODO: reload if this file is changed-                           , tagBaseDir :: FilePath-                           -- ^ path to the tag file directory-                           -- tags are relative to this path-                           , tagFileMap :: Map Tag (FilePath, Int)-                           -- ^ map from tags to files-                           , tagTrie :: Trie.Trie-                           -- ^ trie to speed up tag hinting-                         } deriving Typeable---- | Find the location of a tag using the tag table.--- Returns a full path and line number-lookupTag :: Tag -> TagTable -> Maybe (FilePath, Int)-lookupTag tag tagTable = do-  (file, line) <- Data.Map.lookup tag $ tagFileMap tagTable-  return (tagBaseDir tagTable </> file, line)---- | Super simple parsing CTag format 1 parsing algorithm--- TODO: support search patterns in addition to lineno-readCTags :: String -> Map Tag (FilePath, Int)-readCTags =-    fromList . mapMaybe (parseTagLine . words) . lines-    where parseTagLine (tag:tagfile:lineno:_) =-              -- remove ctag control lines-              if "!_TAG_" `isPrefixOf` tag then Nothing-              else Just (mkTag tag, (tagfile, fst . head . reads $ lineno))-          parseTagLine _ = Nothing---- | Read in a tag file from the system-importTagTable :: FilePath -> IO TagTable-importTagTable filename = do-  friendlyName <-  expandTilda filename-  tagStr <- fmap BS8.toString $ BS.readFile friendlyName-  let cts = readCTags tagStr-  return TagTable { tagFileName = takeFileName filename-                  , tagBaseDir  = takeDirectory filename-                  , tagFileMap  = cts-                    -- TODO either change word-trie to use Text or-                    -- figure out a better way all together for this-                  , tagTrie = Trie.fromList . map (T.unpack . _unTag) $ keys cts-                  }---- | Gives all the possible expanded tags that could match a given @prefix@-hintTags :: TagTable -> T.Text -> [T.Text]-hintTags tags prefix = map (T.append prefix . T.pack) sufs-  where-    sufs = Trie.possibleSuffixes (T.unpack prefix) $ tagTrie tags---- | Extends the string to the longest certain length-completeTag :: TagTable -> T.Text -> T.Text-completeTag tags prefix =-  prefix `T.append` T.pack (Trie.certainSuffix (T.unpack prefix) (tagTrie tags))----- ------------------------------------------------------------------------ Direct access interface to TagTable.---- | Set a new TagTable-setTags :: TagTable -> EditorM ()-setTags = putEditorDyn . Tags . Just---- | Reset the TagTable-resetTags :: EditorM ()-resetTags = putEditorDyn $ Tags Nothing---- | Get the currently registered tag table-getTags :: EditorM (Maybe TagTable)-getTags = do-  Tags t <- getEditorDyn-  return t--setTagsFileList :: String -> EditorM ()-setTagsFileList fps = do-  resetTags-  putEditorDyn $ TagsFileList (splitOn "," fps)--getTagsFileList :: EditorM [FilePath]-getTagsFileList = do-  TagsFileList fps <- getEditorDyn-  return fps--#if __GLASGOW_HASKELL__ < 708-$(derive makeBinary ''Tags)-$(derive makeBinary ''TagTable)-$(derive makeBinary ''TagsFileList)-#else-deriving instance Generic Tags-deriving instance Generic TagTable-deriving instance Generic TagsFileList-instance Binary Tags-instance Binary TagTable-instance Binary TagsFileList-#endif--instance YiVariable Tags--instance YiVariable TagsFileList
− src/library/Yi/TextCompletion.hs 
@@ -1,212 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.TextCompletion--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Module providing text completion functions.--module Yi.TextCompletion (-        -- * Word completion-        wordComplete,-        wordComplete',-        wordCompleteString,-        wordCompleteString',-        mkWordComplete,-        resetComplete,-        completeWordB,-        CompletionScope(..)-) where--import           Control.Applicative-import           Control.Monad-import           Data.Binary-import           Data.Char-import           Data.Default-import           Data.Function (on)-import           Data.List (findIndex)-import           Data.List.NonEmpty (NonEmpty(..))-import           Data.Maybe-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import           Data.Typeable-import           Yi.Buffer-import           Yi.Completion-import           Yi.Types (YiVariable)-import           Yi.Editor-import           Yi.Keymap-import qualified Yi.Rope as R-import           Yi.Utils---- ------------------------------------------------------------------------ | Word completion------ when doing keyword completion, we need to keep track of the word--- we're trying to complete.---newtype Completion = Completion-      [T.Text] -- the list of all possible things we can complete to.-               -- (this seems very inefficient; but we use laziness to-               -- our advantage)-    deriving (Typeable, Show, Eq)--instance Binary Completion where-  put (Completion ts) = put (E.encodeUtf8 <$> ts)-  get = Completion . map E.decodeUtf8 <$> get---- TODO: put this in keymap state instead-instance Default Completion where-    def = Completion []--instance YiVariable Completion---- | Switch out of completion mode.-resetComplete :: EditorM ()-resetComplete = putEditorDyn (Completion [])---- | Try to complete the current word with occurences found elsewhere in the--- editor. Further calls try other options.-mkWordComplete :: YiM T.Text -- ^ Extract function-               -> (T.Text -> YiM [T.Text]) -- ^ Source function-               -> ([T.Text] -> YiM ()) -- ^ Message function-               -> (T.Text -> T.Text -> Bool) -- ^ Predicate matcher-               -> YiM T.Text-mkWordComplete extractFn sourceFn msgFn predMatch = do-  Completion complList <- withEditor getEditorDyn-  case complList of-    (x:xs) -> do -- more alternatives, use them.-       msgFn (x:xs)-       withEditor . putEditorDyn $ Completion xs-       return x-    [] -> do -- no alternatives, build them.-      w <- extractFn-      ws <- sourceFn w-      let comps = nubSet (filter (matches w) ws) ++ [w]-      putEditorDyn $ Completion comps-      -- We put 'w' back at the end so we go back to it after seeing-      -- all possibilities.--      -- to pick the 1st possibility.-      mkWordComplete extractFn sourceFn msgFn predMatch--  where matches x y = x `predMatch` y && x/=y--wordCompleteString' :: Bool -> YiM T.Text-wordCompleteString' caseSensitive =-  mkWordComplete (withCurrentBuffer $-                   textRegion =<< regionOfPartB unitWord Backward)-                 (\_ -> withEditor wordsForCompletion)-                 (\_ -> return ())-                 (mkIsPrefixOf caseSensitive)-  where-    textRegion = fmap R.toText . readRegionB--wordCompleteString :: YiM T.Text-wordCompleteString = wordCompleteString' True--wordComplete' :: Bool -> YiM ()-wordComplete' caseSensitive = do-  x <- R.fromText <$> wordCompleteString' caseSensitive-  withEditor $ withCurrentBuffer $-    flip replaceRegionB x =<< regionOfPartB unitWord Backward--wordComplete :: YiM ()-wordComplete = wordComplete' True--------------------------------- Alternative Word Completion--{--  'completeWordB' is an alternative to 'wordCompleteB'.--  'completeWordB' offers a slightly different interface. The user-  completes the word using the mini-buffer in the same way a user-  completes a buffer or file name when switching buffers or opening a-  file. This means that it never guesses and completes only as much as-  it can without guessing.--  I think there is room for both approaches. The 'wordCompleteB' approach-  which just guesses the completion from a list of possible completion-  and then re-hitting the key-binding will cause it to guess again.-  I think this is very nice for things such as completing a word within-  a TeX-buffer. However using the mini-buffer might be nicer when we allow-  syntax knowledge to allow completion for example we may complete from-  a Hoogle database.--}-completeWordB :: CompletionScope -> EditorM ()-completeWordB = veryQuickCompleteWord--data CompletionScope = FromCurrentBuffer | FromAllBuffers-  deriving (Eq, Show)--{--  This is a very quick and dirty way to complete the current word.-  It works in a similar way to the completion of words in the mini-buffer-  it uses the message buffer to give simple feedback such as,-  "Matches:" and "Complete, but not unique:"--  It is by no means perfect but it's also not bad, pretty usable.--}-veryQuickCompleteWord :: CompletionScope -> EditorM ()-veryQuickCompleteWord scope = do-  (curWord, curWords) <- withCurrentBuffer wordsAndCurrentWord-  allWords <- fmap concat $ withEveryBuffer $ words' <$> (R.toText <$> elemsB)-  let match :: T.Text -> Maybe T.Text-      match x = if (curWord `T.isPrefixOf` x) && (x /= curWord)-                then Just x-                else Nothing-      wordsToChooseFrom = if scope == FromCurrentBuffer-                          then curWords-                          else allWords-  preText             <- completeInList curWord match wordsToChooseFrom-  if T.null curWord-    then printMsg "No word to complete"-    else withCurrentBuffer . insertN . R.fromText $ T.drop (T.length curWord) preText--wordsAndCurrentWord :: BufferM (T.Text, [T.Text])-wordsAndCurrentWord =-  do curText          <- R.toText <$> elemsB-     curWord          <--       fmap R.toText $ readRegionB =<< regionOfPartB unitWord Backward-     return (curWord, words' curText)--wordsForCompletionInBuffer :: BufferM [T.Text]-wordsForCompletionInBuffer = do-  let readTextRegion = fmap R.toText . readRegionB-  above <- readTextRegion =<< regionOfPartB Document Backward-  below <- readTextRegion =<< regionOfPartB Document Forward-  return $ reverse (words' above) ++ words' below--wordsForCompletion :: EditorM [T.Text]-wordsForCompletion = do-    _ :| bs <- fmap bkey <$> getBufferStack-    w0 <- withCurrentBuffer wordsForCompletionInBuffer-    contents <- forM bs $ \b -> withGivenBuffer b (R.toText <$> elemsB)-    return $ w0 ++ concatMap words' contents--words' :: T.Text -> [T.Text]-words' = filter (isJust . charClass . T.head) . T.groupBy ((==) `on` charClass)--charClass :: Char -> Maybe Int-charClass c = findIndex (generalCategory c `elem`)-                [ [ UppercaseLetter, LowercaseLetter, TitlecaseLetter-                  , ModifierLetter, OtherLetter-                  , ConnectorPunctuation-                  , NonSpacingMark, SpacingCombiningMark, EnclosingMark-                  , DecimalNumber, LetterNumber, OtherNumber-                  ]-                , [ MathSymbol, CurrencySymbol, ModifierSymbol, OtherSymbol ]-                ]--{--  Finally obviously we wish to have a much more sophisticated completeword.-  One which spawns a mini-buffer and allows searching in Hoogle databases-  or in other files etc.--}
− src/library/Yi/Types.hs 
@@ -1,472 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveFoldable #-}-{-# LANGUAGE DeriveFunctor #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Types--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ This module is the host of the most prevalent types throughout Yi.--- It is unfortunately a necessary evil to avoid use of bootfiles.------ You're encouraged to import from more idiomatic modules which will--- re-export these where appropriate.--module Yi.Types where--import           Control.Applicative-import           Control.Concurrent-import           Control.Monad.Base-import           Control.Monad.RWS.Strict (RWS, MonadWriter)-import           Control.Monad.Reader-import           Control.Monad.State-import qualified Data.DynamicState as ConfigState-import qualified Data.DynamicState.Serializable as DynamicState-import           Data.Binary (Binary)-import qualified Data.Binary as B-import           Data.Default-import qualified Data.DelayList as DelayList-import           Data.Foldable-import           Data.Function (on)-import           Data.List.NonEmpty-import           Data.List.PointedList-import qualified Data.Map as M-import qualified Data.Text as T-import qualified Data.Text.Encoding as E-import           Data.Time-import           Data.Traversable-import           Data.Typeable-import           Data.Word-#ifdef FRONTEND_VTY-import qualified Graphics.Vty as Vty-#endif-import           Yi.Buffer.Basic (BufferRef, WindowRef)-import           Yi.Buffer.Implementation-import           Yi.Buffer.Undo-import           Yi.Config.Misc-import           Yi.Event-import qualified Yi.Interact as I-import           Yi.KillRing-import           Yi.Layout-import           Yi.Monad-import           Yi.Process (SubprocessInfo, SubprocessId)-import qualified Yi.Rope as R-import           Yi.Style-import           Yi.Style.Library-import           Yi.Syntax-import           Yi.Tab-import           Yi.UI.Common-import           Yi.Window----- Yi.Keymap---- TODO: refactor this!--data Action = forall a. Show a => YiA (YiM a)-            | forall a. Show a => EditorA (EditorM a)-            | forall a. Show a => BufferA (BufferM a)-            deriving Typeable--emptyAction :: Action-emptyAction = BufferA (return ())--class (Default a, Binary a, Typeable a) => YiVariable a-class (Default a, Typeable a) => YiConfigVariable a--instance Eq Action where-    _ == _ = False--instance Show Action where-    show (YiA _) = "@Y"-    show (EditorA _) = "@E"-    show (BufferA _) = "@B"--type Interact ev a = I.I ev Action a--type KeymapM a = Interact Event a--type Keymap = KeymapM ()--type KeymapEndo = Keymap -> Keymap--type KeymapProcess = I.P Event Action--data IsRefreshNeeded = MustRefresh | NoNeedToRefresh-    deriving (Show, Eq)--data Yi = Yi { yiUi          :: UI Editor-             , yiInput       :: [Event] -> IO ()    -- ^ input stream-             , yiOutput      :: IsRefreshNeeded -> [Action] -> IO ()   -- ^ output stream-             , yiConfig      :: Config-               -- TODO: this leads to anti-patterns and seems like one itself-               -- too coarse for actual concurrency, otherwise pointless-               -- And MVars can be empty so this causes soundness problems-               -- Also makes code a bit opaque-             , yiVar         :: MVar YiVar           -- ^ The only mutable state in the program-             }-             deriving Typeable--data YiVar = YiVar { yiEditor             :: !Editor-                   , yiSubprocessIdSupply :: !SubprocessId-                   , yiSubprocesses       :: !(M.Map SubprocessId SubprocessInfo)-                   }---- | The type of user-bindable functions--- TODO: doc how these are actually user-bindable--- are they?-newtype YiM a = YiM {runYiM :: ReaderT Yi IO a}-    deriving (Monad, Applicative, MonadReader Yi, MonadBase IO, Typeable, Functor)--instance MonadState Editor YiM where-    get = yiEditor <$> (liftBase . readMVar =<< yiVar <$> ask)-    put v = liftBase . flip modifyMVar_ (\x -> return $ x {yiEditor = v}) =<< yiVar <$> ask--instance MonadEditor YiM where-    askCfg = yiConfig <$> ask-    withEditor f = do-      r <- asks yiVar-      cfg <- asks yiConfig-      liftBase $ unsafeWithEditor cfg r f---unsafeWithEditor :: Config -> MVar YiVar -> EditorM a -> IO a-unsafeWithEditor cfg r f = modifyMVar r $ \var -> do-  let e = yiEditor var-  let (e',a) = runEditor cfg f e-  -- Make sure that the result of runEditor is evaluated before-  -- replacing the editor state. Otherwise, we might replace e-  -- with an exception-producing thunk, which makes it impossible-  -- to look at or update the editor state.-  -- Maybe this could also be fixed by -fno-state-hack flag?-  -- TODO: can we simplify this?-  e' `seq` a `seq` return (var {yiEditor = e'}, a)---data KeymapSet = KeymapSet-    { topKeymap :: Keymap         -- ^ Content of the top-level loop.-    , insertKeymap :: Keymap      -- ^ For insertion-only modes-    }--extractTopKeymap :: KeymapSet -> Keymap-extractTopKeymap kms = forever (topKeymap kms)-    -- Note the use of "forever": this has quite subtle implications, as it means that-    -- failures in one iteration can yield to jump to the next iteration seamlessly.-    -- eg. in emacs keybinding, failures in incremental search, like <left>, will "exit"-    -- incremental search and immediately move to the left.---- Yi.Buffer.Misc---- | The BufferM monad writes the updates performed.-newtype BufferM a = BufferM { fromBufferM :: RWS Window [Update] FBuffer a }-    deriving (Monad, Functor, MonadWriter [Update], MonadState FBuffer, MonadReader Window, Typeable)---- | Currently duplicates some of Vim's indent settings. Allowing a--- buffer to specify settings that are more dynamic, perhaps via--- closures, could be useful.-data IndentSettings = IndentSettings-  { expandTabs :: Bool -- ^ Insert spaces instead of tabs as possible-  , tabSize    :: Int  -- ^ Size of a Tab-  , shiftWidth :: Int  -- ^ Indent by so many columns-  } deriving (Eq, Show, Typeable)--instance Applicative BufferM where-    pure = return-    (<*>) = ap--data FBuffer = forall syntax.-        FBuffer { bmode  :: !(Mode syntax)-                , rawbuf :: !(BufferImpl syntax)-                , attributes :: !Yi.Types.Attributes-               }-        deriving Typeable--instance Eq FBuffer where-    (==) = (==) `on` bkey__ . attributes--type WinMarks = MarkSet Mark--data MarkSet a = MarkSet { fromMark, insMark, selMark :: !a }-               deriving (Traversable, Foldable, Functor)--instance Binary a => Binary (MarkSet a) where-  put (MarkSet f i s) = B.put f >> B.put i >> B.put s-  get = liftM3 MarkSet B.get B.get B.get--data Attributes = Attributes-                { ident :: !BufferId-                , bkey__   :: !BufferRef          -- ^ immutable unique key-                , undos  :: !URList               -- ^ undo/redo list-                , bufferDynamic :: !DynamicState.DynamicState  -- ^ dynamic components-                , preferCol :: !(Maybe Int)       -- ^ prefered column to arrive at when we do a lineDown / lineUp-                , pendingUpdates :: ![UIUpdate]   -- ^ updates that haven't been synched in the UI yet-                , selectionStyle :: !SelectionStyle-                , keymapProcess :: !KeymapProcess-                , winMarks :: !(M.Map WindowRef WinMarks)-                , lastActiveWindow :: !Window-                , lastSyncTime :: !UTCTime        -- ^ time of the last synchronization with disk-                , readOnly :: !Bool               -- ^ read-only flag-                , inserting                 :: !Bool -- ^ the keymap is ready for insertion into this buffer-                , directoryContent          :: !Bool -- ^ does buffer contain directory contents-                , pointFollowsWindow        :: !(WindowRef -> Bool)-                , updateTransactionInFlight :: !Bool-                , updateTransactionAccum    :: ![Update]-                , fontsizeVariation         :: !Int-                  -- ^ How many points (frontend-specific) to change-                  -- the font by in this buffer-                } deriving Typeable---instance Binary Yi.Types.Attributes where-    put (Yi.Types.Attributes n b u bd pc pu selectionStyle_-         _proc wm law lst ro ins _dc _pfw isTransacPresent transacAccum fv) = do-      let putTime (UTCTime x y) = B.put (fromEnum x) >> B.put (fromEnum y)-      B.put n >> B.put b >> B.put u >> B.put bd-      B.put pc >> B.put pu >> B.put selectionStyle_ >> B.put wm-      B.put law >> putTime lst >> B.put ro >> B.put ins >> B.put _dc-      B.put isTransacPresent >> B.put transacAccum >> B.put fv-    get = Yi.Types.Attributes <$> B.get <*> B.get <*> B.get <*>-          B.get <*> B.get <*> B.get <*> B.get <*> pure I.End <*> B.get <*> B.get-          <*> getTime <*> B.get <*> B.get <*> B.get-          <*> pure (const False) <*> B.get <*> B.get <*> B.get-      where-        getTime = UTCTime <$> (toEnum <$> B.get) <*> (toEnum <$> B.get)--data BufferId = MemBuffer T.Text-              | FileBuffer FilePath-              deriving (Show, Eq)--instance Binary BufferId where-  get = B.get >>= \case-    (0 :: Word8) -> MemBuffer . E.decodeUtf8 <$> B.get-    1 -> FileBuffer <$> B.get-    x -> fail $ "Binary failed on BufferId, tag: " ++ show x-  put (MemBuffer t) = B.put (0 :: Word8) >> B.put (E.encodeUtf8 t)-  put (FileBuffer t) = B.put (1 :: Word8) >> B.put t---data SelectionStyle = SelectionStyle-  { highlightSelection :: !Bool-  , rectangleSelection :: !Bool-  } deriving Typeable--instance Binary SelectionStyle where-  put (SelectionStyle h r) = B.put h >> B.put r-  get = SelectionStyle <$> B.get <*> B.get---data AnyMode = forall syntax. AnyMode (Mode syntax)-  deriving Typeable---- | A Mode customizes the Yi interface for editing a particular data--- format. It specifies when the mode should be used and controls--- file-specific syntax highlighting and command input, among other--- things.-data Mode syntax = Mode-  { modeName :: T.Text-    -- ^ so this can be serialized, debugged.-  , modeApplies :: FilePath -> R.YiString -> Bool-    -- ^ What type of files does this mode apply to?-  , modeHL :: ExtHL syntax-    -- ^ Syntax highlighter-  , modePrettify :: syntax -> BufferM ()-    -- ^ Prettify current \"paragraph\"-  , modeKeymap :: KeymapSet -> KeymapSet-    -- ^ Buffer-local keymap modification-  , modeIndent :: syntax -> IndentBehaviour -> BufferM ()-    -- ^ emacs-style auto-indent line-  , modeAdjustBlock :: syntax -> Int -> BufferM ()-    -- ^ adjust the indentation after modification-  , modeFollow :: syntax -> Action-    -- ^ Follow a \"link\" in the file. (eg. go to location of error message)-  , modeIndentSettings :: IndentSettings-  , modeToggleCommentSelection :: Maybe (BufferM ())-  , modeGetStrokes :: syntax -> Point -> Point -> Point -> [Stroke]-    -- ^ Strokes that should be applied when displaying a syntax element-    -- should this be an Action instead?-  , modeOnLoad :: BufferM ()-    -- ^ An action that is to be executed when this mode is set-  , modeModeLine :: [T.Text] -> BufferM T.Text-    -- ^ buffer-local modeline formatting method-  , modeGotoDeclaration :: BufferM ()-    -- ^ go to the point where the variable is declared-  }---- | Used to specify the behaviour of the automatic indent command.-data IndentBehaviour =-    IncreaseCycle -- ^ Increase the indentation to the next higher indentation-                  --   hint. If we are currently at the highest level of-                  --   indentation then cycle back to the lowest.-  | DecreaseCycle -- ^ Decrease the indentation to the next smaller indentation-                  --   hint. If we are currently at the smallest level then-                  --   cycle back to the largest-  | IncreaseOnly  -- ^ Increase the indentation to the next higher hint-                  --   if no such hint exists do nothing.-  | DecreaseOnly  -- ^ Decrease the indentation to the next smaller indentation-                  --   hint, if no such hint exists do nothing.-    deriving (Eq, Show)---- Yi.Editor--type Status = ([T.Text], StyleName)-type Statuses = DelayList.DelayList Status---- | The Editor state-data Editor = Editor-  { bufferStack     :: !(NonEmpty BufferRef)-    -- ^ Stack of all the buffers.-    -- Invariant: first buffer is the current one.-  , buffers         :: !(M.Map BufferRef FBuffer)-  , refSupply       :: !Int  -- ^ Supply for buffer, window and tab ids.-  , tabs_           :: !(PointedList Tab)-    -- ^ current tab contains the visible windows pointed list.-  , dynamic         :: !DynamicState.DynamicState -- ^ dynamic components-  , statusLines     :: !Statuses-  , maxStatusHeight :: !Int-  , killring        :: !Killring-  , currentRegex    :: !(Maybe SearchExp)-    -- ^ currently highlighted regex (also most recent regex for use-    -- in vim bindings)-  , searchDirection :: !Direction-  , pendingEvents   :: ![Event]-    -- ^ Processed events that didn't yield any action yet.-  , onCloseActions  :: !(M.Map BufferRef (EditorM ()))-    -- ^ Actions to be run when the buffer is closed; should be scrapped.-  } deriving Typeable---newtype EditorM a = EditorM {fromEditorM :: ReaderT Config (State Editor) a}-    deriving (Monad, Applicative, MonadState Editor,-              MonadReader Config, Functor)--instance MonadEditor EditorM where-    askCfg = ask-    withEditor = id--#if __GLASGOW_HASKELL__ < 708-deriving instance Typeable1 EditorM-#else-deriving instance Typeable EditorM-#endif--class (Monad m, MonadState Editor m) => MonadEditor m where-  askCfg :: m Config--  withEditor :: EditorM a -> m a-  withEditor f = do-    cfg <- askCfg-    getsAndModify (runEditor cfg f)--  withEditor_ :: EditorM a -> m ()-  withEditor_ = withEditor . void---runEditor :: Config -> EditorM a -> Editor -> (Editor, a)-runEditor cfg f e = let (a, e') = runState (runReaderT (fromEditorM f) cfg) e-                    in (e',a)---- Yi.Config--data UIConfig = UIConfig {-#ifdef FRONTEND_VTY-   configVty :: Vty.Config,-#endif-   configFontName :: Maybe String,  -- ^ Font name, for the UI that support it.-   configFontSize :: Maybe Int,     -- ^ Font size, for the UI that support it.-   configScrollStyle :: Maybe ScrollStyle,-   -- ^ Style of scroll-   configScrollWheelAmount :: Int,  -- ^ Amount to move the buffer when using the scroll wheel-   configLeftSideScrollBar :: Bool, -- ^ Should the scrollbar be shown on the left side?-   configAutoHideScrollBar :: Bool, -- ^ Hide scrollbar automatically if text fits on one page.-   configAutoHideTabBar :: Bool,    -- ^ Hide the tabbar automatically if only one tab is present-   configLineWrap :: Bool,          -- ^ Wrap lines at the edge of the window if too long to display.-   configCursorStyle :: CursorStyle,-   configWindowFill :: Char,-   -- ^ The char with which to fill empty window space.  Usually '~' for vi-like-   -- editors, ' ' for everything else.-   configTheme :: Theme             -- ^ UI colours-  }---type UIBoot = Config -> ([Event] -> IO ())-              -> ([Action] -> IO ()) ->  Editor -> IO (UI Editor)---- | When should we use a "fat" cursor (i.e. 2 pixels wide, rather than 1)? Fat--- cursors have only been implemented for the Pango frontend.-data CursorStyle = AlwaysFat-                 | NeverFat-                 | FatWhenFocused-                 | FatWhenFocusedAndInserting---- | Configuration record. All Yi hooks can be set here.-data Config = Config {startFrontEnd :: UIBoot,-                      -- ^ UI to use.-                      configUI :: UIConfig,-                      -- ^ UI-specific configuration.-                      startActions :: [Action],-                      -- ^ Actions to run when the editor is started.-                      initialActions :: [Action],-                      -- ^ Actions to run after startup (after startActions) or reload.-                      defaultKm :: KeymapSet,-                      -- ^ Default keymap to use.-                      configInputPreprocess :: I.P Event Event,-                      modeTable :: [AnyMode],-                      -- ^ List modes by order of preference.-                      debugMode :: Bool,-                      -- ^ Produce a .yi.dbg file with a lot of debug information.-                      configRegionStyle :: RegionStyle,-                      -- ^ Set to 'Exclusive' for an emacs-like behaviour.-                      configKillringAccumulate :: Bool,-                      -- ^ Set to 'True' for an emacs-like behaviour, where-                      -- all deleted text is accumulated in a killring.-                      configCheckExternalChangesObsessively :: Bool,-                      bufferUpdateHandler :: [[Update] -> BufferM ()],-                      layoutManagers :: [AnyLayoutManager],-                      -- ^ List of layout managers for 'cycleLayoutManagersNext'-                      configVars :: ConfigState.DynamicState-                      -- ^ Custom configuration, containing the 'YiConfigVariable's. Configure with 'configVariableA'.-                     }----- Yi.Buffer.Normal---- Region styles are relative to the buffer contents.--- They likely should be considered a TextUnit.-data RegionStyle = LineWise-                 | Inclusive-                 | Exclusive-                 | Block-  deriving (Eq, Typeable, Show)--instance Binary RegionStyle where-  put LineWise = B.put (0 :: Word8)-  put Inclusive = B.put (1 :: Word8)-  put Exclusive = B.put (2 :: Word8)-  put Block = B.put (3 :: Word8)--  get = B.get >>= \case-    (0 :: Word8) -> return LineWise-    1 -> return Inclusive-    2 -> return Exclusive-    3 -> return Block-    n -> fail $ "Binary RegionStyle fail with " ++ show n---- TODO: put in the buffer state proper.-instance Default RegionStyle where-  def = Inclusive--instance YiVariable RegionStyle
− src/library/Yi/UI/Batch.hs 
@@ -1,14 +0,0 @@--module Yi.UI.Batch (start) where--import Yi.UI.Common-import Yi.Config---- | Initialise the ui-start :: UIBoot-start _cfg _ch _outCh _ed = do-    mapM_ putStrLn ["Starting 'batch' UI...",-                    "Are you sure you compiled with support for any real UI?",-                    "(for example, pass -fvty to cabal install)"]-    return dummyUI-
− src/library/Yi/UI/Common.hs 
@@ -1,65 +0,0 @@-{-# LANGUAGE Rank2Types #-}--module Yi.UI.Common where--{- | Record presenting a frontend's interface.--The functions 'layout' and 'refresh' are both run by the editor's main loop,-in response to user actions and so on. Their relation is a little subtle, and-is discussed here:--  * to see some code, look at the function @refreshEditor@ in "Yi.Core".-    This is the only place where 'layout' and 'refresh' are used.--  * the function 'layout' is responsible for updating the 'Editor' with the-    width and height of the windows. Some frontends, such as Pango, need to-    modify their internal state to do this, and will consequently change-    their display. This is expected.--  * the function 'refresh' should cause the UI to update its display with-    the information given in the 'Editor'.--  * the functionalities of 'layout' and 'refresh' overlap to some extent, in-    the sense that both may cause the frontend to update its display. The Yi core-    provides the following guarantees which the frontend may take advantage of:--      * in the main editor loop (i.e. in the @refreshEditor@ function),-        'layout' will be run (possibly multiple times) and then 'refresh' will-        be run. This guarantee will hold even in the case of threading (the-        function @refreshEditor@ will always be run atomically, using @MVar@s).--      * between the last run of 'layout' and the run of 'refresh', some changes-        may be made to the 'Editor'. However, the text, text attributes, and-        (displayed) window region of all windows will remain the same. However,-        the cursor location may change.--        This guarantee allows frontends which calculate rendering of the text-        during the 'layout' stage to avoid recalculating the render again during-        'refresh'. Pango is an example of such a frontend.--The Yi core provides no guarantee about the OS thread from which the functions-'layout' and 'refresh' are called from. In particular, subprocesses (e.g. compilation,-ghci) will run 'layout' and 'refresh' from new OS threads (see @startSubprocessWatchers@-in "Yi.Core"). The frontend must be preparaed for this: for instance, Gtk-based frontends-should wrap GUI updates in @postGUIAsync@.--}-data UI e = UI-    { main                  :: IO ()               -- ^ Main loop-    , end                   :: Bool -> IO ()       -- ^ Clean up, and also terminate if given 'true'-    , suspend               :: IO ()               -- ^ Suspend (or minimize) the program-    , refresh               :: e -> IO ()     -- ^ Refresh the UI with the given state-    , userForceRefresh      :: IO ()               -- ^ User force-refresh (in case the screen has been messed up from outside)-    , layout                :: e -> IO e -- ^ Set window width and height-    , reloadProject         :: FilePath -> IO ()   -- ^ Reload cabal project views-    }--dummyUI :: UI e-dummyUI = UI-  { main             = return ()-  , end              = const (return ())-  , suspend          = return ()-  , refresh          = const (return ())-  , userForceRefresh = return ()-  , layout           = return-  , reloadProject    = const (return ())-  }
− src/library/Yi/UI/Pango.hs 
@@ -1,946 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE ViewPatterns #-}-{-# OPTIONS_GHC -funbox-strict-fields #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.UI.Pango--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ This module defines a user interface implemented using gtk2hs and--- pango for direct text rendering.--module Yi.UI.Pango (start, startGtkHook) where--import           Control.Applicative-import           Control.Concurrent-import           Control.Exception (catch, SomeException)-import           Control.Lens hiding (set, Action, from)-import           Control.Monad hiding (forM_, mapM_, forM, mapM)-import           Data.Foldable-import           Data.IORef-import qualified Data.List.PointedList as PL (moveTo)-import qualified Data.List.PointedList.Circular as PL-import qualified Data.Map as M-import           Data.Maybe-import           Data.Monoid-import           Data.Text (unpack, Text)-import qualified Data.Text as T-import           Data.Traversable-import qualified Graphics.UI.Gtk as Gtk-import           Graphics.UI.Gtk hiding (Region, Window, Action , Point,-                                         Style, Modifier, on)-import qualified Graphics.UI.Gtk.Gdk.EventM as EventM-import qualified Graphics.UI.Gtk.Gdk.GC as Gtk-import           Graphics.UI.Gtk.Gdk.GC hiding (foreground)-import           Prelude hiding (error, elem, mapM_, foldl, concat, mapM)-import           System.Glib.GError-import           Yi.Buffer-import           Yi.Config-import           Yi.Debug-import           Yi.Editor-import           Yi.Event-import           Yi.Keymap-import           Yi.Layout(DividerPosition, DividerRef)-import           Yi.Monad-import qualified Yi.Rope as R-import           Yi.Style-import           Yi.Tab-import           Yi.Types (fontsizeVariation, attributes)-import qualified Yi.UI.Common as Common-import           Yi.UI.Pango.Control (keyTable)-#ifdef GNOME_ENABLED-import           Yi.UI.Pango.Gnome(watchSystemFont)-#endif-import           Yi.UI.Pango.Layouts-import           Yi.UI.Pango.Utils-import           Yi.String (showT)-import           Yi.UI.TabBar-import           Yi.UI.Utils-import           Yi.Utils-import           Yi.Window---- We use IORefs in all of these datatypes for all fields which could--- possibly change over time.  This ensures that no 'UI', 'TabInfo',--- 'WinInfo' will ever go out of date.--data UI = UI-    { uiWindow    :: Gtk.Window-    , uiNotebook  :: SimpleNotebook-    , uiStatusbar :: Statusbar-    , tabCache    :: IORef TabCache-    , uiActionCh  :: Action -> IO ()-    , uiConfig    :: UIConfig-    , uiFont      :: IORef FontDescription-    , uiInput     :: IMContext-    }--type TabCache = PL.PointedList TabInfo---- We don't need to know the order of the windows (the layout manages--- that) so we might as well use a map-type WindowCache = M.Map WindowRef WinInfo--data TabInfo = TabInfo-    { coreTabKey      :: TabRef-    , layoutDisplay   :: LayoutDisplay-    , miniwindowPage  :: MiniwindowDisplay-    , tabWidget       :: Widget-    , windowCache     :: IORef WindowCache-    , fullTitle       :: IORef Text-    , abbrevTitle     :: IORef Text-    }--instance Show TabInfo where-    show t = show (coreTabKey t)--data WinInfo = WinInfo-    { coreWinKey      :: WindowRef-    , coreWin         :: IORef Window-    , shownTos        :: IORef Point-    , lButtonPressed  :: IORef Bool-    , insertingMode   :: IORef Bool-    , inFocus         :: IORef Bool-    , winLayoutInfo   :: MVar WinLayoutInfo-    , winMetrics      :: FontMetrics-    , textview        :: DrawingArea-    , modeline        :: Label-    , winWidget       :: Widget -- ^ Top-level widget for this window.-    }--data WinLayoutInfo = WinLayoutInfo {-   winLayout :: !PangoLayout,-   tos :: !Point,-   bos :: !Point,-   bufEnd :: !Point,-   cur :: !Point,-   buffer :: !FBuffer,-   regex :: !(Maybe SearchExp)- }--instance Show WinInfo where-    show w = show (coreWinKey w)--instance Ord EventM.Modifier where-  x <= y = fromEnum x <= fromEnum y--mkUI :: UI -> Common.UI Editor-mkUI ui = Common.dummyUI-    { Common.main          = main-    , Common.end           = const end-    , Common.suspend       = windowIconify (uiWindow ui)-    , Common.refresh       = refresh ui-    , Common.layout        = doLayout ui-    , Common.reloadProject = const reloadProject-    }--updateFont :: UIConfig -> IORef FontDescription -> IORef TabCache -> Statusbar-           -> FontDescription -> IO ()-updateFont cfg fontRef tc status font = do-    maybe (return ()) (fontDescriptionSetFamily font) (configFontName cfg)--    writeIORef fontRef font-    widgetModifyFont status (Just font)-    tcs <- readIORef tc-    forM_ tcs $ \tabinfo -> do-      wcs <- readIORef (windowCache tabinfo)-      forM_ wcs $ \wininfo -> do-        withMVar (winLayoutInfo wininfo) $ \WinLayoutInfo{winLayout} ->-          layoutSetFontDescription winLayout (Just font)--        -- This will cause the textview to redraw-        widgetModifyFont (textview wininfo) (Just font)-        widgetModifyFont (modeline wininfo) (Just font)--askBuffer :: Window -> FBuffer -> BufferM a -> a-askBuffer w b f = fst $ runBuffer w b f---- | Initialise the ui-start :: UIBoot-start = startGtkHook (const $ return ())---- | Initialise the ui, calling a given function---   on the Gtk window. This could be used to---   set additional callbacks, adjusting the window---   layout, etc.-startGtkHook :: (Gtk.Window -> IO ()) -> UIBoot-startGtkHook userHook cfg ch outCh ed =-  catch (startNoMsgGtkHook userHook cfg ch outCh ed)-  (\(GError _dom _code msg) -> fail $ unpack msg)--startNoMsgGtkHook :: (Gtk.Window -> IO ()) -> UIBoot-startNoMsgGtkHook userHook cfg ch outCh ed = do-  logPutStrLn "startNoMsgGtkHook"-  void unsafeInitGUIForThreadedRTS--  win   <- windowNew-  ico   <- loadIcon "yi+lambda-fat-32.png"-  vb    <- vBoxNew False 1    -- Top-level vbox--  im <- imMulticontextNew-  imContextSetUsePreedit im False  -- handler for preedit string not implemented--  -- Yi.Buffer.Misc.insertN for atomic input?-  let imContextCommitS :: Signal IMContext (String -> IO ())-      imContextCommitS = imContextCommit-  im `on` imContextCommitS $ mapM_ (\k -> ch [Event (KASCII k) []])--  set win [ windowDefaultWidth  := 700-          , windowDefaultHeight := 900-          , windowTitle         := ("Yi" :: T.Text)-          , windowIcon          := Just ico-          , containerChild      := vb-          ]--  win `on` deleteEvent $ io $ mainQuit >> return True-  win `on` keyPressEvent $ handleKeypress ch im--  paned <- hPanedNew-  tabs <- simpleNotebookNew-  panedAdd2 paned (baseWidget tabs)--  status  <- statusbarNew--  -- Allow multiple lines in statusbar, GitHub issue #478-  statusbarGetMessageArea status >>= containerGetChildren >>= \case-    [w] -> labelSetSingleLineMode (castToLabel w) False-    _ -> return ()--  -- statusbarGetContextId status "global"--  set vb [ containerChild := paned-         , containerChild := status-         , boxChildPacking status := PackNatural-         ]--  fontRef <- fontDescriptionNew >>= newIORef--  let actionCh = outCh . return-  tc <- newIORef =<< newCache ed actionCh--#ifdef GNOME_ENABLED-  let watchFont = watchSystemFont-#else-  let watchFont = (fontDescriptionFromString ("Monospace 10" :: T.Text) >>=)-#endif-  watchFont $ updateFont (configUI cfg) fontRef tc status--  -- I think this is the correct place to put it...-  userHook win--  -- use our magic threads thingy-  -- http://haskell.org/gtk2hs/archives/2005/07/24/writing-multi-threaded-guis/-  void $ timeoutAddFull (yield >> return True) priorityDefaultIdle 50--  widgetShowAll win--  let ui = UI win tabs status tc actionCh (configUI cfg) fontRef im--  -- Keep the current tab focus up to date-  let move n pl = fromMaybe pl (PL.moveTo n pl)-      runAction = uiActionCh ui . makeAction-  -- why does this cause a hang without postGUIAsync?-  simpleNotebookOnSwitchPage (uiNotebook ui) $ \n -> postGUIAsync $-    runAction ((%=) tabsA (move n) :: EditorM ())--  return (mkUI ui)---main :: IO ()-main = logPutStrLn "GTK main loop running" >> mainGUI---- | Clean up and go home-end :: IO ()-end = mainQuit---- | Modify GUI and the 'TabCache' to reflect information in 'Editor'.-updateCache :: UI -> Editor -> IO ()-updateCache ui e = do-       cache <- readIORef $ tabCache ui-       -- convert to a map for convenient lookups-       let cacheMap = mapFromFoldable . fmap (\t -> (coreTabKey t, t)) $ cache--       -- build the new cache-       cache' <- forM (e ^. tabsA) $ \tab ->-         case M.lookup (tkey tab) cacheMap of-           Just t -> updateTabInfo e ui tab t >> return t-           Nothing -> newTab e ui tab--       -- store the new cache-       writeIORef (tabCache ui) cache'--       -- update the GUI-       simpleNotebookSet (uiNotebook ui)-         =<< forM cache' (\t -> (tabWidget t,) <$> readIORef (abbrevTitle t))----- | Modify GUI and given 'TabInfo' to reflect information in 'Tab'.-updateTabInfo :: Editor -> UI -> Tab -> TabInfo -> IO ()-updateTabInfo e ui tab tabInfo = do-    -- update the window cache-    wCacheOld <- readIORef (windowCache tabInfo)-    wCacheNew <- mapFromFoldable <$> forM (tab ^. tabWindowsA) (\w ->-      case M.lookup (wkey w) wCacheOld of-        Just wInfo -> updateWindow e ui w wInfo >> return (wkey w, wInfo)-        Nothing -> (wkey w,) <$> newWindow e ui w)-    writeIORef (windowCache tabInfo) wCacheNew--    -- TODO update renderer, etc?--    let lookupWin w = wCacheNew M.! w--    -- set layout-    layoutDisplaySet (layoutDisplay tabInfo)-      . fmap (winWidget . lookupWin) . tabLayout $ tab--    -- set minibox-    miniwindowDisplaySet (miniwindowPage tabInfo)-      . fmap (winWidget . lookupWin . wkey) . tabMiniWindows $ tab--    -- set focus-    setWindowFocus e ui tabInfo . lookupWin . wkey . tabFocus $ tab--updateWindow :: Editor -> UI -> Window -> WinInfo -> IO ()-updateWindow e _ui win wInfo = do-    writeIORef (inFocus wInfo) False -- see also 'setWindowFocus'-    writeIORef (coreWin wInfo) win-    writeIORef (insertingMode wInfo)-      (askBuffer win (findBufferWith (bufkey win) e) $ use insertingA)--setWindowFocus :: Editor -> UI -> TabInfo -> WinInfo -> IO ()-setWindowFocus e ui t w = do-  win <- readIORef (coreWin w)-  let bufferName = shortIdentString (length $ commonNamePrefix e) $-                   findBufferWith (bufkey win) e-      ml = askBuffer win (findBufferWith (bufkey win) e) $-           getModeLine (T.pack <$> commonNamePrefix e)-      im = uiInput ui--  writeIORef (inFocus w) True -- see also 'updateWindow'-  update (textview w) widgetIsFocus True-  update (modeline w) labelText ml-  writeIORef (fullTitle t) bufferName-  writeIORef (abbrevTitle t) (tabAbbrevTitle bufferName)-  drawW <- catch (fmap Just $ widgetGetDrawWindow $ textview w)-                 (\(_ :: SomeException) -> return Nothing)-  imContextSetClientWindow im drawW-  imContextFocusIn im--getWinInfo :: UI -> WindowRef -> IO WinInfo-getWinInfo ui ref =-  let tabLoop []     = error "Yi.UI.Pango.getWinInfo: window not found"-      tabLoop (t:ts) = do-        wCache <- readIORef (windowCache t)-        case M.lookup ref wCache of-          Just w -> return w-          Nothing -> tabLoop ts-  in readIORef (tabCache ui) >>= (tabLoop . toList)---- | Make the cache from the editor and the action channel-newCache :: Editor -> (Action -> IO ()) -> IO TabCache-newCache e actionCh = mapM (mkDummyTab actionCh) (e ^. tabsA)---- | Make a new tab, and populate it-newTab :: Editor -> UI -> Tab -> IO TabInfo-newTab e ui tab = do-  t <- mkDummyTab (uiActionCh ui) tab-  updateTabInfo e ui tab t-  return t---- | Make a minimal new tab, without any windows.--- This is just for bootstrapping the UI; 'newTab' should normally--- be called instead.-mkDummyTab :: (Action -> IO ()) -> Tab -> IO TabInfo-mkDummyTab actionCh tab = do-    ws <- newIORef M.empty-    ld <- layoutDisplayNew-    layoutDisplayOnDividerMove ld (handleDividerMove actionCh)-    mwp <- miniwindowDisplayNew-    tw <- vBoxNew False 0-    set tw [containerChild := baseWidget ld,-            containerChild := baseWidget mwp,-            boxChildPacking (baseWidget ld) := PackGrow,-            boxChildPacking (baseWidget mwp) := PackNatural]-    ftRef <- newIORef ""-    atRef <- newIORef ""-    return (TabInfo (tkey tab) ld mwp (toWidget tw) ws ftRef atRef)----- | Make a new window.-newWindow :: Editor -> UI -> Window -> IO WinInfo-newWindow e ui w = do-    let b = findBufferWith (bufkey w) e-    f <- readIORef (uiFont ui)--    ml <- labelNew (Nothing :: Maybe Text)-    widgetModifyFont ml (Just f)-    set ml [ miscXalign := 0.01 ] -- so the text is left-justified.--    -- allow the modeline to be covered up, horizontally-    widgetSetSizeRequest ml 0 (-1)--    v <- drawingAreaNew-    widgetModifyFont v (Just f)-    widgetAddEvents v [Button1MotionMask]-    widgetModifyBg v StateNormal . mkCol False . Yi.Style.background-      . baseAttributes . configStyle $ uiConfig ui--    sw <- scrolledWindowNew Nothing Nothing-    scrolledWindowAddWithViewport sw v-    scrolledWindowSetPolicy sw PolicyAutomatic PolicyNever--    box <- if isMini w-     then do-      prompt <- labelNew (Just $ miniIdentString b)-      widgetModifyFont prompt (Just f)--      hb <- hBoxNew False 1-      set hb [ containerChild := prompt,-               containerChild := sw,-               boxChildPacking prompt := PackNatural,-               boxChildPacking sw := PackGrow]--      return (castToBox hb)-     else do-      vb <- vBoxNew False 1-      set vb [ containerChild := sw,-               containerChild := ml,-               boxChildPacking ml := PackNatural]-      return (castToBox vb)--    tosRef    <- newIORef (askBuffer w b (use . markPointA-                                          =<< fromMark <$> askMarks))-    context   <- widgetCreatePangoContext v-    layout    <- layoutEmpty context-    layoutRef <- newMVar (WinLayoutInfo layout 0 0 0 0-                          (findBufferWith (bufkey w) e) Nothing)-    language  <- contextGetLanguage context-    metrics   <- contextGetMetrics context f language-    ifLButton <- newIORef False-    imode     <- newIORef False-    focused   <- newIORef False-    winRef    <- newIORef w--    layoutSetFontDescription layout (Just f)--    -- stops layoutGetText crashing (as of gtk2hs 0.10.1)-    layoutSetText layout T.empty--    let ref = wkey w-        win = WinInfo { coreWinKey = ref-                      , coreWin   = winRef-                      , winLayoutInfo = layoutRef-                      , winMetrics = metrics-                      , textview  = v-                      , modeline  = ml-                      , winWidget = toWidget box-                      , shownTos  = tosRef-                      , lButtonPressed = ifLButton-                      , insertingMode = imode-                      , inFocus = focused-                      }-    updateWindow e ui w win--    v `on` buttonPressEvent   $ handleButtonClick   ui ref-    v `on` buttonReleaseEvent $ handleButtonRelease ui win-    v `on` scrollEvent        $ handleScroll        ui win--    -- todo: allocate event rather than configure?-    v `on` configureEvent     $ handleConfigure     ui--    v `on` motionNotifyEvent  $ handleMove          ui win-    void $ v `onExpose` render ui win-    -- also redraw when the window receives/loses focus-    uiWindow ui `on` focusInEvent $ io (widgetQueueDraw v) >> return False-    uiWindow ui `on` focusOutEvent $ io (widgetQueueDraw v) >> return False-    -- todo: consider adding an 'isDirty' flag to WinLayoutInfo,-    -- so that we don't have to recompute the Attributes when focus changes.-    return win--refresh :: UI -> Editor -> IO ()-refresh ui e = do-    postGUIAsync $ do-       contextId <- statusbarGetContextId (uiStatusbar ui) ("global" :: T.Text)-       statusbarPop  (uiStatusbar ui) contextId-       void $ statusbarPush (uiStatusbar ui) contextId $ T.intercalate "  " $-         statusLine e--    updateCache ui e -- The cursor may have changed since doLayout-    cache <- readIORef $ tabCache ui-    forM_ cache $ \t -> do-        wCache <- readIORef (windowCache t)-        forM_ wCache $ \w -> do-            updateWinInfoForRendering e ui w-            widgetQueueDraw (textview w)---- | Record all the information we need for rendering.------ This information is kept in an MVar so that the PangoLayout and--- tos/bos/buffer are in sync.-updateWinInfoForRendering :: Editor -> UI -> WinInfo -> IO ()-updateWinInfoForRendering e _ui w = modifyMVar_ (winLayoutInfo w) $ \wli -> do-  win <- readIORef (coreWin w)-  return $! wli{buffer=findBufferWith (bufkey win) e,regex=currentRegex e}---- | Tell the 'PangoLayout' what colours to draw, and draw the 'PangoLayout'--- and the cursor onto the screen-render :: UI -> WinInfo -> t -> IO Bool-render ui w _event =-  withMVar (winLayoutInfo w) $-  \WinLayoutInfo{winLayout=layout,tos,bos,cur,buffer=b,regex} -> do-    -- read the information-    win <- readIORef (coreWin w)--    -- add color attributes.-    let picture = askBuffer win b $ attributesPictureAndSelB sty regex-                  (mkRegion tos bos)-        sty = configStyle $ uiConfig ui--        picZip = zip picture $ drop 1 (fst <$> picture) <> [bos]-        strokes = [ (start',s,end') | ((start', s), end') <- picZip-                                    , s /= emptyAttributes ]--        rel p = fromIntegral (p - tos)-        allAttrs = concat $ do-          (p1, Attributes fg bg _rv bd itlc udrl, p2) <- strokes-          let atr x = x (rel p1) (rel p2)-              if' p x y = if p then x else y-          return [ atr AttrForeground $ mkCol True fg-                 , atr AttrBackground $ mkCol False bg-                 , atr AttrStyle $ if' itlc StyleItalic StyleNormal-                 , atr AttrUnderline $ if' udrl UnderlineSingle UnderlineNone-                 , atr AttrWeight $ if' bd WeightBold WeightNormal-                 ]--    layoutSetAttributes layout allAttrs--    drawWindow <- widgetGetDrawWindow $ textview w-    gc <- gcNew drawWindow--    -- see Note [PangoLayout width]-    -- draw the layout-    drawLayout drawWindow gc 1 0 layout--    -- calculate the cursor position-    im <- readIORef (insertingMode w)--    -- check focus, and decide whether we want a wide cursor-    bufferFocused <- readIORef (inFocus w)-    uiFocused <- Gtk.windowHasToplevelFocus (uiWindow ui)-    let focused = bufferFocused && uiFocused-        wideCursor =-         case configCursorStyle (uiConfig ui) of-           AlwaysFat -> True-           NeverFat -> False-           FatWhenFocused -> focused-           FatWhenFocusedAndInserting -> focused && im---    (PangoRectangle (succ -> curX) curY curW curH, _) <--      layoutGetCursorPos layout (rel cur)-    -- tell the input method-    imContextSetCursorLocation (uiInput ui) $-      Rectangle (round curX) (round curY) (round curW) (round curH)-    -- paint the cursor-    gcSetValues gc-      (newGCValues { Gtk.foreground = mkCol True . Yi.Style.foreground-                                      . baseAttributes . configStyle $-                                      uiConfig ui-                   , Gtk.lineWidth = if wideCursor then 2 else 1 })--    -- tell the renderer-    if im-      then  -- if we are inserting, we just want a line-      drawLine drawWindow gc (round curX, round curY)-      (round $ curX + curW, round $ curY + curH)--      -- we aren't inserting, we want a rectangle around the current character-      else do-      PangoRectangle (succ -> chx) chy chw chh <- layoutIndexToPos-                                                  layout (rel cur)-      drawRectangle drawWindow gc False (round chx) (round chy)-        (if chw > 0 then round chw else 8) (round chh)--    return True--doLayout :: UI -> Editor -> IO Editor-doLayout ui e = do-    updateCache ui e-    tabs <- readIORef $ tabCache ui-    f <- readIORef (uiFont ui)-    heights <- fold <$> mapM (getHeightsInTab ui f e) tabs-    let e' = (tabsA %~ fmap (mapWindows updateWin)) e-        updateWin w = case M.lookup (wkey w) heights of-                          Nothing -> w-                          Just (h,rgn) -> w { height = h, winRegion = rgn }--    -- Don't leak references to old Windows-    let forceWin x w = height w `seq` winRegion w `seq` x-    return $ (foldl . tabFoldl) forceWin e' (e' ^. tabsA)--getHeightsInTab :: UI -> FontDescription -> Editor-                -> TabInfo -> IO (M.Map WindowRef (Int,Region))-getHeightsInTab ui f e tab = do-  wCache <- readIORef (windowCache tab)-  forM wCache $ \wi -> do-    (_, h) <- widgetGetSize $ textview wi-    win <- readIORef (coreWin wi)-    let metrics = winMetrics wi-        lineHeight = ascent metrics + descent metrics-    let b0 = findBufferWith (bufkey win) e-    rgn <- shownRegion ui f wi b0-    let ret= (round $ fromIntegral h / lineHeight, rgn)-    return ret--shownRegion :: UI -> FontDescription -> WinInfo -> FBuffer -> IO Region-shownRegion ui f w b = modifyMVar (winLayoutInfo w) $ \wli -> do-   (tos, cur, bos, bufEnd) <- updatePango ui f w b (winLayout wli)-   return (wli{tos,cur=clampTo tos bos cur,bos,bufEnd}, mkRegion tos bos)- where clampTo lo hi x = max lo (min hi x)--- during scrolling, cur might not lie between tos and bos,--- so we clamp it to avoid Pango errors--{-|-== Note [PangoLayout width]--We start rendering the PangoLayout one pixel from the left of the-rendering area, which means a few +/-1 offsets in Pango rendering and-point lookup code. The reason for this is to support the "wide-cursor", which is 2 pixels wide. If we started rendering the-PangoLayout directly from the left of the rendering area instead of at-a 1-pixel offset, then the "wide cursor" would only be half-displayed-when the cursor is at the beginning of the line, and would then be a-"thin cursor".--An alternative would be to special-case the wide cursor rendering at-the beginning of the line, and draw it one pixel to the right of where-it "should" be. I haven't tried this out to see how it looks.--Reiner--}---- we update the regex and the buffer to avoid holding on to potential garbage.--- These will be overwritten with correct values soon, in--- updateWinInfoForRendering.-updatePango :: UI -> FontDescription -> WinInfo -> FBuffer-            -> PangoLayout -> IO (Point, Point, Point, Point)-updatePango ui font w b layout = do-  (width_', height') <- widgetGetSize $ textview w-  let width' = max 0 (width_' - 1) -- see Note [PangoLayout width]-      fontDescriptionToStringT :: FontDescription -> IO Text-      fontDescriptionToStringT = fontDescriptionToString--  -- Resize (and possibly copy) the currently used font.-  curFont <- case fromIntegral <$> configFontSize (uiConfig ui) of-    Nothing -> return font-    Just defSize -> fontDescriptionGetSize font >>= \case-      Nothing -> fontDescriptionSetSize font defSize >> return font-      Just currentSize -> let fsv = fontsizeVariation $ attributes b-                              newSize = max 1 (fromIntegral fsv + defSize) in do-        if (newSize == currentSize)-          then return font-          else do-          -- This seems like it would be very expensive but I'm-          -- justifying it with that it only gets ran once per font-          -- size change. If the font size stays the same, we only-          -- enter this once per layout. We're effectivelly copying-          -- the default font for each layout that changes. An-          -- alternative would be to assign each buffer its own font-          -- but that seems a pain to maintain and if the user never-          -- changes font sizes, it's a waste of memory.-          nf <- fontDescriptionCopy font-          fontDescriptionSetSize nf newSize-          return nf--  oldFont <- layoutGetFontDescription layout-  oldFontStr <- maybe (return Nothing)-                (fmap Just . fontDescriptionToStringT) oldFont-  newFontStr <- Just <$> fontDescriptionToStringT curFont--  when (oldFontStr /= newFontStr) $-    layoutSetFontDescription layout (Just curFont)---  win <- readIORef (coreWin w)-  let [width'', height''] = fmap fromIntegral [width', height']-      metrics             = winMetrics w-      lineHeight          = ascent metrics + descent metrics-      charWidth           = max (approximateCharWidth metrics)-                                (approximateDigitWidth metrics)-      winw                = max 1 $ floor (width'' / charWidth)-      winh                = max 1 $ floor (height'' / lineHeight)-      maxChars            = winw * winh-      conf                = uiConfig ui--      (tos, size, point, text) = askBuffer win b $ do-        from     <- use . markPointA =<< fromMark <$> askMarks-        rope     <- streamB Forward from-        p        <- pointB-        bufEnd   <- sizeB-        let content = takeContent conf maxChars . fst $ R.splitAtLine winh rope--        -- allow BOS offset to be just after the last line-        let addNL = if R.countNewLines content == winh-                        then id-                        else (`R.snoc` '\n')-        return (from, bufEnd, p, R.toText $ addNL content)---  if configLineWrap conf-    then wrapToWidth layout WrapAnywhere width''-    else do-    (Rectangle px _py pwidth _pheight, _) <- layoutGetPixelExtents layout-    widgetSetSizeRequest (textview w) (px+pwidth) (-1)--  -- optimize for cursor movement-  oldText <- layoutGetText layout-  when (oldText /= text) (layoutSetText layout text)--  (_, bosOffset, _) <- layoutXYToIndex layout width''-                       (fromIntegral winh * lineHeight - 1)-  return (tos, point, tos + fromIntegral bosOffset + 1, size)---- | This is a hack that makes this renderer not suck in the common--- case. There are two scenarios: we're line wrapping or we're not--- line wrapping. This function already assumes that the contents--- given have all the possible lines we can fit on the screen.------ If we are line wrapping then the most text we'll ever need to--- render is precisely the number of characters that can fit on the--- screen. If that's the case, that's precisely what we do, truncate--- up to the point where the text would be off-screen anyway.------ If we aren't line-wrapping then we can't simply truncate at the max--- number of characters: lines might be really long, but considering--- we're not truncating, we should still be able to see every single--- line that can fit on screen up to the screen bound. This suggests--- that we could simply render each line up to the bound. While this--- does work wonders for performance and would work regardless whether--- we're wrapping or not, currently our implementation of the rest of--- the module depends on all characters used being set into the--- layout: if we cut some text off, painting strokes on top or going--- to the end makes for strange effects. So currently we have no--- choice but to render all characters in the visible lines. If you--- have really long lines, this will kill the performance.------ So here we implement the hack for the line-wrapping case. Once we--- fix stroke painting &c, this distinction can be removed and we can--- simply snip at the screen boundary whether we're wrapping or not--- which actually results in great performance in the end. Until that--- happens, only the line-wrapping case doesn't suck. Fortunately it--- is the default.-takeContent :: UIConfig -> Int -> R.YiString -> R.YiString-takeContent cf cl t = case configLineWrap cf of-  True -> R.take cl t-  False -> t---- | Wraps the layout according to the given 'LayoutWrapMode', using--- the specified width.------ In contrast to the past, it actually implements wrapping properly--- which was previously broken.-wrapToWidth :: PangoLayout -> LayoutWrapMode -> Double -> IO ()-wrapToWidth l wm w = do-  layoutGetWrap l >>= \wr -> case (wr, wm) of-    -- No Eq instance…-    (WrapWholeWords, WrapWholeWords) -> return ()-    (WrapAnywhere, WrapAnywhere) -> return ()-    (WrapPartialWords, WrapPartialWords) -> return ()-    _ -> layoutSetWrap l wm--  layoutGetWidth l >>= \case-    Just x | x == w -> return ()-    _               -> layoutSetWidth l (Just w)--reloadProject :: IO ()-reloadProject = return ()--mkCol :: Bool -- ^ is foreground?-      -> Yi.Style.Color -> Gtk.Color-mkCol True  Default = Color 0 0 0-mkCol False Default = Color maxBound maxBound maxBound-mkCol _ (RGB x y z) = Color (fromIntegral x * 256)-                            (fromIntegral y * 256)-                            (fromIntegral z * 256)---- * GTK Event handlers---- | Process GTK keypress if IM fails-handleKeypress :: ([Event] -> IO ()) -- ^ Event dispatcher (Yi.Core.dispatch)-               -> IMContext-               -> EventM EKey Bool-handleKeypress ch im = do-  gtkMods <- eventModifier-  gtkKey  <- eventKeyVal-  ifIM    <- imContextFilterKeypress im-  let char = keyToChar gtkKey-      modsWithShift = M.keys $ M.filter (`elem` gtkMods) modTable-      mods | isJust char = filter (/= MShift) modsWithShift-           | otherwise   = modsWithShift-      key  = case char of-        Just c  -> Just $ KASCII c-        Nothing -> M.lookup (keyName gtkKey) keyTable--  case (ifIM, key) of-    (True, _   ) -> return ()-    (_, Nothing) -> logPutStrLn $ "Event not translatable: " <> showT key-    (_, Just k ) -> io $ ch [Event k mods]-  return True---- | Map Yi modifiers to GTK-modTable :: M.Map Modifier EventM.Modifier-modTable = M.fromList-    [ (MShift, EventM.Shift  )-    , (MCtrl,  EventM.Control)-    , (MMeta,  EventM.Alt    )-    , (MSuper, EventM.Super  )-    , (MHyper, EventM.Hyper  )-    ]---- | Same as Gtk.on, but discards the ConnectId-on :: object -> Signal object callback -> callback -> IO ()-on widget signal handler = void $ Gtk.on widget signal handler--handleButtonClick :: UI -> WindowRef -> EventM EButton Bool-handleButtonClick ui ref = do-  (x, y) <- eventCoordinates-  click  <- eventClick-  button <- eventButton-  io $ do-    w <- getWinInfo ui ref-    point <- pointToOffset (x, y) w--    let focusWindow = focusWindowE ref-        runAction = uiActionCh ui . makeAction--    runAction focusWindow--    win <- io $ readIORef (coreWin w)--    let selectRegion tu = runAction $ do-          b <- gets $ bkey . findBufferWith (bufkey win)-          withGivenBufferAndWindow win b $-            moveTo point >> regionOfB tu >>= setSelectRegionB--    case (click, button) of-      (SingleClick, LeftButton) -> do-        io $ writeIORef (lButtonPressed w) True-        runAction $ do-          b <- gets $ bkey . findBufferWith (bufkey win)-          withGivenBufferAndWindow win b $ do-            m <- selMark <$> askMarks-            markPointA m .= point-            moveTo point-            setVisibleSelection False-      (DoubleClick, LeftButton) -> selectRegion unitWord-      (TripleClick, LeftButton) -> selectRegion Line-      _ -> return ()--    return True---handleButtonRelease :: UI -> WinInfo -> EventM EButton Bool-handleButtonRelease ui w = do-  (x, y)   <- eventCoordinates-  button   <- eventButton-  io $ do-    point <- pointToOffset (x, y) w-    disp  <- widgetGetDisplay $ textview w-    cb    <- clipboardGetForDisplay disp selectionPrimary-    case button of-         MiddleButton -> pasteSelectionClipboard ui w point cb-         LeftButton   -> setSelectionClipboard   ui w cb >>-                         writeIORef (lButtonPressed w) False-         _            -> return ()-  return True--handleScroll :: UI -> WinInfo -> EventM EScroll Bool-handleScroll ui w = do-  scrollDirection <- eventScrollDirection-  xy <- eventCoordinates-  io $ do-    ifPressed <- readIORef $ lButtonPressed w-    -- query new coordinates-    let editorAction =-          withCurrentBuffer $ scrollB $ case scrollDirection of-            ScrollUp   -> negate configAmount-            ScrollDown -> configAmount-            _          -> 0 -- Left/right scrolling not supported-        configAmount = configScrollWheelAmount $ uiConfig ui-    uiActionCh ui (EditorA editorAction)-    when ifPressed $ selectArea ui w xy-  return True--handleConfigure :: UI -> EventM EConfigure Bool-handleConfigure ui = do-  -- trigger a layout-  -- why does this cause a hang without postGUIAsync?-  io $ postGUIAsync $ uiActionCh ui (makeAction (return () :: EditorM()))-  return False -- allow event to be propagated--handleMove :: UI -> WinInfo -> EventM EMotion Bool-handleMove ui w = eventCoordinates >>= (io . selectArea ui w) >>-                  return True--handleDividerMove :: (Action -> IO ()) -> DividerRef -> DividerPosition -> IO ()-handleDividerMove actionCh ref pos =-  actionCh (makeAction (setDividerPosE ref pos))---- | Convert point coordinates to offset in Yi window-pointToOffset :: (Double, Double) -> WinInfo -> IO Point-pointToOffset (x,y) w =-  withMVar (winLayoutInfo w) $ \WinLayoutInfo{winLayout,tos,bufEnd} -> do-    im <- readIORef (insertingMode w)--    -- see Note [PangoLayout width]-    (_, charOffsetX, extra) <- layoutXYToIndex winLayout (max 0 (x-1)) y-    return $ min bufEnd (tos + fromIntegral-                         (charOffsetX + if im then extra else 0))--selectArea :: UI -> WinInfo -> (Double, Double) -> IO ()-selectArea ui w (x,y) = do-  p <- pointToOffset (x,y) w-  let editorAction = do-        txt <- withCurrentBuffer $ do-          moveTo p-          setVisibleSelection True-          readRegionB =<< getSelectRegionB-        setRegE txt--  uiActionCh ui (makeAction editorAction)-  -- drawWindowGetPointer (textview w) -- be ready for next message.--pasteSelectionClipboard :: UI -> WinInfo -> Point -> Clipboard -> IO ()-pasteSelectionClipboard ui w p cb = do-  win <- io $ readIORef (coreWin w)-  let cbHandler :: Maybe R.YiString -> IO ()-      cbHandler Nothing    = return ()-      cbHandler (Just txt) = uiActionCh ui $ EditorA $ do-        b <- gets $ bkey . findBufferWith (bufkey win)-        withGivenBufferAndWindow win b $ do-          pointB >>= setSelectionMarkPointB-          moveTo p-          insertN txt-  clipboardRequestText cb (cbHandler . fmap R.fromText)---- | Set selection clipboard contents to current selection-setSelectionClipboard :: UI -> WinInfo -> Clipboard -> IO ()-setSelectionClipboard ui _w cb = do-  -- Why uiActionCh doesn't allow returning values?-  selection <- newIORef mempty-  let yiAction = do-        txt <- withCurrentBuffer $-               fmap R.toText . readRegionB =<< getSelectRegionB :: YiM T.Text-        io $ writeIORef selection txt-  uiActionCh ui $ makeAction yiAction-  txt <- readIORef selection--  unless (T.null txt) $ clipboardSetText cb txt
− src/library/Yi/UI/Pango/Control.hs 
@@ -1,856 +0,0 @@-{-# LANGUAGE RecordWildCards, ScopedTypeVariables, MultiParamTypeClasses-           , DeriveDataTypeable, OverloadedStrings-           , GeneralizedNewtypeDeriving, FlexibleContexts #-}---- this module isn't finished, and there's heaps of warnings.-{-# OPTIONS_GHC -w #-}---- |--- Module      :  Yi.UI.Pango.Control--- License     :  GPL--module Yi.UI.Pango.Control (-    Control(..)-,   ControlM(..)-,   Buffer(..)-,   View(..)-,   Iter(..)-,   startControl-,   runControl-,   controlIO-,   liftYi-,   getControl-,   newBuffer-,   newView-,   getBuffer-,   setBufferMode-,   withCurrentBuffer-,   setText-,   getText-,   keyTable-) where--import Data.Text (unpack, pack, Text)-import qualified Data.Text as T-import Prelude hiding (concatMap, concat, foldl, elem, mapM_)-import Control.Exception (catch)-import Control.Monad        hiding (mapM_, forM_)-import Control.Monad.Reader hiding (mapM_, forM_)-import Control.Applicative-import Control.Lens hiding (views, Action)-import Data.Foldable-import Data.Maybe (maybe, fromJust, fromMaybe)-import Data.Monoid-import Data.IORef-import Data.List (nub, filter, drop, zip, take, length)-import Data.Prototype-import Yi.Rope (toText, splitAtLine, YiString)-import qualified Yi.Rope as R-import qualified Data.Map as Map-import Yi.Core (startEditor, focusAllSyntax)-import Yi.Buffer-import Yi.Config-import Yi.Tab-import Yi.Window as Yi-import Yi.Editor-import Yi.Event-import Yi.Keymap-import Yi.Monad-import Yi.Style-import Yi.UI.Utils-import Yi.Utils-import Yi.Debug-import Graphics.UI.Gtk as Gtk-       (Color(..), PangoRectangle(..), Rectangle(..), selectionDataSetText,-        targetString, clipboardSetWithData, clipboardRequestText,-        selectionPrimary, clipboardGetForDisplay, widgetGetDisplay,-        onMotionNotify, drawRectangle, drawLine,-        layoutIndexToPos, layoutGetCursorPos, drawLayout,-        widgetGetDrawWindow, layoutSetAttributes, widgetGrabFocus,-        scrolledWindowSetPolicy, scrolledWindowAddWithViewport,-        scrolledWindowNew, contextGetMetrics, contextGetLanguage,-        layoutSetFontDescription, layoutEmpty, widgetCreatePangoContext,-        widgetModifyBg, drawingAreaNew, FontDescription, ScrolledWindow,-        FontMetrics, Language, DrawingArea, layoutXYToIndex, layoutSetText,-        layoutGetText, widgetSetSizeRequest, layoutGetPixelExtents,-        layoutSetWidth, layoutGetWidth, layoutGetFontDescription,-        PangoLayout, descent, ascent, widgetGetSize, widgetQueueDraw,-        mainQuit, signalDisconnect, ConnectId(..), PolicyType(..),-        StateType(..), EventMask(..), AttrOp(..), Weight(..),-        PangoAttribute(..), Underline(..), FontStyle(..))-import Graphics.UI.Gtk.Gdk.GC as Gtk-  (newGCValues, gcSetValues, gcNew, foreground)-import qualified Graphics.UI.Gtk as Gtk-import qualified Graphics.UI.Gtk.Gdk.Events as Gdk.Events-import System.Glib.GError-import Control.Monad.Reader (ask, asks, MonadReader(..))-import Control.Monad.State (liftM, ap, get, put, modify)-import Control.Monad.Base-import Control.Concurrent (newMVar, modifyMVar, MVar, newEmptyMVar, putMVar,-                           readMVar, isEmptyMVar)-import Data.Typeable-import qualified Data.List.PointedList as PL (insertRight, withFocus,-                                              PointedList(..), singleton)-import Yi.Regex-import Yi.String (showT)-import System.FilePath-import qualified Yi.UI.Common as Common-import qualified Yi.Rope as R--data Control = Control-    { controlYi :: Yi-    , tabCache  :: IORef [TabInfo]-    , views     :: IORef (Map.Map WindowRef View)-    }---    { config  :: Config---    , editor  :: Editor---    , input   :: Event -> IO ()---    , output  :: Action -> IO ()---    }--data TabInfo = TabInfo-    { coreTab     :: Tab---    , page        :: VBox-    }--instance Show TabInfo where-    show t = show (coreTab t)----type ControlM = YiM-newtype ControlM a = ControlM { runControl'' :: ReaderT Control IO a }-    deriving (Monad, MonadBase IO, MonadReader Control, Typeable,-              Functor, Applicative)---- Helper functions to avoid issues with mismatching monad libraries-controlIO :: IO a -> ControlM a-controlIO = liftBase--getControl :: ControlM Control-getControl = ask--liftYi :: YiM a -> ControlM a-liftYi m = do-    yi <- asks controlYi-    liftBase $ runReaderT (runYiM m) yi----instance MonadState Editor ControlM where---    get = readRef =<< editor <$> ask---    put v = flip modifyRef (const v) =<< editor <$> ask----instance MonadEditor ControlM where---    askCfg = config <$> ask---    withEditor f = do---      r <- asks editor---      cfg <- asks config---      liftBase $ controlUnsafeWithEditor cfg r f--startControl :: Config -> ControlM () -> IO ()-startControl config main = startEditor (config { startFrontEnd = start main } ) Nothing--runControl' :: ControlM a -> MVar Control -> IO (Maybe a)-runControl' m yiMVar = do-    empty <- isEmptyMVar yiMVar-    if empty-        then return Nothing-        else do-            yi <- readMVar yiMVar-            result <- runControl m yi-            return $ Just result---- runControl :: ControlM a -> Yi -> IO a--- runControl m yi = runReaderT (runYiM m) yi--runControl :: ControlM a -> Control -> IO a-runControl f = runReaderT (runControl'' f)---- runControlEditor f yiMVar = yiMVar--runAction :: Action -> ControlM ()-runAction action = do-    out <- liftYi $ asks yiOutput-    liftBase $ out MustRefresh [action]---- | Test 2-mkUI :: IO () -> MVar Control -> Common.UI Editor-mkUI main yiMVar = Common.dummyUI-    { Common.main          = main-    , Common.end           = \_ -> void $ runControl' end yiMVar-    , Common.suspend       = void $ runControl' suspend yiMVar-    , Common.refresh       = \e -> void $ runControl' (refresh e) yiMVar-    , Common.layout        = \e -> liftM (fromMaybe e) $-                                   runControl' (doLayout e) yiMVar-    , Common.reloadProject = \f -> void $ runControl' (reloadProject f) yiMVar-    }--start :: ControlM () -> UIBoot-start main cfg ch outCh ed =-  catch (startNoMsg main cfg ch outCh ed) (\(GError _dom _code msg) ->-                                            fail $ unpack msg)--makeControl :: MVar Control -> YiM ()-makeControl controlMVar = do-    controlYi <- ask-    tabCache  <- liftBase $ newIORef []-    views  <- liftBase $ newIORef Map.empty-    liftBase $ putMVar controlMVar Control{..}--startNoMsg :: ControlM () -> UIBoot-startNoMsg main config input output ed = do-    control <- newEmptyMVar-    let wrappedMain = do-        output [makeAction $ makeControl control]-        void (runControl' main control)-    return (mkUI wrappedMain control)--end :: ControlM ()-end = do-    liftBase $ putStrLn "Yi Control End"-    liftBase mainQuit--suspend :: ControlM ()-suspend = do-    liftBase $ putStrLn "Yi Control Suspend"-    return ()--{-# ANN refresh ("HLint: ignore Redundant do" :: String) #-}-refresh :: Editor -> ControlM ()-refresh e = do-    --contextId <- statusbarGetContextId (uiStatusbar ui) "global"-    --statusbarPop  (uiStatusbar ui) contextId-    --statusbarPush (uiStatusbar ui) contextId $ intercalate "  " $ statusLine e--    updateCache e -- The cursor may have changed since doLayout-    viewsRef <- asks views-    vs <- liftBase $ readIORef viewsRef-    forM_ (Map.elems vs) $ \v -> do-        let b = findBufferWith (viewFBufRef v) e-        -- when (not $ null $ b ^. pendingUpdatesA) $-        do-            -- sig <- readIORef (renderer w)-            -- signalDisconnect sig-            -- writeRef (renderer w)-            -- =<< (textview w `onExpose` render e ui b (wkey (coreWin w)))-            liftBase $ widgetQueueDraw (drawArea v)--doLayout :: Editor -> ControlM Editor-doLayout e = do-    liftBase $ putStrLn "Yi Control Do Layout"-    updateCache e-    cacheRef <- asks tabCache-    tabs <- liftBase $ readIORef cacheRef-    heights <- concat <$> mapM (getHeightsInTab e) tabs-    let e' = (tabsA %~ fmap (mapWindows updateWin)) e-        updateWin w = case find (\(ref,_,_) -> (wkey w == ref)) heights of-                          Nothing -> w-                          Just (_,h,rgn) -> w { height = h, winRegion = rgn }--    -- Don't leak references to old Windows-    let forceWin x w = height w `seq` winRegion w `seq` x-    return $ (foldl . tabFoldl) forceWin e' (e' ^. tabsA)--getHeightsInTab :: Editor -> TabInfo -> ControlM [(WindowRef,Int,Region)]-getHeightsInTab e tab = do-  viewsRef <- asks views-  vs <- liftBase $ readIORef viewsRef-  foldlM (\a w ->-        case Map.lookup (wkey w) vs of-            Just v -> do-                (_, h) <- liftBase $ widgetGetSize $ drawArea v-                let lineHeight = ascent (metrics v) + descent (metrics v)-                let b0 = findBufferWith (viewFBufRef v) e-                rgn <- shownRegion e v b0-                let ret= (windowRef v, round $ fromIntegral h / lineHeight, rgn)-                return $ a <> [ret]-            Nothing -> return a)-      [] (coreTab tab ^. tabWindowsA)--shownRegion :: Editor -> View -> FBuffer -> ControlM Region-shownRegion e v b = do-   (tos, _, bos) <- updatePango e v b (layout v)-   return $ mkRegion tos bos--updatePango :: Editor -> View -> FBuffer -> PangoLayout-            -> ControlM (Point, Point, Point)-updatePango e v b layout = do-  (width', height') <- liftBase $ widgetGetSize $ drawArea v--  font <- liftBase $ layoutGetFontDescription layout--  --oldFont <- layoutGetFontDescription layout-  --oldFontStr <- maybe (return Nothing)-  --              (fmap Just . fontDescriptionToString) oldFont-  --newFontStr <- Just <$> fontDescriptionToString font-  --when (oldFontStr /= newFontStr)-  --  (layoutSetFontDescription layout (Just font))--  let win                 = findWindowWith (windowRef v) e-      [width'', height''] = map fromIntegral [width', height']-      lineHeight          = ascent (metrics v) + descent (metrics v)-      winh                = max 1 $ floor (height'' / lineHeight)--      (tos, point, text)  = askBuffer win b $ do-                              from <- (use . markPointA) =<< fromMark <$> askMarks-                              rope <- streamB Forward from-                              p    <- pointB-                              let content = fst $ splitAtLine winh rope-                              -- allow BOS offset to be just after the last line-                              let addNL = if R.countNewLines content == winh-                                          then id-                                          else (`R.snoc` '\n')-                              return (from, p, R.toText $ addNL content)--  config   <- liftYi askCfg-  if configLineWrap $ configUI config-    then do oldWidth <- liftBase $ layoutGetWidth layout-            when (oldWidth /= Just width'') $-              liftBase $ layoutSetWidth layout $ Just width''-    else do-    (Rectangle px _py pwidth _pheight, _) <- liftBase $-                                             layoutGetPixelExtents layout-    liftBase $ widgetSetSizeRequest (drawArea v) (px+pwidth) (-1)--  -- optimize for cursor movement-  oldText <- liftBase $ layoutGetText layout-  when (oldText /= text) $ liftBase $ layoutSetText layout text--  (_, bosOffset, _) <- liftBase $ layoutXYToIndex layout width''-                       (fromIntegral winh * lineHeight - 1)-  return (tos, point, tos + fromIntegral bosOffset + 1)--updateCache :: Editor -> ControlM ()-updateCache e = do-    let tabs = e ^. tabsA-    cacheRef <- asks tabCache-    cache <- liftBase $ readIORef cacheRef-    cache' <- syncTabs e (toList $ PL.withFocus tabs) cache-    liftBase $ writeIORef cacheRef cache'--syncTabs :: Editor -> [(Tab, Bool)] -> [TabInfo] -> ControlM [TabInfo]-syncTabs e (tfocused@(t,focused):ts) (c:cs)-    | t == coreTab c =-        do when focused $ setTabFocus c---           let vCache = views c-           (:) <$> syncTab e c t <*> syncTabs e ts cs-    | t `elem` map coreTab cs =-        do removeTab c-           syncTabs e (tfocused:ts) cs-    | otherwise =-        do c' <- insertTabBefore e t c-           when focused $ setTabFocus c'-           return (c':) `ap` syncTabs e ts (c:cs)-syncTabs e ts [] = mapM (\(t,focused) -> do-        c' <- insertTab e t-        when focused $ setTabFocus c'-        return c') ts-syncTabs _ [] cs = mapM_ removeTab cs >> return []--syncTab :: Editor -> TabInfo -> Tab -> ControlM TabInfo-syncTab e tab ws =-  -- TODO Maybe do something here-  return tab--setTabFocus :: TabInfo -> ControlM ()-setTabFocus t =-  -- TODO this needs to set the tab focus with callback-  -- but only if the tab focus has changed-  return ()--askBuffer :: Yi.Window -> FBuffer -> BufferM a -> a-askBuffer w b f = fst $ runBuffer w b f--setWindowFocus :: Editor -> TabInfo -> View -> ControlM ()-setWindowFocus e t v = do-  let bufferName = shortIdentString (length $ commonNamePrefix e) $-                   findBufferWith (viewFBufRef v) e-      window = findWindowWith (windowRef v) e-      ml = askBuffer window (findBufferWith (viewFBufRef v) e) $-           getModeLine (T.pack <$> commonNamePrefix e)---- TODO---  update (textview w) widgetIsFocus True---  update (modeline w) labelText ml---  update (uiWindow ui) windowTitle $ bufferName <> " - Yi"---  update (uiNotebook ui) (notebookChildTabLabel (page t))---    (tabAbbrevTitle bufferName)-  return ()--removeTab :: TabInfo -> ControlM ()-removeTab t =-  -- TODO this needs to close the views in the tab with callback-  return ()--removeView :: TabInfo -> View -> ControlM ()-removeView tab view =-  -- TODO this needs to close the view with callback-  return ()---- | Make a new tab.-newTab :: Editor -> Tab -> ControlM TabInfo-newTab e ws = do-    let t' = TabInfo { coreTab = ws }---    cache <- syncWindows e t' (toList $ PL.withFocus ws) []-    return t' -- { views = cache }--{-# ANN insertTabBefore ("HLint: ignore Redundant do" :: String) #-}-insertTabBefore :: Editor -> Tab -> TabInfo -> ControlM TabInfo-insertTabBefore e ws c = do-    -- Just p <- notebookPageNum (uiNotebook ui) (page c)-    -- vb <- vBoxNew False 1-    -- notebookInsertPage (uiNotebook ui) vb "" p-    -- widgetShowAll $ vb-    newTab e ws--{-# ANN insertTab ("HLint: ignore Redundant do" :: String) #-}-insertTab :: Editor -> Tab -> ControlM TabInfo-insertTab e ws = do-    -- vb <- vBoxNew False 1-    -- notebookAppendPage (uiNotebook ui) vb ""-    -- widgetShowAll $ vb-    newTab e ws--{--insertWindowBefore :: Editor -> TabInfo -> Yi.Window -> WinInfo -> IO WinInfo-insertWindowBefore e ui tab w _c = insertWindow e ui tab w--insertWindowAtEnd :: Editor -> UI -> TabInfo -> Window -> IO WinInfo-insertWindowAtEnd e ui tab w = insertWindow e ui tab w--insertWindow :: Editor -> UI -> TabInfo -> Window -> IO WinInfo-insertWindow e ui tab win = do-  let buf = findBufferWith (bufkey win) e-  liftBase $ do w <- newWindow e ui win buf--              set (page tab) $-                [ containerChild := widget w-                , boxChildPacking (widget w) :=-                    if isMini (coreWin w)-                        then PackNatural-                        else PackGrow-                ]--              let ref = (wkey . coreWin) w-              textview w `onButtonRelease` handleClick ui ref-              textview w `onButtonPress` handleClick ui ref-              textview w `onScroll` handleScroll ui ref-              textview w `onConfigure` handleConfigure ui ref-              widgetShowAll (widget w)--              return w--}--reloadProject :: FilePath -> ControlM ()-reloadProject _ = return ()--controlUnsafeWithEditor :: Config -> MVar Editor -> EditorM a -> IO a-controlUnsafeWithEditor cfg r f = modifyMVar r $ \e -> do-  let (e',a) = runEditor cfg f e-  -- Make sure that the result of runEditor is evaluated before-  -- replacing the editor state. Otherwise, we might replace e-  -- with an exception-producing thunk, which makes it impossible-  -- to look at or update the editor state.-  -- Maybe this could also be fixed by -fno-state-hack flag?-  -- TODO: can we simplify this?-  e' `seq` a `seq` return (e', a)--data Buffer = Buffer-    { fBufRef     :: BufferRef-    }--data View = View-    { viewFBufRef :: BufferRef-    , windowRef   :: WindowRef-    , drawArea    :: DrawingArea-    , layout      :: PangoLayout-    , language    :: Language-    , metrics     :: FontMetrics-    , scrollWin   :: ScrolledWindow-    , shownTos    :: IORef Point-    , winMotionSignal :: IORef (Maybe (ConnectId DrawingArea))-    }--data Iter = Iter-    { iterFBufRef :: BufferRef-    , point       :: Point-    }--newBuffer :: BufferId -> R.YiString -> ControlM Buffer-newBuffer id text = do-    fBufRef <- liftYi . withEditor . newBufferE id $ text-    return Buffer{..}--newView :: Buffer -> FontDescription -> ControlM View-newView buffer font = do-    control  <- ask-    config   <- liftYi askCfg-    let viewFBufRef = fBufRef buffer-    newWindow <--      fmap (\w -> w { height=50-                    , winRegion = mkRegion (Point 0) (Point 2000)-                    }) $ liftYi $ withEditor $ newWindowE False viewFBufRef-    let windowRef = wkey newWindow-    liftYi $ withEditor $ do-        windowsA %= PL.insertRight newWindow-        e <- get-        put $ focusAllSyntax e-    drawArea <- liftBase drawingAreaNew-    liftBase . widgetModifyBg drawArea StateNormal . mkCol False-      . Yi.Style.background . baseAttributes . configStyle $ configUI config-    context  <- liftBase $ widgetCreatePangoContext drawArea-    layout   <- liftBase $ layoutEmpty context-    liftBase $ layoutSetFontDescription layout (Just font)-    language <- liftBase $ contextGetLanguage context-    metrics  <- liftBase $ contextGetMetrics context font language-    liftBase $ layoutSetText layout ("" :: Text)--    scrollWin <- liftBase $ scrolledWindowNew Nothing Nothing-    liftBase $ do-        scrolledWindowAddWithViewport scrollWin drawArea-        scrolledWindowSetPolicy scrollWin PolicyAutomatic PolicyNever--    initialTos <--      liftYi . withEditor . withGivenBufferAndWindow newWindow viewFBufRef $-        (use . markPointA) =<< fromMark <$> askMarks-    shownTos <- liftBase $ newIORef initialTos-    winMotionSignal <- liftBase $ newIORef Nothing--    let view = View {..}--    liftBase $ Gtk.widgetAddEvents drawArea [KeyPressMask]-    liftBase $ Gtk.set drawArea [Gtk.widgetCanFocus := True]--    liftBase $ drawArea `Gtk.onKeyPress` \event -> do-        putStrLn $ "Yi Control Key Press = " <> show event-        runControl (runAction $ makeAction $ do-            focusWindowE windowRef-            switchToBufferE viewFBufRef) control-        result <- processEvent (yiInput $ controlYi control) event-        widgetQueueDraw drawArea-        return result--    liftBase $ drawArea `Gtk.onButtonPress` \event -> do-        widgetGrabFocus drawArea-        runControl (handleClick view event) control--    liftBase $ drawArea `Gtk.onButtonRelease` \event ->-        runControl (handleClick view event) control--    liftBase $ drawArea `Gtk.onScroll` \event ->-        runControl (handleScroll view event) control--    liftBase $ drawArea `Gtk.onExpose` \event -> do-        (text, allAttrs, debug, tos, rel, point, inserting) <--          runControl (liftYi $ withEditor $ do-            window <- findWindowWith windowRef <$> get-            (%=) buffersA (fmap (clearSyntax . clearHighlight))-            let winh = height window-            let tos = max 0 (regionStart (winRegion window))-            let bos = regionEnd (winRegion window)-            let rel p = fromIntegral (p - tos)--            withGivenBufferAndWindow window viewFBufRef $ do-                -- tos       <- getMarkPointB =<< fromMark <$> askMarks-                rope      <- streamB Forward tos-                point     <- pointB-                inserting <- use insertingA--                modeNm <- gets (withMode0 modeName)--    --            let (tos, point, text, picture) = do runBu-    --                        from     <- getMarkPointB =<< fromMark <$> askMarks-    --                        rope     <- streamB Forward from-    --                        p        <- pointB-                let content = fst $ splitAtLine winh rope-                -- allow BOS offset to be just after the last line-                let addNL = if R.countNewLines content == winh-                              then id-                              else (`R.snoc` '\n')-                    sty = configStyle $ configUI config-                          -- attributesPictureAndSelB sty (currentRegex e)-                          --   (mkRegion tos bos)-                          -- return (from, p, addNL $ Rope.toString content,-                          --         picture)-                let text = R.toText $ addNL content--                picture <- attributesPictureAndSelB sty Nothing-                           (mkRegion tos bos)--                -- add color attributes.-                let picZip = zip picture $ drop 1 (fst <$> picture) <> [bos]-                    strokes = [ (start',s,end') | ((start', s), end') <- picZip-                                                , s /= emptyAttributes ]--                    rel p = fromIntegral (p - tos)-                    allAttrs = concat $ do-                      (p1, Attributes fg bg _rv bd itlc udrl, p2) <- strokes-                      let atr x = x (rel p1) (rel p2)-                          if' p x y = if p then x else y-                      return [ atr AttrForeground $ mkCol True fg-                             , atr AttrBackground $ mkCol False bg-                             , atr AttrStyle $ if' itlc StyleItalic StyleNormal-                             , atr AttrUnderline $-                                 if' udrl UnderlineSingle UnderlineNone-                             , atr AttrWeight $ if' bd WeightBold WeightNormal-                             ]---                return (text, allAttrs, (picture, strokes, modeNm,-                                         window, tos, bos, winh),-                        tos, rel, point, inserting)) control--        -- putStrLn $ "Setting Layout Attributes " <> show debug-        layoutSetAttributes layout allAttrs-        -- putStrLn "Done Stting Layout Attributes"-        dw      <- widgetGetDrawWindow drawArea-        gc      <- gcNew dw-        oldText <- layoutGetText layout-        when (text /= oldText) $ layoutSetText layout text-        drawLayout dw gc 0 0 layout-        liftBase $ writeIORef shownTos tos--        -- paint the cursor-        (PangoRectangle curx cury curw curh, _) <--          layoutGetCursorPos layout (rel point)-        PangoRectangle chx chy chw chh          <--          layoutIndexToPos layout (rel point)--        gcSetValues gc-          (newGCValues { Gtk.foreground = mkCol True . Yi.Style.foreground-                                          . baseAttributes . configStyle $-                                          configUI config })-        if inserting-          then drawLine dw gc (round curx, round cury) (round $ curx + curw, round $ cury + curh)-          else drawRectangle dw gc False (round chx) (round chy) (if chw > 0 then round chw else 8) (round chh)--        return True--    liftBase $ widgetGrabFocus drawArea--    tabsRef <- asks tabCache-    ts <- liftBase $ readIORef tabsRef-    -- TODO: the Tab idkey should be assigned using-    -- Yi.Editor.newRef. But we can't modify that here, since our-    -- access to 'Yi' is readonly.-    liftBase $ writeIORef tabsRef (TabInfo (makeTab1 0 newWindow):ts)--    viewsRef <- asks views-    vs <- liftBase $ readIORef viewsRef-    liftBase $ writeIORef viewsRef $ Map.insert windowRef view vs--    return view-  where-    clearHighlight fb =-      -- if there were updates, then hide the selection.-      let h = view highlightSelectionA fb-          us = view pendingUpdatesA fb-      in highlightSelectionA .~ (h && null us) $ fb--{-# ANN setBufferMode ("HLint: ignore Redundant do" :: String) #-}-setBufferMode :: FilePath -> Buffer -> ControlM ()-setBufferMode f buffer = do-    let bufRef = fBufRef buffer-    -- adjust the mode-    tbl <- liftYi $ asks (modeTable . yiConfig)-    contents <- liftYi $ withGivenBuffer bufRef elemsB-    let header = R.toString $ R.take 1024 contents-        hmode = case header =~ ("\\-\\*\\- *([^ ]*) *\\-\\*\\-" :: String) of-            AllTextSubmatches [_,m] -> T.pack m-            _ -> ""-        Just mode = find (\(AnyMode m)-> modeName m == hmode) tbl <|>-                    find (\(AnyMode m)-> modeApplies m f contents) tbl <|>-                    Just (AnyMode emptyMode)-    case mode of-        AnyMode newMode -> do-            -- liftBase $ putStrLn $ show (f, modeName newMode)-            liftYi $ withEditor $ do-                withGivenBuffer bufRef $ do-                    setMode newMode-                    modify clearSyntax-                switchToBufferE bufRef-            -- withEditor focusAllSyntax--withBuffer :: Buffer -> BufferM a -> ControlM a-withBuffer Buffer{fBufRef = b} f = liftYi $ withGivenBuffer b f--getBuffer :: View -> Buffer-getBuffer view = Buffer {fBufRef = viewFBufRef view}--setText :: Buffer -> YiString -> ControlM ()-setText b text = withBuffer b $ do-    r <- regionOfB Document-    replaceRegionB r text--getText :: Buffer -> Iter -> Iter -> ControlM Text-getText b Iter{point = p1} Iter{point = p2} =-  fmap toText . withBuffer b . readRegionB $ mkRegion p1 p2--mkCol :: Bool -- ^ is foreground?-      -> Yi.Style.Color -> Gtk.Color-mkCol True  Default = Color 0 0 0-mkCol False Default = Color maxBound maxBound maxBound-mkCol _ (RGB x y z) = Color (fromIntegral x * 256)-                            (fromIntegral y * 256)-                            (fromIntegral z * 256)--handleClick :: View -> Gdk.Events.Event -> ControlM Bool-handleClick view event = do-  control  <- ask-  -- (_tabIdx,winIdx,w) <- getWinInfo ref <$> readIORef (tabCache ui)--  logPutStrLn $ "Click: " <> showT (Gdk.Events.eventX event,-                                    Gdk.Events.eventY event,-                                    Gdk.Events.eventClick event)--  -- retrieve the clicked offset.-  (_,layoutIndex,_) <- io $ layoutXYToIndex (layout view)-                       (Gdk.Events.eventX event) (Gdk.Events.eventY event)-  tos <- liftBase $ readIORef (shownTos view)-  let p1 = tos + fromIntegral layoutIndex--  let winRef = windowRef view--  -- maybe focus the window-  -- logPutStrLn $ "Clicked inside window: " <> show view----  let focusWindow = do-      -- TODO: check that tabIdx is the focus?---      (%=) windowsA (fromJust . PL.move winIdx)--  liftBase $ case (Gdk.Events.eventClick event, Gdk.Events.eventButton event) of-     (Gdk.Events.SingleClick, Gdk.Events.LeftButton) -> do-        cid <- onMotionNotify (drawArea view) False $ \event ->-            runControl (handleMove view p1 event) control-        writeIORef (winMotionSignal view) $ Just cid--     _ -> do-       maybe (return ()) signalDisconnect =<< readIORef (winMotionSignal view)-       writeIORef (winMotionSignal view) Nothing--  case (Gdk.Events.eventClick event, Gdk.Events.eventButton event) of-    (Gdk.Events.SingleClick, Gdk.Events.LeftButton) ->-      runAction . EditorA $ do-        -- b <- gets $ (bkey . findBufferWith (viewFBufRef view))-        -- focusWindow-        window <- findWindowWith winRef <$> get-        withGivenBufferAndWindow window (viewFBufRef view) $ do-            moveTo p1-            setVisibleSelection False-    -- (Gdk.Events.SingleClick, _) -> runAction focusWindow-    (Gdk.Events.ReleaseClick, Gdk.Events.MiddleButton) -> do-        disp <- liftBase $ widgetGetDisplay (drawArea view)-        cb <- liftBase $ clipboardGetForDisplay disp selectionPrimary-        let cbHandler :: Maybe R.YiString -> IO ()-            cbHandler Nothing = return ()-            cbHandler (Just txt) = runControl (runAction . EditorA $ do-                window <- findWindowWith winRef <$> get-                withGivenBufferAndWindow window (viewFBufRef view) $ do-                    pointB >>= setSelectionMarkPointB-                    moveTo p1-                    insertN txt) control-        liftBase $ clipboardRequestText cb (cbHandler . fmap R.fromText)-    _ -> return ()--  liftBase $ widgetQueueDraw (drawArea view)-  return True--handleScroll :: View -> Gdk.Events.Event -> ControlM Bool-handleScroll view event = do-  let editorAction =-        withCurrentBuffer $ vimScrollB $ case Gdk.Events.eventDirection event of-                        Gdk.Events.ScrollUp   -> -1-                        Gdk.Events.ScrollDown -> 1-                        _ -> 0 -- Left/right scrolling not supported--  runAction $ EditorA editorAction-  liftBase $ widgetQueueDraw (drawArea view)-  return True--handleMove :: View -> Point -> Gdk.Events.Event -> ControlM Bool-handleMove view p0 event = do-  logPutStrLn $ "Motion: " <> showT (Gdk.Events.eventX event,-                                     Gdk.Events.eventY event)--  -- retrieve the clicked offset.-  (_,layoutIndex,_) <--    liftBase $ layoutXYToIndex (layout view)-    (Gdk.Events.eventX event) (Gdk.Events.eventY event)-  tos <- liftBase $ readIORef (shownTos view)-  let p1 = tos + fromIntegral layoutIndex---  let editorAction = do-        txt <- withCurrentBuffer $-           if p0 /= p1-            then Just <$> do-              m <- selMark <$> askMarks-              markPointA m .= p0-              moveTo p1-              setVisibleSelection True-              readRegionB =<< getSelectRegionB-            else return Nothing-        maybe (return ()) setRegE txt--  runAction $ makeAction editorAction-  -- drawWindowGetPointer (textview w) -- be ready for next message.--  -- Relies on uiActionCh being synchronous-  selection <- liftBase $ newIORef ""-  let yiAction = do-      txt <- (withCurrentBuffer (readRegionB =<< getSelectRegionB))-             :: YiM R.YiString-      liftBase $ writeIORef selection txt-  runAction $ makeAction yiAction-  txt <- liftBase $ readIORef selection--  disp <- liftBase $ widgetGetDisplay (drawArea view)-  cb <- liftBase $ clipboardGetForDisplay disp selectionPrimary-  liftBase $ clipboardSetWithData cb [(targetString,0)]-      (\0 -> void (selectionDataSetText $ R.toText txt)) (return ())--  liftBase $ widgetQueueDraw (drawArea view)-  return True--processEvent :: ([Event] -> IO ()) -> Gdk.Events.Event -> IO Bool-processEvent ch ev = do-  -- logPutStrLn $ "Gtk.Event: " <> show ev-  -- logPutStrLn $ "Event: " <> show (gtkToYiEvent ev)-  case gtkToYiEvent ev of-    Nothing -> logPutStrLn $ "Event not translatable: " <> showT ev-    Just e -> ch [e]-  return True--gtkToYiEvent :: Gdk.Events.Event -> Maybe Event-gtkToYiEvent (Gdk.Events.Key {Gdk.Events.eventKeyName = key-                             , Gdk.Events.eventModifier = evModifier-                             , Gdk.Events.eventKeyChar = char})-    = fmap (\k -> Event k $ (nub $ (if isShift-                                    then filter (/= MShift)-                                    else id) $ concatMap modif evModifier)) key'-      where (key',isShift) =-                case char of-                  Just c -> (Just $ KASCII c, True)-                  Nothing -> (Map.lookup key keyTable, False)-            modif Gdk.Events.Control = [MCtrl]-            modif Gdk.Events.Alt = [MMeta]-            modif Gdk.Events.Shift = [MShift]-            modif _ = []-gtkToYiEvent _ = Nothing---- | Map GTK long names to Keys-keyTable :: Map.Map Text Key-keyTable = Map.fromList-    [("Down",       KDown)-    ,("Up",         KUp)-    ,("Left",       KLeft)-    ,("Right",      KRight)-    ,("Home",       KHome)-    ,("End",        KEnd)-    ,("BackSpace",  KBS)-    ,("Delete",     KDel)-    ,("Page_Up",    KPageUp)-    ,("Page_Down",  KPageDown)-    ,("Insert",     KIns)-    ,("Escape",     KEsc)-    ,("Return",     KEnter)-    ,("Tab",        KTab)-    ,("ISO_Left_Tab", KTab)-    ]
− src/library/Yi/UI/Pango/Layouts.hs 
@@ -1,424 +0,0 @@-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ViewPatterns #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.UI.Pango.Layouts--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Provides abstract controls which implement 'Yi.Layout.Layout's and--- which manage the minibuffer.------ The implementation strategy is to first construct the layout--- managers @WeightedStack@ (implementing the 'Stack' constructor) and--- @SlidingPair@ (implementing the 'Pair' constructor), and then--- construct 'LayoutDisplay' as a tree of these, mirroring the--- structure of 'Layout'.--module Yi.UI.Pango.Layouts (-  -- * Getting the underlying widget-  WidgetLike(..),-  -- * Window layout-  LayoutDisplay,-  layoutDisplayNew,-  layoutDisplaySet,-  layoutDisplayOnDividerMove,-  -- * Miniwindow layout-  MiniwindowDisplay,-  miniwindowDisplayNew,-  miniwindowDisplaySet,-  -- * Tabs-  SimpleNotebook,-  simpleNotebookNew,-  simpleNotebookSet,-  simpleNotebookOnSwitchPage,-  -- * Utils-  update,- ) where--import           Control.Applicative-import           Control.Arrow (first)-import           Control.Monad hiding (mapM, forM)-import           Data.Foldable (toList)-import           Data.IORef-import qualified Data.List.PointedList as PL-import qualified Data.Text as T-import           Data.Traversable-import           Graphics.UI.Gtk as Gtk hiding(Orientation, Layout)-import           Prelude hiding (mapM)-import           Yi.Layout(Orientation(..), RelativeSize, DividerPosition,-                           Layout(..), DividerRef)--class WidgetLike w where-  -- | Extracts the main widget. This is the widget to be added to the GUI.-  baseWidget :: w -> Widget------------------------- The WeightedStack type-{- | A @WeightedStack@ is like a 'VBox' or 'HBox', except that we may-specify the ratios of the areas of the child widgets (so this-implements the 'Stack' constructor of 'Yi.Layout.Layout'.--Essentially, we implement this layout manager from scratch, by-implementing the 'sizeRequest' and 'sizeAllocate' signals by hand (see-the 'Container' documentation for details, and-http://www.ibm.com/developerworks/linux/library/l-widget-pygtk/ for an-example in Python). Ideally, we would directly subclass the abstract-class 'Container', but Gtk2hs doesn't directly support this. Instead,-we start off with the concrete class 'Fixed', and just override its-layout behaviour.--}--newtype WeightedStack = WS Fixed-  deriving(GObjectClass, ObjectClass, WidgetClass,ContainerClass)--type StackDescr = [(Widget, RelativeSize)]--weightedStackNew :: Orientation -> StackDescr -> IO WeightedStack-weightedStackNew o s = do-  when (any ((<= 0) . snd) s) $ error-    "Yi.UI.Pango.WeightedStack.WeightedStack: all weights must be positive"-  l <- fixedNew-  set l (fmap ((containerChild :=) . fst) s)-  void $ Gtk.on l sizeRequest (doSizeRequest o s)-  void $ Gtk.on l sizeAllocate (relayout o s)-  return (WS l)---- | Requests the smallest size so that each widget gets its requested size-doSizeRequest :: Orientation -> StackDescr -> IO Requisition-doSizeRequest o s =-  let-    (requestAlong, requestAcross) =-      case o of-        Horizontal ->-          (\(Requisition w _) -> fromIntegral w,-           \(Requisition _ h) -> h)-        Vertical ->-          (\(Requisition _ h) -> fromIntegral h,-           \(Requisition w _) -> w)--    totalWeight = sum . fmap snd $ s-    reqsize (request, relSize) = requestAlong request / relSize-    sizeAlong widgetRequests =-      totalWeight * (maximum . fmap reqsize $ widgetRequests)-    sizeAcross widgetRequests =-      maximum . fmap (requestAcross . fst) $ widgetRequests-    mkRequisition wr =-      case o of-        Horizontal -> Requisition (round $ sizeAlong wr) (sizeAcross wr)-        Vertical -> Requisition (sizeAcross wr) (round $ sizeAlong wr)-    swreq (w, relSize) = (,relSize) <$> widgetSizeRequest w-  in-   boundRequisition =<< mkRequisition <$> mapM swreq s----- | Bounds the given requisition to not exceed screen dimensions-boundRequisition :: Requisition -> IO Requisition-boundRequisition r@(Requisition w h) =-  do-    mscr <- screenGetDefault-    case mscr of-      Just scr -> Requisition <$> (min w <$> screenGetWidth scr)-                              <*> (min h <$> screenGetHeight scr)-      Nothing -> return r---- | Position the children appropriately for the given width and height-relayout :: Orientation -> StackDescr -> Rectangle -> IO ()-relayout o s (Rectangle x y width height) =-  let-    totalWeight = sum . fmap snd $ s-    totalSpace = fromIntegral $-      case o of-        Horizontal -> width-        Vertical -> height-    wtMult = totalSpace / totalWeight-    calcPosition pos (widget, wt) = (pos + wt * wtMult,-                                     (pos, wt * wtMult, widget))-    widgetToRectangle (round -> pos, round -> size, widget) =-      case o of-        Horizontal -> (Rectangle pos y size height, widget)-        Vertical -> (Rectangle x pos width size, widget)-    startPosition = fromIntegral $-      case o of-        Horizontal -> x-        Vertical -> y-    widgetPositions =-      fmap widgetToRectangle (snd (mapAccumL calcPosition startPosition s))-  in forM_ widgetPositions $ \(rect, widget) -> widgetSizeAllocate widget rect--------------------------------------------------------- SlidingPair--{-|-'SlidingPair' implements the 'Pair' constructor.--Most of what is needed is already implemented by the 'HPaned' and-'VPaned' classes. The main feature added by 'SlidingPair' is that the-divider position, *as a fraction of the available space*, remains-constant even when resizing.--}--newtype SlidingPair = SP Paned-  deriving(GObjectClass, ObjectClass, WidgetClass, ContainerClass)--slidingPairNew :: (WidgetClass w1, WidgetClass w2) => Orientation -> w1 -> w2-               -> DividerPosition-               -> (DividerPosition -> IO ())-               -> IO SlidingPair-slidingPairNew o w1 w2 pos handleNewPos = do-  p <--    case o of-      Horizontal -> toPaned <$> hPanedNew-      Vertical -> toPaned <$> vPanedNew-  panedPack1 p w1 True True-  panedPack2 p w2 True True--{- We want to catch the sizeAllocate signal. If this event is-called, two things could have happened: the size could have changed;-or the slider could have moved.  We want to correct the slider-position, but only if the size has changed. Furthermore, if the size-only changes in the direction /orthogonal/ to the slider, then there-is also no need to correct the slider position.---}--  posRef <- newIORef pos-  sizeRef <- newIORef 0--  void $ Gtk.on p sizeAllocate $ \(Rectangle _ _ w h) ->-    do-      oldSz <- readIORef sizeRef-      oldPos <- readIORef posRef--      let sz = case o of-            Horizontal -> w-            Vertical -> h-      writeIORef sizeRef sz-      when (sz /= 0) $-        if sz == oldSz-        then do -- the slider was moved; store its new position-          sliderPos <- get p panedPosition-          let newPos = fromIntegral sliderPos / fromIntegral sz-          writeIORef posRef newPos-          when (oldPos /= newPos) $ handleNewPos newPos-        else -- the size was changed; restore the slider position and-             -- save the new position-          set p [ panedPosition := round (oldPos * fromIntegral sz) ]--  return (SP p)------------------------------- LayoutDisplay--- | A container implements 'Layout's.-data LayoutDisplay-  = LD {-     mainWidget :: Bin,-     implWidget :: IORef (Maybe LayoutImpl),-     dividerCallbacks :: IORef [DividerRef -> DividerPosition -> IO ()]-     }---- | Tree mirroring 'Layout', which holds the layout widgets for 'LayoutDisplay'-data LayoutImpl-  = SingleWindowI {-      singleWidget :: Widget-    }-  | StackI {-      orientationI :: Orientation,-      winsI :: [(LayoutImpl, RelativeSize)],-      stackWidget :: WeightedStack-    }-  | PairI {-      orientationI :: Orientation,-      pairFstI :: LayoutImpl,-      pairSndI :: LayoutImpl,-      divRefI :: DividerRef,-      pairWidget :: SlidingPair-    }----- construction-layoutDisplayNew :: IO LayoutDisplay-layoutDisplayNew = do-  cbRef <- newIORef []-  implRef <- newIORef Nothing-  box <- toBin <$> alignmentNew 0 0 1 1-  return (LD box implRef cbRef)---- | Registers a callback to a divider changing position. (There is--- currently no way to unregister.)-layoutDisplayOnDividerMove :: LayoutDisplay-                           -> (DividerRef -> DividerPosition -> IO ())-                           -> IO ()-layoutDisplayOnDividerMove ld cb = modifyIORef (dividerCallbacks ld) (cb:)----- changing the layout---- | Sets the layout to the given schema.------ * it is permissible to add or remove widgets in this process.------ * as an optimisation, this function will first check whether the--- layout has actually changed (so the caller need not be concerned--- with this)------ * will run 'widgetShowAll', and hence will show the underlying widgets too-layoutDisplaySet :: LayoutDisplay -> Layout Widget -> IO ()-layoutDisplaySet ld lyt = do-  mimpl <- readIORef (implWidget ld)--  let applyLayout = do-        impl' <- buildImpl (runCb $ dividerCallbacks ld) lyt-        widgetShowAll (outerWidget impl')-        set (mainWidget ld) [containerChild := outerWidget impl']-        writeIORef (implWidget ld) (Just impl')--  case mimpl of-    Nothing -> applyLayout-    Just impl -> unless (sameLayout impl lyt) $ do-      unattachWidgets (toContainer $ mainWidget ld) impl-      applyLayout--runCb :: IORef [DividerRef -> DividerPosition -> IO ()]-      -> DividerRef -> DividerPosition -> IO ()-runCb cbRef dRef dPos = readIORef cbRef >>= mapM_ (\cb -> cb dRef dPos)--buildImpl :: (DividerRef -> DividerPosition -> IO ())-          -> Layout Widget -> IO LayoutImpl-buildImpl cb = go-  where-    go (SingleWindow w) = return (SingleWindowI w)-    go (s@Stack{}) = do-      impls <- forM (wins s) $ \(lyt,relSize) -> (,relSize) <$> go lyt-      ws <- weightedStackNew (orientation s) (first outerWidget <$> impls)-      return (StackI (orientation s) impls ws)-    go (p@Pair{}) = do-      w1 <- go (pairFst p)-      w2 <- go (pairSnd p)-      sp <- slidingPairNew (orientation p) (outerWidget w1)-                           (outerWidget w2) (divPos p) (cb $ divRef p)-      return $ PairI (orientation p) w1 w2 (divRef p) sp---- | true if the displayed layout agrees with the given schema, other--- than divider positions-sameLayout :: LayoutImpl -> Layout Widget -> Bool-sameLayout (SingleWindowI w) (SingleWindow w') = w == w'-sameLayout (s@StackI{}) (s'@Stack{}) =-     orientationI s == orientation s'-  && length (winsI s) == length (wins s')-  && and (zipWith (\(impl, relSize) (layout, relSize') ->-                    relSize == relSize' && sameLayout impl layout)-          (winsI s) (wins s'))-sameLayout (p@PairI{}) (p'@Pair{}) =-     orientationI p == orientation p'-  && divRefI p == divRef p'-  && sameLayout (pairFstI p) (pairFst p')-  && sameLayout (pairSndI p) (pairSnd p')-sameLayout _ _ = False---- removes all widgets from the layout-unattachWidgets :: Container -> LayoutImpl -> IO ()-unattachWidgets parent (SingleWindowI w) = containerRemove parent w-unattachWidgets parent s@StackI{} = do-  containerRemove parent (stackWidget s)-  mapM_ (unattachWidgets (toContainer $ stackWidget s) . fst) (winsI s)-unattachWidgets parent p@PairI{} = do-  containerRemove parent (pairWidget p)-  mapM_ (unattachWidgets (toContainer $ pairWidget p)) [pairFstI p, pairSndI p]----- extract the main widget from the tree-outerWidget :: LayoutImpl -> Widget-outerWidget s@SingleWindowI{} = singleWidget s-outerWidget s@StackI{} = toWidget . stackWidget $ s-outerWidget p@PairI{} = toWidget . pairWidget $ p--instance WidgetLike LayoutDisplay where-  baseWidget = toWidget . mainWidget------------------ MiniwindowDisplay-data MiniwindowDisplay-  = MD-   { mwdMainWidget :: VBox,-     mwdWidgets :: IORef [Widget]-   }--miniwindowDisplayNew :: IO MiniwindowDisplay-miniwindowDisplayNew = do-  vb <- vBoxNew False 1-  wsRef <- newIORef []-  return (MD vb wsRef)--instance WidgetLike MiniwindowDisplay where-  baseWidget = toWidget . mwdMainWidget--miniwindowDisplaySet :: MiniwindowDisplay -> [Widget] -> IO ()-miniwindowDisplaySet mwd ws = do-  curWs <- readIORef (mwdWidgets mwd)--  -- we could be more careful here, and only remove the widgets which we need to.-  when (ws /= curWs) $ do-    forM_ curWs $ containerRemove (mwdMainWidget mwd)-    forM_ ws $ \w -> boxPackEnd (mwdMainWidget mwd) w PackNatural 0-    widgetShowAll $ mwdMainWidget mwd-    writeIORef (mwdWidgets mwd) ws------------------------- SimpleNotebook-data SimpleNotebook-   = SN-    { snMainWidget :: Notebook,-      snTabs :: IORef (Maybe (PL.PointedList (Widget, T.Text)))-    }--instance WidgetLike SimpleNotebook where-  baseWidget = toWidget . snMainWidget---- | Constructs an empty notebook-simpleNotebookNew :: IO SimpleNotebook-simpleNotebookNew = do-  nb <- notebookNew-  ts <- newIORef Nothing-  return (SN nb ts)---- | Sets the tabs-simpleNotebookSet :: SimpleNotebook -> PL.PointedList (Widget, T.Text) -> IO ()-simpleNotebookSet sn ts = do-  curTs <- readIORef (snTabs sn)--  let nb = snMainWidget sn-      tsList = toList ts-      curTsList = maybe [] toList curTs--  -- the common case is no change at all-  when (curTs /= Just ts) $ do--    -- update the tabs, if they have changed-    when (fmap fst curTsList /= fmap fst tsList) $ do-      forM_ curTsList $ const (notebookRemovePage nb (-1))-      forM_ tsList $ uncurry (notebookAppendPage nb)--    -- now update the titles if they have changed-    forM_ tsList $ \(w,s) -> update nb (notebookChildTabLabel w) s--    -- now set the focus-    p <- notebookPageNum nb (fst $ PL._focus ts)-    maybe (return ()) (update nb notebookPage) p--    -- write the new status-    writeIORef (snTabs sn) (Just ts)--    -- display!-    widgetShowAll nb----- | The 'onSwitchPage' callback-simpleNotebookOnSwitchPage :: SimpleNotebook -> (Int -> IO ()) -> IO ()-simpleNotebookOnSwitchPage sn = void . (snMainWidget sn `on` switchPage)---------------------- Utils--- Only set an attribute if has actually changed.--- This makes setting window titles much faster.-update :: (Eq a) => o -> ReadWriteAttr o a a -> a -> IO ()-update w attr val = do oldVal <- get w attr-                       when (val /= oldVal) $ set w [attr := val]
− src/library/Yi/UI/Pango/Utils.hs 
@@ -1,23 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}---- | Random GTK utils-module Yi.UI.Pango.Utils where--import Control.Exception (catch, throw)--import Data.Text (append)-import Paths_yi-import System.FilePath-import Graphics.UI.Gtk-import System.Glib.GError--loadIcon :: FilePath -> IO Pixbuf-loadIcon fpath = do-  iconfile <- getDataFileName $ "art" </> fpath-  icoProject <--    catch (pixbufNewFromFile iconfile)-    (\(GError dom code msg) ->-      throw $ GError dom code $-        msg `append` " -- use the yi_datadir environment variable to"-            `append` " specify an alternate location")-  pixbufAddAlpha icoProject (Just (0,255,0))
− src/library/Yi/UI/SimpleLayout.hs 
@@ -1,164 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE ViewPatterns #-}--module Yi.UI.SimpleLayout-    ( Rect (..)-    , Layout (..)-    , Point2D (..)-    , Size2D (..)-    , coordsOfCharacterB-    , layout-    , verticalOffsetsForWindows-    ) where--import Prelude hiding (concatMap, mapM)--import Control.Lens-import Control.Monad.State (evalState, get, put)-import Data.Foldable-import Data.List (partition)-import qualified Data.List.PointedList.Circular as PL-import qualified Data.Map.Strict as M-import Data.Monoid-import qualified Data.Text as T-import Data.Traversable (mapM)---import Yi.Buffer-import Yi.Editor-import qualified Yi.Rope as R-import Yi.UI.Utils-import Yi.Window--data Layout = Layout-    { tabbarRect :: !Rect-    , windowRects :: !(M.Map WindowRef Rect)-    , promptRect :: !Rect-    }--data Rect = Rect-    { offsetX :: !Int-    , offsetY :: !Int-    , sizeX :: !Int-    , sizeY :: !Int-    }--data Point2D = Point2D-    { pointCol :: !Int-    , pointRow :: !Int-    }--data Size2D = Size2D-    { sizeWidth :: !Int-    , sizeHeight :: !Int-    }--layout :: Int -> Int -> Editor -> (Editor, Layout)-layout colCount rowCount e =-    ( ((windowsA .~ newWindows) e)-    , Layout (Rect 0 0 colCount 1) winRects cmdRect-    )-    where-        (miniWs, ws) = partition isMini (toList (windows e))-        (cmd, _) = statusLineInfo e-        niceCmd = arrangeItems cmd colCount (maxStatusHeight e)-        cmdRect = Rect 0 (rowCount - cmdHeight - if null miniWs then 0 else 1) colCount cmdHeight-        cmdHeight = length niceCmd-        tabbarHeight = 1-        (heightQuot, heightRem) =-            quotRem-                (rowCount - tabbarHeight - if null miniWs then max 1 cmdHeight else 1 + cmdHeight)-                (length ws)-        heights = heightQuot + heightRem : repeat heightQuot-        offsets = scanl (+) 0 heights-        bigWindowsWithHeights =-            zipWith (\win h -> layoutWindow win e colCount h)-                    ws-                    heights-        miniWindowsWithHeights =-            fmap (\win -> layoutWindow win e colCount 1) miniWs-        Just newWindows = PL.fromList (miniWindowsWithHeights <> bigWindowsWithHeights)-        winRects = M.fromList (bigWindowsWithRects <> miniWindowsWithRects)-        bigWindowsWithRects =-            zipWith (\w offset -> (wkey w, Rect 0 (offset + tabbarHeight) colCount (height w)))-                    bigWindowsWithHeights-                    offsets-        miniWindowsWithRects =-            map (\w -> (wkey w, Rect 0 (rowCount - 1) colCount 1))-                miniWindowsWithHeights--layoutWindow :: Window -> Editor -> Int -> Int -> Window-layoutWindow win e w h = win-    { height = h-    , winRegion = mkRegion fromMarkPoint toMarkPoint-    , actualLines = dispLnCount-    }-    where-        b = findBufferWith (bufkey win) e-        evalBuffer action = fst (runBuffer win b action)--        -- Mini windows don't have a mode line.-        h' = h - if isMini win then 0 else 1--        -- Work around a problem with the mini window never displaying it's contents due to a-        -- fromMark that is always equal to the end of the buffer contents.-        Just (MarkSet fromM _ _) = evalBuffer (getMarks win)-        fromMarkPoint = if isMini win-                        then Point 0-                        else evalBuffer $ use $ markPointA fromM--        -- TODO: I suspect that this costs quite a lot of CPU in the "dry run" which determines the window size;-        -- In that case, since attributes are also useless there, it might help to replace the call by a dummy value.-        -- This is also approximately valid of the call to "indexedAnnotatedStreamB".-        (toMarkPoint, wrapCount) = evalBuffer-            (lastVisiblePointAndWrapCountB (Size2D w h') fromMarkPoint)--        dispLnCount = h' - wrapCount---coordsOfCharacterB :: Size2D -> Point -> Point-    -> BufferM (Maybe Point2D)-coordsOfCharacterB _ topLeft char | topLeft > char = return Nothing-coordsOfCharacterB (Size2D w h) (Point topLeft) (Point char)-    | char - topLeft >= w * h = return Nothing-coordsOfCharacterB (Size2D w h) (Point topLeft) (Point char) = savingPointB $ do-    ts <- fmap tabSize indentSettingsB-    text <- fmap (R.toString . R.take (w * h)) (streamB Forward (Point topLeft))-    let go !x !y n t | x >= w = go (x - w) (y + 1) n t-        go _  !y _ _ | y >= h = Nothing-        go !x !y 0 _ = Just (Point2D x y)-        go !x !y !n (c : t) =-            case c of-                '\t' -> go (x + ts) y (n - 1) t-                '\n' -> go 0 (y + 1) (n - 1) t-                _ -> go (x + 1) y (n - 1) t-        go !x !y _ _ = Just (Point2D x y)-    return (go 0 0 (char - topLeft) text)--lastVisiblePointAndWrapCountB :: Size2D -> Point -> BufferM (Point, Int)-lastVisiblePointAndWrapCountB (Size2D w h) (Point topLeft) = savingPointB $ do-    ts <- fmap tabSize indentSettingsB-    text <- fmap (R.toText . R.take (w * h))-                 (streamB Forward (Point topLeft))-    let go !x !y !wc !n t | x >= w = go (x - w) (y + 1) (wc + 1) n t-        go _  !y !wc !n _ | y >= h = (Point (n - 1), wc)-        go !x !y !wc !n (T.uncons -> Just (c, t)) =-            case c of-                '\t' -> go (x + ts) y wc (n + 1) t-                '\n' -> go 0 (y + 1) wc (n + 1) t-                _ -> go (x + 1) y wc (n + 1) t-        go _ _ !wc !n _ = (Point n, wc)-    return (go 0 0 0 topLeft text)--verticalOffsetsForWindows :: Int -> PL.PointedList Window -> PL.PointedList Int-verticalOffsetsForWindows startY ws =-    scanrT (+) startY (fmap (\w -> if isMini w then 0 else height w) ws)---- As scanr, but generalized to a traversable (TODO)-scanrT :: (Int -> Int -> Int) -> Int -> PL.PointedList Int -> PL.PointedList Int-scanrT (+*+) k t = evalState (mapM f t) k-    where f x = do s <- get-                   let s' = s +*+ x-                   put s'-                   return s
− src/library/Yi/UI/TabBar.hs 
@@ -1,56 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.UI.TabBar--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Tabs.--module Yi.UI.TabBar where--import           Control.Applicative-import           Control.Lens-import qualified Data.List.PointedList.Circular as PL-import qualified Data.Text as T-import           System.FilePath-import           Yi.Buffer (shortIdentString)-import           Yi.Editor (Editor(..), commonNamePrefix, findBufferWith, tabsA)-import           Yi.Tab-import           Yi.Window---- | A TabDescr describes the properties of a UI tab independent of--- the particular GUI in use.-data TabDescr = TabDescr-    { tabText :: T.Text-    , tabInFocus :: Bool-    } deriving (Show, Eq)--type TabBarDescr = PL.PointedList TabDescr--tabBarDescr :: Editor -> TabBarDescr-tabBarDescr editor = tabDescr <$> PL.withFocus (editor ^. tabsA)-  where-    prefix = commonNamePrefix editor-    shorten = tabAbbrevTitle . shortIdentString (length prefix)-    mkHintWith f = shorten $ findBufferWith f editor-    hintForTab tab = mkHintWith (bufkey $ PL._focus (tab ^. tabWindowsA))--    tabDescr (tab, True)  = TabDescr (hintForTab tab) True-    tabDescr (tab, False) = TabDescr (hintForTab tab) False----- FIXME: it seems that using splitDirectories can abstract the '/'--- handling away. (Making it win32 friendly and simpler)-tabAbbrevTitle :: T.Text -> T.Text-tabAbbrevTitle title = if isValid fp-                       then T.pack $ concatMap abbrev (splitPath fp)-                       else title-  where-    fp = T.unpack title-    abbrev "/" = "/"-    abbrev path | head path == '.' && last path == '/' = take 2 path ++ "/"-                | last path == '/' = head path : "/"-                | otherwise        = path
− src/library/Yi/UI/Utils.hs 
@@ -1,115 +0,0 @@-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.UI.Utils--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Utilities shared by various UIs--module Yi.UI.Utils where--import           Control.Applicative-import           Control.Arrow (second)-import           Control.Lens-import           Control.Monad.State (evalState,modify)-import           Control.Monad.State.Class (gets)-import           Data.Foldable (maximumBy)-import           Data.Function (on)-import           Data.List (transpose)-import           Data.List.Split (chunksOf)-import           Data.Monoid-import qualified Data.Text as T-import           Data.Traversable (mapM)-import           Prelude hiding (mapM)-import           Yi.Buffer-import           Yi.String (padLeft)-import           Yi.Style-import           Yi.Syntax (Span(..))-import           Yi.Window--applyHeights :: Traversable t => [Int] -> t Window -> t Window-applyHeights heights ws = evalState (mapM distribute ws) heights-    where-      distribute win = if isMini win-          then return win{height = 1}-          else (do h <- gets head-                   modify tail-                   return win{height = h})--spliceAnnots :: [(Point,Char)] -> [Span String] -> [(Point,Char)]-spliceAnnots text [] = text-spliceAnnots text (Span start x stop:anns) = l ++ zip (repeat start) x ++ spliceAnnots r anns-    where (l,rest) =  span ((start >) . fst) text-          (_,r) = span ((stop >) . fst) rest---- | Turn a sequence of (from,style,to) strokes into a sequence---   of picture points (from,style), taking special care to---   ensure that the points are strictly increasing and introducing---   padding segments where neccessary.---   Precondition: Strokes are ordered and not overlapping.-strokePicture :: [Span (Endo a)] -> [(Point,a -> a)]-strokePicture [] = []-strokePicture wholeList@(Span leftMost _ _:_) = helper leftMost wholeList-    where helper :: Point -> [Span (Endo a)] -> [(Point,a -> a)]-          helper prev [] = [(prev,id)]-          helper prev (Span l f r:xs)-              | prev < l  = (prev, id) : (l,appEndo f) : helper r xs-              | otherwise = (l,appEndo f) : helper r xs---- | Paint the given stroke-picture on top of an existing picture-paintStrokes :: (a -> a) -> a -> [(Point,a -> a)] -> [(Point,a)] -> [(Point,a)]-paintStrokes f0 _  [] lx = fmap (second f0)     lx-paintStrokes _  x0 lf [] = fmap (second ($ x0)) lf-paintStrokes f0 x0 lf@((pf,f):tf) lx@((px,x):tx) =-  case pf `compare` px of-    LT -> (pf, f  x0):paintStrokes f  x0 tf lx-    EQ -> (pf, f  x ):paintStrokes f  x  tf tx-    GT -> (px, f0 x ):paintStrokes f0 x  lf tx----paintPicture :: a -> [[Span (Endo a)]] -> [(Point,a)]-paintPicture a = foldr (paintStrokes id a . strokePicture) []--attributesPictureB :: UIStyle -> Maybe SearchExp -> Region -> [[Span StyleName]]-    -> BufferM [(Point,Attributes)]-attributesPictureB sty mexp region extraLayers =-  paintPicture (baseAttributes sty) <$>-    fmap (fmap (fmap ($ sty))) <$>-    (extraLayers ++) <$>-    strokesRangesB mexp region--attributesPictureAndSelB :: UIStyle -> Maybe SearchExp -> Region -> BufferM [(Point,Attributes)]-attributesPictureAndSelB sty mexp region = do-    selReg <- getSelectRegionB-    showSel <- use highlightSelectionA-    rectSel <- use rectangleSelectionA-    let styliseReg reg = Span (regionStart reg) selectedStyle (regionEnd reg)-        extraLayers | rectSel && showSel = (:[]) . fmap styliseReg <$> blockifyRegion selReg-                    | showSel            = return [[styliseReg selReg]]-                    | otherwise          = return []-    attributesPictureB sty mexp region =<< extraLayers----- | Arrange a list of items in columns over maximum @maxNumberOfLines@ lines-arrangeItems :: [T.Text] -> Int -> Int -> [T.Text]-arrangeItems items _ _ | all T.null items = []-arrangeItems items maxWidth maxNumberOfLines = take maxNumberOfLines $ snd choice-    where choice = maximumBy (compare `on` fst) arrangements-          arrangements = fmap (arrangeItems' items maxWidth) (reverse [1..maxNumberOfLines])---- | Arrange a list of items in columns over @numberOfLines@ lines.------ TODO: proper Text/YiString implementation-arrangeItems' :: [T.Text] -> Int -> Int -> (Int, [T.Text])-arrangeItems' items' maxWidth numberOfLines = (fittedItems,theLines)-    where items = T.unpack <$> items'-          columns = chunksOf numberOfLines items-          columnsWidth = fmap (maximum . fmap length) columns-          totalWidths = scanl (\x y -> 1 + x + y) 0 columnsWidth-          shownItems = scanl (+) 0 (fmap length columns)-          fittedItems = snd $ last $ takeWhile ((<= maxWidth) . fst) $ zip totalWidths shownItems-          theLines = fmap (T.pack . unwords . zipWith padLeft columnsWidth) $ transpose columns
− src/library/Yi/UI/Vty.hs 
@@ -1,330 +0,0 @@-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE OverloadedStrings #-}---- |--- Module      :  Yi.UI.Vty--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ This module defines a user interface implemented using vty.------ Originally derived from: riot/UI.hs Copyright (c) Tuomo Valkonen 2004.--module Yi.UI.Vty-    ( start-    ) where--import Prelude hiding (error, concatMap, reverse)-import Control.Applicative hiding ((<|>))-import Control.Concurrent-import Control.Exception-import Control.Lens-import Control.Monad-import Data.Char-import qualified Data.DList as D-import Data.Foldable (toList, concatMap)-import Data.IORef-import qualified Data.List.PointedList.Circular as PL-import qualified Data.Map.Strict as M-import Data.Maybe-import Data.Monoid-import qualified Data.Text as T-import qualified Graphics.Vty as Vty-import GHC.Conc (labelThread)--import Yi.Buffer-import Yi.Config-import Yi.Debug-import Yi.Editor-import Yi.Event-import Yi.Style-import qualified Yi.UI.Common as Common-import qualified Yi.UI.SimpleLayout as SL-import Yi.UI.Vty.Conversions-import Yi.UI.TabBar-import Yi.UI.Utils-import Yi.Window--data Rendered = Rendered-    { picture :: !Vty.Image-    , cursor  :: !(Maybe (Int,Int))-    }--data FrontendState = FrontendState-    { fsVty :: Vty.Vty-    , fsConfig :: Config-    , fsEndMain :: MVar ()-    , fsEndInputLoop :: MVar ()-    , fsEndRenderLoop :: MVar ()-    , fsDirty :: MVar ()-    , fsEditorRef :: IORef Editor-    }--start :: UIBoot-start config submitEvents submitActions editor = do-    vty <- (Vty.mkVty . configVty . configUI) config-    let inputChan = Vty._eventChannel (Vty.inputIface vty)-    endInput <- newEmptyMVar-    endMain <- newEmptyMVar-    endRender <- newEmptyMVar-    dirty <- newEmptyMVar-    editorRef <- newIORef editor-    let -- | Action to read characters into a channel-        inputLoop :: IO ()-        inputLoop = tryTakeMVar endInput >>=-                    maybe (do-                            let go evs = do-                                e <- getEvent-                                done <- isEmptyChan inputChan-                                if done-                                then submitEvents (D.toList (evs `D.snoc` e))-                                else go (evs `D.snoc` e)-                            go D.empty-                            inputLoop)-                          (const $ return ())--        -- | Read a key. UIs need to define a method for getting events.-        getEvent :: IO Yi.Event.Event-        getEvent = do-          event <- readChan inputChan-          case event of-            (Vty.EvResize _ _) -> do-                submitActions []-                getEvent-            _ -> return (fromVtyEvent event)--        renderLoop :: IO ()-        renderLoop = do-          takeMVar dirty-          tryTakeMVar endRender >>=-            maybe (handle (\(except :: IOException) -> do-                              logPutStrLn "refresh crashed with IO Error"-                              logError (T.pack (show except)))-                          (readIORef editorRef >>= refresh fs >> renderLoop))-                  (const $ return ())--        fs = FrontendState vty config endMain endInput endRender dirty editorRef--    inputThreadId <- forkIO inputLoop-    labelThread inputThreadId "VtyInput"-    renderThreadId <- forkIO renderLoop-    labelThread renderThreadId "VtyRender"--    return $! Common.dummyUI-        { Common.main = main fs-        , Common.end = end fs-        , Common.refresh = requestRefresh fs-        , Common.userForceRefresh = Vty.refresh vty-        , Common.layout = layout fs-        }--main :: FrontendState -> IO ()-main fs = do-    tid <- myThreadId-    labelThread tid "VtyMain"-    takeMVar (fsEndMain fs)--layout :: FrontendState -> Editor -> IO Editor-layout fs e = do-    (colCount, rowCount) <- Vty.displayBounds (Vty.outputIface (fsVty fs))-    let (e', _layout) = SL.layout colCount rowCount e-    return e'--end :: FrontendState -> Bool -> IO ()-end fs mustQuit = do-    -- setTerminalAttributes stdInput (oAttrs ui) Immediately-    void $ tryPutMVar (fsEndInputLoop fs) ()-    void $ tryPutMVar (fsEndRenderLoop fs) ()-    Vty.shutdown (fsVty fs)-    when mustQuit $-        void (tryPutMVar (fsEndMain fs) ())--requestRefresh :: FrontendState -> Editor -> IO ()-requestRefresh fs e = do-    writeIORef (fsEditorRef fs) e-    void $ tryPutMVar (fsDirty fs) ()--refresh :: FrontendState -> Editor -> IO ()-refresh fs e = do-    (colCount, rowCount) <- Vty.displayBounds (Vty.outputIface (fsVty fs))-    let (_e, SL.Layout _tabbarRect winRects promptRect) = SL.layout colCount rowCount e-        ws = windows e-        (cmd, cmdSty) = statusLineInfo e-        niceCmd = arrangeItems cmd (SL.sizeX promptRect) (maxStatusHeight e)-        mkLine = T.justifyLeft colCount ' ' . T.take colCount-        formatCmdLine text = withAttributes statusBarStyle (mkLine text)-        winImage (win, hasFocus) =-            let rect = winRects M.! wkey win-            in renderWindow (configUI $ fsConfig fs) e rect (win, hasFocus)-        windowsAndImages =-            fmap (\(w, f) -> (w, winImage (w, f))) (PL.withFocus ws)-        bigImages =-            map (picture . snd)-                (filter (not . isMini . fst) (toList windowsAndImages))-        miniImages =-            map (picture . snd)-                (filter (isMini . fst) (toList windowsAndImages))-        statusBarStyle =-            ((appEndo <$> cmdSty) <*> baseAttributes)-                (configStyle (configUI (fsConfig fs)))-        tabBarImage =-            renderTabBar (configStyle (configUI (fsConfig fs)))-                (map (\(TabDescr t f) -> (t, f)) (toList (tabBarDescr e)))-        cmdImage = if null cmd-                   then Vty.emptyImage-                   else Vty.translate-                           (SL.offsetX promptRect)-                           (SL.offsetY promptRect)-                           (Vty.vertCat (fmap formatCmdLine niceCmd))-        cursorPos =-            case (\(w, r) -> (isMini w, cursor r)) (PL._focus windowsAndImages) of-                (False, Just (y, x)) -> Vty.Cursor (toEnum x) (toEnum y)-                (True, Just (_, x)) -> Vty.Cursor (toEnum x) (toEnum (rowCount - 1))-                (_, Nothing) -> Vty.NoCursor-    logPutStrLn "refreshing screen."-    Vty.update (fsVty fs)-        (Vty.picForLayers ([tabBarImage, cmdImage] ++ bigImages ++ miniImages))-        { Vty.picCursor = cursorPos }--renderWindow :: UIConfig -> Editor -> SL.Rect -> (Window, Bool) -> Rendered-renderWindow cfg e (SL.Rect x y w h) (win, focused) =-    Rendered (Vty.translate x y pict)-             (fmap (\(i, j) -> (i + y, j + x)) cur)-    where-        b = findBufferWith (bufkey win) e-        sty = configStyle cfg--        notMini = not (isMini win)-        -- off reserves space for the mode line. The mini window does not have a mode line.-        off = if notMini then 1 else 0-        h' = h - off-        ground = baseAttributes sty-        wsty = attributesToAttr ground Vty.defAttr-        eofsty = appEndo (eofStyle sty) ground-        (point, _) = runBuffer win b pointB-        region = mkSizeRegion fromMarkPoint (Size (w*h'))-        -- Work around a problem with the mini window never displaying it's contents due to a-        -- fromMark that is always equal to the end of the buffer contents.-        (Just (MarkSet fromM _ _), _) = runBuffer win b (getMarks win)-        fromMarkPoint = if notMini-                        then fst $ runBuffer win b $ use $ markPointA fromM-                        else Point 0-        (text, _) = runBuffer win b (indexedStreamB Forward fromMarkPoint)--        (attributes, _) = runBuffer win b $ attributesPictureAndSelB sty (currentRegex e) region-        -- TODO: I suspect that this costs quite a lot of CPU in the "dry run" which determines the window size;-        -- In that case, since attributes are also useless there, it might help to replace the call by a dummy value.-        -- This is also approximately valid of the call to "indexedAnnotatedStreamB".-        colors = map (fmap (($ Vty.defAttr) . attributesToAttr)) attributes-        bufData =  paintChars Vty.defAttr colors text-        tabWidth = tabSize . fst $ runBuffer win b indentSettingsB-        prompt = if isMini win then miniIdentString b else ""--        cur = (fmap (\(SL.Point2D curx cury) -> (cury, T.length prompt + curx)) . fst)-              (runBuffer win b-                         (SL.coordsOfCharacterB-                             (SL.Size2D w h)-                             fromMarkPoint-                             point))--        rendered =-            drawText h' w-                     tabWidth-                     ([(c, wsty) | c <- T.unpack prompt] ++ bufData ++ [(' ', wsty)])-                     -- we always add one character which can be used to position the cursor at the end of file-        commonPref = T.pack <$> commonNamePrefix e-        (modeLine0, _) = runBuffer win b $ getModeLine commonPref-        modeLine = if notMini then Just modeLine0 else Nothing-        prepare = withAttributes modeStyle . T.justifyLeft w ' ' . T.take w-        modeLines = map prepare $ maybeToList modeLine-        modeStyle = (if focused then appEndo (modelineFocusStyle sty) else id) (modelineAttributes sty)--        filler :: T.Text-        filler = if w == 0 -- justify would return a single char at w = 0-                 then T.empty-                 else T.justifyLeft w ' ' $ T.singleton (configWindowFill cfg)--        pict = Vty.vertCat (take h' (rendered <> repeat (withAttributes eofsty filler)) <> modeLines)--withAttributes :: Attributes -> T.Text -> Vty.Image-withAttributes sty = Vty.text' (attributesToAttr sty Vty.defAttr)--attributesToAttr :: Attributes -> Vty.Attr -> Vty.Attr-attributesToAttr (Attributes fg bg reverse bd _itlc underline') =-    (if reverse then (`Vty.withStyle` Vty.reverseVideo) else id) .-    (if bd then (`Vty.withStyle` Vty.bold) else id) .-    (if underline' then (`Vty.withStyle` Vty.underline) else id) .-    colorToAttr (flip Vty.withForeColor) fg .-    colorToAttr (flip Vty.withBackColor) bg---- | Apply the attributes in @sty@ and @changes@ to @cs@.  If the--- attributes are not used, @sty@ and @changes@ are not evaluated.-paintChars :: a -> [(Point, a)] -> [(Point, Char)] -> [(Char, a)]-paintChars sty changes cs = zip (fmap snd cs) attrs-    where attrs = stys sty changes cs--stys :: a -> [(Point, a)] -> [(Point, Char)] -> [a]-stys sty [] cs = [ sty | _ <- cs ]-stys sty ((endPos, sty') : xs) cs = [ sty | _ <- previous ] <> stys sty' xs later-    where (previous, later) = break ((endPos <=) . fst) cs--drawText :: Int    -- ^ The height of the part of the window we are in-         -> Int    -- ^ The width of the part of the window we are in-         -> Int    -- ^ The number of spaces to represent a tab character with.-         -> [(Char, Vty.Attr)]  -- ^ The data to draw.-         -> [Vty.Image]-drawText h w tabWidth bufData-    | h == 0 || w == 0 = []-    | otherwise        = renderedLines-    where--    -- the number of lines that taking wrapping into account,-    -- we use this to calculate the number of lines displayed.-    wrapped = concatMap (wrapLine w) $ map (concatMap expandGraphic) $ take h $ lines' bufData-    lns0 = take h wrapped--    -- fill lines with blanks, so the selection looks ok.-    renderedLines = map fillColorLine lns0-    colorChar (c, a) = Vty.char a c--    fillColorLine :: [(Char, Vty.Attr)] -> Vty.Image-    fillColorLine [] = Vty.charFill Vty.defAttr ' ' w 1-    fillColorLine l = Vty.horizCat (map colorChar l)-                      Vty.<|>-                      Vty.charFill a ' ' (w - length l) 1-                      where (_, a) = last l--    -- | Cut a string in lines separated by a '\n' char. Note-    -- that we add a blank character where the \n was, so the-    -- cursor can be positioned there.--    lines' :: [(Char, a)] -> [[(Char, a)]]-    lines' [] =  []-    lines' s  = case s' of-                  []          -> [l]-                  ((_,x):s'') -> (l++[(' ',x)]) : lines' s''-                where-                (l, s') = break ((== '\n') . fst) s--    wrapLine :: Int -> [x] -> [[x]]-    wrapLine _ [] = []-    wrapLine n l = let (x,rest) = splitAt n l in x : wrapLine n rest--    expandGraphic ('\t', p) = replicate tabWidth (' ', p)-    expandGraphic (c, p)-        | ord c < 32 = [('^', p), (chr (ord c + 64), p)]-        | otherwise = [(c, p)]--renderTabBar :: UIStyle -> [(T.Text, Bool)] -> Vty.Image-renderTabBar uiStyle = Vty.horizCat . fmap render-  where-    render (text, inFocus) = Vty.text' (tabAttr inFocus) (tabTitle text)-    tabTitle text   = ' ' `T.cons` text `T.snoc` ' '-    tabAttr b       = baseAttr b $ tabBarAttributes uiStyle-    baseAttr True sty =-        attributesToAttr (appEndo (tabInFocusStyle uiStyle) sty) Vty.defAttr-    baseAttr False sty =-        attributesToAttr (appEndo (tabNotFocusedStyle uiStyle) sty) Vty.defAttr-            `Vty.withStyle` Vty.underline
− src/library/Yi/UI/Vty/Conversions.hs 
@@ -1,75 +0,0 @@-module Yi.UI.Vty.Conversions-    ( colorToAttr-    , fromVtyEvent-    , fromVtyKey-    , fromVtyMod-    ) where--import Data.List (nub, sort)-import qualified Graphics.Vty as Vty--import qualified Yi.Event-import qualified Yi.Style--fromVtyEvent :: Vty.Event -> Yi.Event.Event-fromVtyEvent (Vty.EvKey Vty.KBackTab mods) =-    Yi.Event.Event Yi.Event.KTab (sort $ nub $ Yi.Event.MShift : map fromVtyMod mods)-fromVtyEvent (Vty.EvKey k mods) =-    Yi.Event.Event (fromVtyKey k) (sort $ map fromVtyMod mods)-fromVtyEvent _ = error "fromVtyEvent: unsupported event encountered."--fromVtyKey :: Vty.Key -> Yi.Event.Key-fromVtyKey (Vty.KEsc      ) = Yi.Event.KEsc-fromVtyKey (Vty.KFun x    ) = Yi.Event.KFun x-fromVtyKey (Vty.KPrtScr   ) = Yi.Event.KPrtScr-fromVtyKey (Vty.KPause    ) = Yi.Event.KPause-fromVtyKey (Vty.KChar '\t') = Yi.Event.KTab-fromVtyKey (Vty.KChar c   ) = Yi.Event.KASCII c-fromVtyKey (Vty.KBS       ) = Yi.Event.KBS-fromVtyKey (Vty.KIns      ) = Yi.Event.KIns-fromVtyKey (Vty.KHome     ) = Yi.Event.KHome-fromVtyKey (Vty.KPageUp   ) = Yi.Event.KPageUp-fromVtyKey (Vty.KDel      ) = Yi.Event.KDel-fromVtyKey (Vty.KEnd      ) = Yi.Event.KEnd-fromVtyKey (Vty.KPageDown ) = Yi.Event.KPageDown-fromVtyKey (Vty.KCenter   ) = Yi.Event.KNP5-fromVtyKey (Vty.KUp       ) = Yi.Event.KUp-fromVtyKey (Vty.KMenu     ) = Yi.Event.KMenu-fromVtyKey (Vty.KLeft     ) = Yi.Event.KLeft-fromVtyKey (Vty.KDown     ) = Yi.Event.KDown-fromVtyKey (Vty.KRight    ) = Yi.Event.KRight-fromVtyKey (Vty.KEnter    ) = Yi.Event.KEnter-fromVtyKey (Vty.KBackTab  ) = error "This should be handled in fromVtyEvent"-fromVtyKey (Vty.KBegin    ) = error "Yi.UI.Vty.fromVtyKey: can't handle KBegin"-fromVtyKey _ = error "Unhandled key in fromVtyKey"--fromVtyMod :: Vty.Modifier -> Yi.Event.Modifier-fromVtyMod Vty.MShift = Yi.Event.MShift-fromVtyMod Vty.MCtrl  = Yi.Event.MCtrl-fromVtyMod Vty.MMeta  = Yi.Event.MMeta-fromVtyMod Vty.MAlt   = Yi.Event.MMeta----- | Convert a Yi Attr into a Vty attribute change.-colorToAttr :: (Vty.Color -> Vty.Attr -> Vty.Attr)-    -> Yi.Style.Color -> Vty.Attr -> Vty.Attr-colorToAttr set c =-  case c of-    Yi.Style.RGB 0 0 0         -> set Vty.black-    Yi.Style.RGB 128 128 128   -> set Vty.brightBlack-    Yi.Style.RGB 139 0 0       -> set Vty.red-    Yi.Style.RGB 255 0 0       -> set Vty.brightRed-    Yi.Style.RGB 0 100 0       -> set Vty.green-    Yi.Style.RGB 0 128 0       -> set Vty.brightGreen-    Yi.Style.RGB 165 42 42     -> set Vty.yellow-    Yi.Style.RGB 255 255 0     -> set Vty.brightYellow-    Yi.Style.RGB 0 0 139       -> set Vty.blue-    Yi.Style.RGB 0 0 255       -> set Vty.brightBlue-    Yi.Style.RGB 128 0 128     -> set Vty.magenta-    Yi.Style.RGB 255 0 255     -> set Vty.brightMagenta-    Yi.Style.RGB 0 139 139     -> set Vty.cyan-    Yi.Style.RGB 0 255 255     -> set Vty.brightCyan-    Yi.Style.RGB 165 165 165   -> set Vty.white-    Yi.Style.RGB 255 255 255   -> set Vty.brightWhite-    Yi.Style.Default           -> id-    Yi.Style.RGB r g b         -> set (Vty.rgbColor r g b)
− src/library/Yi/Verifier/JavaScript.hs 
@@ -1,123 +0,0 @@-{-# LANGUAGE FlexibleInstances, FlexibleContexts #-}---- TODO:--- ! User configuration.--- ! Checking for side-effect-less code, e.g. "1;".--module Yi.Verifier.JavaScript where--import Control.Monad.Writer.Lazy (Writer, MonadWriter, tell)-import Control.Monad-import Data.List (intercalate)-import Data.Foldable (toList)-import Data.Function (on)-import qualified Data.DList as D-import Yi.Lexer.Alex (Posn, Tok, tokT, tokPosn)-import Yi.Lexer.JavaScript (Token(..), TT)-import Yi.Syntax.JavaScript hiding (res)----- * Types--data Error = MultipleFunctionDeclaration String [Posn]-             deriving Eq--data Warning = UnreachableCode Posn-               deriving Eq--data Report = Err  Error-            | Warn Warning-              deriving Eq----- * Instances--instance Show Error where-    show (MultipleFunctionDeclaration n ps) =-        "Function `" ++ n ++ "' declared more than once: " ++ intercalate ", " (map show ps)--instance Show Warning where-    show (UnreachableCode pos) =-        "Unreachable code at " ++ show pos--instance Show Report where-    show (Err e) = "EE " ++ show e-    show (Warn w) = "WW " ++ show w----- * Main code---- | The main verifier which calls the sub-verifiers.-verify :: Tree TT -> Writer (D.DList Report) ()-verify t = do-  let topfuns = findFunctions (toList t)-  checkMultipleFuns topfuns-  mapM_ (checkUnreachable . funBody) topfuns---- | Given a list of function declarations, checks for multiple function---   declarations, including the functions' subfunctions.-checkMultipleFuns :: [Statement TT] -> Writer (D.DList Report) ()-checkMultipleFuns stmts = do-  let dupFuns = dupsBy (ttEq `on` funName) stmts-  unless (null dupFuns)-    (say (Err (MultipleFunctionDeclaration-               (nameOf $ tokT $ funName $ head dupFuns)-               (map (tokPosn . funName) dupFuns))))-  let subFuns = map (findFunctions . funBody) (findFunctions stmts)-  mapM_ checkMultipleFuns subFuns--checkUnreachable :: [Statement TT] -> Writer (D.DList Report) ()-checkUnreachable stmts = do-  let afterReturn = dropWhile' (not . isReturn) stmts-  unless (null afterReturn)-    (say (Warn (UnreachableCode (tokPosn $ firstTok $ head afterReturn))))----- * Helper functions---- | Given two @Tok t@, compares the @t@s.-ttEq :: Eq t => Tok t -> Tok t -> Bool-ttEq x y = tokT x == tokT y--say :: MonadWriter (D.DList a) m => a -> m ()-say = tell . D.singleton--isReturn :: Statement t -> Bool-isReturn (Return {}) = True-isReturn _           = False---- | Returns a list of the functions in the given block.-findFunctions :: [Statement t] -> [Statement t]-findFunctions stmts = [ f | f@(FunDecl {}) <- stmts ]---- | Given a 'FunDecl', returns the token representing the name.-funName :: Statement t -> t-funName (FunDecl _ n _ _) = n-funName _                 = undefined---- | Given a 'FunDecl', returns its inner body as a list.-funBody :: Statement t -> [Statement t]-funBody (FunDecl _ _ _ blk) =-    case blk of-      Block _ stmts _ -> toList stmts-      BlockOne stmt   -> [stmt]-      _               -> []-funBody _ = undefined---- | Given a @ValidName@ returns the string representing the name.-nameOf :: Token -> String-nameOf (ValidName n) = n-nameOf _             = undefined----- * Misc---- | Like 'dropWhile' but drops the first element in the result.-dropWhile' :: (a -> Bool) -> [a] -> [a]-dropWhile' p xs =-    let res = dropWhile p xs in-    if null res then [] else drop 1 res--dupsBy :: (a -> a -> Bool) -> [a] -> [a]-dupsBy p xs = filter (\x -> length (filter (p x) xs) > 1) xs-
− src/library/Yi/Window.hs 
@@ -1,80 +0,0 @@-{-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE TemplateHaskell #-}-{-# OPTIONS_HADDOCK show-extensions #-}---- |--- Module      :  Yi.Window--- License     :  GPL-2--- Maintainer  :  yi-devel@googlegroups.com--- Stability   :  experimental--- Portability :  portable------ Operations on 'Window's, in the emacs sense of the word.--module Yi.Window where--import Data.Binary-import Data.Default-import Data.Typeable-import Control.Applicative-import Yi.Buffer.Basic (BufferRef, WindowRef)-import Yi.Region (Region,emptyRegion)-import Yi.JumpList-import Yi.Utils (makeLensesWithSuffix)----------------------------------------------------------------------------- | A window onto a buffer.--data Window = Window-    { isMini    :: !Bool -- ^ regular or mini window?-    , bufkey    :: !BufferRef -- ^ the buffer this window opens to-    , bufAccessList :: ![BufferRef]-      -- ^ list of last accessed buffers (former bufKeys). Last-      -- accessed one is first element-    , height    :: !Int -- ^ height of the window (in number of screen-                       -- lines displayed)-    , winRegion :: !Region -- ^ view area. note that the top point is-                          -- also available as a buffer mark.-    , wkey      :: !WindowRef -- ^ identifier for the window (for UI sync)-    -- This is required for accurate scrolling.-    -- Scrolling depends on the actual number of buffer-    -- lines displayed. Line wrapping changes that number-    -- relative to the height so we can't use height for that-    -- purpose.-    , actualLines :: !Int-      -- ^ The actual number of buffer lines displayed. Taking into-      -- account line wrapping-    , jumpList :: !JumpList-    } deriving (Typeable)--makeLensesWithSuffix "A" ''Window--instance Binary Window where-    put (Window mini bk bl _h _rgn key lns jl) =-        put mini >> put bk >> put bl >> put key >> put lns >> put jl-    get = Window <$> get <*> get <*> get-                   <*> return 0 <*> return emptyRegion-                   <*> get <*> get <*> get----- | Get the identification of a window.-winkey :: Window -> (Bool, BufferRef)-winkey w = (isMini w, bufkey w)--instance Show Window where-    show w = "Window to " ++ show (bufkey w)-             -- ++ "{" ++ show (tospnt w) ++ "->" ++ show (bospnt w) ++ "}"-             ++ "(" ++ show (height w) ++ ")"--instance Eq Window where-    (==) w1 w2 = wkey w1 == wkey w2--{---- | Is a given point within tospnt / bospnt?-pointInWindow :: Point -> Window -> Bool-pointInWindow point win = tospnt win <= point && point <= bospnt win--}---- | Return a "fake" window onto a buffer.-dummyWindow :: BufferRef -> Window-dummyWindow b = Window False b [] 0 emptyRegion def 0 Nothing
− src/tests/Driver.hs 
@@ -1,101 +0,0 @@-{-# LANGUAGE TypeSynonymInstances, GeneralizedNewtypeDeriving #-}--module Driver where--import System.Environment-import Control.Monad-import Test.QuickCheck hiding (promote)-import System.Random hiding (next)-import Text.Printf-import Data.List            (sort,group,intersperse)---- Following code shamelessly stolen from XMonad.-main :: (Read t, Num t, PrintfArg t1, Num b, PrintfArg b) =>-                                    [(t1, t -> IO (Bool, b))] -> IO ()-main tests  = do-    args <- fmap (drop 1) getArgs-    let n = if null args then 100 else read (head args)-    (results, passed) <- fmap unzip $ mapM (\(s,a) -> printf "%-25s: " s >> a n) tests-    printf "Passed %d tests!\n" (sum passed) :: IO ()-    when (not . and $ results) $ fail "Not all tests passed!"-------------------------------------------------------------------------------- QC driver------debug :: Bool-debug = False--mytest :: Testable a => a -> Int -> IO (Bool, Int)-mytest a n = mycheck (stdArgs {maxSuccess = n}) a--- mytest a n = mycheck stdArgs---     { maxSuccess=n ---    , configEvery   = \o _ -> let s = show o in s ++ [ '\b' | _ <- s ] } a- -- , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a--mycheck :: Testable a => Args -> a -> IO (Bool, Int)-mycheck config a = do-    rnd <- newStdGen-    results <- quickCheckWithResult config {replay = Just (rnd, 1)} a-    print results-    return $ case results of-        Success {} ->(True, maxSuccess config)-        GaveUp {numTests = n} ->(True, n)-        Failure {} -> (False, 0)-        NoExpectedFailure {} -> (True, 0)---- mytests :: Args -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO (Bool, Int)--- mytests config gen rnd0 ntest nfail stamps---     | ntest == maxTest config = done "OK," ntest stamps >> return (True, ntest)---     | nfail == maxFail config = done "Arguments exhausted after" ntest stamps >> return (True, ntest)---     | otherwise               =---       do putStr (configEvery config ntest (arguments result)) >> hFlush stdout---          case ok result of---            Nothing    ->---              mytests config gen rnd1 ntest (nfail+1) stamps---            Just True  ->---              mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps)---            Just False ->---              putStr ( "Falsifiable after "---                    ++ show ntest---                    ++ " tests:\n"---                    ++ unlines (arguments result)---                     ) >> hFlush stdout >> return (False, ntest)---      where---       result      = generate (maxSize config ntest) rnd2 gen---       (rnd1,rnd2) = split rnd0--done :: String -> Int -> [[String]] -> IO ()-done mesg ntest stamps = putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table )-  where-    table = display-            . map entry-            . reverse-            . sort-            . map pairLength-            . group-            . sort-            . filter (not . null)-            $ stamps--    display []  = ".\n"-    display [x] = " (" ++ x ++ ").\n"-    display xs  = ".\n" ++ unlines (map (++ ".") xs)--    pairLength xss@(xs:_) = (length xss, xs)-    pairLength []         = (0, [])-    entry (n, xs)         = percentage n ntest-                       ++ " "-                       ++ concat (intersperse ", " xs)--    percentage n m        = show ((100 * n) `div` m) ++ "%"----------------------------------------------------------------------------integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g)-integralRandomR  (a,b) g = case randomR (fromIntegral a :: Integer,-                                         fromIntegral b :: Integer) g of-                            (x,h) -> (fromIntegral x, h)-
− src/tests/Generic/TestPureBufferManipulations.hs 
@@ -1,212 +0,0 @@--- | This module aims to provide a generic back-end for other keymaps to--- use for pure buffer manipulations. Pure buffer manipulations are considered--- to be operations which simply change the contents of the buffer and move the--- cursor. For example, opening a second buffer is not considered a pure buffer--- operation.--module Generic.TestPureBufferManipulations where--import Test.Tasty.HUnit-import Test.Tasty (TestTree, testGroup)--import Control.Monad (filterM, forM, void, unless)-import Control.Lens ((%=))--import Data.List (sort, isSuffixOf, intercalate, isPrefixOf)-import Data.Ord (comparing)--import System.Directory-import System.FilePath--import Text.Printf--import Yi.Buffer-import Yi.Config (Config)-import Yi.Editor-import Yi.Window-import Yi.Region--import Generic.TestUtils--data KeymapTest = KeymapTest {-                   ktName :: String-                 , ktOptionalSettings :: [OptionalSetting]-                 , ktInput :: String-                 , ktOutput :: String-                 , ktEventString :: String-                 , ktKeysEval :: KeyEval-               }--data OptionalSetting = WindowSize Int Int  -- ^ WindowSize Width Height -                     deriving Eq--instance Show OptionalSetting where-    show (WindowSize w h) = unwords ["+WindowSize", (show w), (show h)]--instance Eq KeymapTest where-  KeymapTest n s i o e _ == KeymapTest n' s' i' o' e' _ =-    n == n' && s == s' && i == i' && o == o' && e == e'--instance Ord KeymapTest where-  compare = comparing ktName---data TestResult = TestPassed String-                | TestFailed String String--instance Show TestResult where-    show (TestPassed name) = "PASSED " ++ name-    show (TestFailed name msg) = "FAILED " ++ name ++ ":\n" ++ msg--unlines' :: [String] -> String-unlines' = intercalate "\n"--optionalSettingPrefix :: String-optionalSettingPrefix = "--+ " --isOptionalSetting :: String -> Bool-isOptionalSetting = (optionalSettingPrefix `isPrefixOf`)--decodeOptionalSetting :: [String] -> OptionalSetting-decodeOptionalSetting ["WindowSize", w, h] = WindowSize (read w) (read h)-decodeOptionalSetting unknownSetting = -    error $ "Invalid Setting: " ++ (intercalate " " unknownSetting) --loadTestFromDirectory :: FilePath -- ^ Directory of the test-                      -> KeyEval -- ^ Function that can run-                                                -- ‘events’ commands-                      -> IO KeymapTest-loadTestFromDirectory path ev = do-    [input, output, events] <- mapM (readFile' . (path </>)) ["input", "output", "events"]-    return $ KeymapTest (joinPath . drop 1 . splitPath $ path) [] input output events ev--isValidTestFile :: String -> Bool-isValidTestFile text =-    case (skipOptionals . lines $ text) of-        [] -> False-        ("-- Input": ls) ->-            case break (== "-- Output") ls of-                (_, []) -> False-                (_, "-- Output":ls') -> "-- Events" `elem` ls'-                _ -> False-        _ -> False-    where-        skipOptionals = dropWhile isOptionalSetting---- | See Arguments to 'loadTestFromDirectory'-loadTestFromFile :: FilePath -> KeyEval -> IO KeymapTest-loadTestFromFile path ev = do-    text <- readFile' path-    unless (isValidTestFile text) $-        void $ printf "Test %s is invalid\n" path-    let (optionals, testContents) = span isOptionalSetting (lines text) -        ls = tail testContents-        (input, rest) = break (== "-- Output") ls-        (output, rest2) = break (== "-- Events") $ tail rest-        eventText = tail rest2-    return $-      KeymapTest-        (joinPath . drop 1 . splitPath . dropExtension $ path)-        (map (decodeOptionalSetting . drop 1 . words) optionals)-        (unlines' input)-        (unlines' output)-        (unlines' eventText)-        ev--containsTest :: FilePath -> IO Bool-containsTest d = do-    files <- fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents d-    return $ sort files == ["events", "input", "output"]--getRecursiveFiles :: FilePath -> IO [FilePath]-getRecursiveFiles topdir = do-    names <- getDirectoryContents topdir-    let properNames = filter (`notElem` [".", "..", ".git", ".svn"]) names-    paths <- forM properNames $ \name -> do-        let path = topdir </> name-        isDirectory <- doesDirectoryExist path-        if isDirectory-            then getRecursiveFiles path-            else return [path]-    return (concat paths)--getRecursiveDirectories :: FilePath -> IO [FilePath]-getRecursiveDirectories topdir = do-    names <- getDirectoryContents topdir-    let properNames = filter (`notElem` [".", "..", ".git", ".svn"]) names-    paths <- forM properNames $ \name -> do-        let path = topdir </> name-        isDirectory <- doesDirectoryExist path-        if isDirectory-            then fmap (path:) $ getRecursiveDirectories path-            else return []-    return (concat paths)--discoverTests :: FilePath -> KeyEval -> IO [KeymapTest]-discoverTests topdir ev = do-    dirs <- getRecursiveDirectories topdir-    testDirs <- filterM containsTest dirs-    testFiles <- fmap (filter (isSuffixOf ".test")) $ getRecursiveFiles topdir-    testsFromDirs <- mapM (`loadTestFromDirectory` ev) testDirs-    testsFromFiles <- mapM (`loadTestFromFile` ev) testFiles-    return $ testsFromDirs ++ testsFromFiles--optionalSettingAction :: OptionalSetting -> EditorM ()-optionalSettingAction (WindowSize w h) = -    let region = mkSizeRegion (Point 0) (Size (w*h))-    in currentWindowA %= (\w -> w { height = h, winRegion = region })--mkTestCase :: Config -> KeymapTest -> TestTree-mkTestCase cf t = testCase (ktName t) $ do-    let setupActions = do-            let (cursorLine, '\n':text) = break (== '\n') (ktInput t)-            mapM_ optionalSettingAction $ ktOptionalSettings t-            insertText text-            setCursorPosition cursorLine--        preConditions _ _ = return ()--        testActions _ = ktKeysEval t $ ktEventString t--        assertions editor _ =-            let actualOut = cursorPos editor ++ "\n" ++-                            extractBufferString cf editor-            in  assertEqual (errorMsg actualOut) actualOut (ktOutput t)--    runTest setupActions preConditions testActions assertions cf--  where-    setCursorPosition cursorLine =-        let (x, y) = read cursorLine-        in withCurrentBuffer $ moveToLineColB x (y - 1)-    cursorPos = show . snd . runEditor cf (withCurrentBuffer $ do-                                            l <- curLn-                                            c <- curCol-                                            return (l, c + 1))-    errorMsg actualOut = unlines $ optionalSettings ++-                                 [ "Input:", ktInput t-                                 , "Expected:", ktOutput t-                                 , "Got:", actualOut-                                 , "Events:", ktEventString t-                                 , "---"]-    optionalSettings = map show $ ktOptionalSettings t---- | Takes a directory with the tests, a name of the keymap--- and an evaluation function for the keys contained in the tests.--- For Vim, we might do something like:------ @--- getTests defaultVimConfig "src/tests/vimtests"---   "Vim" (pureEval $ extractValue defVimConfig)--- @-getTests :: Config -> FilePath -> String-         -> KeyEval -> IO TestTree-getTests c fp n ev = do-    tests <- discoverTests fp ev-    return $ testGroup (n ++ " keymap tests") $-      fmap (mkTestCase c) . sort $ tests--readFile' :: FilePath -> IO String-readFile' f = do-    s <- readFile f-    return $! length s `seq` s
− src/tests/Generic/TestUtils.hs 
@@ -1,99 +0,0 @@-module Generic.TestUtils where--import           Control.Monad (unless)-import           Test.Tasty.HUnit-import           Yi.Buffer-import           Yi.Config (Config)-import           Yi.Editor-import qualified Yi.Rope as R---type KeyEval = String -> EditorM ()--- | Run a pure editor manipulation test.------ Runs the @setupActions@ against an empty editor. Checks that @preConditions@--- hold for that editor. Then runs @testActions@ against the setup editor.--- Finally checks that @assertions@ hold for the final editor state.------ @preConditions@, @testActions@ and @assertions@ are each passed the return--- value of @setupActions@.----runTest :: EditorM a-        -- ^ Setup actions to initialize the editor.-        -> (Editor -> a -> Assertion)-        -- ^ Precondition assertions. Used to check that the editor-        -- is in the expected state prior to running the test actions.-        -> (a -> EditorM ())-        -- ^ The actions to run as part of the test. The return value-        -- from the setup action is passed to this.-        -> (Editor -> a -> Assertion)-        -- ^ Assertions to check that the editor is in the expected-        -- state. The return value from the setup action is passed to-        -- this.-        -> Config-        -- ^ The 'Config' to use for this test. 'defaultVimConfig' is-        -- an example of a value we could provide.-        -> Assertion-runTest setupActions preConditions testActions assertions c = do-    let (setupEditor, a) = runEditor c setupActions emptyEditor-    preConditions setupEditor a-    let finalEditor = fst $ runEditor c (testActions a) setupEditor-    assertions finalEditor a----- Return the contents of the current buffer as a string.-extractBufferString :: Config -> Editor -> String-extractBufferString c editor =-  R.toString $ snd (runEditor c (withCurrentBuffer elemsB) editor)-------------------------------------------------------- Functions for altering the state of the editor.---- | Insert the given text into the editor inside an update transaction.-insertText :: String -> EditorM ()-insertText text =-    withCurrentBuffer $ do-        startUpdateTransactionB-        insertN (R.fromString text)-        commitUpdateTransactionB-------------------------------------------------------- Useful assertions.---- | Asserts that the specified actual value is not equal to the unexpected--- value. The output message will contain the prefix and the actual value.------ If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted--- and only the actual value is output.-assertNotEqual :: (Eq a, Show a) => String  -- ^ The message prefix-                                 -> a       -- ^ The expected value-                                 -> a       -- ^ The actual value-                                 -> Assertion-assertNotEqual preface expected actual =-    unless (actual /= expected) (assertFailure msg)-  where-    msg = (if null preface then "" else preface ++ "\n") ++-          "expected not to get: " ++ show expected----- | Asserts that the contents of the current buffer are equal to the expected--- value. The output message will contain the expected value and the actual value.-assertContentOfCurrentBuffer :: Config -> String -> Editor -> Assertion-assertContentOfCurrentBuffer c expectedContent editor =-    assertEqual "Unexpected buffer content" expectedContent (extractBufferString c editor)----- | Asserts that the current buffer is not the specified buffer. The output will--- contain the BufferKey of the current buffer.-assertNotCurrentBuffer :: BufferRef -> Editor -> Assertion-assertNotCurrentBuffer bufref editor =-    assertNotEqual "Unexpected current buffer" bufref (currentBuffer editor)----- | Asserts that the current buffer is the expected buffer. The output will--- contain the expected BufferKey and the acutal BufferKey of the current buffer.-assertCurrentBuffer :: BufferRef -> Editor -> Assertion-assertCurrentBuffer bufref editor =-    assertEqual "Unexpected current buffer" bufref (currentBuffer editor)
− src/tests/TestSuite.hs 
@@ -1,16 +0,0 @@-module Main where--import Test.Tasty (defaultMain, testGroup)--import qualified Vim.TestPureBufferManipulations as VimBuffer-import qualified Vim.TestPureEditorManipulations as VimEditor-import qualified Vim.TestExCommandParsers as VimExCommand--main :: IO ()-main = do-    tests  <- VimBuffer.getTests-    defaultMain $ testGroup "Tests" [-        tests-      , VimEditor.tests-      , VimExCommand.tests-      ]
− src/tests/Vim/EditorManipulations/BufferExCommand.hs 
@@ -1,174 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | Tests for the :buffer ex command in the Vim keymap----module Vim.EditorManipulations.BufferExCommand (tests) where--import qualified Data.List.NonEmpty as NE-import           Generic.TestUtils-import           Test.Tasty (TestTree, testGroup)-import           Test.Tasty.HUnit-import           Yi.Buffer-import           Yi.Config (Config)-import           Yi.Editor-import           Yi.Rope ()--type BufferName = String---- | Create three buffers and return the 'BufferRef' and buffer name of--- each.-createInitialBuffers :: EditorM [(BufferRef, BufferName)]-createInitialBuffers = do-  one   <- newBufferE (FileBuffer "one")   "Buffer one"-  two   <- newBufferE (FileBuffer "two")   "Buffer two"-  three <- newBufferE (FileBuffer "three") "Buffer three"-  return [(one, "one"), (two, "two"), (three, "three")]---nthBufferRef :: Int -> [(BufferRef, BufferName)] -> BufferRef-nthBufferRef n buffers = fst $ buffers !! n--nthBufferName :: Int -> [(BufferRef, BufferName)] -> BufferName-nthBufferName n buffers = snd $ buffers !! n---tests :: Config -> KeyEval -> TestTree-tests c ev =-    testGroup ":buffer" [-        testCase ":buffer {bufname} switches to the named buffer" $ do-            let setupActions = createInitialBuffers--                preConditions editor buffers =-                    assertNotCurrentBuffer (nthBufferRef 1 buffers) editor--                testActions buffers =-                    ev $ ":buffer " ++ nthBufferName 1 buffers ++ "<CR>"--                assertions editor buffers = do-                    assertContentOfCurrentBuffer c "Buffer two" editor-                    assertCurrentBuffer (nthBufferRef 1 buffers) editor--            runTest setupActions preConditions testActions assertions c---      , testCase ":buffer N switches to the numbered buffer" $ do-            let setupActions = createInitialBuffers--                preConditions editor buffers =-                    assertNotCurrentBuffer (nthBufferRef 1 buffers) editor--                testActions buffers =-                    let (BufferRef bref) = nthBufferRef 1 buffers-                    in ev $ ":buffer " ++ show bref ++ "<CR>"--                assertions editor buffers = do-                    assertContentOfCurrentBuffer c "Buffer two" editor-                    assertCurrentBuffer (nthBufferRef 1 buffers) editor--            runTest setupActions preConditions testActions assertions c---      , testCase ":buffer # switches to the previous buffer" $ do-            let setupActions = createInitialBuffers--                preConditions editor buffers =-                    assertEqual "Unexpected buffer stack"-                        [nthBufferRef 2 buffers, nthBufferRef 1 buffers]-                        (take 2 . NE.toList $ bufferStack editor)--                testActions _ =-                    ev $ ":buffer #<CR>"--                assertions editor buffers = do-                    assertEqual "Unexpected buffer stack"-                        [nthBufferRef 1 buffers, nthBufferRef 2 buffers]-                        (take 2 . NE.toList $ bufferStack editor)--            runTest setupActions preConditions testActions assertions c---      , testCase ":buffer % is a no-op" $ do-            let setupActions = createInitialBuffers--                preConditions editor buffers =-                    assertCurrentBuffer (nthBufferRef 2 buffers) editor--                testActions _ =-                    ev $ ":buffer %<CR>"--                assertions editor buffers = do-                    assertContentOfCurrentBuffer c "Buffer three" editor-                    assertCurrentBuffer (nthBufferRef 2 buffers) editor--            runTest setupActions preConditions testActions assertions c---      , testCase ":buffer is a no-op" $ do-            let setupActions = createInitialBuffers--                preConditions editor buffers =-                    assertCurrentBuffer (nthBufferRef 2 buffers) editor--                testActions _ =-                    ev $ ":buffer<CR>"--                assertions editor buffers = do-                    assertContentOfCurrentBuffer c "Buffer three" editor-                    assertCurrentBuffer (nthBufferRef 2 buffers) editor--            runTest setupActions preConditions testActions assertions c---      , testCase "A modified buffer is not abandoned" $ do-            let setupActions = createInitialBuffers--                preConditions editor buffers =-                    assertNotCurrentBuffer (nthBufferRef 1 buffers) editor--                testActions buffers = do-                    withCurrentBuffer $ insertN "The buffer is altered"-                    ev $ ":buffer " ++ nthBufferName 1 buffers ++ "<CR>"--                assertions editor buffers = do-                    assertNotCurrentBuffer (nthBufferRef 1 buffers) editor--            runTest setupActions preConditions testActions assertions c---      , testCase "A modified buffer can be abandoned with a bang" $ do-            let setupActions = createInitialBuffers--                preConditions editor buffers =-                    assertNotCurrentBuffer (nthBufferRef 1 buffers) editor--                testActions buffers = do-                    withCurrentBuffer $ insertN "The buffer is altered"-                    ev $ ":buffer! " ++ nthBufferName 1 buffers ++ "<CR>"--                assertions editor buffers = do-                    assertCurrentBuffer (nthBufferRef 1 buffers) editor--            runTest setupActions preConditions testActions assertions c---      , testCase ":Nbuffer switches to the numbered buffer" $ do-            let setupActions = createInitialBuffers--                preConditions editor buffers =-                    assertNotCurrentBuffer (nthBufferRef 1 buffers) editor--                testActions buffers =-                    -- return ()-                    let (BufferRef bref) = nthBufferRef 1 buffers-                    in ev $ ":" ++ show bref ++ "buffer<CR>"-                    -- in ev $ ":buffer " ++ show bref ++ "<CR>"--                assertions editor buffers = do-                    -- assertContentOfCurrentBuffer c "Buffer two" editor-                    assertCurrentBuffer (nthBufferRef 1 buffers) editor--            runTest setupActions preConditions testActions assertions c---      -- , testCase "A named buffer can be shown in a split window" $ do-      -- , testCase "A numbered buffer can be shown in a split window" $ do-    ]
− src/tests/Vim/TestExCommandParsers.hs 
@@ -1,157 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Vim.TestExCommandParsers (tests) where--import           Control.Applicative-import           Data.Maybe-import           Data.Monoid-import qualified Data.Text as T-import           Test.QuickCheck-import           Test.Tasty (TestTree, testGroup)-import           Test.Tasty.QuickCheck-import           Yi.Keymap.Vim.Common-import           Yi.Keymap.Vim.Ex-import qualified Yi.Keymap.Vim.Ex.Commands.Buffer as Buffer-import qualified Yi.Keymap.Vim.Ex.Commands.BufferDelete as BufferDelete-import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete--data CommandParser = CommandParser-    { cpDescription :: String-    , cpParser      :: String -> Maybe ExCommand-    , cpNames       :: [String]-    , cpAcceptsBang :: Bool-    , cpAcceptsCount :: Bool-    , cpArgs        :: Gen String-    }--addingSpace :: Gen String -> Gen String-addingSpace = fmap (" " <>)--numberString :: Gen String-numberString = (\(NonNegative n) -> show n) <$> (arbitrary :: Gen (NonNegative Int))---- | QuickCheck Generator of buffer identifiers.------ A buffer identifier is either an empty string, a "%" character, a "#"--- character, a string containing only numbers (optionally preceeded by--- a space), or a string containing any chars preceeded by a space. E.g.,------   ["", "%", "#", " myBufferName", " 45", "45"]------ TODO Don't select "", "%", "#" half of the time.-bufferIdentifier :: Gen String-bufferIdentifier =-    oneof [ addingSpace arbitrary-          , addingSpace numberString-          , numberString-          , oneof [pure "%", pure " %"]-          , oneof [pure "#", pure " #"]-          , pure ""-          ]---- | QuickCheck generator of strings suitable for use as register names in Vim--- ex command lines. Does not include a preceding @"@.-registerName :: Gen String-registerName =-    (:[]) <$> oneof [ elements ['0'..'9']-                    , elements ['a'..'z']-                    , elements ['A'..'Z']-                    , elements ['"', '-', '=', '*', '+', '~', '_', '/']-                    -- TODO Should the read-only registers be included here?-                    -- , element [':', '.', '%', '#']-                    ]---- | QuickCheck generator of strings suitable for use as counts in Vim ex--- command lines-count :: Gen String-count = numberString--commandParsers :: [CommandParser]-commandParsers =-    [ CommandParser-          "Buffer.parse"-          (Buffer.parse . Ev . T.pack)-          ["buffer", "buf", "bu", "b"]-          True-          True-          bufferIdentifier--    , CommandParser-          "BufferDelete.parse"-          (BufferDelete.parse . Ev . T.pack)-          ["bdelete", "bdel", "bd"]-          True-          False-          (unwords <$> listOf bufferIdentifier)--    , CommandParser-          "Delete.parse"-          (Delete.parse . Ev . T.pack)-          ["delete", "del", "de", "d"]-          -- XXX TODO support these weird abbreviations too?-          -- :dl, :dell, :delel, :deletl, :deletel-          -- :dp, :dep, :delp, :delep, :deletp, :deletep-          True-          False-          (oneof [ pure ""-                 , addingSpace registerName-                 , addingSpace count-                 , (<>) <$> addingSpace registerName <*> addingSpace count-                 ])-    ]---commandString :: CommandParser -> Gen String-commandString cp = do-    name <- elements $ cpNames cp-    bang <- if cpAcceptsBang cp-                then elements ["!", ""]-                else pure ""-    count' <- if cpAcceptsCount cp-                then count-                else pure ""-    args <- cpArgs cp-    return $ concat [count', name, bang, args]---expectedParserParses :: CommandParser -> TestTree-expectedParserParses commandParser =-    testProperty (cpDescription commandParser <> " parses expected input") $-        forAll (commandString commandParser)-               (isJust . cpParser commandParser)---expectedParserSelected :: CommandParser -> TestTree-expectedParserSelected expectedCommandParser =-    testProperty testName $-        forAll (commandString expectedCommandParser) $ \s ->-            let expectedName = expectedCommandName (Ev $ T.pack s)-                actualName   = actualCommandName (Ev $ T.pack s)-            in counterexample (errorMessage s actualName)-                              (expectedName == actualName)-  where-    unE = T.unpack . _unEv-    expectedCommandName = commandNameFor [cpParser expectedCommandParser . unE]-    actualCommandName   = commandNameFor defExCommandParsers-    commandNameFor parsers s =-        cmdShow <$> evStringToExCommand parsers s-    errorMessage s actualName =-        "Parsed " <> show s <> " to " <> show actualName <> " command"-    testName =-       cpDescription expectedCommandParser <> " selected for expected input"------ | Tests for the Ex command parsers in the Vim Keymap.------ Tests that the parsers parse the strings they are expected to and that--- the expected parser is selected for string.------ The actions of the ex commands are not tested here.-tests :: TestTree-tests =-    testGroup "Vim keymap ex command parsers"-        [ testGroup "Expected parser parses" $-              map expectedParserParses commandParsers-        , testGroup "Expected parser selected" $-              map expectedParserSelected commandParsers-        ]
− src/tests/Vim/TestPureBufferManipulations.hs 
@@ -1,30 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}---- | Tests for pure manipulations of a single buffer in the Vim Keymap.------ A manipulation of a single buffer is an operation or sequence of operations--- which do nothing other than change the contents or cursor position of a--- single buffer.------ This module loads the tests from files in @src/tests/vimtests@. Adding new--- tests, or altering existing tests is done by editing files there. The format--- should be self explanatory.------ If a test is pure and manipulates something other than the contents or cursor--- position of a single buffer, it should be added to the--- 'Vim.TestPureEditorManipulations' module.----module Vim.TestPureBufferManipulations (getTests) where--import qualified Data.Text as T-import qualified Generic.TestPureBufferManipulations as GT-import           Test.Tasty (TestTree)-import           Yi (extractValue)-import           Yi.Config.Default (defaultVimConfig)-import           Yi.Keymap.Vim-import           Yi.Keymap.Vim.Common--getTests :: IO TestTree-getTests = GT.getTests defaultVimConfig "src/tests/vimtests"-           "Vim" (pureEval (extractValue defVimConfig) . Ev . T.pack)
− src/tests/Vim/TestPureEditorManipulations.hs 
@@ -1,28 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--- | Tests for pure manipulations of the editor in the Vim Keymap.------ Pure manipulations of the editor refers to such things as changing layout,--- navigating buffers, creating or deleting buffers, creating or deleting tabs.--- In short, anything which 1) doesn't perform IO and 2) interacts with--- something other than a single buffer.------ If a test is pure and manipulates only a single buffer, it would be better--- being part of the 'Vim.TestPureBufferManipulations' module. That module--- provides a nicer way of writing pure single buffer manipulation tests.----module Vim.TestPureEditorManipulations (tests) where--import qualified Data.Text as T-import           Test.Tasty (TestTree, testGroup)-import qualified Vim.EditorManipulations.BufferExCommand as BufferExCommand-import           Yi (extractValue)-import           Yi.Config.Default (defaultVimConfig)-import           Yi.Keymap.Vim-import           Yi.Keymap.Vim.Common--tests :: TestTree-tests =-    testGroup "Vim pure editor manipulation tests"-        [ BufferExCommand.tests defaultVimConfig-            (pureEval (extractValue defVimConfig) . Ev . T.pack)-        ]
− src/tests/vimtests/README.rst 
@@ -1,59 +0,0 @@-Testing Vim bindings-====================--Single file test format--------------------------  Files with names like "foo.test" are treated as single file tests.--::--  -- Input <-- This marks beginning of initial buffer state-  (1,1)    <-- This is initial cursor position, (row, column), both 1-based-  aaaaa    <-- Here goes actual buffer content-  b b b-  ccccc-  -- Output <-- This marks beginning of expected buffer state after test-  (3,5)     <-- This is expected cursor position-  aaaaa     <-- Expected buffer text-  b bfoo b-  ccccc-  -- Events <-- This line starts event sequence that is fed to editor after loading initial state-  2wifoo-  <Esc>jj--Directory test format------------------------  Directories that contain files "input", "output" and "events" and nothing else are considered directory tests. These three files have the same format as the sections of single file test described above.--Test file naming note------------------------Originally we've used names like "ddP.test" and "ddp.test". It turned out to be really inconvenient on OSX, which uses case-insensitive filesystem by default. We had to rename tests to avoid collisions: "ddP.test" became "dd_capP.test".--Event notation-----------------  Event parsing expects a subset of vim notation (see :help <>). Backslash escaping is not supported. So to enter left angle bracket one must write <lt> and not \<.--Intentionally not supported features of Vim----------------------------------------------  * select mode-  * folds-  * 0<C-d> and ^<C-d> in insert mode-  * After i_<C-o> only motions are allowed--Features incompatible with Vim because why not-------------------------------------------------  * Y yanks to EOL-  * A and I in linewise visual mode behave like in blockwise visual mode-  * 999rZ turns ABC into ZZZ instead of doing nothing-  * Operators in visual mode always leave cursor at selection start. Vim doesn't do this in some cases and I don't understand the pattern.-  * Paragraph text object is slightly different-  * Repeating insert actions with dot works differently when insertion events contain oneshot normal commands, e.g. "ifoo<C-o>hbar<Esc>". In Vim dot would insert only "bar", but yi dot inserts "fobaro"-  * Scrolling motions (<C-f>, PageUp, etc) are treated like linewise motions.-  * <C-w>, <C-u> remove whole region, not only entered characters.-
− src/tests/vimtests/blockvisual/0.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-1234-1234-1234--- Output-(1,2)-14-14-14--- Events-l<C-v>ljjd
− src/tests/vimtests/blockvisual/8.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-ABCD-ABCD-ABCD-ABCD--- Output-(2,2)-ABCD-AcD-AbcD-ABCD--- Events-lj<C-v>jlgux
− src/tests/vimtests/blockvisual/9.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-abcd-abcd-abcd-abcd--- Output-(2,3)-abcd-abD-abCD-abCD--- Events-jjjlll<C-v>kkhgUx
− src/tests/vimtests/blockvisual/block.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-ABCD-ABCD-ABCD-ABCD--- Output-(3,3)-ABCD-ABCD-ABCD-ABCD--- Events-jl<C-v>jl
− src/tests/vimtests/blockvisual/block_d.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-ABCD-ABCD-ABCD-ABCD--- Output-(2,2)-ABCD-AD-AD-ABCD--- Events-jl<C-v>jld
− src/tests/vimtests/blockvisual/block_d_1.test 
@@ -1,14 +0,0 @@--- Input-(1,4)-ABCD-ABCD-ABCD-ABCD--- Output-(2,2)-ABCD-AD-AD-ABCD--- Events-hj<C-v>jhd
− src/tests/vimtests/blockvisual/block_d_2.test 
@@ -1,14 +0,0 @@--- Input-(1,4)-ABCD-ABCD-ABCD-ABCD--- Output-(1,1)-A-A-A-ABCD--- Events-<C-v>2jhhd
− src/tests/vimtests/blockvisual/capD_1.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,1)-f-b--- Events-l<C-v>jD
− src/tests/vimtests/blockvisual/capD_2.test 
@@ -1,20 +0,0 @@--- Input-(2,2)-foo-44444444-bar--baz-xyzzy-123123--- Output-(2,1)-foo-4-b--b-x-123123--- Events-<C-v>4jD
− src/tests/vimtests/blockvisual/capI.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,3)-fo-o-ba-r-ba-z--- Events-ll<C-v>jjI-<Esc>
− src/tests/vimtests/blockvisual/capU_2.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,1)-FOo-BAr-BAz--- Events-<C-v>ljjU
− src/tests/vimtests/blockvisual/commentblock.test 
@@ -1,20 +0,0 @@--- Input-(2,3)-444-  foo bar-  baz xyzzy--  abc-  123-  555--- Output-(2,5)-444-  // foo bar-  // baz xyzzy--  // abc-  123-  555--- Events-<C-v>3jI// <Esc>
− src/tests/vimtests/blockvisual/commentblock_1.test 
@@ -1,14 +0,0 @@--- Input-(1,3)-  foo bar-  baz xyzzy-  abc-123--- Output-(1,3)-  @foo bar-  @baz xyzzy-  @abc-12@3--- Events-<C-v>3jI@<Esc>
− src/tests/vimtests/blockvisual/commentblock_2.test 
@@ -1,20 +0,0 @@--- Input-(2,3)-444-  foo bar-  baz xyzzy--  abc-  123-  555--- Output-(2,5)-444-  // foo bar-  // baz xyzzy--  // abc-  123-  555--- Events-<C-v>3jI// <Esc>
− src/tests/vimtests/blockvisual/d.test 
@@ -1,12 +0,0 @@--- Input-(1,17)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,7)-Lorem  sit amet-abc de-qwe rty uiop--- Events-<C-v>10hjd
− src/tests/vimtests/blockvisual/d_1.test 
@@ -1,14 +0,0 @@--- Input-(2,3)-ABCD-ABCD-ABCD-ABCD--- Output-(2,2)-ABCD-AD-AD-ABCD--- Events-<C-v>jhd
− src/tests/vimtests/blockvisual/d_2.test 
@@ -1,20 +0,0 @@--- Input-(2,1)-444-  foo bar-  baz xyzzy--  abc-  123-  555--- Output-(2,1)-444-foo bar-baz xyzzy--abc-  123-  555--- Events-<C-v>3jld
− src/tests/vimtests/blockvisual/d_3.test 
@@ -1,18 +0,0 @@--- Input-(2,1)-foo-----bar--- Output-(2,1)-foo-----bar--- Events-<C-v>3jd
− src/tests/vimtests/blockvisual/d_4.test 
@@ -1,12 +0,0 @@--- Input-(1,6)-xyzzy123-foo-barbaz90--- Output-(1,6)-xyzzy3-foo-barba0--- Events-<C-v>jjld
− src/tests/vimtests/blockvisual/hl.test 
@@ -1,12 +0,0 @@--- Input-(1,17)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,7)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-<C-v>10hj
− src/tests/vimtests/blockvisual/o_1.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-abcd-abcd-abcd-abcd--- Output-(2,2)-abcd-abcd-abcd-abcd--- Events-<C-v>jlo
− src/tests/vimtests/blockvisual/o_2.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-abcd-abcd-abcd-abcd--- Output-(2,3)-abcd-abcd-abcd-abcd--- Events-<C-v>jloO
− src/tests/vimtests/blockvisual/o_3.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-abcd-abcd-abcd-abcd--- Output-(3,3)-abcd-abcd-abcd-abcd--- Events-<C-v>jloo
− src/tests/vimtests/blockvisual/o_4.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-abcd-abcd-abcd-abcd--- Output-(3,2)-abcd-abcd-abcd-abcd--- Events-<C-v>jlO
− src/tests/vimtests/blockvisual/o_5.test 
@@ -1,12 +0,0 @@--- Input-(1,17)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,2)-Ldolor sit amet-a-qwe rty uiop--- Events-<C-v>j2|Od
− src/tests/vimtests/blockvisual/o_6.test 
@@ -1,12 +0,0 @@--- Input-(1,17)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,7)-Lorem  dolor sit amet-abc de-qwe rty uiop--- Events-<C-v>10hjOhd
− src/tests/vimtests/blockvisual/r_1.test 
@@ -1,14 +0,0 @@--- Input-(1,3)-  foo bar-  baz xyzzy-  abc-123--- Output-(1,3)-  xoo bar-  xaz xyzzy-  xbc-12x--- Events-<C-v>3jrx
− src/tests/vimtests/blockvisual/r_2.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-1234-1234--- Output-(1,2)-1xx4-1xx4--- Events-l<C-v>ljrx
− src/tests/vimtests/blockvisual/r_3.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,2)-fxx-bxx-baz--- Events-l<C-v>ljrx
− src/tests/vimtests/blockvisual/switchcase_2.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,1)-FOo-BAr--- Events-<C-v>jl~
− src/tests/vimtests/blockvisual/u_2.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-FOO-BAR-BAZ--- Output-(1,1)-foO-baR-baZ--- Events-<C-v>ljju
− src/tests/vimtests/blockvisual/y_10.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-1234-abcd-ABCD-XYZW--- Output-(2,2)-1234-abcdbcd-ABCD-XYZW--- Events-<C-v>llyP
− src/tests/vimtests/blockvisual/y_11.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-abcdef-abcdef-abcdef-abcdef--- Output-(2,2)-abcdef-a    bcdef-a    bcdef-a    bcdef--- Events-<C-v>jj>
− src/tests/vimtests/blockvisual/y_12.test 
@@ -1,15 +0,0 @@--- Input-(2,2)-abcdef-abcdef-abcdef-abcdef--- Output-(3,3)-abcdef-abcdef-abbcdcdef-abbcdcdef-  bcd--- Events-<C-v>lljjyjp
− src/tests/vimtests/blockvisual/y_13.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-abcdef-a bcdef-a bcdef-abcdef--- Output-(2,2)-abcdef-a     bcdef-a     bcdef-a    bcdef--- Events-<C-v>jj>
− src/tests/vimtests/blockvisual/y_14.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-abcdef-a    bcdef-a    bcdef-a    bcdef--- Output-(2,2)-abcdef-abcdef-abcdef-abcdef--- Events-<C-v>jj<lt>
− src/tests/vimtests/blockvisual/y_15.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-abcdef-a      bcdef-a      bcdef-a      bcdef--- Output-(2,2)-abcdef-a  bcdef-a  bcdef-a  bcdef--- Events-<C-v>jj<lt>
− src/tests/vimtests/blockvisual/y_3.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-12-12--- Output-(1,2)-112-112--- Events-<C-v>jyp
− src/tests/vimtests/blockvisual/y_4.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-1234-abcd-ABCD-XYZW--- Output-(2,3)-1234-abbccd-ABBCCD-XYZW--- Events-lj<C-v>ljyp
− src/tests/vimtests/blockvisual/y_7.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-1234-abcd-ABCD-XYZW--- Output-(2,2)-1234-abcbcd-ABCBCD-XYZW--- Events-lj<C-v>ljyP
− src/tests/vimtests/blockvisual/y_8.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-1234-abcd-ABCD-XYZW--- Output-(1,5)-12344-abcdd-ABCDD-XYZW--- Events-$<C-v>jjyp
− src/tests/vimtests/blockvisual/y_9.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-1234-abcd-ABCD-XYZW--- Output-(2,2)-1234-abcdbcd-ABCD-XYZW--- Events-<C-v>llllllllyP
− src/tests/vimtests/change/C_part_of_line.test 
@@ -1,12 +0,0 @@--- Input-(1,9)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,11)-Lorem ipman-abc def ghi-qwe rty uiop--- Events-Cman<Esc>
− src/tests/vimtests/change/C_whole_line.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,3)-man-abc def ghi-qwe rty uiop--- Events-Cman<Esc>
− src/tests/vimtests/change/S.test 
@@ -1,12 +0,0 @@--- Input-(1,11)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,3)-man-abc def ghi-qwe rty uiop--- Events-Sman<Esc>
− src/tests/vimtests/change/c3l.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,11)-xem ipsum xor sit amet-abc def ghi-qwe rty uiop--- Events-c3lx<Esc>ww.
− src/tests/vimtests/change/ciw.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,3)-foo ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-ciwfoo<Esc>
− src/tests/vimtests/delete/10dd.test 
@@ -1,10 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-Lorem ipsum dolor sit amet--- Events-10dd
− src/tests/vimtests/delete/2d3w.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-a b c d e f g h--- Output-(1,1)-g h--- Events-2d3w
− src/tests/vimtests/delete/2d3w_1.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-a b c d e f g h-a b c d e f g h--- Output-(2,1)-g h-e f g h--- Events-2d3wj4.
− src/tests/vimtests/delete/2dd.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-qwe rty uiop--- Events-2dd
− src/tests/vimtests/delete/C-u_1.test 
@@ -1,10 +0,0 @@--- Input-(2,5)-Lorem ipsum dolor sit amet-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-rty uiop--- Events-i<C-u>
− src/tests/vimtests/delete/C-u_2.test 
@@ -1,9 +0,0 @@--- Input-(2,1)-foo bar-baz--- Output-(1,8)-foo barbaz--- Events-i<C-u>
− src/tests/vimtests/delete/capD.test 
@@ -1,12 +0,0 @@--- Input-(1,1)- foo- bar- baz--- Output-(2,2)- foo- b- baz--- Events-jllD
− src/tests/vimtests/delete/capX.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-A very intelligent turtle-Found programming UNIX a hurdle--- Output-(2,11)-A very intelligent turtle-Found progng UNIX a hurdle--- Events-15lj3XXX
− src/tests/vimtests/delete/capX_1.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,1)-foo-ar-baz--- Events-5X
− src/tests/vimtests/delete/d0.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-abc def ghi-123 456 789-lorem ipsum--- Output-(1,1)-bc def ghi-123 456 789-lorem ipsum--- Events-dl
− src/tests/vimtests/delete/d2G.test 
@@ -1,12 +0,0 @@--- Input-(3,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop-aze rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-aze rty uiop--- Events-d2G
− src/tests/vimtests/delete/d2vd.test 
@@ -1,12 +0,0 @@--- Input-(2,8)-Lorem ipsum dolor sit amet-   abc def ghi-qwe rty uiop--- Output-(2,7)-Lorem ipsum dolor sit amet-   abc -qwe rty uiop--- Events-d2vd
− src/tests/vimtests/delete/d2vd_1.test 
@@ -1,11 +0,0 @@--- Input-(2,8)-Lorem ipsum dolor sit amet-   abc def ghi-    qwe rty uiop--- Output-(2,8)-Lorem ipsum dolor sit amet-   abc qwe rty uiop--- Events-d2vd
− src/tests/vimtests/delete/d3G.test 
@@ -1,12 +0,0 @@--- Input-(2,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop-aze rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-aze rty uiop--- Events-d3G
− src/tests/vimtests/delete/d3vd.test 
@@ -1,12 +0,0 @@--- Input-(2,8)-Lorem ipsum dolor sit amet-   abc def ghi-    qwe rty uiop-    qwe rty uiop--- Output-(2,8)-Lorem ipsum dolor sit amet-   abc qwe rty uiop--- Events-d3vd
− src/tests/vimtests/delete/dVl.test 
@@ -1,11 +0,0 @@--- Input-(2,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-qwe rty uiop--- Events-dVl
− src/tests/vimtests/delete/d_capG.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop-aze rty uiop--- Output-(1,1)---- Events-dG
− src/tests/vimtests/delete/d_capV}.test 
@@ -1,10 +0,0 @@--- Input-(1,5)-Foo bar baz--123 234 345--- Output-(1,1)-123 234 345--- Events-dV}
− src/tests/vimtests/delete/daw.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-daw
− src/tests/vimtests/delete/dd.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-qwe rty uiop--- Events-jdd
− src/tests/vimtests/delete/dd_1.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-qwe rty uiop--- Events-j$dd
− src/tests/vimtests/delete/dd_2.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-qwe rty uiop--- Events-$2dd
− src/tests/vimtests/delete/dd_3.test 
@@ -1,11 +0,0 @@--- Input-(3,3)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-abc def ghi--- Events-dd
− src/tests/vimtests/delete/dd_4.test 
@@ -1,12 +0,0 @@--- Input-(2,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop- --- Output-(2,1)-Lorem ipsum dolor sit amet- --- Events-2dd
− src/tests/vimtests/delete/dd_5.test 
@@ -1,14 +0,0 @@--- Input-(2,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop----- Output-(2,1)-Lorem ipsum dolor sit amet----- Events-2dd
− src/tests/vimtests/delete/de.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-de
− src/tests/vimtests/delete/diw.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-diw
− src/tests/vimtests/delete/dj.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-qwe rty uiop--- Events-dj
− src/tests/vimtests/delete/dt.test 
@@ -1,12 +0,0 @@--- Input-(2,10)-Lorem ipsum dolor sit amet-[peanut butter and jelly]-qwe rty uiop--- Output-(2,10)-Lorem ipsum dolor sit amet-[peanut b]-qwe rty uiop--- Events-dt]
− src/tests/vimtests/delete/dvd.test 
@@ -1,12 +0,0 @@--- Input-(2,8)-Lorem ipsum dolor sit amet-   abc def ghi-qwe rty uiop--- Output-(2,4)-Lorem ipsum dolor sit amet-   def ghi-qwe rty uiop--- Events-dvd
− src/tests/vimtests/delete/dve.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-Foo bar baz--- Output-(1,1)-o bar baz--- Events-dve
− src/tests/vimtests/delete/dv}.test 
@@ -1,10 +0,0 @@--- Input-(1,5)-Foo bar baz--123 234 345--- Output-(1,5)-Foo 123 234 345--- Events-dv}
− src/tests/vimtests/delete/dw_1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-sit amet-abc def ghi-qwe rty uiop--- Events-dw..
− src/tests/vimtests/delete/d}.test 
@@ -1,12 +0,0 @@--- Input-(1,5)-Foo bar baz--123 234 345--- Output-(1,4)-Foo --123 234 345--- Events-d}
− src/tests/vimtests/delete/ld3w.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-1 2 3-4 5 6--- Output-(1,1)-1-4 5 6--- Events-ld3w
− src/tests/vimtests/delete/ld3w_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-1 2 3 4 5 6--- Output-(1,2)-14 5 6--- Events-ld3w
− src/tests/vimtests/delete/ldw.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-1 2 3-4 5 6--- Output-(1,2)-12 3-4 5 6--- Events-ldw
− src/tests/vimtests/delete/ldwdw.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-1 2 3-4 5 6--- Output-(1,2)-13-4 5 6--- Events-ldwdw
− src/tests/vimtests/delete/spec_delete.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,2)-foo-br-baz--- Events-<Del>
− src/tests/vimtests/delete/x.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-A very intelligent turtle-Found programming UNIX a hurdle--- Output-(2,4)-A very intelligent turtle-Foumming UNIX a hurdle--- Events-3lj5xxxxx
− src/tests/vimtests/delete/x_1.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,1)-foo-b-baz--- Events-5x
− src/tests/vimtests/digraphs/ae.test 
@@ -1,8 +0,0 @@--- Input-(1,5)-abcdf--- Output-(1,5)-abcdæf--- Events-i<C-k>ae<Esc>
− src/tests/vimtests/digraphs/eacute.test 
@@ -1,8 +0,0 @@--- Input-(1,5)-abcdf--- Output-(1,5)-abcdéf--- Events-i<C-k>'e<Esc>
− src/tests/vimtests/empty/empty.test 
@@ -1,13 +0,0 @@--- Input-(1,1)------- Output-(1,1)------- Events
− src/tests/vimtests/empty/emptytest/events 
− src/tests/vimtests/empty/emptytest/input 
@@ -1,8 +0,0 @@-(1,1)-------
− src/tests/vimtests/empty/emptytest/output 
@@ -1,8 +0,0 @@-(1,1)-------
− src/tests/vimtests/ex/d/1.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,1)-foo-baz--- Events-j:d<CR>
− src/tests/vimtests/ex/d/2.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,1)-foo-baz--- Events-j:delete<CR>
− src/tests/vimtests/ex/empty.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,1)---- Events-:<CR>:<CR>:<CR>
− src/tests/vimtests/ex/esc.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,2)-foo-bar-baz--- Events-ll:<Esc>hj
− src/tests/vimtests/ex/esc_1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,2)-foo-bar-baz--- Events-ll:blah<Esc>hj
− src/tests/vimtests/ex/fail.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,2)-foo-bar-baz--- Events-ll:blah<CR>hj
− src/tests/vimtests/ex/g/1.test 
@@ -1,20 +0,0 @@--- Input-(2,1)-a 1-bb 2-bb 3-bb 4-ba 5-bb 6-bb 3--- Output-(2,1)-a 1-bb 2-bb x-bb 4-ba 5-bb 6-bb x--- Events-:g/bb/s/3/x/<CR>
− src/tests/vimtests/ex/g/2.test 
@@ -1,19 +0,0 @@--- Input-(1,1)-a 1-bb 2-bb 3-bb 4-ba 5-bb 6-bb 7--- Output-(1,1)-a 1-bb 2-bb 3-bb 4-bb 6-bb 7--- Events-:g/ba/d<CR>
− src/tests/vimtests/ex/gotoline/1.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-foo-bar-baz-xyzzy--- Output-(3,1)-foo-bar-baz-xyzzy--- Events-:3<CR>
− src/tests/vimtests/ex/gotoline/2.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-foo-bar-  baz-xyzzy--- Output-(3,3)-foo-bar-  baz-xyzzy--- Events-:3<CR>
− src/tests/vimtests/ex/gotoline/3.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-foo-bar-  baz-xyzzy--- Output-(1,1)-foo-bar-  baz-xyzzy--- Events-:0<CR>
− src/tests/vimtests/ex/gotoline/4.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-foo-bar-  baz-xyzzy--- Output-(4,1)-foo-bar-  baz-xyzzy--- Events-:100500<CR>
− src/tests/vimtests/ex/s/1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,1)-foo-car-baz--- Events-j:s/b/c/<CR>
− src/tests/vimtests/ex/s/1_dollar.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,1)-foo-car-baz--- Events-j:s$b$c$<CR>
− src/tests/vimtests/ex/s/1_question.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,1)-foo-car-baz--- Events-j:s?b?c?<CR>
− src/tests/vimtests/ex/s/1_sharp.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,1)-foo-car-baz--- Events-j:s#b#c#<CR>
− src/tests/vimtests/ex/s/2.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,1)-foo-car-caz--- Events-j:%s/b/c/<CR>
− src/tests/vimtests/ex/s/3.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bbar-baz--- Output-(2,1)-foo-cbar-baz--- Events-j:s/b/c/<CR>
− src/tests/vimtests/ex/s/4.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bbar-baz--- Output-(2,1)-foo-ccar-baz--- Events-j:s/b/c/g<CR>
− src/tests/vimtests/ex/s/5.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bbar-bbaz--- Output-(2,1)-foo-cbar-cbaz--- Events-j:%s/b/c/<CR>
− src/tests/vimtests/ex/s/6.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bbar-bbaz--- Output-(2,1)-foo-ccar-ccaz--- Events-j:%s/b/c/g<CR>
− src/tests/vimtests/ex/s/7.test 
@@ -1,16 +0,0 @@--- Input-(1,1)-foo-bbar-bbaz-bbaz-quux--- Output-(2,1)-foo-cbar-cbaz-cbaz-quux--- Events-j:%s/b/c/<CR>
− src/tests/vimtests/find/f.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,7)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-fi
− src/tests/vimtests/find/f1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,20)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-2fi
− src/tests/vimtests/find/f2.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,20)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-fi;
− src/tests/vimtests/find/f3.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,7)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-fi;,
− src/tests/vimtests/find/f4.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-fh
− src/tests/vimtests/find/t.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,6)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-ti
− src/tests/vimtests/find/t1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,19)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-2ti
− src/tests/vimtests/find/t2.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,19)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-til;
− src/tests/vimtests/find/t3.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,7)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-fi;,
− src/tests/vimtests/find/t4.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-th
− src/tests/vimtests/find/t5.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,6)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-ti;
− src/tests/vimtests/find/t6.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-to2;
− src/tests/vimtests/indent/1.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-foo-bar-baz-123--- Output-(2,5)-foo-    bar-    baz-123--- Events-j>j
− src/tests/vimtests/indent/2.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-foo-bar-baz-123--- Output-(2,5)-foo-    bar-baz-123--- Events-j>>
− src/tests/vimtests/indent/3.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-foo-bar-baz-123--- Output-(2,5)-foo-    bar-    baz-123--- Events-j2>>
− src/tests/vimtests/indent/4.test 
@@ -1,14 +0,0 @@--- Input-(2,5)-foo-    bar-baz-123--- Output-(2,1)-foo-bar-baz-123--- Events-<lt><lt>
− src/tests/vimtests/indent/5.test 
@@ -1,14 +0,0 @@--- Input-(2,5)-foo-    bar-    baz-    123--- Output-(2,1)-foo-bar-baz-    123--- Events-2<lt><lt>
− src/tests/vimtests/indent/6.test 
@@ -1,14 +0,0 @@--- Input-(2,6)-foo-    bar-    baz-    123--- Output-(2,1)-foo-bar-baz-    123--- Events-Vj<lt>
− src/tests/vimtests/indent/setpaste.test 
@@ -1,14 +0,0 @@--- Input-(1,7)-    foo-    bar-    baz--- Output-(3,3)-    foo-    quux-123-    bar-    baz--- Events-a<CR>quux<Esc>:set paste<CR>a<CR>123<Esc>
− src/tests/vimtests/insertion/2o.test 
@@ -1,14 +0,0 @@--- Input-(2,1)-123-456-789--- Output-(4,3)-123-456-abc-abc-789--- Events-2oabc<Esc>
− src/tests/vimtests/insertion/C-c_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-bar--- Output-(1,1)-ar--- Events-s<C-c>
− src/tests/vimtests/insertion/C-c_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-bar--- Output-(1,1)-br--- Events-ls<C-c>
− src/tests/vimtests/insertion/C-c_10.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(2,1)-foo--bar--- Events-o<C-c>
− src/tests/vimtests/insertion/C-c_11.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo bar--- Output-(1,1)-oo bar--- Events-wlI<C-c>x
− src/tests/vimtests/insertion/C-c_12.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo bar--- Output-(1,5)-foo ar--- Events-wli<C-c>x
− src/tests/vimtests/insertion/C-c_13.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo bar--- Output-(1,10)-foo bhelloar--- Events-wlihello<C-c>
− src/tests/vimtests/insertion/C-c_2.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,1)--bar--- Events-S<C-c>
− src/tests/vimtests/insertion/C-c_3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-baz bar--- Output-(1,6)-baz ba--- Events-lA<C-c>x
− src/tests/vimtests/insertion/C-c_4.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-baz bar--- Output-(1,2)-bz bar--- Events-la<C-c>x
− src/tests/vimtests/insertion/C-c_5.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,1)--bar-baz--- Events-C<C-c>
− src/tests/vimtests/insertion/C-c_6.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo bar baz--- Output-(1,1)- baz--- Events-c2w<C-c>
− src/tests/vimtests/insertion/C-c_7.test 
@@ -1,13 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(3,1)-foo-bar--baz--- Events-jo<C-c>
− src/tests/vimtests/insertion/C-c_8.test 
@@ -1,13 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,1)-foo--bar-baz--- Events-jO<C-c>
− src/tests/vimtests/insertion/C-c_9.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,1)--foo-bar--- Events-O<C-c>
− src/tests/vimtests/insertion/C-d_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,5)-    foo--- Events-i<C-t>
− src/tests/vimtests/insertion/C-d_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-    foo--- Output-(1,1)-foo--- Events-i<C-d>
− src/tests/vimtests/insertion/C-d_2.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,1)-foo-bar--- Events-i<C-t><C-d>
− src/tests/vimtests/insertion/C-e_0.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,1)-bfoo-bar--- Events-i<C-e><Esc>
− src/tests/vimtests/insertion/C-e_1.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,3)-barfoo-bar--- Events-i<C-e><C-e><C-e><Esc>
− src/tests/vimtests/insertion/C-e_2.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-b--- Output-(1,1)-bfoo-b--- Events-i<C-e><C-e><C-e><Esc>
− src/tests/vimtests/insertion/C-h_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,1)-foo--- Events-i<C-h>
− src/tests/vimtests/insertion/C-h_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)- foo--- Output-(1,1)-foo--- Events-li<C-h><Esc>
− src/tests/vimtests/insertion/C-h_2.test 
@@ -1,9 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,3)-foobar--- Events-ji<C-h><Esc>
− src/tests/vimtests/insertion/C-h_3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-1234567890--- Output-(1,5)-12345--- Events-A<C-h><C-h><C-h><C-h><C-h><Esc>
− src/tests/vimtests/insertion/C-h_4.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-1-2-3--- Output-(1,1)-1--- Events-GA<C-h><C-h><C-h><C-h><Esc>
− src/tests/vimtests/insertion/C-o_2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo bar baz--- Output-(1,4)-foo  baz--- Events-i<C-o>7l<C-w><Esc>
− src/tests/vimtests/insertion/C-o_3.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,3)-foo-arbaz--- Events-li<C-o>j<C-w><C-o>j<C-w>
− src/tests/vimtests/insertion/C-o_4.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,3)-ugougsausageosausage--- Events-isausage<C-o>bugo<Esc>.
− src/tests/vimtests/insertion/C-r_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-barbaz--- Output-(1,3)-barbarbaz--- Events-"ay3li<C-r>a<Esc>
− src/tests/vimtests/insertion/C-r_1.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-bar-baz--- Output-(2,1)-babar-r-baz--- Events-"byylli<C-r>b<Esc>
− src/tests/vimtests/insertion/C-w_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobar--- Output-(1,1)-r--- Events-$i<C-w>
− src/tests/vimtests/insertion/C-w_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobar--- Output-(1,1)-r--- Events-$i<C-w>
− src/tests/vimtests/insertion/C-y_0.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(2,3)-foo-foobar--- Events-ji<C-y><C-y><C-y><Esc>
− src/tests/vimtests/insertion/C-y_1.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(2,1)-foo-fbar--- Events-ji<C-y><Esc>
− src/tests/vimtests/insertion/C-y_2.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-f-bar--- Output-(2,1)-f-fbar--- Events-ji<C-y><C-y><C-y><Esc>
− src/tests/vimtests/insertion/O2.test 
@@ -1,13 +0,0 @@--- Input-(2,1)-abc-def-ghi--- Output-(2,1)-abc--def-ghi--- Events-O<Esc>
− src/tests/vimtests/insertion/a.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,4)-foOOo--- Events-ifoo<Esc>haOO<Esc>
− src/tests/vimtests/insertion/a2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,3)-fOOoo--- Events-ifoo<Esc>0aOO<Esc>
− src/tests/vimtests/insertion/a3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,5)-fooOO--- Events-ifoo<Esc>$aOO<Esc>
− src/tests/vimtests/insertion/a4.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,5)-fooOO--- Events-ifoo<Esc>aOO<Esc>
− src/tests/vimtests/insertion/capA.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,5)-fooOO--- Events-ifoo<Esc>AOO<Esc>
− src/tests/vimtests/insertion/capA2.test 
@@ -1,14 +0,0 @@--- Input-(2,1)------- Output-(2,3)--foo----- Events-Afoo<Esc>
− src/tests/vimtests/insertion/capA3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,5)-fooOO--- Events-ifoo<Esc>hAOO<Esc>
− src/tests/vimtests/insertion/capA4.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,5)-fooOO--- Events-ifoo<Esc>$AOO<Esc>
− src/tests/vimtests/insertion/capI.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,2)-OOfoo--- Events-ifoo<Esc>IOO<Esc>
− src/tests/vimtests/insertion/capI2.test 
@@ -1,8 +0,0 @@--- Input-(1,7)-    foo--- Output-(1,7)-    barfoo--- Events-Ibar<Esc>
− src/tests/vimtests/insertion/capI3.test 
@@ -1,8 +0,0 @@--- Input-(1,7)---- Output-(1,3)-bar--- Events-Ibar<Esc>
− src/tests/vimtests/insertion/capO.test 
@@ -1,14 +0,0 @@--- Input-(2,1)-abc-def-ghi--- Output-(3,3)-abc-123-456-def-ghi--- Events-O123<CR>456<Esc>
− src/tests/vimtests/insertion/counted_a.test 
@@ -1,8 +0,0 @@--- Input-(1,2)-aa--- Output-(1,44)-aaxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx--- Events-42ax<Esc>
− src/tests/vimtests/insertion/counted_capA.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa--- Output-(1,44)-aaxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx--- Events-42Ax<Esc>
− src/tests/vimtests/insertion/counted_capI.test 
@@ -1,8 +0,0 @@--- Input-(1,2)-aa--- Output-(1,42)-xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxaa--- Events-42Ix<Esc>
− src/tests/vimtests/insertion/counted_capO.test 
@@ -1,14 +0,0 @@--- Input-(2,1)-abc-def-ghi--- Output-(3,3)-abc-123-123-def-ghi--- Events-2O123<Esc>
− src/tests/vimtests/insertion/counted_i.test 
@@ -1,8 +0,0 @@--- Input-(1,2)-aa--- Output-(1,25)-axyzxyzxyzxyzxyzxyzxyzxyza--- Events-8ixyz<Esc>
− src/tests/vimtests/insertion/counted_o.test 
@@ -1,14 +0,0 @@--- Input-(2,1)-abc-def-ghi--- Output-(4,3)-abc-def-123-123-ghi--- Events-2o123<Esc>
− src/tests/vimtests/insertion/cursorkeys/down.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(3,3)-foo-b1ar-ba3z--- Events-i1<Down>3<Esc>
− src/tests/vimtests/insertion/cursorkeys/left.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,2)-foo-b31ar-baz--- Events-i1<Left>3<Esc>
− src/tests/vimtests/insertion/cursorkeys/right.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,4)-foo-b1a3r-baz--- Events-i1<Right>3<Esc>
− src/tests/vimtests/insertion/cursorkeys/up.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(1,3)-fo3o-b1ar-baz--- Events-i1<Up>3<Esc>
− src/tests/vimtests/insertion/i.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,3)-fOOoo--- Events-ifoo<Esc>hiOO<Esc>
− src/tests/vimtests/insertion/i2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,2)-OOfoo--- Events-ifoo<Esc>0iOO<Esc>
− src/tests/vimtests/insertion/i3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,4)-foOOo--- Events-ifoo<Esc>$iOO<Esc>
− src/tests/vimtests/insertion/indent_0.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-    foo-    bar-    baz--- Output-(4,9)-    foo-    bar--    xyzzy-    baz--- Events-jo<CR>xyzzy<Esc>
− src/tests/vimtests/insertion/indent_1.test 
@@ -1,11 +0,0 @@--- Input-(1,8)-    foo bar-    baz--- Output-(2,4)-    foo-    bar-    baz--- Events-i<CR><Esc>
− src/tests/vimtests/insertion/indent_2.test 
@@ -1,11 +0,0 @@--- Input-(1,9)-    foo bar-    baz--- Output-(2,4)-    foo -    bar-    baz--- Events-i<CR><Esc>
− src/tests/vimtests/insertion/indent_3.test 
@@ -1,16 +0,0 @@--- Input-(1,1)-    foo-    bar-    baz--- Output-(6,9)-    foo-    bar----    xyzzy-    baz--- Events-jo<CR><CR><CR>xyzzy<Esc>
− src/tests/vimtests/insertion/indent_4.test 
@@ -1,16 +0,0 @@--- Input-(1,1)-    foo-    bar-    baz--- Output-(6,1)-    foo-    bar-----    baz--- Events-jo<CR><CR><CR><Esc>
− src/tests/vimtests/insertion/indent_5.test 
@@ -1,16 +0,0 @@--- Input-(1,1)-    foo-    bar-    baz--- Output-(6,5)-    foo-    bar----xyzzy-    baz--- Events-jo<CR><C-d><CR><CR>xyzzy<Esc>
− src/tests/vimtests/insertion/indent_6.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-    foo-    bar-    baz--- Output-(4,5)-    foo-    bar--xyzzy-    baz--- Events-jo<CR><C-d>xyzzy<Esc>
− src/tests/vimtests/insertion/indent_7.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-    foo-    bar-    baz--- Output-(4,5)-    foo-    bar--xyzzy-    baz--- Events-jo<C-d><CR>xyzzy<Esc>
− src/tests/vimtests/insertion/indent_8.test 
@@ -1,16 +0,0 @@--- Input-(1,1)-        foo-        bar-        baz--- Output-(6,9)-        foo-        bar----    xyzzy-        baz--- Events-jo<CR><C-d><CR><CR>xyzzy<Esc>
− src/tests/vimtests/insertion/nl_insert.test 
@@ -1,9 +0,0 @@--- Input-(1,2)-x--- Output-(2,1)-xbc-d--- Events-abc<CR>d<Esc>
− src/tests/vimtests/insertion/o.test 
@@ -1,14 +0,0 @@--- Input-(2,1)-abc-def-ghi--- Output-(4,3)-abc-def-123-456-ghi--- Events-o123<CR>456<Esc>
− src/tests/vimtests/insertion/o1.test 
@@ -1,13 +0,0 @@--- Input-(2,1)-abc-def-ghi--- Output-(3,1)-abc-def--ghi--- Events-o<Esc>
− src/tests/vimtests/insertion/onechar.test 
@@ -1,11 +0,0 @@--- Input-(1,4)-foo-bar--- Output-(2,1)-foo-x-bar--- Events-i<CR>x<Esc>
− src/tests/vimtests/insertion/spec_delete.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,1)-foo-br-baz--- Events-i<Del><Esc>
− src/tests/vimtests/insertion/spec_insert.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,2)-foo-b1ar-baz--- Events-<Ins>1<Esc>
− src/tests/vimtests/joinlines/1.test 
@@ -1,9 +0,0 @@--- Input-(1,3)-aaa-bbb--- Output-(1,4)-aaa bbb--- Events-J
− src/tests/vimtests/joinlines/2.test 
@@ -1,9 +0,0 @@--- Input-(1,1)-aaa-bbb--- Output-(1,4)-aaa bbb--- Events-J
− src/tests/vimtests/joinlines/counted_1.test 
@@ -1,9 +0,0 @@--- Input-(1,3)-aaa-bbb--- Output-(1,4)-aaa bbb--- Events-1J
− src/tests/vimtests/joinlines/counted_2.test 
@@ -1,10 +0,0 @@--- Input-(1,2)-aaa-bbb-ccc--- Output-(1,8)-aaa bbb ccc--- Events-3J
− src/tests/vimtests/jumplist/1.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet--- Output-(2,7)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet--- Events-w***<C-o><C-o>
− src/tests/vimtests/jumplist/2.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet--- Output-(4,7)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet--- Events-w***<C-o><C-o><Tab><Tab>
− src/tests/vimtests/macros/0.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-qwf-ars-zxc--- Output-(2,5)-qwf-arfoos-zxc--- Events-qaafoo<Esc>q
− src/tests/vimtests/macros/1.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-qwf-ars-zxc--- Output-(2,11)-qwf-arfoofoofoos-zxc--- Events-qaafoo<Esc>q@a@a
− src/tests/vimtests/macros/10.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Output-(1,11)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Events-q1eq2@1
− src/tests/vimtests/macros/11.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Output-(1,8)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Events-q1f3lq@1
− src/tests/vimtests/macros/12.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Output-(1,15)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Events-q1eeq@1
− src/tests/vimtests/macros/13.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-abc---- Output-(2,10)-abc123-A123<Esc>b--- Events-qqA123<Esc>bqj"qp
− src/tests/vimtests/macros/14.test 
@@ -1,10 +0,0 @@--- Input-(2,1)-abc-A123<Esc>b--- Output-(1,1)-abc123-A123<Esc>b--- Events-"0yyk@0
− src/tests/vimtests/macros/15.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,4)-^x$x--- Events-qr^x$xq"rp
− src/tests/vimtests/macros/16.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-^x$x-"123 123 123"-"123 123 123"--- Output-(3,11)-^x$x-123 123 123-123 123 123--- Events-"ry$j@rj@r
− src/tests/vimtests/macros/2.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-qwf-ars-zxc--- Output-(2,2)-qwf-ars-zxc--- Events-qaq
− src/tests/vimtests/macros/3.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-qwf-ars-zxc--- Output-(2,8)-qwf-arfoofoos-zxc--- Events-qaafoo<Esc>q@a
− src/tests/vimtests/macros/4.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-qwf-ars-zxc--- Output-(2,11)-qwf-arfoofoofoos-zxc--- Events-qaafoo<Esc>q2@a
− src/tests/vimtests/macros/5.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-qwf-ars-zxc--- Output-(2,4)-qwf-afoorfoofoos-zxc--- Events-qaafoo<Esc>q@a0@a
− src/tests/vimtests/macros/6.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Output-(1,7)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Events-qqf3q@q
− src/tests/vimtests/macros/7.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Output-(1,11)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Events-qqf3q2@q
− src/tests/vimtests/macros/8.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Output-(1,7)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Events-q1f3q@1
− src/tests/vimtests/macros/9.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Output-(1,7)-123 123 123 qwf-123 123 123 ars-123 123 123 zxc--- Events-q1eq@1
− src/tests/vimtests/marks/unjump_backquote.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet--- Output-(2,7)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet--- Events-w**``
− src/tests/vimtests/marks/unjump_quote.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-    Lorem ipsum dolor sit amet-    Lorem ipsum dolor sit amet-    Lorem ipsum dolor sit amet-    Lorem ipsum dolor sit amet--- Output-(2,5)-    Lorem ipsum dolor sit amet-    Lorem ipsum dolor sit amet-    Lorem ipsum dolor sit amet-    Lorem ipsum dolor sit amet--- Events-ww**''
− src/tests/vimtests/marks/unjump_quote_blank.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-    Lorem ipsum dolor sit amet-                -    Lorem ipsum dolor sit amet-    Lorem ipsum dolor sit amet--- Output-(2,16)-    Lorem ipsum dolor sit amet-                -    Lorem ipsum dolor sit amet-    Lorem ipsum dolor sit amet--- Events-wwjG''
− src/tests/vimtests/movement/bigWord/2e.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,5)-aa bb cc dd--- Events-2E
− src/tests/vimtests/movement/bigWord/2w.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,7)-aa bb cc dd--- Events-2W
− src/tests/vimtests/movement/bigWord/6b.test 
@@ -1,12 +0,0 @@--- Input-(3,3)-a b- ccc 111 22 3-d e--- Output-(1,3)-a b- ccc 111 22 3-d e--- Events-6B
− src/tests/vimtests/movement/bigWord/B_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-quux(foo, bar, baz);--- Output-(1,11)-quux(foo, ar, baz);--- Events-2W4lBBx
− src/tests/vimtests/movement/bigWord/b.test 
@@ -1,12 +0,0 @@--- Input-(3,3)-a b- ccc 111 22 3-d e--- Output-(3,1)-a b- ccc 111 22 3-d e--- Events-B
− src/tests/vimtests/movement/bigWord/bbbb.test 
@@ -1,12 +0,0 @@--- Input-(3,3)-a b- ccc 111 22 3-d e--- Output-(2,6)-a b- ccc 111 22 3-d e--- Events-BBBB
− src/tests/vimtests/movement/bigWord/e.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,2)-aa bb cc dd--- Events-E
− src/tests/vimtests/movement/bigWord/ee.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,5)-aa bb cc dd--- Events-EE
− src/tests/vimtests/movement/bigWord/punctuation.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-a-b+c"d foo--- Output-(1,9)-a-b+c"d foo--- Events-W
− src/tests/vimtests/movement/bigWord/punctuation_b.test 
@@ -1,8 +0,0 @@--- Input-(1,11)-a-b+c"d foo--- Output-(1,1)-a-b+c"d foo--- Events-BB
− src/tests/vimtests/movement/bigWord/punctuation_e.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-a-b+c"d foo--- Output-(1,7)-a-b+c"d foo--- Events-E
− src/tests/vimtests/movement/bigWord/too_much_b.test 
@@ -1,12 +0,0 @@--- Input-(3,3)-a b- ccc 111 22 3-d e--- Output-(1,1)-a b- ccc 111 22 3-d e--- Events-BBBBBBBBBBBBBBBBBBBBBBBBBBBBBB
− src/tests/vimtests/movement/bigWord/too_much_e.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,11)-aa bb cc dd--- Events-EEEEEEEEEEEEEEEEEEEE
− src/tests/vimtests/movement/bigWord/too_much_w.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,11)-aa bb cc dd--- Events-WWWWWWWWWWW
− src/tests/vimtests/movement/bigWord/w.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,4)-aa bb cc dd--- Events-W
− src/tests/vimtests/movement/bigWord/ww.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,7)-aa bb cc dd--- Events-WW
− src/tests/vimtests/movement/char/counted_hjkl.test 
@@ -1,16 +0,0 @@--- Input-(1,2)-aaaaaaaaaaaaaa-bbbbbbbbbbbbbb-cccccccccccccc-dddddddddddddd-eeeeeeeeeeeeee--- Output-(5,4)-aaaaaaaaaaaaaa-bbbbbbbbbbbbbb-cccccccccccccc-dddddddddddddd-eeeeeeeeeeeeee--- Events-h2j3l1k2lkk4j2h
− src/tests/vimtests/movement/char/esc_resets_count.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-abc-eee-cd-ddd--- Output-(3,1)-abc-eee-cd-ddd--- Events-3<Esc>2j
− src/tests/vimtests/movement/char/h.test 
@@ -1,8 +0,0 @@--- Input-(1,3)-bar--- Output-(1,2)-br--- Events-hx
− src/tests/vimtests/movement/char/h_1.test 
@@ -1,12 +0,0 @@--- Input-(2,3)-foo-bar-baz--- Output-(2,1)-foo-ar-baz--- Events-10l9hx
− src/tests/vimtests/movement/char/h_2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-0123456789012345--- Output-(1,4)-012456789012345--- Events-13l10hx
− src/tests/vimtests/movement/char/h_at_bol/events 
@@ -1,1 +0,0 @@-hhh
− src/tests/vimtests/movement/char/h_at_bol/input 
@@ -1,4 +0,0 @@-(2,1)-aaa-bbb-ccc
− src/tests/vimtests/movement/char/h_at_bol/output 
@@ -1,4 +0,0 @@-(2,1)-aaa-bbb-ccc
− src/tests/vimtests/movement/char/hjkl.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-ab-cd--- Output-(2,2)-ab-cd--- Events-jlllkjhl
− src/tests/vimtests/movement/char/hjkl1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-abc-eee-cd--- Output-(3,2)-abc-eee-cd--- Events-lljj
− src/tests/vimtests/movement/char/hjkl2.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-abc-eee-cd-ddd--- Output-(4,3)-abc-eee-cd-ddd--- Events-lljjj
− src/tests/vimtests/movement/char/hl/events 
@@ -1,1 +0,0 @@-lllhlhhl
− src/tests/vimtests/movement/char/hl/input 
@@ -1,4 +0,0 @@-(1,1)-aaaaaaaaa-bbbbbbbbb-ccccccccc
− src/tests/vimtests/movement/char/hl/output 
@@ -1,4 +0,0 @@-(1,3)-aaaaaaaaa-bbbbbbbbb-ccccccccc
− src/tests/vimtests/movement/char/j.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-bar-bar--- Output-(2,1)-bar-ar--- Events-jx
− src/tests/vimtests/movement/char/j/events 
@@ -1,1 +0,0 @@-j
− src/tests/vimtests/movement/char/j/input 
@@ -1,4 +0,0 @@-(1,1)-aaa-bbb-ccc
− src/tests/vimtests/movement/char/j/output 
@@ -1,4 +0,0 @@-(2,1)-aaa-bbb-ccc
− src/tests/vimtests/movement/char/j_1.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-bar-bar--- Output-(2,1)-bar-ar--- Events-10jx
− src/tests/vimtests/movement/char/j_2.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-bar-bara--- Output-(2,3)-bar-baa--- Events-llljx
− src/tests/vimtests/movement/char/j_3.test 
@@ -1,38 +0,0 @@--- Input-(1,1)-0-1-2-3-4-5-6-7-8-9-0-1-2-3-4-5--- Output-(14,1)-0-1-2-3-4-5-6-7-8-9-0-1-2--4-5--- Events-13jx
− src/tests/vimtests/movement/char/k.test 
@@ -1,38 +0,0 @@--- Input-(14,1)-0-1-2-3-4-5-6-7-8-9-0-1-2-3-4-5--- Output-(4,1)-0-1-2--4-5-6-7-8-9-0-1-2-3-4-5--- Events-10kx
− src/tests/vimtests/movement/char/l.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-abcdefghijk--- Output-(1,8)-abcdefghijk--- Events-2l.3l.2l.
− src/tests/vimtests/movement/char/l_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-bar--- Output-(1,2)-br--- Events-lx
− src/tests/vimtests/movement/char/l_2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-bar--- Output-(1,2)-ba--- Events-2lx
− src/tests/vimtests/movement/char/l_3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-0123456789012345--- Output-(1,14)-012345678901245--- Events-13lx
− src/tests/vimtests/movement/char/l_4.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-bar--- Output-(1,2)-ba--- Events-10lx
− src/tests/vimtests/movement/char/l_at_eol/events 
@@ -1,1 +0,0 @@-lllll
− src/tests/vimtests/movement/char/l_at_eol/input 
@@ -1,4 +0,0 @@-(1,1)-aaa-bbb-ccc
− src/tests/vimtests/movement/char/l_at_eol/output 
@@ -1,4 +0,0 @@-(1,3)-aaa-bbb-ccc
− src/tests/vimtests/movement/cursorkeys/down.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(3,2)-foo-bar-baz--- Events-<Down>
− src/tests/vimtests/movement/cursorkeys/left.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,1)-foo-bar-baz--- Events-<Left>
− src/tests/vimtests/movement/cursorkeys/right.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,3)-foo-bar-baz--- Events-<Right>
− src/tests/vimtests/movement/cursorkeys/up.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(1,2)-foo-bar-baz--- Events-<Up>
− src/tests/vimtests/movement/empty.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,1)---- Events-hjkl
− src/tests/vimtests/movement/empty_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,1)---- Events-ggG$0
− src/tests/vimtests/movement/eol_j.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi--qwe rty uiop--- Output-(4,12)-Lorem ipsum dolor sit amet-abc def ghi--qwe rty uiop--- Events-$jj
− src/tests/vimtests/movement/eol_j2.test 
@@ -1,14 +0,0 @@--- Input-(1,2)-Lorem ipsum dolor sit amet-abc def ghi--qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-abc def ghi--qwe rty uiop--- Events-$0j
− src/tests/vimtests/movement/file/G_no_count.test 
@@ -1,14 +0,0 @@--- Input-(1,4)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Output-(4,1)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Events-G
− src/tests/vimtests/movement/file/G_with_count_1.test 
@@ -1,14 +0,0 @@--- Input-(3,4)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Output-(1,1)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Events-1G
− src/tests/vimtests/movement/file/G_with_count_2.test 
@@ -1,14 +0,0 @@--- Input-(3,4)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Output-(2,1)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Events-2G
− src/tests/vimtests/movement/file/G_with_too_much_count.test 
@@ -1,14 +0,0 @@--- Input-(3,4)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Output-(4,1)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Events-1000G
− src/tests/vimtests/movement/file/H_no_count.test 
@@ -1,21 +0,0 @@---+ WindowSize 12 5--- Input-(4,3)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Output-(2,1)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Events-2H
− src/tests/vimtests/movement/file/H_with_count_2.test 
@@ -1,21 +0,0 @@---+ WindowSize 12 5--- Input-(4,3)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Output-(2,1)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Events-2H
− src/tests/vimtests/movement/file/L_no_count.test 
@@ -1,21 +0,0 @@---+ WindowSize 12 5--- Input-(2,3)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Output-(5,1)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Events-L
− src/tests/vimtests/movement/file/L_with_count_2.test 
@@ -1,21 +0,0 @@---+ WindowSize 12 5--- Input-(2,3)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Output-(4,1)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Events-2L
− src/tests/vimtests/movement/file/M.test 
@@ -1,21 +0,0 @@---+ WindowSize 12 5--- Input-(2,3)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Output-(3,1)-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd-aa bb cc dd--- Events-M
− src/tests/vimtests/movement/intraline/0.test 
@@ -1,14 +0,0 @@--- Input-(1,3)-abc-eee-cd-ddd--- Output-(1,1)-abc-eee-cd-ddd--- Events-0
− src/tests/vimtests/movement/intraline/00.test 
@@ -1,14 +0,0 @@--- Input-(2,2)-abc-eee-cd-ddd--- Output-(2,1)-abc-eee-cd-ddd--- Events-00
− src/tests/vimtests/movement/intraline/2dollar.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-abc-eeefoo-cd-ddd--- Output-(2,6)-abc-eeefoo-cd-ddd--- Events-2$
− src/tests/vimtests/movement/intraline/caret.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-abc def ghi-    qwe rty uiop--- Output-(2,5)-abc def ghi-    qwe rty uiop--- Events-$j^
− src/tests/vimtests/movement/intraline/dollar.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-abc-eee-cd-ddd--- Output-(1,3)-abc-eee-cd-ddd--- Events-$
− src/tests/vimtests/movement/intraline/dollardollar.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-abc-eee-cd-ddd--- Output-(1,3)-abc-eee-cd-ddd--- Events-$$
− src/tests/vimtests/movement/intraline/dollarj.test 
@@ -1,12 +0,0 @@--- Input-(3,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,26)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-$kk
− src/tests/vimtests/movement/intraline/end.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,3)-foo-bar-baz--- Events-<End>
− src/tests/vimtests/movement/intraline/home.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,1)-foo-bar-baz--- Events-<Home>
− src/tests/vimtests/movement/v_eol_j2.test 
@@ -1,14 +0,0 @@--- Input-(1,2)-Lorem ipsum dolor sit amet-abc def ghi--qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-abc def ghi--qwe rty uiop--- Events-v$0j
− src/tests/vimtests/movement/word/2e.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,5)-aa bb cc dd--- Events-2e
− src/tests/vimtests/movement/word/2w.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,7)-aa bb cc dd--- Events-2w
− src/tests/vimtests/movement/word/6b.test 
@@ -1,12 +0,0 @@--- Input-(3,3)-a b- ccc 111 22 3-d e--- Output-(1,3)-a b- ccc 111 22 3-d e--- Events-6b
− src/tests/vimtests/movement/word/b.test 
@@ -1,12 +0,0 @@--- Input-(3,3)-a b- ccc 111 22 3-d e--- Output-(3,1)-a b- ccc 111 22 3-d e--- Events-b
− src/tests/vimtests/movement/word/bbbb.test 
@@ -1,12 +0,0 @@--- Input-(3,3)-a b- ccc 111 22 3-d e--- Output-(2,6)-a b- ccc 111 22 3-d e--- Events-bbbb
− src/tests/vimtests/movement/word/e.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,2)-aa bb cc dd--- Events-e
− src/tests/vimtests/movement/word/ee.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,5)-aa bb cc dd--- Events-ee
− src/tests/vimtests/movement/word/punctuation.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-a-b+c"d foo--- Output-(1,5)-a-b+c"d foo--- Events-wwww
− src/tests/vimtests/movement/word/punctuation_b.test 
@@ -1,8 +0,0 @@--- Input-(1,11)-a-b+c"d foo--- Output-(1,5)-a-b+c"d foo--- Events-bbbb
− src/tests/vimtests/movement/word/punctuation_e.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-a-b+c"d foo--- Output-(1,5)-a-b+c"d foo--- Events-eeee
− src/tests/vimtests/movement/word/too_much_b.test 
@@ -1,12 +0,0 @@--- Input-(3,3)-a b- ccc 111 22 3-d e--- Output-(1,1)-a b- ccc 111 22 3-d e--- Events-bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb
− src/tests/vimtests/movement/word/too_much_e.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,11)-aa bb cc dd--- Events-eeeeeeeeeeeeeeeeeeee
− src/tests/vimtests/movement/word/too_much_w.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,11)-aa bb cc dd--- Events-wwwwwwwwwww
− src/tests/vimtests/movement/word/w.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,4)-aa bb cc dd--- Events-w
− src/tests/vimtests/movement/word/w_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-bar--- Output-(1,3)-bar--- Events-w
− src/tests/vimtests/movement/word/w_2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-quux(foo, bar, baz);--- Output-(1,15)-quuxfoo ar baz;--- Events-wxwxwxwx2wx
− src/tests/vimtests/movement/word/ww.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-aa bb cc dd--- Output-(1,7)-aa bb cc dd--- Events-ww
− src/tests/vimtests/numbers/cursor_on_digits.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Test increasing 109 to 110 when cursor is on 9.-Test increasing 109 to 110 when cursor is on 0.-Test increasing 109 to 110 when cursor is on 1.-Test increasing 109 to 110 when cursor is on space before 1.--- Output-(4,19)-Test increasing 110 to 110 when cursor is on 9.-Test increasing 110 to 110 when cursor is on 0.-Test increasing 110 to 110 when cursor is on 1.-Test increasing 110 to 110 when cursor is on space before 1.--- Events-3e<C-a>jh<C-a>j2h<C-a>j3h<C-a>
− src/tests/vimtests/numbers/decrement.test 
@@ -1,20 +0,0 @@--- Input-(1,1)-Test decreasing 101 to 99-Test decreasing 11 to 9-Test decreasing 9 to 1-Test decreasing 1 to 0-Test decreasing 0 to -1-Test decreasing -1 to -11-Test decreasing -99 to -101--- Output-(7,20)-Test decreasing 99 to 99-Test decreasing 9 to 9-Test decreasing 1 to 1-Test decreasing 0 to 0-Test decreasing -1 to -1-Test decreasing -11 to -11-Test decreasing -101 to -101--- Events-2<C-x>j2<C-x>j8<C-x>j<C-x>j<C-x>j10<C-x>j2<C-x>
− src/tests/vimtests/numbers/hex_decrease.test 
@@ -1,16 +0,0 @@--- Input-(1,1)-Test decreasing 0x1 to 0x0-Test decreasing 0xa to 0x9-Test decreasing 0x10 to 0xf-Test decreasing 0x20 to 0x1f-Test decreasing 0x100 to 0xff--- Output-(5,20)-Test decreasing 0x0 to 0x0-Test decreasing 0x9 to 0x9-Test decreasing 0xf to 0xf-Test decreasing 0x1f to 0x1f-Test decreasing 0xff to 0xff--- Events-<C-x>j<C-x>j<C-x>j<C-x>j<C-x>
− src/tests/vimtests/numbers/hex_increase.test 
@@ -1,16 +0,0 @@--- Input-(1,1)-Test increasing 0x1 to 0x2-Test increasing 0x9 to 0xa-Test increasing 0xf to 0x10-Test increasing 0x1f to 0x20-Test increasing 0xff to 0x100--- Output-(5,21)-Test increasing 0x2 to 0x2-Test increasing 0xa to 0xa-Test increasing 0x10 to 0x10-Test increasing 0x20 to 0x20-Test increasing 0x100 to 0x100--- Events-<C-a>j<C-a>j<C-a>j<C-a>j<C-a>
− src/tests/vimtests/numbers/increment.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Test increasing 0 to 11-Test increasing -11 to 11-Test increasing -101 to -99-Test increasing 99 to 101--- Output-(4,19)-Test increasing 11 to 11-Test increasing 11 to 11-Test increasing -99 to -99-Test increasing 101 to 101--- Events-11<C-a>j22<C-a>j2<C-a>jh2<C-a>
− src/tests/vimtests/numbers/no_numbers.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Test case if numbers are not present on the line.-This should not cause yi to freeze.-This should not cause the cursor to move.--- Output-(3,1)-Test case if numbers are not present on the line.-This should not cause yi to freeze.-This should not cause the cursor to move.--- Events-<C-a><C-x>j<C-a><C-x>$<C-a><C-x>^11<C-x>j
− src/tests/vimtests/numbers/oct_decrease.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Test decreasing 0o1 to 0o0-Test decreasing 0o10 to 0o7-Test decreasing 0o20 to 0o17-Test decreasing 0o100 to 0o77--- Output-(4,20)-Test decreasing 0o0 to 0o0-Test decreasing 0o7 to 0o7-Test decreasing 0o17 to 0o17-Test decreasing 0o77 to 0o77--- Events-<C-x>j<C-x>j<C-x>j<C-x>
− src/tests/vimtests/numbers/oct_hex_letters.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-Make sure aa bb cc dd ee ff 0x1 increments correctly.-Make sure oo 0o1 increments correctly.--- Output-(2,16)-Make sure aa bb cc dd ee ff 0x2 increments correctly.-Make sure oo 0o2 increments correctly.--- Events-<C-a>+<C-a>
− src/tests/vimtests/numbers/oct_increase.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Test increasing 0o1 to 0o2-Test increasing 0o7 to 0o10-Test increasing 0o17 to 0o20-Test increasing 0o77 to 0o100--- Output-(4,21)-Test increasing 0o2 to 0o2-Test increasing 0o10 to 0o10-Test increasing 0o20 to 0o20-Test increasing 0o100 to 0o100--- Events-<C-a>j<C-a>j<C-a>j<C-a>
− src/tests/vimtests/numbers/sol_eol.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-0x1-0o1-1--- Output-(3,1)-0x5-0o4-3--- Events-4<C-a>j3<C-a>j2<C-a>
− src/tests/vimtests/paste/2dd_capP.test 
@@ -1,14 +0,0 @@--- Input-(2,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop-foo--- Output-(2,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop-foo--- Events-2ddP
− src/tests/vimtests/paste/2dd_capP_1.test 
@@ -1,12 +0,0 @@--- Input-(2,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-abc def ghi-qwe rty uiop-Lorem ipsum dolor sit amet--- Events-2ddP
− src/tests/vimtests/paste/2ddp.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-qwe rty uiop-Lorem ipsum dolor sit amet-abc def ghi--- Events-2ddp
− src/tests/vimtests/paste/2ddp_1.test 
@@ -1,12 +0,0 @@--- Input-(3,3)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(3,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-2ddp
− src/tests/vimtests/paste/2yyp.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-abc def ghi-qwe rty uiop--- Events-2yyp
− src/tests/vimtests/paste/Yp.test 
@@ -1,12 +0,0 @@--- Input-(1,10)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,27)-Lorem ipsuum dolor sit ametm dolor sit amet-abc def ghi-qwe rty uiop--- Events-Yp
− src/tests/vimtests/paste/d2wp.test 
@@ -1,12 +0,0 @@--- Input-(1,9)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,19)-Lorem ipssum dolor it amet-abc def ghi-qwe rty uiop--- Events-d2wp
− src/tests/vimtests/paste/dbp.test 
@@ -1,12 +0,0 @@--- Input-(1,9)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,9)-Lorem sipum dolor sit amet-abc def ghi-qwe rty uiop--- Events-dbp
− src/tests/vimtests/paste/dd_capP.test 
@@ -1,12 +0,0 @@--- Input-(2,6)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-ddP
− src/tests/vimtests/paste/dd_capP_1.test 
@@ -1,12 +0,0 @@--- Input-(3,6)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-qwe rty uiop-abc def ghi--- Events-ddP
− src/tests/vimtests/paste/ddjp.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(3,1)-abc def ghi-qwe rty uiop-Lorem ipsum dolor sit amet--- Events-ddjp
− src/tests/vimtests/paste/ddkP.test 
@@ -1,12 +0,0 @@--- Input-(2,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-abc def ghi-Lorem ipsum dolor sit amet-qwe rty uiop--- Events-ddkP
− src/tests/vimtests/paste/ddp.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-abc def ghi-Lorem ipsum dolor sit amet-qwe rty uiop--- Events-ddp
− src/tests/vimtests/paste/ddp_1.test 
@@ -1,12 +0,0 @@--- Input-(3,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(3,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-ddp
− src/tests/vimtests/paste/dep.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,6)- Loremipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-dep
− src/tests/vimtests/paste/dw_capP.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,6)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-dwP
− src/tests/vimtests/paste/dwp.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,7)-iLorem psum dolor sit amet-abc def ghi-qwe rty uiop--- Events-dwp
− src/tests/vimtests/paste/p_at_newline.test 
@@ -1,18 +0,0 @@--- Input-(1,1)-abc-def--123-456 789-xxx--- Output-(3,3)-abc-def-789-123-456 -xxx--- Events-4j4ld$2kp
− src/tests/vimtests/paste/p_at_newline2.test 
@@ -1,18 +0,0 @@--- Input-(1,1)-abc-def--123-456 789-xxx--- Output-(3,3)-abc-def-789-123-456 -xxx--- Events-4j4ld$2kP
− src/tests/vimtests/paste/visual.test 
@@ -1,13 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,3)-Lorem ipsum dolor sit amet-abbc def ghi-qwec def ghi-qwe rty uiop--- Events-vjlyp
− src/tests/vimtests/paste/y_1.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-1234-abcd-xyzw--- Output-(2,4)-1234-abcdbcd-xyzw--- Events-y$P
− src/tests/vimtests/paste/y_2.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-1234-abcd-xyzw--- Output-(2,4)-1234-abcdbcd-xyzw--- Events-y3lP
− src/tests/vimtests/paste/y_3.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-1234-abcd-xyzw--- Output-(2,4)-1234-abcdbcd-xyzw--- Events-y20lP
− src/tests/vimtests/paste/yep.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,6)-LLoremorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-yep
− src/tests/vimtests/paste/yjp.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-abc def ghi-qwe rty uiop--- Events-yjp
− src/tests/vimtests/paste/ywp.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,7)-LLorem orem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-ywp
− src/tests/vimtests/paste/yy_capP.test 
@@ -1,13 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-yyP
− src/tests/vimtests/paste/yyp.test 
@@ -1,13 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-yyp
− src/tests/vimtests/repeat/2r.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-abcdef--- Output-(1,6)-xxcdxx--- Events-2rx3l.
− src/tests/vimtests/repeat/O1.test 
@@ -1,17 +0,0 @@--- Input-(2,1)-123-456-789--- Output-(7,3)-123-456-abc-abc-abc-abc-abc-789--- Events-2oabc<Esc>3.
− src/tests/vimtests/repeat/a.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,10)-fABCABCABCoo--- Events-aABC<Esc>..
− src/tests/vimtests/repeat/a2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,10)-fABCABCABCoo--- Events-aABC<Esc>2.
− src/tests/vimtests/repeat/a3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,28)-fABCABCABCABCABCABCABCABCABCoo--- Events-3aABC<Esc>..
− src/tests/vimtests/repeat/a4.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,16)-fABCABCABCABCABCoo--- Events-3aABC<Esc>2.
− src/tests/vimtests/repeat/a5.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,28)-fABCABCABCABCABCABCABCABCABCoo--- Events-3aABC<Esc>y<Esc>.d<Esc>.
− src/tests/vimtests/repeat/capA.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,12)-fooABCABCABC--- Events-AABC<Esc>..
− src/tests/vimtests/repeat/capA2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,12)-fooABCABCABC--- Events-AABC<Esc>2.
− src/tests/vimtests/repeat/capA3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,30)-fooABCABCABCABCABCABCABCABCABC--- Events-3AABC<Esc>..
− src/tests/vimtests/repeat/capA4.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,18)-fooABCABCABCABCABC--- Events-3AABC<Esc>2.
− src/tests/vimtests/repeat/capI.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,3)-ABCABCABCfoo--- Events-IABC<Esc>..
− src/tests/vimtests/repeat/capI2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,6)-ABCABCABCfoo--- Events-IABC<Esc>2.
− src/tests/vimtests/repeat/capI3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,6)-ABCABCABCABCABCfoo--- Events-3IABC<Esc>2.
− src/tests/vimtests/repeat/capI4.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,9)-ABCABCABCABCABCABCABCABCABCfoo--- Events-3IABC<Esc>..
− src/tests/vimtests/repeat/capO.test 
@@ -1,18 +0,0 @@--- Input-(2,1)-123-456-789--- Output-(5,3)-123-abc-abc-abc-abc-abc-abc-456-789--- Events-2Oabc<Esc>..
− src/tests/vimtests/repeat/capO2.test 
@@ -1,15 +0,0 @@--- Input-(2,1)-123-456-789--- Output-(3,3)-123-abc-abc-abc-456-789--- Events-Oabc<Esc>2.
− src/tests/vimtests/repeat/capO3.test 
@@ -1,15 +0,0 @@--- Input-(2,1)-123-456-789--- Output-(2,3)-123-abc-abc-abc-456-789--- Events-Oabc<Esc>..
− src/tests/vimtests/repeat/capX.test 
@@ -1,12 +0,0 @@--- Input-(2,5)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,2)-Lorem ipsum dolor sit amet-adef ghi-qwe rty uiop--- Events-X..
− src/tests/vimtests/repeat/capX_1.test 
@@ -1,12 +0,0 @@--- Input-(2,8)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,2)-Lorem ipsum dolor sit amet-a ghi-qwe rty uiop--- Events-2X..
− src/tests/vimtests/repeat/counted_2r.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-abcdefg--- Output-(1,7)-xxxdexx--- Events-3rx3l2.
− src/tests/vimtests/repeat/dw_capP.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,16)-LoremLoremLorem   ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-dwP..
− src/tests/vimtests/repeat/dwp.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,19)-iLorem Lorem Lorem psum dolor sit amet-abc def ghi-qwe rty uiop--- Events-dwp..
− src/tests/vimtests/repeat/i.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,7)-ABABABCCCfoo--- Events-iABC<Esc>..
− src/tests/vimtests/repeat/i2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,8)-ABABCABCCfoo--- Events-iABC<Esc>2.
− src/tests/vimtests/repeat/i3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,14)-ABCABCABABCABCCfoo--- Events-3iABC<Esc>2.
− src/tests/vimtests/repeat/i4.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,25)-ABCABCABABCABCABABCABCABCCCfoo--- Events-3iABC<Esc>..
− src/tests/vimtests/repeat/o.test 
@@ -1,18 +0,0 @@--- Input-(2,1)-123-456-789--- Output-(8,3)-123-456-abc-abc-abc-abc-abc-abc-789--- Events-2oabc<Esc>..
− src/tests/vimtests/repeat/o1.test 
@@ -1,17 +0,0 @@--- Input-(2,1)-123-456-789--- Output-(7,3)-123-456-abc-abc-abc-abc-abc-789--- Events-2oabc<Esc>3.
− src/tests/vimtests/repeat/o2.test 
@@ -1,15 +0,0 @@--- Input-(2,1)-123-456-789--- Output-(5,3)-123-456-abc-abc-abc-789--- Events-oabc<Esc>2.
− src/tests/vimtests/repeat/o3.test 
@@ -1,15 +0,0 @@--- Input-(2,1)-123-456-789--- Output-(5,3)-123-456-abc-abc-abc-789--- Events-oabc<Esc>..
− src/tests/vimtests/repeat/r.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-abcdef--- Output-(1,5)-xbxdxf--- Events-rx2l.2l.
− src/tests/vimtests/repeat/r_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-abcdef--- Output-(1,3)-xbxdef--- Events-rx2l.
− src/tests/vimtests/repeat/r_2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-abcdefghijk--- Output-(1,8)-xbxdexgxijk--- Events-rx2l.3l.2l.
− src/tests/vimtests/repeat/r_3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-abcdefghijk--- Output-(1,6)-xbxdefghijk--- Events-rx2l.3l
− src/tests/vimtests/repeat/tilde_repeat.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-lOREM IPSUM dolor sit amet-abc def ghi-qwe rty uiop--- Events-6~.
− src/tests/vimtests/repeat/tilde_repeat_does_not_affect_other_lines.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-abcdefghijklmnopqrstuvwxyz-abc def ghi-qwe rty uiop--- Output-(1,26)-ABCDEFGHIJKLMNOPQRSTUVWXYz-abc def ghi-qwe rty uiop--- Events-13~..
− src/tests/vimtests/repeat/x.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,2)-Lorem ipsum dolor sit amet-adef ghi-qwe rty uiop--- Events-x..
− src/tests/vimtests/repeat/x_1.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,2)-Lorem ipsum dolor sit amet-a ghi-qwe rty uiop--- Events-2x..
− src/tests/vimtests/repeat/x_2.test 
@@ -1,12 +0,0 @@--- Input-(1,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,6)-Lemps dolor sit amet-abc def ghi-qwe rty uiop--- Events-2x2l.2l.
− src/tests/vimtests/replace/0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobarbaz--- Output-(1,6)-fooiarbaz--- Events-3lrill
− src/tests/vimtests/replace/1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobarbaz--- Output-(1,7)-foo123baz--- Events-3lR123<Esc>l
− src/tests/vimtests/replace/10.test 
@@ -1,12 +0,0 @@--- Input-(3,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(3,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-r<C-e>
− src/tests/vimtests/replace/11.test 
@@ -1,12 +0,0 @@--- Input-(2,1)-Lorem ipsum dolor sit amet--qwe rty uiop--- Output-(2,1)-Lorem ipsum dolor sit amet--qwe rty uiop--- Events-rx
− src/tests/vimtests/replace/2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobarbaz--- Output-(1,6)-fooxxxbaz--- Events-3l3rx
− src/tests/vimtests/replace/3.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,3)-foo-bxx-baz--- Events-5rx
− src/tests/vimtests/replace/4.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,2)-Lorem ipsum dolor sit amet-awc def ghi-qwe rty uiop--- Events-r<C-e>
− src/tests/vimtests/replace/5.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,2)-Lorem ipsum dolor sit amet-aoc def ghi-qwe rty uiop--- Events-r<C-y>
− src/tests/vimtests/replace/6.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,5)-Lorem ipsum dolor sit amet-awe ref ghi-qwe rty uiop--- Events-4r<C-e>
− src/tests/vimtests/replace/7.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,6)-Lorem ipsum dolor sit amet-aorem f ghi-qwe rty uiop--- Events-5r<C-y>
− src/tests/vimtests/replace/8.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobarbaz--- Output-(1,12)-foo123456789--- Events-3lR123456789<Esc>
− src/tests/vimtests/replace/9.test 
@@ -1,12 +0,0 @@--- Input-(1,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-r<C-y>
− src/tests/vimtests/search/1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-Lorem ipsum olor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>x
− src/tests/vimtests/search/2.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,13)-Lorem ipsum dolor sit amet-Lorem ipsum olor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>nx
− src/tests/vimtests/search/3.test 
@@ -1,16 +0,0 @@--- Input-(2,16)-Lorem ipsum dolor sit amet- ipsum dolor sit amet- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,8)-Lorem ipsum dolor sit amet- ipsum dolor sit amet- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-?dolor<CR>
− src/tests/vimtests/search/4.test 
@@ -1,16 +0,0 @@--- Input-(2,16)-Lorem ipsum dolor sit amet- ipsum dolor sit amet- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-Lorem ipsum dolor sit amet- ipsum dolor sit amet- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-?dolor<CR>n
− src/tests/vimtests/search/5.test 
@@ -1,16 +0,0 @@--- Input-(2,16)-Lorem ipsum dolor sit amet- ipsum dolor sit amet- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,8)-Lorem ipsum dolor sit amet- ipsum dolor sit amet- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-?dolor<CR>nN
− src/tests/vimtests/search/6.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-Lorem ipsum olor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>nNx
− src/tests/vimtests/search/7.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-Lorem ipsum olor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>nnx
− src/tests/vimtests/search/8.test 
@@ -1,16 +0,0 @@--- Input-(2,16)-Lorem ipsum dolor sit amet- ipsum dolor sit amet- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,8)-Lorem ipsum dolor sit amet- ipsum dolor sit amet- ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-?dolor<CR>nnn
− src/tests/vimtests/search/9.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-Foo--- Output-(1,1)-oo--- Events-/<CR>x
− src/tests/vimtests/search/counted_1.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,13)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-2/dolor<CR>
− src/tests/vimtests/search/counted_2.test 
@@ -1,14 +0,0 @@--- Input-(3,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-2?dolor<CR>
− src/tests/vimtests/search/counted_3.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-1/dolor<CR>
− src/tests/vimtests/search/counted_capN_1.test 
@@ -1,18 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(3,13)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>2N
− src/tests/vimtests/search/counted_capN_2.test 
@@ -1,16 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,13)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-?dolor<CR>2N
− src/tests/vimtests/search/counted_n_1.test 
@@ -1,16 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(3,13)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>2n
− src/tests/vimtests/search/counted_n_2.test 
@@ -1,18 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(4,13)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>2nn
− src/tests/vimtests/search/counted_n_3.test 
@@ -1,18 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(4,13)-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>n2n
− src/tests/vimtests/search/history1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-Lorem ipsum olor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>/amet<CR>gg/<C-p><C-p><CR>x
− src/tests/vimtests/search/history2.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,13)-Lorem ipsum olor sit amet-abc def ghi-qwe rty uiop--- Events-/dolor<CR>/amet<CR>gg/<C-p><Up><CR>x
− src/tests/vimtests/search/history3.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,23)-Lorem ipsum dolor sit met-abc def ghi-qwe rty uiop--- Events-/dolor<CR>/amet<CR>gg/<C-p><Up><Down><CR>x
− src/tests/vimtests/search/history4.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,23)-Lorem ipsum dolor sit met-abc def ghi-qwe rty uiop--- Events-/dolor<CR>/amet<CR>gg/<C-p><Up><C-n><CR>x
− src/tests/vimtests/searchword/g_pound.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(3,7)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-g#
− src/tests/vimtests/searchword/g_repeat_pound.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(1,13)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-g#nnn
− src/tests/vimtests/searchword/g_repeat_pound_1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(3,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-g#n
− src/tests/vimtests/searchword/g_repeat_star.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(3,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-g*nn
− src/tests/vimtests/searchword/g_star.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(1,13)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-g*
− src/tests/vimtests/searchword/pound.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(3,7)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-#
− src/tests/vimtests/searchword/repeat_pound.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(2,16)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-#nn
− src/tests/vimtests/searchword/repeat_star.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(3,7)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-*nn
− src/tests/vimtests/searchword/star.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(2,16)-lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-*
− src/tests/vimtests/searchword/star_2.test 
@@ -1,12 +0,0 @@--- Input-(1,2)-(lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Output-(2,16)-(lorem ipsum lorem2 dolor sit amet-dolor sit amet lorem ipsum-lorem-lorem ipsumipsum--- Events-*
− src/tests/vimtests/switchcase/g_capU.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-LOREM IPSUM dolor sit amet-abc def ghi-qwe rty uiop--- Events-gU2w
− src/tests/vimtests/switchcase/gtilde.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-LOREM IPSUM dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-g~2w
− src/tests/vimtests/switchcase/gtilde_1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-lOREM IPSUM dolor sit amet-abc def ghi-qwe rty uiop--- Events-g~2w
− src/tests/vimtests/switchcase/gu.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-LOREM IPSUM dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-gu2w
− src/tests/vimtests/switchcase/tilde_does_not_cross_lines.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-abcdefghijklmnopqrstuvwxyz-abc def ghi-qwe rty uiop--- Output-(1,26)-ABCDEFGHIJKLMNOPQRSTUVWXYZ-abc def ghi-qwe rty uiop--- Events-30~
− src/tests/vimtests/switchcase/tilde_left_over_count_at_eol_is_ignored.test 
@@ -1,18 +0,0 @@--- Input-(2,1)-12345678901234567890-If tilde is given a-count which is greater than the line length-the case of the final character is switched exactly once.-We have 18 characters in the first line, a count of 19-should switch the final 'a' to 'A', not to 'A' and then back to 'a'.--- Output-(2,19)-12345678901234567890-iF TILDE IS GIVEN A-count which is greater than the line length-the case of the final character is switched exactly once.-We have 18 characters in the first line, a count of 19-should switch the final 'a' to 'A', not to 'A' and then back to 'a'.--- Events-20~
− src/tests/vimtests/switchcase/tilde_near_eol.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,26)-Lorem ipsum dolor sit ameT-abc def ghi-qwe rty uiop--- Events-$~
− src/tests/vimtests/switchcase/tilde_no_count.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,2)-lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-~
− src/tests/vimtests/switchcase/tilde_with_count.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,11)-lOREM IPSUm dolor sit amet-abc def ghi-qwe rty uiop--- Events-10~
− src/tests/vimtests/undo/1.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,3)-foo-bar-baz--- Events-A 123<Esc>u
− src/tests/vimtests/undo/2.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,7)-foo-bar 123-baz--- Events-A 123<Esc>u<C-r>
− src/tests/vimtests/undo/3.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,2)-foo-bar-baz--- Events-xu
− src/tests/vimtests/undo/4.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,2)-foo-br-baz--- Events-jlxu<C-r>
− src/tests/vimtests/undo/5.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,7)-foo-bar 123-baz--- Events-jlA 123<Esc>A 456<Esc>u
− src/tests/vimtests/undo/6.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,3)-foo-bar-baz--- Events-jlA 123<Esc>A 456<Esc>uu
− src/tests/vimtests/undo/7.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,7)-foo-bar 123-baz--- Events-jlA 123<Esc>A 456<Esc>uu<C-r>
− src/tests/vimtests/undo/8.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,11)-foo-bar 123 456-baz--- Events-jlA 123<Esc>A 456<Esc>uu<C-r><C-r>
− src/tests/vimtests/undo/9.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,3)-foo-bar-baz--- Events-jlA 123<Esc>A 456<Esc>uu<C-r>u
− src/tests/vimtests/unicode/chinese-simp.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,4)-中文测试--- Events-i中文测试<Esc>
− src/tests/vimtests/unicode/chinese-trad.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,4)-中文測試--- Events-i中文測試<Esc>
− src/tests/vimtests/unicode/russian.test 
@@ -1,8 +0,0 @@--- Input-(1,1)---- Output-(1,16)-Спасибопожалусто--- Events-iСпасибопожалусто<Esc>
− src/tests/vimtests/unsorted/2yy.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,1)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Events-2yy
− src/tests/vimtests/unsorted/v3lcABC.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-Lorem ipsum--- Output-(1,8)-ABCm ABCm--- Events-v3lcABC<Esc>w.
− src/tests/vimtests/visual/1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-12345678--- Output-(1,2)-1345678--- Events-lv3lyx
− src/tests/vimtests/visual/10.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-12345678--- Output-(1,5)-1234678--- Events-lv3l<Esc>x
− src/tests/vimtests/visual/11.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-12345678--- Output-(1,5)-1234678--- Events-lv3l<C-c>x
− src/tests/vimtests/visual/12.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-12345678--- Output-(1,5)-1234678--- Events-lv3l<C-c>xv3ly
− src/tests/vimtests/visual/13.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-12345678--- Output-(1,1)-2345678--- Events-y<Esc>v3lyx
− src/tests/vimtests/visual/14.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-ab1-cd2--- Output-(1,1)-b1-cd2--- Events-jVlkgux
− src/tests/vimtests/visual/15.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobarbaz--- Output-(1,2)-fbaz--- Events-lvlkkjl2ld
− src/tests/vimtests/visual/2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-12345678--- Output-(1,4)-1235678--- Events-$hv3hyx
− src/tests/vimtests/visual/3.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-aaa-bbb--- Output-(1,2)-aA-BBb--- Events-lvj~x
− src/tests/vimtests/visual/4.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-123-456--- Output-(1,2)-13-456--- Events-jlvkyx
− src/tests/vimtests/visual/6.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-12-34--- Output-(1,1)-2-34--- Events-lVjyx
− src/tests/vimtests/visual/7.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-ab-cd--- Output-(1,1)-b-cd--- Events-jVlkgux
− src/tests/vimtests/visual/A_0.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-averyverylongline-shortline-shorter---- Output-(1,18)-averyverylonglineb-shortlineb-shorterb---- Events-jjVkkAb<Esc>
− src/tests/vimtests/visual/A_1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-averyverylongline-shortline---- Output-(1,18)-averyverylonglineb-shortlineb---- Events-VjAb<Esc>
− src/tests/vimtests/visual/A_2.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-averyverylongline-shortline---- Output-(1,6)-averybverylongline-shortbline---- Events-<C-v>j4lAb<Esc>
− src/tests/vimtests/visual/I_0.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-abc-def--- Output-(1,3)-123abc-123def--- Events-VjI123<Esc>
− src/tests/vimtests/visual/I_1.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-abc-def--- Output-(1,3)-123abc-123def--- Events-<C-v>jI123<Esc>
− src/tests/vimtests/visual/Vd.test 
@@ -1,9 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,1)-bar--- Events-Vd
− src/tests/vimtests/visual/capD_0.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,1)-baz--- Events-lvjlD
− src/tests/vimtests/visual/capD_1.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,1)-baz--- Events-lVjlD
− src/tests/vimtests/visual/capD_2.test 
@@ -1,9 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,1)-bar--- Events-VjkD
− src/tests/vimtests/visual/capU_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo bar--- Output-(1,1)-FOO Bar--- Events-vwgU
− src/tests/vimtests/visual/capU_1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,1)-FOO-BAR-BAZ--- Events-VjjU
− src/tests/vimtests/visual/capY_0.test 
@@ -1,13 +0,0 @@--- Input-(1,1)-foo-foo-bar--- Output-(2,1)-foo-foo-foo-bar--- Events-VYp
− src/tests/vimtests/visual/d_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobarbaz--- Output-(1,2)-fbaz--- Events-lvlkkjl2ld
− src/tests/vimtests/visual/d_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobar--- Output-(1,1)---- Events-v$d
− src/tests/vimtests/visual/d_2.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,1)-foo-baz--- Events-jVlld
− src/tests/vimtests/visual/gq_0.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,1)-foo-bar-baz--- Events-Vgq
− src/tests/vimtests/visual/gq_1.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,1)-foo bar-baz--- Events-Vjgq
− src/tests/vimtests/visual/indent_0.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,5)-    foo-    bar--- Events-vj>
− src/tests/vimtests/visual/indent_1.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(2,5)-foo-    bar-    baz--- Events-jVj>
− src/tests/vimtests/visual/indent_10.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-    foo-    bar-    baz-    xyzzy--- Output-(1,1)-foo-bar-baz-    xyzzy--- Events-V2j<lt>
− src/tests/vimtests/visual/indent_2.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foo--- Output-(1,13)-            foo--- Events-vl3>
− src/tests/vimtests/visual/indent_3.test 
@@ -1,8 +0,0 @@--- Input-(1,1)- foo--- Output-(1,1)-foo--- Events-vl<lt>
− src/tests/vimtests/visual/indent_4.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,5)-    foo-bar-baz--- Events-V>
− src/tests/vimtests/visual/indent_5.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,5)-    foo-    bar-baz--- Events-Vj>
− src/tests/vimtests/visual/indent_6.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,5)-    foo-    bar-    baz--- Events-V2j>
− src/tests/vimtests/visual/indent_7.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,21)-                    foo-bar-baz--- Events-V5>
− src/tests/vimtests/visual/indent_8.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-  foo-bar-baz--- Output-(1,1)-foo-bar-baz--- Events-V<lt>
− src/tests/vimtests/visual/indent_9.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar-baz--- Output-(1,1)-foo-bar-baz--- Events-V>V<lt>
− src/tests/vimtests/visual/m_0.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(2,2)-foo-br--- Events-vljmavgg`ax
− src/tests/vimtests/visual/m_1.test 
@@ -1,14 +0,0 @@--- Input-(1,1)-1-2-3-4--- Output-(2,1)-1-2-3-4--- Events-Vjmajjmb<Esc>'a
− src/tests/vimtests/visual/o_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobar--- Output-(1,4)-fooar--- Events-lv2lo2ld
− src/tests/vimtests/visual/r_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobar--- Output-(1,1)-aaaaaa--- Events-Vra
− src/tests/vimtests/visual/r_1.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,3)-fox-xxr--- Events-jlvklrx
− src/tests/vimtests/visual/r_2.test 
@@ -1,12 +0,0 @@--- Input-(1,7)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(1,7)-Lorem XXXXXXXXXXXXXXXXXXXX-XXXXXXX ghi-qwe rty uiop--- Events-vj^eerX
− src/tests/vimtests/visual/switchcase_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobar--- Output-(1,2)-fOOBar--- Events-lv2l~
− src/tests/vimtests/visual/switchcase_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-FooBar--- Output-(1,1)-fOObAR--- Events-V~
− src/tests/vimtests/visual/u_0.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-TEST--- Output-(1,1)-test--- Events-Vgu
− src/tests/vimtests/visual/u_1.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-TeSt--- Output-(1,1)-teSt--- Events-vlgu
− src/tests/vimtests/visual/vlllx.test 
@@ -1,8 +0,0 @@--- Input-(1,1)-foobar--- Output-(1,1)-ar--- Events-vlllx
− src/tests/vimtests/visual/vx.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-Lorem ipsum dolor sit amet-abc def ghi-qwe rty uiop--- Output-(2,2)-Lorem ipsum dolor sit amet-ac def ghi-qwe rty uiop--- Events-vx
− src/tests/vimtests/visual/y_0.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foobar--- Output-(3,1)-foobar-foobar-foobar--- Events-Vypp
− src/tests/vimtests/visual/y_1.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,3)-fooo-baro-bar--- Events-lvjlyp
− src/tests/vimtests/visual/y_2.test 
@@ -1,10 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(2,1)-foo-bar--- Events-Vjlllypddxxxdd
− src/tests/vimtests/visual/y_3.test 
@@ -1,12 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(2,1)-foo-foo-bar-bar--- Events-Vjlllyp
− src/tests/vimtests/visual/y_5.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,3)-foo-bar-bar--- Events-llvjypx
− src/tests/vimtests/visual/y_6.test 
@@ -1,11 +0,0 @@--- Input-(1,1)-foo-bar--- Output-(1,4)-fooo-bar-bar--- Events-llvjyp
− src/tests/vimtests/yank/yy.test 
@@ -1,12 +0,0 @@--- Input-(2,2)-foo-bar-baz--- Output-(2,2)-foo-bar-baz--- Events-yy
+ yi.1 view
@@ -0,0 +1,69 @@+.TH YI 1 2008-10-22 "yi version 0.1" "User Manual"++.SH NAME+yi \- text editor extensible in Haskell++.SH SYNOPSIS+.B yi+[\fIOPTION\fR] [\fIFILENAME\fR]++.SH DESCRIPTION+.ds c \fIYi\fP+\*c is a text editor written and extensible in Haskell. Consult the html+documentation for a full description of its behaviour.+.PP+.TP+.B \-\-selfcheck+Run self-checks+.TP+.B \-f frontend \-\-frontend=frontend+Select frontend (one of vty, gtk, pango, cocoa).+.TP+.B \-y config \-\-config\-file=config+Specify a configuration file.+.TP+.B \-V \-\-version+Show version information+.TP+.B \-h \-\-help+Show help message.+.TP+.B \-\-debug+Write debug information in a log file.+.TP+.B \-l num \-\-line=num+Start on given line number+.TP+.B \-\-as=editor+Start with key bindings of given editor.+.TP+.B \-\-recompile\-force+Force recompile of custom Yi before starting.+.TP+.B \-\-resume+Resume execution of Yi from previous state.+.TP+.B \-\-recompile+Recompile custom Yi if required then exit.++.SH FILES+It can be configured in ~/.config/yi/yi.hs; consult the html+documentation.++.SH BUGS+Bug reports should be posted to the Google issue tracker+<http://code.google.com/p/yi-editor/issues/>. Other suggestions or ideas may+be posted to the yi-devel <yi-devel@googlegroups.com> mailing list.+.SH COPYRIGHT+Copyright \(co 2004-2005 Don Stewart,+except for components derived from Riot <http://iki.fi/tuomov/riot/>,+Copyright \(co Tuomo Valkonen.+.PP+Yi is released under the terms of the GPL.+.SH "SEE ALSO"+.BR vi (1)++.SH AUTHOR++Yi is developed by a team of many developers, currently lead by Jean-Philippe+Bernardy.
yi.cabal view
@@ -1,394 +1,72 @@ name:           yi-version:        0.10.1-category:       Development, Editor-synopsis:       The Haskell-Scriptable Editor-description:-  Yi is a text editor written in Haskell and extensible in Haskell. The goal of the Yi project is-  to provide a flexible, powerful, and correct editor for haskell hacking.-license:        GPL-2-license-file:   LICENSE-author:         AUTHORS-maintainer:     yi-devel@googlegroups.com-homepage:       http://haskell.org/haskellwiki/Yi+version:        0.19.3+synopsis:       Yi editor+category:       Yi+homepage:       https://github.com/yi-editor/yi#readme bug-reports:    https://github.com/yi-editor/yi/issues-Cabal-Version:  >= 1.10-tested-with:    GHC==7.8.3+maintainer:     Yi developers <yi-devel@googlegroups.com>+license:        GPL-2 build-type:     Simple+cabal-version:  >= 1.10 data-files:-  art/*.png-  art/*.pdf-  example-configs/*.hs-+  art/*.xpm+  art/*.svg extra-source-files:-  src/tests/vimtests/find/*.test-  src/tests/vimtests/repeat/*.test-  src/tests/vimtests/ex/*.test-  src/tests/vimtests/ex/s/*.test-  src/tests/vimtests/ex/d/*.test-  src/tests/vimtests/ex/gotoline/*.test-  src/tests/vimtests/ex/g/*.test-  src/tests/vimtests/jumplist/*.test-  src/tests/vimtests/README.rst-  src/tests/vimtests/undo/*.test-  src/tests/vimtests/searchword/*.test-  src/tests/vimtests/blockvisual/*.test-  src/tests/vimtests/delete/*.test-  src/tests/vimtests/paste/*.test-  src/tests/vimtests/insertion/*.test-  src/tests/vimtests/insertion/cursorkeys/*.test-  src/tests/vimtests/search/*.test-  src/tests/vimtests/visual/*.test-  src/tests/vimtests/indent/*.test-  src/tests/vimtests/unicode/*.test-  src/tests/vimtests/joinlines/*.test-  src/tests/vimtests/replace/*.test-  src/tests/vimtests/change/*.test-  src/tests/vimtests/digraphs/*.test-  src/tests/vimtests/unsorted/*.test-  src/tests/vimtests/marks/*.test-  src/tests/vimtests/numbers/*.test-  src/tests/vimtests/yank/*.test-  src/tests/vimtests/switchcase/*.test-  src/tests/vimtests/empty/*.test-  src/tests/vimtests/empty/emptytest/input-  src/tests/vimtests/empty/emptytest/output-  src/tests/vimtests/empty/emptytest/events-  src/tests/vimtests/macros/*.test-  src/tests/vimtests/movement/*.test-  src/tests/vimtests/movement/word/*.test-  src/tests/vimtests/movement/bigWord/*.test-  src/tests/vimtests/movement/char/*.test-  src/tests/vimtests/movement/char/l_at_eol/input-  src/tests/vimtests/movement/char/l_at_eol/output-  src/tests/vimtests/movement/char/l_at_eol/events-  src/tests/vimtests/movement/char/j/input-  src/tests/vimtests/movement/char/j/output-  src/tests/vimtests/movement/char/j/events-  src/tests/vimtests/movement/char/h_at_bol/input-  src/tests/vimtests/movement/char/h_at_bol/output-  src/tests/vimtests/movement/char/h_at_bol/events-  src/tests/vimtests/movement/char/hl/input-  src/tests/vimtests/movement/char/hl/output-  src/tests/vimtests/movement/char/hl/events-  src/tests/vimtests/movement/cursorkeys/*.test-  src/tests/vimtests/movement/file/*.test-  src/tests/vimtests/movement/intraline/*.test+  yi.1  source-repository head-  type:     git-  location: https://github.com/yi-editor/yi.git---- Frontends-flag pango-  Default: False-  Description: Build with Pango frontend--flag vty-  Default: True-  Description: Build with Vty frontend--flag profiling-  Default: False-  Description:-    Runtime binary will be compiled with profiling and RTS-    options enabled.--flag eventlog-  Default: False-  Description:-    Runtime binary will be compiled with eventlog and RTS-    options enabled.--flag testing-  Description: bake-in the self-checks+  type: git+  location: https://github.com/yi-editor/yi -library-  hs-source-dirs: src/library-  default-language: Haskell2010+flag emacs+  description: Include the emacs keymap+  manual: True+  default: True -  if flag(profiling)-    CPP-options: -DPROFILING+flag pango+  description: Include the pango (GUI) frontend+  manual: True+  default: False -  if flag(eventlog)-    CPP-options: -DEVENTLOG+flag vim+  description: Include the vim keymap+  manual: True+  default: True -  exposed-modules:-    Yi-    Yi.Boot-    Yi.Boot.Internal-    Yi.Buffer-    Yi.Buffer.Adjusted-    Yi.Buffer.HighLevel-    Yi.Buffer.Indent-    Yi.Buffer.Normal-    Yi.Buffer.Misc-    Yi.Buffer.Region-    Yi.Buffer.TextUnit-    Yi.Buffer.Undo-    Yi.Command-    Yi.Completion-    Yi.Config-    Yi.Config.Default-    Yi.Config.Misc-    Yi.Config.Lens-    Yi.Config.Simple-    Yi.Config.Simple.Types-    Yi.Core-    Yi.Debug-    Yi.Dired-    Yi.Editor-    Yi.Eval-    Yi.Event-    Yi.File-    Yi.History-    Yi.Hoogle-    Yi.Hooks-    Yi.IReader-    Yi.IncrementalParse-    Yi.Interact-    Yi.JumpList-    Yi.Keymap-    Yi.Keymap.Completion-    Yi.Keymap.Cua-    Yi.Keymap.Emacs-    Yi.Keymap.Emacs.KillRing-    Yi.Keymap.Emacs.Utils-    Yi.Keymap.Keys-    Yi.Keymap.Vim-    Yi.Keymap.Vim.Common-    Yi.Keymap.Vim.Digraph-    Yi.Keymap.Vim.Eval-    Yi.Keymap.Vim.EventUtils-    Yi.Keymap.Vim.Ex-    Yi.Keymap.Vim.Ex.Commands.Common-    Yi.Keymap.Vim.Ex.Commands.Buffer-    Yi.Keymap.Vim.Ex.Commands.Buffers-    Yi.Keymap.Vim.Ex.Commands.BufferDelete-    Yi.Keymap.Vim.Ex.Commands.Cabal-    Yi.Keymap.Vim.Ex.Commands.Delete-    Yi.Keymap.Vim.Ex.Commands.Edit-    Yi.Keymap.Vim.Ex.Commands.Global-    Yi.Keymap.Vim.Ex.Commands.GotoLine-    Yi.Keymap.Vim.Ex.Commands.Nohl-    Yi.Keymap.Vim.Ex.Commands.Paste-    Yi.Keymap.Vim.Ex.Commands.Quit-    Yi.Keymap.Vim.Ex.Commands.Reload-    Yi.Keymap.Vim.Ex.Commands.Substitute-    Yi.Keymap.Vim.Ex.Commands.Tag-    Yi.Keymap.Vim.Ex.Commands.Write-    Yi.Keymap.Vim.Ex.Commands.Yi-    Yi.Keymap.Vim.Ex.Types-    Yi.Keymap.Vim.Ex.Eval-    Yi.Keymap.Vim.ExMap-    Yi.Keymap.Vim.InsertMap-    Yi.Keymap.Vim.MatchResult-    Yi.Keymap.Vim.Motion-    Yi.Keymap.Vim.NormalMap-    Yi.Keymap.Vim.NormalOperatorPendingMap-    Yi.Keymap.Vim.Operator-    Yi.Keymap.Vim.ReplaceMap-    Yi.Keymap.Vim.ReplaceSingleCharMap-    Yi.Keymap.Vim.Search-    Yi.Keymap.Vim.SearchMotionMap-    Yi.Keymap.Vim.StateUtils-    Yi.Keymap.Vim.StyledRegion-    Yi.Keymap.Vim.Tag-    Yi.Keymap.Vim.TextObject-    Yi.Keymap.Vim.Utils-    Yi.Keymap.Vim.VisualMap-    Yi.KillRing-    Yi.Layout-    Yi.Main-    Yi.MiniBuffer-    Yi.Misc-    Yi.Mode.Abella-    Yi.Mode.Buffers-    Yi.Mode.Compilation-    Yi.Mode.GHCi-    Yi.Mode.Haskell-    Yi.Mode.Haskell.Dollarify-    Yi.Mode.IReader-    Yi.Mode.Interactive-    Yi.Mode.JavaScript-    Yi.Mode.Latex-    Yi.Modes-    Yi.Monad-    Yi.Paths-    Yi.PersistentState-    Yi.Process-    Yi.Rectangle-    Yi.Snippets-    Yi.Snippets.Haskell-    Yi.Search-    Yi.Search.Internal-    Yi.String-    Yi.Syntax.Driver-    Yi.Syntax.Haskell-    Yi.Syntax.JavaScript-    Yi.Syntax.Latex-    Yi.Syntax.Layout-    Yi.Syntax.OnlineTree-    Yi.Syntax.Paren-    Yi.Syntax.Tree-    Yi.Syntax.Strokes.Haskell-    Yi.Tab-    Yi.Tag-    Yi.TextCompletion-    Yi.Types-    Yi.UI.Common-    Yi.UI.Batch-    Yi.UI.SimpleLayout-    Yi.UI.TabBar-    Yi.UI.Utils-    Yi.Verifier.JavaScript-    Yi.Window-    Yi.Char.Unicode+flag vty+  description: Include the vty (CLI) frontend+  manual: True+  default: True -  if impl(ghc < 7.8)-    build-depends: derive >=2.4 && <2.7, binary >= 0.5, tagged-  else-    build-depends: binary >= 0.7+executable yi+  main-is: Main.hs+  hs-source-dirs:+      ./+  ghc-options: -Wall -ferror-spans -threaded -eventlog -rtsopts   build-depends:-    Cabal >= 1.10,-    array,-    containers,-    directory,-    process >= 1.0.1.1,-    old-locale,-    base >= 4 && < 5,-    bytestring >= 0.9.1 && < 0.11,-    cautious-file >= 1.0.1,-    dynamic-state >= 0.1.0.5,-    data-default,-    lens >= 4.4.0.1,-    dlist >=0.4.1,-    dyre >=0.8.11,-    filepath>=1.1 && <1.4,-    hashable >=1.1.2.5,-    hint > 0.3.1,-    mtl >= 0.1.0.1,-    parsec >= 3.0,-    pointedlist >= 0.5,-    regex-base ==0.93.*,-    regex-tdfa >= 1.1 && <1.3,-    safe >= 0.3.4 && < 0.4,-    split >= 0.1 && < 0.3,-    template-haskell >= 2.4,-    text >= 1.1.1.3,-    time >= 1.1 && < 1.5,-    utf8-string >= 0.3.1,-    unix-compat >=0.1 && <0.5,-    unordered-containers >= 0.1.3 && < 0.3,-    xdg-basedir >= 0.2.1 && < 0.3,-    transformers-base,-    semigroups,-    word-trie >= 0.2.0.4,-    yi-language >= 0.1.0.7,-    oo-prototypes,-    yi-rope >= 0.4.1.0--  ghc-options: -Wall -fno-warn-orphans-  ghc-prof-options: -prof -auto-all -rtsopts--  if flag(profiling)-    cpp-options: -DPROFILING--  if flag(eventlog)-    CPP-options: -DEVENTLOG-    ghc-options: -Wall -fno-warn-orphans -eventlog--  default-extensions: NondecreasingIndentation--  if !os(windows)-    build-depends:-      unix--  if os(windows)-    build-depends:-      Win32--  if flag(testing)-    cpp-options: -DTESTING+      base >= 4.8 && < 5+    , microlens-platform >= 0.3.4.0+    , mtl >= 2.2.1+    , optparse-applicative >= 0.13.0.0+    , yi-core >= 0.19+    , yi-misc-modes >= 0.19+    , yi-mode-haskell >= 0.19+    , yi-mode-javascript >= 0.19+    , yi-rope >= 0.10+  if flag(vty)+    cpp-options: -DVTY     build-depends:-      QuickCheck >= 2.7 && < 2.8,-      random--  -- Frontends+        yi-frontend-vty >= 0.19   if flag(pango)-    exposed-modules:-      Yi.UI.Pango-      Yi.UI.Pango.Control-    other-modules:-      Yi.UI.Pango.Layouts-      Yi.UI.Pango.Utils+    cpp-options: -DPANGO     build-depends:-      gtk ==0.13.*,-      glib ==0.13.*,-      pango ==0.13.*-    cpp-options: -DFRONTEND_PANGO--  if flag(vty)-    exposed-modules:-      Yi.UI.Vty-      Yi.UI.Vty.Conversions+        yi-frontend-pango >= 0.19+  if flag(vim)+    cpp-options: -DVIM     build-depends:-      unix-compat >=0.1 && <0.5,-      vty >= 5.2.2 && < 6-    cpp-options: -DFRONTEND_VTY--  other-modules:-    Paths_yi,--    -- "Internal" modules that the user better not see.-    Yi.Buffer.Implementation,-    Parser.Incremental,--    -- Should probably be split out to another package.-    Control.Exc,-    Data.DelayList,-    System.CanonicalizePath,-    System.FriendlyPath--executable yi-  hs-source-dirs: src/executable-  default-language: Haskell2010--  if flag(profiling)-    cpp-options: -DPROFILING--  main-is: Main.hs--  build-depends:-    base >=4 && <5, yi--  ghc-options: -threaded-  ghc-prof-options: -prof -auto-all -rtsopts--Test-Suite test-suite+        yi-keymap-vim >= 0.19+  if flag(emacs)+    cpp-options: -DEMACS+    build-depends:+        yi-keymap-emacs >= 0.19   default-language: Haskell2010-  hs-source-dirs: src/tests-  type: exitcode-stdio-1.0-  main-is: TestSuite.hs-  other-modules:-    Driver-    Generic.TestPureBufferManipulations-    Generic.TestUtils-    Vim.EditorManipulations.BufferExCommand-    Vim.TestExCommandParsers-    Vim.TestPureBufferManipulations-    Vim.TestPureEditorManipulations-  build-depends:-    base,-    lens >= 4.4.0.1,-    semigroups,-    tasty,-    tasty-hunit,-    tasty-quickcheck,-    HUnit,-    QuickCheck,-    filepath,-    directory,-    text,-    yi-language >= 0.1.0.7,-    yi-rope,-    yi