Hi! >Well, this is not surprising: Cabal will simply disable the vty support >in yi if it does not find a compatible vty version. You at least also >need to patch the .cabal file to allow for the newer version of vty. Oh, I forgot most parts, thank you for the reminder! Please see the attached patches, which are for the sourcecode and debian/control. >Alternatively, if you care about yi you are probably in the position to >tell us what features are missing without vty, and whether we can maybe >drop the dependency. Without vty, there would be no support as an editor in a terminal, so at least I would not be content with the package. >It’s open to non-DMs, so if you are interested in helping out with yi >and the other 750 packages, that’d be great! Sounds daunting. I will try to get up to it in between, but there may be bumps. Regards, Marcel
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
@@ -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,6 @@ defaultConfig =
, configAutoHideTabBar = True
, configWindowFill = ' '
, configTheme = defaultTheme
- , configVtyEscDelay = 0
}
, defaultKm = modelessKeymapSet nilKeymap
, startActions = []
@@ -193,7 +193,9 @@ 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
+ },
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
@@ -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)
--- yi-0.7.1-orig/debian/control 2014-08-04 11:27:10.000000000 +0200
+++ yi-0.7.1/debian/control 2014-09-10 17:22:15.607225128 +0200
@@ -76,8 +76,8 @@
, libghc-unordered-containers-prof
, libghc-utf8-string-dev (>= 0.3.1)
, libghc-utf8-string-prof
- , libghc-vty-dev (>= 4.7.0.0)
- , libghc-vty-dev (<< 5)
+ , libghc-vty-dev (>= 5.1.0.0)
+ , libghc-vty-dev (<< 6)
, libghc-vty-prof
, libghc-xdg-basedir-dev (>= 0.2.1)
, libghc-xdg-basedir-dev (<< 0.3)
Attachment:
signature.asc
Description: PGP signature