yi 0.7.0 → 0.7.1
raw patch · 29 files changed
+132/−1619 lines, 29 filesdep −HOCdep −HOC-AppKitdep −HOC-Foundationdep ~hashabledep ~processdep ~regex-tdfa
Dependencies removed: HOC, HOC-AppKit, HOC-Foundation, executable-path, ghc, vte
Dependency ranges changed: hashable, process, regex-tdfa, template-haskell
Files
- dist/build/Yi/Lexer/Abella.hs +6/−5
- dist/build/Yi/Lexer/C.hs +6/−5
- dist/build/Yi/Lexer/Cabal.hs +4/−3
- dist/build/Yi/Lexer/Compilation.hs +6/−5
- dist/build/Yi/Lexer/Cplusplus.hs +6/−5
- dist/build/Yi/Lexer/GNUMake.hs +4/−3
- dist/build/Yi/Lexer/GitCommit.hs +4/−3
- dist/build/Yi/Lexer/Haskell.hs +4/−3
- dist/build/Yi/Lexer/JSON.hs +6/−5
- dist/build/Yi/Lexer/Java.hs +6/−5
- dist/build/Yi/Lexer/JavaScript.hs +6/−5
- dist/build/Yi/Lexer/Latex.hs +6/−5
- dist/build/Yi/Lexer/LiterateHaskell.hs +4/−3
- dist/build/Yi/Lexer/OCaml.hs +6/−5
- dist/build/Yi/Lexer/ObjectiveC.hs +6/−5
- dist/build/Yi/Lexer/Ott.hs +6/−5
- dist/build/Yi/Lexer/Perl.hs +4/−3
- dist/build/Yi/Lexer/Python.hs +6/−5
- dist/build/Yi/Lexer/Ruby.hs +6/−5
- dist/build/Yi/Lexer/SVNCommit.hs +4/−3
- dist/build/Yi/Lexer/Srmc.hs +6/−5
- dist/build/Yi/Lexer/Whitespace.hs +6/−5
- src/library/Yi/UI/Cocoa.hs +0/−416
- src/library/Yi/UI/Cocoa/Application.hs +0/−211
- src/library/Yi/UI/Cocoa/TextStorage.hs +0/−434
- src/library/Yi/UI/Cocoa/TextView.hs +0/−193
- src/library/Yi/UI/Cocoa/Utils.hs +0/−116
- src/library/Yi/UI/Vte.hs +0/−71
- yi.cabal +14/−82
dist/build/Yi/Lexer/Abella.hs view
@@ -107,7 +107,6 @@ alex_action_16 = c Unrecognized {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/C.hs view
@@ -85,7 +85,6 @@ alex_action_19 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/Cabal.hs view
@@ -81,7 +81,6 @@ alex_action_16 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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+
dist/build/Yi/Lexer/Compilation.hs view
@@ -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 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/Cplusplus.hs view
@@ -82,7 +82,6 @@ alex_action_17 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/GNUMake.hs view
@@ -119,7 +119,6 @@ alex_action_30 = c Style.commentStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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+
dist/build/Yi/Lexer/GitCommit.hs view
@@ -98,7 +98,6 @@ alex_action_23 = c Style.defaultStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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+
dist/build/Yi/Lexer/Haskell.hs view
@@ -208,7 +208,6 @@ alex_action_52 = c Unrecognized {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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+
dist/build/Yi/Lexer/JSON.hs view
@@ -59,7 +59,6 @@ alex_action_4 = c defaultStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/Java.hs view
@@ -84,7 +84,6 @@ alex_action_18 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/JavaScript.hs view
@@ -232,7 +232,6 @@ alex_action_21 = c $ Comment Text {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/Latex.hs view
@@ -400,7 +400,6 @@ alex_action_7 = c $ Text {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/LiterateHaskell.hs view
@@ -140,7 +140,6 @@ alex_action_81 = c Unrecognized {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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+
dist/build/Yi/Lexer/OCaml.hs view
@@ -93,7 +93,6 @@ alex_action_16 = c Operator {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/ObjectiveC.hs view
@@ -83,7 +83,6 @@ alex_action_17 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/Ott.hs view
@@ -90,7 +90,6 @@ alex_action_28 = c defaultStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/Perl.hs view
@@ -294,7 +294,6 @@ alex_action_62 = c stringStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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+
dist/build/Yi/Lexer/Python.hs view
@@ -66,7 +66,6 @@ alex_action_9 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/Ruby.hs view
@@ -71,7 +71,6 @@ alex_action_14 = c operatorStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/SVNCommit.hs view
@@ -71,7 +71,6 @@ alex_action_5 = c Style.commentStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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+
dist/build/Yi/Lexer/Srmc.hs view
@@ -83,7 +83,6 @@ alex_action_11 = c keywordStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
dist/build/Yi/Lexer/Whitespace.hs view
@@ -66,7 +66,6 @@ alex_action_3 = c commentStyle {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}-{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# 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
− src/library/Yi/UI/Cocoa.hs
@@ -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)
− src/library/Yi/UI/Cocoa/Application.hs
@@ -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
− src/library/Yi/UI/Cocoa/TextStorage.hs
@@ -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
− src/library/Yi/UI/Cocoa/TextView.hs
@@ -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
− src/library/Yi/UI/Cocoa/Utils.hs
@@ -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---}
− src/library/Yi/UI/Vte.hs
@@ -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)
yi.cabal view
@@ -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