yi 0.6.7.0 → 0.7.0
raw patch · 97 files changed
+4938/−837 lines, 97 filesdep +HUnitdep +parsecdep +test-frameworkdep ~Cabaldep ~Diffdep ~QuickCheck
Dependencies added: HUnit, parsec, test-framework, test-framework-hunit
Dependency ranges changed: Cabal, Diff, QuickCheck, base, concrete-typerep, filepath, fingertree, hashable
Files
- dist/build/Yi/Lexer/Abella.hs +16/−5
- dist/build/Yi/Lexer/C.hs +16/−5
- dist/build/Yi/Lexer/Cabal.hs +14/−3
- dist/build/Yi/Lexer/Compilation.hs +16/−5
- dist/build/Yi/Lexer/Cplusplus.hs +16/−5
- dist/build/Yi/Lexer/GNUMake.hs +14/−3
- dist/build/Yi/Lexer/GitCommit.hs +14/−3
- dist/build/Yi/Lexer/Haskell.hs +16/−3
- dist/build/Yi/Lexer/JSON.hs +16/−5
- dist/build/Yi/Lexer/Java.hs +16/−5
- dist/build/Yi/Lexer/JavaScript.hs +16/−5
- dist/build/Yi/Lexer/Latex.hs +16/−5
- dist/build/Yi/Lexer/LiterateHaskell.hs +14/−3
- dist/build/Yi/Lexer/OCaml.hs +16/−5
- dist/build/Yi/Lexer/ObjectiveC.hs +16/−5
- dist/build/Yi/Lexer/Ott.hs +16/−5
- dist/build/Yi/Lexer/Perl.hs +14/−3
- dist/build/Yi/Lexer/Python.hs +16/−5
- dist/build/Yi/Lexer/Ruby.hs +16/−5
- dist/build/Yi/Lexer/SVNCommit.hs +14/−3
- dist/build/Yi/Lexer/Srmc.hs +16/−5
- dist/build/Yi/Lexer/Whitespace.hs +16/−5
- example-configs/yi-vim.hs +1/−1
- example-configs/yi-vim2.hs +63/−0
- src/library/Control/Exc.hs +9/−3
- src/library/Data/Rope.hs +13/−4
- src/library/Yi.hs +1/−1
- src/library/Yi/Boot.hs +3/−1
- src/library/Yi/Buffer.hs +2/−0
- src/library/Yi/Buffer/HighLevel.hs +278/−10
- src/library/Yi/Buffer/Indent.hs +12/−5
- src/library/Yi/Buffer/Misc.hs +137/−8
- src/library/Yi/Buffer/Normal.hs +13/−353
- src/library/Yi/Buffer/Region.hs +39/−14
- src/library/Yi/Buffer/TextUnit.hs +390/−0
- src/library/Yi/Config/Default.hs +9/−3
- src/library/Yi/Core.hs +3/−2
- src/library/Yi/Editor.hs +50/−7
- src/library/Yi/File.hs +1/−1
- src/library/Yi/History.hs +0/−11
- src/library/Yi/IReader.hs +7/−6
- src/library/Yi/JumpList.hs +48/−0
- src/library/Yi/Keymap.hs +41/−20
- src/library/Yi/Keymap/Emacs.hs +1/−1
- src/library/Yi/Keymap/Vim.hs +6/−83
- src/library/Yi/Keymap/Vim2.hs +175/−0
- src/library/Yi/Keymap/Vim2/Common.hs +120/−0
- src/library/Yi/Keymap/Vim2/Digraph.hs +70/−0
- src/library/Yi/Keymap/Vim2/Eval.hs +16/−0
- src/library/Yi/Keymap/Vim2/EventUtils.hs +97/−0
- src/library/Yi/Keymap/Vim2/Ex.hs +39/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/BufferDelete.hs +21/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Common.hs +97/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Delete.hs +23/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Edit.hs +35/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Global.hs +49/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/GotoLine.hs +22/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Nohl.hs +22/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Paste.hs +26/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Quit.hs +68/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Reload.hs +18/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Substitute.hs +49/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Write.hs +40/−0
- src/library/Yi/Keymap/Vim2/Ex/Commands/Yi.hs +23/−0
- src/library/Yi/Keymap/Vim2/Ex/Eval.hs +29/−0
- src/library/Yi/Keymap/Vim2/Ex/Types.hs +27/−0
- src/library/Yi/Keymap/Vim2/ExMap.hs +184/−0
- src/library/Yi/Keymap/Vim2/InsertMap.hs +206/−0
- src/library/Yi/Keymap/Vim2/MatchResult.hs +43/−0
- src/library/Yi/Keymap/Vim2/Motion.hs +211/−0
- src/library/Yi/Keymap/Vim2/NormalMap.hs +374/−0
- src/library/Yi/Keymap/Vim2/NormalOperatorPendingMap.hs +154/−0
- src/library/Yi/Keymap/Vim2/Operator.hs +161/−0
- src/library/Yi/Keymap/Vim2/ReplaceMap.hs +84/−0
- src/library/Yi/Keymap/Vim2/ReplaceSingleCharMap.hs +52/−0
- src/library/Yi/Keymap/Vim2/Search.hs +41/−0
- src/library/Yi/Keymap/Vim2/SearchMotionMap.hs +74/−0
- src/library/Yi/Keymap/Vim2/StateUtils.hs +144/−0
- src/library/Yi/Keymap/Vim2/StyledRegion.hs +62/−0
- src/library/Yi/Keymap/Vim2/TextObject.hs +68/−0
- src/library/Yi/Keymap/Vim2/Utils.hs +139/−0
- src/library/Yi/Keymap/Vim2/VisualMap.hs +238/−0
- src/library/Yi/Lexer/Haskell.x +2/−0
- src/library/Yi/Main.hs +2/−9
- src/library/Yi/Misc.hs +27/−0
- src/library/Yi/Mode/Interactive.hs +0/−5
- src/library/Yi/Paths.hs +13/−8
- src/library/Yi/Prelude.hs +1/−0
- src/library/Yi/Search.hs +3/−1
- src/library/Yi/Style/Library.hs +8/−17
- src/library/Yi/Tag.hs +6/−4
- src/library/Yi/UI/Utils.hs +2/−2
- src/library/Yi/UI/Vty.hs +9/−8
- src/library/Yi/Window.hs +22/−19
- src/tests/Driver.hs +0/−101
- src/tests/TestSuite.hs +8/−22
- yi.cabal +67/−11
dist/build/Yi/Lexer/Abella.hs view
@@ -119,11 +119,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -240,7 +251,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -256,7 +267,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -272,7 +283,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/C.hs view
@@ -97,11 +97,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -218,7 +229,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -234,7 +245,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -250,7 +261,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/Cabal.hs view
@@ -93,11 +93,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -214,7 +225,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in
dist/build/Yi/Lexer/Compilation.hs view
@@ -76,11 +76,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -197,7 +208,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -213,7 +224,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -229,7 +240,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/Cplusplus.hs view
@@ -94,11 +94,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -215,7 +226,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -231,7 +242,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -247,7 +258,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/GNUMake.hs view
@@ -131,11 +131,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -252,7 +263,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in
dist/build/Yi/Lexer/GitCommit.hs view
@@ -110,11 +110,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -231,7 +242,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in
dist/build/Yi/Lexer/Haskell.hs view
@@ -74,6 +74,8 @@ ReservedOp _ -> operatorStyle Reserved Import -> importStyle Reserved Qualified -> importStyle+ Reserved As -> importStyle+ Reserved Hiding -> importStyle Reserved _ -> keywordStyle Special _ -> defaultStyle ConsOperator _ -> operatorStyle@@ -218,11 +220,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -339,7 +352,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in
dist/build/Yi/Lexer/JSON.hs view
@@ -71,11 +71,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -192,7 +203,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -208,7 +219,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -224,7 +235,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/Java.hs view
@@ -96,11 +96,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -217,7 +228,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -233,7 +244,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -249,7 +260,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/JavaScript.hs view
@@ -244,11 +244,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -365,7 +376,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -381,7 +392,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -397,7 +408,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/Latex.hs view
@@ -412,11 +412,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -533,7 +544,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -549,7 +560,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -565,7 +576,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/LiterateHaskell.hs view
@@ -152,11 +152,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -273,7 +284,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in
dist/build/Yi/Lexer/OCaml.hs view
@@ -105,11 +105,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -226,7 +237,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -242,7 +253,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -258,7 +269,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/ObjectiveC.hs view
@@ -95,11 +95,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -216,7 +227,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -232,7 +243,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -248,7 +259,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/Ott.hs view
@@ -102,11 +102,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -223,7 +234,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -239,7 +250,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -255,7 +266,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/Perl.hs view
@@ -306,11 +306,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -427,7 +438,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in
dist/build/Yi/Lexer/Python.hs view
@@ -78,11 +78,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -199,7 +210,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -215,7 +226,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -231,7 +242,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/Ruby.hs view
@@ -83,11 +83,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -204,7 +215,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -220,7 +231,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -236,7 +247,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/SVNCommit.hs view
@@ -83,11 +83,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -204,7 +215,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in
dist/build/Yi/Lexer/Srmc.hs view
@@ -95,11 +95,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -216,7 +227,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -232,7 +243,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -248,7 +259,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
dist/build/Yi/Lexer/Whitespace.hs view
@@ -78,11 +78,22 @@ -- ----------------------------------------------------------------------------- -- INTERNALS and main scanner engine -{-# LINE 35 "templates/GenericTemplate.hs" #-}+{-# LINE 21 "templates/GenericTemplate.hs" #-} -{-# LINE 45 "templates/GenericTemplate.hs" #-} +++#if __GLASGOW_HASKELL__ > 706+#define GTE(n,m) (tagToEnum# (n >=# m))+#define EQ(n,m) (tagToEnum# (n ==# m))+#else+#define GTE(n,m) (n >=# m)+#define EQ(n,m) (n ==# m)+#endif+{-# LINE 50 "templates/GenericTemplate.hs" #-}++ data AlexAddr = AlexA# Addr# #if __GLASGOW_HASKELL__ < 503@@ -199,7 +210,7 @@ offset = (base +# ord_c) check = alexIndexInt16OffAddr alex_check offset - new_s = if (offset >=# 0#) && (check ==# ord_c)+ new_s = if GTE(offset,0#) && EQ(check,ord_c) then alexIndexInt16OffAddr alex_table offset else alexIndexInt16OffAddr alex_deflt s in@@ -215,7 +226,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len))-{-# LINE 191 "templates/GenericTemplate.hs" #-}+{-# LINE 196 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone@@ -231,7 +242,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip-{-# LINE 235 "templates/GenericTemplate.hs" #-}+{-# LINE 240 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i
example-configs/yi-vim.hs view
@@ -23,7 +23,7 @@ styles yet - Jim -} defaultVimUiTheme :: Theme-defaultVimUiTheme = defaultLightTheme `override` \super self -> super {+defaultVimUiTheme = defaultTheme `override` \super self -> super { selectedStyle = modelineFocusStyle self }
+ example-configs/yi-vim2.hs view
@@ -0,0 +1,63 @@+import Prelude ()+import Yi+import Yi.Keymap.Vim+import qualified Yi.Keymap.Vim2 as V2+import qualified Yi.Keymap.Vim2.Common as V2+import qualified Yi.Keymap.Vim2.Utils as V2++import qualified Yi.Mode.Haskell as Haskell++main :: IO ()+main = yi $ defaultVimConfig {+ modeTable = (myModes ++ modeTable defaultVimConfig),+ defaultKm = myKeymapSet,+ configCheckExternalChangesObsessively = False+}++defaultSearchKeymap :: Keymap+defaultSearchKeymap = do+ Event (KASCII c) [] <- anyEvent+ write (isearchAddE [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.Vim2.Common for datatypes and + -- Yi.Keymap.Vim2.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 :: (String -> EditorM ()) -> [V2.VimBinding]+myBindings eval =+ let nmap x y = V2.mkStringBindingE V2.Normal V2.Drop (x, y, id)+ 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>" (withBuffer0 deleteTrailingSpaceB)+ , nmap "<F4>" (withBuffer0 moveToSol)+ , nmap "<F1>" (withBuffer0 readCurrentWordB >>= printMsg)+ ]++myModes = [+ AnyMode Haskell.fastMode {+ -- Disable beautification+ modePrettify = const $ return ()+ , modeGetAnnotations = (const . const) []+ }+ ]
src/library/Control/Exc.hs view
@@ -1,10 +1,16 @@ {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE CPP #-}+ -- | Utilities for working with new Control.Exception-module Control.Exc(ignoringException, printingException, orException)+module Control.Exc (ignoringException, printingException, orException) where -import Prelude hiding(catch)-import Control.Exception(catch, SomeException) +#if defined(__GLASGOW_HASKELL__) && (__GLASGOW_HASKELL__ >= 706)+import Prelude+#else+import Prelude hiding (catch)+#endif+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)
src/library/Data/Rope.hs view
@@ -25,7 +25,11 @@ toString, toReverseString, -- * List-like functions- null, empty, take, drop, append, splitAt, splitAtLine, length, reverse, countNewLines,+ null, empty, take, drop, length, reverse, countNewLines,++ split, splitAt, splitAtLine,++ append, concat, -- * IO readFile, writeFile,@@ -34,18 +38,18 @@ splitAtChunkBefore ) where -import Prelude hiding (null, head, tail, length, take, drop, splitAt, head, tail, foldl, reverse, readFile, writeFile)+import Prelude hiding (null, head, tail, length, take, drop, splitAt, head, tail, foldl, reverse, readFile, writeFile, concat) import qualified Data.List as L import qualified Data.ByteString.UTF8 as B import qualified Data.ByteString as B (append, concat) import qualified Data.ByteString as Byte import Data.ByteString (ByteString)-import qualified Data.ByteString.Lazy as LB (toChunks, fromChunks, null, readFile)+import qualified Data.ByteString.Lazy as LB (toChunks, fromChunks, null, readFile, split) import qualified Data.ByteString.Lazy.UTF8 as LB import qualified Data.FingerTree as T-import Data.FingerTree hiding (null, empty, reverse)+import Data.FingerTree hiding (null, empty, reverse, split) import Data.Binary import Data.Char (ord)@@ -149,6 +153,9 @@ (Chunk len' x') :< r -> if (fromIntegral len) + (fromIntegral len') < defaultChunkSize then l >< singleton (Chunk (len + len') (x `B.append` x')) >< r else a >< b++concat :: [Rope] -> Rope+concat = L.foldl1' append take, drop :: Int -> Rope -> Rope take n = fst . splitAt n@@ -188,6 +195,8 @@ where (l, c) = T.split ((n <) . lineIndex) t +split :: Word8 -> Rope -> [Rope]+split c = map fromLazyByteString . LB.split c . toLazyByteString cutExcess :: Int -> ByteString -> (ByteString, ByteString) cutExcess i s = let idx = gt i $ L.reverse $ Byte.elemIndices newline s
src/library/Yi.hs view
@@ -8,7 +8,7 @@ -- -- You should therefore: -- import Yi--- in your ~/.yi/ scripts+-- in your ~/.config/yi/ scripts -- module Yi
src/library/Yi/Boot.hs view
@@ -16,7 +16,7 @@ import Yi.Keymap import Yi.Main import qualified Yi.UI.Common as UI-import qualified Yi.Paths(getConfigDir)+import qualified Yi.Paths(getConfigDir, getConfigModules) -- | once the custom yi is compiled this restores the editor state (if requested) then proceeds to -- run the editor.@@ -42,6 +42,7 @@ -- The yi executable uses a default config. yiDriver cfg = do args <- Dyre.withDyreOptions Dyre.defaultParams getArgs + modules <- Yi.Paths.getConfigModules -- 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) ->@@ -55,6 +56,7 @@ , Dyre.configDir = Just Yi.Paths.getConfigDir , Dyre.hidePackages = ["mtl"] , Dyre.ghcOpts = (["-threaded", "-O2"] +++ ["-i" ++ modules] ++ #ifdef PROFILING ["-prof", "-auto-all", "-rtsopts", "-osuf=p_o", "-hisuf=p_hi"] ++ #endif
src/library/Yi/Buffer.hs view
@@ -13,6 +13,7 @@ , 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 (..)@@ -27,6 +28,7 @@ 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/HighLevel.hs view
@@ -2,15 +2,20 @@ -- Copyright (C) 2008 JP Bernardy module Yi.Buffer.HighLevel where +import Prelude (FilePath)+import Yi.Prelude+ import Control.Monad.RWS.Strict (ask)-import Control.Monad.State+import Control.Monad.State hiding (forM, forM_, sequence_)+ import Data.Char-import Data.List (isPrefixOf, sort, lines, drop, filter, length, takeWhile, dropWhile, reverse)+import Data.List (isPrefixOf, sort, lines, drop, filter, length,+ takeWhile, dropWhile, reverse, map, intersperse, zip)+import Data.Maybe (fromMaybe, listToMaybe, catMaybes)+import Data.Ord import qualified Data.Rope as R-import Data.Maybe (fromMaybe, listToMaybe) import Data.Time (UTCTime)-import Prelude (FilePath, map)-import Yi.Prelude+import Data.Tuple (swap) import Yi.Buffer.Basic import Yi.Buffer.Misc@@ -66,22 +71,45 @@ -- * 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 = doUntilB_ ((c ==) <$> readB) rightB+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 = nextCInc c >> leftB+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 = doUntilB_ ((c ==) <$> readB) leftB+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 = prevCInc c >> rightB+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@@ -98,6 +126,29 @@ moveNonspaceOrSol = do prev <- readPreviousOfLnB if and . map 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@@ -141,10 +192,19 @@ 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 String readLnB = readUnitB Line@@ -179,6 +239,9 @@ else do p <- pointB return $ Point (fromPoint p + 1) +readCurrentWordB :: BufferM String+readCurrentWordB = readUnitB unitWord+ readPrevWordB :: BufferM String readPrevWordB = readPrevUnitB unitViWordOnLine @@ -215,7 +278,13 @@ capitaliseWordB :: BufferM () capitaliseWordB = transformB capitalizeFirst unitWord Forward +-- | switch the case of the letter under the cursor+switchCaseCharB :: BufferM ()+switchCaseCharB = transformB (fmap 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@@ -237,7 +306,7 @@ -- | Delete trailing whitespace from all lines deleteTrailingSpaceB :: BufferM () deleteTrailingSpaceB = modifyRegionClever deleteSpaces =<< regionOfB Document- where deleteSpaces = mapLines $ reverse . dropWhile (' ' ==) . reverse+ where deleteSpaces = mapLines $ reverse . dropWhile (`elem` " \t") . reverse -- ---------------------------------------------------- -- | Marks@@ -633,3 +702,202 @@ smallBufferSize :: Int smallBufferSize = 1000000++-- 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+ discard $ 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+ discard $ lineMoveRel i+ p <- pointB+ eol <- atEol+ if not eol+ then return $ Just p+ else return Nothing+leftEdgesOfRegionB _ r = return [regionStart r]++rightEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point]+-- rightEdgesOfRegionB Block reg = return [regionEnd reg]+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 acc+ else do+ discard $ lineMoveRel 1+ go (edge:acc) =<< pointB+ go [] (regionStart reg)+rightEdgesOfRegionB _ reg = savingPointB $ do+ moveTo $ regionEnd reg+ leftOnEol+ fmap singleton 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+ discard $ 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 Rope+readRegionRopeWithStyleB reg Block = savingPointB $ do+ (start, lengths) <- shapeOfBlockRegionB reg+ moveTo start+ chunks <- forM lengths $ \l ->+ if l == 0+ then lineMoveRel 1 >> return R.empty+ else do+ p <- pointB+ r <- readRegionB' $ mkRegion p (p +~ Size l)+ discard $ lineMoveRel 1+ return r+ return $ R.concat $ intersperse (R.fromString "\n") chunks+readRegionRopeWithStyleB reg style = readRegionB' =<< convertRegionToStyleB reg style++insertRopeWithStyleB :: Rope -> RegionStyle -> BufferM ()+insertRopeWithStyleB rope Block = savingPointB $ do+ let ls = R.split (fromIntegral (ord '\n')) rope+ advanceLine = do+ bottom <- atLastLine+ if bottom+ then do+ col <- curCol+ moveToEol+ newlineB+ insertN $ replicate col ' '+ else discard $ lineMoveRel 1+ 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+ discard $ 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
src/library/Yi/Buffer/Indent.hs view
@@ -34,7 +34,7 @@ Retrieve the current indentation settings for the buffer. -} indentSettingsB :: BufferM IndentSettings-indentSettingsB = withModeB (\Mode {modeIndentSettings = x} -> return x)+indentSettingsB = withModeB $ return . modeIndentSettings {-|@@ -381,10 +381,17 @@ -- | Indent as much as the previous line indentAsPreviousB :: BufferM ()-indentAsPreviousB =- do previousLine <- getNextNonBlankLineB Backward- previousIndent <- indentOfB previousLine- indentToB previousIndent+indentAsPreviousB = indentAsNeighborLineB Backward++-- | Indent as much as the previous line+indentAsNextB :: BufferM ()+indentAsNextB = indentAsNeighborLineB Forward++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 ()
src/library/Yi/Buffer/Misc.hs view
@@ -19,6 +19,7 @@ , curCol , colOf , lineOf+ , lineCountB , sizeB , pointB , pointOfLineColB@@ -41,12 +42,14 @@ , moveN , leftN , rightN+ , insertN' , insertN , insertNAt' , insertNAt , insertB , deleteN , nelemsB+ , nelemsB' , writeB , writeN , newlineB@@ -57,6 +60,8 @@ , undoB , redoB , getMarkB+ , setMarkHereB+ , setNamedMarkHereB , mayGetMarkB , getMarkValueB , setMarkPointB@@ -141,6 +146,15 @@ , file , lastSyncTimeA , replaceCharB+ , replaceCharWithBelowB+ , replaceCharWithAboveB+ , insertCharWithBelowB+ , insertCharWithAboveB+ , pointAfterCursorB+ , destinationOfMoveB+ , withEveryLineB+ , startUpdateTransactionB+ , commitUpdateTransactionB ) where @@ -153,7 +167,7 @@ import Yi.Buffer.Undo import Yi.Dynamic import Yi.Window-import Control.Monad.RWS.Strict hiding (mapM_, mapM, get, put, forM)+import Control.Monad.RWS.Strict hiding (mapM_, mapM, get, put, forM_, forM) import Data.Accessor.Template import Data.Binary import Data.DeriveTH@@ -233,17 +247,21 @@ , readOnly :: !Bool -- ^ read-only flag , inserting :: !Bool -- ^ the keymap is ready for insertion into this buffer , pointFollowsWindow :: !(WindowRef -> Bool)+ , updateTransactionInFlight :: !Bool+ , updateTransactionAccum :: ![Update] } deriving Typeable $(nameDeriveAccessors ''Attributes (\n -> Just (n ++ "AA"))) instance Binary Attributes where- put (Attributes n b u bd pc pu selectionStyle_ _proc wm law lst ro ins _pfw) = do+ put (Attributes n b u bd pc pu selectionStyle_ _proc wm law lst ro ins _pfw+ isTransacPresent transacAccum) = do put n >> put b >> put u >> put bd put pc >> put pu >> put selectionStyle_ >> put wm- put law >> put lst >> put ro >> put ins+ put law >> put lst >> put ro >> put ins >> put isTransacPresent >> put transacAccum get = Attributes <$> get <*> get <*> get <*> - get <*> get <*> get <*> get <*> pure I.End <*> get <*> get <*> get <*> get <*> get <*> pure (const False)+ get <*> get <*> get <*> get <*> pure I.End <*> get <*> get <*> get <*> get <*>+ get <*> pure (const False) <*> get <*> get instance Binary UTCTime where put (UTCTime x y) = put (fromEnum x) >> put (fromEnum y)@@ -332,7 +350,12 @@ pointFollowsWindowA :: Accessor FBuffer (WindowRef -> Bool) pointFollowsWindowA = pointFollowsWindowAA . attrsA +updateTransactionInFlightA :: Accessor FBuffer Bool+updateTransactionInFlightA = updateTransactionInFlightAA . attrsA +updateTransactionAccumA :: Accessor FBuffer [Update]+updateTransactionAccumA = updateTransactionAccumAA . attrsA+ file :: FBuffer -> (Maybe FilePath) file b = case b ^. identA of Right f -> Just f@@ -585,7 +608,29 @@ isUnchangedBuffer :: FBuffer -> Bool isUnchangedBuffer = isAtSavedFilePointU . getVal undosA +startUpdateTransactionB :: BufferM ()+startUpdateTransactionB = do+ transactionPresent <- getA updateTransactionInFlightA+ if transactionPresent+ then error "Already started update transaction"+ else do+ modA undosA $ addChangeU InteractivePoint+ putA updateTransactionInFlightA True +commitUpdateTransactionB :: BufferM ()+commitUpdateTransactionB = do+ transactionPresent <- getA updateTransactionInFlightA+ if not transactionPresent+ then error "Not in update transaction"+ else do+ putA updateTransactionInFlightA False+ transacAccum <- getA updateTransactionAccumA+ putA updateTransactionAccumA []++ modA undosA $ appEndo . mconcat $ fmap (Endo . addChangeU . AtomicChange) transacAccum+ modA undosA $ addChangeU InteractivePoint++ undoRedo :: (forall syntax. Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update])) ) -> BufferM () undoRedo f = do m <- getInsMark@@ -595,11 +640,20 @@ tell updates undoB :: BufferM ()-undoB = undoRedo undoU+undoB = do+ isTransacPresent <- getA updateTransactionInFlightA+ if isTransacPresent+ then error "Can't undo while undo transaction is in progress"+ else undoRedo undoU redoB :: BufferM ()-redoB = undoRedo redoU+redoB = do+ isTransacPresent <- getA 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@@ -657,6 +711,8 @@ , readOnly = False , inserting = True , pointFollowsWindow = const False+ , updateTransactionInFlight = False+ , updateTransactionAccum = [] } } epoch :: UTCTime@@ -675,6 +731,9 @@ nelemsB :: Int -> Point -> BufferM String nelemsB n i = queryBuffer $ nelemsBI n i +nelemsB' :: Int -> Point -> BufferM Rope+nelemsB' n i = fmap (R.take n) (streamB Forward i)+ streamB :: Direction -> Point -> BufferM Rope streamB dir i = queryBuffer (getStream dir i) @@ -715,7 +774,12 @@ forgetPreferCol let reversed = reverseUpdateI update modifyBuffer (applyUpdateI update)- modA undosA $ addChangeU $ AtomicChange $ reversed++ isTransacPresent <- getA updateTransactionInFlightA+ if isTransacPresent+ then modA updateTransactionAccumA $ (reversed:)+ else modA undosA $ addChangeU $ AtomicChange $ reversed+ tell [update] -- otherwise, just ignore. @@ -745,7 +809,7 @@ ------------------------------------------------------------------------ insertNAt' :: Rope -> Point -> BufferM ()-insertNAt' rope pnt = applyUpdate (Insert pnt Forward $ rope)+insertNAt' rope pnt = applyUpdate (Insert pnt Forward rope) -- | Insert the list at specified point, extending size of buffer insertNAt :: String -> Point -> BufferM ()@@ -755,6 +819,9 @@ insertN :: String -> BufferM () insertN cs = insertNAt cs =<< pointB +insertN' :: Rope -> BufferM ()+insertN' rope = insertNAt' rope =<< pointB+ -- | Insert the char at current point, extending size of buffer insertB :: Char -> BufferM () insertB = insertN . return@@ -865,6 +932,14 @@ modifyMarkB :: Mark -> (MarkValue -> MarkValue) -> BufferM () modifyMarkB m f = modifyBuffer $ modifyMarkBI m f +setMarkHereB :: BufferM Mark+setMarkHereB = getMarkB Nothing++setNamedMarkHereB :: String -> BufferM ()+setNamedMarkHereB name = do+ p <- pointB+ getMarkB (Just name) >>= flip setMarkPointB p+ -- | Highlight the selection setVisibleSelection :: Bool -> BufferM () setVisibleSelection = putA highlightSelectionA@@ -981,6 +1056,40 @@ insertB 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+ discard $ lineMoveRel offset+ l1 <- curLn+ c1 <- curCol+ curChar <- readB+ if c0 == c1 && l0 + offset == l1 && curChar `notElem` "\n\0"+ then return $ Just curChar+ else return Nothing+ -- | Delete @n@ characters forward from the current point deleteN :: Int -> BufferM () deleteN n = pointB >>= deleteNAt Forward n@@ -1000,6 +1109,9 @@ lineOf :: Point -> BufferM Int lineOf p = queryBuffer $ lineAt p +lineCountB :: BufferM Int+lineCountB = lineOf =<< sizeB+ colMove :: Int -> Char -> Int colMove col '\t' = (col + 7) `mod` 8 colMove col _ = col + 1@@ -1050,10 +1162,27 @@ pointAt :: forall a. 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+ discard $ gotoLn l+ action $(nameDeriveAccessors ''Mode (\n -> Just (n ++ "A")))
src/library/Yi/Buffer/Normal.hs view
@@ -9,7 +9,7 @@ -- * the textual units they work on -- * the direction towards which they operate (if applicable) -module Yi.Buffer.Normal (TextUnit(Character, Line, VLine, Document),+module Yi.Buffer.Normal (TextUnit(Character, Line, VLine, Document, GenUnit), outsideUnit, leftBoundaryUnit, unitWord,@@ -38,366 +38,24 @@ checkPeekB , RegionStyle(..) , mkRegionOfStyleB+ , convertRegionToStyleB , unitWiseRegion , extendRegionToBoundaries- , regionStyleA- ) where+ , regionStyleA+ ) where import Prelude(length, subtract) import Yi.Prelude-import Yi.Buffer.Basic-import Yi.Buffer.Misc-import Yi.Buffer.Region-import Yi.Dynamic-import Data.Char-import Data.List (sort)-import Control.Monad import Data.Binary import Data.DeriveTH---- | 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 @siz@ characters in specified direction--- shifted by specified offset.-genBoundary :: Int -> (String -> Bool) -> Direction -> BufferM Bool-genBoundary ofs condition dir = condition <$> peekB- where -- | read some characters in the specified direction- peekB = savingPointB $- do moveN $ mayNegate $ ofs- fmap snd <$> (indexedStreamB dir =<< pointB)- 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 list matches all the predicates, pairwise.--- If the list is "too small", then return 'False'.-checks :: [a -> Bool] -> [a] -> Bool-checks [] _ = True-checks _ [] = False-checks (p:ps) (x:xs) = p x && checks ps xs---checkPeekB :: Int -> [Char -> Bool] -> Direction -> BufferM Bool-checkPeekB offset conds = genBoundary offset (checks conds)--atViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool-atViWordBoundary charType = genBoundary (-1) $ \cs -> case cs of- (c1:c2:_) -> isNl c1 && isNl c2 -- stop at empty lines- || not (isSpace c1) && (charType c1 /= charType c2)- _ -> True--atAnyViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool-atAnyViWordBoundary charType = genBoundary (-1) $ \cs -> case cs of- (c1:c2:_) -> isNl c1 || isNl c2 || charType c1 /= charType c2- _ -> True--atViWordBoundaryOnLine :: (Char -> Int) -> Direction -> BufferM Bool-atViWordBoundaryOnLine charType = genBoundary (-1) $ \cs -> case cs of- (c1:c2:_) -> isNl c1 || isNl c2 || not (isSpace c1) && charType c1 /= charType c2- _ -> 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` [ Space, LineSeparator, ParagraphSeparator ]--atSepBoundary :: Direction -> BufferM Bool-atSepBoundary = genBoundary (-1) $ \cs -> case cs of- (c1:c2:_) -> isNl c1 || isNl c2 || isAnySep c1 /= isAnySep c2- _ -> 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 = doUntilB cond f >> return () -- maybe do an optimized version?--untilB_ :: BufferM Bool -> BufferM a -> BufferM ()-untilB_ cond f = untilB cond f >> return () -- 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 -> if p c then o >> return () else return ()----- | Boundary side-data BoundarySide = InsideBound | OutsideBound---- | 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 ()-genMaybeMoveB Document boundSpec moveDir = genMoveB Document boundSpec moveDir - -- optimized case for Document-genMaybeMoveB Line (Backward, InsideBound) Backward = moveTo =<< solPointB- -- optimized case for begin of Line-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'--transformB :: (String -> String) -> 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---- | What would be the point after doing the given action?--- The argument must not modify the buffer.-indexAfterB :: BufferM a -> BufferM Point-indexAfterB f = savingPointB (f >> pointB)---- | Region of the whole textunit where the current point is.-regionOfB :: TextUnit -> BufferM Region-regionOfB unit = savingPointB $ mkRegion- <$> (maybeMoveB unit Backward >> pointB)- <*> (maybeMoveB unit Forward >> pointB)---- 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)--- <*> indexAfterB (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 <*> indexAfterB (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 <*> indexAfterB (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 String-readPrevUnitB unit = readRegionB =<< regionOfPartNonEmptyB unit Backward+import Data.List (sort) -readUnitB :: TextUnit -> BufferM String-readUnitB = readRegionB <=< regionOfB+import Yi.Buffer.Basic+import Yi.Buffer.Misc+import Yi.Buffer.Region+import Yi.Buffer.TextUnit+import Yi.Dynamic -- Region styles are relative to the buffer contents. -- They likely should be considered a TextUnit.@@ -418,6 +76,9 @@ regionStyleA :: Accessor FBuffer RegionStyle regionStyleA = bufferDynamicValueA +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']@@ -443,4 +104,3 @@ genMaybeMoveB unit (Forward, bs2) Forward stop <- pointB return $ mkRegion' (regionDirection region) start stop-
src/library/Yi/Buffer/Region.hs view
@@ -12,20 +12,28 @@ , replaceRegionB' , replaceRegionClever , readRegionB+ , readRegionB' , mapRegionB , modifyRegionB , modifyRegionClever , winRegionB , inclusiveRegionB , blockifyRegion+ , joinLinesB+ , concatLinesB ) where++import Prelude ()+import Yi.Prelude+ import Data.Algorithm.Diff-import Yi.Region+import Data.Char (isSpace)+import Data.List (filter, length, sort, dropWhile)+ import Yi.Buffer.Misc-import Yi.Prelude-import Prelude ()-import Data.List (length, sort)+import Yi.Region+import Yi.String (lines') import Yi.Window (winRegion) winRegionB :: BufferM Region@@ -40,6 +48,10 @@ readRegionB r = nelemsB (fromIntegral (regionEnd r - i)) i where i = regionStart r +readRegionB' :: Region -> BufferM Rope+readRegionB' r = nelemsB' (fromIntegral (regionEnd r - i)) i+ where i = regionStart r+ -- | Replace a region with a given string. replaceRegionB :: Region -> String -> BufferM () replaceRegionB r s = do@@ -62,14 +74,12 @@ let diffs = getGroupedDiff text text' moveTo (regionStart region) #if MIN_VERSION_Diff(0,2,0)- forM_ diffs $ \d -> do- case d of+ forM_ diffs $ \d -> case d of First str -> deleteN $ length str- Both str1 str2 -> rightN $ length str1 + length str2+ Both str _ -> rightN $ length str Second str -> insertN str #else- forM_ diffs $ \(d,str) -> do- case d of+ forM_ diffs $ \(d,str) -> case d of F -> deleteN $ length str B -> rightN $ length str S -> insertN str@@ -112,11 +122,8 @@ inclusiveRegionB :: Region -> BufferM Region inclusiveRegionB r = if regionStart r <= regionEnd r- then mkRegion (regionStart r) <$> pointAfter (regionEnd r)- else mkRegion <$> pointAfter (regionStart r) <*> pure (regionEnd r)- where pointAfter p = pointAt $ do - moveTo p- rightB+ 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@@ -130,3 +137,21 @@ mapM (\line -> mkRegion <$> pointOfLineColB line lowCol <*> pointOfLineColB line (1 + highCol)) [startLine..endLine] +skippingFirst :: ([a] -> [a]) -> [a] -> [a]+skippingFirst f = list [] (\x -> (x :) . f)++skippingLast :: ([a] -> [a]) -> [a] -> [a]+skippingLast f xs = f (init xs) ++ [last xs]++skippingNull :: ([a] -> [b]) -> [a] -> [b]+skippingNull _ [] = []+skippingNull f xs = f xs++joinLinesB :: Region -> BufferM ()+joinLinesB =+ savingPointB .+ (modifyRegionClever $ skippingLast $+ concat . (skippingFirst $ fmap $ skippingNull ((' ':) . dropWhile isSpace)) . lines')++concatLinesB :: Region -> BufferM ()+concatLinesB = savingPointB . (modifyRegionClever $ skippingLast $ filter (/='\n'))
+ src/library/Yi/Buffer/TextUnit.hs view
@@ -0,0 +1,390 @@+{-# LANGUAGE DeriveDataTypeable #-}++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 Prelude (length, subtract)+import Yi.Prelude++import Data.Char++import Yi.Buffer.Basic+import Yi.Buffer.Misc+import Yi.Buffer.Region++-- | 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 @siz@ characters in specified direction+-- shifted by specified offset.+genBoundary :: Int -> (String -> Bool) -> Direction -> BufferM Bool+genBoundary ofs condition dir = condition <$> peekB+ where -- | read some characters in the specified direction+ peekB = savingPointB $+ do moveN $ mayNegate $ ofs+ fmap snd <$> (indexedStreamB dir =<< pointB)+ 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 list matches all the predicates, pairwise.+-- If the list is "too small", then return 'False'.+checks :: [a -> Bool] -> [a] -> Bool+checks [] _ = True+checks _ [] = False+checks (p:ps) (x:xs) = p x && checks ps xs+++checkPeekB :: Int -> [Char -> Bool] -> Direction -> BufferM Bool+checkPeekB offset conds = genBoundary offset (checks conds)++atViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool+atViWordBoundary charType = genBoundary (-1) $ \cs -> case cs of+ (c1:c2:_) -> isNl c1 && isNl c2 -- stop at empty lines+ || not (isSpace c1) && (charType c1 /= charType c2)+ _ -> True++atAnyViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool+atAnyViWordBoundary charType = genBoundary (-1) $ \cs -> case cs of+ (c1:c2:_) -> isNl c1 || isNl c2 || charType c1 /= charType c2+ _ -> True++atViWordBoundaryOnLine :: (Char -> Int) -> Direction -> BufferM Bool+atViWordBoundaryOnLine charType = genBoundary (-1) $ \cs -> case cs of+ (c1:c2:_) -> isNl c1 || isNl c2 || not (isSpace c1) && charType c1 /= charType c2+ _ -> 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` [ Space, LineSeparator, ParagraphSeparator ]++atSepBoundary :: Direction -> BufferM Bool+atSepBoundary = genBoundary (-1) $ \cs -> case cs of+ (c1:c2:_) -> isNl c1 || isNl c2 || isAnySep c1 /= isAnySep c2+ _ -> 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 = doUntilB cond f >> return () -- maybe do an optimized version?++untilB_ :: BufferM Bool -> BufferM a -> BufferM ()+untilB_ cond f = untilB cond f >> return () -- 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 -> if p c then o >> return () else return ()+++-- | 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 ()+genMaybeMoveB Document boundSpec moveDir = genMoveB Document boundSpec moveDir + -- optimized case for Document+genMaybeMoveB Line (Backward, InsideBound) Backward = moveTo =<< solPointB+ -- optimized case for begin of Line+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'++transformB :: (String -> String) -> 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 String+readPrevUnitB unit = readRegionB =<< regionOfPartNonEmptyB unit Backward++readUnitB :: TextUnit -> BufferM String+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/Config/Default.hs view
@@ -3,7 +3,7 @@ module Yi.Config.Default (defaultConfig, availableFrontends, defaultEmacsConfig, defaultVimConfig, defaultCuaConfig,- toVimStyleConfig, toEmacsStyleConfig, toCuaStyleConfig) where+ toVimStyleConfig, toVim2StyleConfig, toEmacsStyleConfig, toCuaStyleConfig) where import Control.Monad (forever) import Data.Either (rights)@@ -34,6 +34,7 @@ import qualified Yi.Keymap.Cua as Cua import qualified Yi.Keymap.Emacs as Emacs import qualified Yi.Keymap.Vim as Vim+import qualified Yi.Keymap.Vim2 as Vim2 import qualified Yi.Mode.Abella as Abella import qualified Yi.Mode.Haskell as Haskell import qualified Yi.Mode.JavaScript as JS@@ -143,7 +144,7 @@ , configAutoHideScrollBar = False , configAutoHideTabBar = True , configWindowFill = ' '- , configTheme = defaultLightTheme+ , configTheme = defaultTheme , configVtyEscDelay = 0 } , defaultKm = modelessKeymapSet nilKeymap@@ -189,7 +190,7 @@ defaultVimConfig = toVimStyleConfig defaultConfig defaultCuaConfig = toCuaStyleConfig defaultConfig -toEmacsStyleConfig, toVimStyleConfig, toCuaStyleConfig :: Config -> Config+toEmacsStyleConfig, toVimStyleConfig, toVim2StyleConfig, toCuaStyleConfig :: Config -> Config toEmacsStyleConfig cfg = cfg { configUI = (configUI cfg) { configVtyEscDelay = 1000 , configScrollStyle = Just SnapToCenter},@@ -211,6 +212,11 @@ , configUI = (configUI cfg) { configScrollStyle = Just SingleLine} , configRegionStyle = Inclusive , modeTable = AnyMode Abella.abellaModeVim : modeTable cfg }++toVim2StyleConfig cfg = cfg { defaultKm = Vim2.keymapSet+ , configUI = (configUI cfg) { configScrollStyle = Just SingleLine}+ , configRegionStyle = Inclusive }+ toCuaStyleConfig cfg = cfg {defaultKm = Cua.keymap} -- | Open an emacs-like scratch buffer if no file is open.
src/library/Yi/Core.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE ScopedTypeVariables, DoRec, Rank2Types #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE DoRec #-}+{-# LANGUAGE Rank2Types #-} -- Copyright (c) Tuomo Valkonen 2004. -- Copyright (c) Don Stewart 2004-5. http://www.cse.unsw.edu.au/~dons@@ -332,7 +334,6 @@ runAction (BufferA act) = do withBuffer act >>= msgEditor' . show return ()-runAction (TaggedA _ act) = runAction act msgEditor :: String -> YiM () msgEditor = withEditor . printMsg
src/library/Yi/Editor.hs view
@@ -24,6 +24,7 @@ import Yi.Dynamic import Yi.Event (Event) import Yi.Interact as I+import Yi.JumpList import Yi.KillRing import Yi.Layout import Yi.Prelude@@ -455,7 +456,7 @@ -- | 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+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@@ -669,12 +670,15 @@ -- contains only one window then do nothing. tryCloseE :: EditorM () tryCloseE = do- n <- getsA windowsA PL.length- if n == 1- -- Could the Maybe response from deleteLeft be used instead of the- -- initial 'if'?- then modA tabsA (fromJust . PL.deleteLeft)- else modA windowsA (fromJust . PL.deleteLeft)+ ntabs <- getsA tabsA PL.length+ nwins <- getsA windowsA PL.length+ if ntabs == 1 && nwins == 1+ then return ()+ else if nwins == 1+ -- Could the Maybe response from deleteLeft be used instead of the+ -- initial 'if'?+ then modA tabsA (fromJust . PL.deleteLeft)+ else modA windowsA (fromJust . PL.deleteLeft) -- | Make the current window the only window on the screen closeOtherE :: EditorM ()@@ -730,3 +734,42 @@ instance YiVariable TempBufferNameHint +addJumpHereE :: EditorM ()+addJumpHereE = do+ w <- getA currentWindowA+ let jl = jumpList w+ curPoint <- withBuffer0 $ pointB+ shouldAddJump <- case jl of+ Just (PL.PointedList _ (Jump mark bf) _) -> do+ bfStillAlive <- gets (M.lookup bf . buffers)+ case bfStillAlive of+ Nothing -> return False+ _ -> do+ p <- withGivenBuffer0 bf $ getMarkPointB mark+ return $! (p, bf) /= (curPoint, bufkey w)+ _ -> return True+ when shouldAddJump $ do+ m <- withBuffer0 setMarkHereB+ let bf = bufkey w+ j = Jump m bf+ putA currentWindowA $ w { jumpList = addJump j (jumpList w) }+ return ()++jumpBackE :: EditorM ()+jumpBackE = addJumpHereE >> modifyJumpListE jumpBack++jumpForwardE :: EditorM ()+jumpForwardE = modifyJumpListE jumpForward++modifyJumpListE :: (JumpList -> JumpList) -> EditorM ()+modifyJumpListE f = do+ w <- getA currentWindowA+ let w' = w { jumpList = f (jumpList w) }+ jl = jumpList w'+ case jl of+ Nothing -> return ()+ Just (PL.PointedList _ (Jump mark bf) _) -> do+ switchToBufferE bf+ withBuffer0 $ getMarkPointB mark >>= moveTo++ modA currentWindowA (\win -> win { jumpList = f (jumpList win) })
src/library/Yi/File.hs view
@@ -56,7 +56,7 @@ else newEmptyBuffer f (h:_) -> return $ bkey h - withEditor $ switchToBufferE b+ withEditor $ switchToBufferE b >> addJumpHereE return b where fileToNewBuffer :: FilePath -> YiM BufferRef
src/library/Yi/History.hs view
@@ -52,7 +52,6 @@ historyStartGen ident = do (History _cur cont pref) <- getA (dynKeyA ident . dynA) putA (dynKeyA ident . dynA) (History 0 (nub ("":cont)) pref)- debugHist historyFinish :: EditorM () historyFinish = historyFinishGen miniBuffer (withBuffer0 elemsB)@@ -67,15 +66,6 @@ cont' `seq` -- force checking the top of the history, otherwise we'll build up thunks putA (dynKeyA ident . dynA) $ History (-1) (curValue:cont') pref --- historyGetGen :: String -> EditorM String--- historyGetGen ident = do--- (History cur cont) <- getA (dynKeyA ident .> dynA)--- return $ cont !! cur---- TODO: scrap-debugHist :: EditorM ()-debugHist = return ()- historyFind :: [String] -> Int -> Int -> Int -> String -> Int historyFind cont len cur delta pref = case (next < 0, next >= len) of@@ -106,7 +96,6 @@ return curValue (_,_) -> do putA (dynKeyA ident . dynA) (History next (take cur cont ++ [curValue] ++ drop (cur+1) cont) pref)- debugHist return nextValue historyPrefixSet :: String -> EditorM ()
src/library/Yi/IReader.hs view
@@ -6,12 +6,14 @@ -- \"incremental reading\", see <http://en.wikipedia.org/wiki/Incremental_reading>. module Yi.IReader where +import Prelude ()+import Yi.Prelude hiding (empty)+ import Control.Monad.State (join) import Control.Exception-import Prelude hiding (catch)-import Data.Binary (Binary, decode, encodeFile)+import Data.Binary (decode, encodeFile) import Data.Sequence as S-import Data.Typeable (Typeable)+import Data.Typeable () import qualified Data.ByteString.Char8 as B (pack, unpack, readFile, ByteString) import qualified Data.ByteString.Lazy.Char8 as BL (fromChunks) @@ -21,12 +23,11 @@ import Yi.Buffer.Region (readRegionB) import Yi.Dynamic import Yi.Keymap (withBuffer, YiM)-import Yi.Prelude (getA, putA, io, discard, Initializable(..))-import Yi.Paths(getArticleDbFilename)+import Yi.Paths (getArticleDbFilename) type Article = B.ByteString newtype ArticleDB = ADB { unADB :: Seq Article }- deriving(Typeable, Binary)+ deriving (Typeable, Binary) instance Initializable ArticleDB where initial = ADB S.empty
+ src/library/Yi/JumpList.hs view
@@ -0,0 +1,48 @@+{-# LANGUAGE TemplateHaskell #-}++module Yi.JumpList+ ( JumpList+ , Jump(..)+ , addJump+ , jumpBack+ , jumpForward+ ) where++import Prelude ()+import Yi.Prelude++import Yi.Buffer.Basic++import Data.Binary+import Data.DeriveTH++import Data.List.PointedList as PL++type JumpList = Maybe (PL.PointedList Jump)++data Jump = Jump {+ jumpMark :: Mark+ , jumpBufferRef :: BufferRef+ }++-- $(derive makeBinary ''JumpList)+$(derive makeBinary ''Jump)++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 view
@@ -2,21 +2,50 @@ -- Copyright (c) Jean-Philippe Bernardy 2007,8. -module Yi.Keymap where+module Yi.Keymap+ ( Action(..)+ , emptyAction+ , Interact+ , KeymapM+ , Keymap+ , KeymapEndo+ , KeymapProcess+ , KeymapSet(..)+ , topKeymapA+ , startInsertKeymapA+ , insertKeymapA+ , startTopKeymapA+ , extractTopKeymap+ , modelessKeymapSet+ , YiM(..)+ , withUI+ , unsafeWithEditor+ , withGivenBuffer+ , withBuffer+ , readEditor+ , catchDynE+ , catchJustE+ , handleJustE+ , shutdown+ , YiAction (..)+ , Yi(..)+ , YiVar(..)+ , write+ ) where -import Control.Applicative +import Prelude ()+import Yi.Prelude+ import Control.Concurrent-import Control.Monad.Reader-import Control.Monad.State+import Control.Monad.Reader hiding (mapM_)+import Control.Monad.State hiding (mapM_) import Control.Exception-import Data.Typeable-import Prelude hiding (error, catch)+import Data.Typeable () import Yi.Buffer import Yi.Config import Yi.Editor (EditorM, Editor, runEditor, MonadEditor(..)) import Yi.Event-import Yi.Monad-import Yi.Prelude (io)+import Yi.Monad () import Yi.Process (SubprocessInfo, SubprocessId) import Yi.UI.Common import qualified Data.Map as M@@ -27,9 +56,6 @@ data Action = forall a. Show a => YiA (YiM a) | forall a. Show a => EditorA (EditorM a) | forall a. Show a => BufferA (BufferM a)- | TaggedA String Action--- | InsertA String--- | TextA Direction Unit Operation deriving Typeable emptyAction :: Action@@ -42,7 +68,6 @@ show (YiA _) = "@Y" show (EditorA _) = "@E" show (BufferA _) = "@B"- show (TaggedA s a) = s ++ show a type Interact ev a = I.I ev Action a @@ -90,9 +115,6 @@ write :: (I.MonadInteract m Action ev, YiAction a x, Show x) => a -> m () write x = I.write (makeAction x) -write' :: (I.MonadInteract m Action e, YiAction a x, Show x) => String -> a -> m ()-write' s x = I.write (TaggedA s (makeAction x))- -------------------------------- -- Uninteresting glue code @@ -111,13 +133,13 @@ -- TODO: can we simplify this? e' `seq` a `seq` return (var {yiEditor = e'}, a) -withGivenBuffer :: BufferRef -> BufferM a -> YiM a+withGivenBuffer :: MonadEditor m => BufferRef -> BufferM a -> m a withGivenBuffer b f = withEditor (Editor.withGivenBuffer0 b f) -withBuffer :: BufferM a -> YiM a+withBuffer :: MonadEditor m => BufferM a -> m a withBuffer f = withEditor (Editor.withBuffer0 f) -readEditor :: (Editor -> a) -> YiM a+readEditor :: MonadEditor m => (Editor -> a) -> m a readEditor f = withEditor (gets f) catchDynE :: Exception exception => YiM a -> (exception -> YiM a) -> YiM a@@ -172,8 +194,7 @@ $(nameDeriveAccessors ''KeymapSet $ Just.(++ "A")) extractTopKeymap :: KeymapSet -> Keymap-extractTopKeymap kms = do- startTopKeymap kms >> forever (topKeymap kms)+extractTopKeymap kms = startTopKeymap 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"
src/library/Yi/Keymap/Emacs.hs view
@@ -254,7 +254,7 @@ , ctrlCh 'b' ?>>! listBuffers , ctrlCh 'c' ?>>! askQuitEditor , ctrlCh 'f' ?>>! findFile- , ctrlCh 'q' ?>>! (withBuffer $ modA readOnlyA not)+ , ctrlCh 'q' ?>>! (withBuffer0 $ modA readOnlyA not) , ctrlCh 's' ?>>! fwriteE , ctrlCh 'w' ?>>! promptFile "Write file:" fwriteToE , ctrlCh 'x' ?>>! (exchangePointAndMarkB >>
src/library/Yi/Keymap/Vim.hs view
@@ -71,9 +71,9 @@ import Yi.Eval (execEditorAction, getAllNamesInScope) import Yi.File import Yi.History-import Yi.Misc (matchingFileNames,adjBlock,adjIndent)-import Yi.String (dropSpace,lines')+import Yi.String (dropSpace) import Yi.MiniBuffer+import Yi.Misc import Yi.Regex (seInput, regexEscapeString) import Yi.Search import Yi.Style@@ -326,7 +326,7 @@ viMove (Move unit dir) = moveB unit dir viMove (CharMove Forward) = moveXorEol 1 viMove (CharMove Backward) = moveXorSol 1-viMove (PercentageFile i) = movePercentageFile i+viMove (PercentageFile i) = setMarkHere '\'' >> movePercentageFileB i viMove (ArbMove move) = move viMove (SeqMove move1 move2) = viMove move1 >> viMove move2 viMove (Replicate move i) = viReplicateMove move i@@ -339,17 +339,6 @@ viReplicateMove (Replicate move j) i = viReplicateMove move (i * j) viReplicateMove move i = replicateM_ i $ viMove move -movePercentageFile :: Int -> BufferM ()-movePercentageFile 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- Point max_p <- sizeB- setMarkHere '\''- moveTo $ Point $ floor (fromIntegral max_p * f)- firstNonSpaceB- mkKeymap :: Proto ModeMap -> KeymapSet mkKeymap p = KeymapSet { -- if the keymap "crashed" we restart here@@ -427,7 +416,6 @@ where testDeleteB = if null s then return () else deleteWordB deleteWordB = deleteUnitB unitSep Backward- deleteUnitB unit dir = deleteRegionB =<< regionOfPartNonEmptyB unit dir exHistComplete' :: Bool -> (String -> YiM [String]) -> String -> YiM () exHistComplete' caseSensitive = mkExHistComplete (mkIsPrefixOf caseSensitive)@@ -702,25 +690,6 @@ printMsg $ directionElim dir '?' '/' : maybe "" seInput m viSearch "" [] dir - skippingFirst :: ([a] -> [a]) -> [a] -> [a]- skippingFirst f = list [] (\x -> (x :) . f)-- skippingLast :: ([a] -> [a]) -> [a] -> [a]- skippingLast f xs = f (init xs) ++ [last xs]-- skippingNull :: ([a] -> [b]) -> [a] -> [b]- skippingNull _ [] = []- skippingNull f xs = f xs-- joinLinesB :: Region -> BufferM ()- joinLinesB =- savingPointB .- (modifyRegionClever $ skippingLast $- concat . (skippingFirst $ map $ skippingNull ((' ':) . dropWhile isSpace)) . lines')-- concatLinesB :: Region -> BufferM ()- concatLinesB = savingPointB . (modifyRegionClever $ skippingLast $ filter (/='\n'))- onCurrentWord :: (String -> String) -> BufferM () onCurrentWord f = savingPointB $ modifyRegionClever f =<< regionOfNonEmptyB unitViWord @@ -781,7 +750,7 @@ -- Usually the integer argument is the number of times an action should be repeated. cmdFM :: [([Event], Int -> YiM ())] cmdFM =- [([ctrlCh 'g'], const $ withEditor viFileInfo)+ [([ctrlCh 'g'], const $ withEditor printFileInfoE) ,([ctrlCh '^'], withEditor . alternateBufferE . (+ (-1)) ) @@ -1011,19 +980,7 @@ case txt' of '\n':txt -> moveToSol >> insertN txt >> leftN (length txt) _ -> insertN txt' >> leftB- switchCaseChar :: Char -> Char- switchCaseChar c = if isUpper c then toLower c else toUpper c - onCharLetterCode :: (Int -> Int) -> Char -> Char- onCharLetterCode f c | isUpper c || isLower c = chr (f (ord c - a) `mod` 26 + a)- | otherwise = c- where a | isUpper c = ord 'A'- | isLower c = ord 'a'- | otherwise = undefined-- rot13Char :: Char -> Char- rot13Char = onCharLetterCode (+13)- viMapRegion :: (Char -> Char) -> RegionStyle -> Region -> EditorM () viMapRegion f Block region = withBuffer0' $ mapM_ (`mapRegionB` f) =<< blockifyRegion region viMapRegion f _ region = withBuffer0' $ mapRegionB region f@@ -1564,7 +1521,7 @@ -- --------------------------------------------------------------------- -- Misc functions -forAllBuffers :: (BufferRef -> YiM ()) -> YiM ()+forAllBuffers :: MonadEditor m => (BufferRef -> m ()) -> m () forAllBuffers f = mapM_ f =<< readEditor bufferStack viCharInfo :: EditorM ()@@ -1584,20 +1541,6 @@ . showString ", Octal " . showSeq showOct w8 $ "" where showSeq showX xs s = foldr ($) s $ intersperse (showChar ' ') $ map showX xs -viFileInfo :: EditorM ()-viFileInfo =- do bufInfo <- withBuffer0' bufInfoB- printMsg $ showBufInfo bufInfo- where- showBufInfo :: BufferFileInfo -> String- showBufInfo bufInfo = concat [ show $ bufInfoFileName bufInfo- , " Line "- , show $ bufInfoLineNo bufInfo- , " ["- , bufInfoPercent bufInfo- , "]"- ]- -- | write the current buffer, but only if modified (cf. :help :x) viWriteModified :: YiM () viWriteModified = do unchanged <- withBuffer' $ gets isUnchangedBuffer@@ -1684,27 +1627,7 @@ -- Find the item after or under the cursor and jump to its match percentMove :: (RegionStyle, ViMove)-percentMove = (Inclusive, ArbMove tryGoingToMatch)- where tryGoingToMatch = do- p <- pointB- getViMarkB '\'' >>= flip setMarkPointB p- foundMatch <- goToMatch- unless foundMatch $ moveTo p- 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 -- search for matchable character after the cursor+percentMove = (Inclusive, ArbMove (setMarkHere '\'' >> findMatchingPairB)) jumpToMark :: Char -> BufferM () jumpToMark c = do
+ src/library/Yi/Keymap/Vim2.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}++module Yi.Keymap.Vim2+ ( keymapSet+ , mkKeymapSet+ , defVimConfig+ , VimBinding (..)+ , VimOperator (..)+ , VimConfig (..)+ , pureEval+ , impureEval+ ) where++import Prelude ()+import Yi.Prelude++import Data.List (map, filter)+import Data.Prototype++import Yi.Buffer hiding (Insert)+import Yi.Editor+import Yi.Event+import Yi.Keymap+import Yi.Keymap.Keys (anyEvent)++import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.Digraph+import Yi.Keymap.Vim2.EventUtils+import Yi.Keymap.Vim2.Ex+import Yi.Keymap.Vim2.ExMap+import Yi.Keymap.Vim2.InsertMap+import Yi.Keymap.Vim2.NormalMap+import Yi.Keymap.Vim2.NormalOperatorPendingMap+import Yi.Keymap.Vim2.Operator+import Yi.Keymap.Vim2.ReplaceMap+import Yi.Keymap.Vim2.ReplaceSingleCharMap+import Yi.Keymap.Vim2.SearchMotionMap+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.Utils+import Yi.Keymap.Vim2.VisualMap++data VimConfig = VimConfig {+ vimKeymap :: Keymap+ , vimBindings :: [VimBinding]+ , vimOperators :: [VimOperator]+ , vimExCommandParsers :: [String -> Maybe ExCommand]+ , vimDigraphs :: [(String, 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+ }++defVimKeymap :: VimConfig -> KeymapM ()+defVimKeymap config = do+ e <- anyEvent+ write $ handleEvent config e++handleEvent :: VimConfig -> Event -> YiM ()+handleEvent config event = do+ currentState <- withEditor getDynamic+ let evs = vsBindingAccumulator currentState ++ eventToString event+ bindingMatch = selectBinding evs currentState (vimBindings config)+ prevMode = vsMode currentState++ repeatToken <- case bindingMatch of+ WholeMatch (VimBindingY _ action) -> do+ withEditor dropBindingAccumulatorE+ action evs+ WholeMatch (VimBindingE _ action) -> withEditor $ dropBindingAccumulatorE >> action evs+ NoMatch -> do+ withEditor dropBindingAccumulatorE+ return Drop+ PartialMatch -> do+ withEditor $ accumulateBindingEventE event+ return Continue++ withEditor $ do+ newMode <- vsMode <$> getDynamic++ -- TODO: we should introduce some hook mechanism like autocommands in vim+ case (prevMode, newMode) of+ (Insert _, Insert _) -> return ()+ (Insert _, _) -> withBuffer0 commitUpdateTransactionB+ (_, Insert _) -> withBuffer0 startUpdateTransactionB+ _ -> return ()++ case repeatToken of+ Drop -> dropAccumulatorE+ Continue -> accumulateEventE event+ Finish -> do+ accumulateEventE event+ flushAccumulatorIntoRepeatableActionE++ performEvalIfNecessary config+ updateModeIndicatorE prevMode++-- This is not in Yi.Keymap.Vim2.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 handleEvent+pureEval :: VimConfig -> String -> EditorM ()+pureEval config s = sequence_ actions+ where actions = map (pureHandleEvent config) $ parseEvents s++impureEval :: VimConfig -> String -> YiM ()+impureEval config s = sequence_ actions+ where actions = map (handleEvent config) $ parseEvents s++-- TODO: merge handleEvent and pureHandleEvent somehow+pureHandleEvent :: VimConfig -> Event -> EditorM ()+pureHandleEvent config event = do+ currentState <- getDynamic+ let evs = vsBindingAccumulator currentState ++ eventToString event+ bindingMatch = selectBinding evs currentState (allPureBindings config)+ prevMode = vsMode currentState+ case bindingMatch of+ NoMatch -> dropBindingAccumulatorE+ PartialMatch -> do+ accumulateBindingEventE event+ accumulateEventE event+ WholeMatch (VimBindingE _ action) -> do+ repeatToken <- withEditor $ action evs+ dropBindingAccumulatorE+ case repeatToken of+ Drop -> dropAccumulatorE+ Continue -> accumulateEventE event+ Finish -> accumulateEventE event >> flushAccumulatorIntoRepeatableActionE+ WholeMatch (VimBindingY _ _) -> fail "Impure binding found"++ newMode <- vsMode <$> getDynamic++ -- TODO: we should introduce some hook mechanism like autocommands in vim+ case (prevMode, newMode) of+ (Insert _, Insert _) -> return ()+ (Insert _, _) -> withBuffer0 commitUpdateTransactionB+ (_, Insert _) -> withBuffer0 startUpdateTransactionB+ _ -> return ()++ performEvalIfNecessary config+ updateModeIndicatorE prevMode++performEvalIfNecessary :: VimConfig -> EditorM ()+performEvalIfNecessary config = do+ stateAfterAction <- getDynamic++ -- see comment for 'pureEval'+ modifyStateE $ \s -> s { vsStringToEval = "" }+ pureEval config $ vsStringToEval stateAfterAction++allPureBindings :: VimConfig -> [VimBinding]+allPureBindings config = filter isPure $ vimBindings config+ where isPure (VimBindingE _ _) = True+ isPure _ = False
+ src/library/Yi/Keymap/Vim2/Common.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE DeriveDataTypeable, TemplateHaskell #-}++module Yi.Keymap.Vim2.Common+ ( VimMode(..)+ , VimBinding(..)+ , GotoCharCommand(..)+ , VimState(..)+ , Register(..)+ , RepeatToken(..)+ , RepeatableAction(..)+ , MatchResult(..)+ , EventString+ , OperatorName+ , RegisterName+ , module Yi.Keymap.Vim2.MatchResult+ ) where++import Yi.Prelude+import Prelude ()++import Data.Binary+import Data.DeriveTH+import qualified Data.HashMap.Strict as HM+import qualified Data.Rope as R++import Yi.Buffer hiding (Insert)+import Yi.Dynamic+import Yi.Editor+import Yi.Keymap+import Yi.Keymap.Vim2.MatchResult++type EventString = String++type OperatorName = String++type RegisterName = Char++data RepeatableAction = RepeatableAction {+ raPreviousCount :: !Int+ , raActionString :: !EventString+ }+ deriving (Typeable, Eq, Show)++data Register = Register {+ regRegionStyle :: RegionStyle+ , regContent :: R.Rope+ }++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.Vim2.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+ } deriving (Typeable)++$(derive makeBinary ''RepeatableAction)++$(derive makeBinary ''Register)++$(derive makeBinary ''GotoCharCommand)++instance Initializable VimMode where+ initial = Normal++$(derive makeBinary ''VimMode)++instance Initializable VimState where+ initial = VimState Normal Nothing [] [] HM.empty '\0' Nothing [] False [] Nothing [] [] False++$(derive makeBinary ''VimState)++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 {+ vbPrerequisite :: EventString -> VimState -> MatchResult (),+ vbyAction :: EventString -> YiM RepeatToken+ }+ | VimBindingE {+ vbPrerequisite :: EventString -> VimState -> MatchResult (),+ vbeAction :: EventString -> EditorM RepeatToken+ }
+ src/library/Yi/Keymap/Vim2/Digraph.hs view
@@ -0,0 +1,70 @@+module Yi.Keymap.Vim2.Digraph+ ( charFromDigraph+ , defDigraphs+ ) where++import Prelude ()+import Yi.Prelude++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/Vim2/Eval.hs view
@@ -0,0 +1,16 @@+module Yi.Keymap.Vim2.Eval+ ( scheduleActionStringForEval+ ) where++-- This module doesn't contains actual eval, see Yi.Keymap.Vim2.vimEval comment++import Yi.Prelude+import Prelude ()++import Yi.Editor+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.StateUtils++scheduleActionStringForEval :: String -> EditorM ()+scheduleActionStringForEval s = modifyStateE $+ \state -> state { vsStringToEval = s }
+ src/library/Yi/Keymap/Vim2/EventUtils.hs view
@@ -0,0 +1,97 @@+module Yi.Keymap.Vim2.EventUtils+ ( stringToEvent+ , eventToString+ , parseEvents+ , stringToRepeatableAction+ , normalizeCount+ , splitCountedCommand+ ) where++import Yi.Prelude+import Prelude ()++import Data.Char (toUpper, isDigit)+import Data.List (break)+import qualified Data.Map as M+import Data.Tuple (swap)++import Yi.Event+import Yi.Keymap.Keys (char, ctrlCh, spec)+import Yi.Keymap.Vim2.Common++specMap :: M.Map EventString Key+specMap = M.fromList $ specList++invSpecMap :: M.Map Key EventString+invSpecMap = M.fromList $ fmap swap specList++specList :: [(String, Key)]+specList =+ [ ("<Esc>", KEsc)+ , ("<CR>", KEnter)+ , ("<BS>", KBS)+ , ("<Tab>", KTab)+ , ("<Down>", KDown)+ , ("<Up>", KUp)+ , ("<Left>", KLeft)+ , ("<Right>", KRight)+ , ("<PageUp>", KPageUp)+ , ("<PageDown>", KPageDown)+ , ("<Home>", KHome)+ , ("<End>", KEnd)+ , ("<Ins>", KIns)+ , ("<Del>", KDel)+ ]++stringToEvent :: String -> Event+stringToEvent ('<':'C':'-':c:'>':[]) = ctrlCh c+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 =+ case M.lookup s specMap of+ Just k -> spec k+ Nothing -> error $ "Couldn't convert string <" ++ s ++ "> to event"++eventToString :: Event -> String+eventToString (Event (KASCII '<') []) = "<lt>"+eventToString (Event (KASCII c) []) = [c]+eventToString (Event (KASCII c) [MCtrl]) = ['<', 'C', '-', c, '>']+eventToString (Event (KASCII c) [MShift]) = [toUpper c]+eventToString (Event (KFun x) []) = "<F" ++ show x ++ ">"+eventToString e@(Event k []) =+ case M.lookup k invSpecMap of+ Just s -> s+ Nothing -> error $ "Couldn't convert event <" ++ show e ++ "> to string"+eventToString e = error $ "Couldn't convert event <" ++ show e ++ "> to string"++parseEvents :: String -> [Event]+parseEvents = fst . foldl' go ([], [])+ 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 :: String -> RepeatableAction+stringToRepeatableAction s = RepeatableAction count command+ where (count, command) = splitCountedCommand s++splitCountedCommand :: String -> (Int, String)+splitCountedCommand s = (count, commandString)+ where (countString, commandString) = break (not . isDigit) s+ count = case countString of+ [] -> 1+ _ -> read countString++-- 2d3w -> 6dw+-- 6dw -> 6dw+-- dw -> dw+normalizeCount :: String -> String+normalizeCount s = if null countedObject+ then s+ else show (operatorCount * objectCount) ++ operator ++ object+ where (operatorCount, rest1) = splitCountedCommand s+ (operator, countedObject) = break isDigit rest1+ (objectCount, object) = splitCountedCommand countedObject
+ src/library/Yi/Keymap/Vim2/Ex.hs view
@@ -0,0 +1,39 @@+module Yi.Keymap.Vim2.Ex+ ( exEvalE+ , exEvalY+ , stringToExCommand+ , ExCommand(..)+ , defExCommandParsers+ ) where++import Yi.Keymap.Vim2.Ex.Types+import Yi.Keymap.Vim2.Ex.Eval++import qualified Yi.Keymap.Vim2.Ex.Commands.BufferDelete as BufferDelete+import qualified Yi.Keymap.Vim2.Ex.Commands.Delete as Delete+import qualified Yi.Keymap.Vim2.Ex.Commands.Edit as Edit+import qualified Yi.Keymap.Vim2.Ex.Commands.Global as Global+import qualified Yi.Keymap.Vim2.Ex.Commands.GotoLine as GotoLine+import qualified Yi.Keymap.Vim2.Ex.Commands.Nohl as Nohl+import qualified Yi.Keymap.Vim2.Ex.Commands.Paste as Paste+import qualified Yi.Keymap.Vim2.Ex.Commands.Quit as Quit+import qualified Yi.Keymap.Vim2.Ex.Commands.Reload as Reload+import qualified Yi.Keymap.Vim2.Ex.Commands.Substitute as Substitute+import qualified Yi.Keymap.Vim2.Ex.Commands.Write as Write+import qualified Yi.Keymap.Vim2.Ex.Commands.Yi as Yi++defExCommandParsers :: [String -> Maybe ExCommand]+defExCommandParsers =+ [ BufferDelete.parse+ , Delete.parse+ , Edit.parse+ , Global.parse+ , GotoLine.parse+ , Nohl.parse+ , Paste.parse+ , Quit.parse+ , Reload.parse+ , Substitute.parse+ , Write.parse+ , Yi.parse+ ]
+ src/library/Yi/Keymap/Vim2/Ex/Commands/BufferDelete.hs view
@@ -0,0 +1,21 @@+module Yi.Keymap.Vim2.Ex.Commands.BufferDelete+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import qualified Text.ParserCombinators.Parsec as P++import Yi.Editor+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import qualified Yi.Keymap.Vim2.Ex.Commands.Common as Common++parse :: String -> Maybe ExCommand+parse = Common.parse $ do+ discard $ 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/Vim2/Ex/Commands/Common.hs view
@@ -0,0 +1,97 @@+module Yi.Keymap.Vim2.Ex.Commands.Common+ ( parse+ , parseRange+ , OptionAction(..)+ , parseOption+ , filenameComplete+ , forAllBuffers+ , pureExCommand+ , impureExCommand+ ) where++import Prelude ()+import Yi.Prelude++import Data.Either (either)+import Data.List (isPrefixOf, drop, length)+import System.Directory+import System.FilePath+import qualified Text.ParserCombinators.Parsec as P++import Yi.Buffer+import Yi.Editor+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import Yi.Misc++parse :: P.GenParser Char () ExCommand -> String -> Maybe ExCommand+parse parser s = either (const Nothing) Just (P.parse parser "" s)++parseRange :: P.GenParser Char () LineRange+parseRange = return CurrentLineRange++data OptionAction = Set !Bool | Invert | Ask++parseOption :: String -> (OptionAction -> Action) -> String -> Maybe ExCommand+parseOption name action = parse $ do+ discard $ P.string "set "+ nos <- P.many (P.string "no")+ invs <- P.many (P.string "inv")+ discard $ P.string name+ bangs <- P.many (P.string "!")+ qs <- P.many (P.string "?")+ let + return $ pureExCommand {+ cmdShow = "set " ++ concat nos ++ name ++ concat bangs ++ 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 :: FilePath -> YiM FilePath+removePwd path = do+ pwd <- io getCurrentDirectory+ return $! if (pwd ++ "/") `isPrefixOf` path+ then drop (1 + length pwd) path+ else path++filenameComplete :: FilePath -> YiM [FilePath]+filenameComplete "%" = do+ -- current buffer is minibuffer+ -- actual file is in the second buffer in bufferStack+ bufferRef <- withEditor $ gets (head . drop 1 . bufferStack)+ currentFileName <- withGivenBuffer bufferRef $+ fmap bufInfoFileName bufInfoB++ let sanitizedFileName = case currentFileName of+ ('/':'/':f') -> '/':f'+ _ -> currentFileName++ fmap (:[]) $ removePwd sanitizedFileName++filenameComplete f = do+ files <- matchingFileNames Nothing f++ case files of+ [] -> return []+ [x] -> fmap (:[]) $ removePwd x + xs -> sequence $ fmap removePwd xs++forAllBuffers :: MonadEditor m => (BufferRef -> m ()) -> m ()+forAllBuffers f = mapM_ f =<< readEditor bufferStack++pureExCommand :: ExCommand+pureExCommand = ExCommand {+ cmdIsPure = True+ , cmdComplete = return []+ , cmdAcceptsRange = False+ , cmdAction = undefined+ , cmdShow = undefined+ }++impureExCommand :: ExCommand+impureExCommand = pureExCommand { cmdIsPure = False }
+ src/library/Yi/Keymap/Vim2/Ex/Commands/Delete.hs view
@@ -0,0 +1,23 @@+module Yi.Keymap.Vim2.Ex.Commands.Delete+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import qualified Text.ParserCombinators.Parsec as P++import Yi.Buffer hiding (Delete)+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import qualified Yi.Keymap.Vim2.Ex.Commands.Common as Common++parse :: String -> Maybe ExCommand+parse = Common.parse $ do+ discard $ 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/Vim2/Ex/Commands/Edit.hs view
@@ -0,0 +1,35 @@+module Yi.Keymap.Vim2.Ex.Commands.Edit + ( parse+ ) where++import Prelude ()+import Yi.Prelude++import System.FilePath+import qualified Text.ParserCombinators.Parsec as P++import Yi.Editor+import Yi.File+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import qualified Yi.Keymap.Vim2.Ex.Commands.Common as Common++parse :: String -> Maybe ExCommand+parse = Common.parse $ do+ tab <- P.many (P.string "tab")+ discard $ P.try ( P.string "edit") <|> P.string "e"+ discard $ P.many1 P.space+ filename <- P.many1 P.anyChar+ return $! edit (not (null tab)) filename++edit :: Bool -> FilePath -> ExCommand+edit tab f = Common.impureExCommand {+ cmdShow = showEdit tab f+ , cmdAction = YiA $ do+ when tab $ withEditor newTabE+ discard . editFile $ f+ , cmdComplete = (fmap . fmap) (showEdit tab) (Common.filenameComplete f)+ }++showEdit :: Bool -> FilePath -> String+showEdit tab f = (if tab then "tab" else "") ++ "edit " ++ f
+ src/library/Yi/Keymap/Vim2/Ex/Commands/Global.hs view
@@ -0,0 +1,49 @@+module Yi.Keymap.Vim2.Ex.Commands.Global+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import Data.List (reverse, isInfixOf)+import qualified Text.ParserCombinators.Parsec as P++import Yi.Buffer+import Yi.Editor+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import qualified Yi.Keymap.Vim2.Ex.Commands.Common as Common+import qualified Yi.Keymap.Vim2.Ex.Commands.Delete as Delete+import qualified Yi.Keymap.Vim2.Ex.Commands.Substitute as Substitute++parse :: String -> Maybe ExCommand+parse = Common.parse $ do+ discard $ P.try (P.string "global/") <|> P.string "g/"+ predicate <- P.many (P.noneOf "/")+ discard $ P.char '/'+ cmdString <- P.many P.anyChar+ cmd <- case stringToExCommand allowedCmds cmdString of+ Just c -> return c+ _ -> fail "Unexpected command argument for global command."+ return $! global predicate cmd++global :: String -> ExCommand -> ExCommand+global p c = Common.pureExCommand {+ cmdShow = concat ["g/", p, "/", show c]+ , cmdAction = EditorA $ do+ mark <- withBuffer0 setMarkHereB+ lineCount <- withBuffer0 lineCountB+ forM_ (reverse [1..lineCount]) $ \l -> do+ ln <- withBuffer0 $ gotoLn l >> readLnB+ when (p `isInfixOf` ln) $+ case cmdAction c of+ BufferA action -> withBuffer0 $ discard action+ EditorA action -> discard action+ _ -> error "Impure command as an argument to global."+ withBuffer0 $ do+ getMarkPointB mark >>= moveTo+ deleteMarkB mark+ }++allowedCmds :: [String -> Maybe ExCommand]+allowedCmds = [Delete.parse, Substitute.parse]
+ src/library/Yi/Keymap/Vim2/Ex/Commands/GotoLine.hs view
@@ -0,0 +1,22 @@+module Yi.Keymap.Vim2.Ex.Commands.GotoLine+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import Data.Char (isDigit)++import Yi.Buffer+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import Yi.Keymap.Vim2.Ex.Commands.Common (pureExCommand)++parse :: String -> Maybe ExCommand+parse s = if and $ (not $ null s):(fmap isDigit s)+ then let l = read s in+ Just $ pureExCommand {+ cmdAction = BufferA $ gotoLn l >> firstNonSpaceB+ , cmdShow = s+ }+ else Nothing
+ src/library/Yi/Keymap/Vim2/Ex/Commands/Nohl.hs view
@@ -0,0 +1,22 @@+module Yi.Keymap.Vim2.Ex.Commands.Nohl+ ( parse + ) where++import Prelude ()+import Yi.Prelude++import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import Yi.Keymap.Vim2.Ex.Commands.Common (pureExCommand)+import Yi.Search++parse :: String -> 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/Vim2/Ex/Commands/Paste.hs view
@@ -0,0 +1,26 @@+module Yi.Keymap.Vim2.Ex.Commands.Paste+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import Yi.Editor+import Yi.Keymap+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.Ex.Types+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.Ex.Commands.Common hiding (parse)++parse :: String -> Maybe ExCommand+parse = parseOption "paste" action++action :: OptionAction -> Action+action Ask = EditorA $ do+ value <- vsPaste <$> getDynamic+ printMsg $ "paste = " ++ show 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/Vim2/Ex/Commands/Quit.hs view
@@ -0,0 +1,68 @@+module Yi.Keymap.Vim2.Ex.Commands.Quit+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import Data.Either (either)++import qualified Text.ParserCombinators.Parsec as P++import Yi.Core (quitEditor, errorEditor, closeWindow)+import Yi.Buffer+import Yi.Editor+import Yi.File+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import qualified Yi.Keymap.Vim2.Ex.Commands.Common as Common++parse :: String -> Maybe ExCommand+parse = Common.parse $ do+ ws <- P.many (P.char 'w')+ discard $ 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 = concat+ [ (if w then "w" else "")+ , "quit"+ , (if a then "all" else "")+ , (if f then "!" else "")+ ]+ , cmdAction = YiA $ action w f a+ }++action :: Bool -> Bool -> Bool -> YiM ()+action False False False = closeWindow+action False False True = quitAllE+action True False False = viWrite >> closeWindow+action True False True = saveAndQuitAllE+action False True False = quitEditor+action False True True = quitAllE+action True True False = viWrite >> closeWindow+action True True True = saveAndQuitAllE++quitAllE :: YiM ()+quitAllE = do+ bs <- mapM (\b -> (,) b <$> withEditor (withGivenBuffer0 b needsAWindowB)) =<< readEditor bufferStack+ -- Vim only shows the first modified buffer in the error.+ case find snd bs of+ Nothing -> quitEditor+ Just (b, _) -> do+ bufferName <- withEditor $ withGivenBuffer0 b $ gets file+ errorEditor $ "No write since last change for buffer "+ ++ show bufferName+ ++ " (add ! to override)"++saveAndQuitAllE :: YiM ()+saveAndQuitAllE = Common.forAllBuffers fwriteBufferE >> quitEditor++needsAWindowB :: BufferM Bool+needsAWindowB = do+ isWorthless <- gets (either (const True) (const False) . (^. identA))+ canClose <- gets isUnchangedBuffer+ return (not (isWorthless || canClose))
+ src/library/Yi/Keymap/Vim2/Ex/Commands/Reload.hs view
@@ -0,0 +1,18 @@+module Yi.Keymap.Vim2.Ex.Commands.Reload+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import {-# source #-} Yi.Boot (reload)+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import Yi.Keymap.Vim2.Ex.Commands.Common (impureExCommand)++parse :: String -> Maybe ExCommand+parse "reload" = Just $ impureExCommand {+ cmdShow = "reload"+ , cmdAction = YiA reload+ }+parse _ = Nothing
+ src/library/Yi/Keymap/Vim2/Ex/Commands/Substitute.hs view
@@ -0,0 +1,49 @@+module Yi.Keymap.Vim2.Ex.Commands.Substitute+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import qualified Text.ParserCombinators.Parsec as P++import Yi.Buffer hiding (Delete)+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import qualified Yi.Keymap.Vim2.Ex.Commands.Common as Common+import Yi.Search++parse :: String -> Maybe ExCommand+parse = Common.parse $ do+ percents <- P.many (P.char '%')+ discard $ P.try (P.string "substitute/") <|> P.string "s/"+ from <- P.many (P.noneOf "/")+ discard $ P.char '/'+ to <- P.many (P.noneOf "/")+ discard $ P.char '/'+ flagChars <- P.many (P.oneOf "gi")+ return $! substitute from to+ ('g' `elem` flagChars)+ ('i' `elem` flagChars)+ (not $ null percents)++substitute :: String -> String -> Bool -> Bool -> Bool -> ExCommand+substitute from to global caseInsensitive allLines = Common.pureExCommand {+ cmdShow = concat+ [ if allLines then "%" else ""+ , "substitute/" , from , "/" , to , "/"+ , if caseInsensitive then "i" else ""+ , if global then "g" else ""+ ]+ , cmdAction = BufferA $ do+ let regex = makeSimpleSearch from+ replace = do+ region <- regionOfB Line+ discard $ searchAndRepRegion0 regex to global region++ if allLines+ then withEveryLineB replace+ else replace++ moveToSol+ }
+ src/library/Yi/Keymap/Vim2/Ex/Commands/Write.hs view
@@ -0,0 +1,40 @@+module Yi.Keymap.Vim2.Ex.Commands.Write+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import System.FilePath++import qualified Text.ParserCombinators.Parsec as P++import Yi.File+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import qualified Yi.Keymap.Vim2.Ex.Commands.Common as Common++parse :: String -> Maybe ExCommand+parse = Common.parse $ P.choice [parseWrite, parseWriteAs]+ where parseWrite = do+ discard $ 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+ discard $ P.try ( P.string "write") <|> P.string "w"+ discard $ P.many1 P.space+ filename <- 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 :: FilePath -> ExCommand+writeAsCmd filename = Common.impureExCommand {+ cmdShow = "write " ++ filename+ , cmdAction = YiA $ viWriteTo filename+ }
+ src/library/Yi/Keymap/Vim2/Ex/Commands/Yi.hs view
@@ -0,0 +1,23 @@+module Yi.Keymap.Vim2.Ex.Commands.Yi+ ( parse+ ) where++import Prelude ()+import Yi.Prelude++import qualified Text.ParserCombinators.Parsec as P++import Yi.Eval (execEditorAction)+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types+import qualified Yi.Keymap.Vim2.Ex.Commands.Common as Common++parse :: String -> Maybe ExCommand+parse = Common.parse $ do+ discard $ P.string "yi"+ discard $ P.many1 P.space+ cmd <- P.many1 P.anyChar+ return $! Common.impureExCommand {+ cmdAction = YiA $ execEditorAction cmd+ , cmdShow = cmd+ }
+ src/library/Yi/Keymap/Vim2/Ex/Eval.hs view
@@ -0,0 +1,29 @@+module Yi.Keymap.Vim2.Ex.Eval+ ( exEvalE+ , exEvalY+ ) where++import Prelude ()+import Yi.Prelude++import Yi.Editor+import Yi.Keymap+import Yi.Keymap.Vim2.Ex.Types++exEvalE :: [String -> Maybe ExCommand] -> String -> EditorM ()+exEvalE cmds cmdString = evalHelper id (const $ error msg) cmds cmdString+ where msg = "exEvalE got impure command" ++ cmdString++exEvalY :: [String -> Maybe ExCommand] -> String -> YiM ()+exEvalY = evalHelper withEditor id++evalHelper :: MonadEditor m =>+ (EditorM () -> m ()) -> (YiM () -> m ()) ->+ [String -> Maybe ExCommand] -> String -> m ()+evalHelper pureHandler impureHandler cmds cmdString =+ case stringToExCommand cmds cmdString of+ Just cmd -> case cmdAction cmd of+ BufferA actionB -> pureHandler $ withBuffer0 (discard actionB)+ EditorA actionE -> pureHandler (discard actionE)+ YiA actionY -> impureHandler (discard actionY)+ _ -> return ()
+ src/library/Yi/Keymap/Vim2/Ex/Types.hs view
@@ -0,0 +1,27 @@+module Yi.Keymap.Vim2.Ex.Types where++import Prelude ()+import Yi.Prelude++import Data.Maybe++import Yi.Keymap++data ExCommand = ExCommand {+ cmdComplete :: YiM [String]+ , cmdIsPure :: Bool+ , cmdAction :: Action+ , cmdAcceptsRange :: Bool+ , cmdShow :: String+}++instance Show ExCommand where+ show = cmdShow++data LineRange+ = MarkRange String String -- ^ 'a,'b+ | FullRange -- ^ %+ | CurrentLineRange++stringToExCommand :: [String -> Maybe ExCommand] -> String -> Maybe ExCommand+stringToExCommand parsers s = listToMaybe . mapMaybe ($ s) $ parsers
+ src/library/Yi/Keymap/Vim2/ExMap.hs view
@@ -0,0 +1,184 @@+module Yi.Keymap.Vim2.ExMap+ ( defExMap+ ) where++import Prelude (unwords, drop, length, reverse)+import Yi.Prelude++import Data.Char (isSpace)+import Data.Maybe (fromJust)+import Data.List.Split (splitWhen)+import System.FilePath (isPathSeparator)++import Yi.Buffer hiding (Insert)+import Yi.Editor+import Yi.History+import Yi.Keymap+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.Utils+import Yi.Keymap.Vim2.Ex++defExMap :: [String -> Maybe ExCommand] -> [VimBinding]+defExMap cmdParsers =+ [ exitBinding+ , completionBinding cmdParsers+ , finishBindingY cmdParsers+ , finishBindingE cmdParsers+ , failBindingE+ , historyBinding+ , printable+ ]++completionBinding :: [String -> Maybe ExCommand] -> VimBinding+completionBinding commandParsers = VimBindingY prereq action+ where prereq evs (VimState { vsMode = Ex }) = matchFromBool $ evs == "<Tab>"+ prereq _ _ = NoMatch+ action :: EventString -> YiM RepeatToken+ action _ = do+ commandString <- withEditor . withBuffer0 $ elemsB+ case stringToExCommand commandParsers commandString of+ Just cmd -> complete cmd+ Nothing -> return ()+ return Drop+ complete :: ExCommand -> YiM ()+ complete cmd = do+ possibilities <- cmdComplete cmd+ case possibilities of+ [] -> return ()+ (s:[]) -> updateCommand s+ ss -> do+ let s = commonPrefix ss+ updateCommand s+ withEditor + . printMsg + . unwords + . fmap (dropToLastWordOf s)+ $ ss+ updateCommand :: String -> YiM ()+ updateCommand s = do+ withBuffer $ replaceBufferContent s+ withEditor $ do+ historyPrefixSet s+ modifyStateE $ \state -> state {+ vsOngoingInsertEvents = s+ }++dropToLastWordOf :: String -> String -> String+dropToLastWordOf s =+ case reverse . splitWhen isWordSep $ s of+ [] -> id+ (_w:[]) -> id+ (_w:ws) -> drop . (+1) . length . unwords $ ws+ where+ isWordSep :: Char -> Bool+ isWordSep c = isPathSeparator c || isSpace c++exitEx :: Bool -> EditorM ()+exitEx success = do+ if success then historyFinish else return ()+ resetCountE+ switchModeE Normal+ closeBufferAndWindowE++exitBinding :: VimBinding+exitBinding = VimBindingE prereq action+ where prereq "<CR>" (VimState { vsMode = Ex, vsOngoingInsertEvents = [] })+ = WholeMatch ()+ prereq evs (VimState { vsMode = Ex })+ = matchFromBool $ evs `elem` ["<Esc>", "<C-c>"]+ prereq _ _ = NoMatch+ action _ = do+ exitEx False+ return Drop++finishBindingY :: [String -> Maybe ExCommand] -> VimBinding+finishBindingY commandParsers = VimBindingY+ (finishPrereq commandParsers (not . cmdIsPure))+ (const $ finishAction commandParsers exEvalY)++finishBindingE :: [String -> Maybe ExCommand] -> VimBinding+finishBindingE commandParsers = VimBindingE+ (finishPrereq commandParsers cmdIsPure)+ (const $ finishAction commandParsers exEvalE)++finishPrereq :: [String -> Maybe ExCommand] -> (ExCommand -> Bool)+ -> EventString -> VimState -> MatchResult ()+finishPrereq commandParsers cmdPred evs s =+ matchFromBool . and $+ [ vsMode s == Ex+ , evs == "<CR>"+ , case stringToExCommand commandParsers (vsOngoingInsertEvents s) of+ Just cmd -> cmdPred cmd+ _ -> False+ ]++finishAction :: MonadEditor m => [String -> Maybe ExCommand] ->+ ([String -> Maybe ExCommand] -> String -> m ()) -> m RepeatToken+finishAction commandParsers execute = do+ s <- withEditor $ withBuffer0 elemsB+ withEditor $ exitEx True+ execute commandParsers s+ return Drop++failBindingE :: VimBinding+failBindingE = VimBindingE prereq action+ where prereq evs s = matchFromBool . and $ [vsMode s == Ex, evs == "<CR>"]+ action _ = do+ exitEx False+ printMsg "Unknown command"+ return Drop++printable :: VimBinding+printable = VimBindingE prereq editAction+ where prereq _ (VimState { vsMode = Ex }) = WholeMatch ()+ prereq _ _ = NoMatch++historyBinding :: VimBinding+historyBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = Ex }) =+ matchFromBool $ evs `elem` (fmap fst binds)+ prereq _ _ = NoMatch+ action evs = do+ fromJust $ lookup evs binds+ command <- withBuffer0 elemsB+ modifyStateE $ \state -> state {+ vsOngoingInsertEvents = command+ }+ return Drop+ binds =+ [ ("<Up>", historyUp)+ , ("<C-p>", historyUp)+ , ("<Down>", historyDown)+ , ("<C-n>", historyDown)+ ]++editAction :: EventString -> EditorM RepeatToken+editAction evs = do+ withBuffer0 $ case evs of+ (c:[]) -> insertB c+ "<BS>" -> deleteB Character Backward+ "<C-h>" -> deleteB Character Backward+ "<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' -> error $ "Unhandled event " ++ evs' ++ " in ex mode"+ command <- withBuffer0 elemsB+ historyPrefixSet command+ modifyStateE $ \state -> state {+ vsOngoingInsertEvents = command+ }+ return Drop
+ src/library/Yi/Keymap/Vim2/InsertMap.hs view
@@ -0,0 +1,206 @@+module Yi.Keymap.Vim2.InsertMap+ ( defInsertMap+ ) where++import Yi.Prelude+import Prelude ()++import Control.Monad (replicateM_)+import Data.Char (isDigit)+import Data.List (break, drop, dropWhile)+import Data.Maybe (maybe)++import Yi.Buffer hiding (Insert)+import Yi.Editor+import Yi.Event+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.Digraph+import Yi.Keymap.Vim2.EventUtils+import Yi.Keymap.Vim2.Motion+import Yi.Keymap.Vim2.Utils+import Yi.Keymap.Vim2.StateUtils+import Yi.TextCompletion (completeWordB)++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 prereq action+ where prereq evs (VimState { vsMode = (Insert _) }) =+ matchFromBool $ evs `elem` ["<Esc>", "<C-c>"]+ prereq _ _ = NoMatch+ action _ = do+ count <- getCountE+ (Insert starter) <- fmap vsMode getDynamic+ when (count > 1) $ do+ inputEvents <- fmap (parseEvents . vsOngoingInsertEvents) getDynamic+ replicateM_ (count - 1) $ do+ when (starter `elem` "Oo") $ withBuffer0 $ insertB '\n'+ replay digraphs inputEvents+ modifyStateE $ \s -> s { vsOngoingInsertEvents = "" }+ withBuffer0 $ moveXorSol 1+ modifyStateE $ \s -> s { vsSecondaryCursors = [] }+ resetCountE+ switchModeE Normal+ withBuffer0 $ do+ whenM isCurrentLineAllWhiteSpaceB $ moveToSol >> deleteToEol+ return Finish++rawPrintable :: VimBinding+rawPrintable = VimBindingE prereq action+ where prereq evs s@(VimState { vsMode = (Insert _)}) =+ matchFromBool $ vsPaste s && evs `notElem` ["<Esc>", "<C-c>"]+ prereq _ _ = NoMatch+ action evs = withBuffer0 $ do+ case evs of+ "<lt>" -> insertB '<'+ "<CR>" -> newlineB+ "<Tab>" -> insertB '\t'+ "<BS>" -> deleteB Character Backward+ "<C-h>" -> deleteB Character Backward+ "<Del>" -> deleteB Character Forward+ c -> insertN c+ return Continue++replay :: [(String, Char)] -> [Event] -> EditorM ()+replay _ [] = return ()+replay digraphs (e1:es1) = do+ state <- getDynamic+ let recurse = replay digraphs+ evs1 = eventToString e1+ bindingMatch1 = selectBinding evs1 state (defInsertMap digraphs)+ case bindingMatch1 of+ WholeMatch (VimBindingE _ action) -> discard (action evs1) >> recurse es1+ PartialMatch -> do+ case es1 of+ [] -> return ()+ (e2:es2) -> do+ let evs2 = evs1 ++ eventToString e2+ bindingMatch2 = selectBinding evs2 state (defInsertMap digraphs)+ case bindingMatch2 of+ WholeMatch (VimBindingE _ action) -> discard (action evs2) >> recurse es2+ _ -> recurse es2+ _ -> recurse es1++oneshotNormalBinding :: VimBinding+oneshotNormalBinding = VimBindingE prereq action+ where prereq "<C-o>" (VimState { vsMode = Insert _ }) = PartialMatch+ prereq ('<':'C':'-':'o':'>':evs) (VimState { vsMode = Insert _ }) =+ fmap (const ()) (stringToMove (dropWhile isDigit evs))+ prereq _ _ = NoMatch+ action ('<':'C':'-':'o':'>':evs) = do+ let (countString, motionCmd) = break (not . isDigit) evs+ WholeMatch (Move _style _isJump move) = stringToMove motionCmd+ withBuffer0 $ move (if null countString then Nothing else Just (read countString))+ return Continue+ action _ = error "can't happen"++pasteRegisterBinding :: VimBinding+pasteRegisterBinding = VimBindingE prereq action+ where prereq "<C-r>" (VimState { vsMode = Insert _ }) = PartialMatch+ prereq ('<':'C':'-':'r':'>':_c1:[]) (VimState { vsMode = Insert _ }) = WholeMatch ()+ prereq _ _ = NoMatch+ action evs = do+ let regName = last evs+ mr <- getRegisterE regName+ case mr of+ Nothing -> return ()+ Just (Register _style rope) -> withBuffer0 $ do+ insertRopeWithStyleB rope Inclusive+ return Continue++digraphBinding :: [(String, Char)] -> VimBinding+digraphBinding digraphs = VimBindingE prereq action+ where prereq ('<':'C':'-':'k':'>':_c1:_c2:[]) (VimState { vsMode = Insert _ }) = WholeMatch ()+ prereq ('<':'C':'-':'k':'>':_c1:[]) (VimState { vsMode = Insert _ }) = PartialMatch+ prereq "<C-k>" (VimState { vsMode = Insert _ }) = PartialMatch+ prereq _ _ = NoMatch+ action ('<':'C':'-':'k':'>':c1:c2:[]) = do+ maybe (return ()) (withBuffer0 . insertB) $ charFromDigraph digraphs c1 c2+ return Continue+ action _ = error "can't happen"++-- TODO: split this binding into printable and specials+printable :: VimBinding+printable = VimBindingE prereq printableAction+ where prereq evs state@(VimState { vsMode = Insert _ } ) =+ matchFromBool $+ all (\b -> case vbPrerequisite b evs state of+ NoMatch -> True+ _ -> False) (specials undefined)+ prereq _ _ = NoMatch++printableAction :: EventString -> EditorM RepeatToken+printableAction evs = do+ saveInsertEventStringE evs+ currentCursor <- withBuffer0 pointB+ secondaryCursors <- fmap vsSecondaryCursors getDynamic+ let allCursors = currentCursor:secondaryCursors+ marks <- withBuffer0 $ forM allCursors $ \cursor -> do+ moveTo cursor+ -- getMarkB $ Just $ "v_I" ++ show cursor+ getMarkB Nothing+ let bufAction = case evs of+ (c:[]) -> insertB c+ "<CR>" -> do+ isOldLineEmpty <- isCurrentLineEmptyB+ shouldTrimOldLine <- isCurrentLineAllWhiteSpaceB+ if isOldLineEmpty+ then do+ newlineB+ else if shouldTrimOldLine+ then savingPointB $ do+ moveToSol+ newlineB+ else do+ newlineB+ indentAsPreviousB+ firstNonSpaceB+ -- For testing purposes assume noexpandtab, tw=4+ "<Tab>" -> insertN $ replicate 4 ' '+ "<C-t>" -> shiftIndentOfRegion 1 =<< regionOfB Line+ "<C-d>" -> shiftIndentOfRegion (-1) =<< regionOfB Line+ "<C-e>" -> insertCharWithBelowB+ "<C-y>" -> insertCharWithAboveB+ "<BS>" -> deleteB Character Backward+ "<C-h>" -> deleteB Character Backward+ "<Del>" -> deleteB Character Forward+ "<C-w>" -> deleteRegionB =<< regionOfPartNonEmptyB unitViWordOnLine Backward+ "<lt>" -> insertB '<'+ evs' -> error $ "Unhandled event " ++ evs' ++ " in insert mode"+ updatedCursors <- withBuffer0 $ do+ updatedCursors <- forM marks $ \mark -> do+ moveTo =<< getMarkPointB mark+ bufAction+ pointB+ mapM_ deleteMarkB marks+ moveTo $ head updatedCursors+ return updatedCursors+ modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 updatedCursors }+ return Continue++completionBinding :: VimBinding+completionBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = (Insert _) }) =+ matchFromBool $ evs `elem` ["<C-n>", "<C-p>"]+ prereq _ _ = NoMatch+ action evs = do+ let _direction = if evs == "<C-n>" then Forward else Backward+ completeWordB+ return Continue++cursorBinding :: VimBinding+cursorBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = (Insert _) }) =+ matchFromBool $ evs `elem` ["<Up>", "<Left>", "<Down>", "<Right>"]+ prereq _ _ = NoMatch+ action evs = do+ let WholeMatch (Move _style _isJump move) = stringToMove evs+ withBuffer0 $ move Nothing+ return Continue
+ src/library/Yi/Keymap/Vim2/MatchResult.hs view
@@ -0,0 +1,43 @@+module Yi.Keymap.Vim2.MatchResult where++import Yi.Prelude+import Prelude ()++import Data.List (isPrefixOf)++data MatchResult a = NoMatch+ | PartialMatch+ | WholeMatch a++-- like Data.List.lookup, but with MatchResult instead of Maybe+lookupBestMatch :: String -> [(String, a)] -> MatchResult a+lookupBestMatch key = foldl go NoMatch+ where go m (k, x) = m <|> fmap (const x) (key `matchesString` k)++matchesString :: String -> String -> MatchResult ()+matchesString got expected | expected == got = WholeMatch ()+ | got `isPrefixOf` expected = PartialMatch+ | otherwise = NoMatch++instance Functor MatchResult where+ fmap f (WholeMatch x) = WholeMatch (f x)+ fmap _ NoMatch = NoMatch+ fmap _ PartialMatch = PartialMatch++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/Vim2/Motion.hs view
@@ -0,0 +1,211 @@+module Yi.Keymap.Vim2.Motion+ ( Move(..)+ , CountedMove(..)+ , stringToMove + , regionOfMoveB+ , changeMoveStyle+ ) where++-- TODO:+--+-- respecting wrap in gj, g0, etc+--+-- gm, go+-- ]], [[, [], ][+-- [(, [{, ]), ]}+-- ]m, ]M, [m, [M+-- [#, ]#+-- [*, [/, ]*, ]/+-- H, M, L+--+-- 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.++import Prelude ()+import Yi.Prelude++import Control.Monad (replicateM_)++import Data.Maybe (fromMaybe)+import Data.Tuple (uncurry)++import Yi.Buffer+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.StyledRegion++data Move = Move {+ moveStyle :: !RegionStyle+ , moveIsJump :: !Bool+ , moveAction :: (Maybe Int -> BufferM ())+ }++data CountedMove = CountedMove !(Maybe Int) !Move++stringToMove :: String -> MatchResult Move+stringToMove s = lookupMove s+ <|> matchGotoCharMove s+ <|> matchGotoMarkMove s++lookupMove :: String -> 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++instance Functor ((,,) a b) where+ fmap f (a, b, c) = (a, b, f c)++-- Linewise motions which treat no count as being the same as a count of 1.+linewiseMotions :: [(String, Bool, Maybe Int -> BufferM ())]+linewiseMotions = fmap withDefaultCount+ [ ("j", False, discard . lineMoveRel)+ , ("k", False, discard . lineMoveRel . negate)+ , ("<Down>", False, discard . lineMoveRel)+ , ("<Up>", False, discard . lineMoveRel . negate)+ , ("-", False, const firstNonSpaceB <=< discard . lineMoveRel . negate)+ , ("+", False, const firstNonSpaceB <=< discard . lineMoveRel)+ , ("_", False, \n -> do+ when (n > 1) $ discard $ lineMoveRel (n - 1)+ firstNonSpaceB)+ , ("gg", True, discard . gotoLn) -- TODO: save column+ , ("<C-b>", False, scrollScreensB . negate)+ , ("<PageUp>", False, scrollScreensB . negate)+ , ("<C-f>", False, scrollScreensB)+ , ("<PageDown>", False, scrollScreensB)+ ]+ ++ [("G", True, gotoXOrEOF)]++-- Exclusive motions which treat no count as being the same as a count of 1.+exclusiveMotions :: [(String, 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 :: [(String, 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) $ discard $ lineMoveRel (n - 1)+ moveToEol)+ , ("<End>", const $ moveToEol >> leftOnEol)+ , ("$", \n -> do+ when (n > 1) $ discard $ lineMoveRel (n - 1)+ moveToEol+ leftOnEol)+ , ("g_", \n -> do+ when (n > 1) $ discard $ 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 :: (String, Bool, Int -> BufferM ()) -> (String, Bool, Maybe Int -> BufferM ())+withDefaultCount = fmap (. 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 =<< getMarkPointB 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/Vim2/NormalMap.hs view
@@ -0,0 +1,374 @@+module Yi.Keymap.Vim2.NormalMap+ ( defNormalMap+ ) where++import Yi.Prelude+import Prelude ()++import Control.Monad (replicateM_)++import Data.Char+import Data.List (group)+import Data.Maybe (fromMaybe)+import qualified Data.Rope as R++import Yi.Buffer hiding (Insert)+import Yi.Editor+import Yi.Event+import Yi.History+import Yi.Keymap.Keys+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.Eval+import Yi.Keymap.Vim2.Motion+import Yi.Keymap.Vim2.Operator+import Yi.Keymap.Vim2.Search+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.StyledRegion+import Yi.Keymap.Vim2.Utils+import Yi.MiniBuffer+import Yi.Misc+import Yi.Regex (seInput, makeSearchOptsM)+import Yi.Search (getRegexE, isearchInitE, setRegexE, makeSimpleSearch)++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 =+ [zeroBinding, repeatBinding, motionBinding, searchBinding] +++ [chooseRegisterBinding, setMarkBinding] +++ fmap mkDigitBinding ['1' .. '9'] +++ operatorBindings operators +++ finishingBingings +++ continuingBindings +++ nonrepeatableBindings +++ jumpBindings +++ [tabTraversalBinding]++motionBinding :: VimBinding+motionBinding = mkMotionBinding Drop $+ \m -> case m of+ Normal -> True+ _ -> False++chooseRegisterBinding :: VimBinding+chooseRegisterBinding = mkChooseRegisterBinding ((== Normal) . vsMode)++zeroBinding :: VimBinding+zeroBinding = VimBindingE prereq action+ where prereq evs state = matchFromBool $ evs == "0" && (vsMode state == Normal)+ action _ = do+ currentState <- getDynamic+ case vsCount currentState of+ Just c -> do+ setDynamic $ currentState { vsCount = Just (10 * c) }+ return Continue+ Nothing -> do+ withBuffer0 moveToSol+ setDynamic $ resetCount currentState+ return Drop++repeatBinding :: VimBinding+repeatBinding = VimBindingE prereq action+ where prereq evs state = matchFromBool $ evs == "." && (vsMode state == Normal)+ action _ = do+ currentState <- getDynamic+ case vsRepeatableAction currentState of+ Nothing -> return ()+ Just (RepeatableAction prevCount actionString) -> do+ let count = fromMaybe prevCount (vsCount currentState)+ scheduleActionStringForEval $ show count ++ actionString+ resetCountE+ return Drop++jumpBindings :: [VimBinding]+jumpBindings = fmap (mkBindingE Normal Drop)+ [ (ctrlCh 'o', jumpBackE, id)+ , (spec KTab, jumpForwardE, id)+ ]++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 <- withBuffer0 $ regionWithTwoMovesB (return ()) moveToEol+ discard $ operatorApplyToRegionE opDelete 1 $ StyledRegion Exclusive region+ , id)++ -- Pasting+ , ("p", pasteAfter, id)+ , ("P", pasteBefore, id)++ -- Miscellaneous.+ , ("~", do+ count <- getCountE+ withBuffer0 $ do+ transformCharactersInLineN count switchCaseChar+ leftOnEol+ , resetCount)+ , ("J", do+ count <- fmap (flip (-) 1 . max 2) getCountE+ withBuffer0 $ do+ (StyledRegion s r) <- case stringToMove "j" of+ WholeMatch m -> regionOfMoveB $ CountedMove (Just count) m+ _ -> error "can't happen"+ discard $ lineMoveRel $ count - 1+ moveToEol+ joinLinesB =<< convertRegionToStyleB r s+ , resetCount)+ ]++pasteBefore :: EditorM ()+pasteBefore = do+ -- TODO: use count+ register <- getRegisterE . vsActiveRegister =<< getDynamic+ case register of+ Nothing -> return ()+ Just (Register LineWise rope) -> withBuffer0 $ when (not $ R.null rope) $+ -- Beware of edge cases ahead+ insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise+ Just (Register style rope) -> withBuffer0 $ pasteInclusiveB rope style++pasteAfter :: EditorM ()+pasteAfter = do+ -- TODO: use count+ register <- getRegisterE . vsActiveRegister =<< getDynamic+ case register of+ Nothing -> return ()+ Just (Register LineWise rope) -> withBuffer0 $ 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) -> withBuffer0 $ do+ whenM (fmap not atEol) rightB+ pasteInclusiveB rope style++operatorBindings :: [VimOperator] -> [VimBinding]+operatorBindings = fmap mkOperatorBinding+ where mkOperatorBinding (VimOperator {operatorName = opName}) =+ mkStringBindingE Normal (if opName == "y" then Drop else Continue)+ (opName, return (), switchMode (NormalOperatorPending 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", withBuffer0 firstNonSpaceB, switchMode $ Insert 'I')+ , ("a", withBuffer0 rightB, switchMode $ Insert 'a')+ , ("A", withBuffer0 moveToEol, switchMode $ Insert 'A')+ , ("o", withBuffer0 $ do+ moveToEol+ newlineAndIndentB+ , switchMode $ Insert 'o')+ , ("O", withBuffer0 $ 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 <- withBuffer0 $ regionWithTwoMovesB (return ()) moveToEol+ discard $ operatorApplyToRegionE opDelete 1 $ StyledRegion Exclusive region+ , switchMode $ Insert 'C')+ , (char 's', cutCharE Forward =<< getCountE, switchMode $ Insert 's')+ , (char 'S',+ do region <- withBuffer0 $ regionWithTwoMovesB firstNonSpaceB moveToEol+ discard $ operatorApplyToRegionE opDelete 1 $ StyledRegion Exclusive region+ , switchMode $ Insert 'S')++ -- Replacing+ , (char 'R', return (), switchMode Replace)++ -- Yanking+ , (char 'Y',+ do region <- withBuffer0 $ regionWithTwoMovesB (return ()) moveToEol+ discard $ operatorApplyToRegionE opYank 1 $ StyledRegion Exclusive region+ , id)++ -- Search+ , (char '*', addJumpHereE >> searchWordE True Forward, resetCount)+ , (char '#', addJumpHereE >> searchWordE True Backward, resetCount)+ , (char 'n', addJumpHereE >> (withCount $ continueSearching id), resetCount)+ , (char 'N', addJumpHereE >> (withCount $ continueSearching reverseDir), resetCount)+ , (char ';', repeatGotoCharE id, id)+ , (char ',', repeatGotoCharE reverseDir, id)++ -- Repeat+ , (char '&', return (), id) -- TODO++ -- Transition to ex+ , (char ':', do+ discard (spawnMinibufferE ":" id)+ historyStart+ historyPrefixSet ""+ , switchMode Ex)++ -- Undo+ , (char 'u', withCountOnBuffer0 undoB >> withBuffer0 leftOnEol, id)+ , (char 'U', withCountOnBuffer0 undoB >> withBuffer0 leftOnEol, id) -- TODO+ , (ctrlCh 'r', withCountOnBuffer0 redoB >> withBuffer0 leftOnEol, id)++ -- scrolling+ ,(ctrlCh 'b', getCountE >>= withBuffer0 . upScreensB, id)+ ,(ctrlCh 'f', getCountE >>= withBuffer0 . downScreensB, id)+ ,(ctrlCh 'u', getCountE >>= withBuffer0 . vimScrollByB (negate . (`div` 2)), id)+ ,(ctrlCh 'd', getCountE >>= withBuffer0 . vimScrollByB (`div` 2), id)+ ,(ctrlCh 'y', getCountE >>= withBuffer0 . vimScrollB . negate, id)+ ,(ctrlCh 'e', getCountE >>= withBuffer0 . vimScrollB, id)++ -- unsorted TODO+ , (char '-', return (), id)+ , (char '+', return (), id)+ , (char 'q', return (), id)+ , (spec KEnter, return (), id)+ ] ++ fmap (mkStringBindingE Normal Drop)+ [ ("g*", searchWordE False Forward, resetCount)+ , ("g#", searchWordE False Backward, 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)+ ]++setMarkBinding :: VimBinding+setMarkBinding = VimBindingE prereq action+ where prereq _ s | vsMode s /= Normal = NoMatch+ prereq "m" _ = PartialMatch+ prereq ('m':_:[]) _ = WholeMatch ()+ prereq _ _ = NoMatch+ action ('m':c:[]) = do+ withBuffer0 $ setNamedMarkHereB [c]+ return Drop+ action _ = error "Can't happen"++searchWordE :: Bool -> Direction -> EditorM ()+searchWordE wholeWord dir = do+ word <- withBuffer0 readCurrentWordB++ let search re = do+ setRegexE re+ putA searchDirectionA dir+ withCount $ continueSearching (const dir)++ if wholeWord+ then case makeSearchOptsM [] $ "\\<" ++ word ++ "\\>" of+ Right re -> search re+ Left _ -> return ()+ else search $ makeSimpleSearch word+++searchBinding :: VimBinding+searchBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = Normal }) = matchFromBool $ evs `elem` group "/?"+ prereq _ _ = NoMatch+ action evs = do+ state <- fmap vsMode getDynamic+ let dir = if evs == "/" then Forward else Backward+ switchModeE $ Search state dir+ isearchInitE dir+ historyStart+ historyPrefixSet ""+ return Continue++continueSearching :: (Direction -> Direction) -> EditorM ()+continueSearching fdir = do+ mbRegex <- getRegexE+ case mbRegex of+ Just regex -> do+ dir <- fdir <$> getA searchDirectionA+ printMsg $ (if dir == Forward then '/' else '?') : seInput regex+ discard $ doVimSearch Nothing [] dir+ Nothing -> printMsg "No previous search pattern"++repeatGotoCharE :: (Direction -> Direction) -> EditorM ()+repeatGotoCharE mutateDir = do+ prevCommand <- fmap vsLastGotoCharCommand getDynamic+ count <- getCountE+ withBuffer0 $ 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 = withBuffer0 $ do+ putA regionStyleA style+ putA rectangleSelectionA $ Block == style+ setVisibleSelection True+ pointB >>= setSelectionMarkPointB++cutCharE :: Direction -> Int -> EditorM ()+cutCharE dir count = do+ r <- withBuffer0 $ 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 getDynamic+ setRegisterE regName Inclusive r++tabTraversalBinding :: VimBinding+tabTraversalBinding = VimBindingE prereq action+ where prereq "g" (VimState { vsMode = Normal }) = PartialMatch+ prereq ('g':c:[]) (VimState { vsMode = Normal }) | c `elem` "tT" = WholeMatch ()+ prereq _ _ = NoMatch+ action ('g':c:[]) = do+ count <- getCountE+ replicateM_ count $ if c == 'T' then previousTabE else nextTabE+ resetCountE+ return Drop+ action _ = error "can't happen"++-- 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 $ withBuffer0 action
+ src/library/Yi/Keymap/Vim2/NormalOperatorPendingMap.hs view
@@ -0,0 +1,154 @@+module Yi.Keymap.Vim2.NormalOperatorPendingMap+ ( defNormalOperatorPendingMap+ ) where++import Prelude ()+import Yi.Prelude++import Data.Char (isDigit)+import Data.List (isPrefixOf, drop)+import Data.Maybe (fromMaybe, fromJust)++import Yi.Buffer hiding (Insert)+import Yi.Editor+import Yi.Keymap.Keys+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.Motion+import Yi.Keymap.Vim2.Operator+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.StyledRegion+import Yi.Keymap.Vim2.TextObject+import Yi.Keymap.Vim2.Utils++defNormalOperatorPendingMap :: [VimOperator] -> [VimBinding]+defNormalOperatorPendingMap operators = [textObject operators, escBinding]++textObject :: [VimOperator] -> VimBinding+textObject operators = VimBindingE prereq action+ where+ prereq _ vs = case vsMode vs of+ NormalOperatorPending _ -> WholeMatch ()+ _ -> NoMatch+ action evs = do+ currentState <- getDynamic++ let partial = vsTextObjectAccumulator currentState+ opChar = lastCharForOperator op+ op = fromJust $ stringToOperator operators opname+ (NormalOperatorPending opname) = vsMode currentState++ -- vim treats cw as ce+ let evs' = if opname == "c" &&+ last evs == 'w' &&+ (case parseOperand opChar (partial ++ evs) of+ JustMove _ -> True+ _ -> False)+ then init evs ++ "e"+ else evs+ operand = parseOperand opChar (partial ++ evs')++ case operand of+ NoOperand -> do+ dropTextObjectAccumulatorE+ resetCountE+ switchModeE Normal+ return Drop+ PartialOperand -> do+ accumulateTextObjectEventE 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 <- withBuffer0 $ regionOfMoveB $ CountedMove (maybeMult mcount n) m+ operatorApplyToRegionE op 1 region+ JustOperator n style -> do+ normalizeCountE (Just n)+ normalizedCount <- getCountE+ region <- withBuffer0 $ regionForOperatorLineB normalizedCount style+ curPoint <- withBuffer0 pointB+ token <- operatorApplyToRegionE op 1 region+ when (opname == "y") $+ withBuffer0 $ 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+ discard $ 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"++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)+parseCommand n sm _ s =+ case stringToMove 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/Vim2/Operator.hs view
@@ -0,0 +1,161 @@+module Yi.Keymap.Vim2.Operator+ ( VimOperator(..)+ , defOperators+ , opDelete+ , opChange+ , opYank+ , opFormat+ , stringToOperator+ , mkCharTransformOperator+ , operatorApplyToTextObjectE+ , lastCharForOperator+ ) where++import Prelude ()+import Yi.Prelude++import Data.Char (toLower, toUpper)+import Data.List (isSuffixOf)++import Yi.Buffer hiding (Insert)+import Yi.Editor+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.StyledRegion+import Yi.Keymap.Vim2.TextObject+import Yi.Keymap.Vim2.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 <- withBuffer0 $ regionOfTextObjectB cto+ operatorApplyToRegionE op count styledRegion++opYank :: VimOperator+opYank = VimOperator {+ operatorName = "y"+ , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do+ s <- withBuffer0 $ readRegionRopeWithStyleB reg style+ regName <- fmap vsActiveRegister getDynamic+ setRegisterE regName style s+ withBuffer0 $ moveTo . regionStart =<< convertRegionToStyleB reg style+ switchModeE Normal+ return Finish+}++opDelete :: VimOperator+opDelete = VimOperator {+ operatorName = "d"+ , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do+ s <- withBuffer0 $ readRegionRopeWithStyleB reg style+ regName <- fmap vsActiveRegister getDynamic+ setRegisterE regName style s+ withBuffer0 $ 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 <- withBuffer0 $ readRegionRopeWithStyleB reg style+ regName <- fmap vsActiveRegister getDynamic+ setRegisterE regName style s+ withBuffer0 $ do+ point <- deleteRegionWithStyleB reg style+ moveTo point+ switchModeE $ Insert 'c'+ return Continue+}++opFormat :: VimOperator+opFormat = VimOperator {+ operatorName = "gq"+ , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do+ withBuffer0 $ 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+ if p >= end+ then return ()+ else 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+ withBuffer0 $ 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+ withBuffer0 $+ if (style == Block)+ then do+ indentBlockRegionB (countMod count) reg+ else do+ reg' <- convertRegionToStyleB reg style+ shiftIndentOfRegion (countMod count) reg'+ switchModeE Normal+ return Finish+}++lastCharForOperator :: VimOperator -> String+lastCharForOperator (VimOperator { operatorName = name }) =+ if "<lt>" `isSuffixOf` name then "<lt>" else [last name]
+ src/library/Yi/Keymap/Vim2/ReplaceMap.hs view
@@ -0,0 +1,84 @@+module Yi.Keymap.Vim2.ReplaceMap+ ( defReplaceMap+ ) where++import Yi.Prelude+import Prelude ()++import Control.Monad (replicateM_)++import Yi.Buffer+import Yi.Editor+import Yi.Keymap.Keys+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.EventUtils+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.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) getDynamic+ replicateM_ (count - 1) $ mapM_ (printableAction . eventToString) inputEvents+ modifyStateE $ \s -> s { vsOngoingInsertEvents = "" }+ withBuffer0 $ moveXorSol 1++printable :: VimBinding+printable = VimBindingE prereq action+ where prereq _ s = matchFromBool $ Replace == vsMode s+ action = printableAction++printableAction :: EventString -> EditorM RepeatToken+printableAction evs = do+ saveInsertEventStringE evs+ withBuffer0 $ case 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/Vim2/ReplaceSingleCharMap.hs view
@@ -0,0 +1,52 @@+module Yi.Keymap.Vim2.ReplaceSingleCharMap+ ( defReplaceSingleMap+ ) where++import Yi.Prelude+import Prelude ()++import Control.Monad (replicateM_)++import Data.Maybe (fromMaybe)++import Yi.Buffer+import Yi.Editor+import Yi.Keymap.Keys+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.Utils++defReplaceSingleMap :: [VimBinding]+defReplaceSingleMap = [escBinding, actualReplaceBinding]++escBinding :: VimBinding+escBinding = mkBindingE ReplaceSingleChar Drop (spec KEsc, return (), resetCount . switchMode Normal)++actualReplaceBinding :: VimBinding+actualReplaceBinding = VimBindingE prereq action+ where prereq _ s = matchFromBool $ ReplaceSingleChar == vsMode s+ action evs = do+ currentState <- getDynamic+ let count = fromMaybe 1 $ vsCount currentState+ let replacer = case evs of+ (c:[]) -> replaceCharB c+ "<lt>" -> replaceCharB '<'+ "<C-e>" -> replaceCharWithBelowB+ "<C-y>" -> replaceCharWithAboveB+ _ -> return ()+ withBuffer0 $ 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
+ src/library/Yi/Keymap/Vim2/Search.hs view
@@ -0,0 +1,41 @@+module Yi.Keymap.Vim2.Search+ ( doVimSearch+ , continueVimSearch+ ) where++import Prelude ()+import Yi.Prelude++import Data.Maybe (maybe, listToMaybe)++import Yi.Buffer+import Yi.Editor+import Yi.Search++doVimSearch :: Maybe String -> [SearchOption] -> Direction -> EditorM ()+doVimSearch Nothing _ dir = do+ mbRegex <- getRegexE+ case mbRegex of+ Just regex -> withBuffer0 $ continueVimSearch (regex, dir)+ Nothing -> printMsg "No previous search pattern"+doVimSearch (Just needle) opts dir =+ searchInit needle dir opts >>= withBuffer0 . 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/Vim2/SearchMotionMap.hs view
@@ -0,0 +1,74 @@+module Yi.Keymap.Vim2.SearchMotionMap+ ( defSearchMotionMap+ ) where++import Prelude ()+import Yi.Prelude++import Control.Monad (replicateM_)+import Data.List (drop)+import Data.Maybe (fromMaybe)++import Yi.Buffer+import Yi.Editor+import Yi.History+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.Search+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.Utils+import Yi.Search++defSearchMotionMap :: [VimBinding]+defSearchMotionMap = [enterBinding, editBinding, exitBinding]++enterBinding :: VimBinding+enterBinding = VimBindingE prereq action+ where prereq "<CR>" (VimState { vsMode = Search {}} ) = WholeMatch ()+ prereq _ _ = NoMatch+ action _ = do+ Search prevMode dir <- fmap vsMode getDynamic+ -- TODO: parse cmd into regex and flags+ isearchFinishE+ historyFinish+ switchModeE prevMode++ count <- getCountE+ Just regex <- getRegexE+ withBuffer0 $ 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++editBinding :: VimBinding+editBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = Search {}} ) = matchFromBool $+ evs `elem` (fmap fst binds)+ || (null (drop 1 evs))+ prereq _ _ = NoMatch+ action evs = do+ fromMaybe (isearchAddE evs) (lookup evs binds)+ withBuffer0 elemsB >>= historyPrefixSet+ 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 prereq action+ where prereq _ (VimState { vsMode = Search {}} ) = WholeMatch ()+ prereq _ _ = NoMatch+ action _ = do+ Search prevMode _dir <- fmap vsMode getDynamic+ isearchCancelE+ switchModeE prevMode+ return Drop
+ src/library/Yi/Keymap/Vim2/StateUtils.hs view
@@ -0,0 +1,144 @@+module Yi.Keymap.Vim2.StateUtils+ ( switchMode+ , switchModeE+ , resetCount+ , resetCountE+ , setCountE+ , modifyStateE+ , getMaybeCountE+ , getCountE+ , accumulateEventE+ , accumulateBindingEventE+ , accumulateTextObjectEventE+ , flushAccumulatorIntoRepeatableActionE+ , dropAccumulatorE+ , dropBindingAccumulatorE+ , dropTextObjectAccumulatorE+ , setRegisterE+ , getRegisterE+ , normalizeCountE+ , setStickyEolE+ , maybeMult+ , updateModeIndicatorE+ , saveInsertEventStringE+ ) where++import Yi.Prelude+import Prelude ()++import qualified Data.HashMap.Strict as HM+import Data.Maybe (fromMaybe)+import qualified Data.Rope as R++import Yi.Buffer.Normal+import Yi.Editor+import Yi.Event+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.EventUtils+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 <- getDynamic+ setDynamic $ f currentState++resetCount :: VimState -> VimState+resetCount s = s { vsCount = Nothing }++resetCountE :: EditorM ()+resetCountE = modifyStateE resetCount++getMaybeCountE :: EditorM (Maybe Int)+getMaybeCountE = fmap vsCount getDynamic++getCountE :: EditorM Int+getCountE = do+ currentState <- getDynamic+ 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 ++ eventToString e }++accumulateEventE :: Event -> EditorM ()+accumulateEventE e = modifyStateE $+ \s -> s { vsAccumulator = vsAccumulator s ++ eventToString e }++accumulateTextObjectEventE :: EventString -> EditorM ()+accumulateTextObjectEventE evs = modifyStateE $+ \s -> s { vsTextObjectAccumulator = vsTextObjectAccumulator s ++ evs }++flushAccumulatorIntoRepeatableActionE :: EditorM ()+flushAccumulatorIntoRepeatableActionE = do+ currentState <- getDynamic+ let repeatableAction = stringToRepeatableAction $ vsAccumulator currentState+ modifyStateE $ \s -> s { vsRepeatableAction = Just repeatableAction+ , vsAccumulator = []+ }++dropAccumulatorE :: EditorM ()+dropAccumulatorE = modifyStateE $ \s -> s { vsAccumulator = [] }++dropBindingAccumulatorE :: EditorM ()+dropBindingAccumulatorE = modifyStateE $ \s -> s { vsBindingAccumulator = [] }++dropTextObjectAccumulatorE :: EditorM ()+dropTextObjectAccumulatorE = modifyStateE $ \s -> s { vsTextObjectAccumulator = [] }++getRegisterE :: RegisterName -> EditorM (Maybe Register)+getRegisterE name = fmap (HM.lookup name . vsRegisterMap) getDynamic++setRegisterE :: RegisterName -> RegionStyle -> R.Rope -> EditorM ()+setRegisterE name style rope = do+ rmap <- fmap vsRegisterMap getDynamic+ 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 = show (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 <- getDynamic+ 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 null modeName then "" else "-- " ++ modeName ++ " --"+ setStatus ([decoratedModeName], defaultStyle)++saveInsertEventStringE :: EventString -> EditorM ()+saveInsertEventStringE evs =+ modifyStateE $ \s -> s { vsOngoingInsertEvents = vsOngoingInsertEvents s ++ evs }
+ src/library/Yi/Keymap/Vim2/StyledRegion.hs view
@@ -0,0 +1,62 @@+module Yi.Keymap.Vim2.StyledRegion+ ( StyledRegion(..)+ , normalizeRegion+ , transformCharactersInRegionB+ , transformCharactersInLineN+ ) where++import Prelude ()+import Yi.Prelude++import Yi.Buffer++data StyledRegion = StyledRegion !RegionStyle !Region++normalizeRegion :: StyledRegion -> BufferM StyledRegion+normalizeRegion sr@(StyledRegion style reg) =+ -- 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.+ -- *exclusive-linewise*+ -- 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+ if style == Exclusive+ then do+ let end = regionEnd reg+ (_, endColumn) <- getLineAndColOfPoint end+ if endColumn == 0+ then return $ StyledRegion Inclusive $ reg { regionEnd = end -~ 2 }+ else return 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' (fmap 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/Vim2/TextObject.hs view
@@ -0,0 +1,68 @@+module Yi.Keymap.Vim2.TextObject+ ( TextObject(..)+ , CountedTextObject(..)+ , regionOfTextObjectB+ , changeTextObjectCount+ , changeTextObjectStyle+ , stringToTextObject+ ) where++import Prelude ()+import Yi.Prelude++import Control.Monad (replicateM_)++import Yi.Buffer+import Yi.Keymap.Vim2.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/Vim2/Utils.hs view
@@ -0,0 +1,139 @@+module Yi.Keymap.Vim2.Utils+ ( mkBindingE+ , mkBindingY+ , mkStringBindingE+ , splitCountedCommand+ , selectBinding+ , matchFromBool+ , mkMotionBinding+ , mkChooseRegisterBinding+ , pasteInclusiveB+ , addNewLineIfNecessary+ , indentBlockRegionB+ ) where++import Yi.Prelude+import Prelude ()++import Data.List (group, zip)+import qualified Data.Rope as R++import Yi.Buffer hiding (Insert)+import Yi.Editor+import Yi.Event+import Yi.Keymap+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.Motion+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.EventUtils++-- '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+ -> (String, EditorM (), VimState -> VimState) -> VimBinding+mkStringBindingE mode rtoken (eventString, action, mutate) = VimBindingE prereq combinedAction+ where prereq _ vs | vsMode vs /= mode = NoMatch+ prereq evs _ = evs `matchesString` eventString+ combinedAction _ = combineAction action mutate rtoken++mkBindingE :: VimMode -> RepeatToken -> (Event, EditorM (), VimState -> VimState) -> VimBinding+mkBindingE mode rtoken (event, action, mutate) = VimBindingE prereq combinedAction+ where prereq evs vs = matchFromBool $ vsMode vs == mode && evs == eventToString event+ combinedAction _ = combineAction action mutate rtoken++mkBindingY :: VimMode -> (Event, YiM (), VimState -> VimState) -> VimBinding+mkBindingY mode (event, action, mutate) = VimBindingY prereq combinedAction+ where prereq evs vs = matchFromBool $ vsMode vs == mode && evs == eventToString event+ combinedAction _ = combineAction action mutate Drop++combineAction :: MonadEditor m => m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken+combineAction action mutateState rtoken = do+ action+ withEditor $ modifyStateE mutateState+ return rtoken++selectBinding :: String -> VimState -> [VimBinding] -> MatchResult VimBinding+selectBinding eventString state = foldl go NoMatch+ where go match b = match <|> fmap (const b) (vbPrerequisite b eventString state)++matchFromBool :: Bool -> MatchResult ()+matchFromBool b = if b then WholeMatch () else NoMatch++mkMotionBinding :: RepeatToken -> (VimMode -> Bool) -> VimBinding+mkMotionBinding token condition = VimBindingE prereq action+ where prereq evs state | condition (vsMode state) = fmap (const ()) (stringToMove evs)+ prereq _ _ = NoMatch+ action evs = do+ state <- getDynamic+ let WholeMatch (Move _style isJump move) = stringToMove evs+ count <- getMaybeCountE+ when isJump addJumpHereE+ withBuffer0 $ move count >> leftOnEol+ resetCountE++ -- moving with j/k after $ sticks cursor to the right edge+ when (evs == "$") $ setStickyEolE True+ when (evs `elem` group "jk" && vsStickyEol state) $+ withBuffer0 $ moveToEol >> moveXorSol 1+ when (evs `notElem` group "jk$") $ setStickyEolE False++ let m = head evs+ when (m `elem` "fFtT") $ do+ let c = 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 prereq action+ where prereq "\"" s | statePredicate s = PartialMatch+ prereq ('"':_:[]) s | statePredicate s = WholeMatch ()+ prereq _ _ = NoMatch+ action ('"':c:[]) = do+ modifyStateE $ \s -> s { vsActiveRegister = c }+ return Continue+ action _ = error "can't happen"++indentBlockRegionB :: Int -> Region -> BufferM ()+indentBlockRegionB count reg = do+ indentSettings <- indentSettingsB+ (start, lengths) <- shapeOfBlockRegionB reg+ moveTo start+ forM_ (zip [1..] lengths) $ \(i, _) -> do+ whenM (not <$> atEol) $ do+ if count > 0+ then insertN $ replicate (count * shiftWidth indentSettings) ' '+ else do+ let go 0 = return ()+ go n = do+ c <- readB+ when (c == ' ') $+ deleteN 1 >> go (n - 1)+ go (abs count * shiftWidth indentSettings)+ moveTo start+ discard $ lineMoveRel i+ moveTo start++pasteInclusiveB :: Rope -> RegionStyle -> BufferM ()+pasteInclusiveB rope style = do+ p0 <- pointB+ insertRopeWithStyleB rope style+ if R.countNewLines rope == 0 && style `elem` [Exclusive, Inclusive]+ then leftB+ else moveTo p0++addNewLineIfNecessary :: Rope -> Rope+addNewLineIfNecessary rope = if lastChar == '\n'+ then rope+ else R.append rope (R.fromString "\n")+ where lastChar = head $ R.toString $ R.drop (R.length rope - 1) rope
+ src/library/Yi/Keymap/Vim2/VisualMap.hs view
@@ -0,0 +1,238 @@+module Yi.Keymap.Vim2.VisualMap+ ( defVisualMap+ ) where++import Yi.Prelude+import Prelude ()++import Data.Char (ord)+import Data.List (drop, group, length, reverse)+import Data.Maybe (fromJust)++import Yi.Buffer hiding (Insert)+import Yi.Editor+import Yi.Keymap.Vim2.Common+import Yi.Keymap.Vim2.Operator+import Yi.Keymap.Vim2.StateUtils+import Yi.Keymap.Vim2.StyledRegion+import Yi.Keymap.Vim2.Utils+import Yi.MiniBuffer++defVisualMap :: [VimOperator] -> [VimBinding]+defVisualMap operators =+ [escBinding, motionBinding, changeVisualStyleBinding, setMarkBinding]+ ++ [chooseRegisterBinding]+ ++ operatorBindings operators ++ digitBindings ++ [replaceBinding, switchEdgeBinding]+ ++ [insertBinding, exBinding, shiftDBinding]++escBinding :: VimBinding+escBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = (Visual _) }) =+ matchFromBool $ evs `elem` ["<Esc>", "<C-c>"]+ prereq _ _ = NoMatch+ action _ = do+ resetCountE+ clrStatus+ withBuffer0 $ do+ setVisibleSelection False+ putA regionStyleA Inclusive+ switchModeE Normal+ return Drop++exBinding :: VimBinding+exBinding = VimBindingE prereq action+ where prereq ":" (VimState { vsMode = (Visual _) }) = WholeMatch ()+ prereq _ _ = NoMatch+ action _ = do+ discard $ spawnMinibufferE ":'<,'>" id+ switchModeE Ex+ return Finish++digitBindings :: [VimBinding]+digitBindings = zeroBinding : fmap mkDigitBinding ['1' .. '9']++zeroBinding :: VimBinding+zeroBinding = VimBindingE prereq action+ where prereq "0" (VimState { vsMode = (Visual _) }) = WholeMatch ()+ prereq _ _ = NoMatch+ action _ = do+ currentState <- getDynamic+ case vsCount currentState of+ Just c -> do+ setDynamic $ currentState { vsCount = Just (10 * c) }+ return Continue+ Nothing -> do+ withBuffer0 moveToSol+ setDynamic $ resetCount currentState+ return Continue++setMarkBinding :: VimBinding+setMarkBinding = VimBindingE prereq action+ where prereq "m" (VimState { vsMode = (Visual _) }) = PartialMatch+ prereq ('m':_:[]) (VimState { vsMode = (Visual _) }) = WholeMatch ()+ prereq _ _ = NoMatch+ action ('m':c:[]) = do+ withBuffer0 $ setNamedMarkHereB [c]+ return Continue + action _ = error "Can't happen"++changeVisualStyleBinding :: VimBinding+changeVisualStyleBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = (Visual _) }) | evs `elem` ["v", "V", "<C-v>"] = WholeMatch ()+ prereq _ _ = NoMatch+ action evs = do+ currentMode <- fmap vsMode getDynamic+ let newStyle = case evs of+ "v" -> Inclusive+ "V" -> LineWise+ "<C-v>" -> Block+ _ -> error "Can't happen because of prereq, this just prevents warning"+ newMode = Visual newStyle+ if newMode == currentMode+ then do+ vbeAction escBinding "<Esc>"+ else do+ modifyStateE $ \s -> s { vsMode = newMode }+ withBuffer0 $ do+ putA regionStyleA newStyle+ putA rectangleSelectionA $ Block == newStyle+ setVisibleSelection True+ return Finish++mkDigitBinding :: Char -> VimBinding+mkDigitBinding c = VimBindingE prereq action+ where prereq (c':[]) (VimState { vsMode = (Visual _) }) = matchFromBool $ c == c'+ prereq _ _ = NoMatch+ action _ = do+ modifyStateE mutate+ return Continue+ 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 prereq action+ where prereq "D" (VimState { vsMode = (Visual _) }) = WholeMatch ()+ prereq _ _ = NoMatch+ action _ = do+ (Visual style) <- vsMode <$> getDynamic+ reg <- withBuffer0 regionOfSelectionB+ case style of+ Block -> withBuffer0 $ do+ (start, lengths) <- shapeOfBlockRegionB reg+ moveTo start+ startCol <- curCol+ forM_ (reverse [0 .. length lengths - 1]) $ \l -> do+ moveTo start+ discard $ lineMoveRel l+ whenM (fmap (== startCol) curCol) deleteToEol+ leftOnEol+ _ -> do+ reg' <- withBuffer0 $ convertRegionToStyleB reg LineWise+ reg'' <- withBuffer0 $ mkRegionOfStyleB (regionStart reg')+ (regionEnd reg' -~ Size 1)+ Exclusive+ discard $ operatorApplyToRegionE opDelete 1 $ StyledRegion LineWise reg''+ resetCountE+ switchModeE Normal+ return Finish++mkOperatorBinding :: VimOperator -> VimBinding+mkOperatorBinding op = VimBindingE prereq action+ where prereq evs (VimState { vsMode = (Visual _) }) =+ evs `matchesString` (operatorName op)+ prereq _ _ = NoMatch+ action _ = do+ (Visual style) <- vsMode <$> getDynamic+ region <- withBuffer0 regionOfSelectionB+ count <- getCountE+ token <- operatorApplyToRegionE op count $ StyledRegion style region+ resetCountE+ clrStatus+ withBuffer0 $ do+ setVisibleSelection False+ putA regionStyleA Inclusive+ return token++replaceBinding :: VimBinding+replaceBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = (Visual _) }) =+ case evs of+ "r" -> PartialMatch+ ('r':_:[]) -> WholeMatch ()+ _ -> NoMatch+ prereq _ _ = NoMatch+ action (_:c:[]) = do+ (Visual style) <- vsMode <$> getDynamic+ region <- withBuffer0 regionOfSelectionB+ withBuffer0 $ transformCharactersInRegionB (StyledRegion style region)+ (\x -> if x == '\n' then x else c)+ switchModeE Normal+ return Finish+ action _ = error "can't happen"++switchEdgeBinding :: VimBinding+switchEdgeBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = (Visual _) }) =+ matchFromBool $ evs `elem` group "oO"+ prereq _ _ = NoMatch+ action (c:[]) = do+ (Visual style) <- vsMode <$> getDynamic+ withBuffer0 $ 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+ action _ = error "can't happen"++insertBinding :: VimBinding+insertBinding = VimBindingE prereq action+ where prereq evs (VimState { vsMode = (Visual _) }) =+ matchFromBool $ evs `elem` group "IA"+ prereq _ _ = NoMatch+ action evs = do+ (Visual style) <- vsMode <$> getDynamic+ region <- withBuffer0 regionOfSelectionB+ cursors <- withBuffer0 $ case evs of+ "I" -> leftEdgesOfRegionB style region+ "A" -> rightEdgesOfRegionB style region+ _ -> error "can't happen"+ withBuffer0 $ moveTo $ head cursors+ modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 cursors }+ switchModeE $ Insert (head evs)+ return Continue
src/library/Yi/Lexer/Haskell.x view
@@ -184,6 +184,8 @@ ReservedOp _ -> operatorStyle Reserved Import -> importStyle Reserved Qualified -> importStyle+ Reserved As -> importStyle+ Reserved Hiding -> importStyle Reserved _ -> keywordStyle Special _ -> defaultStyle ConsOperator _ -> operatorStyle
src/library/Yi/Main.hs view
@@ -31,10 +31,6 @@ import Yi.File import Paths_yi -#ifdef TESTING-import qualified TestSuite-#endif- #ifdef FRONTEND_COCOA import HOC (withAutoreleasePool) #endif@@ -83,6 +79,7 @@ editors :: [(String,Config -> Config)] editors = [("emacs", toEmacsStyleConfig), ("vim", toVimStyleConfig),+ ("vim2", toVim2StyleConfig), ("cua", toCuaStyleConfig)] options :: [OptDescr Opts]@@ -158,13 +155,9 @@ -- this after setting preferences passed from the boot loader. -- main :: (Config, ConsoleConfig) -> Maybe Editor -> IO ()-main (cfg, cfgcon) state = do+main (cfg, _cfgcon) state = do #ifdef FRONTEND_COCOA withAutoreleasePool $ do-#endif-#ifdef TESTING- when (selfCheck cfgcon)- TestSuite.main #endif when (debugMode cfg) $ initDebug ".yi.dbg" startEditor cfg state
src/library/Yi/Misc.hs view
@@ -5,6 +5,12 @@ where {- Standard Library Module Imports -}+import Data.Char+ ( isUpper+ , isLower+ , chr+ , ord+ ) import Data.List ( isPrefixOf , stripPrefix@@ -141,3 +147,24 @@ -- have the given prefix. findFileHint :: String -> String -> YiM [String] findFileHint startPath s = snd <$> getAppropriateFiles (Just startPath) s++onCharLetterCode :: (Int -> Int) -> Char -> Char+onCharLetterCode f c | isUpper c || isLower c = chr (f (ord c - a) `mod` 26 + a)+ | otherwise = c+ where a | isUpper c = ord 'A'+ | isLower c = ord 'a'+ | otherwise = undefined++rot13Char :: Char -> Char+rot13Char = onCharLetterCode (+13)++printFileInfoE :: EditorM ()+printFileInfoE = printMsg . showBufInfo =<< withBuffer0 bufInfoB+ where showBufInfo :: BufferFileInfo -> String+ showBufInfo bufInfo = concat [ show $ bufInfoFileName bufInfo+ , " Line "+ , show $ bufInfoLineNo bufInfo+ , " ["+ , bufInfoPercent bufInfo+ , "]"+ ]
src/library/Yi/Mode/Interactive.hs view
@@ -11,11 +11,6 @@ import qualified Yi.Mode.Compilation as Compilation import qualified Yi.Syntax.OnlineTree as OnlineTree -atLastLine :: BufferM Bool-atLastLine = savingPointB $ do- moveToEol- (==) <$> sizeB <*> pointB- mode :: Mode (OnlineTree.Tree (Tok Token)) mode = Compilation.mode { modeApplies = modeNeverApplies,
src/library/Yi/Paths.hs view
@@ -2,10 +2,10 @@ module Yi.Paths( getEvaluatorContextFilename ,getConfigFilename+ ,getConfigModules ,getArticleDbFilename ,getPersistentStateFilename ,getConfigDir- ,getConfigPath ,getDataPath ) where@@ -32,13 +32,15 @@ getConfigDir ::(MonadIO m) => m FilePath getConfigDir = appUserDataCond XDG.getUserConfigDir-getDataDir ::(MonadIO m) => m FilePath-getDataDir = appUserDataCond XDG.getUserDataDir +getDataDir ::(MonadIO 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 :: (MonadIO m) => FilePath -> m FilePath-getDataPath fp = getDataDir >>= (return . (</> fp))+getDataPath fp = getDataDir >>= (return . (</> fp))+ -- | Given a path relative to application configuration directory, -- this function finds a path to a given configuration file. getConfigPath :: (MonadIO m) => FilePath -> m FilePath@@ -48,16 +50,19 @@ --getCachePath = getPathHelper XDG.getUserCacheDirectory -- Below are all points that are used in Yi code (to keep it clean.)-getEvaluatorContextFilename, getConfigFilename, getArticleDbFilename, getPersistentStateFilename :: (MonadIO m) => m FilePath+getEvaluatorContextFilename, getConfigFilename, getConfigModules,+ getArticleDbFilename, getPersistentStateFilename :: (MonadIO m) => m FilePath -- | Get Yi master configuration script.-getConfigFilename = getConfigPath "yi.hs"+getConfigFilename = getConfigPath "yi.hs" +getConfigModules = getConfigPath "modules"+ -- | Get articles.db database of locations to visit (for Yi.IReader.)-getArticleDbFilename = getConfigPath "articles.db"+getArticleDbFilename = getConfigPath "articles.db" -- | Get path to Yi history that stores state between runs.-getPersistentStateFilename = getDataPath "history"+getPersistentStateFilename = getDataPath "history" -- | Get path to environment file that defines namespace used by Yi -- command evaluator.
src/library/Yi/Prelude.hs view
@@ -5,6 +5,7 @@ (<>), (++), -- consider scrapping this and replacing it by the above (=<<),+(<=<), ($!), Double, Binary,
src/library/Yi/Search.hs view
@@ -20,15 +20,17 @@ -- -> IO SearchExp continueSearch, -- :: SearchExp -- -> IO SearchResult+ makeSimpleSearch, -- * Batch search-replace searchReplaceRegionB, searchReplaceSelectionB, replaceString, searchAndRepRegion,+ searchAndRepRegion0, searchAndRepUnit, -- :: String -> String -> Bool -> TextUnit -> EditorM Bool- -- * Incremental Search + -- * Incremental Search isearchInitE, isearchIsEmpty, isearchAddE,
src/library/Yi/Style/Library.hs view
@@ -9,17 +9,17 @@ -- | Abstract theme that provides useful defaults. defaultTheme :: Theme-defaultTheme = Proto $ const $ UIStyle- { modelineAttributes = error "modeline attributes must be redefined!"+defaultTheme = Proto $ const UIStyle+ { modelineAttributes = emptyAttributes { foreground = white, background = grey } , modelineFocusStyle = withFg brightwhite - , tabBarAttributes = error "tabbar attributes must be redefined!"- , tabInFocusStyle = withFg black `mappend` withBg brightwhite- , tabNotFocusedStyle = withFg grey `mappend` withBg white+ , tabBarAttributes = emptyAttributes+ , tabInFocusStyle = withFg black `mappend` withBg white+ , tabNotFocusedStyle = mempty - , baseAttributes = error "base attributes must be redefined!"+ , baseAttributes = emptyAttributes - , selectedStyle = withFg black `mappend` withBg cyan+ , selectedStyle = withFg white `mappend` withBg purple , eofStyle = withFg blue , errorStyle = withBg red , hintStyle = withFg black `mappend` withBg cyan@@ -35,7 +35,7 @@ , typeStyle = withFg darkgreen , dataConstructorStyle = withBd True `mappend` withFg darkgreen- , importStyle = withFg grey+ , importStyle = withFg blue , builtinStyle = withFg blue , regexStyle = withFg red , variableStyle = mempty@@ -43,15 +43,6 @@ , makeFileRuleHead = withFg blue , makeFileAction = withFg grey , quoteStyle = withFg grey- }----- | The default Theme-defaultLightTheme :: Theme-defaultLightTheme = defaultTheme `override` \super _ -> super- { modelineAttributes = emptyAttributes { foreground = black, background = darkcyan }- , tabBarAttributes = emptyAttributes { foreground = white, background = black }- , baseAttributes = emptyAttributes } -- | A Theme inspired by the darkblue colorscheme of Vim.
src/library/Yi/Tag.hs view
@@ -19,11 +19,13 @@ where {- Standard Library Module Imports -}-import Prelude (map, words, lines, readFile)+import Prelude (map, words, lines, readFile, reads) import Yi.Prelude import Yi.Editor import Yi.Dynamic +import qualified Data.ByteString as BS+import qualified Data.ByteString.UTF8 as BS8 import Data.Maybe (mapMaybe) import Data.List (isPrefixOf) import System.FilePath (takeFileName, takeDirectory, FilePath, (</>))@@ -69,17 +71,17 @@ readCTags :: String -> Map Tag (FilePath, Int) readCTags = fromList . mapMaybe (parseTagLine . words) . lines- where parseTagLine [tag, tagfile, lineno] =+ where parseTagLine (tag:tagfile:lineno:_) = -- remove ctag control lines if "!_TAG_" `isPrefixOf` tag then Nothing- else Just (tag, (tagfile, read lineno))+ else Just (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 <- readFile friendlyName+ tagStr <- fmap BS8.toString $ BS.readFile friendlyName let ctags = readCTags tagStr return $ TagTable { tagFileName = takeFileName filename, tagBaseDir = takeDirectory filename,
src/library/Yi/UI/Utils.hs view
@@ -11,7 +11,7 @@ import Yi.Style import Data.List (zip, repeat, span, dropWhile, length, zipWith, transpose, scanl, take, intercalate, takeWhile, reverse) import Yi.Syntax (Span(..))-import Data.List.Split (splitEvery)+import Data.List.Split (chunksOf) import Yi.String (padLeft) import Control.Monad.State (runState,modify) @@ -93,7 +93,7 @@ -- | Arrange a list of items in columns over @numberOfLines@ lines. arrangeItems' :: [String] -> Int -> Int -> (Int, [String]) arrangeItems' items maxWidth numberOfLines = (fittedItems,theLines)- where columns = splitEvery numberOfLines items+ where 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)
src/library/Yi/UI/Vty.hs view
@@ -255,11 +255,11 @@ extraImage = withAttributes (tabBarAttributes uiStyle) (replicate (xss - fromEnum totalTabWidth) ' ') totalTabWidth = Vty.image_width tabImages- uiStyle = configStyle $ configUI $ config $ ui+ uiStyle = configStyle $ configUI $ config ui tabTitle text = " " ++ text ++ " "- baseAttr b sty = if b then attributesToAttr (appEndo (tabInFocusStyle uiStyle) sty) Vty.def_attr- else attributesToAttr (appEndo (tabNotFocusedStyle uiStyle) sty) Vty.def_attr `Vty.with_style` Vty.underline tabAttr b = baseAttr b $ tabBarAttributes uiStyle+ baseAttr True sty = attributesToAttr (appEndo (tabInFocusStyle uiStyle) sty) Vty.def_attr+ baseAttr False sty = attributesToAttr (appEndo (tabNotFocusedStyle uiStyle) sty) Vty.def_attr `Vty.with_style` Vty.underline tabToVtyImage _tab@(TabDescr text inFocus) = Vty.string (tabAttr inFocus) (tabTitle text) -- | Determine whether it is necessary to render the tab bar@@ -428,8 +428,8 @@ ------------------------------------------------------------------------ -- | Convert a Yi Attr into a Vty attribute change.-colorToAttr :: (Vty.Color -> Vty.Attr -> Vty.Attr) -> Vty.Color -> Style.Color -> (Vty.Attr -> Vty.Attr)-colorToAttr set unknown c =+colorToAttr :: (Vty.Color -> Vty.Attr -> Vty.Attr) -> Style.Color -> (Vty.Attr -> Vty.Attr)+colorToAttr set c = case c of RGB 0 0 0 -> set Vty.black RGB 128 128 128 -> set Vty.bright_black@@ -448,15 +448,16 @@ RGB 165 165 165 -> set Vty.white RGB 255 255 255 -> set Vty.bright_white Default -> id- _ -> set unknown -- NB+ _ -> error $ "Color unsupported by Vty frontend: " ++ show c attributesToAttr :: Attributes -> (Vty.Attr -> Vty.Attr) attributesToAttr (Attributes fg bg reverse bd _itlc underline') = (if reverse then (flip Vty.with_style Vty.reverse_video) else id) . (if bd then (flip Vty.with_style Vty.bold) else id) . (if underline' then (flip Vty.with_style Vty.underline) else id) .- colorToAttr (flip Vty.with_fore_color) Vty.black fg . - colorToAttr (flip Vty.with_back_color) Vty.white bg+ colorToAttr (flip Vty.with_fore_color) fg .+ colorToAttr (flip Vty.with_back_color) bg+ ---------------------------------
src/library/Yi/Window.hs view
@@ -12,32 +12,35 @@ import Data.Binary import Yi.Buffer.Basic (BufferRef, WindowRef) import Yi.Region (Region,emptyRegion)+import Yi.JumpList ------------------------------------------------------------------------ -- | 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- }- deriving (Typeable)+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) instance Binary Window where- put (Window mini bk bl _h _rgn key lns) = put mini >> put bk >> put bl >> put key >> put lns+ 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 <*> get -- | Get the identification of a window.@@ -60,5 +63,5 @@ -- | Return a "fake" window onto a buffer. dummyWindow :: BufferRef -> Window-dummyWindow b = Window False b [] 0 emptyRegion initial 0+dummyWindow b = Window False b [] 0 emptyRegion initial 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/TestSuite.hs view
@@ -1,26 +1,12 @@-module TestSuite where--import Driver--import Control.Monad.Identity-import Data.Traversable-import Text.Show.Functions ()--main :: IO ()-main = Driver.main tests--type Prop_Functor f a = f a -> Bool--prop_functor :: (Eq (f a), Functor f) => f a -> Bool-prop_functor ws = fmap id ws == ws+module Main where -prop_traversable :: (Eq (t b), Traversable t) => t a -> (a -> b) -> Bool-prop_traversable ws f = runIdentity (Data.Traversable.mapM (Identity . f) ws) == fmap f ws+import Test.Framework (defaultMain) -tests :: [(String, Int -> IO (Bool, Int))]-tests = - [ -- Format like this in the future, but no tests are applicable here:- -- ("WindowSet prop_traversable" , mytest (prop_traversable :: WindowSet Int -> (Int -> Int) -> Bool))- ]+import Test.Framework.Providers.HUnit +import qualified TestVim +main :: IO ()+main = do+ tests <- TestVim.getTests+ defaultMain tests
yi.cabal view
@@ -1,5 +1,5 @@ name: yi-version: 0.6.7.0+version: 0.7.0 category: Development, Editor synopsis: The Haskell-Scriptable Editor description:@@ -64,7 +64,7 @@ Default: False Description: Hacking mode:- * Create HackerMain.hs by copying your ~/.yi/yi.hs+ * Create HackerMain.hs by copying your ~/.config/yi/yi.hs * Skip library compilation * You can run yi in-place with dist/build/yi/yi @@ -98,6 +98,7 @@ Yi.Buffer.Normal Yi.Buffer.Misc Yi.Buffer.Region+ Yi.Buffer.TextUnit Yi.Buffer.Undo Yi.Command Yi.Completion@@ -120,6 +121,7 @@ Yi.IReader Yi.IncrementalParse Yi.Interact+ Yi.JumpList Yi.Keymap Yi.Keymap.Completion Yi.Keymap.Cua@@ -130,6 +132,43 @@ Yi.Keymap.Readline Yi.Keymap.Vim Yi.Keymap.Vim.TagStack+ Yi.Keymap.Vim2+ Yi.Keymap.Vim2.Common+ Yi.Keymap.Vim2.Digraph+ Yi.Keymap.Vim2.Eval+ Yi.Keymap.Vim2.EventUtils+ Yi.Keymap.Vim2.Ex+ Yi.Keymap.Vim2.Ex.Commands.Common+ Yi.Keymap.Vim2.Ex.Commands.BufferDelete+ Yi.Keymap.Vim2.Ex.Commands.Delete+ Yi.Keymap.Vim2.Ex.Commands.Edit+ Yi.Keymap.Vim2.Ex.Commands.Global+ Yi.Keymap.Vim2.Ex.Commands.GotoLine+ Yi.Keymap.Vim2.Ex.Commands.Nohl+ Yi.Keymap.Vim2.Ex.Commands.Paste+ Yi.Keymap.Vim2.Ex.Commands.Quit+ Yi.Keymap.Vim2.Ex.Commands.Reload+ Yi.Keymap.Vim2.Ex.Commands.Substitute+ Yi.Keymap.Vim2.Ex.Commands.Write+ Yi.Keymap.Vim2.Ex.Commands.Yi+ Yi.Keymap.Vim2.Ex.Types+ Yi.Keymap.Vim2.Ex.Eval+ Yi.Keymap.Vim2.ExMap+ Yi.Keymap.Vim2.InsertMap+ Yi.Keymap.Vim2.MatchResult+ Yi.Keymap.Vim2.Motion+ Yi.Keymap.Vim2.NormalMap+ Yi.Keymap.Vim2.NormalOperatorPendingMap+ Yi.Keymap.Vim2.Operator+ Yi.Keymap.Vim2.ReplaceMap+ Yi.Keymap.Vim2.ReplaceSingleCharMap+ Yi.Keymap.Vim2.Search+ Yi.Keymap.Vim2.SearchMotionMap+ Yi.Keymap.Vim2.StateUtils+ Yi.Keymap.Vim2.StyledRegion+ Yi.Keymap.Vim2.TextObject+ Yi.Keymap.Vim2.Utils+ Yi.Keymap.Vim2.VisualMap Yi.KillRing Yi.Layout Yi.Lexer.Abella@@ -204,14 +243,14 @@ Yi.Char.Unicode build-depends:- Cabal >= 1.10 && < 1.18,- Diff >=0.1 && <0.3,+ Cabal >= 1.10 && < 1.20,+ Diff >=0.1 && <0.4, array, containers, directory, process, old-locale, base >= 4 && < 5, binary >= 0.5, bytestring >= 0.9.1 && < 0.11, cautious-file >= 1.0.1,- concrete-typerep == 0.1.*,+ concrete-typerep >= 0.1.0.2 && < 0.1.1, derive >=2.4 && <2.7, data-accessor >= 0.2.1.4 && < 0.3, data-accessor-mtl == 0.2.*,@@ -219,11 +258,14 @@ dlist >=0.4.1, dyre >=0.8.11, filepath>=1.1 && <1.4,- fingertree >= 0 && <0.1,- hashable >= 1.1 && < 1.3,+ fingertree >= 0 && <0.2,+ ghc-paths ==0.1.*,+ hashable ==1.2.*, hint > 0.3.1, mtl >= 0.1.0.1,+ parsec >= 3.0, pointedlist >= 0.4 && < 0.6,+ pureMD5 >= 0.2.3, random, regex-base ==0.93.*, regex-tdfa == 1.1.*,@@ -236,7 +278,7 @@ unordered-containers >= 0.1.3 && < 0.3, xdg-basedir >= 0.2.1 && < 0.3 - build-tools: alex >= 3.0.3 && <= 3.0.5+ build-tools: alex >= 3.0.3 && <= 3.1.0 ghc-options: -Wall -fno-warn-orphans ghc-prof-options: -prof -auto-all -rtsopts if flag(profiling)@@ -260,8 +302,6 @@ if flag(testing) cpp-options: -DTESTING- hs-source-dirs: src/tests- other-modules: Driver, TestSuite build-depends: QuickCheck >= 2.1.0.2, random@@ -399,6 +439,22 @@ base >=4 && <5 if !flag(dochack) build-depends: yi- build-tools: alex >= 3.0.3 && <= 3.0.5+ build-tools: alex >= 3.0.3 && <= 3.1.0 ghc-options: -threaded ghc-prof-options: -prof -auto-all -rtsopts++Test-Suite test-suite+ default-language: Haskell2010+ hs-source-dirs: src/tests+ type: exitcode-stdio-1.0+ main-is: TestSuite.hs+ build-depends:+ base,+ test-framework,+ test-framework-hunit,+ HUnit,+ QuickCheck,+ filepath,+ directory,+ yi+