yi 0.11.1 → 0.11.2
raw patch · 57 files changed
+960/−333 lines, 57 filesdep ~timedep ~yi-language
Dependency ranges changed: time, yi-language
Files
- example-configs/yi-vim.hs +0/−1
- src/library/Yi/Buffer/HighLevel.hs +30/−8
- src/library/Yi/Buffer/Implementation.hs +49/−35
- src/library/Yi/Buffer/Indent.hs +25/−6
- src/library/Yi/Buffer/Misc.hs +45/−21
- src/library/Yi/Buffer/Normal.hs +1/−1
- src/library/Yi/Buffer/TextUnit.hs +5/−2
- src/library/Yi/Command/Help.hs +58/−0
- src/library/Yi/Completion.hs +2/−1
- src/library/Yi/Config/Default.hs +2/−2
- src/library/Yi/Core.hs +2/−2
- src/library/Yi/Debug.hs +1/−1
- src/library/Yi/Dired.hs +27/−23
- src/library/Yi/Editor.hs +4/−4
- src/library/Yi/Eval.hs +42/−4
- src/library/Yi/File.hs +23/−24
- src/library/Yi/History.hs +0/−3
- src/library/Yi/IReader.hs +2/−1
- src/library/Yi/Keymap/Cua.hs +3/−1
- src/library/Yi/Keymap/Emacs/Utils.hs +1/−2
- src/library/Yi/Keymap/Vim/EventUtils.hs +2/−0
- src/library/Yi/Keymap/Vim/Ex.hs +6/−0
- src/library/Yi/Keymap/Vim/Ex/Commands/Buffer.hs +1/−1
- src/library/Yi/Keymap/Vim/Ex/Commands/Common.hs +119/−25
- src/library/Yi/Keymap/Vim/Ex/Commands/Help.hs +36/−0
- src/library/Yi/Keymap/Vim/Ex/Commands/Paste.hs +5/−5
- src/library/Yi/Keymap/Vim/Ex/Commands/Quit.hs +3/−3
- src/library/Yi/Keymap/Vim/Ex/Commands/Sort.hs +39/−0
- src/library/Yi/Keymap/Vim/Ex/Commands/Tag.hs +1/−1
- src/library/Yi/Keymap/Vim/Ex/Commands/Undo.hs +32/−0
- src/library/Yi/Keymap/Vim/InsertMap.hs +26/−18
- src/library/Yi/Keymap/Vim/NormalMap.hs +9/−0
- src/library/Yi/Keymap/Vim/Operator.hs +58/−17
- src/library/Yi/Keymap/Vim/VisualMap.hs +2/−1
- src/library/Yi/MiniBuffer.hs +6/−8
- src/library/Yi/Mode/Haskell.hs +19/−19
- src/library/Yi/Mode/JavaScript.hs +1/−1
- src/library/Yi/Modes.hs +6/−1
- src/library/Yi/PersistentState.hs +1/−1
- src/library/Yi/Syntax/Latex.hs +1/−1
- src/library/Yi/Syntax/Tree.hs +1/−1
- src/library/Yi/Types.hs +31/−27
- src/library/Yi/UI/Pango.hs +6/−6
- src/library/Yi/UI/Pango/Control.hs +7/−8
- src/library/Yi/UI/SimpleLayout.hs +4/−4
- src/library/Yi/UI/Utils.hs +1/−1
- src/library/Yi/UI/Vty.hs +2/−2
- src/tests/vimtests/insertion/C-d_3.test +8/−0
- src/tests/vimtests/insertion/C-d_4.test +8/−0
- src/tests/vimtests/insertion/C-d_5.test +12/−0
- src/tests/vimtests/insertion/C-d_6.test +12/−0
- src/tests/vimtests/sort/1.test +26/−0
- src/tests/vimtests/sort/2.test +26/−0
- src/tests/vimtests/sort/3.test +26/−0
- src/tests/vimtests/sort/4.test +26/−0
- src/tests/vimtests/sort/5.test +24/−0
- yi.cabal +45/−40
example-configs/yi-vim.hs view
@@ -46,7 +46,6 @@ _ -> V2.NoMatch) in [ nmap "<C-h>" previousTabE , nmap "<C-l>" nextTabE- , nmap "<C-l>" nextTabE -- Press space to clear incremental search highlight , nmap " " (eval ":nohlsearch<CR>")
src/library/Yi/Buffer/HighLevel.hs view
@@ -94,6 +94,7 @@ , setSelectRegionB , shapeOfBlockRegionB , sortLines+ , sortLinesWithRegion , snapInsB , snapScreenB , splitBlockRegionToContiguousSubRegionsB@@ -114,13 +115,14 @@ import Control.Applicative import Control.Lens hiding ((-~), (+~), re, transform)+import Control.Lens.Cons (_last) import Control.Monad import Control.Monad.RWS.Strict (ask) import Control.Monad.State hiding (forM, forM_, sequence_) import Data.Char (isDigit, isHexDigit, isOctDigit, toUpper, isUpper, toLower, isSpace) import Data.List (sort, intersperse)-import Data.Maybe (fromMaybe, listToMaybe, catMaybes)+import Data.Maybe (fromMaybe, listToMaybe, catMaybes, fromJust) import Data.Monoid import qualified Data.Text as T import Data.Time (UTCTime)@@ -867,6 +869,26 @@ sortLines :: BufferM () sortLines = modifyExtendedSelectionB Line (onLines sort) +-- | Forces an extra newline into the region (if one exists)+modifyExtendedLRegion :: Region -> (R.YiString -> R.YiString) -> BufferM ()+modifyExtendedLRegion region transform = do+ reg <- unitWiseRegion Line region+ modifyRegionB transform (fixR reg)+ where fixR reg = mkRegion (regionStart reg) $ regionEnd reg + 1++sortLinesWithRegion :: Region -> BufferM ()+sortLinesWithRegion region = modifyExtendedLRegion region (onLines sort')+ where sort' [] = []+ sort' lns =+ if hasnl (last lns)+ then sort lns+ else over _last+ -- should be completely safe since every element contains newline+ (fromMaybe (error "sortLinesWithRegion fromMaybe") . R.init) . sort $+ over _last (`R.snoc` '\n') lns+ hasnl t | R.last t == Just '\n' = True+ | otherwise = False+ -- | Helper function: revert the buffer contents to its on-disk version revertB :: YiString -> Maybe R.ConverterName -> UTCTime -> BufferM () revertB s cn now = do@@ -1053,7 +1075,7 @@ (_, c1) <- getLineAndColOfPoint p1 case compare c0 c1 of EQ -> return (p0, p1)- GT -> fmap swap $ flipRectangleB p1 p0+ GT -> swap <$> flipRectangleB p1 p0 LT -> do -- now we know that c0 < c1 moveTo p0@@ -1099,11 +1121,11 @@ incrementNextNumberByB :: Int -> BufferM () incrementNextNumberByB n = do start <- pointB- untilB_ (not <$> isNumberB) (moveXorSol 1)- untilB_ (isNumberB) (moveXorEol 1)+ untilB_ (not <$> isNumberB) $ moveXorSol 1+ untilB_ isNumberB $ moveXorEol 1 begin <- pointB beginIsEol <- atEol- untilB_ (not <$> isNumberB) (moveXorEol 1)+ untilB_ (not <$> isNumberB) $ moveXorEol 1 end <- pointB if beginIsEol then moveTo start else do modifyRegionB (increment n) (mkRegion begin end)@@ -1113,9 +1135,9 @@ increment :: Int -> R.YiString -> R.YiString increment n l = R.fromString $ go (R.toString l) where- go ('0':'x':xs) = ((\ys -> '0':'x':ys) . (flip showHex "") . (+ n) . (fst . head . readHex)) xs- go ('0':'o':xs) = ((\ys -> '0':'o':ys) . (flip showOct "") . (+ n) . (fst . head . readOct)) xs- go s = (show . (+ n) . (\x -> read x :: Int)) s+ go ('0':'x':xs) = (\ys -> '0':'x':ys) . (`showHex` "") . (+ n) . fst . head . readHex $ xs+ go ('0':'o':xs) = (\ys -> '0':'o':ys) . (`showOct` "") . (+ n) . fst . head . readOct $ xs+ go s = show . (+ n) . (\x -> read x :: Int) $ s -- | Is character under cursor a number. isNumberB :: BufferM Bool
src/library/Yi/Buffer/Implementation.hs view
@@ -28,7 +28,7 @@ , Size , Direction (..) , BufferImpl- , Overlay, OvlLayer (..)+ , Overlay (..) , mkOverlay , overlayUpdate , applyUpdateI@@ -51,7 +51,8 @@ , setSyntaxBI , addOverlayBI , delOverlayBI- , delOverlayLayer+ , delOverlaysOfOwnerBI+ , getOverlaysOfOwnerBI , updateSyntax , getAst, focusAst , strokesRangesBI@@ -105,33 +106,37 @@ data HLState syntax = forall cache. HLState !(Highlighter cache syntax) !cache -data OvlLayer = UserLayer | HintLayer- deriving (Ord, Eq)-data Overlay = Overlay {- overlayLayer :: OvlLayer,- -- underscores to avoid 'defined but not used'. Remove if desired- _overlayBegin :: MarkValue,- _overlayEnd :: MarkValue,- _overlayStyle :: StyleName- }+data Overlay = Overlay+ { overlayOwner :: R.YiString+ , _overlayBegin :: MarkValue+ , _overlayEnd :: MarkValue+ , _overlayStyle :: StyleName+ , overlayAnnotation :: R.YiString+ }+ instance Eq Overlay where- Overlay a b c _ == Overlay a' b' c' _ = a == a' && b == b' && c == c'+ Overlay a b c _ msg == Overlay a' b' c' _ msg' =+ a == a' && b == b' && c == c' && msg == msg' instance Ord Overlay where- compare (Overlay a b c _) (Overlay a' b' c' _)- = compare a a' `mappend` compare b b' `mappend` compare c c'---data BufferImpl syntax =- FBufferData { mem :: !YiString -- ^ buffer text- , marks :: !Marks -- ^ Marks for this buffer- , markNames :: !(M.Map String Mark)- , hlCache :: !(HLState syntax) -- ^ syntax highlighting state- , overlays :: !(Set.Set Overlay) -- ^ set of (non overlapping) visual overlay regions- , dirtyOffset :: !Point -- ^ Lowest modified offset since last recomputation of syntax- }- deriving Typeable+ compare (Overlay a b c _ msg) (Overlay a' b' c' _ msg')+ = mconcat+ [ compare a a'+ , compare b b'+ , compare c c'+ , compare msg msg'+ ] +data BufferImpl syntax = FBufferData+ { mem :: !YiString -- ^ buffer text+ , marks :: !Marks -- ^ Marks for this buffer+ , markNames :: !(M.Map String Mark)+ , hlCache :: !(HLState syntax) -- ^ syntax highlighting state+ , overlays :: !(Set.Set Overlay)+ -- ^ set of (non overlapping) visual overlay regions+ , dirtyOffset :: !Point+ -- ^ Lowest modified offset since last recomputation of syntax+ } deriving Typeable dummyHlState :: HLState syntax dummyHlState = HLState noHighlighter (hlStartState noHighlighter)@@ -142,8 +147,6 @@ put b = put (mem b) >> put (marks b) >> put (markNames b) get = FBufferData <$> get <*> get <*> get <*> pure dummyHlState <*> pure Set.empty <*> pure 0 -- -- | Mutation actions (also used the undo or redo list) -- -- For the undo/redo, we use the /partial checkpoint/ (Berlage, pg16) strategy to store@@ -222,7 +225,7 @@ where p' = max from (p +~ by) mapOvlMarks :: (MarkValue -> MarkValue) -> Overlay -> Overlay-mapOvlMarks f (Overlay l s e v) = Overlay l (f s) (f e) v+mapOvlMarks f (Overlay _owner s e v msg) = Overlay _owner (f s) (f e) v msg ------------------------------------- -- * "high-level" (exported) operations@@ -251,12 +254,16 @@ dF n = n : dF (pred n) -- | Create an "overlay" for the style @sty@ between points @s@ and @e@-mkOverlay :: OvlLayer -> Region -> StyleName -> Overlay-mkOverlay l r = Overlay l (MarkValue (regionStart r) Backward) (MarkValue (regionEnd r) Forward)+mkOverlay :: R.YiString -> Region -> StyleName -> R.YiString -> Overlay+mkOverlay owner r =+ Overlay owner+ (MarkValue (regionStart r) Backward)+ (MarkValue (regionEnd r) Forward) -- | Obtain a style-update for a specific overlay overlayUpdate :: Overlay -> UIUpdate-overlayUpdate (Overlay _l (MarkValue s _) (MarkValue e _) _) = StyleUpdate s (e ~- s)+overlayUpdate (Overlay _owner (MarkValue s _) (MarkValue e _) _ _ann) =+ StyleUpdate s (e ~- s) -- | Add a style "overlay" between the given points. addOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax@@ -266,8 +273,14 @@ delOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax delOverlayBI ov fb = fb{overlays = Set.delete ov (overlays fb)} -delOverlayLayer :: OvlLayer -> BufferImpl syntax -> BufferImpl syntax-delOverlayLayer layer fb = fb{overlays = Set.filter ((/= layer) . overlayLayer) (overlays fb)}+delOverlaysOfOwnerBI :: R.YiString -> BufferImpl syntax -> BufferImpl syntax+delOverlaysOfOwnerBI owner fb =+ fb{overlays = Set.filter ((/= owner) . overlayOwner) (overlays fb)}++getOverlaysOfOwnerBI :: R.YiString -> BufferImpl syntax -> Set.Set Overlay+getOverlaysOfOwnerBI owner fb =+ Set.filter ((== owner) . overlayOwner) (overlays fb)+ -- FIXME: this can be really inefficient. -- | Return style information for the range @(i,j)@ Style information@@ -291,12 +304,13 @@ -- zero-length spans seem to break stroking in general, so filter them out! syntaxHlLayer = filter (\(Span b _m a) -> b /= a) $ getStrokes point i j - layers2 = map (map overlayStroke) $ groupBy ((==) `on` overlayLayer) $ Set.toList $ overlays fb+ layers2 = map (map overlayStroke) $ groupBy ((==) `on` overlayOwner) $ Set.toList $ overlays fb layer3 = case regex of Just re -> takeIn $ map hintStroke $ regexRegionBI re (mkRegion i j) fb Nothing -> [] result = map (map clampStroke . takeIn . dropBefore) (layer3 : layers2 ++ [syntaxHlLayer, groundLayer])- overlayStroke (Overlay _ sm em a) = Span (markPoint sm) a (markPoint em)+ overlayStroke (Overlay _owner sm em a _msg) =+ Span (markPoint sm) a (markPoint em) clampStroke (Span l x r) = Span (max i l) x (min j r) hintStroke r = Span (regionStart r) (if point `nearRegion` r then strongHintStyle else hintStyle) (regionEnd r)
src/library/Yi/Buffer/Indent.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} @@ -24,6 +25,7 @@ , indentOfCurrentPosB , indentSettingsB , indentToB+ , modifyIndentB , newlineAndIndentB , shiftIndentOfRegionB , tabB@@ -39,6 +41,7 @@ import Yi.Buffer.Misc import Yi.Buffer.Normal import Yi.Buffer.Region+import Yi.Buffer.TextUnit import Yi.Rope (YiString) import qualified Yi.Rope as R import Yi.String@@ -253,10 +256,18 @@ isClosing _ = False -- | Returns the indentation of a given string. Note that this depends---on the current indentation settings.+-- on the current indentation settings. indentOfB :: YiString -> BufferM Int indentOfB = spacingOfB . R.takeWhile isSpace +makeIndentString :: Int -> BufferM YiString+makeIndentString level = do+ IndentSettings et _ sw <- indentSettingsB+ let (q, r) = level `quotRem` sw+ if et+ then return (R.replicate level " ")+ else return (R.replicate q "\t" <> R.replicate r " ")+ -- | Returns the length of a given string taking into account the -- white space and the indentation settings. spacingOfB :: YiString -> BufferM Int@@ -273,11 +284,19 @@ of the line then we wish to remain pointing to the same character. -} indentToB :: Int -> BufferM ()-indentToB level = do- indentSettings <- indentSettingsB- r <- regionOfB Line- when (regionDirection r == Forward) $- modifyRegionB (rePadString indentSettings level) r+indentToB = modifyIndentB . const++-- | Modifies current line indent measured in visible spaces.+-- Respects indent settings. Calling this with value (+ 4)+-- will turn "\t" into "\t\t" if shiftwidth is 4 and into+-- "\t " if shiftwidth is 8+-- If current line is empty nothing happens.+modifyIndentB :: (Int -> Int) -> BufferM ()+modifyIndentB f = do+ leadingSpaces <- regionWithTwoMovesB moveToSol firstNonSpaceB+ newLeadinSpaces <-+ readRegionB leadingSpaces >>= indentOfB >>= makeIndentString . f+ modifyRegionB (const newLeadinSpaces) leadingSpaces -- | Indent as much as the previous line indentAsPreviousB :: BufferM ()
src/library/Yi/Buffer/Misc.hs view
@@ -11,6 +11,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK show-extensions #-}@@ -53,7 +54,7 @@ , lineDown , newB , MarkValue(..)- , Overlay, OvlLayer(..)+ , Overlay (overlayAnnotation) , mkOverlay , gotoLn , gotoLnFrom@@ -103,9 +104,12 @@ , movingToPrefVisCol , preferColA , markSavedB+ , retroactivelyAtSavePointB , addOverlayB , delOverlayB- , delOverlayLayerB+ , delOverlaysOfOwnerB+ , getOverlaysOfOwnerB+ , isPointInsideOverlay , savingExcursionB , savingPointB , savingPositionB@@ -195,6 +199,7 @@ import Data.Function hiding ((.), id) import qualified Data.Map as M import Data.Maybe+import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text.Encoding as E import Data.Time@@ -272,7 +277,7 @@ put binmode put strippedRaw put attributes_- get = do+ get = FBuffer <$> get <*> getStripped <*> get where getStripped :: Get (BufferImpl ()) getStripped = get@@ -385,16 +390,24 @@ pendingUpdatesA %= (++ [overlayUpdate ov]) modifyBuffer $ addOverlayBI ov +getOverlaysOfOwnerB :: R.YiString -> BufferM (Set.Set Overlay)+getOverlaysOfOwnerB owner = queryBuffer (getOverlaysOfOwnerBI owner)+ -- | Remove an existing "overlay" delOverlayB :: Overlay -> BufferM () delOverlayB ov = do pendingUpdatesA %= (++ [overlayUpdate ov]) modifyBuffer $ delOverlayBI ov -delOverlayLayerB :: OvlLayer -> BufferM ()-delOverlayLayerB l =- modifyBuffer $ delOverlayLayer l+delOverlaysOfOwnerB :: R.YiString -> BufferM ()+delOverlaysOfOwnerB owner =+ modifyBuffer $ delOverlaysOfOwnerBI owner +isPointInsideOverlay :: Point -> Overlay -> Bool+isPointInsideOverlay point overlay =+ let Overlay _ (MarkValue start _) (MarkValue finish _) _ _ = overlay+ in start <= point && point <= finish+ -- | Execute a @BufferM@ value on a given buffer and window. The new state of -- the buffer is returned alongside the result of the computation. runBuffer :: Window -> FBuffer -> BufferM a -> (a, FBuffer)@@ -486,25 +499,36 @@ -> (BufferImpl syntax, (URList, [Update]))) -> BufferM () undoRedo f = do- m <- getInsMark- ur <- use undosA- (ur', updates) <- queryAndModify (f m ur)- assign undosA ur'- tell updates+ isTransacPresent <- use updateTransactionInFlightA+ if isTransacPresent+ then error "Can't undo while undo transaction is in progress"+ else do+ m <- getInsMark+ ur <- use undosA+ (ur', updates) <- queryAndModify (f m ur)+ assign undosA ur'+ tell updates undoB :: BufferM ()-undoB = do- isTransacPresent <- use updateTransactionInFlightA- if isTransacPresent- then error "Can't undo while undo transaction is in progress"- else undoRedo undoU+undoB = undoRedo undoU redoB :: BufferM ()-redoB = do- isTransacPresent <- use updateTransactionInFlightA- if isTransacPresent- then error "Can't undo while undo transaction is in progress"- else undoRedo redoU+redoB = undoRedo redoU++-- | Undo all updates that happened since last save,+-- perform a given action and redo all updates again.+-- Given action must not modify undo history.+retroactivelyAtSavePointB :: BufferM a -> BufferM a+retroactivelyAtSavePointB action = do+ (undoDepth, result) <- go 0+ replicateM_ undoDepth redoB+ return result+ where+ go step = do+ atSavedPoint <- gets isUnchangedBuffer+ if atSavedPoint+ then (step,) <$> action+ else undoB >> go (step + 1) -- | Analogous to const, but returns a function that takes two parameters,
src/library/Yi/Buffer/Normal.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE TemplateHaskell, CPP, StandaloneDeriving #-}+{-# LANGUAGE CPP #-} -- | A normalized API to many buffer operations.
src/library/Yi/Buffer/TextUnit.hs view
@@ -92,9 +92,12 @@ -- | a word as in use in Emacs (fundamental mode) unitWord :: TextUnit-unitWord = GenUnit Document $ \direction -> checkPeekB (-1) [isWordChar, not . isWordChar] direction+unitWord =+ GenUnit Document $+ \direction -> checkPeekB (-1) [isWordChar, not . isWordChar] direction --- ^ delimited on the left and right by given characters, boolean argument tells if whether those are included.+-- | delimited on the left and right by given characters, boolean+-- argument tells if whether those are included. unitDelimited :: Char -> Char -> Bool -> TextUnit unitDelimited left right included = GenUnit Document $ \direction -> case (included,direction) of
+ src/library/Yi/Command/Help.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Yi.Command.Help+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+--+-- Help command support+-- This module uses Yi.Eval.describeNamedAction to+-- show whatever information about particular action is available+-- from current evaluator (ghciEvaluator currently presents only type.)+-- TODO: Would be nice to show excerpt from Haddock documentation in the future.+--+-- If given no arguments, the help index is shown (using @getAllNamesInScope@).+--+-- Please do not try to show descriptions for the whole index,+-- as our interface to GHCi is too slow.++module Yi.Command.Help(displayHelpFor) where++import Control.Applicative+import Data.Binary+import Data.Default+import Data.Typeable+import Yi.Buffer+import Yi.Editor+import Yi.Monad+import qualified Yi.Rope as R+import qualified Data.Text as T+import Yi.Eval (getAllNamesInScope, describeNamedAction)+import Yi.Keymap+import Yi.Types(YiVariable)++-- | Displays help for a given name, or help index, if no name is given+displayHelpFor :: T.Text -> YiM ()+displayHelpFor name = helpFor name >>= displayHelpBuffer++-- | Finds help text to display, given a command argument+helpFor :: T.Text -> YiM T.Text+helpFor "" = (T.unlines . map T.pack) <$> getAllNamesInScope+helpFor name = T.pack <$> describeNamedAction (T.unpack name) ++-- * To make help buffer unique:+-- | Dynamic YiVariable to store the help buffer reference.+newtype HelpBuffer = HelpBuffer { helpBuffer :: Maybe BufferRef }+ deriving (Default, Typeable, Binary)++instance YiVariable HelpBuffer++-- | Display help buffer with a given text...+displayHelpBuffer :: T.Text -> YiM ()+displayHelpBuffer text = withEditor $ withOtherWindow $ do+ maybeM deleteBuffer =<< helpBuffer <$> getEditorDyn+ b <- newBufferE (MemBuffer "*help*") $ R.fromText text+ putEditorDyn $ HelpBuffer $ Just b
src/library/Yi/Completion.hs view
@@ -25,6 +25,7 @@ import Data.List import Data.Maybe import Data.Monoid+import Data.Function (on) import qualified Data.Text as T import Yi.Editor (EditorM, printMsg, printMsgs) import Yi.String (commonTPrefix', showT)@@ -40,7 +41,7 @@ -> T.Text -> Bool mkIsPrefixOf True = T.isPrefixOf-mkIsPrefixOf False = \x y -> T.toCaseFold x `T.isPrefixOf` T.toCaseFold y+mkIsPrefixOf False = T.isPrefixOf `on` T.toCaseFold -- | Prefix matching function, for use with 'completeInList' prefixMatch :: T.Text -> T.Text -> Maybe T.Text
src/library/Yi/Config/Default.hs view
@@ -61,8 +61,7 @@ #ifdef FRONTEND_PANGO ("pango", Yi.UI.Pango.start) : #endif- ("batch", Yi.UI.Batch.start) :- []+ [("batch", Yi.UI.Batch.start)] -- | List of published Actions @@ -150,6 +149,7 @@ AnyMode cppMode, AnyMode Haskell.literateMode, AnyMode cabalMode,+ AnyMode clojureMode, AnyMode gnuMakeMode, AnyMode srmcMode, AnyMode ocamlMode,
src/library/Yi/Core.hs view
@@ -309,7 +309,7 @@ where msg1 = (1, (["File was changed by a concurrent process, reloaded!"], strongHintStyle)) msg2 = (1, (["Disk version changed by a concurrent process"], strongHintStyle)) msg3 x = (1, (["File changed on disk to unknown encoding, not updating buffer: " <> x], strongHintStyle))- visibleBuffers = fmap bufkey $ windows e0+ visibleBuffers = bufkey <$> windows e0 fileModTime f = posixSecondsToUTCTime . realToFrac . modificationTime <$> getFileStatus f runDummy b act = snd $ runBuffer (dummyWindow $ bkey b) b act @@ -355,7 +355,7 @@ UI.layout (yiUi yi) >>= scroll >>= -- Adjust point according to the current layout;- return . (fst . runOnWins snapInsB) >>=+ return . fst . runOnWins snapInsB >>= return . focusAllSyntax >>= -- Clear "pending updates" and "followUp" from buffers. return . (buffersA %~ fmap (clearUpdates . clearFollow))
src/library/Yi/Debug.hs view
@@ -53,7 +53,7 @@ error s = unsafePerformIO $ logPutStrLn s >> Prelude.error (T.unpack s) logPutStrLn :: MonadBase IO m => T.Text -> m ()-logPutStrLn s = liftBase $ do+logPutStrLn s = liftBase $ readIORef dbgHandle >>= \case Nothing -> return () Just h -> do
src/library/Yi/Dired.hs view
@@ -52,6 +52,7 @@ import Data.Binary import Data.Char (toLower) import Data.Default+import Data.Maybe #if __GLASGOW_HASKELL__ < 708 import Data.DeriveTH #else@@ -279,7 +280,7 @@ withCurrentBuffer $ getBufferDyn >>= putBufferDyn . (diredOpSucCnt %~ succ) getDiredOpState :: YiM DiredOpState-getDiredOpState = withCurrentBuffer $ getBufferDyn+getDiredOpState = withCurrentBuffer getBufferDyn modDiredOpState :: (DiredOpState -> DiredOpState) -> YiM () modDiredOpState f = withCurrentBuffer $ getBufferDyn >>= putBufferDyn . f@@ -387,7 +388,7 @@ proceedYes quit = cleanUp >> printMsg "Quit" help = do- printMsg $+ printMsg "y: yes, n: no, !: yes on all remaining items, q: quit, h: help" cleanUp procDiredOp counting r -- repeat@@ -562,7 +563,7 @@ insertN $ R.fromString dir <> ":\n" p <- pointB -- paint header- addOverlayB $ mkOverlay UserLayer (mkRegion 0 (p-2)) headStyle+ addOverlayB $ mkOverlay "dired" (mkRegion 0 (p-2)) headStyle "" ptsList <- mapM insertDiredLine $ zip3 strss' stys strs putBufferDyn $ diredFilePointsA .~ ptsList $ diredNameColA .~ namecol $ ds @@ -603,7 +604,7 @@ insertN $ ' ' `R.cons` last fields p2 <- pointB newlineB- addOverlayB (mkOverlay UserLayer (mkRegion p1 p2) sty)+ addOverlayB (mkOverlay "dired" (mkRegion p1 p2) sty "") return (p1, p2, R.toString filenm) data DRStrings = DRPerms {undrs :: R.YiString}@@ -702,16 +703,19 @@ -- | Needed on Mac OS X 10.4 scanForUid :: UserID -> [UserEntry] -> UserEntry-scanForUid uid entries = case find ((== uid) . userID) entries of- Nothing -> UserEntry "?" mempty uid 0 mempty mempty mempty- Just x -> x+scanForUid uid entries = fromMaybe missingEntry $+ find ((uid ==) . userID) entries+ where+ missingEntry = UserEntry "?" mempty uid 0 mempty mempty mempty -- | Needed on Mac OS X 10.4 scanForGid :: GroupID -> [GroupEntry] -> GroupEntry-scanForGid gid entries = case find ((== gid) . groupID) entries of- Nothing -> GroupEntry "?" mempty gid mempty- Just x -> x+scanForGid gid entries = fromMaybe missingEntry $+ find ((gid ==) . groupID) entries+ where+ missingEntry = GroupEntry "?" mempty gid mempty + modeString :: FileMode -> R.YiString modeString fm = "" <> strIfSet "r" ownerReadMode@@ -796,7 +800,7 @@ deleteKeys = foldl' (flip M.delete) diredMarkWithChar :: Char -> BufferM () -> BufferM ()-diredMarkWithChar c mv = bypassReadOnly $ do+diredMarkWithChar c mv = bypassReadOnly $ fileFromPoint >>= \case Just (fn, _de) -> do state <- getBufferDyn@@ -816,7 +820,7 @@ moveTo pos >> moveToSol >> insertB mark >> deleteN 1 e <- pointB addOverlayB $- mkOverlay UserLayer (mkRegion (e - 1) e) (styleOfMark mark)+ mkOverlay "dired" (mkRegion (e - 1) e) (styleOfMark mark) "" Nothing -> -- for deleted marks moveTo pos >> moveToSol >> insertN " " >> deleteN 1@@ -851,7 +855,7 @@ diredRefreshMark currentDir :: YiM FilePath-currentDir = fmap diredPath $ withCurrentBuffer $ getBufferDyn+currentDir = diredPath <$> withCurrentBuffer getBufferDyn -- | move selected files in a given directory to the target location given -- by user input@@ -871,11 +875,11 @@ -- else error askRenameFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM () askRenameFiles dir fs = case fs of- (_x:[]) -> do resetDiredOpState- procDiredOp True [DOInput prompt sOpIsDir]- (_x:_) -> do resetDiredOpState- procDiredOp True [DOInput prompt mOpIsDirAndExists]- [] -> procDiredOp True [DOFeedback showNothing]+ [_x] -> do resetDiredOpState+ procDiredOp True [DOInput prompt sOpIsDir]+ _x:_ -> do resetDiredOpState+ procDiredOp True [DOInput prompt mOpIsDirAndExists]+ [] -> procDiredOp True [DOFeedback showNothing] where mkErr t = return . DOFeedback . const $ errorEditor t prompt = "Move " <> R.fromString (show total) <> " item(s) to:"@@ -917,11 +921,11 @@ askCopyFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM () askCopyFiles dir fs = case fs of- (_x:[]) -> do resetDiredOpState- procDiredOp True [DOInput prompt sOpIsDir]- (_x:_) -> do resetDiredOpState- procDiredOp True [DOInput prompt mOpIsDirAndExists]- [] -> procDiredOp True [DOFeedback showNothing]+ [_x] -> do resetDiredOpState+ procDiredOp True [DOInput prompt sOpIsDir]+ _x:_ -> do resetDiredOpState+ procDiredOp True [DOInput prompt mOpIsDirAndExists]+ [] -> procDiredOp True [DOFeedback showNothing] where prompt = "Copy " <> R.fromString (show total) <> " item(s) to:" mOpIsDirAndExists t = [DOCheck (doesDirectoryExist t) posOps negOps]
src/library/Yi/Editor.hs view
@@ -134,10 +134,10 @@ import Yi.Window instance Binary Editor where- put (Editor bss bs supply ts dv _sl msh kr re _dir _ev _cwa ) =+ put (Editor bss bs supply ts dv _sl msh kr regex _dir _ev _cwa ) = let putNE (x :| xs) = put x >> put xs in putNE bss >> put bs >> put supply >> put ts- >> put dv >> put msh >> put kr >> put re+ >> put dv >> put msh >> put kr >> put regex get = do bss <- (:|) <$> get <*> get bs <- get@@ -146,7 +146,7 @@ dv <- get msh <- get kr <- get- re <- get+ regex <- get return $ emptyEditor { bufferStack = bss , buffers = bs , refSupply = supply@@ -154,7 +154,7 @@ , dynamic = dv , maxStatusHeight = msh , killring = kr- , currentRegex = re+ , currentRegex = regex } -- | The initial state
src/library/Yi/Eval.hs view
@@ -20,6 +20,7 @@ -- * Main (generic) evaluation interface execEditorAction, getAllNamesInScope,+ describeNamedAction, Evaluator(..), evaluator, -- ** Standard evaluators@@ -77,13 +78,21 @@ execEditorAction :: String -> YiM () execEditorAction = runHook execEditorActionImpl --- | Lists the action names in scope, for use by 'execEditorAction'.+-- | Lists the action names in scope, for use by 'execEditorAction',+-- and 'help' index. -- -- The behaviour of this function can be customised by modifying the -- 'Evaluator' variable. getAllNamesInScope :: YiM [String] getAllNamesInScope = runHook getAllNamesInScopeImpl +-- | Describes the named action in scope, for use by 'help'.+--+-- The behaviour of this function can be customised by modifying the+-- 'Evaluator' variable.+describeNamedAction :: String -> YiM String+describeNamedAction = runHook describeNamedActionImpl+ -- | Config variable for customising the behaviour of -- 'execEditorAction' and 'getAllNamesInScope'. --@@ -94,6 +103,8 @@ -- ^ implementation of 'execEditorAction' , getAllNamesInScopeImpl :: YiM [String] -- ^ implementation of 'getAllNamesInScope'+ , describeNamedActionImpl :: String -> YiM String+ -- ^ describe named action (or at least its type.), simplest implementation is at least @return@. } deriving (Typeable) -- | The evaluator to use for 'execEditorAction' and@@ -105,13 +116,20 @@ instance YiConfigVariable Evaluator -- * Evaluator based on GHCi-+-- | Cached variable for getAllNamesInScopeImpl newtype NamesCache = NamesCache [String] deriving (Typeable, Binary) instance Default NamesCache where def = NamesCache [] instance YiVariable NamesCache +-- | Cached dictioary for describeNameImpl+newtype HelpCache = HelpCache (M.HashMap String String) deriving (Typeable, Binary)++instance Default HelpCache where+ def = HelpCache M.empty+instance YiVariable HelpCache+ type HintRequest = (String, MVar (Either LHI.InterpreterError Action)) newtype HintThreadVar = HintThreadVar (Maybe (MVar HintRequest)) deriving (Typeable, Default)@@ -171,6 +189,7 @@ ghciEvaluator :: Evaluator ghciEvaluator = Evaluator { execEditorActionImpl = execAction , getAllNamesInScopeImpl = getNames+ , describeNamedActionImpl = describeName -- TODO: use haddock to add docs } where execAction :: String -> YiM ()@@ -187,7 +206,7 @@ getNames :: YiM [String] getNames = do- NamesCache cache <- withEditor $ getEditorDyn+ NamesCache cache <- getEditorDyn result <- if null cache then do res <- io $ LHI.runInterpreter $ do@@ -197,7 +216,7 @@ Left err ->[show err] Right exports -> flattenExports exports else return $ sort cache- withEditor $ putEditorDyn $ NamesCache result+ putEditorDyn $ NamesCache result return result flattenExports :: [LHI.ModuleElem] -> [String]@@ -207,6 +226,24 @@ flattenExport (LHI.Fun x) = [x] flattenExport (LHI.Class _ xs) = xs flattenExport (LHI.Data _ xs) = xs+ + describeName :: String -> YiM String+ describeName name = do+ HelpCache cache <- getEditorDyn+ description <- case name `M.lookup` cache of+ Nothing -> do+ result <- io $ LHI.runInterpreter $ do+ LHI.set [LHI.searchPath LHI.:= []]+ -- when haveUserContext $ do+ -- LHI.loadModules [contextFile]+ -- LHI.setTopLevelModules ["Env"]+ LHI.setImportsQ [("Yi", Nothing), ("Yi.Keymap",Just "Yi.Keymap")]+ LHI.typeOf name+ let newDescription = either show id result+ putEditorDyn $ HelpCache $ M.insert name newDescription cache+ return newDescription+ Just description -> return description+ return $ name ++ " :: " ++ description -- * 'PublishedActions' evaluator @@ -244,6 +281,7 @@ { getAllNamesInScopeImpl = askCfg <&> M.keys . (^. publishedActions) , execEditorActionImpl = \s -> askCfg <&> M.lookup s . (^. publishedActions) >>= mapM_ runAction+ , describeNamedActionImpl = return -- TODO: try to show types using TemplateHaskell! } -- * Miscellaneous interpreter
src/library/Yi/File.hs view
@@ -18,12 +18,12 @@ openNewFile, viWrite, viWriteTo, viSafeWriteTo,- fwriteE, -- :: YiM ()- fwriteBufferE, -- :: BufferM ()- fwriteAllE, -- :: YiM ()- fwriteToE, -- :: String -> YiM ()- backupE, -- :: FilePath -> YiM ()- revertE, -- :: YiM ()+ fwriteE,+ fwriteBufferE,+ fwriteAllY,+ fwriteToE,+ backupE,+ revertE, -- * Helper functions setFileName,@@ -35,7 +35,7 @@ import Control.Applicative import Control.Lens hiding (act, Action)-import Control.Monad (when, void)+import Control.Monad (filterM, when, void) import Control.Monad.Base import Data.Default import Data.Monoid@@ -84,7 +84,7 @@ -- | Revert to the contents of the file on disk revertE :: YiM ()-revertE = do+revertE = withCurrentBuffer (gets file) >>= \case Just fp -> do now <- io getCurrentTime@@ -102,17 +102,17 @@ -- | Try to write a file in the manner of vi/vim -- Need to catch any exception to avoid losing bindings viWrite :: YiM ()-viWrite = do+viWrite = withCurrentBuffer (gets file) >>= \case- Nothing -> errorEditor "no file name associate with buffer"- Just f -> do- bufInfo <- withCurrentBuffer bufInfoB- let s = bufInfoFileName bufInfo- succeed <- fwriteE- let message = (showT f <>) (if f == s- then " written"- else " " <> showT s <> " written")- when succeed $ printMsg message+ Nothing -> errorEditor "no file name associated with buffer"+ Just f -> do+ bufInfo <- withCurrentBuffer bufInfoB+ let s = bufInfoFileName bufInfo+ succeed <- fwriteE+ let message = (showT f <>) (if f == s+ then " written"+ else " " <> showT s <> " written")+ when succeed $ printMsg message -- | Try to write to a named file in the manner of vi/vim viWriteTo :: T.Text -> YiM ()@@ -151,7 +151,7 @@ True -> printMsg "Can't save over a directory, doing nothing." >> return False False -> do hooks <- view preSaveHooks <$> askCfg- sequence_ $ map runAction hooks+ mapM_ runAction hooks mayErr <- liftBase $ case conv of Nothing -> R.writeFileUsingText f contents >> return Nothing Just cn -> R.writeFile f contents cn@@ -169,11 +169,10 @@ fwriteBufferE b -- | Write all open buffers-fwriteAllE :: YiM Bool-fwriteAllE =- do allBuffs <- gets bufferSet- let modifiedBuffers = filter (not . isUnchangedBuffer) allBuffs- all id <$> mapM fwriteBufferE (fmap bkey modifiedBuffers)+fwriteAllY :: YiM Bool+fwriteAllY = do+ modifiedBuffers <- filterM deservesSave =<< gets bufferSet+ and <$> mapM fwriteBufferE (fmap bkey modifiedBuffers) -- | Make a backup copy of file backupE :: FilePath -> YiM ()
src/library/Yi/History.hs view
@@ -1,12 +1,9 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-}-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- |
src/library/Yi/IReader.hs view
@@ -22,6 +22,7 @@ import Control.Exception import Control.Monad+import Data.Functor ( (<$>) ) import Data.Binary import qualified Data.ByteString.Char8 as B (pack, unpack, readFile, ByteString) import qualified Data.ByteString.Lazy.Char8 as BL (fromChunks)@@ -103,7 +104,7 @@ oldDbNewArticle :: YiM (ArticleDB, Article) oldDbNewArticle = do saveddb <- withCurrentBuffer getBufferDyn- newarticle <- fmap (B.pack . R.toString) $ withCurrentBuffer elemsB+ newarticle <- B.pack . R.toString <$> withCurrentBuffer elemsB if not $ S.null (unADB saveddb) then return (saveddb, newarticle) else readDB >>= \olddb -> return (olddb, newarticle)
src/library/Yi/Keymap/Cua.hs view
@@ -127,7 +127,9 @@ (spec KUp , moveB VLine Backward), (spec KDown , moveB VLine Forward), (spec KRight , moveB Character Forward),- (spec KLeft , moveB Character Backward)+ (spec KLeft , moveB Character Backward),+ (spec KPageUp , scrollScreensB (-1)),+ (spec KPageDown , scrollScreensB 1) ]
src/library/Yi/Keymap/Emacs/Utils.hs view
@@ -53,12 +53,11 @@ import Control.Applicative import Control.Lens hiding (re,act) import Control.Monad-import Control.Monad.Base+import Control.Monad.Base() import Data.List ((\\)) import Data.Maybe (fromMaybe) import Data.Monoid import qualified Data.Text as T-import System.Directory (doesDirectoryExist) import System.FilePath (takeDirectory, takeFileName, (</>)) import System.FriendlyPath () import Yi.Buffer
src/library/Yi/Keymap/Vim/EventUtils.hs view
@@ -54,6 +54,7 @@ stringToEvent :: String -> Event stringToEvent "<" = error "Invalid event string \"<\""+stringToEvent "<C-@>" = (Event (KASCII ' ') [MCtrl]) stringToEvent s@('<':'C':'-':_) = stringToEvent' 3 s ctrl stringToEvent s@('<':'M':'-':_) = stringToEvent' 3 s meta stringToEvent s@('<':'a':'-':_) = stringToEvent' 3 s meta@@ -78,6 +79,7 @@ eventToEventString :: Event -> EventString eventToEventString e = case e of Event (KASCII '<') [] -> Ev "<lt>"+ Event (KASCII ' ') [MCtrl] -> Ev "<C-@>" Event (KASCII c) [] -> Ev $ T.singleton c Event (KASCII c) [MCtrl] -> Ev $ mkMod MCtrl c Event (KASCII c) [MMeta] -> Ev $ mkMod MMeta c
src/library/Yi/Keymap/Vim/Ex.hs view
@@ -24,14 +24,17 @@ import qualified Yi.Keymap.Vim.Ex.Commands.Edit as Edit import qualified Yi.Keymap.Vim.Ex.Commands.Global as Global import qualified Yi.Keymap.Vim.Ex.Commands.GotoLine as GotoLine+import qualified Yi.Keymap.Vim.Ex.Commands.Help as Help import qualified Yi.Keymap.Vim.Ex.Commands.Make as Make import qualified Yi.Keymap.Vim.Ex.Commands.Nohl as Nohl import qualified Yi.Keymap.Vim.Ex.Commands.Paste as Paste import qualified Yi.Keymap.Vim.Ex.Commands.Quit as Quit import qualified Yi.Keymap.Vim.Ex.Commands.Reload as Reload import qualified Yi.Keymap.Vim.Ex.Commands.Shell as Shell+import qualified Yi.Keymap.Vim.Ex.Commands.Sort as Sort import qualified Yi.Keymap.Vim.Ex.Commands.Substitute as Substitute import qualified Yi.Keymap.Vim.Ex.Commands.Tag as Tag+import qualified Yi.Keymap.Vim.Ex.Commands.Undo as Undo import qualified Yi.Keymap.Vim.Ex.Commands.Write as Write import qualified Yi.Keymap.Vim.Ex.Commands.Yi as Yi import Yi.Keymap.Vim.Ex.Eval@@ -47,14 +50,17 @@ , Edit.parse , Global.parse , GotoLine.parse+ , Help.parse , Make.parse , Nohl.parse , Paste.parse , Quit.parse , Reload.parse+ , Sort.parse , Substitute.parse , Shell.parse , Tag.parse+ , Undo.parse , Write.parse , Yi.parse ]
src/library/Yi/Keymap/Vim/Ex/Commands/Buffer.hs view
@@ -45,7 +45,7 @@ nameParser :: P.GenParser Char () ()-nameParser = do+nameParser = void $ P.try ( P.string "buffer") <|> P.try ( P.string "buf") <|> P.try ( P.string "bu") <|>
src/library/Yi/Keymap/Vim/Ex/Commands/Common.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK show-extensions #-} -- |@@ -16,8 +17,10 @@ , parseWithBang , parseWithBangAndCount , parseRange- , OptionAction(..)- , parseOption+ , BoolOptionAction(..)+ , TextOptionAction(..)+ , parseBoolOption+ , parseTextOption , filenameComplete , forAllBuffers , pureExCommand@@ -28,6 +31,7 @@ ) where import Control.Applicative+import Control.Lens (use) import Control.Monad import Data.List.NonEmpty (NonEmpty(..)) import Data.Monoid@@ -50,17 +54,16 @@ parse parser (Ev s) = either (const Nothing) Just (P.parse parser "" $ T.unpack s) - parseWithBangAndCount :: P.GenParser Char () a -- ^ The command name parser. -> (a -> Bool- -> (Maybe Int)+ -> Maybe Int -> P.GenParser Char () ExCommand) -- ^ A parser for the remaining command arguments. -> EventString -- ^ The string to parse. -> Maybe ExCommand-parseWithBangAndCount nameParser argumentParser (Ev s) = do+parseWithBangAndCount nameParser argumentParser (Ev s) = either (const Nothing) Just (P.parse parser "" $ T.unpack s) where parser = do@@ -76,7 +79,7 @@ -> EventString -- ^ The string to parse. -> Maybe ExCommand-parseWithBang nameParser argumentParser (Ev s) = do+parseWithBang nameParser argumentParser (Ev s) = either (const Nothing) Just (P.parse parser "" $ T.unpack s) where parser = do@@ -87,38 +90,129 @@ parseBang :: P.GenParser Char () Bool parseBang = P.string "!" *> return True <|> return False -parseRange :: P.GenParser Char () LineRange-parseRange = return CurrentLineRange- parseCount :: P.GenParser Char () (Maybe Int)-parseCount = do- readMaybe <$> P.many P.digit+parseCount = readMaybe <$> P.many P.digit -data OptionAction = Set !Bool | Invert | Ask+parseRange :: P.GenParser Char s (Maybe (BufferM Region))+parseRange = fmap Just parseFullRange+ <|> fmap Just parsePointRange+ <|> return Nothing -parseOption :: String -> (OptionAction -> Action) -> EventString -> Maybe ExCommand-parseOption name action = parse $ do+parseFullRange :: P.GenParser Char s (BufferM Region)+parseFullRange = P.char '%' *> return (regionOfB Document)++parsePointRange :: P.GenParser Char s (BufferM Region)+parsePointRange = do+ p1 <- parseSinglePoint+ void $ P.char ','+ p2 <- parseSinglePoint2 p1+ return $ do+ p1' <- p1+ p2' <- p2+ return $ mkRegion (min p1' p2') (max p1' p2')++parseSinglePoint :: P.GenParser Char s (BufferM Point)+parseSinglePoint = parseSingleMark <|> parseLinePoint++-- | Some of the parse rules for the second point actually depend+-- on the first point. If parse rule succeeds this can result+-- in the first BufferM Point having to be run twice but this+-- probably isn't a big deal.+parseSinglePoint2 :: BufferM Point -> P.GenParser Char s (BufferM Point)+parseSinglePoint2 ptB = parseEndOfLine ptB <|> parseSinglePoint++-- | Parse a single mark, or a selection mark (< or >)+parseSingleMark :: P.GenParser Char s (BufferM Point)+parseSingleMark = P.char '\'' *> (parseSelMark <|> parseNormMark)++-- | Parse a normal mark (non-system)+parseNormMark :: P.GenParser Char s (BufferM Point)+parseNormMark = do+ c <- P.anyChar+ return $ mayGetMarkB [c] >>= \case+ Nothing -> fail $ "Mark " <> show c <> " not set"+ Just mark -> use (markPointA mark)++-- | Parse selection marks.+parseSelMark :: P.GenParser Char s (BufferM Point)+parseSelMark = do+ c <- P.oneOf "<>" + return $ if c == '<' then getSelectionMarkPointB else pointB++-- | Parses end of line, $, only valid for 2nd point.+parseEndOfLine :: BufferM Point -> P.GenParser Char s (BufferM Point)+parseEndOfLine ptB = P.char '$' *> return (ptB >>= eolPointB)++-- | Parses a numeric line or ".+k", k relative to current+parseLinePoint :: P.GenParser Char s (BufferM Point)+parseLinePoint = parseCurrentLinePoint <|> parseNormalLinePoint++-- | Parses .+-k+parseCurrentLinePoint :: P.GenParser Char s (BufferM Point)+parseCurrentLinePoint = do+ void $ P.char '.'+ relative <- P.optionMaybe $ do+ c <- P.oneOf "+-"+ (i :: Int) <- read <$> P.many1 P.digit+ return $ if c == '+' then i else -i+ case relative of+ Nothing -> return $ pointB >>= solPointB+ Just offset -> return $ do+ ln <- curLn+ savingPointB $ gotoLn (ln + offset) >> pointB++-- | Parses a line number+parseNormalLinePoint :: P.GenParser Char s (BufferM Point)+parseNormalLinePoint = do+ ln <- read <$> P.many1 P.digit+ return . savingPointB $ gotoLn ln >> pointB++data BoolOptionAction = BoolOptionSet !Bool | BoolOptionInvert | BoolOptionAsk++parseBoolOption :: T.Text -> (BoolOptionAction -> Action) -> EventString+ -> Maybe ExCommand+parseBoolOption name action = parse $ do void $ P.string "set " nos <- P.many (P.string "no") invs <- P.many (P.string "inv")- void $ P.string name+ void $ P.string (T.unpack name) bangs <- P.many (P.string "!") qs <- P.many (P.string "?") return $ pureExCommand { cmdShow = T.concat [ "set " , T.pack $ concat nos- , T.pack name+ , name , T.pack $ concat bangs , T.pack $ concat qs ] , cmdAction = action $ case fmap (not . null) [qs, bangs, invs, nos] of- [True, _, _, _] -> Ask- [_, True, _, _] -> Invert- [_, _, True, _] -> Invert- [_, _, _, True] -> Set False- _ -> Set True+ [True, _, _, _] -> BoolOptionAsk+ [_, True, _, _] -> BoolOptionInvert+ [_, _, True, _] -> BoolOptionInvert+ [_, _, _, True] -> BoolOptionSet False+ _ -> BoolOptionSet True } +data TextOptionAction = TextOptionSet !T.Text | TextOptionAsk++parseTextOption :: T.Text -> (TextOptionAction -> Action) -> EventString+ -> Maybe ExCommand+parseTextOption name action = parse $ do+ void $ P.string "set "+ void $ P.string (T.unpack name)+ maybeNewValue <- P.optionMaybe $ do+ void $ P.many P.space+ void $ P.char '='+ void $ P.many P.space+ T.pack <$> P.many P.anyChar+ return $ pureExCommand+ { cmdShow = T.concat [ "set "+ , name+ , maybe "" (" = " <>) maybeNewValue+ ]+ , cmdAction = action $ maybe TextOptionAsk TextOptionSet maybeNewValue+ }+ removePwd :: T.Text -> YiM T.Text removePwd path = do pwd' <- T.pack <$> io getCurrentDirectory@@ -127,8 +221,8 @@ else path filenameComplete :: T.Text -> YiM [T.Text]-filenameComplete f = case f == "%" of- True -> do+filenameComplete f = if f == "%"+ then -- current buffer is minibuffer -- actual file is in the second buffer in bufferStack gets bufferStack >>= \case@@ -145,7 +239,7 @@ return <$> removePwd sanitizedFileName - False -> do+ else do files <- matchingFileNames Nothing f case files of [] -> return []@@ -199,7 +293,7 @@ -- normal, as well as allowing escaping of space (is this normal behavior?). quoteArg :: Char -> P.GenParser Char () T.Text quoteArg delim = fmap T.pack $ P.char delim - *> (P.many1 $ P.noneOf (delim:"\\") <|> escapeChar)+ *> P.many1 (P.noneOf (delim:"\\") <|> escapeChar) <* P.char delim -- | Parser for a single escape character
+ src/library/Yi/Keymap/Vim/Ex/Commands/Help.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Yi+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable+++module Yi.Keymap.Vim.Ex.Commands.Help (parse) where++import Control.Monad+import Control.Applicative+import Yi.Command.Help (displayHelpFor)+import qualified Data.Text as T+import qualified Text.ParserCombinators.Parsec as P+import Yi.Keymap+import Yi.Keymap.Vim.Common+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common+import Yi.Keymap.Vim.Ex.Types++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ void $ P.string "help"+ cmd <- P.option "" $ P.try $ do+ void $ P.many1 P.space+ T.pack <$> P.many1 P.anyChar+ return $! Common.impureExCommand {+ cmdAction = YiA $ displayHelpFor cmd+ , cmdShow = "help" `T.append`+ if cmd == ""+ then ""+ else " " `T.append` cmd+ }
src/library/Yi/Keymap/Vim/Ex/Commands/Paste.hs view
@@ -23,14 +23,14 @@ import Yi.String (showT) parse :: EventString -> Maybe ExCommand-parse = parseOption "paste" action+parse = parseBoolOption "paste" action -action :: OptionAction -> Action-action Ask = EditorA $ do+action :: BoolOptionAction -> Action+action BoolOptionAsk = EditorA $ do value <- vsPaste <$> getEditorDyn printMsg $ "paste = " <> showT value-action (Set b) = modPaste $ const b-action Invert = modPaste not+action (BoolOptionSet b) = modPaste $ const b+action BoolOptionInvert = modPaste not modPaste :: (Bool -> Bool) -> Action modPaste f = EditorA . modifyStateE $ \s -> s { vsPaste = f (vsPaste s) }
src/library/Yi/Keymap/Vim/Ex/Commands/Quit.hs view
@@ -38,7 +38,7 @@ parse :: EventString -> Maybe ExCommand parse = Common.parse $ P.choice [ do- _ <- (P.try ( P.string "xit") <|> P.string "x")+ void $ P.try ( P.string "xit") <|> P.string "x" bangs <- P.many (P.char '!') return (quit True (not $ null bangs) False) , do@@ -97,5 +97,5 @@ saveAndQuitAllE :: YiM () saveAndQuitAllE = do- succeed <- fwriteAllE- when succeed $ quitEditor+ succeed <- fwriteAllY+ when succeed quitEditor
+ src/library/Yi/Keymap/Vim/Ex/Commands/Sort.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Sort+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Sort (parse) where++import Control.Monad+import qualified Text.ParserCombinators.Parsec as P+import Yi.Buffer+import Yi.Keymap+import Yi.Keymap.Vim.Common+import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common+import Yi.Keymap.Vim.Ex.Types++parse :: EventString -> Maybe ExCommand+parse = Common.parse $ do+ region <- Common.parseRange+ void $ P.string "sort"+ return $ sort region++sort :: Maybe (BufferM Region) -> ExCommand+sort r = Common.pureExCommand {+ cmdShow = "sort"+ , cmdAction = BufferA $ sortA r+ , cmdComplete = return ["sort"]+ }++sortA :: Maybe (BufferM Region) -> BufferM ()+sortA r = do+ region <- case r of+ Nothing -> regionOfB Document+ Just r' -> r'+ sortLinesWithRegion region
src/library/Yi/Keymap/Vim/Ex/Commands/Tag.hs view
@@ -52,7 +52,7 @@ tag (Just (Tag t)) = Common.impureExCommand { cmdShow = "tag " <> t , cmdAction = YiA $ gotoTag (Tag t) 0 Nothing- , cmdComplete = (fmap . fmap) (mappend "tag ") $ completeVimTag t+ , cmdComplete = map ("tag " <>) <$> completeVimTag t } next :: ExCommand
+ src/library/Yi/Keymap/Vim/Ex/Commands/Undo.hs view
@@ -0,0 +1,32 @@+{-# LANGUAGE OverloadedStrings #-}+{-# OPTIONS_HADDOCK show-extensions #-}++-- |+-- Module : Yi.Keymap.Vim.Ex.Commands.Undo+-- License : GPL-2+-- Maintainer : yi-devel@googlegroups.com+-- Stability : experimental+-- Portability : portable++module Yi.Keymap.Vim.Ex.Commands.Undo (parse) where++import Yi.Buffer.Adjusted+import Yi.Keymap+import Yi.Keymap.Vim.Common+import Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand)+import Yi.Keymap.Vim.Ex.Types++parse :: EventString -> Maybe ExCommand+parse (Ev s) | s `elem` ["u", "undo"] = + Just pureExCommand {+ cmdAction = BufferA undoB+ , cmdShow = "undo"+ , cmdComplete = return ["undo"]+ }+parse (Ev s) | s `elem` ["redo"] =+ Just pureExCommand {+ cmdAction = BufferA redoB+ , cmdShow = "redo"+ , cmdComplete = return ["redo"]+ }+parse _ = Nothing
src/library/Yi/Keymap/Vim/InsertMap.hs view
@@ -72,12 +72,16 @@ | vsPaste s && evs `notElem` ["<Esc>", "<C-c>"] = WholeMatch . withCurrentBuffer $ do case evs of- "<lt>" -> insertB '<'- "<CR>" -> newlineB- "<Tab>" -> insertB '\t'- "<BS>" -> bdeleteB- "<C-h>" -> bdeleteB- "<Del>" -> deleteB Character Forward+ "<lt>" -> insertB '<'+ "<CR>" -> newlineB+ "<Tab>" -> insertB '\t'+ "<BS>" -> bdeleteB+ "<C-h>" -> bdeleteB+ "<Del>" -> deleteB Character Forward+ "<Home>" -> moveToSol+ "<End>" -> moveToEol+ "<PageUp>" -> scrollScreensB (-1)+ "<PageDown>" -> scrollScreensB 1 c -> insertN (R.fromText $ _unEv c) return Continue f _ _ = NoMatch@@ -148,6 +152,7 @@ printableAction evs = do saveInsertEventStringE evs currentCursor <- withCurrentBuffer pointB+ IndentSettings et ts sw <- withCurrentBuffer indentSettingsB secondaryCursors <- fmap vsSecondaryCursors getEditorDyn let allCursors = currentCursor :| secondaryCursors marks <- withCurrentBuffer $ forM' allCursors $ \cursor -> do@@ -179,21 +184,24 @@ indentAsTheMostIndentedNeighborLineB firstNonSpaceB "<Tab>" -> do- IndentSettings et _ts sw <- indentSettingsB if et then insertN' . R.fromString $ replicate sw ' ' else insertB' '\t'- "<C-t>" -> shiftIndentOfRegionB 1 =<< regionOfB Line- "<C-d>" -> shiftIndentOfRegionB (-1) =<< regionOfB Line- "<C-e>" -> insertCharWithBelowB- "<C-y>" -> insertCharWithAboveB- "<BS>" -> bdeleteB'- "<C-h>" -> bdeleteB'- "<Del>" -> deleteB' Character Forward- "<C-w>" -> deleteRegionB' =<< regionOfPartNonEmptyB unitViWordOnLine Backward- "<C-u>" -> bdeleteLineB- "<lt>" -> insertB' '<'- evs' -> error $ "Unhandled event " <> show evs' <> " in insert mode"+ "<C-t>" -> modifyIndentB (+ sw)+ "<C-d>" -> modifyIndentB (max 0 . subtract sw)+ "<C-e>" -> insertCharWithBelowB+ "<C-y>" -> insertCharWithAboveB+ "<BS>" -> bdeleteB'+ "<C-h>" -> bdeleteB'+ "<Home>" -> moveToSol+ "<End>" -> moveToEol >> leftOnEol+ "<PageUp>" -> scrollScreensB (-1)+ "<PageDown>" -> scrollScreensB 1+ "<Del>" -> deleteB' Character Forward+ "<C-w>" -> deleteRegionB' =<< regionOfPartNonEmptyB unitViWordOnLine Backward+ "<C-u>" -> bdeleteLineB+ "<lt>" -> insertB' '<'+ evs' -> error $ "Unhandled event " <> show evs' <> " in insert mode" updatedCursors <- withCurrentBuffer $ do updatedCursors <- forM' marks $ \mark -> do
src/library/Yi/Keymap/Vim/NormalMap.hs view
@@ -304,9 +304,18 @@ , ("<C-w>o", closeOtherE, resetCount) , ("<C-w>s", splitE, resetCount) , ("<C-w>w", nextWinE, resetCount)+ , ("<C-w><Down>", nextWinE, resetCount) -- TODO: please implement downWinE+ , ("<C-w><Right>", nextWinE, resetCount) -- TODO: please implement rightWinE , ("<C-w><C-w>", nextWinE, resetCount) , ("<C-w>W", prevWinE, resetCount) , ("<C-w>p", prevWinE, resetCount)+ , ("<C-w><Up>", prevWinE, resetCount) -- TODO: please implement upWinE+ , ("<C-w><Left>", prevWinE, resetCount) -- TODO: please implement leftWinE+ , ("<C-w>l", layoutManagersNextE, resetCount)+ , ("<C-w>L", layoutManagersPreviousE, resetCount)+ --, ("<C-w> ", layoutManagersNextE, resetCount)+ , ("<C-w>v", layoutManagerNextVariantE, resetCount)+ , ("<C-w>V", layoutManagerPreviousVariantE, resetCount) , ("<C-a>", getCountE >>= withCurrentBuffer . incrementNextNumberByB, resetCount) , ("<C-x>", getCountE >>= withCurrentBuffer . incrementNextNumberByB . negate, resetCount)
src/library/Yi/Keymap/Vim/Operator.hs view
@@ -23,9 +23,11 @@ , lastCharForOperator ) where +import Control.Applicative ((<$>)) import Control.Monad-import Data.Char (toLower, toUpper)+import Data.Char (toLower, toUpper, isSpace) import Data.Foldable (find)+import Data.Maybe (fromJust) import Data.Monoid import qualified Data.Text as T import Yi.Buffer.Adjusted hiding (Insert)@@ -37,6 +39,8 @@ import Yi.Keymap.Vim.TextObject import Yi.Keymap.Vim.Utils import Yi.Misc+import Yi.Rope (YiString)+import qualified Yi.Rope as R data VimOperator = VimOperator { operatorName :: !OperatorName@@ -127,23 +131,60 @@ formatRegionB :: RegionStyle -> Region -> BufferM () formatRegionB Block _reg = return () formatRegionB _style reg = do- -- TODO: handle indentation- -- TODO: break words- let (start, end) = (regionStart reg, regionEnd reg)- moveTo start- let go = do- rightB- p <- pointB- col <- curCol- char <- readB- unless (p >= end) $- if col < 80 && char == '\n'- then writeB ' ' >> go- else if col == 80 && char /= '\n'- then writeB '\n' >> go- else go- go+ start <- solPointB $ regionStart reg+ end <- eolPointB $ regionEnd reg moveTo start+ -- Don't use firstNonSpaceB since paragraphs can start with lines made+ -- completely of whitespace (which should be fixed)+ untilB_ ((not . isSpace) <$> readB) rightB+ indent <- curCol+ modifyRegionB (formatStringWithIndent indent) $ reg { regionStart = start+ , regionEnd = end+ }+ -- Emulate vim behaviour+ moveTo =<< solPointB end+ firstNonSpaceB++formatStringWithIndent :: Int -> YiString -> YiString+formatStringWithIndent indent str+ | R.null str = R.empty+ | otherwise = let spaces = R.replicateChar indent ' '+ (formattedLine, textToFormat) = getNextLine (80 - indent) str+ lineEnd = if R.null textToFormat+ then R.empty+ else '\n' `R.cons` formatStringWithIndent indent textToFormat+ in R.concat [ spaces+ , formattedLine+ , lineEnd+ ]++getNextLine :: Int -> YiString -> (YiString, YiString)+getNextLine maxLength str = let firstSplit = takeBlock (R.empty, R.dropWhile isSpace str)+ isMaxLength (l, r) = R.length l > maxLength || R.null r+ in if isMaxLength firstSplit+ then firstSplit+ else let (line, remainingText) = until isMaxLength+ takeBlock+ firstSplit+ in if R.length line <= maxLength+ then (R.dropWhileEnd isSpace line, remainingText)+ else let (beginL, endL) = breakAtLastItem line+ in if isSpace $ fromJust $ R.head endL+ then (beginL, remainingText)+ else (R.dropWhileEnd isSpace beginL, endL `R.append` remainingText)+ where+ isMatch (Just x) y = isSpace x == isSpace y+ isMatch Nothing _ = False++ -- Gets the next block of either whitespace, or non-whitespace,+ -- characters+ takeBlock (cur, rest) =+ let (word, line) = R.span (isMatch $ R.head rest) rest+ in (cur `R.append` R.map (\c -> if c == '\n' then ' ' else c) word, line)+ breakAtLastItem s =+ let y = R.takeWhileEnd (isMatch $ R.last s) s+ (x, _) = R.splitAt (R.length s - R.length y) s+ in (x, y) mkCharTransformOperator :: OperatorName -> (Char -> Char) -> VimOperator mkCharTransformOperator name f = VimOperator {
src/library/Yi/Keymap/Vim/VisualMap.hs view
@@ -60,7 +60,8 @@ exBinding :: VimBinding exBinding = VimBindingE f where f ":" (VimState { vsMode = (Visual _) }) = WholeMatch $ do- void $ spawnMinibufferE (T.pack ":'<,'>") id+ void $ spawnMinibufferE ":" id+ withCurrentBuffer $ writeN "'<,'>" switchModeE Ex return Finish f _ _ = NoMatch
src/library/Yi/MiniBuffer.hs view
@@ -73,7 +73,7 @@ mv <- io $ newIORef mempty keepGoing <- io $ newIORef True let delay = threadDelay 100000 >> readIORef keepGoing- void . forkAction delay NoNeedToRefresh $ do+ void . forkAction delay NoNeedToRefresh $ findBuffer b >>= \case Nothing -> io $ writeIORef keepGoing True Just _ -> do@@ -107,12 +107,12 @@ commentRegion :: YiM () commentRegion = withCurrentBuffer (gets $ withMode0 modeToggleCommentSelection) >>= \case- Nothing -> do+ Nothing -> withMinibufferFree "No comment syntax is defined. Use: " $ \cString -> withCurrentBuffer $ do let toggle = toggleCommentB (R.fromText cString)- _ <- toggle- modifyMode $ (\x -> x { modeToggleCommentSelection = Just toggle })+ void toggle+ modifyMode $ \x -> x { modeToggleCommentSelection = Just toggle } Just b -> withCurrentBuffer b -- | Open a minibuffer window with the given prompt and keymap@@ -214,7 +214,7 @@ windowsA %= fromJust . PL.find initialWindow showMatchings = showMatchingsOf . R.toText =<< withCurrentBuffer elemsB showMatchingsOf userInput =- printStatus =<< withDefaultStyle <$> (getHint userInput)+ printStatus =<< withDefaultStyle <$> getHint userInput withDefaultStyle msg = (msg, defaultStyle) typing = onTyping . R.toText =<< withCurrentBuffer elemsB @@ -276,9 +276,7 @@ -- may have for example two possibilities which share a long -- prefix and hence we wish to press tab to complete up to the -- point at which they differ.- completer s = return $ case commonTPrefix $ catMaybes $ fmap (infixMatch s) possibilities of- Nothing -> s- Just p -> p+ completer s = return $ fromMaybe s $ commonTPrefix $ catMaybes (infixMatch s <$> possibilities) -- | TODO: decide whether we should be keeping 'T.Text' here or moving -- to 'YiString'.
src/library/Yi/Mode/Haskell.hs view
@@ -180,14 +180,19 @@ insideGroup (Special c) = T.any (== c) "',;})]" insideGroup _ = True -cleverAutoIndentHaskellB :: Paren.Tree TT -> IndentBehaviour -> BufferM ()-cleverAutoIndentHaskellB e behaviour = do- indentSettings <- indentSettingsB- let indentLevel = shiftWidth indentSettings+-- | Helper method for taking information needed for both Haskell auto-indenters:+indentInfoB :: BufferM (Int, Int, Int, Point, Point)+indentInfoB = do+ indentLevel <- shiftWidth <$> indentSettingsB previousIndent <- indentOfB =<< getNextNonBlankLineB Backward nextIndent <- indentOfB =<< getNextNonBlankLineB Forward- solPnt <- pointAt moveToSol- eolPnt <- pointAt moveToEol+ solPnt <- pointAt moveToSol+ eolPnt <- pointAt moveToEol+ return (indentLevel, previousIndent, nextIndent, solPnt, eolPnt)++cleverAutoIndentHaskellB :: Paren.Tree TT -> IndentBehaviour -> BufferM ()+cleverAutoIndentHaskellB e behaviour = do+ (indentLevel, previousIndent, nextIndent, solPnt, eolPnt) <- indentInfoB let onThisLine ofs = ofs >= solPnt && ofs <= eolPnt firstTokNotOnLine = listToMaybe . filter (not . onThisLine . posnOfs . tokPosn) .@@ -232,12 +237,7 @@ cleverAutoIndentHaskellC :: Exp TT -> IndentBehaviour -> BufferM () cleverAutoIndentHaskellC e behaviour = do- indentSettings <- indentSettingsB- let indentLevel = shiftWidth indentSettings- previousIndent <- indentOfB =<< getNextNonBlankLineB Backward- nextIndent <- indentOfB =<< getNextNonBlankLineB Forward- solPnt <- pointAt moveToSol- eolPnt <- pointAt moveToEol+ (indentLevel, previousIndent, nextIndent, solPnt, eolPnt) <- indentInfoB let onThisLine ofs = ofs >= solPnt && ofs <= eolPnt firstTokNotOnLine = listToMaybe . filter (not . onThisLine . posnOfs . tokPosn) .@@ -422,7 +422,7 @@ -- | Load current buffer in GHCi ghciLoadBuffer :: YiM () ghciLoadBuffer = do- void $ fwriteE+ void fwriteE f <- withCurrentBuffer (gets file) case f of Nothing -> error "Couldn't get buffer filename in ghciLoadBuffer"@@ -460,12 +460,12 @@ g <- getEditorDyn let nm = g ^. GHCi.ghciProcessName args = g ^. GHCi.ghciProcessArgs- prompt = T.unwords $ [ "List of args to call "- , T.pack nm- , "with, currently"- , T.pack $ show args- , ":"- ]+ prompt = T.unwords [ "List of args to call "+ , T.pack nm+ , "with, currently"+ , T.pack $ show args+ , ":"+ ] withMinibufferFree prompt $ \arg -> case readMaybe $ T.unpack arg of Nothing -> printMsg "Could not parse as [String], keep old args."
src/library/Yi/Mode/JavaScript.hs view
@@ -112,7 +112,7 @@ -- | The "compiler." jsCompile :: Tree TT -> YiM () jsCompile tree = do- fwriteE+ _ <- fwriteE Just filename <- withCurrentBuffer $ gets file buf <- getJSBuffer withOtherWindow $ withEditor $ switchToBufferE buf
src/library/Yi/Modes.hs view
@@ -12,7 +12,7 @@ -- Definitions for the bulk of modes shipped with Yi. module Yi.Modes (TokenBasedMode, fundamentalMode,- cMode, objectiveCMode, cppMode, cabalMode,+ cMode, objectiveCMode, cppMode, cabalMode, clojureMode, srmcMode, ocamlMode, ottMode, gnuMakeMode, perlMode, pythonMode, javaMode, jsonMode, anyExtension, extensionOrContentsMatch, linearSyntaxMode,@@ -34,6 +34,7 @@ import Yi.Lexer.Alex import qualified Yi.Lexer.C as C import qualified Yi.Lexer.Cabal as Cabal+import qualified Yi.Lexer.Clojure as Clojure import qualified Yi.Lexer.Cplusplus as Cplusplus import qualified Yi.Lexer.GNUMake as GNUMake import qualified Yi.Lexer.GitCommit as GitCommit@@ -130,6 +131,10 @@ & modeAppliesA .~ anyExtension [ "cabal" ] & modeToggleCommentSelectionA .~ Just (toggleCommentB "--") +clojureMode :: StyleBasedMode+clojureMode = styleMode Clojure.lexer+ & modeNameA .~ "clojure"+ & modeAppliesA .~ anyExtension [ "clj", "edn" ] srmcMode :: StyleBasedMode srmcMode = styleMode Srmc.lexer
src/library/Yi/PersistentState.hs view
@@ -103,7 +103,7 @@ savePersistentState = do MaxHistoryEntries histLimit <- withEditor askConfigVariableA pStateFilename <- getPersistentStateFilename- (hist :: Histories) <- withEditor $ getEditorDyn+ (hist :: Histories) <- withEditor getEditorDyn kr <- withEditor $ use killringA curRe <- withEditor getRegexE let pState = PersistentState {
src/library/Yi/Syntax/Latex.hs view
@@ -140,7 +140,7 @@ End _ -> keywordStyle NewCommand -> keywordStyle -isSpecial :: [Char] -> Token -> Bool+isSpecial :: String -> Token -> Bool isSpecial cs (Special c) = c `elem` cs isSpecial _ _ = False
src/library/Yi/Syntax/Tree.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE CPP #-}-{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE ScopedTypeVariables #-} -- the CPP seems to confuse GHC; we have uniplate patterns
src/library/Yi/Types.hs view
@@ -5,12 +5,11 @@ {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE MultiParamTypeClasses #-} {-# OPTIONS_HADDOCK show-extensions #-} -- |@@ -207,30 +206,35 @@ put (MarkSet f i s) = B.put f >> B.put i >> B.put s get = liftM3 MarkSet B.get B.get B.get -data Attributes = Attributes- { ident :: !BufferId- , bkey__ :: !BufferRef -- ^ immutable unique key- , undos :: !URList -- ^ undo/redo list- , bufferDynamic :: !DynamicState.DynamicState -- ^ dynamic components- , preferCol :: !(Maybe Int) -- ^ prefered column to arrive at when we do a lineDown / lineUp- , preferVisCol :: !(Maybe Int) -- ^ prefered column to arrive at visually (ie, respecting wrap)- , pendingUpdates :: ![UIUpdate] -- ^ updates that haven't been synched in the UI yet- , selectionStyle :: !SelectionStyle- , keymapProcess :: !KeymapProcess- , winMarks :: !(M.Map WindowRef WinMarks)- , lastActiveWindow :: !Window- , lastSyncTime :: !UTCTime -- ^ time of the last synchronization with disk- , readOnly :: !Bool -- ^ read-only flag- , inserting :: !Bool -- ^ the keymap is ready for insertion into this buffer- , directoryContent :: !Bool -- ^ does buffer contain directory contents- , pointFollowsWindow :: !(WindowRef -> Bool)- , updateTransactionInFlight :: !Bool- , updateTransactionAccum :: ![Update]- , fontsizeVariation :: !Int- , encodingConverterName :: Maybe R.ConverterName- -- ^ How many points (frontend-specific) to change- -- the font by in this buffer- } deriving Typeable+data Attributes+ = Attributes+ { ident :: !BufferId+ , bkey__ :: !BufferRef -- ^ immutable unique key+ , undos :: !URList -- ^ undo/redo list+ , bufferDynamic :: !DynamicState.DynamicState -- ^ dynamic components+ , preferCol :: !(Maybe Int)+ -- ^ prefered column to arrive at when we do a lineDown / lineUp+ , preferVisCol :: !(Maybe Int)+ -- ^ prefered column to arrive at visually (ie, respecting wrap)+ , pendingUpdates :: ![UIUpdate]+ -- ^ updates that haven't been synched in the UI yet+ , selectionStyle :: !SelectionStyle+ , keymapProcess :: !KeymapProcess+ , winMarks :: !(M.Map WindowRef WinMarks)+ , lastActiveWindow :: !Window+ , lastSyncTime :: !UTCTime+ -- ^ time of the last synchronization with disk+ , readOnly :: !Bool -- ^ read-only flag+ , inserting :: !Bool -- ^ the keymap is ready for insertion into this buffer+ , directoryContent :: !Bool -- ^ does buffer contain directory contents+ , pointFollowsWindow :: !(WindowRef -> Bool)+ , updateTransactionInFlight :: !Bool+ , updateTransactionAccum :: ![Update]+ , fontsizeVariation :: !Int+ , encodingConverterName :: Maybe R.ConverterName+ -- ^ How many points (frontend-specific) to change+ -- the font by in this buffer+ } deriving Typeable instance Binary Yi.Types.Attributes where@@ -250,7 +254,7 @@ data BufferId = MemBuffer T.Text | FileBuffer FilePath- deriving (Show, Eq)+ deriving (Show, Eq, Ord) instance Binary BufferId where get = B.get >>= \case
src/library/Yi/UI/Pango.hs view
@@ -646,9 +646,9 @@ Nothing -> return font Just defSize -> fontDescriptionGetSize font >>= \case Nothing -> fontDescriptionSetSize font defSize >> return font- Just currentSize -> let fsv = fontsizeVariation $ attributes b- newSize = max 1 (fromIntegral fsv + defSize) in do- if (newSize == currentSize)+ Just currentSize -> let fsv = fontsizeVariation $ attributes b+ newSize = max 1 (fromIntegral fsv + defSize) in+ if newSize == currentSize then return font else do -- This seems like it would be very expensive but I'm@@ -741,9 +741,9 @@ -- happens, only the line-wrapping case doesn't suck. Fortunately it -- is the default. takeContent :: UIConfig -> Int -> R.YiString -> R.YiString-takeContent cf cl t = case configLineWrap cf of- True -> R.take cl t- False -> t+takeContent cf cl t = if configLineWrap cf+ then R.take cl t+ else t -- | Wraps the layout according to the given 'LayoutWrapMode', using -- the specified width.
src/library/Yi/UI/Pango/Control.hs view
@@ -95,7 +95,6 @@ import Yi.String (showT) import System.FilePath import qualified Yi.UI.Common as Common-import qualified Yi.Rope as R data Control = Control { controlYi :: Yi@@ -799,7 +798,7 @@ -- Relies on uiActionCh being synchronous selection <- liftBase $ newIORef "" let yiAction = do- txt <- (withCurrentBuffer (readRegionB =<< getSelectRegionB))+ txt <- withCurrentBuffer (readRegionB =<< getSelectRegionB) :: YiM R.YiString liftBase $ writeIORef selection txt runAction $ makeAction yiAction@@ -826,17 +825,17 @@ gtkToYiEvent (Gdk.Events.Key {Gdk.Events.eventKeyName = key , Gdk.Events.eventModifier = evModifier , Gdk.Events.eventKeyChar = char})- = fmap (\k -> Event k $ (nub $ (if isShift- then filter (/= MShift)- else id) $ concatMap modif evModifier)) key'+ = (\k -> Event k $ nub $ notMShift $ concatMap modif evModifier) <$> key' where (key',isShift) = case char of- Just c -> (Just $ KASCII c, True)+ Just c -> (Just $ KASCII c, True) Nothing -> (Map.lookup key keyTable, False) modif Gdk.Events.Control = [MCtrl]- modif Gdk.Events.Alt = [MMeta]- modif Gdk.Events.Shift = [MShift]+ modif Gdk.Events.Alt = [MMeta]+ modif Gdk.Events.Shift = [MShift] modif _ = []+ notMShift | isShift = filter (/= MShift)+ | otherwise = id gtkToYiEvent _ = Nothing -- | Map GTK long names to Keys
src/library/Yi/UI/SimpleLayout.hs view
@@ -57,7 +57,7 @@ layout :: Int -> Int -> Editor -> (Editor, Layout) layout colCount rowCount e =- ( ((windowsA .~ newWindows) e)+ ( (windowsA .~ newWindows) e , Layout (Rect 0 0 colCount 1) winRects cmdRect ) where@@ -135,15 +135,15 @@ let go _ !y _ _ | y >= h = Nothing go !x !y 0 _ = Just (Point2D x y) go !x !y !n (c : d : t) =- case (c, d, (compare x wOffset)) of+ case (c, d, compare x wOffset) of ('\t', _ , _) -> go (x + ts) y (n - 1) (d:t) ('\n', _ , _) -> go 0 (y + 1) (n - 1) (d:t) ( _ ,'\n',EQ) -> go x y (n - 1) (d:t) ( _ , _ ,EQ) -> go (x - wOffset) (y + 1) (n - 1) (d:t) ( _ , _ , _) -> go (x + 1) y (n - 1) (d:t) where wOffset = w - 1- go !x !y !n (c : []) =- case (c, (compare x wOffset)) of+ go !x !y !n [c] =+ case (c, compare x wOffset) of ('\n', _) -> go 0 (y + 1) (n - 1) [c] ( _ , _) -> go (x + 1) y (n - 1) [c] where wOffset = w - 1
src/library/Yi/UI/Utils.hs view
@@ -112,4 +112,4 @@ totalWidths = scanl (\x y -> 1 + x + y) 0 columnsWidth shownItems = scanl (+) 0 (fmap length columns) fittedItems = snd $ last $ takeWhile ((<= maxWidth) . fst) $ zip totalWidths shownItems- theLines = fmap (T.pack . unwords . zipWith padLeft columnsWidth) $ transpose columns+ theLines = T.pack . unwords . zipWith padLeft columnsWidth <$> transpose columns
src/library/Yi/UI/Vty.hs view
@@ -285,7 +285,7 @@ -- the number of lines that taking wrapping into account, -- we use this to calculate the number of lines displayed.- wrapped = concatMap (wrapLine w) $ map addSpace $ map (concatMap expandGraphic) $ take h $ lines' bufData+ wrapped = concatMap (wrapLine w . addSpace . concatMap expandGraphic) $ take h $ lines' bufData lns0 = take h wrapped -- fill lines with blanks, so the selection looks ok.@@ -302,7 +302,7 @@ addSpace :: [(Char, Vty.Attr)] -> [(Char, Vty.Attr)] addSpace [] = [(' ', wsty)]- addSpace l = case (mod lineLength w) of+ addSpace l = case mod lineLength w of 0 -> l _ -> l ++ [(' ', wsty)] where
+ src/tests/vimtests/insertion/C-d_3.test view
@@ -0,0 +1,8 @@+-- Input+(1,6)+ foo+-- Output+(1,2)+foo+-- Events+i<C-d>
+ src/tests/vimtests/insertion/C-d_4.test view
@@ -0,0 +1,8 @@+-- Input+(1,2)+foo+-- Output+(1,6)+ foo+-- Events+i<C-t>
+ src/tests/vimtests/insertion/C-d_5.test view
@@ -0,0 +1,12 @@+-- Input+(2,1)+foo++bar+-- Output+(2,5)+foo+ +bar+-- Events+i<C-t>
+ src/tests/vimtests/insertion/C-d_6.test view
@@ -0,0 +1,12 @@+-- Input+(2,1)+foo++bar+-- Output+(2,1)+foo++bar+-- Events+i<C-d>
+ src/tests/vimtests/sort/1.test view
@@ -0,0 +1,26 @@+-- Input+(1,1)+1+2+3+5+4+6+7+8+9++-- Output+(10,1)+1+2+3+4+5+6+7+8+9++-- Events+:sort<CR>
+ src/tests/vimtests/sort/2.test view
@@ -0,0 +1,26 @@+-- Input+(1,1)+1+2+3+5+4+6+7+8+9++-- Output+(3,1)+1+2+3+5+4+6+7+8+9++-- Events+:1,2sort<CR>
+ src/tests/vimtests/sort/3.test view
@@ -0,0 +1,26 @@+-- Input+(1,1)+1+2+3+5+4+6+7+8+9++-- Output+(1,1)+1+2+3+4+5+6+7+8+9++-- Events+:4,5sort<CR>
+ src/tests/vimtests/sort/4.test view
@@ -0,0 +1,26 @@+-- Input+(1,1)+1+2+3+5+4+6+7+8+9++-- Output+(10,1)+1+2+3+4+5+6+7+8+9++-- Events+:1,9sort<CR>
+ src/tests/vimtests/sort/5.test view
@@ -0,0 +1,24 @@+-- Input+(1,1)+1+2+3+5+4+6+7+8+9+-- Output+(9,2)+1+2+3+4+5+6+7+8+9+-- Events+:sort<CR>
yi.cabal view
@@ -1,5 +1,5 @@ name: yi-version: 0.11.1+version: 0.11.2 category: Development, Editor synopsis: The Haskell-Scriptable Editor description:@@ -20,59 +20,60 @@ example-configs/*.hs extra-source-files:- src/tests/vimtests/find/*.test- src/tests/vimtests/repeat/*.test- src/tests/vimtests/ex/*.test- src/tests/vimtests/ex/s/*.test- src/tests/vimtests/ex/d/*.test- src/tests/vimtests/ex/gotoline/*.test- src/tests/vimtests/ex/g/*.test- src/tests/vimtests/jumplist/*.test src/tests/vimtests/README.rst- src/tests/vimtests/undo/*.test- src/tests/vimtests/searchword/*.test src/tests/vimtests/blockvisual/*.test- src/tests/vimtests/delete/*.test- src/tests/vimtests/paste/*.test- src/tests/vimtests/insertion/*.test- src/tests/vimtests/insertion/cursorkeys/*.test- src/tests/vimtests/search/*.test- src/tests/vimtests/visual/*.test- src/tests/vimtests/indent/*.test- src/tests/vimtests/unicode/*.test- src/tests/vimtests/joinlines/*.test- src/tests/vimtests/replace/*.test src/tests/vimtests/change/*.test+ src/tests/vimtests/delete/*.test src/tests/vimtests/digraphs/*.test- src/tests/vimtests/unsorted/*.test- src/tests/vimtests/marks/*.test- src/tests/vimtests/numbers/*.test- src/tests/vimtests/yank/*.test- src/tests/vimtests/switchcase/*.test src/tests/vimtests/empty/*.test+ src/tests/vimtests/empty/emptytest/events src/tests/vimtests/empty/emptytest/input src/tests/vimtests/empty/emptytest/output- src/tests/vimtests/empty/emptytest/events+ src/tests/vimtests/ex/*.test+ src/tests/vimtests/ex/d/*.test+ src/tests/vimtests/ex/g/*.test+ src/tests/vimtests/ex/gotoline/*.test+ src/tests/vimtests/ex/s/*.test+ src/tests/vimtests/find/*.test+ src/tests/vimtests/indent/*.test+ src/tests/vimtests/insertion/*.test+ src/tests/vimtests/insertion/cursorkeys/*.test+ src/tests/vimtests/joinlines/*.test+ src/tests/vimtests/jumplist/*.test src/tests/vimtests/macros/*.test+ src/tests/vimtests/marks/*.test src/tests/vimtests/movement/*.test- src/tests/vimtests/movement/word/*.test src/tests/vimtests/movement/bigWord/*.test src/tests/vimtests/movement/char/*.test- src/tests/vimtests/movement/char/l_at_eol/input- src/tests/vimtests/movement/char/l_at_eol/output- src/tests/vimtests/movement/char/l_at_eol/events- src/tests/vimtests/movement/char/j/input- src/tests/vimtests/movement/char/j/output- src/tests/vimtests/movement/char/j/events+ src/tests/vimtests/movement/char/h_at_bol/events src/tests/vimtests/movement/char/h_at_bol/input src/tests/vimtests/movement/char/h_at_bol/output- src/tests/vimtests/movement/char/h_at_bol/events+ src/tests/vimtests/movement/char/hl/events src/tests/vimtests/movement/char/hl/input src/tests/vimtests/movement/char/hl/output- src/tests/vimtests/movement/char/hl/events+ src/tests/vimtests/movement/char/j/events+ src/tests/vimtests/movement/char/j/input+ src/tests/vimtests/movement/char/j/output+ src/tests/vimtests/movement/char/l_at_eol/events+ src/tests/vimtests/movement/char/l_at_eol/input+ src/tests/vimtests/movement/char/l_at_eol/output src/tests/vimtests/movement/cursorkeys/*.test src/tests/vimtests/movement/file/*.test src/tests/vimtests/movement/intraline/*.test+ src/tests/vimtests/movement/word/*.test+ src/tests/vimtests/numbers/*.test+ src/tests/vimtests/paste/*.test+ src/tests/vimtests/repeat/*.test+ src/tests/vimtests/replace/*.test+ src/tests/vimtests/search/*.test+ src/tests/vimtests/searchword/*.test+ src/tests/vimtests/sort/*.test+ src/tests/vimtests/switchcase/*.test+ src/tests/vimtests/undo/*.test+ src/tests/vimtests/unicode/*.test+ src/tests/vimtests/unsorted/*.test+ src/tests/vimtests/visual/*.test+ src/tests/vimtests/yank/*.test source-repository head type: git@@ -126,6 +127,7 @@ Yi.Buffer.TextUnit Yi.Buffer.Undo Yi.Command+ Yi.Command.Help Yi.Completion Yi.Config Yi.Config.Default@@ -169,14 +171,17 @@ Yi.Keymap.Vim.Ex.Commands.Edit Yi.Keymap.Vim.Ex.Commands.Global Yi.Keymap.Vim.Ex.Commands.GotoLine+ Yi.Keymap.Vim.Ex.Commands.Help Yi.Keymap.Vim.Ex.Commands.Make Yi.Keymap.Vim.Ex.Commands.Nohl Yi.Keymap.Vim.Ex.Commands.Paste Yi.Keymap.Vim.Ex.Commands.Quit Yi.Keymap.Vim.Ex.Commands.Reload Yi.Keymap.Vim.Ex.Commands.Shell+ Yi.Keymap.Vim.Ex.Commands.Sort Yi.Keymap.Vim.Ex.Commands.Substitute Yi.Keymap.Vim.Ex.Commands.Tag+ Yi.Keymap.Vim.Ex.Commands.Undo Yi.Keymap.Vim.Ex.Commands.Write Yi.Keymap.Vim.Ex.Commands.Yi Yi.Keymap.Vim.Ex.Types@@ -277,7 +282,7 @@ split >= 0.1 && < 0.3, template-haskell >= 2.4, text >= 1.1.1.3,- time >= 1.1 && < 1.5,+ time >= 1.1, utf8-string >= 0.3.1, unix-compat >=0.1 && <0.5, unordered-containers >= 0.1.3 && < 0.3,@@ -285,12 +290,12 @@ transformers-base, semigroups, word-trie >= 0.2.0.4,- yi-language >= 0.1.0.7,+ yi-language >= 0.1.1.0, oo-prototypes, yi-rope >= 0.7.0.0 && < 0.8, exceptions - ghc-options: -Wall -fno-warn-orphans+ ghc-options: -Wall -fno-warn-orphans -ferror-spans ghc-prof-options: -prof -auto-all -rtsopts if flag(profiling)@@ -392,6 +397,6 @@ filepath, directory, text,- yi-language >= 0.1.0.7,+ yi-language >= 0.1.1.0, yi-rope, yi