Wed Dec 3 19:55:20 EST 2008 [EMAIL PROTECTED] * Yi.IReader: more comments
Wed Dec 3 19:56:04 EST 2008 [EMAIL PROTECTED] * various -Wall cleanups --~--~---------~--~----~------------~-------~--~----~ Yi development mailing list [email protected] http://groups.google.com/group/yi-devel -~----------~----~----~----~------~----~------~--~---
-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA512 New patches: [Yi.IReader: more comments [EMAIL PROTECTED] Ignore-this: c413390c7fd7ae85f76734fa3c5a8b54 ] hunk ./Yi/IReader.hs 1 +-- | This module defines a list type and operations on it; it further +-- provides functions which write in and out the list. +-- The goal is to make it easy for the user to store a large number of text buffers +-- and cycle among them, making edits as she goes. The idea is inspired by +-- \"incremental reading\", see <http://en.wikipedia.org/wiki/Incremental_reading>. module Yi.IReader where import Control.Monad.State hunk ./Yi/IReader.hs 20 import Yi.Buffer.HighLevel import qualified System.IO as IO - - type Article = String type ArticleDB = [String] hunk ./Yi/IReader.hs 24 -- | Get the first article in the list. We use the list to express relative priority; - --- the first is the most, the last least. We then just cycle through - everybody gets equal time. +-- the first is the most, the last least. We then just cycle through - every article gets equal time. getLatestArticle :: ArticleDB -> Article getLatestArticle [] = "" getLatestArticle adb = head adb hunk ./Yi/IReader.hs 43 deleteArticle :: ArticleDB -> Article -> ArticleDB deleteArticle = flip delete +-- | Serialize given 'ArticleDB' out. writeDB :: ArticleDB -> YiM () writeDB adb = io $ join $ liftM (flip writeFile $ show adb) $ dbLocation hunk ./Yi/IReader.hs 47 +-- | Read in database from 'dbLocation' and then parse it into an 'ArticleDB'. readDB :: YiM ArticleDB readDB = io $ rddb `catch` (\_ -> return (return [])) where rddb = do db <- liftM readfile $ dbLocation hunk ./Yi/IReader.hs 58 hGetContents :: IO.Handle -> IO.IO String hGetContents h = IO.hGetContents h >>= \s -> length s `seq` return s +-- | The canonical location. We assume \~\/.yi has been set up already. dbLocation :: IO FilePath dbLocation = getHomeDirectory >>= \home -> return (home ++ "/.yi/articles.db") hunk ./Yi/IReader.hs 79 -- to bottom? -- | Go to next one. This ignores the buffer, but it doesn't remove anything from the database. - --- The ordering does change, however. +-- However, the ordering does change. nextArticle :: YiM () nextArticle = do (oldb,_) <- oldDbNewArticle -- Ignore buffer, just set the first article last [various -Wall cleanups [EMAIL PROTECTED] Ignore-this: e6f1e3e96277f4cb67480376fc0476a8 ] hunk ./Data/ByteRope.hs 16 -- * Conversions from ByteRope toString, toReverseString, toLazyByteString, toReverseLazyByteString, - - toByteString, + toByteString, -- rebalance, -- should not be needed. -- List-like functions hunk ./Data/ByteRope.hs 20 - - null, empty, take, drop, append, splitAt, count, length, + null, empty, take, drop, append, splitAt, count, length, head, tail, -- * searching elemIndices, findSubstring, findSubstrings, elemIndexEnd, elemIndicesEnd hunk ./Data/ByteRope.hs 97 toTree b = let (h,t) = L.splitAt chunkSize b in B.pack h <| toTree t -- | Optimize the tree, to contain equally sized substrings - -rebalance :: ByteRope -> ByteRope - -rebalance = fromLazyByteString . toLazyByteString +-- rebalance :: ByteRope -> ByteRope +-- rebalance = fromLazyByteString . toLazyByteString null :: ByteRope -> Bool null (ByteRope a) = T.null a hunk ./Yi/Buffer/Implementation.hs 52 where import Yi.Prelude - -import Prelude (take, takeWhile, dropWhile, map, length, reverse) - -import Yi.Syntax +import Prelude (take, takeWhile, dropWhile, map, reverse) +import Yi.Syntax import qualified Data.Map as M import Data.Binary hunk ./Yi/Buffer/Implementation.hs 57 - -import Data.Maybe +import Data.Maybe import Data.Monoid import Yi.Style hunk ./Yi/Buffer/Implementation.hs 68 import qualified Data.ByteRope as F import Data.ByteRope (ByteRope) import qualified Data.ByteString.Lazy as LazyB - -import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.ByteString.Lazy.UTF8 as LazyUTF8 import qualified Codec.Binary.UTF8.Generic as UF8Codec import Yi.Buffer.Basic hunk ./Yi/Buffer/Implementation.hs 99 Overlay a b c _ == Overlay a' b' c' _ = a == a' && b == b' && c == c' instance Ord Overlay where - - compare (Overlay a b c _) (Overlay a' b' c' _) + compare (Overlay a b c _) (Overlay a' b' c' _) = compare a a' `mappend` compare b b' `mappend` compare c c' hunk ./Yi/Buffer/Implementation.hs 109 , 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 + , dirtyOffset :: !Point -- ^ Lowest modified offset since last recomputation of syntax } deriving Typeable hunk ./Yi/Buffer/Implementation.hs 118 instance Binary (BufferImpl ()) where put b = put (mem b) >> put (marks b) >> put (markNames b) get = pure FBufferData <*> get <*> get <*> get <*> pure dummyHlState <*> pure Set.empty <*> pure 0 - - - - + + -- | Mutation actions (also used the undo or redo list) -- hunk ./Yi/Buffer/Implementation.hs 129 -- Note that the update direction is only a hint for moving the cursor -- (mainly for undo purposes); the insertions and deletions are always -- applied Forward. - -data Update = Insert {updatePoint :: !Point, updateDirection :: !Direction, insertUpdateString :: !LazyB.ByteString} +data Update = Insert {updatePoint :: !Point, updateDirection :: !Direction, insertUpdateString :: !LazyB.ByteString} | Delete {updatePoint :: !Point, updateDirection :: !Direction, deleteUpdateString :: !LazyB.ByteString} -- Note that keeping the text does not cost much: we keep the updates in the undo list; -- if it's a "Delete" it means we have just inserted the text in the buffer, so the update shares hunk ./Yi/Buffer/Implementation.hs 271 groundLayer = [(i,mempty,j)] syntaxHlLayer = hlGetStrokes hl point i j $ hlGetTree hl cache layers2 = map (map overlayStroke) $ groupBy ((==) `on` overlayLayer) $ Set.toList $ overlays fb - - layer3 = case regex of + 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]) hunk ./Yi/Buffer/Implementation.hs 283 -- Point based editing findNextChar :: Int -> Point -> BufferImpl syntax -> Point - -findNextChar m p fb +findNextChar m p fb | m < 0 = case drop (0 - 1 - m) (getIndexedStream Backward p fb) of [] -> 0 (i,_):_ -> i hunk ./Yi/Buffer/Implementation.hs 301 -- | Apply a /valid/ update applyUpdateI :: Update -> BufferImpl syntax -> BufferImpl syntax - -applyUpdateI u fb = touchSyntax (updatePoint u) $ +applyUpdateI u fb = touchSyntax (updatePoint u) $ fb {mem = p', marks = M.map shift (marks fb), overlays = Set.map (mapOvlMarks shift) (overlays fb)} -- FIXME: this is inefficient; find a way to use mapMonotonic hunk ./Yi/Buffer/Implementation.hs 313 shift = shiftMarkValue (updatePoint u) amount p = mem fb -- FIXME: remove collapsed overlays - - + -- | Reverse the given update reverseUpdateI :: Update -> Update reverseUpdateI (Delete p dir cs) = Insert p (reverseDir dir) cs hunk ./Yi/Buffer/Implementation.hs 373 -- consisting of the point of the start of the line to which we move -- and the number of lines we have actually moved. -- Note: that this doesn't work if the number of lines to move down - - -- is zero. + -- is zero. findDownLine :: Int -> Int -> [ Int ] -> (Int, Int) -- try to go forward, but there is no such line -- this cannot happen on a recursive call so it can only happen if hunk ./Yi/Buffer/Implementation.hs 378 -- we started on the last line, so we return the current point. - - findDownLine acc _ [] = (acc, point) + findDownLine acc _ [] = (acc, point) findDownLine acc _ [x] = (acc, x) findDownLine acc 1 (x:_) = (acc, x) findDownLine acc l (_:xs) = findDownLine (acc + 1) (l - 1) xs hunk ./Yi/Buffer/Implementation.hs 391 -- | Return indices of all strings in buffer matching regex, inside the given region. regexRegionBI :: SearchExp -> Region -> forall syntax. BufferImpl syntax -> [Region] - -regexRegionBI (_,re) r fb = mayReverse (regionDirection r) $ +regexRegionBI (_,re) r fb = mayReverse (regionDirection r) $ fmap (fmapRegion addPoint . matchedRegion) $ matchAll re $ F.toLazyByteString $ F.take s $ F.drop p $ mem fb -- FIXME: lazy backward search is very inefficient with large regions. where matchedRegion arr = let (off,len) = arr!0 in mkRegion (Point off) (Point (off+len)) hunk ./Yi/Buffer/Implementation.hs 422 touchSyntax touchedIndex fb = fb { dirtyOffset = min touchedIndex (dirtyOffset fb)} updateSyntax :: BufferImpl syntax -> BufferImpl syntax - -updateSyntax [EMAIL PROTECTED] {dirtyOffset = touchedIndex, hlCache = HLState hl cache} +updateSyntax [EMAIL PROTECTED] {dirtyOffset = touchedIndex, hlCache = HLState hl cache} | touchedIndex == maxBound = fb | otherwise = fb {dirtyOffset = maxBound, hunk ./Yi/Buffer/Implementation.hs 437 Backward -> toIndexedStringBackward) p . LazyB.unpack toIndexedStringForward :: Point -> [Word8] -> [(Point, Char)] - -toIndexedStringForward curIdx bs = +toIndexedStringForward curIdx bs = case UF8Codec.decode bs of Nothing -> [] Just (c,n) -> let newIndex = curIdx + (fromIntegral n) in hunk ./Yi/Buffer/Implementation.hs 442 (curIdx,c) : (newIndex `seq` (toIndexedStringForward newIndex (drop n bs))) - - + toIndexedStringBackward :: Point -> [Word8] -> [(Point,Char)] toIndexedStringBackward curIdx bs = case UF8Codec.decode (reverse $ decodeBack bs) of Nothing -> [] hunk ./Yi/Buffer/Implementation.hs 448 Just (c,n) -> let newIndex = curIdx - (fromIntegral n) in (newIndex,c) : (newIndex `seq` (toIndexedStringBackward newIndex (drop n bs))) - - + decodeBack :: [Word8] -> [Word8] decodeBack [] = [] hunk ./Yi/Buffer/Implementation.hs 485 instance Binary MarkValue where put (MarkValue x1 x2) = return () >> (put x1 >> put x2) - - get = case 0 of + get = case (0::Int) of 0 -> ap (ap (return MarkValue) get) get instance Binary Update hunk ./Yi/Buffer/Misc.hs 194 -- unfortunately the dynamic stuff can't be read. instance Binary FBuffer where - - put (FBuffer n b f u r bmode pd _bd pc pu hs _proc wm law) = + put (FBuffer n b f u r bufmode pd _bd pc pu hs _proc wm law) = let strippedRaw :: BufferImpl () hunk ./Yi/Buffer/Misc.hs 196 - - strippedRaw = (setSyntaxBI (modeHL emptyMode) r) + strippedRaw = (setSyntaxBI (modeHL emptyMode) r) in do hunk ./Yi/Buffer/Misc.hs 198 - - put (modeName bmode) + put (modeName bufmode) put n >> put b >> put f >> put u >> put strippedRaw put pd >> put pc >> put pu >> put hs >> put wm put law hunk ./Yi/Buffer/Misc.hs 224 clearSyntax = modifyRawbuf updateSyntax modifyRawbuf :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> FBuffer -> FBuffer - -modifyRawbuf f (FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14) = +modifyRawbuf f (FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14) = (FBuffer f1 f2 f3 f4 (f f5) f6 f7 f8 f9 f10 f11 f12 f13 f14) queryAndModifyRawbuf :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) -> hunk ./Yi/Buffer/Misc.hs 229 FBuffer -> (FBuffer, x) - -queryAndModifyRawbuf f (FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14) = +queryAndModifyRawbuf f (FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14) = let (f5', x) = f f5 in (FBuffer f1 f2 f3 f4 f5' f6 f7 f8 f9 f10 f11 f12 f13 f14, x) hunk ./Yi/Buffer/Misc.hs 234 lastActiveWindowA :: Accessor FBuffer Window - -lastActiveWindowA = Accessor lastActiveWindow (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +lastActiveWindowA = Accessor lastActiveWindow (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 (f f14)) pointDriveA :: Accessor FBuffer Bool hunk ./Yi/Buffer/Misc.hs 239 - -pointDriveA = Accessor pointDrive (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +pointDriveA = Accessor pointDrive (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 f3 f4 f5 f6 (f f7) f8 f9 f10 f11 f12 f13 f14) hunk ./Yi/Buffer/Misc.hs 245 undosA :: Accessor (FBuffer) (URList) - -undosA = Accessor undos (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +undosA = Accessor undos (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 f3 (f f4) f5 f6 f7 f8 f9 f10 f11 f12 f13 f14) fileA :: Accessor (FBuffer) (Maybe FilePath) hunk ./Yi/Buffer/Misc.hs 250 - -fileA = Accessor file (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +fileA = Accessor file (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 (f f3) f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14) preferColA :: Accessor (FBuffer) (Maybe Int) hunk ./Yi/Buffer/Misc.hs 255 - -preferColA = Accessor preferCol (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +preferColA = Accessor preferCol (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 f3 f4 f5 f6 f7 f8 (f f9) f10 f11 f12 f13 f14) bufferDynamicA :: Accessor (FBuffer) (DynamicValues) hunk ./Yi/Buffer/Misc.hs 260 - -bufferDynamicA = Accessor bufferDynamic (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +bufferDynamicA = Accessor bufferDynamic (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 f3 f4 f5 f6 f7 (f f8) f9 f10 f11 f12 f13 f14) pendingUpdatesA :: Accessor (FBuffer) ([UIUpdate]) hunk ./Yi/Buffer/Misc.hs 265 - -pendingUpdatesA = Accessor pendingUpdates (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +pendingUpdatesA = Accessor pendingUpdates (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 (f f10) f11 f12 f13 f14) selectionStyleA :: Accessor FBuffer SelectionStyle hunk ./Yi/Buffer/Misc.hs 270 - -selectionStyleA = Accessor selectionStyle (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +selectionStyleA = Accessor selectionStyle (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 (f f11) f12 f13 f14) highlightSelectionA :: Accessor FBuffer Bool hunk ./Yi/Buffer/Misc.hs 275 - -highlightSelectionA = +highlightSelectionA = Accessor highlightSelection (\f e -> e { highlightSelection = f (highlightSelection e) }) .> selectionStyleA hunk ./Yi/Buffer/Misc.hs 280 rectangleSelectionA :: Accessor FBuffer Bool - -rectangleSelectionA = +rectangleSelectionA = Accessor rectangleSelection (\f e -> e { rectangleSelection = f (rectangleSelection e) }) .> selectionStyleA hunk ./Yi/Buffer/Misc.hs 285 nameA :: Accessor FBuffer String - -nameA = Accessor name (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +nameA = Accessor name (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer (f f1) f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14) keymapProcessA :: Accessor FBuffer KeymapProcess hunk ./Yi/Buffer/Misc.hs 290 - -keymapProcessA = Accessor process (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +keymapProcessA = Accessor process (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 (f f12) f13 f14) winMarksA :: Accessor FBuffer (M.Map Int WinMarks) hunk ./Yi/Buffer/Misc.hs 295 - -winMarksA = Accessor winMarks (\f e -> case e of - - FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> +winMarksA = Accessor winMarks (\f e -> case e of + FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 (f f13) f14) hunk ./Yi/Buffer/Misc.hs 307 -} data IndentSettings = IndentSettings { expandTabs :: Bool -- ^ Insert spaces instead of tabs as possible , tabSize :: Int -- ^ Size of a Tab - - , shiftWidth :: Int -- ^ Indent by so many columns + , shiftWidth :: Int -- ^ Indent by so many columns } deriving (Eq, Show, Typeable) hunk ./Yi/Buffer/Misc.hs 338 {- Is used to specify the behaviour of the automatic indent command. -} - -data IndentBehaviour = +data IndentBehaviour = IncreaseCycle -- ^ Increase the indentation to the next higher indentation -- hint. If we are currently at the highest level of -- indentation then cycle back to the lowest. hunk ./Yi/Buffer/Misc.hs 430 -- | 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) - -runBuffer w b f = - - let (a, _, b') = runBufferFull w b f +runBuffer w b f = + let (a, _, b') = runBufferFull w b f in (a, b') getMarks :: Window -> BufferM (Maybe WinMarks) hunk ./Yi/Buffer/Misc.hs 436 getMarks w = do - - getsA winMarksA (M.lookup $ wkey w) - - + getsA winMarksA (M.lookup $ wkey w) + runBufferFull :: Window -> FBuffer -> BufferM a -> (a, [Update], FBuffer) hunk ./Yi/Buffer/Misc.hs 440 - -runBufferFull w b f = +runBufferFull w b f = let (a, b', updates) = runRWS (fromBufferM f') w b f' = do ms <- getMarks w hunk ./Yi/Buffer/Misc.hs 470 -- | Execute a @BufferM@ value on a given buffer, using a dummy window. The new state of -- the buffer is discarded. - -runBufferDummyWindow :: FBuffer -> BufferM a -> a +runBufferDummyWindow :: FBuffer -> BufferM a -> a runBufferDummyWindow b = fst . runBuffer (dummyWindow $ bkey b) b hunk ./Yi/Buffer/Misc.hs 504 emptyMode :: Mode syntax emptyMode = Mode - - { + { modeName = "empty", modeApplies = const False, modeHL = ExtHL noHighlighter, hunk ./Yi/Buffer/Misc.hs 513 modeIndent = \_ _ -> return (), modeAdjustBlock = \_ _ -> return (), modeFollow = \_ -> emptyAction, - - modeIndentSettings = IndentSettings + modeIndentSettings = IndentSettings { expandTabs = True , tabSize = 8 , shiftWidth = 4 hunk ./Yi/Buffer/Misc.hs 533 , pointDrive = True , bmode = emptyMode , preferCol = Nothing - - , bufferDynamic = emptyDV + , bufferDynamic = emptyDV , pendingUpdates = [] , selectionStyle = SelectionStyle False False , process = I.End hunk ./Yi/Buffer/Misc.hs 645 -- | Return the current line number curLn :: BufferM Int - -curLn = do +curLn = do p <- pointB queryBuffer (lineAt p) hunk ./Yi/Buffer/Misc.hs 676 setMode m = do modify (setMode0 m) -- reset the keymap process so we use the one of the new mode. - - setA keymapProcessA I.End + setA keymapProcessA I.End -- | Modify the mode hunk ./Yi/Buffer/Misc.hs 684 modifyMode f = do modify (modifyMode0 f) -- reset the keymap process so we use the one of the new mode. - - setA keymapProcessA I.End + setA keymapProcessA I.End onMode :: (forall syntax. Mode syntax -> Mode syntax) -> AnyMode -> AnyMode onMode f (AnyMode m) = AnyMode (f m) hunk ./Yi/Buffer/Misc.hs 690 withMode0 :: (forall syntax. Mode syntax -> a) -> FBuffer -> a - -withMode0 f FBuffer {bmode = m} = f m +withMode0 f FBuffer {bmode = m} = f m withModeB :: (forall syntax. Mode syntax -> BufferM a) -> BufferM a hunk ./Yi/Buffer/Misc.hs 697 withModeB f = do act <- gets (withMode0 f) act - - + withSyntax0 :: (forall syntax. Mode syntax -> syntax -> a) -> FBuffer -> a withSyntax0 f FBuffer {bmode = m, rawbuf = rb} = f m (getAst rb) hunk ./Yi/Buffer/Misc.hs 705 withSyntaxB f = do act <- gets (withSyntax0 f) act - - + -- | Return indices of next string in buffer matched by regex in the -- given region regexRegionB :: SearchExp -> Region -> BufferM [Region] hunk ./Yi/Buffer/Misc.hs 743 getMarkB :: Maybe String -> BufferM Mark getMarkB m = do p <- pointB - - queryAndModify (getMarkDefaultPosBI m p) - - + queryAndModify (getMarkDefaultPosBI m p) + -- | Move point by the given number of characters. hunk ./Yi/Buffer/Misc.hs 842 -- Note that this is different from offset or number of chars from sol. -- (This takes into account tabs, unicode chars, etc.) curCol :: BufferM Int - -curCol = do +curCol = do p <- pointB chars <- queryBuffer (charsFromSolBI p) return (foldl colMove 0 chars) hunk ./Yi/Buffer/Misc.hs 850 colMove :: Int -> Char -> Int colMove col '\t' = (col + 7) `mod` 8 colMove col _ = col + 1 - - + -- | Go to line indexed from current point -- Returns the actual moved difference which of course hunk ./Yi/Buffer/Misc.hs 858 gotoLnFrom :: Int -> BufferM Int gotoLnFrom x = do p <- pointB - - (p',lineDiff) <- queryBuffer $ gotoLnRelI x p + (p',lineDiff) <- queryBuffer $ gotoLnRelI x p moveTo p' return lineDiff hunk ./Yi/Buffer/Region.hs 6 -- | This module defines buffer operation on regions - -module Yi.Buffer.Region +module Yi.Buffer.Region ( module Yi.Region , swapRegionsB hunk ./Yi/Buffer/Region.hs 72 replaceRegionB r (fmap f text) -- | Swap the content of two Regions - -swapRegionsB :: Region -> Region -> BufferM () +swapRegionsB :: Region -> Region -> BufferM () swapRegionsB r r' | regionStart r > regionStart r' = swapRegionsB r' r | otherwise = do w0 <- readRegionB r hunk ./Yi/Buffer/Region.hs 81 replaceRegionB r w1 -- Transform a replace into a modify. +replToMod :: (Region -> a -> BufferM b) -> (String -> a) -> Region -> BufferM b replToMod replace = \transform region -> replace region =<< transform <$> readRegionB region -- | Modifies the given region according to the given hunk ./Yi/Buffer/Region.hs 93 -> BufferM () modifyRegionB = replToMod replaceRegionB - - + -- | As 'modifyRegionB', but do a minimal edition instead of deleting the whole -- region and inserting it back. modifyRegionClever :: (String -> [Char]) -> Region -> BufferM () hunk ./Yi/Buffer/Region.hs 105 if regionStart r <= regionEnd r then mkRegion (regionStart r) <$> pointAfter (regionEnd r) else mkRegion <$> pointAfter (regionStart r) <*> pure (regionEnd r) - - where pointAfter p = pointAt $ do + where pointAfter p = pointAt $ do moveTo p rightB hunk ./Yi/Buffer/Undo.hs 60 import Control.Monad (ap) import Data.Binary - -import Yi.Buffer.Implementation +import Yi.Buffer.Implementation data Change = SavedFilePoint | InteractivePoint hunk ./Yi/Buffer/Undo.hs 64 - - | AtomicChange !Update + | AtomicChange !Update -- !!! It's very important that the updates are forced, otherwise -- !!! we'll keep a full copy of the buffer state for each update -- !!! (thunk) put in the URList. hunk ./Yi/Buffer/Undo.hs 122 -- | Insert an initial interactive point, if there is none addIP xs@(InteractivePoint:_) = xs addIP xs = InteractivePoint:xs - - + -- | Repeatedly undo actions, storing away the inverse operations in the -- redo list. undoUntilInteractive :: Mark -> [Update] -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update])) hunk ./Yi/Buffer/Undo.hs 132 (InteractivePoint:_) -> (b, (ur, xs)) (SavedFilePoint:cs') -> undoUntilInteractive pointMark xs (URList cs' (SavedFilePoint:rs)) b - - (AtomicChange u:cs') -> + (AtomicChange u:cs') -> let ur' = (URList cs' (AtomicChange (reverseUpdateI u):rs)) b' = (applyUpdateWithMoveI u b) (b'', (ur'', xs'')) = undoUntilInteractive pointMark xs ur' b' hunk ./Yi/Buffer/Undo.hs 150 -- operate in a redo fashion instead of undo. asRedo :: (URList -> t -> (t, (URList, [Update]))) -> URList -> t -> (t, (URList, [Update])) asRedo f ur x = let (y,(ur',rs)) = f (swapUndoRedo ur) x in (y,(swapUndoRedo ur',rs)) - - where + where swapUndoRedo :: URList -> URList swapUndoRedo (URList us rs) = URList rs us hunk ./Yi/Buffer/Undo.hs 186 instance Binary URList where put (URList x1 x2) = return () >> (put x1 >> put x2) - - get = case 0 of + get = case (0::Int) of 0 -> ap (ap (return URList) get) get hunk ./Yi/KillRing.hs 9 ,krPut ,krSet, krGet ,krEmpty - - ) + ) where import Control.Monad (ap) hunk ./Yi/KillRing.hs 43 krPut :: Direction -> String -> Killring -> Killring krPut dir s [EMAIL PROTECTED] {krContents = r@(x:xs), krAccumulate=acc} = kr {krKilled = True, - - krContents = if acc then (case dir of + krContents = if acc then (case dir of Forward -> x++s Backward -> s++x):xs else push s r} hunk ./Yi/KillRing.hs 52 -- | Push a string in the killring. push :: String -> [String] -> [String] push s [] = [s] - -push s r@(h:t) = s : if length h <= 1 then t else take maxDepth r +push s r@(h:t) = s : if length h <= 1 then t else take maxDepth r -- Don't save very small cutted text portions. -- | Set the top of the killring. Never accumulate the previous content. hunk ./Yi/KillRing.hs 76 x2 x3 x4) = return () >> (put x1 >> (put x2 >> (put x3 >> put x4))) - - get = case 0 of + get = case (0::Int) of 0 -> ap (ap (ap (ap (return Killring) get) get) get) get hunk ./Yi/Process.hs 67 runShellCommand :: String -> IO (String,String,ExitCode) runShellCommand cmd = do - - shell <- shellFileName - - popen shell [shellCommandSwitch, cmd] Nothing + sh <- shellFileName + popen sh [shellCommandSwitch, cmd] Nothing -------------------------------------------------------------------------------- hunk ./Yi/Process.hs 126 readAvailable handle = (liftM concat) $ repeatUntilM $ read_chunk handle -- Read a chunk from a handle, bool indicates if there is potentially more data available - -read_chunk :: Handle -> IO (Bool,String) - -read_chunk handle = do +read_chunk :: Handle -> IO (Bool,String) +read_chunk handle = do let bufferSize = 1024 allocaBytes bufferSize $ \buffer -> do bytesRead <- hGetBufNonBlocking handle buffer bufferSize hunk ./Yi/Regex.hs 3 {-# LANGUAGE FlexibleContexts #-} -- Copyright (c) Jean-Philippe Bernardy 2008 - -module Yi.Regex +module Yi.Regex ( hunk ./Yi/Regex.hs 5 - - SearchF(..), makeSearchOptsM, + SearchF(..), makeSearchOptsM, makeSearchOptsM', SearchExp, searchString, searchRegex, emptySearch, emptyRegex, module Text.Regex.TDFA, hunk ./Yi/Regex.hs 52 makeSearchOptsM :: [SearchF] -> String -> Either String (String, Regex) makeSearchOptsM opts re = (\r->(re,r)) <$> compilePattern (searchOpts opts defaultCompOpt) defaultExecOpt <$> pattern where searchOpts = foldr (.) id . map searchOpt - - pattern = if QuoteRegex `elem` opts - - then Right (literalPattern re) + pattern = if QuoteRegex `elem` opts + then Right (literalPattern re) else mapLeft show (parseRegex re) hunk ./Yi/Regex.hs 57 - -mapLeft f (Right a) = Right a +mapLeft :: (t1 -> a) -> Either t1 t -> Either a t +mapLeft _ (Right a) = Right a mapLeft f (Left a) = Left (f a) -- | Return a pattern that matches its argument. hunk ./Yi/Regex.hs 62 +literalPattern :: (Num t) => String -> (Pattern, (t, DoPa)) literalPattern source = (PConcat $ map (PChar (DoPa 0)) $ source, (0,DoPa 0)) compilePattern :: CompOption -- ^ Flags (summed together) hunk ./Yi/Window.hs 31 winkey w = (isMini w, bufkey w) instance Show Window where - - show w = "Window to " ++ show (bufkey w) - - -- ++ "{" ++ show (tospnt w) ++ "->" ++ show (bospnt w) ++ "}" + show w = "Window to " ++ show (bufkey w) + -- ++ "{" ++ show (tospnt w) ++ "->" ++ show (bospnt w) ++ "}" ++ "(" ++ show (height w) ++ ")" {- hunk ./Yi/Window.hs 60 x2 x3 x4) = return () >> (put x1 >> (put x2 >> (put x3 >> put x4))) - - get = case 0 of + get = case (0::Int) of 0 -> ap (ap (ap (ap (return Window) get) get) get) get hunk ./Yi/WindowSet.hs 87 backward (WindowSet [] c a) = WindowSet (c:reverse (init a)) (last a) [] setFocus :: (Show a, Eq a) => a -> WindowSet a -> WindowSet a - -setFocus w ws@(WindowSet b c a) +setFocus w ws@(WindowSet b c a) | c == w = ws | w `elem` a = setFocus w (forward ws) | w `elem` b = setFocus w (backward ws) hunk ./Yi/WindowSet.hs 114 where put (WindowSet x1 x2 x3) = return () >> (put x1 >> (put x2 >> put x3)) - - get = case 0 of + get = case (0::Int) of 0 -> ap (ap (ap (return WindowSet) get) get) get Context: [Vim: less parens. Nicolas Pouillard <[EMAIL PROTECTED]>**20081203214311 Ignore-this: 22702b54973afdb5c77d67929452a695 ] [Vim: ":<int>" also have to go to first non space char. Nicolas Pouillard <[EMAIL PROTECTED]>**20081203213806 Ignore-this: 69ee440d16448b21851ddbc06352b37f ] [Vim: improve 'G' code. Nicolas Pouillard <[EMAIL PROTECTED]>**20081203213640 Ignore-this: 8cbd5f1a5c13ca99bc7dc0404563a147 ] ['gg' and 'G' should go to first non-space char of line Krzysztof Goj <[EMAIL PROTECTED]>**20081203212353] [Vim normal mode: "gg" with count argument Krzysztof Goj <[EMAIL PROTECTED]>**20081203203817] [Main.hs: M-x ireadMode to just iread [EMAIL PROTECTED] Ignore-this: b307ff52b630f8500f05218d4a5aa5c0 So I don't need to constantly disambiguate. ] [last of the LANGUAGE pragmas [EMAIL PROTECTED] Ignore-this: 8a1bd56c03682e4c9b163a615263af84 I have cast the extensions field into perdition, and added the missing per-file declarations. ] [Shim/*: +pragmas, rm unused imports [EMAIL PROTECTED] Ignore-this: eff16eba16ed8e3b98fdfe9420f1ab2b ] [fix up Shim/ w/r/t Control.Exception [EMAIL PROTECTED] Ignore-this: 4ec9ae4bafcf9b98c07acd0a6cbab9e ] [Shim/; some -Wall cleanup [EMAIL PROTECTED] Ignore-this: bcfe4c1e2d239472e56d08fe0eee0bd4 ] [Comments fix Krzysztof Goj <[EMAIL PROTECTED]>**20081203155512 - Esc leaves visual mode -- dropping comment - Explain and extend a FIXME for S and C ] [Add Yi.Region.regionIsEmpty Nicolas Pouillard <[EMAIL PROTECTED]>**20081203175753 Ignore-this: c075fd46a14a991d5476770b9faafed7 ] [Vim: do nothing when cuting/pasting empty regions Nicolas Pouillard <[EMAIL PROTECTED]>**20081203155544 Ignore-this: e0b4bc63452e1e2df93b4e3a2a841413 This avoid marking the buffer as unsaved. ] [Vim: style, parens, and trailing white-spaces. Nicolas Pouillard <[EMAIL PROTECTED]>**20081203155350 Ignore-this: 3d959998aed83292f5fac99a7a8d6f44 ] [Vim: when leaving insert/replace mode, use moveXorSol 1 instead of leftB Nicolas Pouillard <[EMAIL PROTECTED]>**20081203155247 Ignore-this: f2766bc3a75501484a524d241f84e025 ] [Corrected 'x' and 'X' behaviour Krzysztof Goj <[EMAIL PROTECTED]>**20081203125741 Now 'x' and 'X' are aliases to dl and dh (as in Vim) -- they cannot delete newline character. ] [Ctrl+h in insert and replace mode; Ctrl+w in replace mode Krzysztof Goj <[EMAIL PROTECTED]>**20081203012614] [Ctrl+h in Ex mode Krzysztof Goj <[EMAIL PROTECTED]>**20081203000017] [Ctrl+p, Ctrl+n in Ex mode Krzysztof Goj <[EMAIL PROTECTED]>**20081202235807] [Vim visual mode: 's' is synonym to 'c' Krzysztof Goj <[EMAIL PROTECTED]>**20081202233509] [Vim: ctrl+u, ctrl+d scrolling Krzysztof Goj <[EMAIL PROTECTED]>**20081202231544] [Behaviour at end of line (BIG PATCH) Krzysztof Goj <[EMAIL PROTECTED]>**20081203031045 - Doesn't allow to go to EOL in normal mode - Does allow it in other (visual, insert, replace) modes - Corrected D, and '$' command - cursor moves left after leaving insert and replace mode ] [Ctrl-t and Ctrl-d in insert mode (indentation) Krzysztof Goj <[EMAIL PROTECTED]>**20081202223751] [Better percent move. Krzysztof Goj <[EMAIL PROTECTED]>**20081202162105] [Issue 202: indentation and Vim commands Krzysztof Goj <[EMAIL PROTECTED]>**20081202183446 Added indentation-awareness to cutRegion, pasteBefore and pasteAfter. ] [Fixed isMakefile: takeBaseName should be takeFileName. Otherwise makefile's named like foo.mk would not be recognized. [EMAIL PROTECTED] [replace all: more helpful message [EMAIL PROTECTED] [fix build [EMAIL PROTECTED] [Better word and WORD motions for Vim keymap. Krzysztof Goj <[EMAIL PROTECTED]>**20081202132813] [doc [EMAIL PROTECTED] [Yi/Users/Gwern.hs: +shorter binding for gotoLn [EMAIL PROTECTED] Ignore-this: 5defc56344c3e1c61bd602d192e06af3 I find the default Emacs binding of M-g g tedious; why not just M-g? ] [doc [EMAIL PROTECTED] [make Accessor instance of Category [EMAIL PROTECTED] [use Control.Category [EMAIL PROTECTED] [Yi.Keymap.Emacs: +standard emacs M-; binding [EMAIL PROTECTED] Ignore-this: 5abf2d7154acfdcce44286f34ec238b9 ] [update to base>=4; replace all Control.Exception with Control.OldException [EMAIL PROTECTED] Ignore-this: 205b7c23a4ffcc16b8612d0b4edc9352 ] [better support for vivid colors [EMAIL PROTECTED] [Main.hs: minor indent [EMAIL PROTECTED] Ignore-this: b53fd55beb556c92b6bba9ee4a49cd61 ] [added C-w and C-u to ex mode Aleksandar Dimitrov <[EMAIL PROTECTED]>**20081201103414] ['ZZ' closes window, not editor, 'ZQ' == ':q!' Aleksandar Dimitrov <[EMAIL PROTECTED]>**20081201103311] [bump version number [EMAIL PROTECTED] [TAG 0.5.2 [EMAIL PROTECTED] Patch bundle hash: 0e59552c8a0ea069ff8dda7473c6d5f812a602fe -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.4.9 (GNU/Linux) iEYEAREKAAYFAkk3Ks4ACgkQvpDo5Pfl1oIfAgCfXV2vdxVte3Cu9WDeEInvXsho muIAn1p26//O/7uLD7lFTBxM4+C8+6TC =e+XS -----END PGP SIGNATURE-----
