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 @@ -107,7 +107,6 @@ alex_action_16 = c Unrecognized {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -125,6 +124,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -132,11 +132,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -179,6 +179,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -267,7 +268,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -283,7 +284,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -85,7 +85,6 @@ alex_action_19 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -103,6 +102,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -110,11 +110,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -157,6 +157,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -245,7 +246,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -261,7 +262,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -81,7 +81,6 @@ alex_action_16 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -99,6 +98,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -106,11 +106,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -148,6 +148,7 @@ #else indexInt32OffAddr# arr off #endif + 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 @@ -64,7 +64,6 @@ in (st, Report (fst $ arr!1) (read $ fst $ arr!2) 0 (fst $ arr!3)) {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -82,6 +81,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -89,11 +89,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -136,6 +136,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -224,7 +225,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -240,7 +241,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -82,7 +82,6 @@ alex_action_17 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -100,6 +99,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -107,11 +107,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -154,6 +154,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -242,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 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -258,7 +259,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -119,7 +119,6 @@ alex_action_30 = c Style.commentStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -137,6 +136,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -144,11 +144,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -186,6 +186,7 @@ #else indexInt32OffAddr# arr off #endif + 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 @@ -98,7 +98,6 @@ alex_action_23 = c Style.defaultStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -116,6 +115,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -123,11 +123,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -165,6 +165,7 @@ #else indexInt32OffAddr# arr off #endif + 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 @@ -208,7 +208,6 @@ alex_action_52 = c Unrecognized {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -226,6 +225,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -233,11 +233,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -275,6 +275,7 @@ #else indexInt32OffAddr# arr off #endif + 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 @@ -59,7 +59,6 @@ alex_action_4 = c defaultStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -77,6 +76,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -84,11 +84,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -131,6 +131,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -219,7 +220,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -235,7 +236,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -84,7 +84,6 @@ alex_action_18 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -102,6 +101,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -109,11 +109,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -156,6 +156,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -244,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 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -260,7 +261,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -232,7 +232,6 @@ alex_action_21 = c $ Comment Text {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -250,6 +249,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -257,11 +257,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -304,6 +304,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -392,7 +393,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -408,7 +409,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -400,7 +400,6 @@ alex_action_7 = c $ Text {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -418,6 +417,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -425,11 +425,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -472,6 +472,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -560,7 +561,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -576,7 +577,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -140,7 +140,6 @@ alex_action_81 = c Unrecognized {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -158,6 +157,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -165,11 +165,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -207,6 +207,7 @@ #else indexInt32OffAddr# arr off #endif + 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 @@ -93,7 +93,6 @@ alex_action_16 = c Operator {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -111,6 +110,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -118,11 +118,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -165,6 +165,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -253,7 +254,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -269,7 +270,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -83,7 +83,6 @@ alex_action_17 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -101,6 +100,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -108,11 +108,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -155,6 +155,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -243,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 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -259,7 +260,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -90,7 +90,6 @@ alex_action_28 = c defaultStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -108,6 +107,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -115,11 +115,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -162,6 +162,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -250,7 +251,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -266,7 +267,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -294,7 +294,6 @@ alex_action_62 = c stringStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -312,6 +311,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -319,11 +319,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -361,6 +361,7 @@ #else indexInt32OffAddr# arr off #endif + 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 @@ -66,7 +66,6 @@ alex_action_9 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -84,6 +83,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -91,11 +91,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -138,6 +138,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -226,7 +227,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -242,7 +243,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -71,7 +71,6 @@ alex_action_14 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -89,6 +88,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -96,11 +96,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -143,6 +143,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -231,7 +232,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -247,7 +248,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -71,7 +71,6 @@ alex_action_5 = c Style.commentStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -89,6 +88,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -96,11 +96,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -138,6 +138,7 @@ #else indexInt32OffAddr# arr off #endif + 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 @@ -83,7 +83,6 @@ alex_action_11 = c keywordStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -101,6 +100,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -108,11 +108,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -155,6 +155,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -243,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 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -259,7 +260,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "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 @@ -66,7 +66,6 @@ alex_action_3 = c commentStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -{-# LINE 1 "" #-} {-# LINE 1 "" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- ----------------------------------------------------------------------------- @@ -84,6 +83,7 @@ +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ > 706 #define GTE(n,m) (tagToEnum# (n >=# m)) #define EQ(n,m) (tagToEnum# (n ==# m)) @@ -91,11 +91,11 @@ #define GTE(n,m) (n >=# m) #define EQ(n,m) (n ==# m) #endif -{-# LINE 50 "templates/GenericTemplate.hs" #-} +{-# LINE 51 "templates/GenericTemplate.hs" #-} data AlexAddr = AlexA# Addr# - +-- Do not remove this comment. Required to fix CPP parsing when using GCC and a clang-compiled alex. #if __GLASGOW_HASKELL__ < 503 uncheckedShiftL# = shiftL# #endif @@ -138,6 +138,7 @@ + #if __GLASGOW_HASKELL__ < 503 quickIndex arr i = arr ! i #else @@ -226,7 +227,7 @@ check_accs (AlexAccNone) = last_acc check_accs (AlexAcc a ) = AlexLastAcc a input (I# (len)) check_accs (AlexAccSkip) = AlexLastSkip input (I# (len)) -{-# LINE 196 "templates/GenericTemplate.hs" #-} +{-# LINE 198 "templates/GenericTemplate.hs" #-} data AlexLastAcc a = AlexNone @@ -242,7 +243,7 @@ = AlexAccNone | AlexAcc a | AlexAccSkip -{-# LINE 240 "templates/GenericTemplate.hs" #-} +{-# LINE 242 "templates/GenericTemplate.hs" #-} -- used by wrappers iUnbox (I# (i)) = i diff --git a/src/library/Yi/UI/Cocoa.hs b/src/library/Yi/UI/Cocoa.hs deleted file mode 100644 --- a/src/library/Yi/UI/Cocoa.hs +++ /dev/null @@ -1,416 +0,0 @@ -{-# LANGUAGE TemplateHaskell, ForeignFunctionInterface, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-} --- --- Copyright (c) 2007, 2008 Jean-Philippe Bernardy --- Copyright (c) 2008 Gustav Munkby --- - --- | This module defines a user interface implemented using Cocoa. - -module Yi.UI.Cocoa (start) where - -import Prelude (Float) - -import Yi.UI.Cocoa.Application -import Yi.UI.Cocoa.TextStorage -import Yi.UI.Cocoa.TextView -import Yi.UI.Cocoa.Utils - -import Yi.Prelude hiding (init) -import Yi.Buffer -import Yi.Editor -import Yi.Keymap -import Yi.Monad -import Yi.Config -import Yi.Rectangle -import Yi.String -import qualified Yi.UI.Common as Common -import qualified Yi.Style as Style -import Yi.Window -import Paths_yi (getDataFileName) - -import Control.Monad.Reader (when) - -import qualified Data.List as L -import qualified Data.List.PointedList.Circular as PL -import Data.IORef -import Data.Maybe -import Data.Monoid -import Data.Unique - --- Specify Cocoa imports explicitly, to avoid name-clashes. --- Since the number of functions recognized by HOC varies --- between revisions, this seems like the safest choice. -import HOC -import Foundation ( - NSPoint(..),NSRect(..),NSRange(..),NSSize(..),nsHeight,nsWidth, - _NSThread,detachNewThreadSelectorToTargetWithObject,alloc,init, - NSObject,toNSString,respondsToSelector,_NSMutableArray,array, - _NSValue,valueWithRange,addObject,NSMutableArray) -import AppKit ( - frame,bounds,setFrame,NSView,_NSView,NSTextField,_NSTextField, - NSCell,_NSSplitView,_NSImage,NSApplication,sharedApplication, - terminate_,run,setApplicationIconImage,NSWindow,_NSWindow,_NSMenu, - activateIgnoringOtherApps,makeKeyAndOrderFront,setMainMenu, - addSubview,removeFromSuperview,Has_setBackgroundColor, - Has_setTextColor,NSSplitView,_NSFont,addSubviewPositionedRelativeTo, - fontWithNameSize,setUserFixedPitchFont,userFixedPitchFontOfSize, - adjustSubviews,cell,center,containerSize,nsWindowBelow, - initWithContentRectStyleMaskBackingDefer,initWithContentsOfFile, - initWithFrame,layoutManager,makeFirstResponder, - nsBackingStoreBuffered,nsClosableWindowMask,nsLeftTextAlignment, - nsLineBreakByTruncatingMiddle,nsMiniaturizableWindowMask, - nsResizableWindowMask,nsTitledWindowMask,nsViewHeightSizable, - nsViewMaxYMargin,nsViewNotSizable,nsViewWidthSizable, - performMiniaturize,replaceTextStorage,scrollRangeToVisible, - setAlignment,setAutodisplay,setAutohidesScrollers, - setAutoresizingMask,setBackgroundColor,setBezeled,setBordered, - setContainerSize,setDelegate,setDocumentView,setEditable, - setFrameAutosaveName,setHasHorizontalScroller,setHasVerticalScroller, - setHorizontallyResizable,setInsertionPointColor,setLineBreakMode, - setRichText,setSelectable,setSelectedRanges,NSLayoutManager, - setSelectedTextAttributes,setStringValue,setTextColor,setTitle, - setVerticallyResizable,setWidthTracksTextView,setWindowsMenu, - setWraps,sizeToFit,textColor,textContainer) - -import qualified AppKit.NSWindow -import qualified AppKit.NSView - -import Foreign.C -import Foreign hiding (new) - -foreign import ccall "Processes.h TransformProcessType" transformProcessType :: Ptr (CInt) -> CInt -> IO (CInt) -foreign import ccall "Processes.h SetFrontProcess" setFrontProcess :: Ptr (CInt) -> IO (CInt) -foreign import ccall "Processes.h GetCurrentProcess" getCurrentProcess :: Ptr (CInt) -> IO (CInt) - --- Don't import this, since it is only available in Leopard... -$(declareRenamedSelector "setAllowsNonContiguousLayout:" "setAllowsNonContiguousLayout" [t| Bool -> IO () |]) -instance Has_setAllowsNonContiguousLayout (NSLayoutManager a) -_silenceWarning :: ImpType_setAllowsNonContiguousLayout a b -_silenceWarning = undefined - ------------------------------------------------------------------------- - -data UI = UI {uiWindow :: NSWindow () - ,uiBox :: NSSplitView () - ,uiCmdLine :: NSTextField () - ,windowCache :: IORef [WinInfo] - ,uiActionCh :: Action -> IO () - ,uiFullConfig :: Config - } - -uiConfig :: UI -> UIConfig -uiConfig = configUI . uiFullConfig - -data WinInfo = WinInfo - { wikey :: !Unique -- ^ Uniquely identify each window - , window :: Window -- ^ The editor window that we reflect - , textview :: YiTextView () - , modeline :: NSTextField () - , widget :: NSView () -- ^ Top-level widget for this window. - , storage :: TextStorage - } - -mkUI :: UI -> Common.UI -mkUI ui = Common.dummyUI - { Common.main = main - , Common.end = const end - , Common.suspend = uiWindow ui # performMiniaturize nil - , Common.refresh = refresh ui - } - -mkRect :: Float -> Float -> Float -> Float -> NSRect -mkRect x y w h = NSRect (NSPoint x y) (NSSize w h) - -allSizable, normalWindowMask :: CUInt -allSizable = nsViewWidthSizable .|. nsViewHeightSizable -normalWindowMask = - nsTitledWindowMask .|. nsResizableWindowMask .|. nsClosableWindowMask .|. nsMiniaturizableWindowMask - -initWithContentRect :: NSRect -> NewlyAllocated (NSWindow ()) -> IO (NSWindow ()) -initWithContentRect r = - initWithContentRectStyleMaskBackingDefer r normalWindowMask nsBackingStoreBuffered True - -toNSView :: forall t. ID () -> NSView t -toNSView = castObject - -toYiApplication :: forall t1 t2. NSApplication t1 -> YiApplication t2 -toYiApplication = castObject -toYiController :: forall t1 t2. NSObject t1 -> YiController t2 -toYiController = castObject - -newTextLine :: IO (NSTextField ()) -newTextLine = do - tl <- new _NSTextField - tl # setAlignment nsLeftTextAlignment - tl # setAutoresizingMask (nsViewWidthSizable .|. nsViewMaxYMargin) - tl # setMonospaceFont - tl # setSelectable True - tl # setEditable False - tl # setBezeled False - tl # sizeToFit - cl <- castObject <$> tl # cell :: IO (NSCell ()) - cl # setWraps False - cl # setLineBreakMode nsLineBreakByTruncatingMiddle - return tl - -addSubviewWithTextLine :: Maybe (NSView t0) -> NSView t1 -> NSView t2 -> IO (NSTextField (), NSView ()) -addSubviewWithTextLine sibling view parent = do - container <- new _NSView - parent # bounds >>= flip setFrame container - container # setAutoresizingMask allSizable - view # setAutoresizingMask allSizable - container # addSubview view - - text <- newTextLine - container # addSubview text - case sibling of - Nothing -> parent # addSubview container - Just v -> parent # addSubviewPositionedRelativeTo container nsWindowBelow v - - -- Adjust frame sizes, as superb cocoa cannot do this itself... - txtbox <- text # frame - winbox <- container # bounds - view # setFrame (mkRect 0 (nsHeight txtbox) (nsWidth winbox) (nsHeight winbox - nsHeight txtbox)) - text # setFrame (mkRect 0 0 (nsWidth winbox) (nsHeight txtbox)) - - return (text, container) - --- | Initialise the ui -start :: UIBoot -start cfg ch outCh _ed = do - - -- Ensure that our command line application is also treated as a gui application - fptr <- mallocForeignPtrBytes 32 -- way to many bytes, but hey... - withForeignPtr fptr $ getCurrentProcess - withForeignPtr fptr $ (flip transformProcessType) 1 - withForeignPtr fptr $ setFrontProcess - - -- Publish Objective-C classes... - initializeClass_Application - initializeClass_YiTextView - initializeClass_TextStorage - initializeClass_YiScrollView - - app <- _YiApplication # sharedApplication >>= return . toYiApplication - app # setIVar _eventChannel (Just ch) - app # setIVar _runAction (Just $ outCh . singleton . makeAction) - - -- Multithreading in Cocoa is initialized by spawning a new thread - -- This spawns a thread that immediately exits, but that's okay - _NSThread # detachNewThreadSelectorToTargetWithObject - (getSelectorForName "sharedApplication") _YiApplication nil - - -- Set the application icon accordingly - icon <- getDataFileName "art/yi+lambda-fat.pdf" - _NSImage # alloc >>= - initWithContentsOfFile (toNSString icon) >>= - flip setApplicationIconImage app - - -- Initialize the app delegate, which allows quit-on-window-close - controller <- autonew _YiController >>= return . toYiController - app # setDelegate controller - - -- init menus - mm <- _NSMenu # alloc >>= init - mm' <- _NSMenu # alloc >>= init - mm'' <- _NSMenu # alloc >>= init - app # setMainMenu mm - app # setAppleMenu mm' - app # setWindowsMenu mm'' - - - -- Create main cocoa window... - win <- _NSWindow # alloc >>= initWithContentRect (mkRect 0 0 480 340) - win # setTitle (toNSString "Yi") - content <- win # AppKit.NSWindow.contentView >>= return . toNSView - content # setAutoresizingMask allSizable - - -- Update the font configuration - let fontSize = maybe 0 fromIntegral (configFontSize (configUI cfg)) - let fontGetter = maybe userFixedPitchFontOfSize (fontWithNameSize . toNSString) (configFontName (configUI cfg)) - _NSFont # fontGetter fontSize >>= flip setUserFixedPitchFont _NSFont - - -- Create yi window container - winContainer <- new _NSSplitView - (cmd,_) <- content # addSubviewWithTextLine Nothing winContainer - - -- Activate application window - win # center - win # setFrameAutosaveName (toNSString "main") - win # makeKeyAndOrderFront nil - app # activateIgnoringOtherApps False - - wc <- newIORef [] - - let ui = UI win winContainer cmd wc (outCh . singleton) cfg - - cmd # setColors (Style.baseAttributes $ configStyle $ uiConfig ui) - - return (mkUI ui) - --- | Run the main loop -main :: IO () -main = _YiApplication # sharedApplication >>= run - --- | Clean up and go home -end :: IO () -end = _YiApplication # sharedApplication >>= terminate_ nil - -syncWindows :: Editor -> UI -> [(Window, Bool)] -> [WinInfo] -> IO [WinInfo] -syncWindows e ui = sync - where - sync ws [] = mapM (insert Nothing) ws - sync [] cs = mapM_ remove cs >> return [] - sync (w:ws) (c:cs) - | match w c = (:) <$> update w c <*> sync ws cs - | L.any (match w) cs = remove c >> sync (w:ws) cs - | otherwise = (:) <$> insert (Just $ widget c) w <*> sync ws (c:cs) - - match w c = winkey (fst w) == winkey (window c) - - winbuf = flip findBufferWith e . bufkey - - remove = removeFromSuperview . widget - insert before (w,f) = update (w,f) =<< newWindow before ui w (winbuf w) - update (w, False) i = return (i{window = w}) - update (w, True) i = do - (textview i) # AppKit.NSView.window >>= makeFirstResponder (textview i) - return (i{window = w}) - -setColors :: (Has_setBackgroundColor t, Has_setTextColor t) => Style.Attributes -> t -> IO () -setColors s slf = do - getColor True (Style.foreground s) >>= flip setTextColor slf - getColor False (Style.background s) >>= flip setBackgroundColor slf - --- | Make A new window -newWindow :: Maybe (NSView t) -> UI -> Window -> FBuffer -> IO WinInfo -newWindow before ui win b = do - v <- alloc _YiTextView >>= initWithFrame (mkRect 0 0 100 100) - v # setRichText False - v # setSelectable True - v # setAlignment nsLeftTextAlignment - v # sizeToFit - let sty = configStyle $ uiConfig ui - ground = Style.baseAttributes sty - attrs <- convertAttributes $ appEndo (Style.selectedStyle sty) $ ground - v # setSelectedTextAttributes attrs - v # setColors ground - v # textColor >>= flip setInsertionPointColor v - - (ml, view) <- if (isMini win) - then do - v # setHorizontallyResizable False - v # setVerticallyResizable False - prompt <- newTextLine - prompt # setStringValue (toNSString $ miniIdentString b) - prompt # sizeToFit - prompt # setAutoresizingMask nsViewNotSizable - prompt # setBordered False - prompt # setColors ground - - prect <- prompt # frame - vrect <- v # frame - - hb <- _NSView # alloc >>= initWithFrame (mkRect 0 0 (nsWidth prect + nsWidth vrect) (nsHeight prect)) - v # setFrame (mkRect (nsWidth prect) 0 (nsWidth vrect) (nsHeight prect)) - v # setAutoresizingMask nsViewWidthSizable - hb # addSubview prompt - hb # addSubview v - hb # setAutoresizingMask nsViewWidthSizable - - brect <- (uiBox ui) # bounds - hb # setFrame (mkRect 0 0 (nsWidth brect) (nsHeight prect)) - - (uiBox ui) # addSubview hb - dummy <- _NSTextField # alloc >>= init - - return (dummy, hb) - else do - v # setHorizontallyResizable True - v # setVerticallyResizable True - - when (not $ configLineWrap $ uiConfig ui) $ do - tc <- v # textContainer - NSSize _ h <- tc # containerSize - tc # setContainerSize (NSSize 1.0e7 h) - tc # setWidthTracksTextView False - - scroll <- new _YiScrollView - scroll # setDocumentView v - scroll # setAutoresizingMask allSizable - - scroll # setHasVerticalScroller True - scroll # setHasHorizontalScroller False - scroll # setAutohidesScrollers (configAutoHideScrollBar $ uiConfig ui) - scroll # setIVar _leftScroller (configLeftSideScrollBar $ uiConfig ui) - addSubviewWithTextLine before scroll (uiBox ui) - - -- TODO: Support focused modeline... - ml # setColors (Style.modelineAttributes sty) - s <- newTextStorage (configStyle $ uiConfig ui) (snd $ runBuffer win b revertPendingUpdatesB) win - layoutManager v >>= replaceTextStorage s - - responds <- layoutManager v >>= respondsToSelector (getSelectorForName "setAllowsNonContiguousLayout:") - when responds $ layoutManager v >>= setAllowsNonContiguousLayout True - - k <- newUnique - flip (setIVar _runBuffer) v $ \act -> do - wCache <- readIORef (windowCache ui) - uiActionCh ui $ makeAction $ do - (modA windowsA) $ fromJust . (PL.move $ fromJust $ L.findIndex ((k ==) . wikey) wCache) - withGivenBufferAndWindow0 win (bkey b) act - - return $ WinInfo - { wikey = k - , window = win - , textview = v - , modeline = ml - , widget = view - , storage = s - } - -getSelectedRegions :: BufferM [NSRange] -getSelectedRegions = do - rect <- getA rectangleSelectionA - if (not rect) - then singleton <$> mkRegionRange <$> getSelectRegionB - else do - (reg, x1, x2) <- getRectangle - ls <- fmap (fromIntegral . L.length) <$> lines' <$> readRegionB reg - return $ fmap mkRegionRange $ catMaybes $ snd $ L.mapAccumL - (lineRegions (fromIntegral x1) (fromIntegral x2)) (regionStart reg) ls - where - lineRegions :: Size -> Size -> Point -> Size -> (Point, Maybe Region) - lineRegions x1 x2 p l - | l <= x1 = (p +~ succ l, Nothing) - | l <= x2 = (p +~ succ l, Just $ mkRegion (p+~x1) (p +~ l)) - | otherwise = (p +~ succ l, Just $ mkRegion (p+~x1) (p +~ x2)) - - -refresh :: UI -> Editor -> IO () -refresh ui e = withAutoreleasePool $ logNSException "refresh" $ do - _YiApplication # sharedApplication >>= - pushClipboard (snd $ runEditor (uiFullConfig ui) getRegE e) . toYiApplication - - (uiCmdLine ui) # setStringValue (toNSString $ L.intercalate "\n" $ statusLine e) - - cache <- readRef $ windowCache ui - (uiWindow ui) # setAutodisplay False -- avoid redrawing while window syncing - cache' <- syncWindows e ui (toList $ PL.withFocus $ windows e) cache - writeRef (windowCache ui) cache' - (uiBox ui) # adjustSubviews -- FIX: maybe it is not needed - (uiWindow ui) # setAutodisplay True -- reenable automatic redrawing - - forM_ cache' $ \w -> - do let buf = findBufferWith (bufkey (window w)) e - (storage w) # setMonospaceFont -- FIXME: Why is this needed for mini buffers? - (storage w) # setTextStorageBuffer e buf - - let ((p0,txt,rs),_) = runBuffer (window w) buf $ - (,,) <$> pointB <*> getModeLine (commonNamePrefix e) <*> getSelectedRegions - a <- castObject <$> _NSMutableArray # array :: IO (NSMutableArray ()) - mapM_ ((flip addObject a =<<) . flip valueWithRange _NSValue) rs - (textview w) # setSelectedRanges (castObject a) - (textview w) # scrollRangeToVisible (NSRange (fromIntegral p0) 0) - (modeline w) # setStringValue (toNSString txt) - (textview w) # visibleRange >>= flip visibleRangeChanged (storage w) diff --git a/src/library/Yi/UI/Cocoa/Application.hs b/src/library/Yi/UI/Cocoa/Application.hs deleted file mode 100644 --- a/src/library/Yi/UI/Cocoa/Application.hs +++ /dev/null @@ -1,211 +0,0 @@ -{-# LANGUAGE TemplateHaskell, EmptyDataDecls, MultiParamTypeClasses, - ForeignFunctionInterface, TypeSynonymInstances, - FlexibleInstances, Rank2Types, DeriveDataTypeable #-} - --- --- Copyright (c) 2008 Gustav Munkby --- - --- | This module defines Cocoa event handling - --- For a Cocoa application to work we need to have the Cocoa --- event-loop running. Since we don't want to re-implement the --- event-loop in Haskell, we simply dispatch to the Objective-C --- version and hook into events. --- --- This however, is not completely trivial, since calling the --- long-running Objective-C loop causes Haskell code not to be --- executed at all. Upon receiving an event we must also make --- sure to dispatch to other Haskell threads in order to make --- progress. - - -module Yi.UI.Cocoa.Application - ( YiApplication - , _YiApplication - , YiController - , _YiController - , initializeClass_Application - , _eventChannel - , _runAction - , setAppleMenu - , ImpType_setAppleMenu - , pushClipboard - ) where - -import Prelude () -import Yi.Prelude - -import Control.Concurrent -import Control.Monad - -import Data.Bits - -import Yi.Editor -import Yi.Event -import Yi.UI.Cocoa.Utils - -import Foreign.C - --- Specify Cocoa imports explicitly, to avoid name-clashes. --- Since the number of functions recognized by HOC varies --- between revisions, this seems like the safest choice. -import HOC -import Foundation ( - NSObject,NSObjectClass,NSNotification,synchronize,_NSUserDefaults, - standardUserDefaults,_NSArray,arrayWithObject,haskellString, - _NSTimer,scheduledTimerWithTimeIntervalTargetSelectorUserInfoRepeats, - toNSString,NSObjectMetaClass) -import AppKit ( - NSEvent,NSMenu,NSApplication,NSApplicationClass,run,sendEvent, - applicationShouldTerminateAfterLastWindowClosed,_NSPasteboard, - applicationWillTerminate,generalPasteboard,availableTypeFromArray, - charactersIgnoringModifiers,declareTypesOwner,modifierFlags, - nsKeyDown,nsStringPboardType,setStringForType,changeCount, - stringForType,nsFlagsChanged,NSApplicationMetaClass) - -foreign import ccall "RtsAPI.h shutdownHaskellAndExit" shutdownHaskellAndExit :: CInt -> IO () - --- The selector is used since NSEvent#type treats the c enum --- in a type-safe way, but Cocoa receives values which are not --- defined in the c enum, which results in a pattern mismatch... -$(declareRenamedSelector "type" "rawType" [t| IO CInt |]) -instance Has_rawType (NSEvent a) - --- This declares an application delegate which ensures the application --- terminates when the last (and only) cocoa window is closed -$(declareClass "YiController" "NSObject") -$(exportClass "YiController" "yc_" [ - InstanceMethod 'applicationShouldTerminateAfterLastWindowClosed -- ' - , InstanceMethod 'applicationWillTerminate -- ' - ]) - -yc_applicationShouldTerminateAfterLastWindowClosed :: forall t. NSApplication t -> YiController () -> IO Bool -yc_applicationShouldTerminateAfterLastWindowClosed _app _self = return True - --- Since cocoa application termination is "optimized" by directly --- calling exit, instead of falling out of the run-loop and returning --- to haskell, we need to capture the termination and make sure that --- we can run the haskell termination procedures. --- Without this, profiling cannot be used with the cocoa frontend. --- Unfortunately, graceful termination would require that haskell --- and cocoa was first disconnected so that haskell code can be --- properly terminated using hs_exit/shutdownHaskell. Once this is --- done control can be left to cocoa to perform the final cocoa --- cleanup. This solution can almost certainly not be implemented --- from within haskell. --- For the time being we try to gracefully terminate the haskell --- portions and terminate the cocoa parts more forcefully. Any --- "necessary" cocoa termination activities have to be replicated --- below... -yc_applicationWillTerminate :: forall t. NSNotification t -> YiController () -> IO () -yc_applicationWillTerminate _note _self = do - -- Partially replicate cocoa termination procedure - _NSUserDefaults # standardUserDefaults >>= synchronize - -- Interrupt cocoa and run haskell termination - shutdownHaskellAndExit 0 - ------------------------------------------------------------------------- - --- This declares an application subclass which enables us to insert --- ourselves into the application event loop and trap key-events application wide -$(declareClass "YiApplication" "NSApplication") -$(declareSelector "doTick" [t| IO () |]) -$(declareSelector "setAppleMenu:" [t| forall t. NSMenu t -> IO () |] ) -instance Has_setAppleMenu (NSApplication a) -$(exportClass "YiApplication" "ya_" [ - InstanceVariable "eventChannel" [t| Maybe (Yi.Event.Event -> IO ()) |] [| Nothing |] - , InstanceVariable "runAction" [t| Maybe (EditorM () -> IO ()) |] [| Nothing |] - , InstanceVariable "lastPaste" [t| String |] [| "" |] - , InstanceVariable "lastChangeCount" [t| CInt |] [| 0 |] - , InstanceMethod 'run -- ' - , InstanceMethod 'doTick -- ' - , InstanceMethod 'sendEvent -- ' - ]) - -ya_doTick :: YiApplication () -> IO () -ya_doTick slf = do - pb <- _NSPasteboard # generalPasteboard - cc <- pb # changeCount - oc <- slf #. _lastChangeCount - when (cc /= oc) $ do - slf # setIVar _lastChangeCount cc - ar <- _NSArray # arrayWithObject nsStringPboardType - ty <- pb # availableTypeFromArray (castObject ar) - when (ty /= nil) $ do - news <- pb # stringForType ty >>= haskellString - olds <- slf #. _lastPaste - when (news /= olds) $ do - slf # setIVar _lastPaste news - Just runAct <- slf #. _runAction - runAct (setRegE news) - - replicateM_ 4 yield - -pushClipboard :: String -> YiApplication () -> IO () -pushClipboard news slf = do - olds <- slf #. _lastPaste - when (news /= olds) $ do - slf # setIVar _lastPaste news - ar <- _NSArray # arrayWithObject nsStringPboardType - pb <- _NSPasteboard # generalPasteboard - cc <- pb # declareTypesOwner (castObject ar) nil - pb # setStringForType (toNSString news) nsStringPboardType - slf # setIVar _lastChangeCount cc - return () - -ya_run :: YiApplication () -> IO () -ya_run self = do - -- Schedule a timer that repeatedly invokes ya_doTick in order to have - -- some Haskell code running all the time. This will prevent other - -- Haskell threads to stall while waiting for the Cocoa run loop to finish. - _NSTimer # scheduledTimerWithTimeIntervalTargetSelectorUserInfoRepeats - 0.05 self (getSelectorForName "doTick") nil True - super self # run - -ya_sendEvent :: forall t. NSEvent t -> YiApplication () -> IO () -ya_sendEvent event self = logNSException "sendEvent" $ do - t <- event # (rawType :: ImpType_rawType (NSEvent t) inst) - if t == fromCEnum nsKeyDown - then self #. _eventChannel >>= handleKeyEvent event - else if t == fromCEnum nsFlagsChanged - then do - logPutStrLn $ "Flags changed" - else super self # sendEvent event - -handleKeyEvent :: forall t. NSEvent t -> Maybe (Yi.Event.Event -> IO ()) -> IO () -handleKeyEvent event mch = do - mask <- event # modifierFlags - str <- event # charactersIgnoringModifiers >>= haskellString - logPutStrLn $ "Key " ++ str - let (mk,shift') = case str of - "\r" -> (Just KEnter, True) - "\t" -> (Just KTab, True) - "\DEL" -> (Just KBS, True) - "\ESC" -> (Just KEsc, True) - "\63232" -> (Just KUp, True) - "\63233" -> (Just KDown, True) - "\63234" -> (Just KLeft, True) - "\63235" -> (Just KRight, True) - "\63272" -> (Just KDel, True) - "\63273" -> (Just KHome, True) - "\63275" -> (Just KEnd, True) - "\63276" -> (Just KPageUp, True) - "\63277" -> (Just KPageDown, True) - [c] -> (Just $ KASCII c, False) - _ -> (Nothing, True) - case (mk,mch) of - (Just k, Just ch) -> ch (Event k (modifiers shift' mask)) - _ -> return () - -modifierTable :: Bool -> [(CUInt, Modifier)] -modifierTable False = [(bit 18,MCtrl), (bit 19,MMeta), (bit 20,MSuper)] -modifierTable True = (bit 17,MShift) : modifierTable False - -modifiers :: Bool -> CUInt -> [Modifier] -modifiers shift' mask = [yi | (cocoa, yi) <- modifierTable shift', (cocoa .&. mask) /= 0] - -initializeClass_Application :: IO () -initializeClass_Application = do - initializeClass_YiApplication - initializeClass_YiController diff --git a/src/library/Yi/UI/Cocoa/TextStorage.hs b/src/library/Yi/UI/Cocoa/TextStorage.hs deleted file mode 100644 --- a/src/library/Yi/UI/Cocoa/TextStorage.hs +++ /dev/null @@ -1,434 +0,0 @@ -{-# LANGUAGE TemplateHaskell, EmptyDataDecls, MultiParamTypeClasses, - FlexibleInstances, TypeSynonymInstances, - DeriveDataTypeable, Rank2Types #-} --- --- Copyright (c) 2008 Gustav Munkby --- - --- | An implementation of NSTextStorage that uses Yi's FBuffer as --- the backing store. - -module Yi.UI.Cocoa.TextStorage - ( TextStorage - , initializeClass_TextStorage - , newTextStorage - , setTextStorageBuffer - , visibleRangeChanged - ) where - -import Prelude () -import Yi.Editor (currentRegex, emptyEditor, Editor) -import Yi.Prelude -import Yi.Buffer -import Yi.Style -import Yi.UI.Cocoa.Utils -import Yi.UI.Utils -import Yi.Window - -import Control.Arrow - -import Data.Char -import Data.Maybe -import qualified Data.Rope as R -import qualified Data.Map as M -import qualified Data.List as L - -import Foreign hiding (new) -import Foreign.C - --- Specify Cocoa imports explicitly, to avoid name-clashes. --- Since the number of functions recognized by HOC varies --- between revisions, this seems like the safest choice. -import HOC -import Foundation ( - Unichar,NSString,NSStringClass,NSDictionary,NSRange(..),NSRangePointer, - NSStringMetaClass,toNSString,NSCharacterSet,_NSCharacterSet,invertedSet, - _NSMutableCharacterSet,formUnionWithCharacterSet,newlineCharacterSet, - length,attributeAtIndexEffectiveRange,attributesAtIndexEffectiveRange, - attributesAtIndexLongestEffectiveRangeInRange,nsMaxRange, - rangeOfCharacterFromSetOptionsRange,nsLiteralSearch, - beginEditing,endEditing,setAttributesRange,haskellString, - NSMutableDictionary,_NSMutableDictionary,dictionaryWithDictionary, - objectForKey,setObjectForKey,substringWithRange,copy, - attributeAtIndexLongestEffectiveRangeInRange, - addAttributeValueRange,addAttributesRange) -import AppKit ( - NSTextStorage,NSTextStorageClass,string,fixesAttributesLazily, - NSTextStorageMetaClass,NSFontClass,NSFont,coveredCharacterSet, - _NSCursor,_NSFont,replaceCharactersInRangeWithString, - _NSParagraphStyle,defaultParagraphStyle,ibeamCursor,_NSTextStorage, - editedRangeChangeInLength,nsTextStorageEditedAttributes, - nsTextStorageEditedCharacters,userFixedPitchFontOfSize) - --- Unfortunately, my version of hoc does not handle typedefs correctly, --- and thus misses every selector that uses the "unichar" type, even --- though it has introduced a type alias for it... -$(declareRenamedSelector "characterAtIndex:" "characterAtIndex" [t| CUInt -> IO Unichar |]) -instance Has_characterAtIndex (NSString a) -$(declareRenamedSelector "getCharacters:range:" "getCharactersRange" [t| Ptr Unichar -> NSRange -> IO () |]) -instance Has_getCharactersRange (NSString a) - --- A (hidden) utility method for looking up font substitutions (used by WebKit) -$(declareRenamedSelector "findFontLike:forString:withRange:inLanguage:" "findFontLikeForStringWithRangeInLanguage" [t| forall t1 t2 t3. NSFont t1 -> NSString t2 -> NSRange -> NSString t3 -> IO (NSFont ()) |]) -instance Has_findFontLikeForStringWithRangeInLanguage (NSFontClass a) -_silence :: ImpType_findFontLikeForStringWithRangeInLanguage x y -_silence = undefined - --- | SplitRope provides means for tracking the position --- of Cocoa reads from the underlying rope... -data SplitRope = SplitRope - R.Rope -- Cocoa has moved beyond this portion - R.Rope -- Cocoa is currently accessing this part - Int -- From this offset... - [Unichar] -- And in this format... =) - [Unichar] -- But we keep the whole as a backup - --- | Create a new SplitRope, and initialize the encoded portion appropriately. -mkSplitRope :: R.Rope -> R.Rope -> SplitRope -mkSplitRope done next = SplitRope done next 0 acs acs - where acs = concatMap (encodeUTF16 . fromEnum) (R.toString next) - --- | Get the length of the whole SplitRope. -sLength :: SplitRope -> Int -sLength (SplitRope done next _ _ _) = R.length done + R.length next - --- | Ensure that the specified position is in the first chunk of --- the ``next'' rope. -sSplitAtChunkBefore :: Int -> SplitRope -> SplitRope -sSplitAtChunkBefore n s@(SplitRope done next _ _ _) - | n < R.length done = mkSplitRope done' (R.append renext next) - | R.null redone = s - | otherwise = mkSplitRope (R.append done redone) next' - where - (done', renext) = R.splitAtChunkBefore n done - (redone, next') = R.splitAtChunkBefore (n - R.length done) next - -sSplitAt :: Int -> SplitRope -> SplitRope -sSplitAt n s = SplitRope done next n' (if n' >= off then L.drop (n' - off) cs else L.drop n' acs) acs - where - n' = n - R.length done - SplitRope done next off cs acs = sSplitAtChunkBefore n s - -encodeUTF16 :: Int -> [Unichar] -encodeUTF16 c - | c < 0x10000 = [fromIntegral c] - | otherwise = let c' = c - 0x10000 - in [0xd800 .|. (fromIntegral $ c' `shiftR` 10), - 0xdc00 .|. (fromIntegral $ c' .&. 0x3ff)] - --- Introduce a NSString subclass that has a Data.Rope internally. --- A NSString subclass needs to implement length and characterAtIndex, --- and for performance reasons getCharactersRange. --- This implementation is a hack just like the old bytestring one, --- but less so as Rope uses character indices instead of byte indices. --- In theory, this should work fine for all characters in the --- unicode BMP. I am unsure as to what happens if any characters --- outside of the BMP are used. -$(declareClass "YiRope" "NSString") -$(exportClass "YiRope" "yirope_" [ - InstanceVariable "str" [t| SplitRope |] [| mkSplitRope R.empty R.empty |] - , InstanceMethod 'length -- ' - , InstanceMethod 'characterAtIndex -- ' - , InstanceMethod 'getCharactersRange -- ' - ]) - -yirope_length :: YiRope () -> IO CUInt -yirope_length slf = do - -- logPutStrLn $ "Calling yirope_length (gah...)" - slf #. _str >>= return . fromIntegral . sLength - -yirope_characterAtIndex :: CUInt -> YiRope () -> IO Unichar -yirope_characterAtIndex i slf = do - -- logPutStrLn $ "Calling yirope_characterAtIndex " ++ show i - flip (modifyIVar _str) slf $ \s -> do - s'@(SplitRope _ _ _ (c:_) _) <- return (sSplitAt (fromIntegral i) s) - return (s', c) - -yirope_getCharactersRange :: Ptr Unichar -> NSRange -> YiRope () -> IO () -yirope_getCharactersRange p _r@(NSRange i l) slf = do - -- logPutStrLn $ "Calling yirope_getCharactersRange " ++ show r - flip (modifyIVar_ _str) slf $ \s -> do - s'@(SplitRope _ _ _ cs _) <- return (sSplitAt (fromIntegral i) s) - pokeArray p (L.take (fromIntegral l) cs) - return s' - --- An implementation of NSTextStorage that uses Yi's FBuffer as --- the backing store. An implementation must at least implement --- a O(1) string method and attributesAtIndexEffectiveRange. --- For performance reasons, attributeAtIndexEffectiveRange is --- implemented to deal with specific properties such as font. - --- Judging by usage logs, the environment using the text storage --- seem to rely on strings O(1) behavior and thus caching the --- result seems like a good idea. In addition attributes are --- queried for the same location multiple times, and thus caching --- them as well also seems fruitful. - -type PicStroke = (CUInt, Attributes) -type Picture = [PicStroke] - -instance Show NSRange where - show (NSRange i len) = "NSRange " ++ show i ++ " " ++ show len - -emptyPicture :: (Picture,NSRange) -emptyPicture = ([],NSRange 0 0) - -dropStrokesWhile :: (a -> Bool) -> [a] -> [a] -dropStrokesWhile f = helper - where - helper [] = [] - helper [_] = [] - helper ~(x:y:zs) = if f y then helper (y:zs) else (x:y:zs) - -attributeIsCached :: CUInt -> [PicStroke] -> Bool -attributeIsCached _ [] = False -attributeIsCached i ~((j,_):_) = i >= j - --- | Extend the currently cached picture, so that it at least --- covers the desired region. The resulting picture starts --- at the location of the desired region, but might extend --- further... -extendPicture :: CUInt -> (CUInt -> IO Picture) -> Picture -> IO Picture -extendPicture d f c = - if attributeIsCached d c - then return c - else f d - -type YiState = (Editor, FBuffer, Window, UIStyle, YiRope ()) - -$(declareClass "YiTextStorage" "NSTextStorage") -$(exportClass "YiTextStorage" "yts_" [ - InstanceVariable "yiState" [t| YiState |] [| error "Uninitialized" |] - , InstanceVariable "dictionaryCache" [t| M.Map Attributes (NSDictionary ()) |] [| M.empty |] - , InstanceVariable "pictureCache" [t| (Picture, NSRange) |] [| emptyPicture |] - , InstanceVariable "attributeCache" [t| [PicStroke] |] [| [] |] - , InstanceVariable "covered" [t| (NSCharacterSet (), NSCharacterSet ()) |] [| error "Uninitialized" |] - , InstanceMethod 'string -- ' - , InstanceMethod 'fixesAttributesLazily -- ' - , InstanceMethod 'attributeAtIndexEffectiveRange -- ' - , InstanceMethod 'attributeAtIndexLongestEffectiveRangeInRange - , InstanceMethod 'attributesAtIndexEffectiveRange -- ' - , InstanceMethod 'attributesAtIndexLongestEffectiveRangeInRange - , InstanceMethod 'replaceCharactersInRangeWithString -- ' - , InstanceMethod 'setAttributesRange -- Disallow changing attributes - , InstanceMethod 'addAttributesRange -- optimized to avoid needless work - , InstanceMethod 'addAttributeValueRange -- ... - , InstanceMethod 'length -- ' - ]) - -_editor :: YiTextStorage () -> IO Editor -_buffer :: YiTextStorage () -> IO FBuffer -_window :: YiTextStorage () -> IO Window -_uiStyle :: YiTextStorage () -> IO UIStyle -_stringCache :: YiTextStorage () -> IO (YiRope ()) -_editor o = (\ (x,_,_,_,_) -> x) <$> o #. _yiState -_buffer o = (\ (_,x,_,_,_) -> x) <$> o #. _yiState -_window o = (\ (_,_,x,_,_) -> x) <$> o #. _yiState -_uiStyle o = (\ (_,_,_,x,_) -> x) <$> o #. _yiState -_stringCache o = (\ (_,_,_,_,x) -> x) <$> o #. _yiState - -yts_length :: YiTextStorage () -> IO CUInt -yts_length slf = do - -- logPutStrLn "Calling yts_length " - slf # _stringCache >>= length - -yts_string :: YiTextStorage () -> IO (NSString ()) -yts_string slf = castObject <$> slf # _stringCache - -yts_fixesAttributesLazily :: YiTextStorage () -> IO Bool -yts_fixesAttributesLazily _ = return True - -yts_attributesAtIndexEffectiveRange :: CUInt -> NSRangePointer -> YiTextStorage () -> IO (NSDictionary ()) -yts_attributesAtIndexEffectiveRange i er slf = do - (cache, _) <- slf #. _pictureCache - if attributeIsCached i cache - then returnEffectiveRange cache i er (NSRange i 12345678) slf - else yts_attributesAtIndexLongestEffectiveRangeInRange i er (NSRange i 1) slf - -yts_attributesAtIndexLongestEffectiveRangeInRange :: CUInt -> NSRangePointer -> NSRange -> YiTextStorage () -> IO (NSDictionary ()) -yts_attributesAtIndexLongestEffectiveRangeInRange i er rl@(NSRange il _) slf = do - (cache, prev_rl) <- slf #. _pictureCache - -- Since we only cache the remaining part of the rl window, we must - -- check to ensure that we do not re-read the window all the time... - let use_i = if prev_rl == rl then i else il - -- logPutStrLn $ "yts_attributesAtIndexLongestEffectiveRangeInRange " ++ show i ++ " " ++ show rl - full <- extendPicture use_i (flip storagePicture slf) cache - returnEffectiveRange full i er rl slf - -returnEffectiveRange :: Picture -> CUInt -> NSRangePointer -> NSRange -> YiTextStorage () -> IO (NSDictionary ()) -returnEffectiveRange full i er rl@(NSRange il ll) slf = do - pic <- return $ dropStrokesWhile ((fromIntegral i >=) . fst) full - slf # setIVar _pictureCache (pic, rl) - case pic of - (before,s):rest@((next,_):_) -> do - let begin = max before il - let len = min (il + ll - begin) (next - begin) - let rng = NSRange begin len - -- Keep a cache of seen styles... usually, there should not be to many - -- TODO: Have one centralized cache instead of one per text storage... - dict <- slf # cachedDictionaryFor s - if (nsMaxRange rng == begin) - then return dict - else do - str <- yts_string slf - (covered, missing) <- slf #. _covered - NSRange b2 _ <- str # rangeOfCharacterFromSetOptionsRange missing nsLiteralSearch rng - if begin /= b2 -- First caracter is included in the font - then do - let corange = NSRange begin $ if b2 == 0x7fffffff then len else b2 - begin - -- logPutStrLn $ "Normal " ++ show i ++ show rl ++ show corange - when (er /= nullPtr) (poke er corange) - when (rng /= corange) $ - slf # setIVar _pictureCache ((before,s):(nsMaxRange corange,s):rest, rl) - return dict - else do - NSRange b3 _ <- str # rangeOfCharacterFromSetOptionsRange covered nsLiteralSearch rng - let unrange = NSRange begin $ if b3 == 0x7fffffff then len else b3 - begin - rep <- str # substringWithRange unrange >>= haskellString - -- logPutStrLn $ "Fixing " ++ show unrange ++ ": " ++ show rep - font <- castObject <$> dict # objectForKey (toNSString "NSFont") :: IO (NSFont ()) - font2 <- _NSFont # findFontLikeForStringWithRangeInLanguage font str unrange nil - dict2 <- castObject <$> _NSMutableDictionary # dictionaryWithDictionary dict :: IO (NSMutableDictionary ()) - dict2 # setObjectForKey font2 (toNSString "NSFont") - dict2 # setObjectForKey font (toNSString "NSOriginalFont") - when (er /= nullPtr) (poke er unrange) - when (rng /= unrange) $ - slf # setIVar _pictureCache ((before,s):(nsMaxRange unrange,s):rest, rl) - castObject <$> return dict2 - _ -> error "Empty picture?" - -cachedDictionaryFor :: Attributes -> YiTextStorage () -> IO (NSDictionary ()) -cachedDictionaryFor s slf = do - slf # modifyIVar _dictionaryCache (\dicts -> - case M.lookup s dicts of - Just dict -> return (dicts, dict) - _ -> do - dict <- convertAttributes s - return (M.insert s dict dicts, dict)) - -simpleAttr :: String -> IO (Either String (ID ())) -simpleAttr "NSFont" = Right <$> castObject <$> userFixedPitchFontOfSize 0 _NSFont -simpleAttr "NSGlyphInfo" = Right <$> return nil -simpleAttr "NSAttachment" = Right <$> return nil -simpleAttr "NSCursor" = Right <$> castObject <$> ibeamCursor _NSCursor -simpleAttr "NSToolTip" = Right <$> return nil -simpleAttr "NSLanguage" = Right <$> return nil -simpleAttr "NSLink" = Right <$> return nil --- TODO: Adjust line break property... -simpleAttr "NSParagraphStyle" = Right <$> castObject <$> defaultParagraphStyle _NSParagraphStyle -simpleAttr attr = Left <$> return attr - -yts_attributeAtIndexLongestEffectiveRangeInRange :: NSString t -> CUInt -> NSRangePointer -> NSRange -> YiTextStorage () -> IO (ID ()) -yts_attributeAtIndexLongestEffectiveRangeInRange attr i er rn slf = do - sres <- simpleAttr =<< haskellString attr - case sres of - Right res -> safePoke er rn >> return res - Left "NSBackgroundColor" -> do - ~((s,a):xs) <- onlyBg <$> L.takeWhile ((<= nsMaxRange rn).fst) <$> slf # storagePicture i - safePoke er (NSRange s ((if null xs then nsMaxRange rn else fst (head xs)) - s)) - castObject <$> getColor False (background a) - Left _attr' -> do - -- logPutStrLn $ "Unoptimized yts_attributeAtIndexLongestEffectiveRangeInRange " ++ attr' ++ " at " ++ show i - super slf # attributeAtIndexLongestEffectiveRangeInRange attr i er rn - -yts_attributeAtIndexEffectiveRange :: forall t. NSString t -> CUInt -> NSRangePointer -> YiTextStorage () -> IO (ID ()) -yts_attributeAtIndexEffectiveRange attr i er slf = do - sres <- simpleAttr =<< haskellString attr - case sres of - Right res -> slf # length >>= safePoke er . NSRange 0 >> return res - Left "NSBackgroundColor" -> do - len <- slf # length - slf # yts_attributeAtIndexLongestEffectiveRangeInRange attr i er (NSRange i (min 100 (len - i))) - Left _attr' -> do - -- TODO: Optimize the other queries as well (if needed) - -- logPutStrLn $ "Unoptimized yts_attributeAtIndexEffectiveRange " ++ attr' ++ " at " ++ show i - super slf # attributeAtIndexEffectiveRange attr i er - --- These methods are used to modify the contents of the NSTextStorage. --- We do not allow direct updates of the contents this way, though. -yts_replaceCharactersInRangeWithString :: forall t. NSRange -> NSString t -> YiTextStorage () -> IO () -yts_replaceCharactersInRangeWithString _ _ _ = return () -yts_setAttributesRange :: forall t. NSDictionary t -> NSRange -> YiTextStorage () -> IO () -yts_setAttributesRange _ _ _ = return () -yts_addAttributesRange :: NSDictionary t -> NSRange -> YiTextStorage () -> IO () -yts_addAttributesRange _ _ _ = return () -yts_addAttributeValueRange :: NSString t -> ID () -> NSRange -> YiTextStorage () -> IO () -yts_addAttributeValueRange _ _ _ _ = return () - --- | Remove element x_(i+1) if f(x_i,x_(i+1)) is true -filter2 :: (a -> a -> Bool) -> [a] -> [a] -filter2 _f [] = [] -filter2 _f [x] = [x] -filter2 f (x1:x2:xs) = - if f x1 x2 then filter2 f (x1:xs) else x1 : filter2 f (x2:xs) - --- | Keep only the background information -onlyBg :: [PicStroke] -> [PicStroke] -onlyBg = filter2 ((==) `on` (background . snd)) - --- | A version of poke that does nothing if p is null. -safePoke :: (Storable a) => Ptr a -> a -> IO () -safePoke p x = when (p /= nullPtr) (poke p x) - --- | Execute strokeRangesB on the buffer, and update the buffer --- so that we keep around cached syntax information... --- We assume that the incoming region provide character-indices, --- and we need to find out the corresponding byte-indices -storagePicture :: CUInt -> YiTextStorage () -> IO Picture -storagePicture i slf = do - (ed, buf, win, sty, _) <- slf #. _yiState - -- logPutStrLn $ "storagePicture " ++ show i - return $ bufferPicture ed sty buf win i - -bufferPicture :: Editor -> UIStyle -> FBuffer -> Window -> CUInt -> Picture -bufferPicture ed sty buf win i = fmap (first fromIntegral) $ fst $ runBuffer win buf $ do - e <- sizeB - (attributesPictureB sty (currentRegex ed) (mkRegion (fromIntegral i) e) []) - -type TextStorage = YiTextStorage () -initializeClass_TextStorage :: IO () -initializeClass_TextStorage = do - initializeClass_YiRope - initializeClass_YiTextStorage - -applyUpdate :: YiTextStorage () -> FBuffer -> Update -> IO () -applyUpdate buf b (Insert p _ s) = - buf # editedRangeChangeInLength nsTextStorageEditedCharacters - (NSRange (fromIntegral p) 0) (fromIntegral $ R.length s) - -applyUpdate buf b (Delete p _ s) = - let len = R.length s in - buf # editedRangeChangeInLength nsTextStorageEditedCharacters - (NSRange (fromIntegral p) (fromIntegral len)) (fromIntegral (negate len)) - -newTextStorage :: UIStyle -> FBuffer -> Window -> IO TextStorage -newTextStorage sty b w = do - buf <- new _YiTextStorage - s <- new _YiRope - s # setIVar _str (mkSplitRope R.empty (runBufferDummyWindow b (streamB Forward 0))) - buf # setIVar _yiState (emptyEditor, b, w, sty, s) - -- Determine the set of characters in the font. - -- Always add newlines, since they are currently not rendered anyhow... - allset <- new _NSMutableCharacterSet - buf # setMonospaceFont >>= coveredCharacterSet >>= flip formUnionWithCharacterSet allset - _NSCharacterSet # newlineCharacterSet >>= flip formUnionWithCharacterSet allset . castObject - covset <- castObject <$> copy allset - misset <- covset # invertedSet - buf # setIVar _covered (covset, misset) - return buf - -setTextStorageBuffer :: Editor -> FBuffer -> TextStorage -> IO () -setTextStorageBuffer ed buf storage = do - storage # beginEditing - flip (modifyIVar_ _yiState) storage $ \ (_,_,w,sty,s) -> do - s # setIVar _str (mkSplitRope R.empty (runBufferDummyWindow buf (streamB Forward 0))) - return (ed, buf, w, sty, s) - when (not $ null $ getVal pendingUpdatesA buf) $ do - mapM_ (applyUpdate storage buf) [u | TextUpdate u <- getVal pendingUpdatesA buf] - storage # setIVar _pictureCache emptyPicture - storage # endEditing - -visibleRangeChanged :: NSRange -> TextStorage -> IO () -visibleRangeChanged range storage = do - storage # setIVar _pictureCache emptyPicture - storage # editedRangeChangeInLength nsTextStorageEditedAttributes range 0 diff --git a/src/library/Yi/UI/Cocoa/TextView.hs b/src/library/Yi/UI/Cocoa/TextView.hs deleted file mode 100644 --- a/src/library/Yi/UI/Cocoa/TextView.hs +++ /dev/null @@ -1,193 +0,0 @@ -{-# LANGUAGE TemplateHaskell, EmptyDataDecls, MultiParamTypeClasses, - TypeSynonymInstances, FlexibleInstances, DeriveDataTypeable #-} --- --- Copyright (c) 2008 Gustav Munkby --- - --- | This declares our special text-view class. The textview interpretes --- mouse events so that mouse-selection in Yi should function as in any --- Cocoa application - -module Yi.UI.Cocoa.TextView - ( YiTextView - , _YiTextView - , initializeClass_YiTextView - , _runBuffer - , YiScrollView - , _YiScrollView - , initializeClass_YiScrollView - , _leftScroller - , visibleRange - )where - -import Prelude () -import Yi.Prelude -import Yi.String -import Yi.Buffer hiding (runBuffer) -import Yi.UI.Cocoa.Utils - --- Specify Cocoa imports explicitly, to avoid name-clashes. --- Since the number of functions recognized by HOC varies --- between revisions, this seems like the safest choice. -import HOC -import Foundation ( - NSPoint(..),NSRange(..),nsMinY,nsWidth,nsOffsetRect,NSArray, - addObject,haskellString,NSMutableArray,NSValue,nsUnionRange, - _NSMutableArray,array,addObjectsFromArray,rangeValue) -import AppKit ( - NSSelectionAffinity,characterRangeForGlyphRangeActualGlyphRange, - glyphRangeForBoundingRectInTextContainer,layoutManager,textContainer, - textContainerOrigin,visibleRect,frame,verticalScroller,NSTextView, - NSTextViewClass,setSelectedRangesAffinityStillSelecting,NSScrollView, - NSScrollViewClass,tile,setFrameOrigin,performDragOperation, - NSTextViewMetaClass,NSScrollViewMetaClass, - acceptableDragTypes,nsStringPboardType,stringForType,NSPasteboard, - convertPointFromView,availableTypeFromArray,_NSPasteboard, - typesFilterableTo,nsFilenamesPboardType,propertyListForType, - glyphIndexForPointInTextContainerFractionOfDistanceThroughGlyph) - -import qualified AppKit.NSScrollView (contentView) - -import Foreign -import Foreign.C - --- TODO: The correct way of doing this would be to add the --- protocol constraints on the performDragOperation --- parameter, but for whatever reason, HOC doesn't --- do this, so we use this hack to work around it... -$(declareRenamedSelector "draggingLocation" "draggingLocation" [t| IO NSPoint |]) -$(declareRenamedSelector "draggingSource" "draggingSource" [t| IO (ID ()) |]) -$(declareRenamedSelector "draggingPasteboard" "draggingPasteboard" [t| IO (NSPasteboard ()) |]) -instance Has_draggingPasteboard (ID t) -instance Has_draggingSource (ID t) -instance Has_draggingLocation (ID t) -_silenceWarning :: ( - ImpType_draggingPasteboard a b, - ImpType_draggingSource c d, - ImpType_draggingLocation e f) -_silenceWarning = undefined - - -$(declareClass "YiTextView" "NSTextView") -$(exportClass "YiTextView" "ytv_" [ - InstanceVariable "runBuffer" [t| BufferM () -> IO () |] [| const $ return () |] - , InstanceVariable "selectingPosition" [t| Maybe Int |] [| Nothing |] - , InstanceMethod 'setSelectedRangesAffinityStillSelecting -- ' - , InstanceMethod 'acceptableDragTypes - , InstanceMethod 'performDragOperation - ]) - --- | Intercept mouse selection so that we can update Yi's selection --- according to how Cocoa wants it. -ytv_setSelectedRangesAffinityStillSelecting :: NSArray () -> NSSelectionAffinity -> Bool -> YiTextView () -> IO () -ytv_setSelectedRangesAffinityStillSelecting rs a b v = do - hrs <- fmap castObject <$> haskellList rs :: IO [NSValue ()] - r@(NSRange i len) <- foldlM nsUnionRange (NSRange 0 0) =<< mapM rangeValue hrs - p <- v #. _selectingPosition - case (b, p) of - (True, Nothing) -> do - -- Assume that the initial indication gives starting position - v # setIVar _selectingPosition (Just $ fromIntegral i) - (False, Just p0) -> do - v # setIVar _selectingPosition Nothing - runbuf <- v #. _runBuffer - runbuf $ do - setVisibleSelection (len /= 0) - setSelectionMarkPointB (fromIntegral p0) - moveTo (fromIntegral $ if fromIntegral i == p0 then i + len else i) - _ -> do - -- Ignore intermediate updates (Cocoa buffers events until selection finishes) - -- Ignore direct updates (to avoid having to detect "our" updates) - return () - - super v # setSelectedRangesAffinityStillSelecting rs a b - -ytv_acceptableDragTypes :: YiTextView () -> IO (NSArray ()) -ytv_acceptableDragTypes _ = do - ar <- castObject <$> _NSMutableArray # array :: IO (NSMutableArray ()) - _NSPasteboard # typesFilterableTo nsStringPboardType >>= - flip addObjectsFromArray ar - ar # addObject nsFilenamesPboardType - return (castObject ar) - --- Implement support for drag and drop... -ytv_performDragOperation :: ID t -> YiTextView () -> IO Bool -ytv_performDragOperation dragInfo slf = do - pb <- dragInfo # draggingPasteboard - - ty <- slf # ytv_acceptableDragTypes >>= flip availableTypeFromArray pb - - when (ty /= nil) $ do - str <- - if ty == nsFilenamesPboardType - then unlines' <$> - (pb # propertyListForType ty >>= (haskellList.castObject) >>= mapM (haskellString.castObject)) - else pb # stringForType ty >>= haskellString - - src <- dragInfo # draggingSource - -- Apparently, the selection only looks as if it was updated... - -- we would have to use draggingLocation to figure out where - -- the new text should go. Which means that we need to get back - -- our old trick for translating a mouse-position to a text-position. - pIns <- dragInfo # draggingLocation >>= flip charAtMouse slf - - runbuf <- slf #. _runBuffer - runbuf $ do - hasSel <- getA highlightSelectionA - rSel <- if hasSel && src == (castObject slf) then getSelectRegionB else return emptyRegion - - moveTo $ fromIntegral pIns - -- To not affect positions we make the "latter" modification first - -- Note that there will be no drag operation if they overlap... - if regionStart rSel < fromIntegral pIns - then insertN str >> deleteRegionB rSel - else deleteRegionB rSel >> insertN str - - return (ty /= nil) - --- | Compute the character index of the specified mouse position -charAtMouse :: NSPoint -> YiTextView () -> IO CUInt -charAtMouse p slf = do - -- Determine the text-relative coordinate - container <- slf # textContainer - NSPoint ex ey <- slf # convertPointFromView p nil - NSPoint ox oy <- slf # textContainerOrigin - let mouse = NSPoint (ex - ox) (ey - oy) - -- Determine the index - layout <- slf # layoutManager - pf <- malloc -- I miss stack variables from C... =P - index <- layout # glyphIndexForPointInTextContainerFractionOfDistanceThroughGlyph mouse container pf - fract <- peek pf - free pf - return $ if (fract > 0.5) then index + 1 else index - --- | Compute the currently visible text range in the view -visibleRange :: YiTextView () -> IO NSRange -visibleRange v = do - -- Force redraw of the whole container to capture interactive style changes... - NSPoint x y <- v # textContainerOrigin - r <- v # visibleRect >>= \r -> nsOffsetRect r x y - lm <- v # layoutManager - tc <- v # textContainer - gr <- lm # glyphRangeForBoundingRectInTextContainer r tc - lm # characterRangeForGlyphRangeActualGlyphRange gr nullPtr - -$(declareClass "YiScrollView" "NSScrollView") -$(exportClass "YiScrollView" "ysv_" [ - InstanceVariable "leftScroller" [t| Bool |] [| False |] - , InstanceMethod 'tile -- ' - ]) - -ysv_tile :: YiScrollView () -> IO () -ysv_tile slf = do - super slf # tile - moveScroller <- slf #. _leftScroller - if not moveScroller - then return () - else do - -- Copied from NostalgicScrollView (found on /.) - c <- slf # AppKit.NSScrollView.contentView - s <- slf # verticalScroller - sf <- s # frame - s # setFrameOrigin (NSPoint 0.0 (nsMinY sf)) - c # frame >>= (flip setFrameOrigin c) . (NSPoint (nsWidth sf)) . nsMinY diff --git a/src/library/Yi/UI/Cocoa/Utils.hs b/src/library/Yi/UI/Cocoa/Utils.hs deleted file mode 100644 --- a/src/library/Yi/UI/Cocoa/Utils.hs +++ /dev/null @@ -1,116 +0,0 @@ -{-# LANGUAGE Rank2Types #-} --- --- Copyright (c) 2008 Gustav Munkby --- - --- | Helper functions for the Cocoa frontend - -module Yi.UI.Cocoa.Utils where - -import Prelude hiding (init) -import Yi.Debug -import Yi.Region -import Yi.Style - -import Control.Applicative -import Control.Concurrent - --- Specify Cocoa imports explicitly, to avoid name-clashes. --- Since the number of functions recognized by HOC varies --- between revisions, this seems like the safest choice. -import HOC -import Foundation ( - NSDictionary,NSMutableDictionary,NSObject,NSObject_, - _NSMutableDictionary,alloc,autorelease,catchNS,description, - haskellString,retain,setValueForKey,dictionary,init, - objectEnumerator,nextObject,NSArray,NSRange(..)) -import AppKit ( - Has_setFont,NSColor,_NSColor,_NSFont,blackColor,NSFont, - colorWithDeviceRedGreenBlueAlpha,nsBackgroundColorAttributeName, - nsFontAttributeName,nsForegroundColorAttributeName,setFont, - userFixedPitchFontOfSize,whiteColor) - -logNSException :: String -> IO () -> IO () -logNSException str act = - catchNS act (\e -> description e >>= haskellString >>= - logPutStrLn . (("NSException " ++ str ++ ":") ++)) - - -new, autonew :: forall t. Class (NSObject_ t) -> IO (NSObject t) -new x = do - d <- description x >>= haskellString - o <- alloc x - logPutStrLn $ "New " ++ d - init o -autonew x = new x >>= autoreleased - -autoreleased :: forall t. NSObject t -> IO (NSObject t) -autoreleased o = do - retain o - autorelease o - return o - -setMonospaceFont :: Has_setFont v => v -> IO (NSFont ()) -setMonospaceFont view = do - font <- userFixedPitchFontOfSize 0 _NSFont - view # setFont font - return font - --- | Convert style information into Cocoa compatible format -convertAttributes :: Attributes -> IO (NSDictionary ()) -convertAttributes s = do - d <- castObject <$> dictionary _NSMutableDictionary - ft <- userFixedPitchFontOfSize 0 _NSFont - setValueForKey ft nsFontAttributeName d - fillAttributeDict d s - castObject <$> return d - --- | Fill and return the filled dictionary with the style information -fillAttributeDict :: NSMutableDictionary t -> Attributes -> IO () -fillAttributeDict d a = do - getColor True (foreground a) >>= setForKey nsForegroundColorAttributeName - getColor False (background a) >>= setForKey nsBackgroundColorAttributeName - where setForKey k = \v -> setValueForKey v k d - --- | Convert a Yi color into a Cocoa color -getColor :: Bool -> Color -> IO (NSColor ()) -getColor fg Default = if fg then _NSColor # blackColor else _NSColor # whiteColor -getColor _g (RGB r g b) = - let conv = (/255) . fromIntegral in - _NSColor # colorWithDeviceRedGreenBlueAlpha (conv r) (conv g) (conv b) 1.0 - -haskellList :: forall t1. NSArray t1 -> IO [ID ()] -haskellList a = a # objectEnumerator >>= helper - where - helper enum = do - e <- enum # nextObject - if e == nil - then return [] - else helper enum >>= return . (e :) - -mkRangeRegion :: NSRange -> Region -mkRangeRegion (NSRange i l) = mkSizeRegion (fromIntegral i) (fromIntegral l) - -mkRegionRange :: Region -> NSRange -mkRegionRange r = NSRange (fromIntegral $ regionStart r) (fromIntegral $ regionSize r) - --- NOTE: Should really be in HOC... we can't even give a type signature here... -modifyIVar ivar f slf = modifyMVar (getInstanceMVar ivar slf) f -modifyIVar_ ivar f slf = modifyMVar_ (getInstanceMVar ivar slf) f - -{- - --- Debugging helpers - -data Hierarchy = View String NSRect [Hierarchy] - deriving Show - - -mkHierarchy :: forall t. NSView t -> IO Hierarchy -mkHierarchy v = do - d <- v # description >>= haskellString - f <- v # frame - ss <- v # subviews >>= haskellList >>= mapM (mkHierarchy . toNSView) - return $ View d f ss - --} diff --git a/src/library/Yi/UI/Vte.hs b/src/library/Yi/UI/Vte.hs deleted file mode 100644 --- a/src/library/Yi/UI/Vte.hs +++ /dev/null @@ -1,71 +0,0 @@ -module Yi.UI.Vte (start) where - -import Prelude () -import Yi.Prelude - -import Graphics.UI.Gtk -import Graphics.UI.Gtk.Vte.Vte -import System.Environment -import System.Environment.Executable -import System.Glib - -import Yi.Config -import Yi.Style -import qualified Yi.UI.Common as Common - -start :: UIBoot -start cfg ch outCh editor = - catchGError (initUI cfg ch outCh editor) (\(GError _dom _code msg) -> fail msg) - -initUI :: UIBoot -initUI cfg _ch _outCh _editor = do - discard unsafeInitGUIForThreadedRTS - setApplicationName "Yi" - - -- Setup window - win <- windowNew - discard $ win `onDestroy` mainQuit - - -- Setup vte - exe <- getExecutablePath - term <- terminalNew - discard $ Graphics.UI.Gtk.on term childExited $ end False - - -- Set default colors - terminalSetColors term - (getBaseAttrColor foreground black cfg) - (getBaseAttrColor background brightwhite cfg) - (Color 0 0 0) - 0 - - -- Start running Yi - args <- getArgs - discard $ terminalForkCommand term - (Just exe) (Just $ exe : args ++ ["-fvty"]) Nothing Nothing False False False - - discard $ set win [ containerChild := term ] - widgetShowAll win - - return $ Common.dummyUI - { Common.main = main - , Common.end = end - } - -main :: IO () -main = mainGUI - -end :: Bool -> IO () -end = const mainQuit - -getBaseAttrColor :: (Attributes -> Yi.Style.Color) -> Yi.Style.Color - -> Config -> Graphics.UI.Gtk.Color -getBaseAttrColor p d cfg = mkCol $ - case p $ baseAttributes $ configStyle $ configUI cfg of - Default -> d - c -> c - -mkCol :: Yi.Style.Color -> Graphics.UI.Gtk.Color -mkCol Default = Color 0 0 0 -mkCol (RGB x y z) = Color (fromIntegral x * 256) - (fromIntegral y * 256) - (fromIntegral z * 256) diff --git a/yi.cabal b/yi.cabal --- a/yi.cabal +++ b/yi.cabal @@ -1,5 +1,5 @@ name: yi -version: 0.7.0 +version: 0.7.1 category: Development, Editor synopsis: The Haskell-Scriptable Editor description: @@ -10,7 +10,7 @@ author: AUTHORS maintainer: yi-devel@googlegroups.com homepage: http://haskell.org/haskellwiki/Yi -bug-reports: http://code.google.com/p/yi-editor/issues/list +bug-reports: https://github.com/yi-editor/yi/issues Cabal-Version: >= 1.10 tested-with: GHC==7.4.2, GHC==7.6.1 build-type: Simple @@ -25,18 +25,10 @@ location: https://github.com/yi-editor/yi.git -- Frontends -flag cocoa - Default: False - Description: "Build with Cocoa frontend" - flag pango Default: False Description: "Build with Pango frontend" -flag vte - Default: False - Description: "Build with Vte frontend" - flag vty Default: True Description: "Build with Vty frontend" @@ -60,31 +52,13 @@ Runtime binary will be compiled with profiling and RTS options enabled. -flag hacking - Default: False - Description: - Hacking mode: - * Create HackerMain.hs by copying your ~/.config/yi/yi.hs - * Skip library compilation - * You can run yi in-place with dist/build/yi/yi - flag testing Description: bake-in the self-checks -flag dochack - Default: False - Description: - Hack to get Haddock documentation, by disabling executables. - * this is a workaround for a cabal bug; see Issue #347 - * do a 'cabal install yi -fdochack' followed by 'cabal install yi' to get yi and the documentation - library hs-source-dirs: src/library default-language: Haskell2010 - if flag(hacking) - buildable: False - if flag(profiling) CPP-options: -DPROFILING @@ -245,7 +219,7 @@ build-depends: Cabal >= 1.10 && < 1.20, Diff >=0.1 && <0.4, - array, containers, directory, process, old-locale, + array, containers, directory, process >= 1.0.1.1, old-locale, base >= 4 && < 5, binary >= 0.5, bytestring >= 0.9.1 && < 0.11, @@ -259,18 +233,15 @@ dyre >=0.8.11, filepath>=1.1 && <1.4, fingertree >= 0 && <0.2, - ghc-paths ==0.1.*, - hashable ==1.2.*, + hashable >=1.1.2.5, 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.*, + regex-tdfa >= 1.1 && <1.3, split >= 0.1 && < 0.3, - template-haskell >= 2.4 && < 2.9, + template-haskell >= 2.4, time >= 1.1 && < 1.5, utf8-string >= 0.3.1, uniplate, @@ -278,17 +249,13 @@ unordered-containers >= 0.1.3 && < 0.3, xdg-basedir >= 0.2.1 && < 0.3 - build-tools: alex >= 3.0.3 && <= 3.1.0 + build-tools: alex >= 3.0.3 ghc-options: -Wall -fno-warn-orphans ghc-prof-options: -prof -auto-all -rtsopts if flag(profiling) cpp-options: -DPROFILING - if flag(hacking) - ghc-prof-options: -prof -auto-all - - if impl(ghc >=7.2) - default-extensions: NondecreasingIndentation + default-extensions: NondecreasingIndentation if !os(windows) build-depends: @@ -307,20 +274,6 @@ random -- Frontends - if flag(cocoa) - exposed-modules: - Yi.UI.Cocoa - other-modules: - Yi.UI.Cocoa.Application - Yi.UI.Cocoa.TextStorage - Yi.UI.Cocoa.TextView - Yi.UI.Cocoa.Utils - build-depends: - HOC, - HOC-AppKit, - HOC-Foundation - cpp-options: -DFRONTEND_COCOA - if flag(pango) exposed-modules: Yi.UI.Pango @@ -334,17 +287,6 @@ pango ==0.12.* cpp-options: -DFRONTEND_PANGO - if flag(vte) - exposed-modules: - Yi.UI.Vte - build-depends: - gtk ==0.12.*, - glib ==0.12.*, - pango ==0.12.*, - vte ==0.12.*, - executable-path - cpp-options: -DFRONTEND_VTE - if flag(vty) exposed-modules: Yi.UI.Vty @@ -356,15 +298,14 @@ if flag (scion) cpp-options: -DSCION exposed-modules: Yi.Scion - build-depends: scion == 0.1.*, - ghc >= 7, + build-depends: + scion == 0.1.*, ghc-syb-utils if flag (ghcAPI) cpp-options: -DGHC_API build-depends: - ghc >= 7, ghc-paths ==0.1.*, old-time >= 1.1.0.0, rosezipper >= 0.1 && < 0.3, @@ -409,9 +350,6 @@ hs-source-dirs: src/parsertest default-language: Haskell2010 - if !flag(hacking) || flag(dochack) - buildable: False - main-is: ParserTest/ParserTest.hs build-depends: @@ -419,27 +357,21 @@ array, containers, directory, - filepath>=1.1 && <1.4 - if !flag(dochack) - build-depends: yi + filepath>=1.1 && <1.4, + yi executable yi hs-source-dirs: src/executable default-language: Haskell2010 - if flag(dochack) - buildable: False - if flag(profiling) cpp-options: -DPROFILING main-is: Main.hs build-depends: - base >=4 && <5 - if !flag(dochack) - build-depends: yi - build-tools: alex >= 3.0.3 && <= 3.1.0 + base >=4 && <5, yi + build-tools: alex >= 3.0.3 ghc-options: -threaded ghc-prof-options: -prof -auto-all -rtsopts