diff --git a/dist/build/Yi/Lexer/Abella.hs b/dist/build/Yi/Lexer/Abella.hs --- a/dist/build/Yi/Lexer/Abella.hs +++ b/dist/build/Yi/Lexer/Abella.hs @@ -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 diff --git a/dist/build/Yi/Lexer/C.hs b/dist/build/Yi/Lexer/C.hs --- a/dist/build/Yi/Lexer/C.hs +++ b/dist/build/Yi/Lexer/C.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Cabal.hs b/dist/build/Yi/Lexer/Cabal.hs --- a/dist/build/Yi/Lexer/Cabal.hs +++ b/dist/build/Yi/Lexer/Cabal.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Compilation.hs b/dist/build/Yi/Lexer/Compilation.hs --- a/dist/build/Yi/Lexer/Compilation.hs +++ b/dist/build/Yi/Lexer/Compilation.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Cplusplus.hs b/dist/build/Yi/Lexer/Cplusplus.hs --- a/dist/build/Yi/Lexer/Cplusplus.hs +++ b/dist/build/Yi/Lexer/Cplusplus.hs @@ -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 diff --git a/dist/build/Yi/Lexer/GNUMake.hs b/dist/build/Yi/Lexer/GNUMake.hs --- a/dist/build/Yi/Lexer/GNUMake.hs +++ b/dist/build/Yi/Lexer/GNUMake.hs @@ -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 diff --git a/dist/build/Yi/Lexer/GitCommit.hs b/dist/build/Yi/Lexer/GitCommit.hs --- a/dist/build/Yi/Lexer/GitCommit.hs +++ b/dist/build/Yi/Lexer/GitCommit.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Haskell.hs b/dist/build/Yi/Lexer/Haskell.hs --- a/dist/build/Yi/Lexer/Haskell.hs +++ b/dist/build/Yi/Lexer/Haskell.hs @@ -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 diff --git a/dist/build/Yi/Lexer/JSON.hs b/dist/build/Yi/Lexer/JSON.hs --- a/dist/build/Yi/Lexer/JSON.hs +++ b/dist/build/Yi/Lexer/JSON.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Java.hs b/dist/build/Yi/Lexer/Java.hs --- a/dist/build/Yi/Lexer/Java.hs +++ b/dist/build/Yi/Lexer/Java.hs @@ -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 diff --git a/dist/build/Yi/Lexer/JavaScript.hs b/dist/build/Yi/Lexer/JavaScript.hs --- a/dist/build/Yi/Lexer/JavaScript.hs +++ b/dist/build/Yi/Lexer/JavaScript.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Latex.hs b/dist/build/Yi/Lexer/Latex.hs --- a/dist/build/Yi/Lexer/Latex.hs +++ b/dist/build/Yi/Lexer/Latex.hs @@ -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 diff --git a/dist/build/Yi/Lexer/LiterateHaskell.hs b/dist/build/Yi/Lexer/LiterateHaskell.hs --- a/dist/build/Yi/Lexer/LiterateHaskell.hs +++ b/dist/build/Yi/Lexer/LiterateHaskell.hs @@ -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 diff --git a/dist/build/Yi/Lexer/OCaml.hs b/dist/build/Yi/Lexer/OCaml.hs --- a/dist/build/Yi/Lexer/OCaml.hs +++ b/dist/build/Yi/Lexer/OCaml.hs @@ -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 diff --git a/dist/build/Yi/Lexer/ObjectiveC.hs b/dist/build/Yi/Lexer/ObjectiveC.hs --- a/dist/build/Yi/Lexer/ObjectiveC.hs +++ b/dist/build/Yi/Lexer/ObjectiveC.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Ott.hs b/dist/build/Yi/Lexer/Ott.hs --- a/dist/build/Yi/Lexer/Ott.hs +++ b/dist/build/Yi/Lexer/Ott.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Perl.hs b/dist/build/Yi/Lexer/Perl.hs --- a/dist/build/Yi/Lexer/Perl.hs +++ b/dist/build/Yi/Lexer/Perl.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Python.hs b/dist/build/Yi/Lexer/Python.hs --- a/dist/build/Yi/Lexer/Python.hs +++ b/dist/build/Yi/Lexer/Python.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Ruby.hs b/dist/build/Yi/Lexer/Ruby.hs --- a/dist/build/Yi/Lexer/Ruby.hs +++ b/dist/build/Yi/Lexer/Ruby.hs @@ -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 diff --git a/dist/build/Yi/Lexer/SVNCommit.hs b/dist/build/Yi/Lexer/SVNCommit.hs --- a/dist/build/Yi/Lexer/SVNCommit.hs +++ b/dist/build/Yi/Lexer/SVNCommit.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Srmc.hs b/dist/build/Yi/Lexer/Srmc.hs --- a/dist/build/Yi/Lexer/Srmc.hs +++ b/dist/build/Yi/Lexer/Srmc.hs @@ -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 diff --git a/dist/build/Yi/Lexer/Whitespace.hs b/dist/build/Yi/Lexer/Whitespace.hs --- a/dist/build/Yi/Lexer/Whitespace.hs +++ b/dist/build/Yi/Lexer/Whitespace.hs @@ -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 diff --git a/example-configs/yi-vim.hs b/example-configs/yi-vim.hs --- a/example-configs/yi-vim.hs +++ b/example-configs/yi-vim.hs @@ -23,7 +23,7 @@ styles yet - Jim -} defaultVimUiTheme :: Theme -defaultVimUiTheme = defaultLightTheme `override` \super self -> super { +defaultVimUiTheme = defaultTheme `override` \super self -> super { selectedStyle = modelineFocusStyle self } diff --git a/example-configs/yi-vim2.hs b/example-configs/yi-vim2.hs new file mode 100644 --- /dev/null +++ b/example-configs/yi-vim2.hs @@ -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 "" previousTabE + , nmap "" nextTabE + , nmap "" nextTabE + + -- Press space to clear incremental search highlight + , nmap " " (eval ":nohlsearch") + + -- for times when you don't press shift hard enough + , nmap ";" (eval ":") + + , nmap "" (withBuffer0 deleteTrailingSpaceB) + , nmap "" (withBuffer0 moveToSol) + , nmap "" (withBuffer0 readCurrentWordB >>= printMsg) + ] + +myModes = [ + AnyMode Haskell.fastMode { + -- Disable beautification + modePrettify = const $ return () + , modeGetAnnotations = (const . const) [] + } + ] diff --git a/src/library/Control/Exc.hs b/src/library/Control/Exc.hs --- a/src/library/Control/Exc.hs +++ b/src/library/Control/Exc.hs @@ -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) diff --git a/src/library/Data/Rope.hs b/src/library/Data/Rope.hs --- a/src/library/Data/Rope.hs +++ b/src/library/Data/Rope.hs @@ -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 diff --git a/src/library/Yi.hs b/src/library/Yi.hs --- a/src/library/Yi.hs +++ b/src/library/Yi.hs @@ -8,7 +8,7 @@ -- -- You should therefore: -- import Yi --- in your ~/.yi/ scripts +-- in your ~/.config/yi/ scripts -- module Yi diff --git a/src/library/Yi/Boot.hs b/src/library/Yi/Boot.hs --- a/src/library/Yi/Boot.hs +++ b/src/library/Yi/Boot.hs @@ -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 diff --git a/src/library/Yi/Buffer.hs b/src/library/Yi/Buffer.hs --- a/src/library/Yi/Buffer.hs +++ b/src/library/Yi/Buffer.hs @@ -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 diff --git a/src/library/Yi/Buffer/HighLevel.hs b/src/library/Yi/Buffer/HighLevel.hs --- a/src/library/Yi/Buffer/HighLevel.hs +++ b/src/library/Yi/Buffer/HighLevel.hs @@ -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 diff --git a/src/library/Yi/Buffer/Indent.hs b/src/library/Yi/Buffer/Indent.hs --- a/src/library/Yi/Buffer/Indent.hs +++ b/src/library/Yi/Buffer/Indent.hs @@ -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 () diff --git a/src/library/Yi/Buffer/Misc.hs b/src/library/Yi/Buffer/Misc.hs --- a/src/library/Yi/Buffer/Misc.hs +++ b/src/library/Yi/Buffer/Misc.hs @@ -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"))) diff --git a/src/library/Yi/Buffer/Normal.hs b/src/library/Yi/Buffer/Normal.hs --- a/src/library/Yi/Buffer/Normal.hs +++ b/src/library/Yi/Buffer/Normal.hs @@ -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 - diff --git a/src/library/Yi/Buffer/Region.hs b/src/library/Yi/Buffer/Region.hs --- a/src/library/Yi/Buffer/Region.hs +++ b/src/library/Yi/Buffer/Region.hs @@ -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')) diff --git a/src/library/Yi/Buffer/TextUnit.hs b/src/library/Yi/Buffer/TextUnit.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Buffer/TextUnit.hs @@ -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 + diff --git a/src/library/Yi/Config/Default.hs b/src/library/Yi/Config/Default.hs --- a/src/library/Yi/Config/Default.hs +++ b/src/library/Yi/Config/Default.hs @@ -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. diff --git a/src/library/Yi/Core.hs b/src/library/Yi/Core.hs --- a/src/library/Yi/Core.hs +++ b/src/library/Yi/Core.hs @@ -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 diff --git a/src/library/Yi/Editor.hs b/src/library/Yi/Editor.hs --- a/src/library/Yi/Editor.hs +++ b/src/library/Yi/Editor.hs @@ -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) }) diff --git a/src/library/Yi/File.hs b/src/library/Yi/File.hs --- a/src/library/Yi/File.hs +++ b/src/library/Yi/File.hs @@ -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 diff --git a/src/library/Yi/History.hs b/src/library/Yi/History.hs --- a/src/library/Yi/History.hs +++ b/src/library/Yi/History.hs @@ -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 () diff --git a/src/library/Yi/IReader.hs b/src/library/Yi/IReader.hs --- a/src/library/Yi/IReader.hs +++ b/src/library/Yi/IReader.hs @@ -6,12 +6,14 @@ -- \"incremental reading\", see . 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 diff --git a/src/library/Yi/JumpList.hs b/src/library/Yi/JumpList.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/JumpList.hs @@ -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) = "" + +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 diff --git a/src/library/Yi/Keymap.hs b/src/library/Yi/Keymap.hs --- a/src/library/Yi/Keymap.hs +++ b/src/library/Yi/Keymap.hs @@ -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 , will "exit" diff --git a/src/library/Yi/Keymap/Emacs.hs b/src/library/Yi/Keymap/Emacs.hs --- a/src/library/Yi/Keymap/Emacs.hs +++ b/src/library/Yi/Keymap/Emacs.hs @@ -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 >> diff --git a/src/library/Yi/Keymap/Vim.hs b/src/library/Yi/Keymap/Vim.hs --- a/src/library/Yi/Keymap/Vim.hs +++ b/src/library/Yi/Keymap/Vim.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2.hs b/src/library/Yi/Keymap/Vim2.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2/Common.hs b/src/library/Yi/Keymap/Vim2/Common.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Common.hs @@ -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 + } diff --git a/src/library/Yi/Keymap/Vim2/Digraph.hs b/src/library/Yi/Keymap/Vim2/Digraph.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Digraph.hs @@ -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", '˚') + ] diff --git a/src/library/Yi/Keymap/Vim2/Eval.hs b/src/library/Yi/Keymap/Vim2/Eval.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Eval.hs @@ -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 } diff --git a/src/library/Yi/Keymap/Vim2/EventUtils.hs b/src/library/Yi/Keymap/Vim2/EventUtils.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/EventUtils.hs @@ -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 = + [ ("", KEsc) + , ("", KEnter) + , ("", KBS) + , ("", KTab) + , ("", KDown) + , ("", KUp) + , ("", KLeft) + , ("", KRight) + , ("", KPageUp) + , ("", KPageDown) + , ("", KHome) + , ("", KEnd) + , ("", KIns) + , ("", KDel) + ] + +stringToEvent :: String -> Event +stringToEvent ('<':'C':'-':c:'>':[]) = ctrlCh c +stringToEvent "" = 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 '<') []) = "" +eventToString (Event (KASCII c) []) = [c] +eventToString (Event (KASCII c) [MCtrl]) = ['<', 'C', '-', c, '>'] +eventToString (Event (KASCII c) [MShift]) = [toUpper c] +eventToString (Event (KFun 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 diff --git a/src/library/Yi/Keymap/Vim2/Ex.hs b/src/library/Yi/Keymap/Vim2/Ex.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex.hs @@ -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 + ] diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/BufferDelete.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/BufferDelete.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/BufferDelete.hs @@ -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 + } diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Common.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Common.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Common.hs @@ -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 } diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Delete.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Delete.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Delete.hs @@ -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 + } diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Edit.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Edit.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Edit.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Global.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Global.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Global.hs @@ -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] diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/GotoLine.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/GotoLine.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/GotoLine.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Nohl.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Nohl.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Nohl.hs @@ -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" + } diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Paste.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Paste.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Paste.hs @@ -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) } diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Quit.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Quit.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Quit.hs @@ -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)) diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Reload.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Reload.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Reload.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Substitute.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Substitute.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Substitute.hs @@ -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 + } diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Write.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Write.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Write.hs @@ -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 + } diff --git a/src/library/Yi/Keymap/Vim2/Ex/Commands/Yi.hs b/src/library/Yi/Keymap/Vim2/Ex/Commands/Yi.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Commands/Yi.hs @@ -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 + } diff --git a/src/library/Yi/Keymap/Vim2/Ex/Eval.hs b/src/library/Yi/Keymap/Vim2/Ex/Eval.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Eval.hs @@ -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 () diff --git a/src/library/Yi/Keymap/Vim2/Ex/Types.hs b/src/library/Yi/Keymap/Vim2/Ex/Types.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Ex/Types.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2/ExMap.hs b/src/library/Yi/Keymap/Vim2/ExMap.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/ExMap.hs @@ -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 == "" + 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 "" (VimState { vsMode = Ex, vsOngoingInsertEvents = [] }) + = WholeMatch () + prereq evs (VimState { vsMode = Ex }) + = matchFromBool $ evs `elem` ["", ""] + 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 == "" + , 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 == ""] + 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 = + [ ("", historyUp) + , ("", historyUp) + , ("", historyDown) + , ("", historyDown) + ] + +editAction :: EventString -> EditorM RepeatToken +editAction evs = do + withBuffer0 $ case evs of + (c:[]) -> insertB c + "" -> deleteB Character Backward + "" -> deleteB Character Backward + "" -> do + r <- regionOfPartNonEmptyB unitViWordOnLine Backward + deleteRegionB r + "" -> return () -- TODO + "" -> insertB '<' + "" -> deleteB Character Forward + "" -> moveXorSol 1 + "" -> moveXorSol 1 + "" -> moveXorEol 1 + "" -> moveXorEol 1 + "" -> moveToSol + "" -> moveToSol + "" -> moveToEol + "" -> moveToEol + "" -> moveToSol >> deleteToEol + "" -> deleteToEol + evs' -> error $ "Unhandled event " ++ evs' ++ " in ex mode" + command <- withBuffer0 elemsB + historyPrefixSet command + modifyStateE $ \state -> state { + vsOngoingInsertEvents = command + } + return Drop diff --git a/src/library/Yi/Keymap/Vim2/InsertMap.hs b/src/library/Yi/Keymap/Vim2/InsertMap.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/InsertMap.hs @@ -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` ["", ""] + 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` ["", ""] + prereq _ _ = NoMatch + action evs = withBuffer0 $ do + case evs of + "" -> insertB '<' + "" -> newlineB + "" -> insertB '\t' + "" -> deleteB Character Backward + "" -> deleteB Character Backward + "" -> 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 "" (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 "" (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 "" (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 + "" -> 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 + "" -> insertN $ replicate 4 ' ' + "" -> shiftIndentOfRegion 1 =<< regionOfB Line + "" -> shiftIndentOfRegion (-1) =<< regionOfB Line + "" -> insertCharWithBelowB + "" -> insertCharWithAboveB + "" -> deleteB Character Backward + "" -> deleteB Character Backward + "" -> deleteB Character Forward + "" -> deleteRegionB =<< regionOfPartNonEmptyB unitViWordOnLine Backward + "" -> 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` ["", ""] + prereq _ _ = NoMatch + action evs = do + let _direction = if evs == "" then Forward else Backward + completeWordB + return Continue + +cursorBinding :: VimBinding +cursorBinding = VimBindingE prereq action + where prereq evs (VimState { vsMode = (Insert _) }) = + matchFromBool $ evs `elem` ["", "", "", ""] + prereq _ _ = NoMatch + action evs = do + let WholeMatch (Move _style _isJump move) = stringToMove evs + withBuffer0 $ move Nothing + return Continue diff --git a/src/library/Yi/Keymap/Vim2/MatchResult.hs b/src/library/Yi/Keymap/Vim2/MatchResult.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/MatchResult.hs @@ -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" diff --git a/src/library/Yi/Keymap/Vim2/Motion.hs b/src/library/Yi/Keymap/Vim2/Motion.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Motion.hs @@ -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) + , ("", False, discard . lineMoveRel) + , ("", 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 + , ("", False, scrollScreensB . negate) + , ("", False, scrollScreensB . negate) + , ("", False, scrollScreensB) + , ("", 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) + , ("", False, moveXorSol) + , ("", 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 + , ("", 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) + , ("", 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 diff --git a/src/library/Yi/Keymap/Vim2/NormalMap.hs b/src/library/Yi/Keymap/Vim2/NormalMap.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/NormalMap.hs @@ -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) + , ("", 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') + , ("", 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)) + , ("", 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) + , ("", printFileInfoE, resetCount) + , ("c", tryCloseE, resetCount) + , ("o", closeOtherE, resetCount) + , ("s", splitE, resetCount) + , ("w", nextWinE, resetCount) + , ("", nextWinE, resetCount) + , ("W", prevWinE, resetCount) + , ("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 diff --git a/src/library/Yi/Keymap/Vim2/NormalOperatorPendingMap.hs b/src/library/Yi/Keymap/Vim2/NormalOperatorPendingMap.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/NormalOperatorPendingMap.hs @@ -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 + "" -> 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") +-- v2V3w -> (Just 6, "", "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 | "" `isPrefixOf` s = go [] count ("":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" diff --git a/src/library/Yi/Keymap/Vim2/Operator.hs b/src/library/Yi/Keymap/Vim2/Operator.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Operator.hs @@ -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 "" 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 "" `isSuffixOf` name then "" else [last name] diff --git a/src/library/Yi/Keymap/Vim2/ReplaceMap.hs b/src/library/Yi/Keymap/Vim2/ReplaceMap.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/ReplaceMap.hs @@ -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 + "" -> insertOrReplaceB '\n' + -- For testing purposes assume noexpandtab, tw=4 + "" -> replicateM_ 4 $ insertOrReplaceB ' ' + "" -> return () -- TODO + "" -> return () -- TODO + "" -> insertOrReplaceCharWithBelowB + "" -> insertOrReplaceCharWithAboveB + "" -> return () -- TODO + "" -> return () -- TODO + "" -> return () -- TODO + "" -> return () -- TODO + "" -> return () -- TODO + "" -> 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 diff --git a/src/library/Yi/Keymap/Vim2/ReplaceSingleCharMap.hs b/src/library/Yi/Keymap/Vim2/ReplaceSingleCharMap.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/ReplaceSingleCharMap.hs @@ -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 + "" -> replaceCharB '<' + "" -> replaceCharWithBelowB + "" -> 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 diff --git a/src/library/Yi/Keymap/Vim2/Search.hs b/src/library/Yi/Keymap/Vim2/Search.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Search.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2/SearchMotionMap.hs b/src/library/Yi/Keymap/Vim2/SearchMotionMap.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/SearchMotionMap.hs @@ -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 "" (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 = [ ("", isearchDelE) + , ("", isearchDelE) + , ("", isearchHistory 1) + , ("", isearchHistory 1) + , ("", isearchHistory (-1)) + , ("", isearchHistory (-1)) + , ("", 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 diff --git a/src/library/Yi/Keymap/Vim2/StateUtils.hs b/src/library/Yi/Keymap/Vim2/StateUtils.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/StateUtils.hs @@ -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 } diff --git a/src/library/Yi/Keymap/Vim2/StyledRegion.hs b/src/library/Yi/Keymap/Vim2/StyledRegion.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/StyledRegion.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2/TextObject.hs b/src/library/Yi/Keymap/Vim2/TextObject.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/TextObject.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2/Utils.hs b/src/library/Yi/Keymap/Vim2/Utils.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/Utils.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim2/VisualMap.hs b/src/library/Yi/Keymap/Vim2/VisualMap.hs new file mode 100644 --- /dev/null +++ b/src/library/Yi/Keymap/Vim2/VisualMap.hs @@ -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` ["", ""] + 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", ""] = WholeMatch () + prereq _ _ = NoMatch + action evs = do + currentMode <- fmap vsMode getDynamic + let newStyle = case evs of + "v" -> Inclusive + "V" -> LineWise + "" -> Block + _ -> error "Can't happen because of prereq, this just prevents warning" + newMode = Visual newStyle + if newMode == currentMode + then do + vbeAction escBinding "" + 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 diff --git a/src/library/Yi/Lexer/Haskell.x b/src/library/Yi/Lexer/Haskell.x --- a/src/library/Yi/Lexer/Haskell.x +++ b/src/library/Yi/Lexer/Haskell.x @@ -184,6 +184,8 @@ ReservedOp _ -> operatorStyle Reserved Import -> importStyle Reserved Qualified -> importStyle + Reserved As -> importStyle + Reserved Hiding -> importStyle Reserved _ -> keywordStyle Special _ -> defaultStyle ConsOperator _ -> operatorStyle diff --git a/src/library/Yi/Main.hs b/src/library/Yi/Main.hs --- a/src/library/Yi/Main.hs +++ b/src/library/Yi/Main.hs @@ -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 diff --git a/src/library/Yi/Misc.hs b/src/library/Yi/Misc.hs --- a/src/library/Yi/Misc.hs +++ b/src/library/Yi/Misc.hs @@ -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 + , "]" + ] diff --git a/src/library/Yi/Mode/Interactive.hs b/src/library/Yi/Mode/Interactive.hs --- a/src/library/Yi/Mode/Interactive.hs +++ b/src/library/Yi/Mode/Interactive.hs @@ -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, diff --git a/src/library/Yi/Paths.hs b/src/library/Yi/Paths.hs --- a/src/library/Yi/Paths.hs +++ b/src/library/Yi/Paths.hs @@ -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. diff --git a/src/library/Yi/Prelude.hs b/src/library/Yi/Prelude.hs --- a/src/library/Yi/Prelude.hs +++ b/src/library/Yi/Prelude.hs @@ -5,6 +5,7 @@ (<>), (++), -- consider scrapping this and replacing it by the above (=<<), +(<=<), ($!), Double, Binary, diff --git a/src/library/Yi/Search.hs b/src/library/Yi/Search.hs --- a/src/library/Yi/Search.hs +++ b/src/library/Yi/Search.hs @@ -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, diff --git a/src/library/Yi/Style/Library.hs b/src/library/Yi/Style/Library.hs --- a/src/library/Yi/Style/Library.hs +++ b/src/library/Yi/Style/Library.hs @@ -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. diff --git a/src/library/Yi/Tag.hs b/src/library/Yi/Tag.hs --- a/src/library/Yi/Tag.hs +++ b/src/library/Yi/Tag.hs @@ -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, diff --git a/src/library/Yi/UI/Utils.hs b/src/library/Yi/UI/Utils.hs --- a/src/library/Yi/UI/Utils.hs +++ b/src/library/Yi/UI/Utils.hs @@ -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) diff --git a/src/library/Yi/UI/Vty.hs b/src/library/Yi/UI/Vty.hs --- a/src/library/Yi/UI/Vty.hs +++ b/src/library/Yi/UI/Vty.hs @@ -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 + --------------------------------- diff --git a/src/library/Yi/Window.hs b/src/library/Yi/Window.hs --- a/src/library/Yi/Window.hs +++ b/src/library/Yi/Window.hs @@ -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 diff --git a/src/tests/Driver.hs b/src/tests/Driver.hs deleted file mode 100644 --- a/src/tests/Driver.hs +++ /dev/null @@ -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) - diff --git a/src/tests/TestSuite.hs b/src/tests/TestSuite.hs --- a/src/tests/TestSuite.hs +++ b/src/tests/TestSuite.hs @@ -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 diff --git a/yi.cabal b/yi.cabal --- a/yi.cabal +++ b/yi.cabal @@ -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 +