diff --git a/src/library/Yi/Buffer/Misc.hs b/src/library/Yi/Buffer/Misc.hs --- a/src/library/Yi/Buffer/Misc.hs +++ b/src/library/Yi/Buffer/Misc.hs @@ -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: diff --git a/src/library/Yi/Editor.hs b/src/library/Yi/Editor.hs --- a/src/library/Yi/Editor.hs +++ b/src/library/Yi/Editor.hs @@ -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 () diff --git a/src/library/Yi/Keymap/Cua.hs b/src/library/Yi/Keymap/Cua.hs --- a/src/library/Yi/Keymap/Cua.hs +++ b/src/library/Yi/Keymap/Cua.hs @@ -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 ())] diff --git a/src/library/Yi/Keymap/Emacs.hs b/src/library/Yi/Keymap/Emacs.hs --- a/src/library/Yi/Keymap/Emacs.hs +++ b/src/library/Yi/Keymap/Emacs.hs @@ -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 diff --git a/src/library/Yi/Keymap/Emacs/KillRing.hs b/src/library/Yi/Keymap/Emacs/KillRing.hs --- a/src/library/Yi/Keymap/Emacs/KillRing.hs +++ b/src/library/Yi/Keymap/Emacs/KillRing.hs @@ -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 diff --git a/src/library/Yi/Keymap/Vim/Utils.hs b/src/library/Yi/Keymap/Vim/Utils.hs --- a/src/library/Yi/Keymap/Vim/Utils.hs +++ b/src/library/Yi/Keymap/Vim/Utils.hs @@ -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 + diff --git a/src/library/Yi/Layout.hs b/src/library/Yi/Layout.hs --- a/src/library/Yi/Layout.hs +++ b/src/library/Yi/Layout.hs @@ -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 diff --git a/src/library/Yi/UI/SimpleLayout.hs b/src/library/Yi/UI/SimpleLayout.hs --- a/src/library/Yi/UI/SimpleLayout.hs +++ b/src/library/Yi/UI/SimpleLayout.hs @@ -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 diff --git a/src/library/Yi/UI/Vty.hs b/src/library/Yi/UI/Vty.hs --- a/src/library/Yi/UI/Vty.hs +++ b/src/library/Yi/UI/Vty.hs @@ -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 diff --git a/yi.cabal b/yi.cabal --- a/yi.cabal +++ b/yi.cabal @@ -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