1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346
|
Description: Rework vty interface code like commit a42841dbeb4f716a50b82aa4c71c419f033806d5
This is a rework of a patch from upstream git to vty 5.1 API, adapted to yi 0.7.1 in Debian by Marcel Fourné.
.
---
The information above should follow the Patch Tagging Guidelines, please
checkout http://dep.debian.net/deps/dep3/ to learn about the format. Here
are templates for supplementary fields that you might want to add:
Origin: upstream, https://github.com/yi-editor/yi/commit/a42841dbeb4f716a50b82aa4c71c419f033806d5#diff-68f4dd75b91abeba23f0417a614830e5
--- yi-0.7.1.orig/src/library/Yi/Config.hs
+++ yi-0.7.1/src/library/Yi/Config.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
{-# LANGUAGE TemplateHaskell #-}
module Yi.Config where
@@ -16,9 +17,14 @@ import Yi.Style
import Yi.Style.Library
import {-# source #-} Yi.UI.Common
import qualified Yi.Interact as I
+#ifdef FRONTEND_VTY
+import qualified Graphics.Vty as Vty
+#endif
data UIConfig = UIConfig {
- configVtyEscDelay :: Int,
+#ifdef FRONTEND_VTY
+ configVty :: Vty.Config,
+#endif
configFontName :: Maybe String, -- ^ Font name, for the UI that support it.
configFontSize :: Maybe Int, -- ^ Font size, for the UI that support it.
configScrollStyle ::Maybe ScrollStyle,
--- yi-0.7.1.orig/src/library/Yi/Config/Default.hs
+++ yi-0.7.1/src/library/Yi/Config/Default.hs
@@ -6,6 +6,7 @@ module Yi.Config.Default (defaultConfig,
toVimStyleConfig, toVim2StyleConfig, toEmacsStyleConfig, toCuaStyleConfig) where
import Control.Monad (forever)
+import Data.Default
import Data.Either (rights)
import Paths_yi
import Prelude ()
@@ -47,6 +47,7 @@ import qualified Yi.UI.Vte
#endif
#ifdef FRONTEND_VTY
import qualified Yi.UI.Vty
+import qualified Graphics.Vty.Config as Vty
#endif
#ifdef FRONTEND_PANGO
import qualified Yi.UI.Pango
@@ -145,7 +146,9 @@ defaultConfig =
, configAutoHideTabBar = True
, configWindowFill = ' '
, configTheme = defaultTheme
- , configVtyEscDelay = 0
+#ifdef FRONTEND_VTY
+ , configVty = def
+#endif
}
, defaultKm = modelessKeymapSet nilKeymap
, startActions = []
@@ -193,7 +193,16 @@ defaultCuaConfig = toCuaStyleConfig defa
toEmacsStyleConfig, toVimStyleConfig, toVim2StyleConfig, toCuaStyleConfig :: Config -> Config
toEmacsStyleConfig cfg
= cfg {
- configUI = (configUI cfg) { configVtyEscDelay = 1000 , configScrollStyle = Just SnapToCenter},
+ configUI = (configUI cfg)
+ { configScrollStyle = Just SnapToCenter
+#ifdef FRONTEND_VTY
+ -- corey: does this actually matter? escToMeta appears to perform all the
+ -- meta joining required. I'm not an emacs user and cannot evaluate feel. For
+ -- me these settings join esc;key to meta-key OK. The 100 millisecond lag in
+ -- ESC is terrible for me. Maybe that's just how it is under emacs...
+ , configVty = def { Vty.vtime = Just 100, Vty.vmin = Just 2 }
+#endif
+ },
defaultKm = Emacs.keymap,
startActions = makeAction openScratchBuffer : startActions cfg,
configInputPreprocess = escToMeta,
--- yi-0.7.1.orig/src/library/Yi/Config/Simple.hs
+++ yi-0.7.1/src/library/Yi/Config/Simple.hs
@@ -108,7 +108,7 @@ import Yi.Config(Config, UIConfig,
startFrontEndA, configUIA, startActionsA, initialActionsA, defaultKmA,
configInputPreprocessA, modeTableA, debugModeA,
configRegionStyleA, configKillringAccumulateA, bufferUpdateHandlerA,
- configVtyEscDelayA, configFontNameA, configFontSizeA, configScrollWheelAmountA,
+ configVtyA, configFontNameA, configFontSizeA, configScrollWheelAmountA,
configScrollStyleA, configCursorStyleA, CursorStyle(..),
configLeftSideScrollBarA, configAutoHideScrollBarA, configAutoHideTabBarA,
configLineWrapA, configWindowFillA, configThemeA, layoutManagersA, configVarsA,
--- yi-0.7.1.orig/src/library/Yi/UI/Vty.hs
+++ yi-0.7.1/src/library/Yi/UI/Vty.hs
@@ -34,7 +34,7 @@ import qualified Yi.UI.Common as Common
import Yi.Config
import Yi.Window
import Yi.Style as Style
-import Graphics.Vty as Vty hiding (refresh, Default)
+import Graphics.Vty as Vty hiding (Config(..), refresh, Default, text)
import qualified Graphics.Vty as Vty
import Yi.Keymap (makeAction, YiM)
@@ -73,11 +73,11 @@ start :: UIBoot
start cfg ch outCh editor = do
liftIO $ do
oattr <- getTerminalAttributes stdInput
- v <- mkVtyEscDelay $ configVtyEscDelay $ configUI $ cfg
+ v <- mkVty $ configVty $ configUI $ cfg
nattr <- getTerminalAttributes stdInput
setTerminalAttributes stdInput (withoutMode nattr ExtendedFunctions) Immediately
-- remove the above call to setTerminalAttributes when vty does it.
- Vty.DisplayRegion x0 y0 <- Vty.display_bounds $ Vty.terminal v
+ (x0,y0) <- Vty.displayBounds $ Vty.outputIface v
sz <- newIORef (fromEnum y0, fromEnum x0)
-- fork input-reading thread. important to block *thread* on getKey
-- otherwise all threads will block waiting for input
@@ -97,7 +97,7 @@ start cfg ch outCh editor = do
-- | Read a key. UIs need to define a method for getting events.
getKey :: IO Yi.Event.Event
getKey = do
- event <- Vty.next_event v
+ event <- Vty.nextEvent v
case event of
(EvResize x y) -> do
logPutStrLn $ "UI: EvResize: " ++ show (x,y)
@@ -146,28 +146,28 @@ fromVtyEvent _ = error "fromVtyEvent: un
fromVtyKey :: Vty.Key -> Yi.Event.Key
-fromVtyKey (Vty.KEsc ) = Yi.Event.KEsc
-fromVtyKey (Vty.KFun x ) = Yi.Event.KFun x
-fromVtyKey (Vty.KPrtScr ) = Yi.Event.KPrtScr
-fromVtyKey (Vty.KPause ) = Yi.Event.KPause
-fromVtyKey (Vty.KASCII '\t') = Yi.Event.KTab
-fromVtyKey (Vty.KASCII c ) = Yi.Event.KASCII c
-fromVtyKey (Vty.KBS ) = Yi.Event.KBS
-fromVtyKey (Vty.KIns ) = Yi.Event.KIns
-fromVtyKey (Vty.KHome ) = Yi.Event.KHome
-fromVtyKey (Vty.KPageUp ) = Yi.Event.KPageUp
-fromVtyKey (Vty.KDel ) = Yi.Event.KDel
-fromVtyKey (Vty.KEnd ) = Yi.Event.KEnd
-fromVtyKey (Vty.KPageDown) = Yi.Event.KPageDown
-fromVtyKey (Vty.KNP5 ) = Yi.Event.KNP5
-fromVtyKey (Vty.KUp ) = Yi.Event.KUp
-fromVtyKey (Vty.KMenu ) = Yi.Event.KMenu
-fromVtyKey (Vty.KLeft ) = Yi.Event.KLeft
-fromVtyKey (Vty.KDown ) = Yi.Event.KDown
-fromVtyKey (Vty.KRight ) = Yi.Event.KRight
-fromVtyKey (Vty.KEnter ) = Yi.Event.KEnter
-fromVtyKey (Vty.KBackTab ) = error "This should be handled in fromVtyEvent"
-fromVtyKey (Vty.KBegin ) = error "Yi.UI.Vty.fromVtyKey: can't handle KBegin"
+fromVtyKey (Vty.KEsc ) = Yi.Event.KEsc
+fromVtyKey (Vty.KFun x ) = Yi.Event.KFun x
+fromVtyKey (Vty.KPrtScr ) = Yi.Event.KPrtScr
+fromVtyKey (Vty.KPause ) = Yi.Event.KPause
+fromVtyKey (Vty.KChar '\t') = Yi.Event.KTab
+fromVtyKey (Vty.KChar c ) = Yi.Event.KASCII c
+fromVtyKey (Vty.KBS ) = Yi.Event.KBS
+fromVtyKey (Vty.KIns ) = Yi.Event.KIns
+fromVtyKey (Vty.KHome ) = Yi.Event.KHome
+fromVtyKey (Vty.KPageUp ) = Yi.Event.KPageUp
+fromVtyKey (Vty.KDel ) = Yi.Event.KDel
+fromVtyKey (Vty.KEnd ) = Yi.Event.KEnd
+fromVtyKey (Vty.KPageDown ) = Yi.Event.KPageDown
+fromVtyKey (Vty.KCenter ) = Yi.Event.KNP5
+fromVtyKey (Vty.KUp ) = Yi.Event.KUp
+fromVtyKey (Vty.KMenu ) = Yi.Event.KMenu
+fromVtyKey (Vty.KLeft ) = Yi.Event.KLeft
+fromVtyKey (Vty.KDown ) = Yi.Event.KDown
+fromVtyKey (Vty.KRight ) = Yi.Event.KRight
+fromVtyKey (Vty.KEnter ) = Yi.Event.KEnter
+fromVtyKey (Vty.KBackTab ) = error "This should be handled in fromVtyEvent"
+fromVtyKey (Vty.KBegin ) = error "Yi.UI.Vty.fromVtyKey: can't handle KBegin"
fromVtyMod :: Vty.Modifier -> Yi.Event.Modifier
fromVtyMod Vty.MShift = Yi.Event.MShift
@@ -229,13 +229,13 @@ refresh ui e = do
logPutStrLn "refreshing screen."
logPutStrLn $ "startXs: " ++ show startXs
Vty.update (vty $ ui)
- ( pic_for_image ( vert_cat tabBarImages
- <->
- vert_cat (toList wImages)
- <->
- vert_cat (fmap formatCmdLine niceCmd)
- )
- ) { pic_cursor = case cursor (PL._focus renders) of
+ ( picForImage ( vertCat tabBarImages
+ <->
+ vertCat (toList wImages)
+ <->
+ vertCat (fmap formatCmdLine niceCmd)
+ )
+ ) { picCursor = case cursor (PL._focus renders) of
Just (y,x) -> Cursor (toEnum x) (toEnum $ y + PL._focus startXs)
-- Add the position of the window to the position of the cursor
Nothing -> NoCursor
@@ -254,12 +254,12 @@ renderTabBar e ui xss =
where tabImages = foldr1 (<|>) $ fmap tabToVtyImage $ tabBarDescr e
extraImage = withAttributes (tabBarAttributes uiStyle) (replicate (xss - fromEnum totalTabWidth) ' ')
- totalTabWidth = Vty.image_width tabImages
+ totalTabWidth = Vty.imageWidth tabImages
uiStyle = configStyle $ configUI $ config ui
tabTitle text = " " ++ text ++ " "
tabAttr b = baseAttr b $ tabBarAttributes uiStyle
- baseAttr True sty = attributesToAttr (appEndo (tabInFocusStyle uiStyle) sty) Vty.def_attr
- baseAttr False sty = attributesToAttr (appEndo (tabNotFocusedStyle uiStyle) sty) Vty.def_attr `Vty.with_style` Vty.underline
+ baseAttr True sty = attributesToAttr (appEndo (tabInFocusStyle uiStyle) sty) Vty.defAttr
+ baseAttr False sty = attributesToAttr (appEndo (tabNotFocusedStyle uiStyle) sty) Vty.defAttr `Vty.withStyle` Vty.underline
tabToVtyImage _tab@(TabDescr text inFocus) = Vty.string (tabAttr inFocus) (tabTitle text)
-- | Determine whether it is necessary to render the tab bar
@@ -303,7 +303,7 @@ drawWindow cfg e focused win w h = (Rend
off = if notMini then 1 else 0
h' = h - off
ground = baseAttributes sty
- wsty = attributesToAttr ground Vty.def_attr
+ wsty = attributesToAttr ground Vty.defAttr
eofsty = appEndo (eofStyle sty) ground
(point, _) = runBuffer win b pointB
(eofPoint, _) = runBuffer win b sizeB
@@ -320,9 +320,9 @@ drawWindow cfg e focused win w h = (Rend
-- TODO: I suspect that this costs quite a lot of CPU in the "dry run" which determines the window size;
-- In that case, since attributes are also useless there, it might help to replace the call by a dummy value.
-- This is also approximately valid of the call to "indexedAnnotatedStreamB".
- colors = map (second (($ Vty.def_attr) . attributesToAttr)) attributes
+ colors = map (second (($ Vty.defAttr) . attributesToAttr)) attributes
bufData = -- trace (unlines (map show text) ++ unlines (map show $ concat strokes)) $
- paintChars Vty.def_attr colors text
+ paintChars Vty.defAttr colors text
tabWidth = tabSize . fst $ runBuffer win b indentSettingsB
prompt = if isMini win then miniIdentString b else ""
@@ -338,7 +338,7 @@ drawWindow cfg e focused win w h = (Rend
modeStyle = (if focused then appEndo (modelineFocusStyle sty) else id) (modelineAttributes sty)
filler = take w (configWindowFill cfg : repeat ' ')
- pict = vert_cat (take h' (rendered ++ repeat (withAttributes eofsty filler)) ++ modeLines)
+ pict = vertCat (take h' (rendered ++ repeat (withAttributes eofsty filler)) ++ modeLines)
-- | Renders text in a rectangle.
-- This also returns
@@ -357,7 +357,7 @@ drawText :: Int -- ^ The height of th
-> ([Image], Point, Maybe (Int,Int), Int)
drawText h w topPoint point tabWidth bufData
| h == 0 || w == 0 = ([], topPoint, Nothing, 0)
- | otherwise = (rendered_lines, bottomPoint, pntpos, h - (length wrapped - h))
+ | otherwise = (renderedLines, bottomPoint, pntpos, h - (length wrapped - h))
where
-- the number of lines that taking wrapping into account,
@@ -372,14 +372,14 @@ drawText h w topPoint point tabWidth buf
pntpos = listToMaybe [(y,x) | (y,l) <- zip [0..] lns0, (x,(_char,(_attr,p))) <- zip [0..] l, p == point]
-- fill lines with blanks, so the selection looks ok.
- rendered_lines = map fillColorLine lns0
+ renderedLines = map fillColorLine lns0
colorChar (c, (a, _aPoint)) = Vty.char a c
fillColorLine :: [(Char, (Vty.Attr, Point))] -> Image
- fillColorLine [] = char_fill Vty.def_attr ' ' w 1
- fillColorLine l = horiz_cat (map colorChar l)
+ fillColorLine [] = charFill Vty.defAttr ' ' w 1
+ fillColorLine l = horizCat (map colorChar l)
<|>
- char_fill a ' ' (w - length l) 1
+ charFill a ' ' (w - length l) 1
where (_,(a,_x)) = last l
-- | Cut a string in lines separated by a '\n' char. Note
@@ -404,7 +404,7 @@ drawText h w topPoint point tabWidth buf
| otherwise = [(c,p)]
withAttributes :: Attributes -> String -> Image
-withAttributes sty str = Vty.string (attributesToAttr sty Vty.def_attr) str
+withAttributes sty str = Vty.string (attributesToAttr sty Vty.defAttr) str
------------------------------------------------------------------------
@@ -432,31 +432,31 @@ colorToAttr :: (Vty.Color -> Vty.Attr ->
colorToAttr set c =
case c of
RGB 0 0 0 -> set Vty.black
- RGB 128 128 128 -> set Vty.bright_black
+ RGB 128 128 128 -> set Vty.brightBlack
RGB 139 0 0 -> set Vty.red
- RGB 255 0 0 -> set Vty.bright_red
+ RGB 255 0 0 -> set Vty.brightRed
RGB 0 100 0 -> set Vty.green
- RGB 0 128 0 -> set Vty.bright_green
+ RGB 0 128 0 -> set Vty.brightGreen
RGB 165 42 42 -> set Vty.yellow
- RGB 255 255 0 -> set Vty.bright_yellow
+ RGB 255 255 0 -> set Vty.brightYellow
RGB 0 0 139 -> set Vty.blue
- RGB 0 0 255 -> set Vty.bright_blue
+ RGB 0 0 255 -> set Vty.brightBlue
RGB 128 0 128 -> set Vty.magenta
- RGB 255 0 255 -> set Vty.bright_magenta
+ RGB 255 0 255 -> set Vty.brightMagenta
RGB 0 139 139 -> set Vty.cyan
- RGB 0 255 255 -> set Vty.bright_cyan
+ RGB 0 255 255 -> set Vty.brightCyan
RGB 165 165 165 -> set Vty.white
- RGB 255 255 255 -> set Vty.bright_white
+ RGB 255 255 255 -> set Vty.brightWhite
Default -> id
_ -> error $ "Color unsupported by Vty frontend: " ++ show c
attributesToAttr :: Attributes -> (Vty.Attr -> Vty.Attr)
attributesToAttr (Attributes fg bg reverse bd _itlc underline') =
- (if reverse then (flip Vty.with_style Vty.reverse_video) else id) .
- (if bd then (flip Vty.with_style Vty.bold) else id) .
- (if underline' then (flip Vty.with_style Vty.underline) else id) .
- colorToAttr (flip Vty.with_fore_color) fg .
- colorToAttr (flip Vty.with_back_color) bg
+ (if reverse then (flip Vty.withStyle Vty.reverseVideo) else id) .
+ (if bd then (flip Vty.withStyle Vty.bold) else id) .
+ (if underline' then (flip Vty.withStyle Vty.underline) else id) .
+ colorToAttr (flip Vty.withForeColor) fg .
+ colorToAttr (flip Vty.withBackColor) bg
---------------------------------
--- yi-0.7.1.orig/yi.cabal
+++ yi-0.7.1/yi.cabal
@@ -230,6 +230,7 @@ library
data-accessor >= 0.2.1.4 && < 0.3,
data-accessor-mtl == 0.2.*,
data-accessor-template >= 0.2.1.3 && < 0.2.2,
+ data-default,
dlist >=0.4.1,
dyre >=0.8.11,
filepath>=1.1 && <1.4,
@@ -293,7 +293,7 @@ library
Yi.UI.Vty
build-depends:
unix-compat >=0.1 && <0.5,
- vty >= 4.7.0.0 && <5
+ vty >= 5.1.0.0 && <6
cpp-options: -DFRONTEND_VTY
if flag (scion)
|