yi 0.12.5 → 0.12.6
raw patch · 10 files changed
+236/−135 lines, 10 filesdep +Hclip
Dependencies added: Hclip
Files
- src/library/Yi/Buffer/Misc.hs +4/−4
- src/library/Yi/Editor.hs +14/−4
- src/library/Yi/Keymap/Cua.hs +31/−27
- src/library/Yi/Keymap/Emacs.hs +3/−3
- src/library/Yi/Keymap/Emacs/KillRing.hs +54/−18
- src/library/Yi/Keymap/Vim/Utils.hs +18/−2
- src/library/Yi/Layout.hs +43/−17
- src/library/Yi/UI/SimpleLayout.hs +40/−38
- src/library/Yi/UI/Vty.hs +25/−17
- yi.cabal +4/−5
src/library/Yi/Buffer/Misc.hs view
@@ -360,7 +360,7 @@ modeNm <- gets (withMode0 modeName) unchanged <- gets isUnchangedBuffer enc <- use encodingConverterNameA >>= return . \case- Nothing -> mempty+ Nothing -> mempty :: T.Text Just cn -> T.pack $ R.unCn cn let pct | pos == 0 || s == 0 = " Top"@@ -991,7 +991,7 @@ -> BufferM YiString betweenB (Point s) (Point e) = if s >= e- then return mempty+ then return (mempty :: YiString) else snd . R.splitAt s . fst . R.splitAt e <$> elemsB -- | Read the character at the current point@@ -1105,8 +1105,8 @@ -- This allows you to retrieve inside a 'BufferM' monad, ie: -- -- > value <- getBufferDyn-getBufferDyn :: (YiVariable a, MonadState FBuffer m, Functor m) => m a-getBufferDyn = fromMaybe def <$> getDyn (use bufferDynamicA) (assign bufferDynamicA)+getBufferDyn :: forall m a. (Default a, YiVariable a, MonadState FBuffer m, Functor m) => m a+getBufferDyn = fromMaybe (def :: a) <$> getDyn (use bufferDynamicA) (assign bufferDynamicA) -- | Access to a value into the extensible state, keyed by its type. -- This allows you to save inside a 'BufferM' monad, ie:
src/library/Yi/Editor.hs view
@@ -51,6 +51,7 @@ , layoutManagerPreviousVariantE , layoutManagersNextE , layoutManagersPreviousE+ , layoutManagersPrintMsgE , maxStatusHeightA , moveTabE , moveWinNextE@@ -625,15 +626,21 @@ w <- gets currentBuffer >>= newWindowE False windowsA %= PL.insertRight w +-- | Prints the description of the current layout manager in the status bar+layoutManagersPrintMsgE :: EditorM ()+layoutManagersPrintMsgE = do+ lm <- use $ currentTabA . tabLayoutManagerA+ printMsg . T.pack $ describeLayout lm+ -- | Cycle to the next layout manager, or the first one if the current -- one is nonstandard. layoutManagersNextE :: EditorM ()-layoutManagersNextE = withLMStackE PL.next+layoutManagersNextE = withLMStackE PL.next >> layoutManagersPrintMsgE -- | Cycle to the previous layout manager, or the first one if the -- current one is nonstandard. layoutManagersPreviousE :: EditorM ()-layoutManagersPreviousE = withLMStackE PL.previous+layoutManagersPreviousE = withLMStackE PL.previous >> layoutManagersPrintMsgE -- | Helper function for 'layoutManagersNext' and 'layoutManagersPrevious' withLMStackE :: (PL.PointedList AnyLayoutManager@@ -650,13 +657,16 @@ -- | Next variant of the current layout manager, as given by 'nextVariant' layoutManagerNextVariantE :: EditorM ()-layoutManagerNextVariantE = currentTabA . tabLayoutManagerA %= nextVariant+layoutManagerNextVariantE = do+ currentTabA . tabLayoutManagerA %= nextVariant+ layoutManagersPrintMsgE -- | Previous variant of the current layout manager, as given by -- 'previousVariant' layoutManagerPreviousVariantE :: EditorM ()-layoutManagerPreviousVariantE =+layoutManagerPreviousVariantE = do currentTabA . tabLayoutManagerA %= previousVariant+ layoutManagersPrintMsgE -- | Sets the given divider position on the current tab setDividerPosE :: DividerRef -> DividerPosition -> EditorM ()
src/library/Yi/Keymap/Cua.hs view
@@ -18,21 +18,22 @@ , del ) where -import Control.Applicative (Alternative ((<|>)), (<$>))-import Control.Lens (assign, use)-import Control.Monad (unless, when)-import qualified Data.Text as T (drop, take)+import Control.Applicative (Alternative ((<|>)), (<$>))+import Control.Lens (assign, use)+import Control.Monad (unless, when)+import qualified Data.Text as T (drop, take) import Yi.Buffer import Yi.Editor-import Yi.File (fwriteE)-import Yi.Keymap (Keymap, KeymapSet, YiM, modelessKeymapSet, write)-import Yi.Keymap.Emacs.Utils (askQuitEditor, findFile, isearchKeymap)+import Yi.File (fwriteE)+import Yi.Keymap (Keymap, KeymapSet, YiM, modelessKeymapSet, write)+import Yi.Keymap.Emacs.Utils (askQuitEditor, findFile, isearchKeymap) import Yi.Keymap.Keys-import Yi.MiniBuffer (commentRegion)-import Yi.Misc (adjBlock, selectAll)-import Yi.Rectangle (getRectangle, killRectangle, yankRectangle)-import qualified Yi.Rope as R (YiString, length, singleton, withText)-import Yi.String (lines', unlines')+import Yi.MiniBuffer (commentRegion)+import Yi.Misc (adjBlock, selectAll)+import Yi.Rectangle (getRectangle, killRectangle, yankRectangle)+import qualified Yi.Rope as R (YiString, length, singleton, withText)+import Yi.String (lines', unlines')+import Yi.Keymap.Emacs.KillRing (clipboardToKillring, killringToClipboard) customizedCuaKeymapSet :: Keymap -> KeymapSet customizedCuaKeymapSet userKeymap =@@ -84,8 +85,8 @@ then withEditor del else withCurrentBuffer (adjBlock (-1) >> act) -cut :: EditorM ()-cut = copy >> del+cut :: YiM ()+cut = copy >> withEditor del del :: EditorM () del = do@@ -94,22 +95,25 @@ then killRectangle else withCurrentBuffer $ deleteRegionB =<< getSelectRegionB -copy :: EditorM ()-copy =- (setRegE =<<) $ withCurrentBuffer $ do- asRect <- use rectangleSelectionA- if not asRect- then getSelectRegionB >>= readRegionB- else do- (reg, l, r) <- getRectangle- let dropOutside = fmap (T.take (r - l) . T.drop l)- R.withText (unlines' . dropOutside . lines') <$> readRegionB reg+copy :: YiM ()+copy = do+ text <- withCurrentBuffer $ do+ asRect <- use rectangleSelectionA+ if not asRect+ then getSelectRegionB >>= readRegionB+ else do+ (reg, l, r) <- getRectangle+ let dropOutside = fmap (T.take (r - l) . T.drop l)+ R.withText (unlines' . dropOutside . lines') <$> readRegionB reg+ withEditor $ setRegE text+ killringToClipboard -paste :: EditorM ()+paste :: YiM () paste = do+ clipboardToKillring asRect <- withCurrentBuffer (use rectangleSelectionA)- if asRect- then yankRectangle+ withEditor $+ if asRect then yankRectangle else withCurrentBuffer . replaceSel =<< getRegE moveKeys :: [(Event, BufferM ())]
src/library/Yi/Keymap/Emacs.hs view
@@ -143,7 +143,7 @@ , ctrlCh 'h' ?>> char 'b' ?>>! acceptedInputsOtherWindow , ctrlCh 'i' ?>>! adjIndent IncreaseOnly , ctrlCh 'j' ?>>! newlineAndIndentB- , ctrlCh 'k' ?>>! killLineE univArg+ , ctrlCh 'k' ?>>! killLine univArg , ctrlCh 'l' ?>>! (withCurrentBuffer scrollToCursorB >> userForceRefresh) , ctrlCh 'm' ?>>! repeatingArg (insertB '\n') , ctrlCh 'n' ?>>! repeatingArg (moveE VLine Forward)@@ -155,7 +155,7 @@ , ctrlCh 't' ?>>! repeatingArg swapB , ctrlCh 'v' ?>>! scrollDownE univArg , ctrlCh 'w' ?>>! killRegion- , ctrlCh 'y' ?>>! yankE+ , ctrlCh 'y' ?>>! yank , ctrlCh 'z' ?>>! suspendEditor , ctrlCh '+' ?>>! repeatingArg (increaseFontSize 1) , ctrlCh '-' ?>>! repeatingArg (decreaseFontSize 1)@@ -204,7 +204,7 @@ , metaCh 'r' ?>>! repeatingArg moveToMTB , metaCh 'u' ?>>! repeatingArg uppercaseWordB , metaCh 't' ?>>! repeatingArg (transposeB unitWord Forward)- , metaCh 'w' ?>>! killRingSaveE+ , metaCh 'w' ?>>! killRingSave , metaCh 'x' ?>>! executeExtendedCommandE , metaCh 'y' ?>>! yankPopE , metaCh '.' ?>>! promptTag
src/library/Yi/Keymap/Emacs/KillRing.hs view
@@ -10,45 +10,76 @@ module Yi.Keymap.Emacs.KillRing where import Control.Lens (assign, use, uses, (%=), (.=))-import Control.Monad (replicateM_)+import Control.Monad (replicateM_, when) import Data.List.NonEmpty (NonEmpty ((:|)))+import Data.Maybe (fromMaybe) import Yi.Buffer import Yi.Editor (EditorM, killringA, withCurrentBuffer) import Yi.Keymap (YiM) import Yi.KillRing (Killring (_krContents), krKilled, krPut)-import qualified Yi.Rope as R (YiString)+import qualified Yi.Rope as R (YiString, fromString, toString)+import Yi.Types (withEditor)+import Yi.Utils (io)+import System.Hclip (getClipboard, setClipboard) -- * Killring actions +-- | Adds system clipboard's contents on top of the killring if not already there+clipboardToKillring :: YiM ()+clipboardToKillring = do+ text <- fmap R.fromString $ io getClipboard+ withEditor $ do+ text' <- killringGet+ when (text' /= text) $ killringPut Forward text --- | C-w---+-- | Adds the top of the killring to the system clipboard+killringToClipboard :: YiM ()+killringToClipboard = do+ text <- withEditor killringGet+ io . setClipboard $ R.toString text+ -- This is like @kill-region-or-backward-word@.-killRegion :: BufferM ()-killRegion = getSelectRegionB >>= \r ->+killRegionB :: BufferM ()+killRegionB = getSelectRegionB >>= \r -> if regionStart r == regionEnd r then bkillWordB else deleteRegionB r +-- | C-w+-- Like `killRegionB`, but with system clipboard synchronization+killRegion :: YiM ()+killRegion = withCurrentBuffer killRegionB >> killringToClipboard++-- | Kills current line+killLineB :: Maybe Int -> BufferM ()+killLineB mbr = replicateM_ (fromMaybe 1 mbr) $ do+ eol <- atEol+ let tu = if eol then Character else Line+ deleteRegionB =<< regionOfPartNonEmptyB tu Forward+ -- | C-k-killLineE :: Maybe Int -> YiM ()-killLineE Nothing = withCurrentBuffer killRestOfLine-killLineE (Just n) = withCurrentBuffer $ replicateM_ (2*n) killRestOfLine+-- | Like `killLineB`, but with system clipboard synchronization+killLine :: Maybe Int -> YiM ()+killLine mbr = withCurrentBuffer (killLineB mbr) >> killringToClipboard +killringGet :: EditorM R.YiString+killringGet = do+ text :| _ <- uses killringA _krContents+ return text+ killringPut :: Direction -> R.YiString -> EditorM () killringPut dir s = killringA %= krPut dir s --- | Kill the rest of line-killRestOfLine :: BufferM ()-killRestOfLine =- do eol <- atEol- if eol then deleteN 1 else deleteToEol---- | C-y+-- | Yanks top of killbuffer yankE :: EditorM () yankE = do text :| _ <- uses killringA _krContents withCurrentBuffer $ pointB >>= setSelectionMarkPointB >> insertN text --- | M-w+-- | C-y+-- Like `yankE`, but with system clipboard synchronization+yank :: YiM ()+yank = clipboardToKillring >> withEditor yankE++-- | Saves current selection to killring and then clears it killRingSaveE :: EditorM () killRingSaveE = do (r, text) <- withCurrentBuffer $ do@@ -57,8 +88,13 @@ assign highlightSelectionA False return (r, text) killringPut (regionDirection r) text--- | M-y +-- | M-w+-- Like `killRingSaveE`, but with system clipboard synchronization+killRingSave :: YiM ()+killRingSave = withEditor killRingSaveE >> killringToClipboard++-- | M-y -- TODO: Handle argument, verify last command was a yank yankPopE :: EditorM () yankPopE = do
src/library/Yi/Keymap/Vim/Utils.hs view
@@ -25,6 +25,8 @@ , addNewLineIfNecessary , indentBlockRegionB , addVimJumpHereE+ , exportRegisterToClipboard+ , pasteFromClipboard ) where import Control.Applicative ((<$), (<$>))@@ -42,10 +44,13 @@ import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.EventUtils (eventToEventString, splitCountedCommand) import Yi.Keymap.Vim.Motion (Move (Move), stringToMove)-import Yi.Keymap.Vim.StateUtils (getMaybeCountE, modifyStateE, resetCountE)+import Yi.Keymap.Vim.StateUtils (getMaybeCountE, modifyStateE,+ resetCountE, getRegisterE) import Yi.Monad (whenM) import Yi.Rope (YiString, countNewLines, last)-import qualified Yi.Rope as R (replicateChar, snoc)+import qualified Yi.Rope as R (replicateChar, snoc, toString, fromString)+import Yi.Utils (io)+import System.Hclip (getClipboard, setClipboard) -- 'mkBindingE' and 'mkBindingY' are helper functions for bindings -- where VimState mutation is not dependent on action performed@@ -203,3 +208,14 @@ addNewLineIfNecessary :: YiString -> YiString addNewLineIfNecessary rope = if trailingNewline rope then rope else rope `R.snoc` '\n'++pasteFromClipboard :: YiM ()+pasteFromClipboard = do+ text <- fmap R.fromString $ io getClipboard+ withCurrentBuffer $ insertRopeWithStyleB text Inclusive++exportRegisterToClipboard :: RegisterName -> YiM ()+exportRegisterToClipboard name = do+ mbr <- withEditor $ getRegisterE name+ io . setClipboard $ maybe "" (R.toString . regContent) mbr+
src/library/Yi/Layout.hs view
@@ -16,6 +16,7 @@ DividerRef, RelativeSize, dividerPositionA,+ findDivider, -- * Layout managers -- ** The interface@@ -32,6 +33,7 @@ -- * Utility functions -- ** Layouts as rectangles Rectangle(..),+ HasNeighborWest, layoutToRectangles, -- ** Transposing things Transposable(..),@@ -53,7 +55,7 @@ import qualified Control.Monad.State.Strict as Monad (State, evalState, get, put) import Data.Default (Default, def) import Data.List (foldl', mapAccumL)-import Data.Maybe (fromMaybe)+import Data.Maybe (fromMaybe, isNothing) import Data.Typeable (Typeable, cast, typeOf) -------------------------------- Some design notes ----------------------@@ -122,6 +124,18 @@ invalidRef = error "Yi.Layout.dividerPositionA: invalid DividerRef" +-- | Find the divider nearest to a given window, or just the first one+-- in case the argument is 'Nothing'+findDivider :: Eq a => Maybe a -> Layout a -> Maybe DividerRef+findDivider mbw = go [] where+ go path (SingleWindow w) = maybe Nothing (\w' ->+ if w == w' && not (null path)+ then Just (head path) else Nothing) mbw+ go path (Pair _ _ ref l1 l2) = if isNothing mbw then Just ref+ else let p' = ref : path+ in go p' l1 <|> go p' l2+ go path (Stack _ ws) = foldr (<|>) Nothing $ map (go path . fst) ws+ instance Show a => Show (Layout a) where show (SingleWindow a) = show a show (Stack o s) = show o ++ " stack " ++ show s@@ -296,24 +310,36 @@ data Rectangle = Rectangle { rectX, rectY, rectWidth, rectHeight :: !Double } deriving(Eq, Show) -layoutToRectangles :: Rectangle -> Layout a -> [(a, Rectangle)]-layoutToRectangles bounds (SingleWindow a) = [(a, bounds)]-layoutToRectangles bounds (Stack o ts) = handleStack o bounds ts-layoutToRectangles bounds (Pair o p _ a b) = handleStack o bounds [(a,p), (b,1-p)]+-- | Used by the vty frontend to draw vertical separators+type HasNeighborWest = Bool -handleStack :: Orientation -> Rectangle -> [(Layout a, RelativeSize)] -> [(a, Rectangle)]-handleStack o bounds tiles =- let (totalSpace, startPos, mkBounds) = case o of- Vertical -> (rectHeight bounds, rectY bounds, \pos size -> bounds{rectY = pos, rectHeight=size})- Horizontal -> (rectWidth bounds, rectX bounds, \pos size -> bounds{rectX = pos, rectWidth=size})+layoutToRectangles :: HasNeighborWest -> Rectangle -> Layout a -> [(a, Rectangle, HasNeighborWest)]+layoutToRectangles nb bounds (SingleWindow a) = [(a, bounds, nb)]+layoutToRectangles nb bounds (Stack o ts) = handleStack o bounds ts'+ where ts' = if o == Vertical then setNbs nb ts+ else case ts of+ (l, s) : xs -> (l, s, nb) : setNbs True xs+ [] -> []+ setNbs val = map (\(l, s) -> (l, s, val))+layoutToRectangles nb bounds (Pair o p _ a b) = handleStack o bounds [(a,p,nb), (b,1-p,nb')]+ where nb' = if o == Horizontal then True else nb - totalWeight' = sum (fmap snd tiles)- totalWeight = if totalWeight' > 0 then totalWeight' else error "Yi.Layout: Stacks must have positive weights"- spacePerWeight = totalSpace / totalWeight- doTile pos (t, wt) = (pos + wt * spacePerWeight,- layoutToRectangles (mkBounds pos (wt * spacePerWeight)) t)- in- concat . snd . mapAccumL doTile startPos $ tiles+handleStack :: Orientation -> Rectangle+ -> [(Layout a, RelativeSize, HasNeighborWest)]+ -> [(a, Rectangle, HasNeighborWest)]+handleStack o bounds tiles = concat . snd . mapAccumL doTile startPos $ tiles+ where + (totalSpace, startPos, mkBounds) = case o of+ Vertical -> (rectHeight bounds, rectY bounds,+ \pos size -> bounds { rectY = pos, rectHeight = size })+ Horizontal -> (rectWidth bounds, rectX bounds,+ \pos size -> bounds { rectX = pos, rectWidth = size })+ totalWeight' = sum . fmap (\(_, s, _) -> s) $ tiles+ totalWeight = if totalWeight' > 0 then totalWeight'+ else error "Yi.Layout: Stacks must have positive weights"+ spacePerWeight = totalSpace / totalWeight+ doTile pos (t, wt, nb) = (pos + wt * spacePerWeight,+ layoutToRectangles nb (mkBounds pos (wt * spacePerWeight)) t) ----------- Flipping things -- | Things with orientations which can be flipped
src/library/Yi/UI/SimpleLayout.hs view
@@ -15,13 +15,13 @@ import Prelude hiding (concatMap, mapM) -import Control.Lens (use, (.~))+import Control.Lens (use, (.~), (&), (^.), to, _1) import Control.Monad.State (evalState, get, put) import Data.Foldable (find, toList) import Data.List (partition)-import qualified Data.List.PointedList.Circular as PL (PointedList)+import qualified Data.List.PointedList.Circular as PL (PointedList, focus) import qualified Data.Map.Strict as M (Map, fromList)-import Data.Maybe (fromJust)+import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T (uncons) import Data.Traversable (mapM)@@ -30,10 +30,14 @@ import qualified Yi.Rope as R (take, toString, toText) import Yi.UI.Utils (arrangeItems) import Yi.Window+import Yi.Tab (tabLayout)+import qualified Yi.Layout as L (Layout)+import Yi.Layout (Rectangle(..), HasNeighborWest,+ layoutToRectangles) data Layout = Layout { tabbarRect :: !Rect- , windowRects :: !(M.Map WindowRef Rect)+ , windowRects :: !(M.Map WindowRef (Rect, HasNeighborWest)) , promptRect :: !Rect } @@ -56,43 +60,41 @@ layout :: Int -> Int -> Editor -> (Editor, Layout) layout colCount rowCount e =- ( (windowsA .~ newWindows) e- , Layout (Rect 0 0 colCount 1) winRects cmdRect+ ( e & windowsA .~ newWs+ , Layout tabRect winRects cmdRect ) where- (miniWs, ws) = partition isMini (toList (windows e))- (cmd, _) = statusLineInfo e- niceCmd = arrangeItems cmd colCount (maxStatusHeight e)- cmdRect = Rect 0 (rowCount - cmdHeight - if null miniWs then 0 else 1) colCount cmdHeight- cmdHeight = length niceCmd- tabbarHeight = 1- (heightQuot, heightRem) =- quotRem- (rowCount - tabbarHeight - if null miniWs then max 1 cmdHeight else 1 + cmdHeight)- (length ws)- heights = heightQuot + heightRem : repeat heightQuot- offsets = scanl (+) 0 heights- bigWindowsWithHeights =- zipWith (\win h -> layoutWindow win e colCount h)- ws- heights- miniWindowsWithHeights =- fmap (\win -> layoutWindow win e colCount 1) miniWs- newWindows =- merge (miniWindowsWithHeights <> bigWindowsWithHeights) (windows e)- winRects = M.fromList (bigWindowsWithRects <> miniWindowsWithRects)- bigWindowsWithRects =- zipWith (\w offset -> (wkey w, Rect 0 (offset + tabbarHeight) colCount (height w)))- bigWindowsWithHeights- offsets- miniWindowsWithRects =- map (\w -> (wkey w, Rect 0 (rowCount - 1) colCount 1))- miniWindowsWithHeights- merge :: [Window] -> PL.PointedList Window -> PL.PointedList Window- merge updates =- let replace (Window { wkey = k }) = fromJust (find ((== k) . wkey) updates)- in fmap replace+ lt = e ^. tabsA . PL.focus . to tabLayout+ miniWs = filter isMini . toList $ windows e+ tabHeight = 1+ tabRect = Rect 0 0 colCount tabHeight+ cmdHeight = length $ arrangeItems (fst $ statusLineInfo e) colCount (maxStatusHeight e)+ miniHeight = if null miniWs then 0 else 1+ cmdRect = Rect 0 (rowCount - cmdHeight - miniHeight) colCount cmdHeight+ bounds = rectToRectangle $ Rect 0 tabHeight colCount $+ rowCount - (max 1 $ cmdHeight + miniHeight) - tabHeight+ bigRects = layoutToRectangles False bounds lt & map (\(wr, r, nb) ->+ let r' = rectangleToRect r+ sx = sizeX r' - if nb then 1 else 0+ w' = layoutWindow (findWindowWith wr e) e sx (sizeY r')+ in (w', r', nb))+ miniRects = miniWs & map (\w ->+ let r' = Rect 0 (rowCount - 1) colCount 1+ w' = layoutWindow w e (sizeX r') (sizeY r')+ in (w', r', False))+ rects = bigRects <> miniRects+ winRects = rects & M.fromList . map (\(w, r, nb) -> (wkey w, (r, nb)))+ updWs = rects & map (^. _1)+ newWs = windows e & fmap (\w -> fromMaybe w $ find ((== wkey w) . wkey) updWs) +rectToRectangle :: Rect -> Rectangle+rectToRectangle (Rect x y sx sy) = Rectangle (fromIntegral x) (fromIntegral y)+ (fromIntegral sx) (fromIntegral sy)++rectangleToRect :: Rectangle -> Rect+rectangleToRect (Rectangle x y sx sy) = Rect (truncate x) (truncate y)+ (truncate (x + sx) - truncate x)+ (truncate (y + sy) - truncate y) layoutWindow :: Window -> Editor -> Int -> Int -> Window layoutWindow win e w h = win
src/library/Yi/UI/Vty.hs view
@@ -61,6 +61,7 @@ import Yi.Style import qualified Yi.UI.Common as Common import qualified Yi.UI.SimpleLayout as SL+import Yi.Layout (HasNeighborWest) import Yi.UI.TabBar (TabDescr (TabDescr), tabBarDescr) import Yi.UI.Utils (arrangeItems, attributesPictureAndSelB) import Yi.UI.Vty.Conversions (colorToAttr, fromVtyEvent)@@ -169,15 +170,15 @@ refresh :: FrontendState -> Editor -> IO () refresh fs e = do (colCount, rowCount) <- Vty.displayBounds (Vty.outputIface (fsVty fs))- let (_e, SL.Layout _tabbarRect winRects promptRect) = SL.layout colCount rowCount e+ let (_e, SL.Layout tabbarRect winRects promptRect) = SL.layout colCount rowCount e ws = windows e (cmd, cmdSty) = statusLineInfo e niceCmd = arrangeItems cmd (SL.sizeX promptRect) (maxStatusHeight e) mkLine = T.justifyLeft colCount ' ' . T.take colCount formatCmdLine text = withAttributes statusBarStyle (mkLine text) winImage (win, hasFocus) =- let rect = winRects M.! wkey win- in renderWindow (configUI $ fsConfig fs) e rect (win, hasFocus)+ let (rect, nb) = winRects M.! wkey win+ in renderWindow (configUI $ fsConfig fs) e rect nb (win, hasFocus) windowsAndImages = fmap (\(w, f) -> (w, winImage (w, f))) (PL.withFocus ws) bigImages =@@ -190,7 +191,7 @@ ((appEndo <$> cmdSty) <*> baseAttributes) (configStyle (configUI (fsConfig fs))) tabBarImage =- renderTabBar (configStyle (configUI (fsConfig fs)))+ renderTabBar tabbarRect (configStyle (configUI (fsConfig fs))) (map (\(TabDescr t f) -> (t, f)) (toList (tabBarDescr e))) cmdImage = if null cmd then Vty.emptyImage@@ -210,11 +211,13 @@ (Vty.picForLayers ([tabBarImage, cmdImage] ++ bigImages ++ miniImages)) { Vty.picCursor = cursorPos } -renderWindow :: UIConfig -> Editor -> SL.Rect -> (Window, Bool) -> Rendered-renderWindow cfg e (SL.Rect x y w h) (win, focused) =- Rendered (Vty.translate x y pict)- (fmap (\(i, j) -> (i + y, j + x)) cur)+renderWindow :: UIConfig -> Editor -> SL.Rect -> HasNeighborWest -> (Window, Bool) -> Rendered+renderWindow cfg e (SL.Rect x y w h) nb (win, focused) =+ Rendered (Vty.translate x y $ if nb then vertSep Vty.<|> pict else pict)+ (fmap (\(i, j) -> (i + y, j + x')) cur) where+ x' = x + if nb then 1 else 0+ w' = w - if nb then 1 else 0 b = findBufferWith (bufkey win) e sty = configStyle cfg @@ -226,7 +229,7 @@ wsty = attributesToAttr ground Vty.defAttr eofsty = appEndo (eofStyle sty) ground (point, _) = runBuffer win b pointB- region = mkSizeRegion fromMarkPoint (Size (w*h'))+ region = mkSizeRegion fromMarkPoint $ Size (w' * h') -- Work around a problem with the mini window never displaying it's contents due to a -- fromMark that is always equal to the end of the buffer contents. (Just (MarkSet fromM _ _), _) = runBuffer win b (getMarks win)@@ -247,28 +250,31 @@ cur = (fmap (\(SL.Point2D curx cury) -> (cury, T.length prompt + curx)) . fst) (runBuffer win b (SL.coordsOfCharacterB- (SL.Size2D w h)+ (SL.Size2D w' h) fromMarkPoint point)) rendered =- drawText wsty h' w+ drawText wsty h' w' tabWidth ([(c, wsty) | c <- T.unpack prompt] ++ bufData ++ [(' ', wsty)]) -- we always add one character which can be used to position the cursor at the end of file commonPref = T.pack <$> commonNamePrefix e (modeLine0, _) = runBuffer win b $ getModeLine commonPref modeLine = if notMini then Just modeLine0 else Nothing- prepare = withAttributes modeStyle . T.justifyLeft w ' ' . T.take w+ prepare = withAttributes modeStyle . T.justifyLeft w' ' ' . T.take w' modeLines = map prepare $ maybeToList modeLine modeStyle = (if focused then appEndo (modelineFocusStyle sty) else id) (modelineAttributes sty) filler :: T.Text- filler = if w == 0 -- justify would return a single char at w = 0+ filler = if w' == 0 -- justify would return a single char at w = 0 then T.empty- else T.justifyLeft w ' ' $ T.singleton (configWindowFill cfg)+ else T.justifyLeft w' ' ' $ T.singleton (configWindowFill cfg) - pict = Vty.vertCat (take h' (rendered <> repeat (withAttributes eofsty filler)) <> modeLines)+ pict = Vty.vertCat $ take h' (rendered <> repeat (withAttributes eofsty filler)) <> modeLines+ + sepStyle = attributesToAttr (modelineAttributes sty) Vty.defAttr+ vertSep = Vty.charFill sepStyle ' ' 1 h withAttributes :: Attributes -> T.Text -> Vty.Image withAttributes sty = Vty.text' (attributesToAttr sty Vty.defAttr)@@ -350,8 +356,8 @@ | otherwise = [(c, p)] where numeric = ord c -renderTabBar :: UIStyle -> [(T.Text, Bool)] -> Vty.Image-renderTabBar uiStyle = Vty.horizCat . fmap render+renderTabBar :: SL.Rect -> UIStyle -> [(T.Text, Bool)] -> Vty.Image+renderTabBar r uiStyle ts = (Vty.<|> padding) . Vty.horizCat $ fmap render ts where render (text, inFocus) = Vty.text' (tabAttr inFocus) (tabTitle text) tabTitle text = ' ' `T.cons` text `T.snoc` ' '@@ -361,3 +367,5 @@ baseAttr False sty = attributesToAttr (appEndo (tabNotFocusedStyle uiStyle) sty) Vty.defAttr `Vty.withStyle` Vty.underline+ padding = Vty.charFill (tabAttr False) ' ' (SL.sizeX r - width) 1+ width = sum . map ((+2) . T.length . fst) $ ts
yi.cabal view
@@ -1,5 +1,5 @@ name: yi-version: 0.12.5+version: 0.12.6 category: Development, Editor synopsis: The Haskell-Scriptable Editor description:@@ -12,7 +12,7 @@ homepage: https://yi-editor.github.io bug-reports: https://github.com/yi-editor/yi/issues Cabal-Version: >= 1.20-tested-with: GHC==7.8.4, GHC==7.10.1+tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 build-type: Simple data-files: art/*.png@@ -296,10 +296,10 @@ yi-language >= 0.1.1.0, oo-prototypes, yi-rope >= 0.7.0.0 && < 0.8,- exceptions+ exceptions,+ Hclip >= 3 ghc-options: -Wall -fno-warn-orphans -ferror-spans- ghc-prof-options: -prof -auto-all -rtsopts if flag(profiling) cpp-options: -DPROFILING@@ -373,7 +373,6 @@ base >=4 && <5, yi ghc-options: -threaded- ghc-prof-options: -prof -auto-all -rtsopts Test-Suite test-suite default-language: Haskell2010