yi-0.12.6/art/0000755000000000000000000000000012533751517011206 5ustar0000000000000000yi-0.12.6/example-configs/0000755000000000000000000000000012717763531013504 5ustar0000000000000000yi-0.12.6/src/0000755000000000000000000000000012636032042011174 5ustar0000000000000000yi-0.12.6/src/executable/0000755000000000000000000000000012533751517013330 5ustar0000000000000000yi-0.12.6/src/library/0000755000000000000000000000000012533751517012653 5ustar0000000000000000yi-0.12.6/src/library/Control/0000755000000000000000000000000012533751517014273 5ustar0000000000000000yi-0.12.6/src/library/Data/0000755000000000000000000000000012533751517013524 5ustar0000000000000000yi-0.12.6/src/library/Parser/0000755000000000000000000000000012717763531014112 5ustar0000000000000000yi-0.12.6/src/library/System/0000755000000000000000000000000012717763531014142 5ustar0000000000000000yi-0.12.6/src/library/Yi/0000755000000000000000000000000012725740550013232 5ustar0000000000000000yi-0.12.6/src/library/Yi/Boot/0000755000000000000000000000000012717763531014142 5ustar0000000000000000yi-0.12.6/src/library/Yi/Buffer/0000755000000000000000000000000012720302155014431 5ustar0000000000000000yi-0.12.6/src/library/Yi/Char/0000755000000000000000000000000012717763531014114 5ustar0000000000000000yi-0.12.6/src/library/Yi/Command/0000755000000000000000000000000012717763531014615 5ustar0000000000000000yi-0.12.6/src/library/Yi/Config/0000755000000000000000000000000012717763531014444 5ustar0000000000000000yi-0.12.6/src/library/Yi/Config/Simple/0000755000000000000000000000000012717763531015675 5ustar0000000000000000yi-0.12.6/src/library/Yi/Keymap/0000755000000000000000000000000012725740550014460 5ustar0000000000000000yi-0.12.6/src/library/Yi/Keymap/Emacs/0000755000000000000000000000000012725740550015510 5ustar0000000000000000yi-0.12.6/src/library/Yi/Keymap/Vim/0000755000000000000000000000000012725740550015213 5ustar0000000000000000yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/0000755000000000000000000000000012717763531015574 5ustar0000000000000000yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/0000755000000000000000000000000012717763531017335 5ustar0000000000000000yi-0.12.6/src/library/Yi/Mode/0000755000000000000000000000000012717763531014123 5ustar0000000000000000yi-0.12.6/src/library/Yi/Mode/Haskell/0000755000000000000000000000000012717763531015506 5ustar0000000000000000yi-0.12.6/src/library/Yi/Search/0000755000000000000000000000000012717763531014444 5ustar0000000000000000yi-0.12.6/src/library/Yi/Snippets/0000755000000000000000000000000012717763531015044 5ustar0000000000000000yi-0.12.6/src/library/Yi/Syntax/0000755000000000000000000000000012717763531014525 5ustar0000000000000000yi-0.12.6/src/library/Yi/Syntax/Strokes/0000755000000000000000000000000012717763531016157 5ustar0000000000000000yi-0.12.6/src/library/Yi/UI/0000755000000000000000000000000012725740550013547 5ustar0000000000000000yi-0.12.6/src/library/Yi/UI/Pango/0000755000000000000000000000000012717763531014620 5ustar0000000000000000yi-0.12.6/src/library/Yi/UI/Vty/0000755000000000000000000000000012717763531014336 5ustar0000000000000000yi-0.12.6/src/library/Yi/Verifier/0000755000000000000000000000000012717763531015012 5ustar0000000000000000yi-0.12.6/src/tests/0000755000000000000000000000000012533751517012351 5ustar0000000000000000yi-0.12.6/src/tests/Generic/0000755000000000000000000000000012717763531013730 5ustar0000000000000000yi-0.12.6/src/tests/Vim/0000755000000000000000000000000012533751517013104 5ustar0000000000000000yi-0.12.6/src/tests/Vim/EditorManipulations/0000755000000000000000000000000012533751517017076 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/0000755000000000000000000000000012533751517014227 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/blockvisual/0000755000000000000000000000000012533751517016545 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/change/0000755000000000000000000000000012717763531015457 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/delete/0000755000000000000000000000000012533751517015471 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/digraphs/0000755000000000000000000000000012533751517016030 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/empty/0000755000000000000000000000000012533751517015365 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/empty/emptytest/0000755000000000000000000000000012533751517017423 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/ex/0000755000000000000000000000000012533751517014643 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/ex/d/0000755000000000000000000000000012533751517015066 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/ex/g/0000755000000000000000000000000012533751517015071 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/ex/gotoline/0000755000000000000000000000000012533751517016463 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/ex/s/0000755000000000000000000000000012533751517015105 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/find/0000755000000000000000000000000012533751517015147 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/indent/0000755000000000000000000000000012533751517015510 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/insertion/0000755000000000000000000000000012717763531016244 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/insertion/cursorkeys/0000755000000000000000000000000012533751517020452 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/joinlines/0000755000000000000000000000000012533751517016221 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/jumplist/0000755000000000000000000000000012533751517016076 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/macros/0000755000000000000000000000000012533751517015513 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/marks/0000755000000000000000000000000012533751517015344 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/0000755000000000000000000000000012533751517016061 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/bigWord/0000755000000000000000000000000012533751517017456 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/char/0000755000000000000000000000000012533751517016776 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/char/h_at_bol/0000755000000000000000000000000012533751517020545 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/char/hl/0000755000000000000000000000000012533751517017401 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/char/j/0000755000000000000000000000000012533751517017227 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/char/l_at_eol/0000755000000000000000000000000012533751517020554 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/cursorkeys/0000755000000000000000000000000012533751517020272 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/file/0000755000000000000000000000000012533751517017000 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/intraline/0000755000000000000000000000000012533751517020046 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/movement/word/0000755000000000000000000000000012533751517017034 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/numbers/0000755000000000000000000000000012533751517015702 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/paste/0000755000000000000000000000000012533751517015343 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/repeat/0000755000000000000000000000000012533751517015507 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/replace/0000755000000000000000000000000012533751517015642 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/search/0000755000000000000000000000000012533751517015474 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/searchword/0000755000000000000000000000000012533751517016370 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/sort/0000755000000000000000000000000012533751517015216 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/switchcase/0000755000000000000000000000000012533751517016364 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/undo/0000755000000000000000000000000012533751517015174 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/unicode/0000755000000000000000000000000012533751517015655 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/unsorted/0000755000000000000000000000000012533751517016072 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/visual/0000755000000000000000000000000012717763531015535 5ustar0000000000000000yi-0.12.6/src/tests/vimtests/yank/0000755000000000000000000000000012533751517015171 5ustar0000000000000000yi-0.12.6/src/library/Yi.hs0000644000000000000000000000252512533751517013574 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Facade of the Yi library, for use by confguration file. Just -- re-exports a bunch of modules. -- -- You should therefore: -- -- @ import Yi@ -- -- in your @~/.config/yi/yi.hs@. module Yi ( module Data.Prototype, -- prototypes are mainly there for config; makes sense to export them. module Yi.Boot, module Yi.Buffer, module Yi.Config, module Yi.Config.Default, module Yi.Core, module Yi.Dired, module Yi.Editor, module Yi.Eval, module Yi.File, module Yi.Keymap, module Yi.Keymap.Keys, module Yi.Misc, module Yi.Mode.Haskell, module Yi.Mode.IReader, module Yi.Search, module Yi.Style, module Yi.Style.Library, ) where import Data.Prototype import Yi.Boot import Yi.Buffer import Yi.Config import Yi.Config.Default import Yi.Core import Yi.Dired import Yi.Editor import Yi.Eval import Yi.File import Yi.Keymap import Yi.Keymap.Keys import Yi.Misc import Yi.Mode.Haskell (ghciGet, ghciLoadBuffer, ghciSetProcessName, ghciSetProcessArgs) import Yi.Mode.IReader (ireaderMode, ireadMode) import Yi.Search import Yi.Style import Yi.Style.Libraryyi-0.12.6/src/library/Yi/Boot.hs0000644000000000000000000000631612713533235014474 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Boot -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Boot process of Yi. -- -- Uses Dyre to implement the XMonad-style dynamic reconfiguration. module Yi.Boot (yi, yiDriver, reload) where import qualified Config.Dyre as Dyre import qualified Config.Dyre.Options as Dyre import qualified Config.Dyre.Params as Dyre import Config.Dyre.Relaunch import Control.Lens import Data.Text () import System.Environment import System.Exit import Yi.Boot.Internal import Yi.Buffer.Misc (BufferId(..)) import Yi.Config import Yi.Editor import Yi.Keymap import Yi.Main import Yi.Paths (getCustomConfigPath) import Yi.Rope (fromString) -- | Once the custom yi is compiled this restores the editor state (if -- requested) then proceeds to run the editor. realMain :: (Config, ConsoleConfig) -> IO () realMain configs = restoreBinaryState Nothing >>= main configs -- | If the custom yi compile produces errors or warnings then the -- messages are presented as a separate activity in the editor. -- -- The use of a separate activity prevents any other initial actions -- from immediately masking the output. showErrorsInConf :: (Config, ConsoleConfig) -> String -> (Config, ConsoleConfig) showErrorsInConf c errs = c & _1 . initialActionsA %~ (makeAction openErrBuf :) where openErrBuf = splitE >> newBufferE (MemBuffer "*errors*") (fromString errs) -- | Handy alias for 'yiDriver'. yi :: Config -> IO () yi = yiDriver -- | Used by both the yi executable and the custom yi that is built -- from the user's configuration. The yi executable uses a default -- config. yiDriver :: Config -> IO () yiDriver cfg = do args <- Dyre.withDyreOptions Dyre.defaultParams getArgs -- we do the arg processing before dyre, so we can extract -- '--ghc-option=' and '--help' and so on. case do_args cfg args of Left (Err err code) -> putStrLn err >> exitWith code Right (finalCfg, cfgcon) -> do modules <- getCustomConfigPath (userConfigDir cfgcon) "modules" let yiParams = Dyre.defaultParams { Dyre.projectName = "yi" , Dyre.realMain = realMain , Dyre.showError = showErrorsInConf , Dyre.configDir = Just $ userConfigDir cfgcon , Dyre.ghcOpts = ["-threaded", "-O2", "-rtsopts"] ++ ["-i" ++ modules] ++ profilingParams ++ ghcOptions cfgcon , Dyre.includeCurrentDirectory = False , Dyre.rtsOptsHandling = Dyre.RTSAppend ["-I5"] } Dyre.wrapMain yiParams (finalCfg, cfgcon) -- | CPP-guarded profiling params. profilingParams :: [String] profilingParams = #ifdef EVENTLOG ["-eventlog", "-rtsopts"] ++ #endif #ifdef PROFILING ["-prof", "-auto-all", "-rtsopts" , "-osuf=p_o", "-hisuf=p_hi"] ++ #endif [] yi-0.12.6/src/library/Yi/Boot/Internal.hs0000644000000000000000000000157112717763531016256 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Boot.Internal -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Internal use for Yi.Boot module Yi.Boot.Internal where import Config.Dyre.Relaunch (relaunchWithBinaryState) import Control.Monad.Base (liftBase) import Control.Monad.State (get) import Yi.Keymap (YiM, withUI) import Yi.Types (withEditor) import Yi.UI.Common (end) -- | "reloads" the configuration -- -- Serializes the editor state and relaunches Yi using the serialized -- state. The launch of Yi will result in recompilation of the user's -- custom Yi. This, in effect, "reloads" the configuration. reload :: YiM () reload = do editor <- withEditor get withUI (`end` False) liftBase $ relaunchWithBinaryState (Just editor) Nothing yi-0.12.6/src/library/Yi/Buffer.hs0000644000000000000000000000176412533751517015011 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Buffer -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- The 'Buffer' module defines monadic editing operations over -- one-dimensional buffers, maintaining a current /point/. -- -- This module acts as a facade for the Buffer.* modules. module Yi.Buffer ( module Yi.Buffer.Basic , module Yi.Buffer.HighLevel , module Yi.Buffer.Indent , module Yi.Buffer.Misc , module Yi.Buffer.Normal , module Yi.Buffer.Region , module Yi.Buffer.TextUnit , module Yi.Buffer.Undo -- Implementation re-exports (move out of implementation?) , UIUpdate (..) , Update (..) , updateIsDelete , markGravityAA , markPointAA ) where import Yi.Buffer.Basic import Yi.Buffer.HighLevel import Yi.Buffer.Indent import Yi.Buffer.Misc import Yi.Buffer.Normal import Yi.Buffer.Region import Yi.Buffer.TextUnit import Yi.Buffer.Undo import Yi.Buffer.Implementation yi-0.12.6/src/library/Yi/Buffer/Adjusted.hs0000644000000000000000000000553312717763531016555 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Buffer.Adjusted -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module re-exports Yi.Buffer overriding insert* and delete* functions -- with their more indent-aware variants. It is intended to be imported -- instead of Yi.Buffer or qualified to avoid name clashes. module Yi.Buffer.Adjusted ( bdeleteB , insertB , insertN , insertNAt , deleteB , deleteN , deleteRegionB , deleteRegionWithStyleB , module Yi.Buffer ) where import Control.Applicative ((<$>)) import Control.Monad (forM_, when) import Yi.Buffer hiding (bdeleteB, insertB, insertN, insertNAt , deleteB, deleteN, deleteNAt , deleteRegionB, deleteRegionWithStyleB) import qualified Yi.Buffer as B (deleteN, insertB, insertNAt) import Yi.Misc (adjBlock) import qualified Yi.Rope as R (YiString, countNewLines, length, take) import Yi.Utils (SemiNum ((~-))) insertNAt :: R.YiString -> Point -> BufferM () insertNAt rope point | R.countNewLines rope > 0 = B.insertNAt rope point insertNAt rope point = B.insertNAt rope point >> adjBlock (R.length rope) -- | Insert the list at current point, extending size of buffer insertN :: R.YiString -> BufferM () insertN rope = insertNAt rope =<< pointB -- | Insert the char at current point, extending size of buffer insertB :: Char -> BufferM () insertB c = B.insertB c >> adjBlock 1 -- | @deleteNAt n p@ deletes @n@ characters forwards from position @p@ deleteNAt :: Direction -> Int -> Point -> BufferM () deleteNAt dir n pos = do els <- R.take n <$> streamB Forward pos applyUpdate (Delete pos dir els) when (R.countNewLines els == 0) $ adjBlock (-(R.length els)) deleteN :: Int -> BufferM () deleteN n = pointB >>= deleteNAt Forward n deleteB :: TextUnit -> Direction -> BufferM () deleteB unit dir = deleteRegionB =<< regionOfPartNonEmptyB unit dir bdeleteB :: BufferM () bdeleteB = deleteB Character Backward deleteRegionB :: Region -> BufferM () deleteRegionB r = deleteNAt (regionDirection r) (fromIntegral (regionEnd r ~- regionStart r)) (regionStart r) deleteRegionWithStyleB :: Region -> RegionStyle -> BufferM Point deleteRegionWithStyleB reg Block = savingPointB $ do (start, lengths) <- shapeOfBlockRegionB reg moveTo start forM_ (zip [1..] lengths) $ \(i, l) -> do B.deleteN l moveTo start lineMoveRel i return start deleteRegionWithStyleB reg style = savingPointB $ do effectiveRegion <- convertRegionToStyleB reg style deleteRegionB effectiveRegion return $! regionStart effectiveRegion yi-0.12.6/src/library/Yi/Buffer/HighLevel.hs0000644000000000000000000011456212717763531016664 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} {-# LANGUAGE MultiWayIf #-} -- | -- Module : Yi.Buffer.HighLevel -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- High level operations on buffers. module Yi.Buffer.HighLevel ( atEof , atEol , atLastLine , atSol , atSof , bdeleteB , bdeleteLineB , bkillWordB , botB , bufInfoB , BufferFileInfo (..) , capitaliseWordB , deleteBlankLinesB , deleteHorizontalSpaceB , deleteRegionWithStyleB , deleteToEol , deleteTrailingSpaceB , downFromTosB , downScreenB , downScreensB , exchangePointAndMarkB , fillParagraph , findMatchingPairB , firstNonSpaceB , flipRectangleB , getBookmarkB , getLineAndCol , getLineAndColOfPoint , getNextLineB , getNextNonBlankLineB , getRawestSelectRegionB , getSelectionMarkPointB , getSelectRegionB , gotoCharacterB , hasWhiteSpaceBefore , incrementNextNumberByB , insertRopeWithStyleB , isCurrentLineAllWhiteSpaceB , isCurrentLineEmptyB , isNumberB , killWordB , lastNonSpaceB , leftEdgesOfRegionB , leftOnEol , lineMoveVisRel , linePrefixSelectionB , lineStreamB , lowercaseWordB , middleB , modifyExtendedSelectionB , moveNonspaceOrSol , movePercentageFileB , moveToMTB , moveToEol , moveToSol , moveXorEol , moveXorSol , nextCExc , nextCInc , nextCInLineExc , nextCInLineInc , nextNParagraphs , nextWordB , prevCExc , prevCInc , prevCInLineExc , prevCInLineInc , prevNParagraphs , prevWordB , readCurrentWordB , readLnB , readPrevWordB , readRegionRopeWithStyleB , replaceBufferContent , revertB , rightEdgesOfRegionB , scrollB , scrollCursorToBottomB , scrollCursorToTopB , scrollScreensB , scrollToCursorB , scrollToLineAboveWindowB , scrollToLineBelowWindowB , setSelectionMarkPointB , setSelectRegionB , shapeOfBlockRegionB , sortLines , sortLinesWithRegion , snapInsB , snapScreenB , splitBlockRegionToContiguousSubRegionsB , swapB , switchCaseChar , test3CharB , testHexB , toggleCommentB , topB , unLineCommentSelectionB , upFromBosB , uppercaseWordB , upScreenB , upScreensB , vimScrollB , vimScrollByB , markWord ) where import Control.Applicative (Applicative ((<*>)), (<$>)) import Control.Lens (assign, over, use, (%=), (.=)) import Control.Lens.Cons (_last) import Control.Monad (forM, forM_, replicateM_, unless, void, when) import Control.Monad.RWS.Strict (ask) import Control.Monad.State (gets) import Data.Char (isDigit, isHexDigit, isOctDigit, isSpace, isUpper, toLower, toUpper) import Data.List (intersperse, sort) import Data.Maybe (catMaybes, fromMaybe, listToMaybe) import Data.Monoid (Monoid (mempty), (<>)) import qualified Data.Text as T (Text, toLower, toUpper, unpack) import Data.Time (UTCTime) import Data.Tuple (swap) import Numeric (readHex, readOct, showHex, showOct) import Yi.Buffer.Basic (Direction (..), Mark, Point (..), Size (Size)) import Yi.Buffer.Misc import Yi.Buffer.Normal import Yi.Buffer.Region import Yi.Config.Misc (ScrollStyle (SingleLine)) import Yi.Rope (YiString) import qualified Yi.Rope as R import Yi.String (capitalizeFirst, fillText, isBlank, mapLines, onLines, overInit) import Yi.Utils (SemiNum ((+~), (-~))) import Yi.Window (Window (actualLines, width, wkey)) -- --------------------------------------------------------------------- -- Movement operations -- | Move point between the middle, top and bottom of the screen -- If the point stays at the middle, it'll be gone to the top -- else if the point stays at the top, it'll be gone to the bottom -- else it'll be gone to the middle moveToMTB :: BufferM () moveToMTB = (==) <$> curLn <*> screenMidLn >>= \case True -> downFromTosB 0 _ -> (==) <$> curLn <*> screenTopLn >>= \case True -> upFromBosB 0 _ -> downFromTosB =<< (-) <$> screenMidLn <*> screenTopLn -- | Move point to start of line moveToSol :: BufferM () moveToSol = maybeMoveB Line Backward -- | Move point to end of line moveToEol :: BufferM () moveToEol = maybeMoveB Line Forward -- | Move cursor to origin topB :: BufferM () topB = moveTo 0 -- | Move cursor to end of buffer botB :: BufferM () botB = moveTo =<< sizeB -- | Move left if on eol, but not on blank line leftOnEol :: BufferM () -- @savingPrefCol@ is needed, because deep down @leftB@ contains @forgetPrefCol@ -- which messes up vertical cursor motion in Vim normal mode leftOnEol = savingPrefCol $ do eol <- atEol sol <- atSol when (eol && not sol) leftB -- | Move @x@ chars back, or to the sol, whichever is less moveXorSol :: Int -> BufferM () moveXorSol x = replicateM_ x $ do c <- atSol; unless c leftB -- | Move @x@ chars forward, or to the eol, whichever is less moveXorEol :: Int -> BufferM () moveXorEol x = replicateM_ x $ do c <- atEol; unless c rightB -- | Move to first char of next word forwards nextWordB :: BufferM () nextWordB = moveB unitWord Forward -- | Move to first char of next word backwards prevWordB :: BufferM () prevWordB = moveB unitWord Backward -- * Char-based movement actions. gotoCharacterB :: Char -> Direction -> RegionStyle -> Bool -> BufferM () gotoCharacterB c dir style stopAtLineBreaks = do start <- pointB let predicate = if stopAtLineBreaks then (`elem` [c, '\n']) else (== c) (move, moveBack) = if dir == Forward then (rightB, leftB) else (leftB, rightB) doUntilB_ (predicate <$> readB) move b <- readB if stopAtLineBreaks && b == '\n' then moveTo start else when (style == Exclusive && b == c) moveBack -- | Move to the next occurence of @c@ nextCInc :: Char -> BufferM () nextCInc c = gotoCharacterB c Forward Inclusive False nextCInLineInc :: Char -> BufferM () nextCInLineInc c = gotoCharacterB c Forward Inclusive True -- | Move to the character before the next occurence of @c@ nextCExc :: Char -> BufferM () nextCExc c = gotoCharacterB c Forward Exclusive False nextCInLineExc :: Char -> BufferM () nextCInLineExc c = gotoCharacterB c Forward Exclusive True -- | Move to the previous occurence of @c@ prevCInc :: Char -> BufferM () prevCInc c = gotoCharacterB c Backward Inclusive False prevCInLineInc :: Char -> BufferM () prevCInLineInc c = gotoCharacterB c Backward Inclusive True -- | Move to the character after the previous occurence of @c@ prevCExc :: Char -> BufferM () prevCExc c = gotoCharacterB c Backward Exclusive False prevCInLineExc :: Char -> BufferM () prevCInLineExc c = gotoCharacterB c Backward Exclusive True -- | Move to first non-space character in this line firstNonSpaceB :: BufferM () firstNonSpaceB = do moveToSol untilB_ ((||) <$> atEol <*> ((not . isSpace) <$> readB)) rightB -- | Move to the last non-space character in this line lastNonSpaceB :: BufferM () lastNonSpaceB = do moveToEol untilB_ ((||) <$> atSol <*> ((not . isSpace) <$> readB)) leftB -- | Go to the first non space character in the line; -- if already there, then go to the beginning of the line. moveNonspaceOrSol :: BufferM () moveNonspaceOrSol = do prev <- readPreviousOfLnB if R.all isSpace prev then moveToSol else firstNonSpaceB -- | True if current line consists of just a newline (no whitespace) isCurrentLineEmptyB :: BufferM Bool isCurrentLineEmptyB = savingPointB $ moveToSol >> atEol -- | Note: Returns False if line doesn't have any characters besides a newline isCurrentLineAllWhiteSpaceB :: BufferM Bool isCurrentLineAllWhiteSpaceB = savingPointB $ do isEmpty <- isCurrentLineEmptyB if isEmpty then return False else do let go = do eol <- atEol if eol then return True else do c <- readB if isSpace c then rightB >> go else return False moveToSol go ------------ -- | Move down next @n@ paragraphs nextNParagraphs :: Int -> BufferM () nextNParagraphs n = replicateM_ n $ moveB unitEmacsParagraph Forward -- | Move up prev @n@ paragraphs prevNParagraphs :: Int -> BufferM () prevNParagraphs n = replicateM_ n $ moveB unitEmacsParagraph Backward -- ! Examples: -- @goUnmatchedB Backward '(' ')'@ -- Move to the previous unmatched '(' -- @goUnmatchedB Forward '{' '}'@ -- Move to the next unmatched '}' goUnmatchedB :: Direction -> Char -> Char -> BufferM () goUnmatchedB dir cStart' cStop' = getLineAndCol >>= \position -> stepB >> readB >>= go position (0::Int) where go pos opened c | c == cStop && opened == 0 = return () | c == cStop = goIfNotEofSof pos (opened-1) | c == cStart = goIfNotEofSof pos (opened+1) | otherwise = goIfNotEofSof pos opened goIfNotEofSof pos opened = atEof >>= \eof -> atSof >>= \sof -> if not eof && not sof then stepB >> readB >>= go pos opened else gotoLn (fst pos) >> moveToColB (snd pos) (stepB, cStart, cStop) | dir == Forward = (rightB, cStart', cStop') | otherwise = (leftB, cStop', cStart') ----------------------------------------------------------------------- -- Queries -- | Return true if the current point is the start of a line atSol :: BufferM Bool atSol = atBoundaryB Line Backward -- | Return true if the current point is the end of a line atEol :: BufferM Bool atEol = atBoundaryB Line Forward -- | True if point at start of file atSof :: BufferM Bool atSof = atBoundaryB Document Backward -- | True if point at end of file atEof :: BufferM Bool atEof = atBoundaryB Document Forward -- | True if point at the last line atLastLine :: BufferM Bool atLastLine = savingPointB $ do moveToEol (==) <$> sizeB <*> pointB -- | Get the current line and column number getLineAndCol :: BufferM (Int, Int) getLineAndCol = (,) <$> curLn <*> curCol getLineAndColOfPoint :: Point -> BufferM (Int, Int) getLineAndColOfPoint p = savingPointB $ moveTo p >> getLineAndCol -- | Read the line the point is on readLnB :: BufferM YiString readLnB = readUnitB Line -- | Read from point to beginning of line readPreviousOfLnB :: BufferM YiString readPreviousOfLnB = readRegionB =<< regionOfPartB Line Backward hasWhiteSpaceBefore :: BufferM Bool hasWhiteSpaceBefore = fmap isSpace (prevPointB >>= readAtB) -- | Get the previous point, unless at the beginning of the file prevPointB :: BufferM Point prevPointB = do sof <- atSof if sof then pointB else do p <- pointB return $ Point (fromPoint p - 1) -- | Reads in word at point. readCurrentWordB :: BufferM YiString readCurrentWordB = readUnitB unitWord -- | Reads in word before point. readPrevWordB :: BufferM YiString readPrevWordB = readPrevUnitB unitViWordOnLine ------------------------- -- Deletes -- | Delete one character backward bdeleteB :: BufferM () bdeleteB = deleteB Character Backward -- | Delete forward whitespace or non-whitespace depending on -- the character under point. killWordB :: BufferM () killWordB = deleteB unitWord Forward -- | Delete backward whitespace or non-whitespace depending on -- the character before point. bkillWordB :: BufferM () bkillWordB = deleteB unitWord Backward -- | Delete backward to the sof or the new line character bdeleteLineB :: BufferM () bdeleteLineB = atSol >>= \sol -> if sol then bdeleteB else deleteB Line Backward -- UnivArgument is in Yi.Keymap.Emacs.Utils but we can't import it due -- to cyclic imports. -- | emacs' @delete-horizontal-space@ with the optional argument. deleteHorizontalSpaceB :: Maybe Int -> BufferM () deleteHorizontalSpaceB u = do c <- curCol reg <- regionOfB Line text <- readRegionB reg let (r, jb) = deleteSpaces c text modifyRegionB (const r) reg -- Jump backwards to where the now-deleted spaces have started so -- it's consistent and feels natural instead of leaving us somewhere -- in the text. moveToColB $ c - jb where deleteSpaces :: Int -> R.YiString -> (R.YiString, Int) deleteSpaces c l = let (f, b) = R.splitAt c l f' = R.dropWhileEnd isSpace f cleaned = f' <> case u of Nothing -> R.dropWhile isSpace b Just _ -> b -- We only want to jump back the number of spaces before the -- point, not the total number of characters we're removing. in (cleaned, R.length f - R.length f') ---------------------------------------- -- Transform operations -- | capitalise the word under the cursor uppercaseWordB :: BufferM () uppercaseWordB = transformB (R.withText T.toUpper) unitWord Forward -- | lowerise word under the cursor lowercaseWordB :: BufferM () lowercaseWordB = transformB (R.withText T.toLower) unitWord Forward -- | capitalise the first letter of this word capitaliseWordB :: BufferM () capitaliseWordB = transformB capitalizeFirst unitWord Forward switchCaseChar :: Char -> Char switchCaseChar c = if isUpper c then toLower c else toUpper c -- | Delete to the end of line, excluding it. deleteToEol :: BufferM () deleteToEol = deleteRegionB =<< regionOfPartB Line Forward -- | Transpose two characters, (the Emacs C-t action) swapB :: BufferM () swapB = do eol <- atEol when eol leftB transposeB Character Forward -- | Delete trailing whitespace from all lines. Uses 'savingPositionB' -- to get back to where it was. deleteTrailingSpaceB :: BufferM () deleteTrailingSpaceB = regionOfB Document >>= savingPositionB . modifyRegionB (tru . mapLines stripEnd) where -- Strips the space from the end of each line, preserving -- newlines. stripEnd :: R.YiString -> R.YiString stripEnd x = case R.last x of Nothing -> x Just '\n' -> (`R.snoc` '\n') $ R.dropWhileEnd isSpace x _ -> R.dropWhileEnd isSpace x -- | Cut off trailing newlines, making sure to preserve one. tru :: R.YiString -> R.YiString tru x = if R.length x == 0 then x else (`R.snoc` '\n') $ R.dropWhileEnd (== '\n') x -- ---------------------------------------------------- -- | Marks -- | Set the current buffer selection mark setSelectionMarkPointB :: Point -> BufferM () setSelectionMarkPointB p = (.= p) . markPointA =<< selMark <$> askMarks -- | Get the current buffer selection mark getSelectionMarkPointB :: BufferM Point getSelectionMarkPointB = use . markPointA =<< selMark <$> askMarks -- | Exchange point & mark. exchangePointAndMarkB :: BufferM () exchangePointAndMarkB = do m <- getSelectionMarkPointB p <- pointB setSelectionMarkPointB p moveTo m getBookmarkB :: String -> BufferM Mark getBookmarkB = getMarkB . Just -- --------------------------------------------------------------------- -- Buffer operations data BufferFileInfo = BufferFileInfo { bufInfoFileName :: FilePath , bufInfoSize :: Int , bufInfoLineNo :: Int , bufInfoColNo :: Int , bufInfoCharNo :: Point , bufInfoPercent :: T.Text , bufInfoModified :: Bool } -- | File info, size in chars, line no, col num, char num, percent bufInfoB :: BufferM BufferFileInfo bufInfoB = do s <- sizeB p <- pointB m <- gets isUnchangedBuffer l <- curLn c <- curCol nm <- gets identString let bufInfo = BufferFileInfo { bufInfoFileName = T.unpack nm , bufInfoSize = fromIntegral s , bufInfoLineNo = l , bufInfoColNo = c , bufInfoCharNo = p , bufInfoPercent = getPercent p s , bufInfoModified = not m } return bufInfo ----------------------------- -- Window-related operations upScreensB :: Int -> BufferM () upScreensB = scrollScreensB . negate downScreensB :: Int -> BufferM () downScreensB = scrollScreensB -- | Scroll up 1 screen upScreenB :: BufferM () upScreenB = scrollScreensB (-1) -- | Scroll down 1 screen downScreenB :: BufferM () downScreenB = scrollScreensB 1 -- | Scroll by n screens (negative for up) scrollScreensB :: Int -> BufferM () scrollScreensB n = do h <- askWindow actualLines scrollB $ n * max 0 (h - 1) -- subtract some amount to get some overlap (emacs-like). -- | Same as scrollB, but also moves the cursor vimScrollB :: Int -> BufferM () vimScrollB n = do scrollB n void $ lineMoveRel n -- | Same as scrollByB, but also moves the cursor vimScrollByB :: (Int -> Int) -> Int -> BufferM () vimScrollByB f n = do h <- askWindow actualLines vimScrollB $ n * f h -- | Move to middle line in screen scrollToCursorB :: BufferM () scrollToCursorB = do MarkSet f i _ <- markLines h <- askWindow actualLines let m = f + (h `div` 2) scrollB $ i - m -- | Move cursor to the top of the screen scrollCursorToTopB :: BufferM () scrollCursorToTopB = do MarkSet f i _ <- markLines scrollB $ i - f -- | Move cursor to the bottom of the screen scrollCursorToBottomB :: BufferM () scrollCursorToBottomB = do MarkSet _ i _ <- markLines r <- winRegionB t <- lineOf (regionEnd r - 1) scrollB $ i - t -- | Scroll by n lines. scrollB :: Int -> BufferM () scrollB n = do MarkSet fr _ _ <- askMarks savingPointB $ do moveTo =<< use (markPointA fr) void $ gotoLnFrom n (markPointA fr .=) =<< pointB w <- askWindow wkey (%=) pointFollowsWindowA (\old w' -> ((w == w') || old w')) -- Scroll line above window to the bottom. scrollToLineAboveWindowB :: BufferM () scrollToLineAboveWindowB = do downFromTosB 0 replicateM_ 1 lineUp scrollCursorToBottomB -- Scroll line below window to the top. scrollToLineBelowWindowB :: BufferM () scrollToLineBelowWindowB = do upFromBosB 0 replicateM_ 1 lineDown scrollCursorToTopB -- | Move the point to inside the viewable region snapInsB :: BufferM () snapInsB = do movePoint <- use pointFollowsWindowA w <- askWindow wkey when (movePoint w) $ do r <- winRegionB p <- pointB moveTo $ max (regionStart r) $ min (regionEnd r) p -- | return index of Sol on line @n@ above current line indexOfSolAbove :: Int -> BufferM Point indexOfSolAbove n = pointAt $ gotoLnFrom (negate n) data RelPosition = Above | Below | Within deriving (Show) -- | return relative position of the point @p@ -- relative to the region defined by the points @rs@ and @re@ pointScreenRelPosition :: Point -> Point -> Point -> RelPosition pointScreenRelPosition p rs re | rs > p && p > re = Within | p < rs = Above | p > re = Below pointScreenRelPosition _ _ _ = Within -- just to disable the non-exhaustive pattern match warning -- | Move the visible region to include the point snapScreenB :: Maybe ScrollStyle ->BufferM Bool snapScreenB style = do movePoint <- use pointFollowsWindowA w <- askWindow wkey if movePoint w then return False else do inWin <- pointInWindowB =<< pointB if inWin then return False else do h <- askWindow actualLines r <- winRegionB p <- pointB let gap = case style of Just SingleLine -> case pointScreenRelPosition p (regionStart r) (regionEnd r) of Above -> 0 Below -> h - 1 Within -> 0 -- Impossible but handle it anyway _ -> h `div` 2 i <- indexOfSolAbove gap f <- fromMark <$> askMarks markPointA f .= i return True -- | Move to @n@ lines down from top of screen downFromTosB :: Int -> BufferM () downFromTosB n = do moveTo =<< use . markPointA =<< fromMark <$> askMarks replicateM_ n lineDown -- | Move to @n@ lines up from the bottom of the screen upFromBosB :: Int -> BufferM () upFromBosB n = do r <- winRegionB moveTo (regionEnd r - 1) moveToSol replicateM_ n lineUp -- | Move to middle line in screen middleB :: BufferM () middleB = do w <- ask f <- fromMark <$> askMarks moveTo =<< use (markPointA f) replicateM_ (actualLines w `div` 2) lineDown pointInWindowB :: Point -> BufferM Bool pointInWindowB p = nearRegion p <$> winRegionB ----------------------------- -- Region-related operations -- | Return the region between point and mark getRawestSelectRegionB :: BufferM Region getRawestSelectRegionB = do m <- getSelectionMarkPointB p <- pointB return $ mkRegion p m -- | Return the empty region if the selection is not visible. getRawSelectRegionB :: BufferM Region getRawSelectRegionB = do s <- use highlightSelectionA if s then getRawestSelectRegionB else do p <- pointB return $ mkRegion p p -- | Get the current region boundaries. Extended to the current selection unit. getSelectRegionB :: BufferM Region getSelectRegionB = do regionStyle <- getRegionStyle r <- getRawSelectRegionB convertRegionToStyleB r regionStyle -- | Select the given region: set the selection mark at the 'regionStart' -- and the current point at the 'regionEnd'. setSelectRegionB :: Region -> BufferM () setSelectRegionB region = do assign highlightSelectionA True setSelectionMarkPointB $ regionStart region moveTo $ regionEnd region ------------------------------------------ -- Some line related movements/operations deleteBlankLinesB :: BufferM () deleteBlankLinesB = do isThisBlank <- isBlank <$> readLnB when isThisBlank $ do p <- pointB -- go up to the 1st blank line in the group void $ whileB (R.null <$> getNextLineB Backward) lineUp q <- pointB -- delete the whole blank region. deleteRegionB $ mkRegion p q -- | Get a (lazy) stream of lines in the buffer, starting at the /next/ line -- in the given direction. lineStreamB :: Direction -> BufferM [YiString] lineStreamB dir = fmap rev . R.lines <$> (streamB dir =<< pointB) where rev = case dir of Forward -> id Backward -> R.reverse -- | Get the next line of text in the given direction. This returns -- simply 'Nothing' if there no such line. getMaybeNextLineB :: Direction -> BufferM (Maybe YiString) getMaybeNextLineB dir = listToMaybe <$> lineStreamB dir -- | The same as 'getMaybeNextLineB' but avoids the use of the 'Maybe' -- type in the return by returning the empty string if there is no -- next line. getNextLineB :: Direction -> BufferM YiString getNextLineB dir = fromMaybe R.empty <$> getMaybeNextLineB dir -- | Get closest line to the current line (not including the current -- line) in the given direction which satisfies the given condition. -- Returns 'Nothing' if there is no line which satisfies the -- condition. getNextLineWhichB :: Direction -> (YiString -> Bool) -> BufferM (Maybe YiString) getNextLineWhichB dir cond = listToMaybe . filter cond <$> lineStreamB dir -- | Returns the closest line to the current line which is non-blank, -- in the given direction. Returns the empty string if there is no -- such line (for example if we are on the top line already). getNextNonBlankLineB :: Direction -> BufferM YiString getNextNonBlankLineB dir = fromMaybe R.empty <$> getNextLineWhichB dir (not . R.null) ------------------------------------------------ -- Some more utility functions involving -- regions (generally that which is selected) modifyExtendedSelectionB :: TextUnit -> (R.YiString -> R.YiString) -> BufferM () modifyExtendedSelectionB unit transform = modifyRegionB transform =<< unitWiseRegion unit =<< getSelectRegionB -- | Prefix each line in the selection using the given string. linePrefixSelectionB :: R.YiString -- ^ The string that starts a line comment -> BufferM () linePrefixSelectionB s = modifyExtendedSelectionB Line . overInit $ mapLines (s <>) -- | Uncomments the selection using the given line comment -- starting string. This only works for the comments which -- begin at the start of the line. unLineCommentSelectionB :: R.YiString -- ^ The string which begins a -- line comment -> R.YiString -- ^ A potentially shorter -- string that begins a comment -> BufferM () unLineCommentSelectionB s1 s2 = modifyExtendedSelectionB Line $ mapLines unCommentLine where (l1, l2) = (R.length s1, R.length s2) unCommentLine :: R.YiString -> R.YiString unCommentLine line = case (R.splitAt l1 line, R.splitAt l2 line) of ((f, s) , (f', s')) | s1 == f -> s | s2 == f' -> s' | otherwise -> line -- | Just like 'toggleCommentSelectionB' but automatically inserts a -- whitespace suffix to the inserted comment string. In fact: toggleCommentB :: R.YiString -> BufferM () toggleCommentB c = toggleCommentSelectionB (c `R.snoc` ' ') c -- | Toggle line comments in the selection by adding or removing a -- prefix to each line. toggleCommentSelectionB :: R.YiString -> R.YiString -> BufferM () toggleCommentSelectionB insPrefix delPrefix = do l <- readUnitB Line if delPrefix == R.take (R.length delPrefix) l then unLineCommentSelectionB insPrefix delPrefix else linePrefixSelectionB insPrefix -- | Replace the contents of the buffer with some string replaceBufferContent :: YiString -> BufferM () replaceBufferContent newvalue = do r <- regionOfB Document replaceRegionB r newvalue -- | Fill the text in the region so it fits nicely 80 columns. fillRegion :: Region -> BufferM () fillRegion = modifyRegionB (R.unlines . fillText 80) fillParagraph :: BufferM () fillParagraph = fillRegion =<< regionOfB unitParagraph -- | Sort the lines of the region. 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 r <- regionOfB Document replaceRegionB r s encodingConverterNameA .= cn markSavedB now -- get lengths of parts covered by block region -- -- Consider block region starting at 'o' and ending at 'z': -- -- start -- | -- \|/ -- def foo(bar): -- baz -- -- ab -- xyz0 -- /|\ -- | -- finish -- -- shapeOfBlockRegionB returns (regionStart, [2, 2, 0, 1, 2]) -- TODO: accept stickToEol flag shapeOfBlockRegionB :: Region -> BufferM (Point, [Int]) shapeOfBlockRegionB reg = savingPointB $ do (l0, c0) <- getLineAndColOfPoint $ regionStart reg (l1, c1) <- getLineAndColOfPoint $ regionEnd reg let (left, top, bottom, right) = (min c0 c1, min l0 l1, max l0 l1, max c0 c1) lengths <- forM [top .. bottom] $ \l -> do void $ gotoLn l moveToColB left currentLeft <- curCol if currentLeft /= left then return 0 else do moveToColB right rightAtEol <- atEol leftOnEol currentRight <- curCol return $ if currentRight == 0 && rightAtEol then 0 else currentRight - currentLeft + 1 startingPoint <- pointOfLineColB top left return (startingPoint, lengths) leftEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point] leftEdgesOfRegionB Block reg = savingPointB $ do (l0, _) <- getLineAndColOfPoint $ regionStart reg (l1, _) <- getLineAndColOfPoint $ regionEnd reg moveTo $ regionStart reg fmap catMaybes $ forM [0 .. abs (l0 - l1)] $ \i -> savingPointB $ do void $ lineMoveRel i p <- pointB eol <- atEol return (if not eol then Just p else Nothing) leftEdgesOfRegionB LineWise reg = savingPointB $ do lastSol <- do moveTo $ regionEnd reg moveToSol pointB let go acc p = do moveTo p moveToSol edge <- pointB if edge >= lastSol then return $ reverse (edge:acc) else do void $ lineMoveRel 1 go (edge:acc) =<< pointB go [] (regionStart reg) leftEdgesOfRegionB _ r = return [regionStart r] rightEdgesOfRegionB :: RegionStyle -> Region -> BufferM [Point] rightEdgesOfRegionB Block reg = savingPointB $ do (l0, _) <- getLineAndColOfPoint $ regionStart reg (l1, _) <- getLineAndColOfPoint $ regionEnd reg moveTo $ 1 + regionEnd reg fmap reverse $ forM [0 .. abs (l0 - l1)] $ \i -> savingPointB $ do void $ lineMoveRel $ -i pointB rightEdgesOfRegionB LineWise reg = savingPointB $ do lastEol <- do moveTo $ regionEnd reg moveToEol pointB let go acc p = do moveTo p moveToEol edge <- pointB if edge >= lastEol then return $ reverse (edge:acc) else do void $ lineMoveRel 1 go (edge:acc) =<< pointB go [] (regionStart reg) rightEdgesOfRegionB _ reg = savingPointB $ do moveTo $ regionEnd reg leftOnEol fmap return pointB splitBlockRegionToContiguousSubRegionsB :: Region -> BufferM [Region] splitBlockRegionToContiguousSubRegionsB reg = savingPointB $ do (start, lengths) <- shapeOfBlockRegionB reg moveTo start forM lengths $ \l -> do p0 <- pointB moveXorEol l p1 <- pointB let subRegion = mkRegion p0 p1 moveTo p0 void $ lineMoveRel 1 return subRegion deleteRegionWithStyleB :: Region -> RegionStyle -> BufferM Point deleteRegionWithStyleB reg Block = savingPointB $ do (start, lengths) <- shapeOfBlockRegionB reg moveTo start forM_ (zip [1..] lengths) $ \(i, l) -> do deleteN l moveTo start lineMoveRel i return start deleteRegionWithStyleB reg style = savingPointB $ do effectiveRegion <- convertRegionToStyleB reg style deleteRegionB effectiveRegion return $! regionStart effectiveRegion readRegionRopeWithStyleB :: Region -> RegionStyle -> BufferM YiString readRegionRopeWithStyleB reg Block = savingPointB $ do (start, lengths) <- shapeOfBlockRegionB reg moveTo start chunks <- forM lengths $ \l -> if l == 0 then lineMoveRel 1 >> return mempty else do p <- pointB r <- readRegionB $ mkRegion p (p +~ Size l) void $ lineMoveRel 1 return r return $ R.intersperse '\n' chunks readRegionRopeWithStyleB reg style = readRegionB =<< convertRegionToStyleB reg style insertRopeWithStyleB :: YiString -> RegionStyle -> BufferM () insertRopeWithStyleB rope Block = savingPointB $ do let ls = R.lines rope advanceLine = atLastLine >>= \case False -> void $ lineMoveRel 1 True -> do col <- curCol moveToEol newlineB insertN $ R.replicateChar col ' ' sequence_ $ intersperse advanceLine $ fmap (savingPointB . insertN) ls insertRopeWithStyleB rope LineWise = do moveToSol savingPointB $ insertN rope insertRopeWithStyleB rope _ = insertN rope -- consider the following buffer content -- -- 123456789 -- qwertyuio -- asdfgh -- -- The following examples use characters from that buffer as points. -- h' denotes the newline after h -- -- 1 r -> 4 q -- 9 q -> 1 o -- q h -> y a -- a o -> h' q -- o a -> q h' -- 1 a -> 1 a -- -- property: fmap swap (flipRectangleB a b) = flipRectangleB b a flipRectangleB :: Point -> Point -> BufferM (Point, Point) flipRectangleB p0 p1 = savingPointB $ do (_, c0) <- getLineAndColOfPoint p0 (_, c1) <- getLineAndColOfPoint p1 case compare c0 c1 of EQ -> return (p0, p1) GT -> swap <$> flipRectangleB p1 p0 LT -> do -- now we know that c0 < c1 moveTo p0 moveXorEol $ c1 - c0 flippedP0 <- pointB return (flippedP0, p1 -~ Size (c1 - c0)) movePercentageFileB :: Int -> BufferM () movePercentageFileB i = do let f :: Double f = case fromIntegral i / 100.0 of x | x > 1.0 -> 1.0 | x < 0.0 -> 0.0 -- Impossible? | otherwise -> x lineCount <- lineCountB void $ gotoLn $ floor (fromIntegral lineCount * f) firstNonSpaceB findMatchingPairB :: BufferM () findMatchingPairB = do let go dir a b = goUnmatchedB dir a b >> return True goToMatch = do c <- readB case c of '(' -> go Forward '(' ')' ')' -> go Backward '(' ')' '{' -> go Forward '{' '}' '}' -> go Backward '{' '}' '[' -> go Forward '[' ']' ']' -> go Backward '[' ']' _ -> otherChar otherChar = do eof <- atEof eol <- atEol if eof || eol then return False else rightB >> goToMatch p <- pointB foundMatch <- goToMatch unless foundMatch $ moveTo p -- Vim numbers -- | Increase (or decrease if negative) next number on line by n. incrementNextNumberByB :: Int -> BufferM () incrementNextNumberByB n = do start <- pointB untilB_ (not <$> isNumberB) $ moveXorSol 1 untilB_ isNumberB $ moveXorEol 1 begin <- pointB beginIsEol <- atEol untilB_ (not <$> isNumberB) $ moveXorEol 1 end <- pointB if beginIsEol then moveTo start else do modifyRegionB (increment n) (mkRegion begin end) moveXorSol 1 -- | Increment number in string by n. increment :: Int -> R.YiString -> R.YiString increment n l = R.fromString $ go (R.toString l) where 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 isNumberB = do eol <- atEol sol <- atSol if sol then isDigit <$> readB else if eol then return False else test3CharB -- | Used by isNumber to test if current character under cursor is a number. test3CharB :: BufferM Bool test3CharB = do moveXorSol 1 previous <- readB moveXorEol 2 next <- readB moveXorSol 1 current <- readB if | previous == '0' && current == 'o' && isOctDigit next -> return True -- octal format | previous == '0' && current == 'x' && isHexDigit next -> return True -- hex format | current == '-' && isDigit next -> return True -- negative numbers | isDigit current -> return True -- all decimal digits | isHexDigit current -> testHexB -- ['a'..'f'] for hex | otherwise -> return False -- | Characters ['a'..'f'] are part of a hex number only if preceded by 0x. -- Test if the current occurence of ['a'..'f'] is part of a hex number. testHexB :: BufferM Bool testHexB = savingPointB $ do untilB_ (not . isHexDigit <$> readB) (moveXorSol 1) leftChar <- readB moveXorSol 1 leftToLeftChar <- readB if leftChar == 'x' && leftToLeftChar == '0' then return True else return False -- | Move point down by @n@ lines -- If line extends past width of window, count moving -- a single line as moving width points to the right. lineMoveVisRel :: Int -> BufferM () lineMoveVisRel = movingToPrefVisCol . lineMoveVisRelUp lineMoveVisRelUp :: Int -> BufferM () lineMoveVisRelUp 0 = return () lineMoveVisRelUp n | n < 0 = lineMoveVisRelDown $ negate n | otherwise = do wid <- width <$> use lastActiveWindowA col <- curCol len <- pointB >>= eolPointB >>= colOf let jumps = (len `div` wid) - (col `div` wid) next = n - jumps if next <= 0 then moveXorEol (n * wid) else do moveXorEol (jumps * wid) void $ gotoLnFrom 1 lineMoveVisRelUp $ next - 1 lineMoveVisRelDown :: Int -> BufferM () lineMoveVisRelDown 0 = return () lineMoveVisRelDown n | n < 0 = lineMoveVisRelUp $ negate n | otherwise = do wid <- width <$> use lastActiveWindowA col <- curCol let jumps = col `div` wid next = n - jumps if next <= 0 then leftN (n * wid) else do leftN (jumps * wid) void $ gotoLnFrom $ -1 moveToEol lineMoveVisRelDown $ next - 1 -- | Implements the same logic that emacs' `mark-word` does. -- Checks the mark point and moves it forth (or backward) for one word. markWord :: BufferM () markWord = do curPos <- pointB curMark <- getSelectionMarkPointB isVisible <- getVisibleSelection savingPointB $ do if not isVisible then nextWordB else do moveTo curMark if curMark < curPos then prevWordB else nextWordB setVisibleSelection True pointB >>= setSelectionMarkPointB yi-0.12.6/src/library/Yi/Buffer/Indent.hs0000644000000000000000000003507612717763531016240 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Buffer.Region -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Handles indentation in the keymaps. Includes: -- -- * (TODO) Auto-indentation to the previous lines indentation -- * Tab-expansion -- * Shifting of the indentation for a region of text module Yi.Buffer.Indent ( autoIndentB , cycleIndentsB , indentAsNextB , indentAsPreviousB , indentAsTheMostIndentedNeighborLineB , indentOfB , indentOfCurrentPosB , indentSettingsB , indentToB , modifyIndentB , newlineAndIndentB , shiftIndentOfRegionB , tabB ) where import Control.Applicative ((<$>)) import Control.Monad () import Data.Char (isSpace) import Data.List (nub, sort) import Data.Monoid ((<>)) import Yi.Buffer.Basic (Direction (..)) import Yi.Buffer.HighLevel (firstNonSpaceB, getNextLineB, getNextNonBlankLineB, moveToSol, readLnB) import Yi.Buffer.Misc import Yi.Buffer.Normal () import Yi.Buffer.Region (Region (regionStart), mkRegion, modifyRegionB, readRegionB) import Yi.Buffer.TextUnit (regionWithTwoMovesB) import Yi.Rope (YiString) import qualified Yi.Rope as R import Yi.String (mapLines) {- | Return either a \t or the number of spaces specified by tabSize in the IndentSettings. Note that if you actually want to insert a tab character (for example when editing makefiles) then you should use: @insertB '\t'@. -} tabB :: BufferM String tabB = do indentSettings <- indentSettingsB return $ if expandTabs indentSettings then replicate (tabSize indentSettings) ' ' else "\t" {-| A specialisation of 'autoIndentHelperB'. This is the most basic and the user is encouraged to specialise 'autoIndentHelperB' on their own. -} autoIndentB :: IndentBehaviour -> BufferM () autoIndentB = autoIndentHelperB fetchPreviousIndentsB indentsOfString where -- Returns the indentation hints considering the given -- string as the line above the current one. -- The hints added are: -- The indent of the given string -- The indent of the given string plus two -- The offset of the last open bracket if any in the line. indentsOfString :: YiString -> BufferM [Int] indentsOfString input = do indent <- indentOfB input bracketHints <- lastOpenBracketHint input indentSettings <- indentSettingsB return $ indent : (indent + shiftWidth indentSettings) : bracketHints {-| This takes two arguments the first is a function to obtain indentation hints from lines above the current one. The second is a function to obtain a set of indentation hints from the previous line. Both of these are in the 'BufferM' monad although the second seems like it is unnecessary. However we must take into account the length of tabs which come from the the tab settings and hence we must be in the 'BufferM' monad. To get the straightforward behaviour of the indents of all previous lines until one of them has zero indent call this with: @autoIndentHelperB fetchPreviousIndentsB (fmap (: []) indentOfB)@ However commonly we wish to have something more interesting for the second argument, in particular we commonly wish to have the last opening bracket of the previous line as well as its indent. -} autoIndentHelperB :: BufferM [ Int ] -- ^ Action to fetch hints from previous lines -> (YiString -> BufferM [ Int ]) -- ^ Action to calculate hints from previous line -> IndentBehaviour -- ^ Sets the indent behaviour, -- see 'Yi.Buffer.IndentBehaviour' for a description -> BufferM () autoIndentHelperB getUpwards getPrevious indentBehave = do upwardHints <- savingExcursionB getUpwards previousLine <- getNextLineB Backward previousHints <- getPrevious previousLine let allHints = upwardHints ++ previousHints cycleIndentsB indentBehave allHints -- | Cycles through the indentation hints. It does this without -- requiring to set/get any state. We just look at the current -- indentation of the current line and moving to the largest -- indent that is cycleIndentsB :: IndentBehaviour -> [Int] -> BufferM () cycleIndentsB _ [] = return () cycleIndentsB indentBehave indents = do currentLine <- readLnB currentIndent <- indentOfB currentLine indentToB $ chooseIndent currentIndent (sort $ nub indents) where -- Is the function to choose the indent from the given current -- indent to the given list of indentation hints. chooseIndent :: Int -> [ Int ] -> Int chooseIndent = case indentBehave of IncreaseCycle -> chooseIncreaseCycle DecreaseCycle -> chooseDecreaseCycle IncreaseOnly -> chooseIncreaseOnly DecreaseOnly -> chooseDecreaseOnly -- Choose the indentation hint which is one more than the current -- indentation hint unless the current is the largest or larger than -- all the indentation hints in which case choose the smallest -- (which will often be zero) chooseIncreaseCycle :: Int -> [ Int ] -> Int chooseIncreaseCycle currentIndent hints = -- Similarly to 'chooseDecreasing' if 'above' is null then -- we will go to the first of below which will be the smallest -- indentation hint, if above is not null then we are moving to -- the indentation hint which is one above the current. head (above ++ below) where (below, above) = span (<= currentIndent) hints -- Note that these functions which follow generally assume that -- the list of hints which have been given is already sorted -- and that the list is non-empty -- Choose the indentation hint one less than the current indentation -- unless the current indentation is the smallest (usually zero) -- in which case choose the largest indentation hint. chooseDecreaseCycle :: Int -> [ Int ] -> Int chooseDecreaseCycle currentIndent hints = -- So in particular if 'below' is null then we will -- go to the largest indentation, if below is not null -- we go to the largest indentation which is *not* higher -- than the current one. last (above ++ below) where (below, above) = span (< currentIndent) hints chooseIncreaseOnly :: Int -> [ Int ] -> Int chooseIncreaseOnly currentIndent hints = head $ filter (> currentIndent) hints ++ [ currentIndent ] chooseDecreaseOnly :: Int -> [ Int ] -> Int chooseDecreaseOnly currentIndent hints = last $ currentIndent : filter (< currentIndent) hints {-| A function generally useful as the first argument to 'autoIndentHelperB'. This searches the lines above the current line for the indentations of each line until we get to a line which has no indentation *and* is not empty. Indicating that we have reached the outer scope. -} fetchPreviousIndentsB :: BufferM [Int] fetchPreviousIndentsB = do -- Move up one line, moveOffset <- lineMoveRel (-1) line <- readLnB indent <- indentOfB line -- So if we didn't manage to move upwards -- or the current offset was zero *and* the line -- was non-blank then we return just the current -- indent (it might be the first line but indented some.) if moveOffset == 0 || (indent == 0 && R.any (not . isSpace) line) then return [ indent ] else (indent :) <$> fetchPreviousIndentsB -- | Returns the position of the last opening bracket on the -- line which is not closed on the same line. -- Note that if we have unmatched parentheses such as "( ]" -- then we may not get the correct answer, but in that case -- then arguably we don't really care if we get the correct -- answer (at least if we get it wrong the user may notice -- their error). -- We return a list here as it's a convenient way of returning -- no hint in the case of there being no non-closed bracket -- and normally such a hint will be part of a list of hints -- anyway. -- NOTE: this could be easily modified to return the indentations -- of *all* the non-closed opening brackets. But I think this is -- not what you generally want. -- TODO: we also do not care whether or not the bracket is within -- a string or escaped. If someone feels up to caring about that -- by all means please fix this. lastOpenBracketHint :: YiString -> BufferM [ Int ] lastOpenBracketHint input = case getOpen 0 $ R.reverse input of Nothing -> return [] Just s -> return <$> spacingOfB s where -- We get the last open bracket by counting through -- the reversed line, when we see a closed bracket we -- add one to the count. When we see an opening bracket -- decrease the count. If we see an opening bracket when the -- count is 0 we return the remaining (reversed) string -- as the part of the line which preceds the last opening bracket. -- This can then be turned into an indentation by calling 'spacingOfB' -- on it so that tabs are counted as tab length. -- NOTE: that this will work even if tab occur in the middle of the line getOpen :: Int -> YiString -> Maybe YiString getOpen i s = let rest = R.drop 1 s in case R.head s of Nothing -> Nothing Just c -- If it is opening and we have no closing to match -- then we return the rest of the line | isOpening c && i == 0 -> Just rest -- If i is not zero then we have matched one of the -- closing parentheses and we can decrease the nesting count. | isOpening c -> getOpen (i - 1) rest -- If the character is a closing bracket then we must increase -- the nesting count | isClosing c -> getOpen (i + 1) rest -- If it is just a normal character forget about it and move on. | otherwise -> getOpen i rest isOpening :: Char -> Bool isOpening '(' = True isOpening '[' = True isOpening '{' = True isOpening _ = False isClosing :: Char -> Bool isClosing ')' = True isClosing ']' = True isClosing '}' = True isClosing _ = False -- | Returns the indentation of a given string. Note that this depends -- 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 spacingOfB text = do indentSettings <- indentSettingsB return $ countIndent indentSettings text {-| Indents the current line to the given indentation level. In addition moves the point according to where it was on the line originally. If we were somewhere within the indentation (ie at the start of the line or on an empty line) then we want to just go to the end of the (new) indentation. However if we are currently pointing somewhere within the text of the line then we wish to remain pointing to the same character. -} indentToB :: Int -> BufferM () 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 () indentAsPreviousB = indentAsNeighborLineB Backward -- | Indent as much as the next line indentAsNextB :: BufferM () indentAsNextB = indentAsNeighborLineB Forward indentAsTheMostIndentedNeighborLineB :: BufferM () indentAsTheMostIndentedNeighborLineB = do prevLine <- getNextNonBlankLineB Backward nextLine <- getNextNonBlankLineB Forward prevIndent <- indentOfB prevLine nextIndent <- indentOfB nextLine indentToB (max prevIndent nextIndent) indentAsNeighborLineB :: Direction -> BufferM () indentAsNeighborLineB dir = do otherLine <- getNextNonBlankLineB dir otherIndent <- indentOfB otherLine indentToB otherIndent -- | Insert a newline at point and indent the new line as the previous one. newlineAndIndentB :: BufferM () newlineAndIndentB = newlineB >> indentAsPreviousB -- | Set the padding of the string to newCount, filling in tabs if -- expandTabs is set in the buffers IndentSettings rePadString :: IndentSettings -> Int -> R.YiString -> R.YiString rePadString indentSettings newCount input | newCount <= 0 = rest | expandTabs indentSettings = R.replicateChar newCount ' ' <> rest | otherwise = tabs <> spaces <> rest where (_indents,rest) = R.span isSpace input tabs = R.replicateChar (newCount `div` tabSize indentSettings) '\t' spaces = R.replicateChar (newCount `mod` tabSize indentSettings) ' ' -- | Counts the size of the indent in the given text. -- -- Assumes nothing but tabs and spaces: uses 'isSpace'. countIndent :: IndentSettings -> R.YiString -> Int countIndent i t = R.foldl' (\i' c -> i' + spacing c) 0 indents where (indents, _) = R.span isSpace t spacing '\t' = tabSize i spacing _ = 1 -- | shifts right (or left if num is negative) num times, filling in tabs if -- expandTabs is set in the buffers IndentSettings indentString :: IndentSettings -> Int -> R.YiString -> R.YiString indentString is numOfShifts i = rePadString is newCount i where newCount = countIndent is i + (shiftWidth is * numOfShifts) -- | Increases the indentation on the region by the given amount of shiftWidth shiftIndentOfRegionB :: Int -> Region -> BufferM () shiftIndentOfRegionB shiftCount region = do is <- indentSettingsB let indentFn :: R.YiString -> R.YiString indentFn line = if not (R.null line) && line /= "\n" then indentString is shiftCount line else line modifyRegionB (mapLines indentFn) region moveTo $ regionStart region firstNonSpaceB -- | Return the number of spaces at the beginning of the line, up to -- the point. indentOfCurrentPosB :: BufferM Int indentOfCurrentPosB = do p <- pointB moveToSol sol <- pointB moveTo p let region = mkRegion p sol readRegionB region >>= spacingOfB yi-0.12.6/src/library/Yi/Buffer/Normal.hs0000644000000000000000000001021312717763531016231 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | A normalized API to many buffer operations. -- The idea is that most operations should be parametric in both -- * the textual units they work on -- * the direction towards which they operate (if applicable) module Yi.Buffer.Normal ( TextUnit(Character, Line, VLine, Document, GenUnit) , isAnySep , isWordChar , leftBoundaryUnit , outsideUnit , unitDelimited , unitEmacsParagraph , unitParagraph , unitSentence , unitSep , unitSepThisLine , unitViWORD , unitViWORDAnyBnd , unitViWORDOnLine , unitViWord , unitViWordAnyBnd , unitViWordOnLine , unitWord -- TextUnit is exported abstract intentionally: -- we'd like to move more units to the GenUnit format. , atBoundaryB , deleteB , doIfCharB , doUntilB_ , genMaybeMoveB , genMoveB , maybeMoveB , moveB , numberOfB , readPrevUnitB , readUnitB , regionOfB , regionOfNonEmptyB , regionOfPartB , regionOfPartNonEmptyAtB , regionOfPartNonEmptyB , transformB , transposeB , untilB , untilB_ , whileB , BoundarySide(..) , checkPeekB , genAtBoundaryB , genEnclosingUnit , genUnitBoundary , RegionStyle(..) , convertRegionToStyleB , extendRegionToBoundaries , getRegionStyle , mkRegionOfStyleB , putRegionStyle , unitWiseRegion ) where import Data.List (sort) import Yi.Buffer.Basic (Direction (Backward, Forward), Point) import Yi.Buffer.Misc (BufferM, getBufferDyn, moveTo, pointB, putBufferDyn, savingPointB) import Yi.Buffer.Region (Region (..), inclusiveRegionB, mkRegion, mkRegion') import Yi.Buffer.TextUnit import Yi.Types (RegionStyle (..)) getRegionStyle :: BufferM RegionStyle getRegionStyle = getBufferDyn putRegionStyle :: RegionStyle -> BufferM () putRegionStyle = putBufferDyn convertRegionToStyleB :: Region -> RegionStyle -> BufferM Region convertRegionToStyleB r = mkRegionOfStyleB (regionStart r) (regionEnd r) mkRegionOfStyleB :: Point -> Point -> RegionStyle -> BufferM Region mkRegionOfStyleB start' stop' regionStyle = let [start, stop] = sort [start', stop'] region = mkRegion start stop in case regionStyle of LineWise -> inclusiveRegionB =<< unitWiseRegion Line region Inclusive -> inclusiveRegionB region Exclusive -> return region Block -> return region unitWiseRegion :: TextUnit -> Region -> BufferM Region unitWiseRegion unit = extendRegionToBoundaries unit InsideBound OutsideBound -- | Extend the given region to boundaries of the text unit. -- For instance one can extend the selection to complete lines, or -- paragraphs. extendRegionToBoundaries :: TextUnit -> BoundarySide -> BoundarySide -> Region -> BufferM Region extendRegionToBoundaries unit bs1 bs2 region = savingPointB $ do moveTo $ regionStart region genMaybeMoveB unit (Backward, bs1) Backward start <- pointB moveTo $ regionEnd region genMaybeMoveB unit (Forward, bs2) Forward stop <- pointB return $ mkRegion' (regionDirection region) start stop yi-0.12.6/src/library/Yi/Buffer/Misc.hs0000644000000000000000000010750312720302155015666 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Buffer.Misc -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- The 'Buffer' module defines monadic editing operations over one-dimensional -- buffers, maintaining a current /point/. module Yi.Buffer.Misc ( FBuffer (FBuffer, bmode) , BufferM (..) , WinMarks, MarkSet (..) , bkey , getMarks , runBuffer , runBufferFull , runBufferDummyWindow , screenTopLn , screenMidLn , screenBotLn , curLn , curCol , colOf , lineOf , lineCountB , sizeB , pointB , pointOfLineColB , solPointB , eolPointB , markLines , moveTo , moveToColB , moveToLineColB , lineMoveRel , lineUp , lineDown , newB , MarkValue (..) , Overlay (overlayAnnotation, overlayBegin, overlayEnd, overlayOwner, overlayStyle) , mkOverlay , gotoLn , gotoLnFrom , leftB , rightB , moveN , leftN , rightN , insertN , insertNAt , insertB , deleteN , nelemsB , writeB , writeN , newlineB , deleteNAt , readB , elemsB , undosA , undoB , redoB , getMarkB , setMarkHereB , setNamedMarkHereB , mayGetMarkB , getMarkValueB , markPointA , modifyMarkB , newMarkB , deleteMarkB , getVisibleSelection , setVisibleSelection , isUnchangedBuffer , setAnyMode , setMode , setMode0 , modifyMode , regexRegionB , regexB , readAtB , getModeLine , getPercent , setInserting , savingPrefCol , forgetPreferCol , movingToPrefCol , movingToPrefVisCol , preferColA , markSavedB , retroactivelyAtSavePointB , addOverlayB , delOverlayB , delOverlaysOfOwnerB , getOverlaysOfOwnerB , isPointInsideOverlay , savingExcursionB , savingPointB , savingPositionB , pendingUpdatesA , highlightSelectionA , rectangleSelectionA , readOnlyA , insertingA , pointFollowsWindowA , revertPendingUpdatesB , askWindow , clearSyntax , focusSyntax , Mode (..) , modeNameA , modeAppliesA , modeHLA , modePrettifyA , modeKeymapA , modeIndentA , modeAdjustBlockA , modeFollowA , modeIndentSettingsA , modeToggleCommentSelectionA , modeGetStrokesA , modeOnLoadA , modeGotoDeclarationA , modeModeLineA , AnyMode (..) , IndentBehaviour (..) , IndentSettings (..) , expandTabsA , tabSizeA , shiftWidthA , modeAlwaysApplies , modeNeverApplies , emptyMode , withModeB , withMode0 , onMode , withSyntaxB , withSyntaxB' , keymapProcessA , strokesRangesB , streamB , indexedStreamB , askMarks , pointAt , SearchExp , lastActiveWindowA , putBufferDyn , getBufferDyn , shortIdentString , identString , miniIdentString , identA , directoryContentA , BufferId (..) , file , lastSyncTimeA , replaceCharB , replaceCharWithBelowB , replaceCharWithAboveB , insertCharWithBelowB , insertCharWithAboveB , pointAfterCursorB , destinationOfMoveB , withEveryLineB , startUpdateTransactionB , commitUpdateTransactionB , applyUpdate , betweenB , decreaseFontSize , increaseFontSize , indentSettingsB , fontsizeVariationA , encodingConverterNameA , stickyEolA ) where import Prelude hiding (foldr, mapM, notElem) import Control.Applicative (Applicative ((*>), (<*>), pure), (<$>)) import Control.Lens (Lens', assign, lens, use, uses, view, (%=), (%~), (.=), (^.)) import Control.Monad.RWS.Strict (Endo (Endo, appEndo), MonadReader (ask), MonadState, MonadWriter (tell), Monoid (mconcat, mempty), asks, gets, join, modify, replicateM_, runRWS, void, when, (<>)) import Data.Binary (Binary (..), Get) import Data.Char (ord) import Data.Default (Default (def)) import Data.DynamicState.Serializable (getDyn, putDyn) import Data.Foldable (Foldable (foldr), forM_, notElem) import qualified Data.Map as M (Map, empty, insert, lookup) import Data.Maybe (fromMaybe, isNothing) import qualified Data.Set as Set (Set) import qualified Data.Text as T (Text, concat, justifyRight, pack, snoc, unpack) import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8) import Data.Time (UTCTime (UTCTime)) import Data.Traversable (Traversable (mapM), forM) import Numeric (showHex) import System.FilePath (joinPath, splitPath) import Yi.Buffer.Basic (BufferRef, Point (..), Size (Size), WindowRef) import Yi.Buffer.Implementation import Yi.Buffer.Undo import Yi.Interact as I (P (End)) import Yi.Monad (getsAndModify) import Yi.Region (Region, mkRegion) import Yi.Rope (YiString) import qualified Yi.Rope as R import Yi.Syntax (ExtHL (ExtHL), Stroke, noHighlighter) import Yi.Types import Yi.Utils (SemiNum ((+~)), makeClassyWithSuffix, makeLensesWithSuffix) import Yi.Window (Window (width, wkey, actualLines), dummyWindow) -- In addition to Buffer's text, this manages (among others): -- * Log of updates mades -- * Undo makeClassyWithSuffix "A" ''Attributes instance HasAttributes FBuffer where attributesA = lens attributes (\(FBuffer f1 f2 _) a -> FBuffer f1 f2 a) -- | Gets a short identifier of a buffer. If we're given a 'MemBuffer' -- then just wraps the buffer name like so: @*name*@. If we're given a -- 'FileBuffer', it drops the the number of characters specified. -- -- >>> shortIdentString 3 (MemBuffer "hello") -- "*hello*" -- >>> shortIdentString 3 (FileBuffer "hello") -- "lo" shortIdentString :: Int -- ^ Number of characters to drop from FileBuffer names -> FBuffer -- ^ Buffer to work with -> T.Text shortIdentString dl b = case b ^. identA of MemBuffer bName -> "*" <> bName <> "*" FileBuffer fName -> T.pack . joinPath . drop dl $ splitPath fName -- | Gets the buffer's identifier string, emphasising the 'MemBuffer': -- -- >>> identString (MemBuffer "hello") -- "*hello*" -- >>> identString (FileBuffer "hello") -- "hello" identString :: FBuffer -> T.Text identString b = case b ^. identA of MemBuffer bName -> "*" <> bName <> "*" FileBuffer fName -> T.pack fName -- TODO: proper instance + de-orphan instance Show FBuffer where show b = Prelude.concat [ "Buffer #", show (bkey b) , " (", T.unpack (identString b), ")" ] miniIdentString :: FBuffer -> T.Text miniIdentString b = case b ^. identA of MemBuffer bufName -> bufName FileBuffer _ -> "MINIFILE:" -- unfortunately the dynamic stuff can't be read. instance Binary FBuffer where put (FBuffer binmode r attributes_) = let strippedRaw :: BufferImpl () strippedRaw = setSyntaxBI (modeHL emptyMode) r in do put binmode put strippedRaw put attributes_ get = FBuffer <$> get <*> getStripped <*> get where getStripped :: Get (BufferImpl ()) getStripped = get -- | update the syntax information (clear the dirty "flag") clearSyntax :: FBuffer -> FBuffer clearSyntax = modifyRawbuf updateSyntax queryRawbuf :: (forall syntax. BufferImpl syntax -> x) -> FBuffer -> x queryRawbuf f (FBuffer _ fb _) = f fb modifyRawbuf :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> FBuffer -> FBuffer modifyRawbuf f (FBuffer f1 f2 f3) = FBuffer f1 (f f2) f3 queryAndModifyRawbuf :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) -> FBuffer -> (FBuffer, x) queryAndModifyRawbuf f (FBuffer f1 f5 f3) = let (f5', x) = f f5 in (FBuffer f1 f5' f3, x) file :: FBuffer -> Maybe FilePath file b = case b ^. identA of FileBuffer f -> Just f MemBuffer _ -> Nothing highlightSelectionA :: Lens' FBuffer Bool highlightSelectionA = selectionStyleA . lens highlightSelection (\e x -> e { highlightSelection = x }) rectangleSelectionA :: Lens' FBuffer Bool rectangleSelectionA = selectionStyleA . lens rectangleSelection (\e x -> e { rectangleSelection = x }) -- | Just stores the mode name. instance Binary (Mode syntax) where put = put . E.encodeUtf8 . modeName get = do n <- E.decodeUtf8 <$> get return (emptyMode {modeName = n}) -- | Increases the font size in the buffer by specified number. What -- this number actually means depends on the front-end. increaseFontSize :: Int -> BufferM () increaseFontSize x = fontsizeVariationA %= \fs -> max 1 (fs + x) -- | Decreases the font size in the buffer by specified number. What -- this number actually means depends on the front-end. decreaseFontSize :: Int -> BufferM () decreaseFontSize x = fontsizeVariationA %= \fs -> max 1 (fs - x) -- | Given a buffer, and some information update the modeline -- -- N.B. the contents of modelines should be specified by user, and -- not hardcoded. getModeLine :: [T.Text] -> BufferM T.Text getModeLine prefix = withModeB (`modeModeLine` prefix) defaultModeLine :: [T.Text] -> BufferM T.Text defaultModeLine prefix = do col <- curCol pos <- pointB ln <- curLn p <- pointB s <- sizeB curChar <- readB ro <-use readOnlyA modeNm <- gets (withMode0 modeName) unchanged <- gets isUnchangedBuffer enc <- use encodingConverterNameA >>= return . \case Nothing -> mempty :: T.Text Just cn -> T.pack $ R.unCn cn let pct | pos == 0 || s == 0 = " Top" | pos == s = " Bot" | otherwise = getPercent p s changed = if unchanged then "-" else "*" readOnly' = if ro then "%" else changed hexxed = T.pack $ showHex (ord curChar) "" hexChar = "0x" <> T.justifyRight 2 '0' hexxed toT = T.pack . show nm <- gets $ shortIdentString (length prefix) return $ T.concat [ enc, " ", readOnly', changed, " ", nm , " ", hexChar, " " , "L", T.justifyRight 5 ' ' (toT ln) , " " , "C", T.justifyRight 3 ' ' (toT col) , " ", pct , " ", modeNm , " ", toT $ fromPoint p ] -- | Given a point, and the file size, gives us a percent string getPercent :: Point -> Point -> T.Text getPercent a b = T.justifyRight 3 ' ' (T.pack $ show p) `T.snoc` '%' where p = ceiling (aa / bb * 100.0 :: Double) :: Int aa = fromIntegral a :: Double bb = fromIntegral b :: Double queryBuffer :: (forall syntax. BufferImpl syntax -> x) -> BufferM x queryBuffer = gets . queryRawbuf modifyBuffer :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> BufferM () modifyBuffer = modify . modifyRawbuf queryAndModify :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) -> BufferM x queryAndModify = getsAndModify . queryAndModifyRawbuf -- | Adds an "overlay" to the buffer addOverlayB :: Overlay -> BufferM () addOverlayB ov = do 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 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) runBuffer w b f = let (a, _, b') = runBufferFull w b f in (a, b') getMarks :: Window -> BufferM (Maybe WinMarks) getMarks = gets . getMarksRaw getMarksRaw :: Window -> FBuffer -> Maybe WinMarks getMarksRaw w b = M.lookup (wkey w) (b ^. winMarksA) runBufferFull :: Window -> FBuffer -> BufferM a -> (a, [Update], FBuffer) runBufferFull w b f = let (a, b', updates) = runRWS (fromBufferM f') w b f' = do ms <- getMarks w when (isNothing ms) $ do -- this window has no marks for this buffer yet; have to create them. newMarkValues <- if wkey (b ^. lastActiveWindowA) == def then return -- no previous window, create some marks from scratch. MarkSet { insMark = MarkValue 0 Forward, selMark = MarkValue 0 Backward, -- sel fromMark = MarkValue 0 Backward } -- from else do Just mrks <- uses winMarksA (M.lookup $ wkey (b ^. lastActiveWindowA)) forM mrks getMarkValueB newMrks <- forM newMarkValues newMarkB winMarksA %= M.insert (wkey w) newMrks assign lastActiveWindowA w f in (a, updates, pendingUpdatesA %~ (++ fmap TextUpdate updates) $ b') getMarkValueRaw :: Mark -> FBuffer -> MarkValue getMarkValueRaw m = fromMaybe (MarkValue 0 Forward) . queryRawbuf (getMarkValueBI m) getMarkValueB :: Mark -> BufferM MarkValue getMarkValueB = gets . getMarkValueRaw newMarkB :: MarkValue -> BufferM Mark newMarkB v = queryAndModify $ newMarkBI v deleteMarkB :: Mark -> BufferM () deleteMarkB m = modifyBuffer $ deleteMarkValueBI m -- | 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 b = fst . runBuffer (dummyWindow $ bkey b) b -- | Mark the current point in the undo list as a saved state. markSavedB :: UTCTime -> BufferM () markSavedB t = do undosA %= setSavedFilePointU assign lastSyncTimeA t bkey :: FBuffer -> BufferRef bkey = view bkey__A isUnchangedBuffer :: FBuffer -> Bool isUnchangedBuffer = isAtSavedFilePointU . view undosA startUpdateTransactionB :: BufferM () startUpdateTransactionB = do transactionPresent <- use updateTransactionInFlightA if transactionPresent then error "Already started update transaction" else do undosA %= addChangeU InteractivePoint assign updateTransactionInFlightA True commitUpdateTransactionB :: BufferM () commitUpdateTransactionB = do transactionPresent <- use updateTransactionInFlightA if not transactionPresent then error "Not in update transaction" else do assign updateTransactionInFlightA False transacAccum <- use updateTransactionAccumA assign updateTransactionAccumA [] undosA %= (appEndo . mconcat) (Endo . addChangeU . AtomicChange <$> transacAccum) undosA %= addChangeU InteractivePoint undoRedo :: (forall syntax. Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update]))) -> BufferM () undoRedo f = do 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 = undoRedo undoU redoB :: BufferM () 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, -- rather than one. const2 :: t -> t1 -> t2 -> t const2 x _ _ = x -- | Mode applies function that always returns True. modeAlwaysApplies :: a -> b -> Bool modeAlwaysApplies = const2 True -- | Mode applies function that always returns False. modeNeverApplies :: a -> b -> Bool modeNeverApplies = const2 False emptyMode :: Mode syntax emptyMode = Mode { modeName = "empty", modeApplies = modeNeverApplies, modeHL = ExtHL noHighlighter, modePrettify = const $ return (), modeKeymap = id, modeIndent = \_ _ -> return (), modeAdjustBlock = \_ _ -> return (), modeFollow = const emptyAction, modeIndentSettings = IndentSettings { expandTabs = True , tabSize = 8 , shiftWidth = 4 }, modeToggleCommentSelection = Nothing, modeGetStrokes = \_ _ _ _ -> [], modeOnLoad = return (), modeGotoDeclaration = return (), modeModeLine = defaultModeLine } -- | Create buffer named @nm@ with contents @s@ newB :: BufferRef -> BufferId -> YiString -> FBuffer newB unique nm s = FBuffer { bmode = emptyMode , rawbuf = newBI s , attributes = Attributes { ident = nm , bkey__ = unique , undos = emptyU , preferCol = Nothing , preferVisCol = Nothing , stickyEol = False , bufferDynamic = mempty , pendingUpdates = [] , selectionStyle = SelectionStyle False False , keymapProcess = I.End , winMarks = M.empty , lastActiveWindow = dummyWindow unique , lastSyncTime = epoch , readOnly = False , directoryContent = False , inserting = True , pointFollowsWindow = const False , updateTransactionInFlight = False , updateTransactionAccum = [] , fontsizeVariation = 0 , encodingConverterName = Nothing } } epoch :: UTCTime epoch = UTCTime (toEnum 0) (toEnum 0) -- | Point of eof sizeB :: BufferM Point sizeB = queryBuffer sizeBI -- | Extract the current point pointB :: BufferM Point pointB = use . markPointA =<< getInsMark nelemsB :: Int -> Point -> BufferM YiString nelemsB n i = R.take n <$> streamB Forward i streamB :: Direction -> Point -> BufferM YiString streamB dir i = queryBuffer $ getStream dir i indexedStreamB :: Direction -> Point -> BufferM [(Point,Char)] indexedStreamB dir i = queryBuffer $ getIndexedStream dir i strokesRangesB :: Maybe SearchExp -> Region -> BufferM [[Stroke]] strokesRangesB regex r = do p <- pointB getStrokes <- withSyntaxB modeGetStrokes queryBuffer $ strokesRangesBI getStrokes regex r p ------------------------------------------------------------------------ -- Point based operations -- | Move point in buffer to the given index moveTo :: Point -> BufferM () moveTo x = do forgetPreferCol maxP <- sizeB let p = case () of _ | x < 0 -> Point 0 | x > maxP -> maxP | otherwise -> x (.= p) . markPointA =<< getInsMark ------------------------------------------------------------------------ setInserting :: Bool -> BufferM () setInserting = assign insertingA checkRO :: BufferM Bool checkRO = do ro <- use readOnlyA when ro (fail "Read Only Buffer") return ro applyUpdate :: Update -> BufferM () applyUpdate update = do ro <- checkRO valid <- queryBuffer (isValidUpdate update) when (not ro && valid) $ do forgetPreferCol let reversed = reverseUpdateI update modifyBuffer (applyUpdateI update) isTransacPresent <- use updateTransactionInFlightA if isTransacPresent then updateTransactionAccumA %= (reversed:) else undosA %= addChangeU (AtomicChange reversed) tell [update] -- otherwise, just ignore. -- | Revert all the pending updates; don't touch the point. revertPendingUpdatesB :: BufferM () revertPendingUpdatesB = do updates <- use pendingUpdatesA modifyBuffer (flip (foldr (\u bi -> applyUpdateI (reverseUpdateI u) bi)) [u | TextUpdate u <- updates]) -- | Write an element into the buffer at the current point. writeB :: Char -> BufferM () writeB c = do deleteN 1 insertB c -- | Write the list into the buffer at current point. writeN :: YiString -> BufferM () writeN cs = do off <- pointB deleteNAt Forward (R.length cs) off insertNAt cs off -- | Insert newline at current point. newlineB :: BufferM () newlineB = insertB '\n' ------------------------------------------------------------------------ -- | Insert given 'YiString' at specified point, extending size of the -- buffer. insertNAt :: YiString -> Point -> BufferM () insertNAt rope pnt = applyUpdate (Insert pnt Forward rope) -- | Insert the 'YiString' at current point, extending size of buffer insertN :: YiString -> BufferM () insertN cs = pointB >>= insertNAt cs -- | Insert the char at current point, extending size of buffer -- -- Implementation note: This just 'insertB's a 'R.singleton'. This -- seems sub-optimal because we should be able to do much better -- without spewing chunks of size 1 everywhere. This approach is -- necessary however so an 'Update' can be recorded. A possible -- improvement for space would be to have ‘yi-rope’ package optimise -- for appends with length 1. insertB :: Char -> BufferM () insertB = insertN . R.singleton ------------------------------------------------------------------------ -- | @deleteNAt n p@ deletes @n@ characters forwards from position @p@ deleteNAt :: Direction -> Int -> Point -> BufferM () deleteNAt _ 0 _ = return () deleteNAt dir n pos = do els <- R.take n <$> streamB Forward pos applyUpdate $ Delete pos dir els ------------------------------------------------------------------------ -- Line based editing -- | Return the current line number curLn :: BufferM Int curLn = do p <- pointB queryBuffer (lineAt p) -- | Top line of the screen screenTopLn :: BufferM Int screenTopLn = do p <- use . markPointA =<< fromMark <$> askMarks queryBuffer (lineAt p) -- | Middle line of the screen screenMidLn :: BufferM Int screenMidLn = (+) <$> screenTopLn <*> (div <$> screenLines <*> pure 2) -- | Bottom line of the screen screenBotLn :: BufferM Int screenBotLn = (+) <$> screenTopLn <*> screenLines -- | Amount of lines in the screen screenLines :: BufferM Int screenLines = pred <$> askWindow actualLines -- | Return line numbers of marks markLines :: BufferM (MarkSet Int) markLines = mapM getLn =<< askMarks where getLn m = use (markPointA m) >>= lineOf -- | Go to line number @n@. @n@ is indexed from 1. Returns the -- actual line we went to (which may be not be the requested line, -- if it was out of range) gotoLn :: Int -> BufferM Int gotoLn x = do moveTo 0 succ <$> gotoLnFrom (x - 1) --------------------------------------------------------------------- setMode0 :: forall syntax. Mode syntax -> FBuffer -> FBuffer setMode0 m (FBuffer _ rb at) = FBuffer m (setSyntaxBI (modeHL m) rb) at modifyMode0 :: (forall syntax. Mode syntax -> Mode syntax) -> FBuffer -> FBuffer modifyMode0 f (FBuffer m rb f3) = FBuffer m' (setSyntaxBI (modeHL m') rb) f3 where m' = f m -- | Set the mode setAnyMode :: AnyMode -> BufferM () setAnyMode (AnyMode m) = setMode m setMode :: Mode syntax -> BufferM () setMode m = do modify (setMode0 m) -- reset the keymap process so we use the one of the new mode. assign keymapProcessA I.End modeOnLoad m -- | Modify the mode modifyMode :: (forall syntax. Mode syntax -> Mode syntax) -> BufferM () modifyMode f = do modify (modifyMode0 f) -- reset the keymap process so we use the one of the new mode. assign keymapProcessA I.End onMode :: (forall syntax. Mode syntax -> Mode syntax) -> AnyMode -> AnyMode onMode f (AnyMode m) = AnyMode (f m) withMode0 :: (forall syntax. Mode syntax -> a) -> FBuffer -> a withMode0 f FBuffer {bmode = m} = f m withModeB :: (forall syntax. Mode syntax -> BufferM a) -> BufferM a withModeB = join . gets . withMode0 withSyntax0 :: (forall syntax. Mode syntax -> syntax -> a) -> WindowRef -> FBuffer -> a withSyntax0 f wk (FBuffer bm rb _attrs) = f bm (getAst wk rb) withSyntaxB :: (forall syntax. Mode syntax -> syntax -> a) -> BufferM a withSyntaxB f = withSyntax0 f <$> askWindow wkey <*> use id focusSyntax :: M.Map WindowRef Region -> FBuffer -> FBuffer focusSyntax r = modifyRawbuf (focusAst r) withSyntaxB' :: (forall syntax. Mode syntax -> syntax -> BufferM a) -> BufferM a withSyntaxB' = join . withSyntaxB -- | Return indices of strings in buffer matched by regex in the -- given region. regexRegionB :: SearchExp -> Region -> BufferM [Region] regexRegionB regex region = queryBuffer $ regexRegionBI regex region -- | Return indices of next string in buffer matched by regex in the -- given direction regexB :: Direction -> SearchExp -> BufferM [Region] regexB dir rx = do p <- pointB s <- sizeB regexRegionB rx (mkRegion p (case dir of Forward -> s; Backward -> 0)) --------------------------------------------------------------------- modifyMarkRaw :: Mark -> (MarkValue -> MarkValue) -> FBuffer -> FBuffer modifyMarkRaw m f = modifyRawbuf $ modifyMarkBI m f modifyMarkB :: Mark -> (MarkValue -> MarkValue) -> BufferM () modifyMarkB = (modify .) . modifyMarkRaw setMarkHereB :: BufferM Mark setMarkHereB = getMarkB Nothing setNamedMarkHereB :: String -> BufferM () setNamedMarkHereB name = do p <- pointB getMarkB (Just name) >>= (.= p) . markPointA -- | Highlight the selection setVisibleSelection :: Bool -> BufferM () setVisibleSelection = assign highlightSelectionA -- | Whether the selection is highlighted getVisibleSelection :: BufferM Bool getVisibleSelection = use highlightSelectionA getInsMark :: BufferM Mark getInsMark = insMark <$> askMarks askMarks :: BufferM WinMarks askMarks = do Just ms <- getMarks =<< ask return ms getMarkB :: Maybe String -> BufferM Mark getMarkB m = do p <- pointB queryAndModify (getMarkDefaultPosBI m p) mayGetMarkB :: String -> BufferM (Maybe Mark) mayGetMarkB m = queryBuffer (getMarkBI m) -- | Move point by the given number of characters. -- A negative offset moves backwards a positive one forward. moveN :: Int -> BufferM () moveN n = do s <- sizeB moveTo =<< min s . max 0 . (+~ Size n) <$> pointB -- | Move point -1 leftB :: BufferM () leftB = leftN 1 -- | Move cursor -n leftN :: Int -> BufferM () leftN n = moveN (-n) -- | Move cursor +1 rightB :: BufferM () rightB = rightN 1 -- | Move cursor +n rightN :: Int -> BufferM () rightN = moveN -- --------------------------------------------------------------------- -- Line based movement and friends -- | Move point down by @n@ lines. @n@ can be negative. -- Returns the actual difference in lines which we moved which -- may be negative if the requested line difference is negative. lineMoveRel :: Int -> BufferM Int lineMoveRel = movingToPrefCol . gotoLnFrom movingToPrefCol :: BufferM a -> BufferM a movingToPrefCol f = do prefCol <- use preferColA targetCol <- maybe curCol return prefCol r <- f moveToColB targetCol preferColA .= Just targetCol return r -- | Moves to a visual column within the current line as shown -- on the editor (ie, moving within the current width of a -- single visual line) movingToPrefVisCol :: BufferM a -> BufferM a movingToPrefVisCol f = do prefCol <- use preferVisColA targetCol <- maybe curVisCol return prefCol r <- f moveToVisColB targetCol preferVisColA .= Just targetCol return r moveToColB :: Int -> BufferM () moveToColB targetCol = do solPnt <- solPointB =<< pointB chrs <- R.toString <$> nelemsB targetCol solPnt is <- indentSettingsB let cols = scanl (colMove is) 0 chrs -- columns corresponding to the char toSkip = takeWhile (\(char,col) -> char /= '\n' && col < targetCol) (zip chrs cols) moveTo $ solPnt +~ fromIntegral (length toSkip) moveToVisColB :: Int -> BufferM () moveToVisColB targetCol = do col <- curCol wid <- width <$> use lastActiveWindowA let jumps = col `div` wid moveToColB $ jumps * wid + targetCol moveToLineColB :: Int -> Int -> BufferM () moveToLineColB line col = gotoLn line >> moveToColB col pointOfLineColB :: Int -> Int -> BufferM Point pointOfLineColB line col = savingPointB $ moveToLineColB line col >> pointB forgetPreferCol :: BufferM () forgetPreferCol = preferColA .= Nothing >> preferVisColA .= Nothing savingPrefCol :: BufferM a -> BufferM a savingPrefCol f = do pc <- use preferColA pv <- use preferVisColA result <- f preferColA .= pc preferVisColA .= pv return result -- | Move point up one line lineUp :: BufferM () lineUp = void (lineMoveRel (-1)) -- | Move point down one line lineDown :: BufferM () lineDown = void (lineMoveRel 1) -- | Return the contents of the buffer. elemsB :: BufferM YiString elemsB = queryBuffer mem -- | Returns the contents of the buffer between the two points. -- -- If the @startPoint >= endPoint@, empty string is returned. If the -- points are out of bounds, as much of the content as possible is -- taken: you're not guaranteed to get @endPoint - startPoint@ -- characters. betweenB :: Point -- ^ Point to start at -> Point -- ^ Point to stop at -> BufferM YiString betweenB (Point s) (Point e) = if s >= e then return (mempty :: YiString) else snd . R.splitAt s . fst . R.splitAt e <$> elemsB -- | Read the character at the current point readB :: BufferM Char readB = pointB >>= readAtB -- | Read the character at the given index -- This is an unsafe operation: character NUL is returned when out of bounds readAtB :: Point -> BufferM Char readAtB i = R.head <$> nelemsB 1 i >>= return . \case Nothing -> '\0' Just c -> c replaceCharB :: Char -> BufferM () replaceCharB c = do writeB c leftB replaceCharWithBelowB :: BufferM () replaceCharWithBelowB = replaceCharWithVerticalOffset 1 replaceCharWithAboveB :: BufferM () replaceCharWithAboveB = replaceCharWithVerticalOffset (-1) insertCharWithBelowB :: BufferM () insertCharWithBelowB = maybe (return ()) insertB =<< maybeCharBelowB insertCharWithAboveB :: BufferM () insertCharWithAboveB = maybe (return ()) insertB =<< maybeCharAboveB replaceCharWithVerticalOffset :: Int -> BufferM () replaceCharWithVerticalOffset offset = maybe (return ()) replaceCharB =<< maybeCharWithVerticalOffset offset maybeCharBelowB :: BufferM (Maybe Char) maybeCharBelowB = maybeCharWithVerticalOffset 1 maybeCharAboveB :: BufferM (Maybe Char) maybeCharAboveB = maybeCharWithVerticalOffset (-1) maybeCharWithVerticalOffset :: Int -> BufferM (Maybe Char) maybeCharWithVerticalOffset offset = savingPointB $ do l0 <- curLn c0 <- curCol void $ lineMoveRel offset l1 <- curLn c1 <- curCol curChar <- readB return $ if c0 == c1 && l0 + offset == l1 && curChar `notElem` ("\n\0" :: String) then Just curChar else Nothing -- | Delete @n@ characters forward from the current point deleteN :: Int -> BufferM () deleteN n = pointB >>= deleteNAt Forward n ------------------------------------------------------------------------ -- | Gives the 'IndentSettings' for the current buffer. indentSettingsB :: BufferM IndentSettings indentSettingsB = withModeB $ return . modeIndentSettings -- | Current column. -- 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 = colOf =<< pointB -- | Current column, visually. curVisCol :: BufferM Int curVisCol = rem <$> curCol <*> (width <$> use lastActiveWindowA) colOf :: Point -> BufferM Int colOf p = do is <- indentSettingsB R.foldl' (colMove is) 0 <$> queryBuffer (charsFromSolBI p) lineOf :: Point -> BufferM Int lineOf p = queryBuffer $ lineAt p lineCountB :: BufferM Int lineCountB = lineOf =<< sizeB -- | Decides which column we should be on after the given character. colMove :: IndentSettings -> Int -> Char -> Int colMove is col '\t' | tabSize is > 1 = col + tabSize is colMove _ col _ = col + 1 -- | Returns start of line point for a given point @p@ solPointB :: Point -> BufferM Point solPointB p = queryBuffer $ solPoint' p -- | Returns end of line for given point. eolPointB :: Point -> BufferM Point eolPointB p = queryBuffer $ eolPoint' p -- | Go to line indexed from current point -- Returns the actual moved difference which of course -- may be negative if the requested difference was negative. gotoLnFrom :: Int -> BufferM Int gotoLnFrom x = do l <- curLn p' <- queryBuffer $ solPoint (l + x) moveTo p' l' <- curLn return (l' - l) -- | Access to a value into the extensible state, keyed by its type. -- This allows you to retrieve inside a 'BufferM' monad, ie: -- -- > value <- getBufferDyn getBufferDyn :: forall m a. (Default a, YiVariable a, MonadState FBuffer m, Functor m) => m a getBufferDyn = fromMaybe (def :: a) <$> getDyn (use bufferDynamicA) (assign bufferDynamicA) -- | Access to a value into the extensible state, keyed by its type. -- This allows you to save inside a 'BufferM' monad, ie: -- -- > putBufferDyn updatedvalue putBufferDyn :: (YiVariable a, MonadState FBuffer m, Functor m) => a -> m () putBufferDyn = putDyn (use bufferDynamicA) (assign bufferDynamicA) -- | perform a @BufferM a@, and return to the current point. (by using a mark) savingExcursionB :: BufferM a -> BufferM a savingExcursionB f = do m <- getMarkB Nothing res <- f moveTo =<< use (markPointA m) return res markPointA :: Mark -> Lens' FBuffer Point markPointA mark = lens getter setter where getter b = markPoint $ getMarkValueRaw mark b setter b pos = modifyMarkRaw mark (\v -> v {markPoint = pos}) b -- | Perform an @BufferM a@, and return to the current point. savingPointB :: BufferM a -> BufferM a savingPointB f = savingPrefCol $ do p <- pointB res <- f moveTo p return res -- | Perform an @BufferM a@, and return to the current line and column -- number. The difference between this and 'savingPointB' is that here -- we attempt to return to the specific line and column number, rather -- than a specific number of characters from the beginning of the -- buffer. -- -- In case the column is further away than EOL, the point is left at -- EOL: 'moveToLineColB' is used internally. savingPositionB :: BufferM a -> BufferM a savingPositionB f = savingPrefCol $ do (c, l) <- (,) <$> curCol <*> curLn res <- f moveToLineColB l c return res pointAt :: BufferM a -> BufferM Point pointAt f = savingPointB (f *> pointB) pointAfterCursorB :: Point -> BufferM Point pointAfterCursorB p = pointAt $ do moveTo p rightB -- | What would be the point after doing the given action? -- The argument must not modify the buffer. destinationOfMoveB :: BufferM a -> BufferM Point destinationOfMoveB f = savingPointB (f >> pointB) ------------- -- Window askWindow :: (Window -> a) -> BufferM a askWindow = asks withEveryLineB :: BufferM () -> BufferM () withEveryLineB action = savingPointB $ do lineCount <- lineCountB forM_ [1 .. lineCount] $ \l -> do void $ gotoLn l action makeLensesWithSuffix "A" ''IndentSettings makeLensesWithSuffix "A" ''Mode yi-0.12.6/src/library/Yi/Buffer/Region.hs0000644000000000000000000000777312717763531016245 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Buffer.Region -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module defines buffer operation on regions module Yi.Buffer.Region ( module Yi.Region , swapRegionsB , deleteRegionB , replaceRegionB , readRegionB , mapRegionB , modifyRegionB , winRegionB , inclusiveRegionB , blockifyRegion , joinLinesB , concatLinesB ) where import Control.Applicative (Applicative ((<*>), pure), (<$>)) import Control.Monad (when) import Data.Char (isSpace) import Data.List (sort) import Data.Monoid (mconcat) import Yi.Buffer.Misc import Yi.Region import Yi.Rope (YiString) import qualified Yi.Rope as R (YiString, cons, dropWhile, filter, lines, map, null) import Yi.String (overInit) import Yi.Utils (SemiNum ((~-))) import Yi.Window (winRegion) winRegionB :: BufferM Region winRegionB = askWindow winRegion -- | Delete an arbitrary part of the buffer deleteRegionB :: Region -> BufferM () deleteRegionB r = deleteNAt (regionDirection r) (fromIntegral (regionEnd r ~- regionStart r)) (regionStart r) readRegionB :: Region -> BufferM YiString readRegionB r = nelemsB (fromIntegral (regionEnd r - i)) i where i = regionStart r -- | Replace a region with a given rope. replaceRegionB :: Region -> YiString -> BufferM () replaceRegionB r s = do deleteRegionB r insertNAt s $ regionStart r -- | Map the given function over the characters in the region. mapRegionB :: Region -> (Char -> Char) -> BufferM () mapRegionB r f = do text <- readRegionB r replaceRegionB r (R.map f text) -- | Swap the content of two Regions swapRegionsB :: Region -> Region -> BufferM () swapRegionsB r r' | regionStart r > regionStart r' = swapRegionsB r' r | otherwise = do w0 <- readRegionB r w1 <- readRegionB r' replaceRegionB r' w0 replaceRegionB r w1 -- | Modifies the given region according to the given -- string transformation function modifyRegionB :: (R.YiString -> R.YiString) -- ^ The string modification function -> Region -- ^ The region to modify -> BufferM () modifyRegionB f region = f <$> readRegionB region >>= replaceRegionB region -- | Extend the right bound of a region to include it. inclusiveRegionB :: Region -> BufferM Region inclusiveRegionB r = if regionStart r <= regionEnd r then mkRegion (regionStart r) <$> pointAfterCursorB (regionEnd r) else mkRegion <$> pointAfterCursorB (regionStart r) <*> pure (regionEnd r) -- | See a region as a block/rectangular region, -- since regions are represented by two point, this returns -- a list of small regions form this block region. blockifyRegion :: Region -> BufferM [Region] blockifyRegion r = savingPointB $ do [lowCol, highCol] <- sort <$> mapM colOf [regionStart r, regionEnd r] startLine <- lineOf $ regionStart r endLine <- lineOf $ regionEnd r when (startLine > endLine) $ fail "blockifyRegion: impossible" mapM (\line -> mkRegion <$> pointOfLineColB line lowCol <*> pointOfLineColB line (1 + highCol)) [startLine..endLine] -- | Joins lines in the region with a single space, skipping any empty -- lines. joinLinesB :: Region -> BufferM () joinLinesB = savingPointB . modifyRegionB g' where g' = overInit $ mconcat . pad . R.lines pad :: [R.YiString] -> [R.YiString] pad [] = [] pad (x:xs) = x : fmap (skip (R.cons ' ' . R.dropWhile isSpace)) xs skip g x = if R.null x then x else g x -- | Concatenates lines in the region preserving the trailing newline -- if any. concatLinesB :: Region -> BufferM () concatLinesB = savingPointB . modifyRegionB (overInit $ R.filter (/= '\n')) yi-0.12.6/src/library/Yi/Buffer/TextUnit.hs0000644000000000000000000004171712717763531016602 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Buffer.TextUnit -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Working with blocks (units) of text. -- module Yi.Buffer.TextUnit ( TextUnit(..) , outsideUnit , leftBoundaryUnit , unitWord , unitViWord , unitViWORD , unitViWordAnyBnd , unitViWORDAnyBnd , unitViWordOnLine , unitViWORDOnLine , unitDelimited , unitSentence, unitEmacsParagraph, unitParagraph , isAnySep, unitSep, unitSepThisLine, isWordChar , moveB, maybeMoveB , transformB, transposeB , regionOfB, regionOfNonEmptyB, regionOfPartB , regionWithTwoMovesB , regionOfPartNonEmptyB, regionOfPartNonEmptyAtB , readPrevUnitB, readUnitB , untilB, doUntilB_, untilB_, whileB, doIfCharB , atBoundaryB , numberOfB , deleteB, genMaybeMoveB , genMoveB, BoundarySide(..), genAtBoundaryB , checkPeekB , halfUnit , deleteUnitB ) where import Control.Applicative (Applicative ((<*>)), (<$>)) import Control.Monad (void, when, (<=<)) import Data.Char (GeneralCategory (LineSeparator, ParagraphSeparator, Space), generalCategory, isAlphaNum, isSeparator, isSpace) import Data.Typeable (Typeable) import Yi.Buffer.Basic (Direction (..), Point (Point), mayReverse, reverseDir) import Yi.Buffer.Misc import Yi.Buffer.Region import Yi.Rope (YiString) import qualified Yi.Rope as R (head, reverse, tail, toString) -- | Designate a given "unit" of text. data TextUnit = Character -- ^ a single character | Line -- ^ a line of text (between newlines) | VLine -- ^ a "vertical" line of text (area of text between two characters at the same column number) | Document -- ^ the whole document | GenUnit {genEnclosingUnit :: TextUnit, genUnitBoundary :: Direction -> BufferM Bool} -- there could be more text units, like Page, Searched, etc. it's probably a good -- idea to use GenUnit though. deriving Typeable -- | Turns a unit into its "negative" by inverting the boundaries. For example, -- @outsideUnit unitViWord@ will be the unit of spaces between words. For units -- without boundaries ('Character', 'Document', ...), this is the identity -- function. outsideUnit :: TextUnit -> TextUnit outsideUnit (GenUnit enclosing boundary) = GenUnit enclosing (boundary . reverseDir) outsideUnit x = x -- for a lack of better definition -- | Common boundary checking function: run the condition on @len@ -- characters in specified direction shifted by specified offset. genBoundary :: Int -- ^ Offset from current position -> Int -- ^ Look-ahead -> (YiString -> Bool) -- ^ predicate -> Direction -- ^ Direction to look in -> BufferM Bool genBoundary ofs len condition dir = condition <$> peekB where peekB = do Point p' <- pointB let pt@(Point p) = Point (p' + mayNegate ofs) case dir of Forward -> betweenB pt (Point $ max 0 p + len) Backward -> R.reverse <$> betweenB (Point $ p - len) pt mayNegate = case dir of Forward -> id Backward -> negate -- | a word as in use in Emacs (fundamental mode) unitWord :: TextUnit 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. unitDelimited :: Char -> Char -> Bool -> TextUnit unitDelimited left right included = GenUnit Document $ \direction -> case (included,direction) of (False, Backward) -> do isCursorOnLeftChar <- (== left) <$> readB when isCursorOnLeftChar rightB checkPeekB 0 [(== left)] Backward (False, Forward) -> do isCursorOnRightChar <- (== right) <$> readB isTextUnitBlank <- checkPeekB 0 [(== left)] Backward if isTextUnitBlank && isCursorOnRightChar then leftB >> return True else return isCursorOnRightChar (True, Backward) -> checkPeekB 0 [(== left)] Forward (True, Forward) -> rightB >> checkPeekB 0 [(== right)] Backward isWordChar :: Char -> Bool isWordChar x = isAlphaNum x || x == '_' isNl :: Char -> Bool isNl = (== '\n') -- | Tells if a char can end a sentence ('.', '!', '?'). isEndOfSentence :: Char -> Bool isEndOfSentence = (`elem` ".!?") -- | Verifies that the string matches all the predicates, pairwise. If -- the string is "too small", then return 'False'. Note the length of -- predicates has to be finite. checks :: [Char -> Bool] -> YiString -> Bool checks ps' t' = go ps' (R.toString t') where go [] _ = True go _ [] = False go (p:ps) (x:xs) = p x && go ps xs checkPeekB :: Int -> [Char -> Bool] -> Direction -> BufferM Bool checkPeekB offset conds = genBoundary offset (length conds) (checks conds) -- | Helper that takes first two characters of YiString. Faster than -- take 2 and string conversion. firstTwo :: YiString -> Maybe (Char, Char) firstTwo t = case R.head t of Nothing -> Nothing Just c -> case R.tail t >>= R.head of Nothing -> Nothing Just c' -> Just (c, c') atViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool atViWordBoundary charType = genBoundary (-1) 2 $ \cs -> case firstTwo cs of Just (c1, c2) -> isNl c1 && isNl c2 -- stop at empty lines || not (isSpace c1) && (charType c1 /= charType c2) Nothing -> True atAnyViWordBoundary :: (Char -> Int) -> Direction -> BufferM Bool atAnyViWordBoundary charType = genBoundary (-1) 2 $ \cs -> case firstTwo cs of Just (c1, c2) -> isNl c1 || isNl c2 || charType c1 /= charType c2 Nothing -> True atViWordBoundaryOnLine :: (Char -> Int) -> Direction -> BufferM Bool atViWordBoundaryOnLine charType = genBoundary (-1) 2 $ \cs -> case firstTwo cs of Just (c1, c2)-> isNl c1 || isNl c2 || not (isSpace c1) && charType c1 /= charType c2 Nothing -> True unitViWord :: TextUnit unitViWord = GenUnit Document $ atViWordBoundary viWordCharType unitViWORD :: TextUnit unitViWORD = GenUnit Document $ atViWordBoundary viWORDCharType unitViWordAnyBnd :: TextUnit unitViWordAnyBnd = GenUnit Document $ atAnyViWordBoundary viWordCharType unitViWORDAnyBnd :: TextUnit unitViWORDAnyBnd = GenUnit Document $ atAnyViWordBoundary viWORDCharType unitViWordOnLine :: TextUnit unitViWordOnLine = GenUnit Document $ atViWordBoundaryOnLine viWordCharType unitViWORDOnLine :: TextUnit unitViWORDOnLine = GenUnit Document $ atViWordBoundaryOnLine viWORDCharType viWordCharType :: Char -> Int viWordCharType c | isSpace c = 1 | isWordChar c = 2 | otherwise = 3 viWORDCharType :: Char -> Int viWORDCharType c | isSpace c = 1 | otherwise = 2 -- | Separator characters (space, tab, unicode separators). Most of -- the units above attempt to identify "words" with various -- punctuation and symbols included or excluded. This set of units is -- a simple inverse: it is true for "whitespace" or "separators" and -- false for anything that is not (letters, numbers, symbols, -- punctuation, whatever). isAnySep :: Char -> Bool isAnySep c = isSeparator c || isSpace c || generalCategory c `elem` seps where seps = [ Space, LineSeparator, ParagraphSeparator ] atSepBoundary :: Direction -> BufferM Bool atSepBoundary = genBoundary (-1) 2 $ \cs -> case firstTwo cs of Just (c1, c2) -> isNl c1 || isNl c2 || isAnySep c1 /= isAnySep c2 Nothing -> True -- | unitSep is true for any kind of whitespace/separator unitSep :: TextUnit unitSep = GenUnit Document atSepBoundary -- | unitSepThisLine is true for any kind of whitespace/separator on this line only unitSepThisLine :: TextUnit unitSepThisLine = GenUnit Line atSepBoundary -- | Is the point at a @Unit@ boundary in the specified @Direction@? atBoundary :: TextUnit -> Direction -> BufferM Bool atBoundary Document Backward = (== 0) <$> pointB atBoundary Document Forward = (>=) <$> pointB <*> sizeB atBoundary Character _ = return True atBoundary VLine _ = return True -- a fallacy; this needs a little refactoring. atBoundary Line direction = checkPeekB 0 [isNl] direction atBoundary (GenUnit _ atBound) dir = atBound dir enclosingUnit :: TextUnit -> TextUnit enclosingUnit (GenUnit enclosing _) = enclosing enclosingUnit _ = Document atBoundaryB :: TextUnit -> Direction -> BufferM Bool atBoundaryB Document d = atBoundary Document d atBoundaryB u d = (||) <$> atBoundary u d <*> atBoundaryB (enclosingUnit u) d -- | Paragraph to implement emacs-like forward-paragraph/backward-paragraph unitEmacsParagraph :: TextUnit unitEmacsParagraph = GenUnit Document $ checkPeekB (-2) [not . isNl, isNl, isNl] -- | Paragraph that begins and ends in the paragraph, not the empty lines surrounding it. unitParagraph :: TextUnit unitParagraph = GenUnit Document $ checkPeekB (-1) [not . isNl, isNl, isNl] unitSentence :: TextUnit unitSentence = GenUnit unitEmacsParagraph $ \dir -> checkPeekB (if dir == Forward then -1 else 0) (mayReverse dir [isEndOfSentence, isSpace]) dir -- | Unit that have its left and right boundaries at the left boundary of the argument unit. leftBoundaryUnit :: TextUnit -> TextUnit leftBoundaryUnit u = GenUnit Document (\_dir -> atBoundaryB u Backward) -- | @genAtBoundaryB u d s@ returns whether the point is at a given boundary @(d,s)@ . -- Boundary @(d,s)@ , taking Word as example, means: -- Word -- ^^ ^^ -- 12 34 -- 1: (Backward,OutsideBound) -- 2: (Backward,InsideBound) -- 3: (Forward,InsideBound) -- 4: (Forward,OutsideBound) -- -- rules: -- genAtBoundaryB u Backward InsideBound = atBoundaryB u Backward -- genAtBoundaryB u Forward OutsideBound = atBoundaryB u Forward genAtBoundaryB :: TextUnit -> Direction -> BoundarySide -> BufferM Bool genAtBoundaryB u d s = withOffset (off u d s) $ atBoundaryB u d where withOffset 0 f = f withOffset ofs f = savingPointB (((ofs +) <$> pointB) >>= moveTo >> f) off _ Backward InsideBound = 0 off _ Backward OutsideBound = 1 off _ Forward InsideBound = 1 off _ Forward OutsideBound = 0 numberOfB :: TextUnit -> TextUnit -> BufferM Int numberOfB unit containingUnit = savingPointB $ do maybeMoveB containingUnit Backward start <- pointB moveB containingUnit Forward end <- pointB moveTo start length <$> untilB ((>= end) <$> pointB) (moveB unit Forward) whileB :: BufferM Bool -> BufferM a -> BufferM [a] whileB cond = untilB (not <$> cond) -- | Repeat an action until the condition is fulfilled or the cursor -- stops moving. The Action may be performed zero times. untilB :: BufferM Bool -> BufferM a -> BufferM [a] untilB cond f = do stop <- cond if stop then return [] else doUntilB cond f -- | Repeat an action until the condition is fulfilled or the cursor -- stops moving. The Action is performed at least once. doUntilB :: BufferM Bool -> BufferM a -> BufferM [a] doUntilB cond f = loop where loop = do p <- pointB x <- f p' <- pointB stop <- cond (x:) <$> if p /= p' && not stop then loop else return [] doUntilB_ :: BufferM Bool -> BufferM a -> BufferM () doUntilB_ cond f = void (doUntilB cond f) -- maybe do an optimized version? untilB_ :: BufferM Bool -> BufferM a -> BufferM () untilB_ cond f = void (untilB cond f) -- maybe do an optimized version? -- | Do an action if the current buffer character passes the predicate doIfCharB :: (Char -> Bool) -> BufferM a -> BufferM () doIfCharB p o = readB >>= \c -> when (p c) $ void o -- | Boundary side data BoundarySide = InsideBound | OutsideBound deriving Eq -- | Generic move operation -- Warning: moving To the (OutsideBound, Backward) bound of Document is impossible (offset -1!) -- @genMoveB u b d@: move in direction d until encountering boundary b or unit u. See 'genAtBoundaryB' for boundary explanation. genMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM () genMoveB Document (Forward,InsideBound) Forward = moveTo =<< subtract 1 <$> sizeB genMoveB Document _ Forward = moveTo =<< sizeB genMoveB Document _ Backward = moveTo 0 -- impossible to go outside beginning of doc. genMoveB Character _ Forward = rightB genMoveB Character _ Backward = leftB genMoveB VLine _ Forward = do ofs <- lineMoveRel 1 when (ofs < 1) (maybeMoveB Line Forward) genMoveB VLine _ Backward = lineUp genMoveB unit (boundDir, boundSide) moveDir = doUntilB_ (genAtBoundaryB unit boundDir boundSide) (moveB Character moveDir) -- | Generic maybe move operation. -- As genMoveB, but don't move if we are at boundary already. genMaybeMoveB :: TextUnit -> (Direction, BoundarySide) -> Direction -> BufferM () -- optimized case for Document genMaybeMoveB Document boundSpec moveDir = genMoveB Document boundSpec moveDir -- optimized case for start/end of Line genMaybeMoveB Line (Backward, InsideBound) Backward = moveTo =<< solPointB =<< pointB genMaybeMoveB Line (Forward, OutsideBound) Forward = moveTo =<< eolPointB =<< pointB genMaybeMoveB unit (boundDir, boundSide) moveDir = untilB_ (genAtBoundaryB unit boundDir boundSide) (moveB Character moveDir) -- | Move to the next unit boundary moveB :: TextUnit -> Direction -> BufferM () moveB u d = genMoveB u (d, case d of Forward -> OutsideBound; Backward -> InsideBound) d -- | As 'moveB', unless the point is at a unit boundary -- So for example here moveToEol = maybeMoveB Line Forward; -- in that it will move to the end of current line and nowhere if we -- are already at the end of the current line. Similarly for moveToSol. maybeMoveB :: TextUnit -> Direction -> BufferM () maybeMoveB u d = genMaybeMoveB u (d, case d of Forward -> OutsideBound; Backward -> InsideBound) d transposeB :: TextUnit -> Direction -> BufferM () transposeB unit direction = do moveB unit (reverseDir direction) w0 <- pointB moveB unit direction w0' <- pointB moveB unit direction w1' <- pointB moveB unit (reverseDir direction) w1 <- pointB swapRegionsB (mkRegion w0 w0') (mkRegion w1 w1') moveTo w1' -- | Transforms the region given by 'TextUnit' in the 'Direction' with -- user-supplied function. transformB :: (YiString -> YiString) -> TextUnit -> Direction -> BufferM () transformB f unit direction = do p <- pointB moveB unit direction q <- pointB let r = mkRegion p q replaceRegionB r =<< f <$> readRegionB r -- | Delete between point and next unit boundary, return the deleted region. deleteB :: TextUnit -> Direction -> BufferM () deleteB unit dir = deleteRegionB =<< regionOfPartNonEmptyB unit dir regionWithTwoMovesB :: BufferM a -> BufferM b -> BufferM Region regionWithTwoMovesB move1 move2 = savingPointB $ mkRegion <$> (move1 >> pointB) <*> (move2 >> pointB) -- | Region of the whole textunit where the current point is. regionOfB :: TextUnit -> BufferM Region regionOfB unit = regionWithTwoMovesB (maybeMoveB unit Backward) (maybeMoveB unit Forward) -- An alternate definition would be the following, but it can return two units if the current point is between them. -- eg. "word1 ^ word2" would return both words. -- regionOfB unit = mkRegion -- <$> pointAfter (maybeMoveB unit Backward) -- <*> destinationOfMoveB (maybeMoveB unit Forward) -- | Non empty region of the whole textunit where the current point is. regionOfNonEmptyB :: TextUnit -> BufferM Region regionOfNonEmptyB unit = savingPointB $ mkRegion <$> (maybeMoveB unit Backward >> pointB) <*> (moveB unit Forward >> pointB) -- | Region between the point and the next boundary. -- The region is empty if the point is at the boundary. regionOfPartB :: TextUnit -> Direction -> BufferM Region regionOfPartB unit dir = mkRegion <$> pointB <*> destinationOfMoveB (maybeMoveB unit dir) -- | Non empty region between the point and the next boundary, -- In fact the region can be empty if we are at the end of file. regionOfPartNonEmptyB :: TextUnit -> Direction -> BufferM Region regionOfPartNonEmptyB unit dir = mkRegion <$> pointB <*> destinationOfMoveB (moveB unit dir) -- | Non empty region at given point and the next boundary, regionOfPartNonEmptyAtB :: TextUnit -> Direction -> Point -> BufferM Region regionOfPartNonEmptyAtB unit dir p = do oldP <- pointB moveTo p r <- regionOfPartNonEmptyB unit dir moveTo oldP return r readPrevUnitB :: TextUnit -> BufferM YiString readPrevUnitB unit = readRegionB =<< regionOfPartNonEmptyB unit Backward readUnitB :: TextUnit -> BufferM YiString readUnitB = readRegionB <=< regionOfB halfUnit :: Direction -> TextUnit -> TextUnit halfUnit dir (GenUnit enclosing boundary) = GenUnit enclosing (\d -> if d == dir then boundary d else return False) halfUnit _dir tu = tu deleteUnitB :: TextUnit -> Direction -> BufferM () deleteUnitB unit dir = deleteRegionB =<< regionOfPartNonEmptyB unit dir yi-0.12.6/src/library/Yi/Buffer/Undo.hs0000644000000000000000000001550112717763531015713 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} -- | An implementation of restricted, linear undo, as described in: -- -- > T. Berlage, "A selective undo mechanism for graphical user interfaces -- > based on command objects", ACM Transactions on Computer-Human -- > Interaction 1(3), pp. 269-294, 1994. -- -- Implementation based on a proposal by sjw. -- -- From Berlage: -- -- > All buffer-mutating commands are stored (in abstract form) in an -- > Undo list. The most recent item in this list is the action that -- > will be undone next. When it is undone, it is removed from the Undo -- > list, and its inverse is added to the Redo list. The last command -- > put into the Redo list can be redone, and again prepended to the -- > Undo list. New commands are added to the Undo list without -- > affecting the Redo list. -- -- Now, the above assumes that commands can be _redone_ in a state other -- than that in which it was orginally done. This is not the case in our -- text editor: a user may delete, for example, between an undo and a -- redo. Berlage addresses this in S2.3. A Yi example: -- -- > Delete some characters -- > Undo partialy -- > Move prior in the file, and delete another _chunk_ -- > Redo some things == corruption. -- -- Berlage describes the /stable execution property/: -- -- > A command is always redone in the same state that it was originally -- > executed in, and is always undone in the state that was reached -- > after the original execution. -- -- > The only case where the linear undo model violates the stable -- > execution property is when _a new command is submitted while the -- > redo list is not empty_. The _restricted linear undo model_ ... -- > clears the redo list in this case. -- -- Also some discussion of this in: /The Text Editor Sam/, Rob Pike, pg 19. -- module Yi.Buffer.Undo ( emptyU , addChangeU , setSavedFilePointU , isAtSavedFilePointU , undoU , redoU , URList {- abstractly -} , Change(AtomicChange, InteractivePoint) ) where import GHC.Generics (Generic) import Data.Binary (Binary (..)) import Yi.Buffer.Implementation data Change = SavedFilePoint | InteractivePoint | 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. deriving (Show, Generic) instance Binary Change -- | A URList consists of an undo and a redo list. data URList = URList ![Change] ![Change] deriving (Show, Generic) instance Binary URList -- | A new empty 'URList'. -- Notice we must have a saved file point as this is when we assume we are -- opening the file so it is currently the same as the one on disk emptyU :: URList emptyU = URList [SavedFilePoint] [] -- | Add an action to the undo list. -- According to the restricted, linear undo model, if we add a command -- whilst the redo list is not empty, we will lose our redoable changes. addChangeU :: Change -> URList -> URList addChangeU InteractivePoint (URList us rs) = URList (addIP us) rs addChangeU u (URList us _rs) = URList (u:us) [] -- | Add a saved file point so that we can tell that the buffer has not -- been modified since the previous saved file point. -- Notice that we must be sure to remove the previous saved file points -- since they are now worthless. setSavedFilePointU :: URList -> URList setSavedFilePointU (URList undos redos) = URList (SavedFilePoint : cleanUndos) cleanRedos where cleanUndos = filter isNotSavedFilePoint undos cleanRedos = filter isNotSavedFilePoint redos isNotSavedFilePoint :: Change -> Bool isNotSavedFilePoint SavedFilePoint = False isNotSavedFilePoint _ = True -- | This undoes one interaction step. undoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update])) undoU m = undoUntilInteractive m [] . undoInteractive -- | This redoes one iteraction step. redoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update])) redoU = asRedo . undoU -- | Prepare undo by moving one interaction point from undoes to redoes. undoInteractive :: URList -> URList undoInteractive (URList us rs) = URList (remIP us) (addIP rs) remIP, addIP :: [Change] -> [Change] -- | Remove an initial interactive point, if there is one remIP (InteractivePoint:xs) = xs remIP xs = xs -- | 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])) undoUntilInteractive pointMark xs ur@(URList cs rs) b = case cs of [] -> (b, (ur, xs)) [SavedFilePoint] -> (b, (ur, xs)) -- Why this special case? (InteractivePoint:_) -> (b, (ur, xs)) (SavedFilePoint:cs') -> undoUntilInteractive pointMark xs (URList cs' (SavedFilePoint:rs)) b (AtomicChange u:cs') -> let ur' = URList cs' (AtomicChange (reverseUpdateI u):rs) b' = applyUpdateWithMoveI u b (b'', (ur'', xs'')) = undoUntilInteractive pointMark xs ur' b' in (b'', (ur'', u:xs'')) where -- Apply a /valid/ update and also move point in buffer to update position applyUpdateWithMoveI :: Update -> BufferImpl syntax -> BufferImpl syntax applyUpdateWithMoveI u = case updateDirection u of Forward -> apply . move Backward -> move . apply where move = modifyMarkBI pointMark (\v -> v {markPoint = updatePoint u}) apply = applyUpdateI u -- | Run the undo-function @f@ on a swapped URList making it -- 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 swapUndoRedo :: URList -> URList swapUndoRedo (URList us rs) = URList rs us -- | undoIsAtSavedFilePoint. @True@ if the undo list is at a SavedFilePoint indicating -- that the buffer has not been modified since we last saved the file. -- Note: that an empty undo list does NOT mean that the buffer is not modified since -- the last save. Because we may have saved the file and then undone actions done before -- the save. isAtSavedFilePointU :: URList -> Bool isAtSavedFilePointU (URList us _) = isUnchanged us where isUnchanged cs = case cs of [] -> False (SavedFilePoint : _) -> True (InteractivePoint : cs') -> isUnchanged cs' _ -> False yi-0.12.6/src/library/Yi/Command.hs0000644000000000000000000001263112717763531015154 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Command -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Various high-level functions to further classify. module Yi.Command where import Control.Applicative ((<$>)) import Control.Exception (SomeException) import Control.Lens (assign) import Control.Monad (void) import Control.Monad.Base (liftBase) import Data.Binary (Binary) import Data.Default (Default) import qualified Data.Text as T (Text, init, last, pack, unpack) import Data.Typeable (Typeable) import System.Exit (ExitCode (..)) import Yi.Buffer (BufferId (MemBuffer), BufferRef, identA, setMode) import Yi.Core (startSubprocess) import Yi.Editor import Yi.Keymap (YiM, withUI) import Yi.MiniBuffer import qualified Yi.Mode.Compilation as Compilation (mode) import qualified Yi.Mode.Interactive as Interactive (spawnProcess) import Yi.Monad (maybeM) import Yi.Process (runShellCommand, shellFileName) import qualified Yi.Rope as R (fromString) import Yi.Types (YiVariable) import Yi.UI.Common (reloadProject) import Yi.Utils (io) --------------------------- -- | Changing the buffer name quite useful if you have -- several the same. This also breaks the relation with the file. changeBufferNameE :: YiM () changeBufferNameE = withMinibufferFree "New buffer name:" strFun where strFun :: T.Text -> YiM () strFun = withCurrentBuffer . assign identA . MemBuffer ---------------------------- -- | shell-command with argument prompt shellCommandE :: YiM () shellCommandE = withMinibufferFree "Shell command:" shellCommandV ---------------------------- -- | shell-command with a known argument shellCommandV :: T.Text -> YiM () shellCommandV cmd = do (exitCode,cmdOut,cmdErr) <- liftBase $ runShellCommand (T.unpack cmd) case exitCode of ExitSuccess -> if length (filter (== '\n') cmdOut) > 17 then withEditor . void $ -- see GitHub issue #477 newBufferE (MemBuffer "Shell Command Output") (R.fromString cmdOut) else printMsg $ case T.pack cmdOut of "" -> "(Shell command with no output)" -- Drop trailing newline from output xs -> if T.last xs == '\n' then T.init xs else xs -- FIXME: here we get a string and convert it back to utf8; -- this indicates a possible bug. ExitFailure _ -> printMsg $ T.pack cmdErr ---------------------------- -- Cabal-related commands newtype CabalBuffer = CabalBuffer {cabalBuffer :: Maybe BufferRef} deriving (Default, Typeable, Binary) instance YiVariable CabalBuffer ---------------------------- -- | cabal-configure cabalConfigureE :: CommandArguments -> YiM () cabalConfigureE = cabalRun "configure" configureExit configureExit :: Either SomeException ExitCode -> YiM () configureExit (Right ExitSuccess) = reloadProjectE "." configureExit _ = return () reloadProjectE :: String -> YiM () reloadProjectE s = withUI $ \ui -> reloadProject ui s -- | Run the given commands with args and pipe the ouput into the build buffer, -- which is shown in an other window. buildRun :: T.Text -> [T.Text] -> (Either SomeException ExitCode -> YiM x) -> YiM () buildRun cmd args onExit = withOtherWindow $ do b <- startSubprocess (T.unpack cmd) (T.unpack <$> args) onExit maybeM deleteBuffer =<< cabalBuffer <$> getEditorDyn putEditorDyn $ CabalBuffer $ Just b withCurrentBuffer $ setMode Compilation.mode return () makeBuild :: CommandArguments -> YiM () makeBuild (CommandArguments args) = buildRun "make" args (const $ return ()) cabalRun :: T.Text -> (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM () cabalRun cmd onExit (CommandArguments args) = buildRun "cabal" (cmd:args) onExit makeRun :: (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM () makeRun onExit (CommandArguments args) = buildRun "make" args onExit ----------------------- -- | cabal-build cabalBuildE :: CommandArguments -> YiM () cabalBuildE = cabalRun "build" (const $ return ()) makeBuildE :: CommandArguments -> YiM () makeBuildE = makeRun (const $ return ()) shell :: YiM BufferRef shell = do sh <- io shellFileName Interactive.spawnProcess sh ["-i"] -- use the -i option for interactive mode (assuming bash) -- | Search the source files in the project. searchSources :: String ::: RegexTag -> YiM () searchSources = grepFind (Doc "*.hs") -- | Perform a find+grep operation grepFind :: String ::: FilePatternTag -> String ::: RegexTag -> YiM () grepFind (Doc filePattern) (Doc searchedRegex) = withOtherWindow $ do void $ startSubprocess "find" [".", "-name", "_darcs", "-prune", "-o", "-name", filePattern, "-exec", "grep", "-Hnie", searchedRegex, "{}", ";"] (const $ return ()) withCurrentBuffer $ setMode Compilation.mode return () yi-0.12.6/src/library/Yi/Command/Help.hs0000644000000000000000000000450512717763531016045 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# 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 (Binary) import Data.Default (Default) import qualified Data.Text as T (Text, pack, unlines, unpack) import Data.Typeable (Typeable) import Yi.Buffer (BufferId (MemBuffer), BufferRef) import Yi.Editor import Yi.Eval (describeNamedAction, getAllNamesInScope) import Yi.Keymap (YiM) import Yi.Monad (maybeM) import qualified Yi.Rope as R (fromText) 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 yi-0.12.6/src/library/Yi/Completion.hs0000644000000000000000000001272312717763531015711 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Completion -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Collection of functions for completion and matching. module Yi.Completion ( completeInList, completeInList' , completeInListCustomShow , commonPrefix , prefixMatch, infixMatch , subsequenceMatch , containsMatch', containsMatch, containsMatchCaseInsensitive , mkIsPrefixOf ) where import Control.Applicative ((<$>)) import Data.Function (on) import Data.List (find, nub) import Data.Maybe (catMaybes) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, breakOn, isPrefixOf, length, null, tails, toCaseFold) import Yi.Editor (EditorM, printMsg, printMsgs) import Yi.String (commonTPrefix', showT) import Yi.Utils (commonPrefix) ------------------------------------------- -- General completion -- | Like usual 'T.isPrefixOf' but user can specify case sensitivity. -- See 'T.toCaseFold' for exotic unicode gotchas. mkIsPrefixOf :: Bool -- ^ Is case-sensitive? -> T.Text -> T.Text -> Bool mkIsPrefixOf True = T.isPrefixOf mkIsPrefixOf False = T.isPrefixOf `on` T.toCaseFold -- | Prefix matching function, for use with 'completeInList' prefixMatch :: T.Text -> T.Text -> Maybe T.Text prefixMatch prefix s = if prefix `T.isPrefixOf` s then Just s else Nothing -- | Infix matching function, for use with 'completeInList' infixMatch :: T.Text -> T.Text -> Maybe T.Text infixMatch needle haystack = case T.breakOn needle haystack of (_, t) -> if T.null t then Nothing else Just t -- | Example: "abc" matches "a1b2c" subsequenceMatch :: String -> String -> Bool subsequenceMatch needle haystack = go needle haystack where go (n:ns) (h:hs) | n == h = go ns hs go (n:ns) (h:hs) | n /= h = go (n:ns) hs go [] _ = True go _ [] = False go _ _ = False -- | TODO: this is a terrible function, isn't this just -- case-insensitive infix? – FÅ«zetsu containsMatch' :: Bool -> T.Text -> T.Text -> Maybe T.Text containsMatch' caseSensitive pattern str = const str <$> find (pattern `tstPrefix`) (T.tails str) where tstPrefix = mkIsPrefixOf caseSensitive containsMatch :: T.Text -> T.Text -> Maybe T.Text containsMatch = containsMatch' True containsMatchCaseInsensitive :: T.Text -> T.Text -> Maybe T.Text containsMatchCaseInsensitive = containsMatch' False -- | Complete a string given a user input string, a matching function -- and a list of possibilites. Matching function should return the -- part of the string that matches the user string. completeInList :: T.Text -- ^ Input to match on -> (T.Text -> Maybe T.Text) -- ^ matcher function -> [T.Text] -- ^ items to match against -> EditorM T.Text completeInList = completeInListCustomShow id -- | Same as 'completeInList', but maps @showFunction@ on possible -- matches when printing completeInListCustomShow :: (T.Text -> T.Text) -- ^ Show function -> T.Text -- ^ Input to match on -> (T.Text -> Maybe T.Text) -- ^ matcher function -> [T.Text] -- ^ items to match against -> EditorM T.Text completeInListCustomShow showFunction s match possibilities | null filtered = printMsg "No match" >> return s | prefix /= s = return prefix | isSingleton filtered = printMsg "Sole completion" >> return s | prefix `elem` filtered = printMsg ("Complete, but not unique: " <> showT filtered) >> return s | otherwise = printMsgs (map showFunction filtered) >> return (bestMatch filtered s) where prefix = commonTPrefix' filtered filtered = filterMatches match possibilities completeInList' :: T.Text -> (T.Text -> Maybe T.Text) -> [T.Text] -> EditorM T.Text completeInList' s match l = case filtered of [] -> printMsg "No match" >> return s [x] | s == x -> printMsg "Sole completion" >> return s | otherwise -> return x _ -> printMsgs filtered >> return (bestMatch filtered s) where filtered = filterMatches match l -- | This function attempts to provide a better tab completion result in -- cases where more than one file matches our prefix. Consider directory with -- following files: @["Main.hs", "Main.hi", "Main.o", "Test.py", "Foo.hs"]@. -- -- After inserting @Mai@ into the minibuffer and attempting to complete, the -- possible matches will be filtered in 'completeInList'' to -- @["Main.hs", "Main.hi", "Main.o"]@ however because of multiple matches, -- the buffer will not be updated to say @Main.@ but will instead stay at @Mai@. -- -- This is extremely tedious when trying to complete filenames in directories -- with many files so here we try to catch common prefixes of filtered files and -- if the result is longer than what we have, we use it instead. bestMatch :: [T.Text] -> T.Text -> T.Text bestMatch fs s = let p = commonTPrefix' fs in if T.length p > T.length s then p else s filterMatches :: Eq a => (b -> Maybe a) -> [b] -> [a] filterMatches match = nub . catMaybes . fmap match -- Not really necessary but a bit faster than @(length l) == 1@ isSingleton :: [a] -> Bool isSingleton [_] = True isSingleton _ = False yi-0.12.6/src/library/Yi/Config.hs0000644000000000000000000000175612717763531015011 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Config -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Module exposing common user settings. Users most likely want to be starting -- with "Yi.Config.Default". module Yi.Config ( Config(..), UIConfig(..), UIBoot, CursorStyle(..) , module Yi.Config.Lens , configStyle, configFundamentalMode, configTopLevelKeymap ) where import Data.Prototype (extractValue) import Yi.Config.Lens import Yi.Style (UIStyle) import Yi.Types (AnyMode, Config (..), CursorStyle (..), Keymap, UIBoot, UIConfig (..), extractTopKeymap) configStyle :: UIConfig -> UIStyle configStyle = extractValue . configTheme configFundamentalMode :: Config -> AnyMode configFundamentalMode = last . modeTable configTopLevelKeymap :: Config -> Keymap configTopLevelKeymap = extractTopKeymap . defaultKm yi-0.12.6/src/library/Yi/Config/Default.hs0000644000000000000000000002417512717763531016375 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Yi.Config.Default ( defaultConfig, availableFrontends, defaultEmacsConfig , defaultVimConfig, defaultCuaConfig, toVimStyleConfig , toEmacsStyleConfig, toCuaStyleConfig) where import Control.Applicative import Control.Lens ((.~), (^.), use) import Control.Monad import Data.Default import qualified Data.HashMap.Strict as HM import qualified Data.Map as M import Data.Monoid import Paths_yi import System.FilePath import Yi.Buffer import Yi.Command (cabalBuildE, cabalConfigureE, grepFind, makeBuild, reloadProjectE, searchSources, shell) import Yi.Config import Yi.Config.Misc import Yi.Core (errorEditor, quitEditor) import Yi.Editor import Yi.Eval (publishedActions) import Yi.File import qualified Yi.Interact as I import Yi.IReader (saveAsNewArticle) import Yi.Keymap import qualified Yi.Keymap.Cua as Cua import qualified Yi.Keymap.Emacs as Emacs import Yi.Keymap.Keys import qualified Yi.Keymap.Vim as Vim import Yi.Layout import qualified Yi.Mode.Abella as Abella import qualified Yi.Mode.Haskell as Haskell import Yi.Mode.IReader (ireadMode, ireaderMode) import qualified Yi.Mode.JavaScript as JS import qualified Yi.Mode.Latex as Latex import Yi.Modes import qualified Yi.Rope as R import Yi.Search import Yi.Style.Library import qualified Yi.UI.Batch import Yi.Utils import Yi.Types () #ifdef FRONTEND_VTY import qualified Graphics.Vty.Config as Vty import qualified Yi.UI.Vty #endif #ifdef FRONTEND_PANGO import qualified Yi.UI.Pango #endif availableFrontends :: [(String, UIBoot)] availableFrontends = #ifdef FRONTEND_VTY ("vty", Yi.UI.Vty.start) : #endif #ifdef FRONTEND_PANGO ("pango", Yi.UI.Pango.start) : #endif [("batch", Yi.UI.Batch.start)] -- | List of published Actions -- THIS MUST BE OF THE FORM: -- ("symbol", box symbol") -- ... so we can hope getting rid of this someday. -- Failing to conform to this rule exposes the code to instant deletion. -- -- TODO: String → Text/YiString defaultPublishedActions :: HM.HashMap String Action defaultPublishedActions = HM.fromList [ ("atBoundaryB" , box atBoundaryB) , ("cabalBuildE" , box cabalBuildE) , ("cabalConfigureE" , box cabalConfigureE) , ("closeBufferE" , box closeBufferE) , ("deleteB" , box deleteB) , ("deleteBlankLinesB" , box deleteBlankLinesB) , ("getSelectRegionB" , box getSelectRegionB) , ("grepFind" , box grepFind) , ("insertB" , box insertB) , ("iread" , box ireadMode) , ("ireadSaveAsArticle" , box saveAsNewArticle) , ("leftB" , box leftB) , ("linePrefixSelectionB" , box linePrefixSelectionB) , ("lineStreamB" , box lineStreamB) -- , ("mkRegion" , box mkRegion) -- can't make 'instance Promptable Region' , ("makeBuild" , box makeBuild) , ("moveB" , box moveB) , ("numberOfB" , box numberOfB) , ("pointB" , box pointB) , ("regionOfB" , box regionOfB) , ("regionOfPartB" , box regionOfPartB) , ("regionOfPartNonEmptyB" , box regionOfPartNonEmptyB) , ("reloadProjectE" , box reloadProjectE) , ("replaceString" , box replaceString) , ("revertE" , box revertE) , ("shell" , box shell) , ("searchSources" , box searchSources) , ("setAnyMode" , box setAnyMode) , ("sortLines" , box sortLines) , ("unLineCommentSelectionB", box unLineCommentSelectionB) , ("writeB" , box writeB) , ("ghciGet" , box Haskell.ghciGet) , ("abella" , box Abella.abella) ] where box :: (Show x, YiAction a x) => a -> Action box = makeAction defaultConfig :: Config defaultConfig = publishedActions .~ defaultPublishedActions $ Config { startFrontEnd = case availableFrontends of [] -> error "panic: no frontend compiled in! (configure with -fvty or another frontend.)" ((_,f):_) -> f , configUI = UIConfig { configFontSize = Just 10 , configFontName = Nothing , configScrollWheelAmount = 4 , configScrollStyle = Nothing , configCursorStyle = FatWhenFocusedAndInserting , configLineWrap = True , configLeftSideScrollBar = True , configAutoHideScrollBar = False , configAutoHideTabBar = True , configWindowFill = ' ' , configTheme = defaultTheme #ifdef FRONTEND_VTY , configVty = def #endif } , defaultKm = modelessKeymapSet nilKeymap , startActions = [] , initialActions = [] , modeTable = [AnyMode Haskell.cleverMode, AnyMode Haskell.preciseMode, AnyMode Latex.latexMode3, AnyMode Latex.fastMode, AnyMode Abella.abellaModeEmacs, AnyMode cMode, AnyMode objectiveCMode, AnyMode cppMode, AnyMode Haskell.literateMode, AnyMode cabalMode, AnyMode clojureMode, AnyMode gnuMakeMode, AnyMode srmcMode, AnyMode ocamlMode, AnyMode ottMode, AnyMode perlMode, AnyMode (JS.hooks JS.javaScriptMode), AnyMode pythonMode, AnyMode rubyMode, AnyMode javaMode, AnyMode jsonMode, AnyMode ireaderMode, AnyMode svnCommitMode, AnyMode gitCommitMode, AnyMode whitespaceMode, AnyMode fundamentalMode] , debugMode = False , configKillringAccumulate = False , configCheckExternalChangesObsessively = True , configRegionStyle = Exclusive , configInputPreprocess = I.idAutomaton , bufferUpdateHandler = [] , layoutManagers = [hPairNStack 1, vPairNStack 1, tall, wide] , configVars = mempty } defaultEmacsConfig, defaultVimConfig, defaultCuaConfig :: Config defaultEmacsConfig = toEmacsStyleConfig defaultConfig defaultVimConfig = toVimStyleConfig defaultConfig defaultCuaConfig = toCuaStyleConfig defaultConfig toEmacsStyleConfig, toVimStyleConfig, toCuaStyleConfig :: Config -> Config toEmacsStyleConfig cfg = cfg { configUI = (configUI cfg) { configScrollStyle = Just SnapToCenter #ifdef FRONTEND_VTY -- corey: does this actually matter? escToMeta appears to perform all the -- meta joining required. I'm not an emacs user and cannot evaluate feel. For -- me these settings join esc;key to meta-key OK. The 100 millisecond lag in -- ESC is terrible for me. Maybe that's just how it is under emacs... , configVty = def { Vty.vtime = Just 100, Vty.vmin = Just 2 } #endif }, defaultKm = Emacs.keymap, startActions = makeAction openScratchBuffer : startActions cfg, configInputPreprocess = escToMeta, configKillringAccumulate = True } -- | Input preprocessor: Transform Esc;Char into Meta-Char -- Useful for emacs lovers ;) escToMeta :: I.P Event Event escToMeta = mkAutomaton $ forever $ (anyEvent >>= I.write) ||> do void $ event (spec KEsc) c <- printableChar I.write (Event (KASCII c) [MMeta]) toVimStyleConfig cfg = cfg { defaultKm = Vim.keymapSet , configUI = (configUI cfg) { configScrollStyle = Just SingleLine #ifdef FRONTEND_VTY , configVty = (configVty (configUI cfg)) { Vty.vtime = Just 0 } #endif } , configRegionStyle = Inclusive } toCuaStyleConfig cfg = cfg {defaultKm = Cua.keymap} -- | Open an emacs-like scratch buffer if no file is open. openScratchBuffer :: YiM () openScratchBuffer = withEditor $ do fileBufOpen <- any isFileOrDir . M.elems <$> use buffersA unless fileBufOpen $ void . newBufferE (MemBuffer "scratch") $ R.unlines [ "This buffer is for notes you don't want to save." , "If you want to create a file, open that file," , "then enter the text in that file's own buffer." , "" ] where isFileOrDir :: FBuffer -> Bool isFileOrDir attrs = case attrs ^. identA of MemBuffer _ -> attrs ^. directoryContentA FileBuffer _ -> True nilKeymap :: Keymap nilKeymap = choice [ char 'q' ?>>! quitEditor, char 'h' ?>>! configHelp ] <|| (anyEvent >>! errorEditor "Keymap not defined, 'q' to quit, 'h' for help.") where configHelp :: YiM () configHelp = do dataDir <- io getDataDir let x y = R.fromString (x y) welcomeText = R.unlines [ "This instance of Yi is not configured." , "" , "To get a standard reasonable keymap, you can run yi with" , "either --as=cua, --as=vim or --as=emacs." , "" , "You should however create your own ~/.config/yi/yi.hs file." , "As a starting point it's recommended to use one of the configs" , "from " <> (dataDir "example-configs/") , "" ] withEditor_ $ newBufferE (MemBuffer "configuration help") welcomeText yi-0.12.6/src/library/Yi/Config/Misc.hs0000644000000000000000000000011212533751517015662 0ustar0000000000000000module Yi.Config.Misc where data ScrollStyle = SnapToCenter | SingleLine yi-0.12.6/src/library/Yi/Config/Lens.hs0000644000000000000000000000142012717763531015676 0ustar0000000000000000{-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Config.Lens -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Lenses for types exported in Yi.Config. This module serves as a -- convenience module, for easy re-exporting. module Yi.Config.Lens where import Control.Lens (Lens) import Data.Default (Default (def)) import Data.DynamicState (_dyn) import Yi.Types (Config (..), UIConfig (..), YiConfigVariable) import Yi.Utils (makeLensesWithSuffix) makeLensesWithSuffix "A" ''Config makeLensesWithSuffix "A" ''UIConfig configVariable :: YiConfigVariable a => Lens Config Config a a configVariable = configVarsA . _dyn def yi-0.12.6/src/library/Yi/Config/Simple.hs0000644000000000000000000003153212717763531016235 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Rank2Types #-} {-# OPTIONS_GHC -fno-warn-duplicate-exports #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Config.Simple -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- A simplified configuration interface for Yi. -- -- This module provides a simple configuration API, allowing users to -- start with an initial configuration and imperatively (monadically) -- modify it. Some common actions (keybindings, selecting modes, -- choosing the frontend) have been given special commands -- ('globalBindKeys', 'setFrontendPreferences', 'addMode', and so on). -- -- A simple configuration might look like the following: -- -- @ -- import Yi.Config.Simple -- import qualified Yi.Mode.Haskell as Haskell -- -- note: don't import "Yi", or else there will be name clashes -- -- main = 'configMain' 'defaultEmacsConfig' $ do -- 'setFrontendPreferences' ["pango", "vty"] -- 'fontSize' '%=' 'Just' 10 -- 'modeBindKeys' Haskell.cleverMode ('metaCh' \'q\' '?>>!' 'reload') -- 'globalBindKeys' ('metaCh' \'r\' '?>>!' 'reload') -- @ -- -- A lot of the fields here are specified with the 'Field' type. To write -- a field, use ('%='). To read, use 'get'. For modification, use -- ('modify'). For example, the functions @foo@ and @bar@ are equivalent: -- -- @ -- foo = 'modify' 'layoutManagers' 'reverse' -- bar = do -- lms <- 'get' 'layoutManagers' -- 'layoutManagers' '%=' 'reverse' lms -- @ module Yi.Config.Simple ( -- * The main interface ConfigM, configMain, Field, -- * Frontend setFrontendPreferences, setFrontend, -- * Modes, commands, and keybindings globalBindKeys, modeBindKeys, modeBindKeysByName, addMode, modifyMode, modifyModeByName, -- * Evaluation of commands evaluator, #ifdef HINT ghciEvaluator, #endif publishedActionsEvaluator, publishAction, publishedActions, -- * Appearance fontName, fontSize, scrollWheelAmount, scrollStyle, ScrollStyle(..), cursorStyle, CursorStyle(..), Side(..), scrollBarSide, autoHideScrollBar, autoHideTabBar, lineWrap, windowFill, theme, -- ** Layout layoutManagers, -- * Debugging debug, -- * Startup hooks runOnStartup, runAfterStartup, -- * Advanced -- $advanced startActions, initialActions, defaultKm, inputPreprocess, modes, regionStyle, killringAccumulate, bufferUpdateHandler, -- * Module exports -- we can't just export 'module Yi', because then we would get -- clashes with Yi.Config module Yi.Boot, module Yi.Buffer, module Yi.Core, module Yi.Dired, module Yi.Editor, module Yi.File, module Yi.Config, module Yi.Config.Default, module Yi.Keymap, module Yi.Keymap.Keys, module Yi.Layout, module Yi.Search, module Yi.Style, module Yi.Style.Library, module Yi.Misc, module Yi.Mode.Haskell, ) where import Control.Applicative import Control.Lens (Lens', (.=), (%=), (%~), use, lens) import Control.Monad.State hiding (modify, get) import Data.Maybe(mapMaybe) import qualified Data.Text as T import Text.Printf(printf) import Yi.Boot import Yi.Buffer hiding (modifyMode) import Yi.Config.Default import Yi.Config.Misc import Yi.Config.Simple.Types import Yi.Core import Yi.Dired import Yi.Editor import Yi.Eval import Yi.File import Yi.Keymap import Yi.Keymap.Keys import Yi.Layout import Yi.Misc import Yi.Mode.Haskell import Yi.Search import Yi.Style import Yi.Style.Library import Yi.Utils -- we do explicit imports because we reuse a lot of the names import Yi.Config(Config, UIConfig, startFrontEndA, configUIA, startActionsA, initialActionsA, defaultKmA, configInputPreprocessA, modeTableA, debugModeA, configRegionStyleA, configKillringAccumulateA, bufferUpdateHandlerA, configFontNameA, configFontSizeA, configScrollWheelAmountA, configScrollStyleA, configCursorStyleA, CursorStyle(..), configLeftSideScrollBarA, configAutoHideScrollBarA, configAutoHideTabBarA, configLineWrapA, configWindowFillA, configThemeA, layoutManagersA, configVarsA, #ifdef FRONTEND_VTY configVtyA #endif ) --------------- Main interface -- newtype ConfigM a (imported) -- | Starts with the given initial config, makes the described -- modifications, then starts yi. configMain :: Config -> ConfigM () -> IO () configMain c m = yi =<< execStateT (runConfigM m) c ---------------------------------- Frontend -- | Sets the frontend to the first frontend from the list which is -- installed. -- -- Available frontends are a subset of: \"vty\", \"pango\", and -- \"batch\". setFrontendPreferences :: [String] -> ConfigM () setFrontendPreferences fs = case mapMaybe (`lookup` availableFrontends) fs of (f:_) -> startFrontEndA .= f [] -> return () -- | Sets the frontend, if it is available. setFrontend :: String -> ConfigM () setFrontend f = case lookup f availableFrontends of Nothing -> return () Just x -> startFrontEndA .= x ------------------------- Modes, commands, and keybindings -- | Adds the given key bindings to the `global keymap'. The bindings -- will override existing bindings in the case of a clash. globalBindKeys :: Keymap -> ConfigM () globalBindKeys a = (defaultKmA . topKeymapA) %= (||> a) -- | @modeBindKeys mode keys@ adds the keybindings in @keys@ to all -- modes with the same name as @mode@. -- -- As with 'modifyMode', a mode by the given name must already be -- registered, or the function will have no effect, and issue a -- command-line warning. modeBindKeys :: Mode syntax -> Keymap -> ConfigM () modeBindKeys mode keys = ensureModeRegistered "modeBindKeys" (modeName mode) boundKeys where boundKeys = modeBindKeysByName (modeName mode) keys -- | @modeBindKeysByName name keys@ adds the keybindings in @keys@ to -- all modes with name @name@ (if it is registered). Consider using -- 'modeBindKeys' instead. modeBindKeysByName :: T.Text -> Keymap -> ConfigM () modeBindKeysByName name k = ensureModeRegistered "modeBindKeysByName" name modMode where f :: (KeymapSet -> KeymapSet) -> KeymapSet -> KeymapSet f mkm km = topKeymapA %~ (||> k) $ mkm km modMode = modifyModeByName name (modeKeymapA %~ f) -- | Register the given mode. It will be preferred over any modes -- already defined. addMode :: Mode syntax -> ConfigM () addMode m = modeTableA %= (AnyMode m :) -- | @modifyMode mode f@ modifies all modes with the same name as -- @mode@, using the function @f@. -- -- Note that the @mode@ argument is only used by its 'modeName'. In -- particular, a mode by the given name must already be registered, or -- this function will have no effect, and issue a command-line -- warning. -- -- @'modifyMode' mode f = 'modifyModeByName' ('modeName' mode) f@ modifyMode :: Mode syntax -> (forall syntax'. Mode syntax' -> Mode syntax') -> ConfigM () modifyMode mode f = ensureModeRegistered "modifyMode" (modeName mode) modMode where modMode = modifyModeByName (modeName mode) f -- | @modifyModeByName name f@ modifies the mode with name @name@ -- using the function @f@. Consider using 'modifyMode' instead. modifyModeByName :: T.Text -> (forall syntax. Mode syntax -> Mode syntax) -> ConfigM () modifyModeByName name f = ensureModeRegistered "modifyModeByName" name $ modeTableA %= fmap (onMode g) where g :: forall syntax. Mode syntax -> Mode syntax g m | modeName m == name = f m | otherwise = m -- helper functions warn :: String -> String -> ConfigM () warn caller msg = io $ putStrLn $ printf "Warning: %s: %s" caller msg -- the putStrLn shouldn't be necessary, but it doesn't print anything -- if it's not there... isModeRegistered :: T.Text -> ConfigM Bool isModeRegistered name = any (\(AnyMode mode) -> modeName mode == name) <$> use modeTableA -- ensure the given mode is registered, and if it is, then run the given action. ensureModeRegistered :: String -> T.Text -> ConfigM () -> ConfigM () ensureModeRegistered caller name m = do isRegistered <- isModeRegistered name if isRegistered then m else warn caller (printf "mode \"%s\" is not registered." (T.unpack name)) --------------------- Appearance -- | 'Just' the font name, or 'Nothing' for default. fontName :: Field (Maybe String) fontName = configUIA . configFontNameA -- | 'Just' the font size, or 'Nothing' for default. fontSize :: Field (Maybe Int) fontSize = configUIA . configFontSizeA -- | Amount to move the buffer when using the scroll wheel. scrollWheelAmount :: Field Int scrollWheelAmount = configUIA . configScrollWheelAmountA -- | 'Just' the scroll style, or 'Nothing' for default. scrollStyle :: Field (Maybe ScrollStyle) scrollStyle = configUIA . configScrollStyleA -- | See 'CursorStyle' for documentation. cursorStyle :: Field CursorStyle cursorStyle = configUIA . configCursorStyleA data Side = LeftSide | RightSide -- | Which side to display the scroll bar on. scrollBarSide :: Field Side scrollBarSide = configUIA . configLeftSideScrollBarA . fromBool where fromBool :: Lens' Bool Side fromBool = lens (\b -> if b then LeftSide else RightSide) (\_ s -> case s of { LeftSide -> True; RightSide -> False }) -- | Should the scroll bar autohide? autoHideScrollBar :: Field Bool autoHideScrollBar = configUIA . configAutoHideScrollBarA -- | Should the tab bar autohide? autoHideTabBar :: Field Bool autoHideTabBar = configUIA . configAutoHideTabBarA -- | Should lines be wrapped? lineWrap :: Field Bool lineWrap = configUIA . configLineWrapA -- | The character with which to fill empty window space. Usually -- \'~\' for vi-like editors, \' \' for everything else. windowFill :: Field Char windowFill = configUIA . configWindowFillA -- | UI colour theme. theme :: Field Theme theme = configUIA . configThemeA ---------- Layout -- | List of registered layout managers. When cycling through layouts, -- this list will be consulted. layoutManagers :: Field [AnyLayoutManager] layoutManagers = layoutManagersA ------------------------ Debugging -- | Produce a .yi.dbg file with debugging information? debug :: Field Bool debug = debugModeA ----------- Startup hooks -- | Run when the editor is started (this is run after all actions -- which have already been registered) runOnStartup :: Action -> ConfigM () runOnStartup action = runManyOnStartup [action] -- | List version of 'runOnStartup'. runManyOnStartup :: [Action] -> ConfigM () runManyOnStartup actions = startActions %= (++ actions) -- | Run after the startup actions have completed, or on reload (this -- is run after all actions which have already been registered) runAfterStartup :: Action -> ConfigM () runAfterStartup action = runManyAfterStartup [action] -- | List version of 'runAfterStartup'. runManyAfterStartup :: [Action] -> ConfigM () runManyAfterStartup actions = initialActions %= (++ actions) ------------------------ Advanced {- $advanced These fields are here for completeness -- that is, to expose all the functionality of the "Yi.Config" module. However, most users probably need not use these fields, typically because they provide advanced functinality, or because a simpler interface for the common case is available above. -} -- | Actions to run when the editor is started. Consider using -- 'runOnStartup' or 'runManyOnStartup' instead. startActions :: Field [Action] startActions = startActionsA -- | Actions to run after startup or reload. Consider using -- 'runAfterStartup' or 'runManyAfterStartup' instead. initialActions :: Field [Action] initialActions = initialActionsA -- | Default keymap to use. defaultKm :: Field KeymapSet defaultKm = defaultKmA -- | ? inputPreprocess :: Field (P Event Event) inputPreprocess = configInputPreprocessA -- | List of modes by order of preference. Consider using 'addMode', -- 'modeBindKeys', or 'modifyMode' instead. modes :: Field [AnyMode] modes = modeTableA -- | Set to 'Exclusive' for an emacs-like behaviour. Consider starting -- with 'defaultEmacsConfig', 'defaultVimConfig', or -- 'defaultCuaConfig' to instead. regionStyle :: Field RegionStyle regionStyle = configRegionStyleA -- | Set to 'True' for an emacs-like behaviour, where all deleted text -- is accumulated in a killring. Consider starting with -- 'defaultEmacsConfig', 'defaultVimConfig', or 'defaultCuaConfig' -- instead. killringAccumulate :: Field Bool killringAccumulate = configKillringAccumulateA -- | ? bufferUpdateHandler :: Field [[Update] -> BufferM ()] bufferUpdateHandler = bufferUpdateHandlerA yi-0.12.6/src/library/Yi/Config/Simple/Types.hs0000644000000000000000000000265012717763531017340 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE Rank2Types #-} -- | exports from "Yi.Config.Simple" which are useful to \"core yi\" rather than just config files. module Yi.Config.Simple.Types where import Control.Applicative (Applicative) import Control.Lens (Lens') import Control.Monad.Base (MonadBase) import Control.Monad.State (MonadState, StateT) import Yi.Config (Config, configVariable) import Yi.Types (YiConfigVariable) -- | The configuration monad. Run it with 'configMain'. newtype ConfigM a = ConfigM { runConfigM :: StateT Config IO a } deriving (Monad, Functor, Applicative, MonadState Config, MonadBase IO) -- | Fields that can be modified with all lens machinery. type Field a = Lens' Config a {- | Accessor for any 'YiConfigVariable', to be used by modules defining 'YiConfigVariable's. Such modules should provide a custom-named field. For instance, take the following hypothetical 'YiConfigVariable': @newtype UserName = UserName { unUserName :: String } deriving(Typeable, Binary, Default) instance YiConfigVariable UserName $(nameDeriveAccessors ''UserName (\n -> Just (n ++ \"A\"))) userName :: 'Field' 'String' userName = unUserNameA '.' 'customVariable'@ Here, the hypothetical library would provide the field @userName@ to be used in preference to @customVariable@. -} customVariable :: YiConfigVariable a => Field a customVariable = configVariable yi-0.12.6/src/library/Yi/Core.hs0000644000000000000000000005531112717763531014470 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE RecursiveDo #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Core -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- The core actions of Yi. This module is the link between the editor -- and the UI. Key bindings, and libraries should manipulate Yi -- through the interface defined here. module Yi.Core ( -- * Construction and destruction startEditor , quitEditor -- :: YiM () -- * User interaction , refreshEditor -- :: YiM () , suspendEditor -- :: YiM () , userForceRefresh -- * Global editor actions , errorEditor -- :: String -> YiM () , closeWindow -- :: YiM () , closeWindowEmacs -- * Interacting with external commands , runProcessWithInput -- :: String -> String -> YiM String , startSubprocess -- :: FilePath -> [String] -> YiM () , sendToProcess -- * Misc , runAction , withSyntax , focusAllSyntax , forkAction ) where import Prelude hiding (elem, mapM_, or) import Control.Applicative (Applicative (pure), (<$>)) import Control.Concurrent (ThreadId, forkIO, forkOS, modifyMVar, modifyMVar_, newMVar, readMVar, threadDelay) import Control.Exc (ignoringException) import Control.Exception (SomeException, handle) import Control.Lens (assign, mapped, use, uses, view, (%=), (%~), (&), (.=), (.~), (^.)) import Control.Monad (forever, void, when) import Control.Monad.Base (MonadBase (liftBase)) import Control.Monad.Error () import Control.Monad.Reader (MonadReader (ask), ReaderT (runReaderT), asks) import qualified Data.DelayList as DelayList (decrease, insert) import Data.Foldable (Foldable (foldMap), elem, find, forM_, mapM_, or, toList) import Data.List (partition) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.PointedList.Circular as PL (PointedList (_focus), length) import Data.List.Split (splitOn) import qualified Data.Map as M (assocs, delete, empty, fromList, insert, member) import Data.Maybe (fromMaybe, isNothing) import Data.Monoid (First (First, getFirst), (<>)) import qualified Data.Text as T (Text, pack, unwords) import Data.Time (getCurrentTime) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Traversable (forM) import GHC.Conc (labelThread) import System.Directory (doesFileExist) import System.Exit (ExitCode) import System.IO (Handle, hPutStr, hWaitForInput) import System.PosixCompat.Files (getFileStatus, modificationTime) import System.Process (ProcessHandle, getProcessExitCode, readProcessWithExitCode, terminateProcess) import Yi.Buffer import Yi.Config import Yi.Debug (logPutStrLn) import Yi.Editor import Yi.Keymap import Yi.Keymap.Keys import Yi.KillRing (krEndCmd) import Yi.Monad (gets) import Yi.PersistentState (loadPersistentState, savePersistentState) import Yi.Process import qualified Yi.Rope as R (YiString, fromString, readFile) import Yi.String (chomp, showT) import Yi.Style (errorStyle, strongHintStyle) import qualified Yi.UI.Common as UI (UI (end, layout, main, refresh, suspend, userForceRefresh)) import Yi.Utils (io) import Yi.Window (bufkey, dummyWindow, isMini, winRegion, wkey) -- | Make an action suitable for an interactive run. -- UI will be refreshed. interactive :: IsRefreshNeeded -> [Action] -> YiM () interactive isRefreshNeeded action = do evs <- withEditor $ use pendingEventsA logPutStrLn $ ">>> interactively" <> showEvs evs withEditor $ buffersA %= (fmap $ undosA %~ addChangeU InteractivePoint) mapM_ runAction action withEditor $ killringA %= krEndCmd when (isRefreshNeeded == MustRefresh) refreshEditor logPutStrLn "<<<" return () -- --------------------------------------------------------------------- -- | Start up the editor, setting any state with the user preferences -- and file names passed in, and turning on the UI -- startEditor :: Config -> Maybe Editor -> IO () startEditor cfg st = do let uiStart = startFrontEnd cfg logPutStrLn "Starting Core" -- Use an empty state unless resuming from an earlier session and -- one is already available let editor = fromMaybe emptyEditor st -- here to add load history etc? -- Setting up the 1st window is a bit tricky because most -- functions assume there exists a "current window" newSt <- newMVar $ YiVar editor 1 M.empty (ui, runYi) <- mdo let handler (exception :: SomeException) = runYi $ errorEditor (showT exception) >> refreshEditor inF [] = return () inF (e:es) = handle handler $ runYi $ dispatch (e :| es) outF refreshNeeded acts = handle handler $ runYi $ interactive refreshNeeded acts runYi f = runReaderT (runYiM f) yi yi = Yi ui inF outF cfg newSt ui <- uiStart cfg inF (outF MustRefresh) editor return (ui, runYi) runYi loadPersistentState runYi $ do if isNothing st -- process options if booting for the first time then postActions NoNeedToRefresh $ startActions cfg -- otherwise: recover the mode of buffers else withEditor $ buffersA.mapped %= recoverMode (modeTable cfg) postActions NoNeedToRefresh $ initialActions cfg ++ [makeAction showErrors] runYi refreshEditor UI.main ui -- transfer control to UI -- | Runs a 'YiM' action in a separate thread. -- -- Notes: -- -- * It seems to work but I don't know why -- -- * Maybe deadlocks? -- -- * If you're outputting into the Yi window, you should really limit -- the rate at which you do so: for example, the Pango front-end will -- quite happily segfault/double-free if you output too fast. -- -- I am exporting this for those adventurous to play with but I have -- only discovered how to do this a night before the release so it's -- rather experimental. A simple function that prints a message once a -- second, 5 times, could be written like this: -- -- @ -- printer :: YiM ThreadId -- printer = do -- mv <- io $ newMVar (0 :: Int) -- forkAction (suicide mv) MustRefresh $ do -- c <- io $ do -- modifyMVar_ mv (return . succ) -- tryReadMVar mv -- case c of -- Nothing -> printMsg "messaging unknown time" -- Just x -> printMsg $ "message #" <> showT x -- where -- suicide mv = tryReadMVar mv >>= \case -- Just i | i >= 5 -> return True -- _ -> threadDelay 1000000 >> return False -- @ forkAction :: (YiAction a x, Show x) => IO Bool -- ^ runs after we insert the action: this may be a -- thread delay or a thread suicide or whatever else; -- when delay returns False, that's our signal to -- terminate the thread. -> IsRefreshNeeded -- ^ should we refresh after each action -> a -- ^ The action to actually run -> YiM ThreadId forkAction delay ref ym = onYiVar $ \yi yv -> do let loop = do yiOutput yi ref [makeAction ym] delay >>= \b -> when b loop t <- forkIO loop return (yv, t) recoverMode :: [AnyMode] -> FBuffer -> FBuffer recoverMode tbl buffer = case fromMaybe (AnyMode emptyMode) (find (\(AnyMode m) -> modeName m == oldName) tbl) of AnyMode m -> setMode0 m buffer where oldName = case buffer of FBuffer {bmode = m} -> modeName m postActions :: IsRefreshNeeded -> [Action] -> YiM () postActions refreshNeeded actions = do yi <- ask; liftBase $ yiOutput yi refreshNeeded actions -- | Display the errors buffer if it is not already visible. showErrors :: YiM () showErrors = withEditor $ do bs <- gets $ findBufferWithName "*errors*" case bs of [] -> return () _ -> do splitE switchToBufferWithNameE "*errors*" -- | Process events by advancing the current keymap automaton and -- executing the generated actions. dispatch :: NonEmpty Event -> YiM () dispatch (ev :| evs) = do yi <- ask (userActions, _p') <- withCurrentBuffer $ do keymap <- gets (withMode0 modeKeymap) p0 <- use keymapProcessA let km = extractTopKeymap $ keymap $ defaultKm $ yiConfig yi let freshP = Chain (configInputPreprocess $ yiConfig yi) (mkAutomaton km) p = case computeState p0 of Dead -> freshP _ -> p0 (actions, p') = processOneEvent p ev state = computeState p' ambiguous = case state of Ambiguous _ -> True _ -> False assign keymapProcessA (if ambiguous then freshP else p') let actions0 = case state of Dead -> [EditorA $ do evs' <- use pendingEventsA printMsg ("Unrecognized input: " <> showEvs (evs' ++ [ev]))] _ -> actions actions1 = [ EditorA (printMsg "Keymap was in an ambiguous state! Resetting it.") | ambiguous] return (actions0 ++ actions1, p') let decay, pendingFeedback :: EditorM () decay = statusLinesA %= DelayList.decrease 1 pendingFeedback = do pendingEventsA %= (++ [ev]) if null userActions then printMsg . showEvs =<< use pendingEventsA else assign pendingEventsA [] allActions = [makeAction decay] ++ userActions ++ [makeAction pendingFeedback] case evs of [] -> postActions MustRefresh allActions (e:es) -> postActions NoNeedToRefresh allActions >> dispatch (e :| es) showEvs :: [Event] -> T.Text showEvs = T.unwords . fmap (T.pack . prettyEvent) -- --------------------------------------------------------------------- -- Meta operations -- | Quit. quitEditor :: YiM () quitEditor = do savePersistentState onYiVar $ terminateSubprocesses (const True) withUI (`UI.end` True) -- | Update (visible) buffers if they have changed on disk. -- FIXME: since we do IO here we must catch exceptions! checkFileChanges :: Editor -> IO Editor checkFileChanges e0 = do now <- getCurrentTime -- Find out if any file was modified "behind our back" by -- other processes. newBuffers <- forM (buffers e0) $ \b -> let nothing = return (b, Nothing) in if bkey b `elem` visibleBuffers then case b ^. identA of FileBuffer fname -> do fe <- doesFileExist fname if not fe then nothing else do modTime <- fileModTime fname if b ^. lastSyncTimeA < modTime then if isUnchangedBuffer b then R.readFile fname >>= return . \case Left m -> (runDummy b (readOnlyA .= True), Just $ msg3 m) Right (newContents, c) -> (runDummy b (revertB newContents (Just c) now), Just msg1) else return (b, Just msg2) else nothing _ -> nothing else nothing -- show appropriate update message if applicable return $ case getFirst (foldMap (First . snd) newBuffers) of Just msg -> (statusLinesA %~ DelayList.insert msg) e0 {buffers = fmap fst newBuffers} Nothing -> e0 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 = bufkey <$> windows e0 fileModTime f = posixSecondsToUTCTime . realToFrac . modificationTime <$> getFileStatus f runDummy b act = snd $ runBuffer (dummyWindow $ bkey b) b act -- | Hide selection, clear "syntax dirty" flag (as appropriate). clearAllSyntaxAndHideSelection :: Editor -> Editor clearAllSyntaxAndHideSelection = buffersA %~ fmap (clearSyntax . clearHighlight) where clearHighlight fb = -- if there were updates, then hide the selection. let h = view highlightSelectionA fb us = view pendingUpdatesA fb in highlightSelectionA .~ (h && null us) $ fb -- Focus syntax tree on the current window, for all visible buffers. focusAllSyntax :: Editor -> Editor focusAllSyntax e6 = buffersA %~ fmap (\b -> focusSyntax (regions b) b) $ e6 where regions b = M.fromList [(wkey w, winRegion w) | w <- toList $ windows e6, bufkey w == bkey b] -- Why bother filtering the region list? After all the trees -- are lazily computed. Answer: focusing is an incremental -- algorithm. Each "focused" path depends on the previous -- one. If we left unforced focused paths, we'd create a -- long list of thunks: a memory leak. -- | Redraw refreshEditor :: YiM () refreshEditor = onYiVar $ \yi var -> do let cfg = yiConfig yi runOnWins a = runEditor cfg (do ws <- use windowsA forM ws $ flip withWindowE a) style = configScrollStyle $ configUI cfg let scroll e3 = let (e4, relayout) = runOnWins (snapScreenB style) e3 in -- Scroll windows to show current points as appropriate -- Do another layout pass if there was any scrolling; (if or relayout then UI.layout (yiUi yi) else return) e4 e7 <- (if configCheckExternalChangesObsessively cfg then checkFileChanges else return) (yiEditor var) >>= return . clearAllSyntaxAndHideSelection >>= -- Adjust window sizes according to UI info UI.layout (yiUi yi) >>= scroll >>= -- Adjust point according to the current layout; return . fst . runOnWins snapInsB >>= return . focusAllSyntax >>= -- Clear "pending updates" and "followUp" from buffers. return . (buffersA %~ fmap (clearUpdates . clearFollow)) -- Display the new state of the editor UI.refresh (yiUi yi) e7 -- Terminate stale processes. terminateSubprocesses (staleProcess $ buffers e7) yi var {yiEditor = e7} where clearUpdates = pendingUpdatesA .~ [] clearFollow = pointFollowsWindowA .~ const False -- Is this process stale? (associated with a deleted buffer) staleProcess bs p = not (bufRef p `M.member` bs) -- | Suspend the program suspendEditor :: YiM () suspendEditor = withUI UI.suspend ------------------------------------------------------------------------ ------------------------------------------------------------------------ -- | Pipe a string through an external command, returning the stdout -- chomp any trailing newline (is this desirable?) -- -- Todo: varients with marks? -- runProcessWithInput :: String -> String -> YiM String runProcessWithInput cmd inp = do let (f:args) = splitOn " " cmd (_,out,_err) <- liftBase $ readProcessWithExitCode f args inp return (chomp "\n" out) ------------------------------------------------------------------------ -- | Same as 'Yi.Editor.printMsg', but do nothing instead of printing @()@ msgEditor :: T.Text -> YiM () msgEditor "()" = return () msgEditor s = printMsg s runAction :: Action -> YiM () runAction (YiA act) = act >>= msgEditor . showT runAction (EditorA act) = withEditor act >>= msgEditor . showT runAction (BufferA act) = withCurrentBuffer act >>= msgEditor . showT -- | Show an error on the status line and log it. errorEditor :: T.Text -> YiM () errorEditor s = do printStatus (["error: " <> s], errorStyle) logPutStrLn $ "errorEditor: " <> s -- | Close the current window. -- If this is the last window open, quit the program. -- -- CONSIDER: call quitEditor when there are no other window in the -- 'interactive' function. (Not possible since the windowset type -- disallows it -- should it be relaxed?) closeWindow :: YiM () closeWindow = do winCount <- withEditor $ uses windowsA PL.length tabCount <- withEditor $ uses tabsA PL.length when (winCount == 1 && tabCount == 1) quitEditor withEditor tryCloseE -- | This is a like 'closeWindow' but with emacs behaviour of C-x 0: -- if we're trying to close the minibuffer or last buffer in the -- editor, then just print a message warning the user about it rather -- closing mini or quitting editor. closeWindowEmacs :: YiM () closeWindowEmacs = do wins <- withEditor $ use windowsA let winCount = PL.length wins tabCount <- withEditor $ uses tabsA PL.length case () of _ | winCount == 1 && tabCount == 1 -> printMsg "Attempt to delete sole ordinary window" | isMini (PL._focus wins) -> printMsg "Attempt to delete the minibuffer" | otherwise -> withEditor tryCloseE onYiVar :: (Yi -> YiVar -> IO (YiVar, a)) -> YiM a onYiVar f = do yi <- ask io $ modifyMVar (yiVar yi) (f yi) -- | Kill a given subprocess terminateSubprocesses :: (SubprocessInfo -> Bool) -> Yi -> YiVar -> IO (YiVar, ()) terminateSubprocesses shouldTerminate _yi var = do let (toKill, toKeep) = partition (shouldTerminate . snd) $ M.assocs $ yiSubprocesses var void $ forM toKill $ terminateProcess . procHandle . snd return (var & yiSubprocessesA .~ M.fromList toKeep, ()) -- | Start a subprocess with the given command and arguments. startSubprocess :: FilePath -> [String] -> (Either SomeException ExitCode -> YiM x) -> YiM BufferRef startSubprocess cmd args onExit = onYiVar $ \yi var -> do let (e', bufref) = runEditor (yiConfig yi) (printMsg ("Launched process: " <> T.pack cmd) >> newEmptyBufferE (MemBuffer bufferName)) (yiEditor var) procid = yiSubprocessIdSupply var + 1 procinfo <- createSubprocess cmd args bufref startSubprocessWatchers procid procinfo yi onExit return (var & yiEditorA .~ e' & yiSubprocessIdSupplyA .~ procid & yiSubprocessesA %~ M.insert procid procinfo , bufref) where bufferName = T.unwords [ "output from", T.pack cmd, showT args ] startSubprocessWatchers :: SubprocessId -> SubprocessInfo -> Yi -> (Either SomeException ExitCode -> YiM x) -> IO () startSubprocessWatchers procid procinfo yi onExit = mapM_ (\(labelSuffix, run) -> do threadId <- forkOS run labelThread threadId (procCmd procinfo ++ labelSuffix)) ([("Err", pipeToBuffer (hErr procinfo) (send . append True)) | separateStdErr procinfo] ++ [("Out", pipeToBuffer (hOut procinfo) (send . append False)), ("Exit", waitForExit (procHandle procinfo) >>= reportExit)]) where send :: YiM () -> IO () send a = yiOutput yi MustRefresh [makeAction a] -- TODO: This 'String' here is due to 'pipeToBuffer' but I don't -- know how viable it would be to read from a process as Text. -- Probably not worse than String but needs benchmarking. append :: Bool -> String -> YiM () append atMark = withEditor . appendToBuffer atMark (bufRef procinfo) . R.fromString reportExit :: Either SomeException ExitCode -> IO () reportExit ec = send $ do append True $ "Process exited with " <> show ec removeSubprocess procid void $ onExit ec removeSubprocess :: SubprocessId -> YiM () removeSubprocess procid = asks yiVar >>= liftBase . flip modifyMVar_ (pure . (yiSubprocessesA %~ M.delete procid)) -- | Appends a 'R.YiString' to the given buffer. -- -- TODO: Figure out and document the Bool here. Probably to do with -- 'startSubprocessWatchers'. appendToBuffer :: Bool -- Something to do with stdout/stderr? -> BufferRef -- ^ Buffer to append to -> R.YiString -- ^ Text to append -> EditorM () appendToBuffer atErr bufref s = withGivenBuffer bufref $ do -- We make sure stdout is always after stderr. This ensures that -- the output of the two pipe do not get interleaved. More -- importantly, GHCi prompt should always come after the error -- messages. me <- getMarkB (Just "StdERR") mo <- getMarkB (Just "StdOUT") let mms = if atErr then [mo, me] else [mo] forM_ mms (`modifyMarkB` (markGravityAA .~ Forward)) insertNAt s =<< use (markPointA (if atErr then me else mo)) forM_ mms (`modifyMarkB` (markGravityAA .~ Backward)) sendToProcess :: BufferRef -> String -> YiM () sendToProcess bufref s = do yi <- ask find ((== bufref) . bufRef) . yiSubprocesses <$> liftBase (readMVar (yiVar yi)) >>= \case Just subProcessInfo -> io $ hPutStr (hIn subProcessInfo) s Nothing -> printMsg "Could not get subProcessInfo in sendToProcess" pipeToBuffer :: Handle -> (String -> IO ()) -> IO () pipeToBuffer h append = void . ignoringException . forever $ do _ <- hWaitForInput h (-1) r <- readAvailable h append r waitForExit :: ProcessHandle -> IO (Either SomeException ExitCode) waitForExit ph = handle (\e -> return (Left (e :: SomeException))) $ do mec <- getProcessExitCode ph case mec of Nothing -> threadDelay (500*1000) >> waitForExit ph Just ec -> return (Right ec) withSyntax :: (Show x, YiAction a x) => (forall syntax. Mode syntax -> syntax -> a) -> YiM () withSyntax f = do b <- gets currentBuffer act <- withGivenBuffer b $ withSyntaxB f runAction $ makeAction act userForceRefresh :: YiM () userForceRefresh = withUI UI.userForceRefresh yi-0.12.6/src/library/Yi/Debug.hs0000644000000000000000000000643012717763531014624 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Debug -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Debug utilities used throughout Yi. module Yi.Debug ( initDebug, trace, traceM, traceM_, logPutStrLn , logError, logStream, Yi.Debug.error ) where import Control.Concurrent ( dupChan, getChanContents, forkIO, myThreadId, Chan ) import Control.Monad.Base ( liftBase, MonadBase ) import Data.IORef ( readIORef, writeIORef, IORef, newIORef ) import Data.Monoid ( (<>) ) import qualified Data.Text as T ( pack, snoc, unpack, Text ) import GHC.Conc ( labelThread ) import System.IO ( hFlush, hPutStrLn, IOMode(WriteMode), openFile, Handle ) import System.IO.Unsafe ( unsafePerformIO ) #if __GLASGOW_HASKELL__ < 710 import Data.Time (formatTime, getCurrentTime) import System.Locale (defaultTimeLocale) #else import Data.Time (formatTime, getCurrentTime, defaultTimeLocale) #endif dbgHandle :: IORef (Maybe Handle) dbgHandle = unsafePerformIO $ newIORef Nothing {-# NOINLINE dbgHandle #-} -- | Set the file to which debugging output should be written. Though this -- is called /init/Debug. -- Debugging output is not created by default (i.e., if this function -- is never called.) -- The target file can not be changed, nor debugging disabled. initDebug :: FilePath -> IO () initDebug f = do hndl <- readIORef dbgHandle case hndl of Nothing -> do openFile f WriteMode >>= writeIORef dbgHandle . Just logPutStrLn "Logging initialized." Just _ -> logPutStrLn "Attempt to re-initialize the logging system." -- | Outputs the given string before returning the second argument. trace :: T.Text -> a -> a trace s e = unsafePerformIO $ logPutStrLn s >> return e {-# NOINLINE trace #-} error :: T.Text -> a error s = unsafePerformIO $ logPutStrLn s >> Prelude.error (T.unpack s) logPutStrLn :: MonadBase IO m => T.Text -> m () logPutStrLn s = liftBase $ readIORef dbgHandle >>= \case Nothing -> return () Just h -> do time <- getCurrentTime tId <- myThreadId let m = show tId ++ " " ++ T.unpack s hPutStrLn h $ formatTime defaultTimeLocale rfc822DateFormat' time ++ m hFlush h where -- A bug in rfc822DateFormat makes us use our own format string rfc822DateFormat' = "%a, %d %b %Y %H:%M:%S %Z" logError :: MonadBase IO m => T.Text -> m () logError s = logPutStrLn $ "error: " <> s logStream :: Show a => T.Text -> Chan a -> IO () logStream msg ch = do logPutStrLn $ "Logging stream " <> msg logThreadId <- forkIO $ logStreamThread msg ch labelThread logThreadId "LogStream" logStreamThread :: Show a => T.Text -> Chan a -> IO () logStreamThread msg ch = do stream <- getChanContents =<< dupChan ch mapM_ logPutStrLn [ msg `T.snoc` '(' <> T.pack (show i) `T.snoc` ')' <> T.pack (show event) | (event, i) <- zip stream [(0::Int)..] ] -- | Traces @x@ and returns @y@. traceM :: Monad m => T.Text -> a -> m a traceM x y = trace x $ return y -- | Like traceM, but returns (). traceM_ :: Monad m => T.Text -> m () traceM_ x = traceM x () yi-0.12.6/src/library/Yi/Dired.hs0000644000000000000000000013016712717763531014632 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} {-| Module : Yi.Dired License : GPL-2 Maintainer : yi-devel@googlegroups.com Stability : experimental Portability : portable A simple implementation for Yi. = TODO * add more comments * Support symlinks * Mark operations * search * Improve the colouring to show * loaded buffers * .hs files * marked files * Fix old mod dates (> 6months) to show year * Fix the 'number of links' field to show actual values not just 1... * Automatic support for browsing .zip, .gz files etc... -} module Yi.Dired ( dired , diredDir , diredDirBuffer , editFile ) where import GHC.Generics (Generic) import Control.Applicative ((<$>), (<|>)) import Control.Category ((>>>)) import Control.Exc (orException, printingException) import Control.Lens (assign, makeLenses, use, (%~), (&), (.=), (.~), (^.)) import Control.Monad.Reader (asks, foldM, unless, void, when) import Data.Binary (Binary) import Data.Char (toLower) import Data.Default (Default, def) import Data.Foldable (find, foldl') import Data.List (any, elem, sum, transpose) import qualified Data.Map as M (Map, assocs, delete, empty, findWithDefault, fromList, insert, keys, lookup, map, mapKeys, union, (!)) import Data.Maybe (fromMaybe) import Data.Monoid (mempty, (<>)) import qualified Data.Text as T (Text, pack, unpack) import qualified Data.Text.ICU as ICU (regex, find, unfold, group, MatchOption(..)) import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Typeable (Typeable) import System.CanonicalizePath (canonicalizePath) import System.Directory (copyFile, createDirectoryIfMissing, doesDirectoryExist, doesFileExist, getDirectoryContents, getPermissions, removeDirectoryRecursive, writable) import System.FilePath (dropTrailingPathSeparator, equalFilePath, isAbsolute, takeDirectory, takeFileName, ()) import System.FriendlyPath (userToCanonPath) import System.PosixCompat.Files (FileStatus, fileExist, fileGroup, fileMode, fileOwner, fileSize, getSymbolicLinkStatus, groupExecuteMode, groupReadMode, groupWriteMode, isBlockDevice, isCharacterDevice, isDirectory, isNamedPipe, isRegularFile, isSocket, isSymbolicLink, linkCount, modificationTime, otherExecuteMode, otherReadMode, otherWriteMode, ownerExecuteMode, ownerReadMode, ownerWriteMode, readSymbolicLink, readSymbolicLink, removeLink, rename, unionFileModes) import System.PosixCompat.Types (FileMode, GroupID, UserID) import System.PosixCompat.User (GroupEntry, GroupEntry (..), UserEntry (..), getAllGroupEntries, getAllUserEntries, getGroupEntryForID, getUserEntryForID, groupID, userID) import Text.Printf (printf) import Yi.Buffer import Yi.Config (modeTable) import Yi.Core (errorEditor) import Yi.Editor import Yi.Keymap (Keymap, YiM, topKeymapA) import Yi.Keymap.Keys import Yi.MiniBuffer (noHint, spawnMinibufferE, withMinibuffer, withMinibufferFree) import Yi.Misc (getFolder, promptFile) import Yi.Monad (gets) import qualified Yi.Rope as R import Yi.String (showT) import Yi.Style import Yi.Types (YiVariable, yiConfig) import Yi.Utils (io, makeLensesWithSuffix) #if __GLASGOW_HASKELL__ < 710 import System.Locale (defaultTimeLocale) import Data.Time (UTCTime, formatTime, getCurrentTime) #else import Data.Time (UTCTime, formatTime, getCurrentTime, defaultTimeLocale) #endif -- Have no idea how to keep track of this state better, so here it is ... data DiredOpState = DiredOpState { _diredOpSucCnt :: !Int -- ^ keep track of the num of successful operations , _diredOpForAll :: Bool -- ^ if True, DOChoice will be bypassed } deriving (Show, Eq, Typeable, Generic) instance Default DiredOpState where def = DiredOpState { _diredOpSucCnt = 0, _diredOpForAll = False } instance Binary DiredOpState instance YiVariable DiredOpState makeLenses ''DiredOpState data DiredFileInfo = DiredFileInfo { permString :: R.YiString , numLinks :: Integer , owner :: R.YiString , grp :: R.YiString , sizeInBytes :: Integer , modificationTimeString :: R.YiString } deriving (Show, Eq, Typeable, Generic) data DiredEntry = DiredFile DiredFileInfo | DiredDir DiredFileInfo | DiredSymLink DiredFileInfo R.YiString | DiredSocket DiredFileInfo | DiredBlockDevice DiredFileInfo | DiredCharacterDevice DiredFileInfo | DiredNamedPipe DiredFileInfo | DiredNoInfo deriving (Show, Eq, Typeable, Generic) -- | Alias serving as documentation of some arguments. We keep most -- paths as 'R.YiString' for the sole reason that we'll have to render -- them. type DiredFilePath = R.YiString -- | Handy alias for 'DiredEntry' map. type DiredEntries = M.Map DiredFilePath DiredEntry data DiredState = DiredState { diredPath :: FilePath -- ^ The full path to the directory being viewed -- FIXME Choose better data structure for Marks... , diredMarks :: M.Map FilePath Char -- ^ Map values are just leafnames, not full paths , diredEntries :: DiredEntries -- ^ keys are just leafnames, not full paths , diredFilePoints :: [(Point,Point,FilePath)] -- ^ position in the buffer where filename is , diredNameCol :: Int -- ^ position on line where filename is (all pointA are this col) , diredCurrFile :: FilePath -- ^ keep the position of pointer (for refreshing dired buffer) } deriving (Show, Eq, Typeable, Generic) makeLensesWithSuffix "A" ''DiredState instance Binary DiredState instance Default DiredState where def = DiredState { diredPath = mempty , diredMarks = mempty , diredEntries = mempty , diredFilePoints = mempty , diredNameCol = 0 , diredCurrFile = mempty } instance YiVariable DiredState instance Binary DiredEntry instance Binary DiredFileInfo -- | If file exists, read contents of file into a new buffer, otherwise -- creating a new empty buffer. Replace the current window with a new -- window onto the new buffer. -- -- If the file is already open, just switch to the corresponding buffer. -- -- Need to clean up semantics for when buffers exist, and how to attach -- windows to buffers. -- -- @Yi.File@ module re-exports this, you probably want to import that -- instead. -- -- In case of a decoding failure, failure message is returned instead -- of the 'BufferRef'. editFile :: FilePath -> YiM (Either T.Text BufferRef) editFile filename = do f <- io $ userToCanonPath filename dupBufs <- filter (maybe False (equalFilePath f) . file) <$> gets bufferSet dirExists <- io $ doesDirectoryExist f fileExists <- io $ doesFileExist f b <- case dupBufs of [] -> if dirExists then Right <$> diredDirBuffer f else do nb <- if fileExists then fileToNewBuffer f else Right <$> newEmptyBuffer f case nb of Left m -> return $ Left m Right buf -> Right <$> setupMode f buf (h:_) -> return . Right $ bkey h case b of Left m -> return $ Left m Right bf -> withEditor (switchToBufferE bf >> addJumpHereE) >> return b where fileToNewBuffer :: FilePath -> YiM (Either T.Text BufferRef) fileToNewBuffer f = io getCurrentTime >>= \n -> io (R.readFile f) >>= \case Left m -> return $ Left m Right (contents, conv) -> do permissions <- io $ getPermissions f b <- stringToNewBuffer (FileBuffer f) contents withGivenBuffer b $ do encodingConverterNameA .= Just conv markSavedB n unless (writable permissions) (readOnlyA .= True) return $ Right b newEmptyBuffer :: FilePath -> YiM BufferRef newEmptyBuffer f = stringToNewBuffer (FileBuffer f) mempty setupMode :: FilePath -> BufferRef -> YiM BufferRef setupMode f b = do tbl <- asks (modeTable . yiConfig) content <- withGivenBuffer b elemsB let header = R.take 1024 content rx = ICU.regex [] "\\-\\*\\- *([^ ]*) *\\-\\*\\-" hmode = case ICU.find rx (R.toText header) of Nothing -> "" Just m -> case (ICU.group 1 m) of Just n -> n Nothing -> "" Just mode = find (\(AnyMode m) -> modeName m == hmode) tbl <|> find (\(AnyMode m) -> modeApplies m f header) tbl <|> Just (AnyMode emptyMode) case mode of AnyMode newMode -> withGivenBuffer b $ setMode newMode return b bypassReadOnly :: BufferM a -> BufferM a bypassReadOnly f = do ro <- use readOnlyA assign readOnlyA False res <- f assign readOnlyA ro return res filenameColOf :: BufferM () -> BufferM () filenameColOf f = getBufferDyn >>= assign preferColA . Just . diredNameCol >> f resetDiredOpState :: YiM () resetDiredOpState = withCurrentBuffer $ putBufferDyn (def :: DiredOpState) incDiredOpSucCnt :: YiM () incDiredOpSucCnt = withCurrentBuffer $ getBufferDyn >>= putBufferDyn . (diredOpSucCnt %~ succ) getDiredOpState :: YiM DiredOpState getDiredOpState = withCurrentBuffer getBufferDyn modDiredOpState :: (DiredOpState -> DiredOpState) -> YiM () modDiredOpState f = withCurrentBuffer $ getBufferDyn >>= putBufferDyn . f -- | Execute the operations -- -- Pass the list of remaining operations down, insert new ops at the -- head if needed procDiredOp :: Bool -> [DiredOp] -> YiM () procDiredOp counting (DORemoveFile f:ops) = do io $ printingException ("Remove file " <> f) (removeLink f) when counting postproc procDiredOp counting ops where postproc = do incDiredOpSucCnt withCurrentBuffer $ diredUnmarkPath (takeFileName f) procDiredOp counting (DORemoveDir f:ops) = do io $ printingException ("Remove directory " <> f) (removeDirectoryRecursive f) -- document suggests removeDirectoryRecursive will follow -- symlinks in f, but it seems not the case, at least on OS X. when counting postproc procDiredOp counting ops where postproc = do incDiredOpSucCnt withCurrentBuffer $ diredUnmarkPath (takeFileName f) procDiredOp _counting (DORemoveBuffer _:_) = undefined -- TODO procDiredOp counting (DOCopyFile o n:ops) = do io $ printingException ("Copy file " <> o) (copyFile o n) when counting postproc procDiredOp counting ops where postproc = do incDiredOpSucCnt withCurrentBuffer $ diredUnmarkPath (takeFileName o) -- TODO: mark copied files with "C" if the target dir's -- dired buffer exists procDiredOp counting (DOCopyDir o n:ops) = do contents <- io $ printingException (concat ["Copy directory ", o, " to ", n]) doCopy subops <- io $ mapM builder $ filter (`notElem` [".", ".."]) contents procDiredOp False subops when counting postproc procDiredOp counting ops where postproc = do incDiredOpSucCnt withCurrentBuffer $ diredUnmarkPath (takeFileName o) -- perform dir copy: create new dir and create other copy ops doCopy :: IO [FilePath] doCopy = do exists <- doesDirectoryExist n when exists $ removeDirectoryRecursive n createDirectoryIfMissing True n getDirectoryContents o -- build actual copy operations builder :: FilePath -> IO DiredOp builder name = do let npath = n name let opath = o name isDir <- doesDirectoryExist opath return $ DOCkOverwrite npath $ getOp isDir opath npath where getOp isDir = if isDir then DOCopyDir else DOCopyFile procDiredOp counting (DORename o n:ops) = do io $ printingException (concat ["Rename ", o, " to ", n]) (rename o n) when counting postproc procDiredOp counting ops where postproc = do incDiredOpSucCnt withCurrentBuffer $ diredUnmarkPath (takeFileName o) procDiredOp counting r@(DOConfirm prompt eops enops:ops) = withMinibuffer (R.toText $ prompt <> " (yes/no)") noHint (act . T.unpack) where act s = case map toLower s of "yes" -> procDiredOp counting (eops <> ops) "no" -> procDiredOp counting (enops <> ops) _ -> procDiredOp counting r -- TODO: show an error msg procDiredOp counting (DOCheck check eops enops:ops) = do res <- io check procDiredOp counting (if res then eops <> ops else enops <> ops) procDiredOp counting (DOCkOverwrite fp op:ops) = do exists <- io $ fileExist fp procDiredOp counting (if exists then newOp:ops else op:ops) where newOp = DOChoice ("Overwrite " <> R.fromString fp <> " ?") op procDiredOp counting (DOInput prompt opGen:ops) = promptFile (R.toText prompt) (act . T.unpack) where act s = procDiredOp counting $ opGen s <> ops procDiredOp counting (DONoOp:ops) = procDiredOp counting ops procDiredOp counting (DOFeedback f:ops) = getDiredOpState >>= f >> procDiredOp counting ops procDiredOp counting r@(DOChoice prompt op:ops) = do st <- getDiredOpState if st ^. diredOpForAll then proceedYes else withEditor_ $ spawnMinibufferE msg (const askKeymap) where msg = R.toText $ prompt <> " (y/n/!/q/h)" askKeymap = choice [ char 'n' ?>>! noAction , char 'y' ?>>! yesAction , char '!' ?>>! allAction , char 'q' ?>>! quit , char 'h' ?>>! help ] noAction = cleanUp >> proceedNo yesAction = cleanUp >> proceedYes allAction = do cleanUp modDiredOpState (diredOpForAll .~ True) proceedYes quit = cleanUp >> printMsg "Quit" help = do printMsg "y: yes, n: no, !: yes on all remaining items, q: quit, h: help" cleanUp procDiredOp counting r -- repeat -- use cleanUp to get back the original buffer cleanUp = withEditor closeBufferAndWindowE proceedYes = procDiredOp counting (op:ops) proceedNo = procDiredOp counting ops procDiredOp _ _ = return () -- | Delete a list of file in the given directory -- -- 1. Ask for confirmation, if yes, perform deletions, otherwise -- showNothing -- -- 2. Confirmation is required for recursive deletion of non-empty -- directry, but only the top level one -- -- 3. Show the number of successful deletions at the end of the excution -- -- 4. TODO: ask confirmation for wether to remove the associated -- buffers when a file is removed askDelFiles :: FilePath -> [(FilePath, DiredEntry)] -> YiM () askDelFiles dir fs = case fs of (_x:_) -> do resetDiredOpState -- TODO: show the file name list in new tmp window opList <- io $ sequence ops -- a deletion command is mapped to a list of deletions -- wrapped up by DOConfirm -- TODO: is `counting' necessary here? let ops' = opList <> [DOFeedback showResult] procDiredOp True [DOConfirm prompt ops' [DOFeedback showNothing]] -- no files listed [] -> procDiredOp True [DOFeedback showNothing] where prompt = R.concat [ "Delete " , R.fromString . show $ length fs , " file(s)?" ] ops = map opGenerator fs showResult st = do diredRefresh printMsg $ showT (st ^. diredOpSucCnt) <> " of " <> showT total <> " deletions done" showNothing _ = printMsg "(No deletions requested)" total = length fs opGenerator :: (FilePath, DiredEntry) -> IO DiredOp opGenerator (fn, de) = do exists <- fileExist path if exists then case de of (DiredDir _dfi) -> do isNull <- fmap nullDir $ getDirectoryContents path return $ if isNull then DOConfirm recDelPrompt [DORemoveDir path] [DONoOp] else DORemoveDir path _ -> return (DORemoveFile path) else return DONoOp where path = dir fn recDelPrompt = "Recursive delete of " <> R.fromString fn <> "?" -- Test the emptyness of a folder nullDir :: [FilePath] -> Bool nullDir = Data.List.any (not . flip Data.List.elem [".", ".."]) diredDoDel :: YiM () diredDoDel = do dir <- currentDir maybefile <- withCurrentBuffer fileFromPoint case maybefile of Just (fn, de) -> askDelFiles dir [(fn, de)] Nothing -> noFileAtThisLine diredDoMarkedDel :: YiM () diredDoMarkedDel = do dir <- currentDir fs <- markedFiles (== 'D') askDelFiles dir fs diredKeymap :: Keymap -> Keymap diredKeymap = important $ withArg mainMap where -- produces a copy of the map allowing for C-u withArg :: (Maybe Int -> Keymap) -> Keymap withArg k = choice [ ctrlCh 'u' ?>> k (Just 1) , k Nothing ] mainMap :: Maybe Int -> Keymap mainMap univArg = choice [ char 'p' ?>>! filenameColOf lineUp , oneOf [char 'n', char ' '] >>! filenameColOf lineDown , char 'd' ?>>! diredMarkDel , char 'g' ?>>! diredRefresh , char 'm' ?>>! diredMark , char '^' ?>>! diredUpDir , char '+' ?>>! diredCreateDir , char 'q' ?>>! ((deleteBuffer =<< gets currentBuffer) :: EditorM ()) , char 'x' ?>>! diredDoMarkedDel , oneOf [ctrl $ char 'm', spec KEnter, char 'f', char 'e'] >>! diredLoad -- Currently ‘o’ misbehaves, seems this naive method loses -- track of buffers. , char 'o' ?>>! withOtherWindow diredLoad , char 'u' ?>>! diredUnmark Forward , spec KBS ?>>! diredUnmark Backward , char 'D' ?>>! diredDoDel , char 'U' ?>>! diredUnmarkAll , char 'R' ?>>! diredRename , char 'C' ?>>! diredCopy , char '*' ?>> multiMarks univArg ] multiMarks :: Maybe Int -> Keymap multiMarks univArg = choice [ char '!' ?>>! diredUnmarkAll , char '@' ?>>! diredMarkSymlinks univArg , char '/' ?>>! diredMarkDirectories univArg , char 't' ?>>! diredToggleAllMarks ] dired :: YiM () dired = do printMsg "Dired..." maybepath <- withCurrentBuffer $ gets file dir <- io $ getFolder maybepath void $ editFile dir diredDir :: FilePath -> YiM () diredDir dir = void (diredDirBuffer dir) diredDirBuffer :: FilePath -> YiM BufferRef diredDirBuffer d = do -- Emacs doesn't follow symlinks, probably Yi shouldn't do too dir <- io $ canonicalizePath d b <- stringToNewBuffer (FileBuffer dir) mempty withEditor $ switchToBufferE b withCurrentBuffer $ do state <- getBufferDyn putBufferDyn (state & diredPathA .~ dir) directoryContentA .= True diredRefresh return b -- | Write the contents of the supplied directory into the current -- buffer in dired format diredRefresh :: YiM () diredRefresh = do dState <- withCurrentBuffer getBufferDyn let dir = diredPath dState -- Scan directory di <- io $ diredScanDir dir currFile <- if null (diredFilePoints dState) then return "" else do maybefile <- withCurrentBuffer fileFromPoint case maybefile of Just (fp, _) -> return fp Nothing -> return "" let ds = diredEntriesA .~ di $ diredCurrFileA .~ currFile $ dState -- Compute results let dlines = linesToDisplay ds (strss, stys, strs) = unzip3 dlines strss' = transpose $ map doPadding $ transpose strss namecol = if null strss' then 0 else let l1details = init $ head strss' in Data.List.sum (map R.length l1details) + length l1details -- Set buffer contents withCurrentBuffer $ do -- Clear buffer assign readOnlyA False ---- modifications begin here deleteRegionB =<< regionOfB Document -- Write Header insertN $ R.fromString dir <> ":\n" p <- pointB -- paint header addOverlayB $ mkOverlay "dired" (mkRegion 0 (p-2)) headStyle "" ptsList <- mapM insertDiredLine $ zip3 strss' stys strs putBufferDyn $ diredFilePointsA .~ ptsList $ diredNameColA .~ namecol $ ds -- Colours for Dired come from overlays not syntax highlighting modifyMode $ modeKeymapA .~ topKeymapA %~ diredKeymap >>> modeNameA .~ "dired" diredRefreshMark ---- no modifications after this line assign readOnlyA True when (null currFile) $ moveTo (p-2) case getRow currFile ptsList of Just rpos -> filenameColOf $ moveTo rpos Nothing -> filenameColOf lineDown where getRow fp recList = lookup fp (map (\(a,_b,c)->(c,a)) recList) headStyle = const (withFg grey) doPadding :: [DRStrings] -> [R.YiString] doPadding drs = map (pad ((maximum . map drlength) drs)) drs pad _n (DRPerms s) = s pad n (DRLinks s) = R.replicate (max 0 (n - R.length s)) " " <> s pad n (DROwners s) = s <> R.replicate (max 0 (n - R.length s)) " " <> " " pad n (DRGroups s) = s <> R.replicate (max 0 (n - R.length s)) " " pad n (DRSizes s) = R.replicate (max 0 (n - R.length s)) " " <> s pad n (DRDates s) = R.replicate (max 0 (n - R.length s)) " " <> s pad _n (DRFiles s) = s -- Don't right-justify the filename drlength = R.length . undrs -- | Returns a tuple containing the textual region (the end of) which -- is used for 'click' detection and the FilePath of the file -- represented by that textual region insertDiredLine :: ([R.YiString], StyleName, R.YiString) -> BufferM (Point, Point, FilePath) insertDiredLine (fields, sty, filenm) = bypassReadOnly $ do insertN . R.unwords $ init fields p1 <- pointB insertN $ ' ' `R.cons` last fields p2 <- pointB newlineB addOverlayB (mkOverlay "dired" (mkRegion p1 p2) sty "") return (p1, p2, R.toString filenm) data DRStrings = DRPerms {undrs :: R.YiString} | DRLinks {undrs :: R.YiString} | DROwners {undrs :: R.YiString} | DRGroups {undrs :: R.YiString} | DRSizes {undrs :: R.YiString} | DRDates {undrs :: R.YiString} | DRFiles {undrs :: R.YiString} -- | Return a List of (prefix, -- fullDisplayNameIncludingSourceAndDestOfLink, style, filename) linesToDisplay :: DiredState -> [([DRStrings], StyleName, R.YiString)] linesToDisplay dState = map (uncurry lineToDisplay) (M.assocs entries) where entries = diredEntries dState lineToDisplay k (DiredFile v) = (l " -" v <> [DRFiles k], defaultStyle, k) lineToDisplay k (DiredDir v) = (l " d" v <> [DRFiles k], const (withFg blue), k) lineToDisplay k (DiredSymLink v s) = (l " l" v <> [DRFiles $ k <> " -> " <> s], const (withFg cyan), k) lineToDisplay k (DiredSocket v) = (l " s" v <> [DRFiles k], const (withFg magenta), k) lineToDisplay k (DiredCharacterDevice v) = (l " c" v <> [DRFiles k], const (withFg yellow), k) lineToDisplay k (DiredBlockDevice v) = (l " b" v <> [DRFiles k], const (withFg yellow), k) lineToDisplay k (DiredNamedPipe v) = (l " p" v <> [DRFiles k], const (withFg brown), k) lineToDisplay k DiredNoInfo = ([DRFiles $ k <> " : Not a file/dir/symlink"], defaultStyle, k) l pre v = [DRPerms $ pre <> permString v, DRLinks . R.fromString $ printf "%4d" (numLinks v), DROwners $ owner v, DRGroups $ grp v, DRSizes . R.fromString $ printf "%8d" (sizeInBytes v), DRDates $ modificationTimeString v] -- | Return dired entries for the contents of the supplied directory diredScanDir :: FilePath -> IO DiredEntries diredScanDir dir = do files <- getDirectoryContents dir foldM (lineForFile dir) M.empty files where lineForFile :: FilePath -> DiredEntries -> FilePath -> IO DiredEntries lineForFile d m f = do let fp = d f fileStatus <- getSymbolicLinkStatus fp dfi <- lineForFilePath fp fileStatus let islink = isSymbolicLink fileStatus linkTarget <- if islink then readSymbolicLink fp else return mempty let de | isDirectory fileStatus = DiredDir dfi | isRegularFile fileStatus = DiredFile dfi | islink = DiredSymLink dfi (R.fromString linkTarget) | isSocket fileStatus = DiredSocket dfi | isCharacterDevice fileStatus = DiredCharacterDevice dfi | isBlockDevice fileStatus = DiredBlockDevice dfi | isNamedPipe fileStatus = DiredNamedPipe dfi | otherwise = DiredNoInfo return $ M.insert (R.fromString f) de m lineForFilePath :: FilePath -> FileStatus -> IO DiredFileInfo lineForFilePath fp fileStatus = do let modTimeStr = R.fromString . shortCalendarTimeToString . posixSecondsToUTCTime . realToFrac $ modificationTime fileStatus let uid = fileOwner fileStatus gid = fileGroup fileStatus fn = takeFileName fp _filenm <- if isSymbolicLink fileStatus then return . ((fn <> " -> ") <>) =<< readSymbolicLink fp else return fn ownerEntry <- orException (getUserEntryForID uid) (fmap (scanForUid uid) getAllUserEntries) groupEntry <- orException (getGroupEntryForID gid) (fmap (scanForGid gid) getAllGroupEntries) let fmodeStr = (modeString . fileMode) fileStatus sz = toInteger $ fileSize fileStatus ownerStr = R.fromString $ userName ownerEntry groupStr = R.fromString $ groupName groupEntry numOfLinks = toInteger $ linkCount fileStatus return DiredFileInfo { permString = fmodeStr , numLinks = numOfLinks , owner = ownerStr , grp = groupStr , sizeInBytes = sz , modificationTimeString = modTimeStr} -- | Needed on Mac OS X 10.4 scanForUid :: UserID -> [UserEntry] -> UserEntry 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 = fromMaybe missingEntry $ find ((gid ==) . groupID) entries where missingEntry = GroupEntry "?" mempty gid mempty modeString :: FileMode -> R.YiString modeString fm = "" <> strIfSet "r" ownerReadMode <> strIfSet "w" ownerWriteMode <> strIfSet "x" ownerExecuteMode <> strIfSet "r" groupReadMode <> strIfSet "w" groupWriteMode <> strIfSet "x" groupExecuteMode <> strIfSet "r" otherReadMode <> strIfSet "w" otherWriteMode <> strIfSet "x" otherExecuteMode where strIfSet s mode = if fm == (fm `unionFileModes` mode) then s else "-" shortCalendarTimeToString :: UTCTime -> String shortCalendarTimeToString = formatTime defaultTimeLocale "%b %d %H:%M" -- Default Filter: omit files ending in '~' or '#' and also '.' and '..'. -- TODO: customizable filters? --diredOmitFile :: String -> Bool --diredOmitFile = undefined diredMark :: BufferM () diredMark = diredMarkWithChar '*' lineDown diredMarkDel :: BufferM () diredMarkDel = diredMarkWithChar 'D' lineDown -- | Generic mark toggler. diredMarkKind :: Maybe Int -- ^ universal argument, usually indicating whether -- to mark or unmark. Here ‘Just …’ is taken as -- unmark. -> (DiredFilePath -> DiredEntry -> Bool) -- ^ Picks which entries to consider -> Char -- ^ Character used for marking. Pass garbage if -- unmarking. -> BufferM () diredMarkKind m p c = bypassReadOnly $ do dState <- getBufferDyn let es = M.assocs $ diredEntries dState ms = M.fromList [ (R.toString fp, c) | (fp, e) <- es, p fp e ] putBufferDyn (dState & diredMarksA %~ run ms) diredRefreshMark where run :: M.Map FilePath Char -> M.Map FilePath Char -> M.Map FilePath Char run ms cms = case m of Nothing -> M.union ms cms Just _ -> deleteKeys cms (M.keys ms) diredMarkSymlinks :: Maybe Int -> BufferM () diredMarkSymlinks m = diredMarkKind m p '*' where p _ DiredSymLink {} = True p _ _ = False diredMarkDirectories :: Maybe Int -> BufferM () diredMarkDirectories m = diredMarkKind m p '*' where p "." DiredDir {} = False p ".." DiredDir {} = False p _ DiredDir {} = True p _ _ = False diredToggleAllMarks :: BufferM () diredToggleAllMarks = bypassReadOnly $ do dState <- getBufferDyn let es = diredEntries dState putBufferDyn (dState & diredMarksA %~ tm es) diredRefreshMark where -- Get all entries, filter out the ones that are marked already, -- then mark everything that remains, in effect toggling the -- marks. tm :: DiredEntries -> M.Map FilePath Char -> M.Map FilePath Char tm de ms = let unmarked = deleteKeys (M.mapKeys R.toString de) (M.keys ms) in M.map (const '*') unmarked -- | Delete all the keys from the map. deleteKeys :: Ord k => M.Map k v -> [k] -> M.Map k v deleteKeys = foldl' (flip M.delete) diredMarkWithChar :: Char -> BufferM () -> BufferM () diredMarkWithChar c mv = bypassReadOnly $ fileFromPoint >>= \case Just (fn, _de) -> do state <- getBufferDyn putBufferDyn (state & diredMarksA %~ M.insert fn c) filenameColOf mv diredRefreshMark Nothing -> filenameColOf mv diredRefreshMark :: BufferM () diredRefreshMark = do b <- pointB dState <- getBufferDyn let posDict = diredFilePoints dState markMap = diredMarks dState draw (pos, _, fn) = case M.lookup fn markMap of Just mark -> do moveTo pos >> moveToSol >> insertB mark >> deleteN 1 e <- pointB addOverlayB $ mkOverlay "dired" (mkRegion (e - 1) e) (styleOfMark mark) "" Nothing -> -- for deleted marks moveTo pos >> moveToSol >> insertN " " >> deleteN 1 mapM_ draw posDict moveTo b where styleOfMark '*' = const (withFg green) styleOfMark 'D' = const (withFg red) styleOfMark _ = defaultStyle -- | Removes mark from current file (if any) and moves in the -- specified direction. diredUnmark :: Direction -- ^ Direction to move in after unmarking -> BufferM () diredUnmark d = bypassReadOnly $ do let lineDir = case d of { Forward -> lineDown; Backward -> lineUp; } fileFromPoint >>= \case Just (fn, _de) -> do diredUnmarkPath fn filenameColOf lineDir diredRefreshMark Nothing -> filenameColOf lineDir diredUnmarkPath :: FilePath -> BufferM() diredUnmarkPath fn = getBufferDyn >>= putBufferDyn.(diredMarksA %~ M.delete fn) diredUnmarkAll :: BufferM () diredUnmarkAll = bypassReadOnly $ do getBufferDyn >>= putBufferDyn.(diredMarksA .~ M.empty) filenameColOf $ return () diredRefreshMark currentDir :: YiM FilePath currentDir = diredPath <$> withCurrentBuffer getBufferDyn -- | move selected files in a given directory to the target location given -- by user input -- -- if multiple source -- then if target is not a existing dir -- then error -- else move source files into target dir -- else if target is dir -- then if target exist -- then move source file into target dir -- else if source is dir and parent of target exists -- then move source to target -- else error -- else if parent of target exist -- then move source to target -- 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] where mkErr t = return . DOFeedback . const $ errorEditor t prompt = "Move " <> R.fromString (show total) <> " item(s) to:" mOpIsDirAndExists t = [DOCheck (doesDirectoryExist t) posOps negOps] where posOps = map builder fs <> [DOFeedback showResult] negOps = mkErr $ T.pack t <> " is not directory!" builder (fn, _de) = let old = dir fn new = t fn in DOCkOverwrite new (DORename old new) sOpIsDir t = [DOCheck (doesDirectoryExist t) posOps sOpDirRename] where (fn, _) = head fs -- the only item posOps = [DOCkOverwrite new (DORename old new), DOFeedback showResult] where new = t fn old = dir fn sOpDirRename = [DOCheck ckParentDir posOps' negOps, DOFeedback showResult] where posOps' = [DOCkOverwrite new (DORename old new)] p = "Cannot move " <> T.pack old <> " to " <> T.pack new negOps = mkErr p new = t old = dir fn ps = dropTrailingPathSeparator t ckParentDir = doesDirectoryExist $ takeDirectory ps showResult st = do diredRefresh printMsg $ showT (st ^. diredOpSucCnt) <> " of " <> showT total <> " item(s) moved." showNothing _ = printMsg "Quit" total = length fs -- | copy selected files in a given directory to the target location given -- by user input -- -- askCopyFiles follow the same logic as askRenameFiles, -- except dir and file are done by different DiredOP 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] where prompt = "Copy " <> R.fromString (show total) <> " item(s) to:" mOpIsDirAndExists t = [DOCheck (doesDirectoryExist t) posOps negOps] where posOps = map builder fs <> [DOFeedback showResult] negOps = [DOFeedback . const $ errorEditor (T.pack t <> " is not directory!")] builder (fn, de) = let old = dir fn new = t fn in DOCkOverwrite new (op4Type de old new) sOpIsDir t = [DOCheck (doesDirectoryExist t) posOps sOpDirCopy] where (fn, de) = head fs -- the only item posOps = [DOCkOverwrite new (op4Type de old new), DOFeedback showResult] where new = t fn old = dir fn sOpDirCopy = [DOCheck ckParentDir posOps' negOps, DOFeedback showResult] where posOps' = [DOCkOverwrite new (op4Type de old new)] p = "Cannot copy " <> T.pack old <> " to " <> T.pack new negOps = [DOFeedback . const $ errorEditor p] new = t old = dir fn ckParentDir = doesDirectoryExist $ takeDirectory (dropTrailingPathSeparator t) showResult st = do diredRefresh printMsg $ showT (st ^. diredOpSucCnt) <> " of " <> showT total <> " item(s) copied." showNothing _ = printMsg "Quit" total = length fs op4Type :: DiredEntry -> FilePath -> FilePath -> DiredOp op4Type (DiredDir _) = DOCopyDir op4Type _ = DOCopyFile diredRename :: YiM () diredRename = do dir <- currentDir fs <- markedFiles (== '*') if null fs then do maybefile <- withCurrentBuffer fileFromPoint case maybefile of Just (fn, de) -> askRenameFiles dir [(fn, de)] Nothing -> noFileAtThisLine else askRenameFiles dir fs diredCopy :: YiM () diredCopy = do dir <- currentDir fs <- markedFiles (== '*') if null fs then do maybefile <- withCurrentBuffer fileFromPoint case maybefile of Just (fn, de) -> askCopyFiles dir [(fn, de)] Nothing -> noFileAtThisLine else askCopyFiles dir fs diredLoad :: YiM () diredLoad = do dir <- currentDir withCurrentBuffer fileFromPoint >>= \case Just (fn, de) -> do let sel = dir fn sel' = T.pack sel case de of (DiredFile _dfi) -> do exists <- io $ doesFileExist sel if exists then void $ editFile sel else printMsg $ sel' <> " no longer exists" (DiredDir _dfi) -> do exists <- io $ doesDirectoryExist sel if exists then diredDir sel else printMsg $ sel' <> " no longer exists" (DiredSymLink _dfi dest') -> do let dest = R.toString dest' target = if isAbsolute dest then dest else dir dest existsFile <- io $ doesFileExist target existsDir <- io $ doesDirectoryExist target printMsg $ "Following link:" <> T.pack target if existsFile then void $ editFile target else if existsDir then diredDir target else printMsg $ T.pack target <> " does not exist" (DiredSocket _dfi) -> do exists <- io $ doesFileExist sel printMsg (if exists then "Can't open Socket " <> sel' else sel' <> " no longer exists") (DiredBlockDevice _dfi) -> do exists <- io $ doesFileExist sel printMsg (if exists then "Can't open Block Device " <> sel' else sel' <> " no longer exists") (DiredCharacterDevice _dfi) -> do exists <- io $ doesFileExist sel printMsg (if exists then "Can't open Character Device " <> sel' else sel' <> " no longer exists") (DiredNamedPipe _dfi) -> do exists <- io $ doesFileExist sel printMsg (if exists then "Can't open Pipe " <> sel' else sel' <> " no longer exists") DiredNoInfo -> printMsg $ "No File Info for:" <> sel' Nothing -> noFileAtThisLine noFileAtThisLine :: YiM () noFileAtThisLine = printMsg "(No file at this line)" -- | Extract the filename at point. NB this may fail if the buffer has -- been edited. Maybe use Markers instead. fileFromPoint :: BufferM (Maybe (FilePath, DiredEntry)) fileFromPoint = do p <- pointB dState <- getBufferDyn let candidates = filter (\(_,p2,_)->p <= p2) (diredFilePoints dState) finddef f = M.findWithDefault DiredNoInfo (R.fromString f) return $ case candidates of ((_, _, f):_) -> Just (f, finddef f $ diredEntries dState) _ -> Nothing markedFiles :: (Char -> Bool) -> YiM [(FilePath, DiredEntry)] markedFiles cond = do dState <- withCurrentBuffer getBufferDyn let fs = fst . unzip $ filter (cond . snd) (M.assocs $ diredMarks dState) return $ map (\f -> (f, diredEntries dState M.! R.fromString f)) fs diredUpDir :: YiM () diredUpDir = do dir <- currentDir diredDir $ takeDirectory dir diredCreateDir :: YiM () diredCreateDir = withMinibufferFree "Create Dir:" $ \nm -> do dir <- currentDir let newdir = dir T.unpack nm printMsg $ "Creating " <> T.pack newdir <> "..." io $ createDirectoryIfMissing True newdir diredRefresh -- | Elementary operations for dired file operations -- Map a dired mark operation (e.g. delete, rename, copy) command -- into a list of DiredOps, and use procDiredOp to excute them. -- Logic and implementation of each operation are packaged in procDiredOp -- See askDelFiles for example. -- If new elem op is added, just add corresponding procDiredOp to handle it. data DiredOp = DORemoveFile FilePath | DORemoveDir FilePath | DOCopyFile FilePath FilePath | DOCopyDir FilePath FilePath | DORename FilePath FilePath | DORemoveBuffer FilePath -- ^ remove the buffers that associate with the file | DOConfirm R.YiString [DiredOp] [DiredOp] -- ^ prompt a "yes/no" question. If yes, execute the -- first list of embedded DiredOps otherwise execute the -- second list of embedded DiredOps | DOCheck (IO Bool) [DiredOp] [DiredOp] -- ^ similar to DOConfirm, but no user interaction. Could -- be used to check file existence | DOCkOverwrite FilePath DiredOp -- ^ this is a shortcut, it invokes DCChoice if file exists | DOInput R.YiString (String -> [DiredOp]) -- ^ prompt a string and collect user input. -- the embedded list of DiredOps is generated based on input, -- Remember that the input should be checked with DOCheck | DOChoice R.YiString DiredOp -- ^ prompt a string, provide keybindings for 'y', 'n', -- '!', 'q' and optional 'h' (help) this is useful when -- overwriting of existing files is required to complete -- the op choice '!' will bypass following DOChoice -- prompts. | DOFeedback (DiredOpState -> YiM ()) -- ^ to feedback, given the state. such as show the result. | DONoOp -- ^ no operation yi-0.12.6/src/library/Yi/Editor.hs0000644000000000000000000007337512725740550015033 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Editor -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- The top level editor state, and operations on it. This is inside an -- internal module for easy re-export with Yi.Types bits. module Yi.Editor ( Editor(..), EditorM, MonadEditor(..) , runEditor , acceptedInputsOtherWindow , addJumpAtE , addJumpHereE , alternateBufferE , askConfigVariableA , bufferSet , buffersA , closeBufferAndWindowE , closeBufferE , closeOtherE , clrStatus , commonNamePrefix , currentBuffer , currentRegexA , currentWindowA , deleteBuffer , deleteTabE , emptyEditor , findBuffer , findBufferWith , findBufferWithName , findWindowWith , focusWindowE , getBufferStack , getBufferWithName , getBufferWithNameOrCurrent , getEditorDyn , getRegE , jumpBackE , jumpForwardE , killringA , layoutManagerNextVariantE , layoutManagerPreviousVariantE , layoutManagersNextE , layoutManagersPreviousE , layoutManagersPrintMsgE , maxStatusHeightA , moveTabE , moveWinNextE , moveWinPrevE , newBufferE , newEmptyBufferE , newTabE , newTempBufferE , newWindowE , nextTabE , nextWinE , onCloseActionsA , pendingEventsA , prevWinE , previousTabE , printMsg , printMsgs , printStatus , pushWinToFirstE , putEditorDyn , searchDirectionA , setDividerPosE , setRegE , setStatus , shiftOtherWindow , splitE , statusLine , statusLineInfo , statusLinesA , stringToNewBuffer , swapWinWithFirstE , switchToBufferE , switchToBufferWithNameE , tabsA , tryCloseE , windows , windowsA , windowsOnBufferE , withCurrentBuffer , withEveryBuffer , withGivenBuffer , withGivenBufferAndWindow , withOtherWindow , withWindowE ) where import Prelude hiding (all, concatMap, foldl, foldr) import Control.Applicative ((<$>), (<*>)) import Control.Lens (Lens', assign, lens, mapped, use, uses, view, (%=), (%~), (&), (.~), (^.)) import Control.Monad (forM_, liftM) import Control.Monad.Reader (MonadReader (ask), asks, unless, when) import Control.Monad.State (gets, modify) import Data.Binary (Binary, get, put) import Data.Default (Default, def) import qualified Data.DelayList as DelayList (insert) import Data.DynamicState.Serializable (getDyn, putDyn) import Data.Foldable (Foldable (foldl, foldr), all, concatMap, toList) import Data.List (delete, (\\)) import Data.List.NonEmpty (NonEmpty (..), fromList, nub) import qualified Data.List.NonEmpty as NE (filter, head, length, toList, (<|)) import qualified Data.List.PointedList as PL (atEnd, moveTo) import qualified Data.List.PointedList.Circular as PL (PointedList (..), delete, deleteLeft, deleteOthers, deleteRight, focus, insertLeft, insertRight, length, next, previous, singleton, _focus) import qualified Data.Map as M (delete, elems, empty, insert, lookup, singleton, (!)) import Data.Maybe (fromJust, fromMaybe, isNothing) import qualified Data.Monoid as Mon ((<>)) import Data.Semigroup (mempty, (<>)) import qualified Data.Text as T (Text, null, pack, unlines, unpack, unwords) import System.FilePath (splitPath) import Yi.Buffer import Yi.Config import Yi.Interact as I (accepted, mkAutomaton) import Yi.JumpList (Jump (..), JumpList, addJump, jumpBack, jumpForward) import Yi.KillRing (krEmpty, krGet, krPut, krSet) import Yi.Layout import Yi.Monad (getsAndModify) import Yi.Rope (YiString, empty, fromText) import qualified Yi.Rope as R (YiString, fromText, snoc) import Yi.String (listify) import Yi.Style (defaultStyle) import Yi.Tab import Yi.Types import Yi.Utils import Yi.Window instance Binary Editor where 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 regex get = do bss <- (:|) <$> get <*> get bs <- get supply <- get ts <- get dv <- get msh <- get kr <- get regex <- get return $ emptyEditor { bufferStack = bss , buffers = bs , refSupply = supply , tabs_ = ts , dynamic = dv , maxStatusHeight = msh , killring = kr , currentRegex = regex } -- | The initial state emptyEditor :: Editor emptyEditor = Editor { buffers = M.singleton (bkey buf) buf , tabs_ = PL.singleton tab , bufferStack = bkey buf :| [] , refSupply = 3 , currentRegex = Nothing , searchDirection = Forward , dynamic = mempty , statusLines = DelayList.insert (maxBound, ([""], defaultStyle)) [] , killring = krEmpty , pendingEvents = [] , maxStatusHeight = 1 , onCloseActions = M.empty } where buf = newB 0 (MemBuffer "console") mempty win = (dummyWindow (bkey buf)) { wkey = WindowRef 1 , isMini = False } tab = makeTab1 2 win -- --------------------------------------------------------------------- makeLensesWithSuffix "A" ''Editor windows :: Editor -> PL.PointedList Window windows e = e ^. windowsA windowsA :: Lens' Editor (PL.PointedList Window) windowsA = currentTabA . tabWindowsA tabsA :: Lens' Editor (PL.PointedList Tab) tabsA = fixCurrentBufferA_ . tabs_A currentTabA :: Lens' Editor Tab currentTabA = tabsA . PL.focus askConfigVariableA :: (YiConfigVariable b, MonadEditor m) => m b askConfigVariableA = do cfg <- askCfg return $ cfg ^. configVariable -- --------------------------------------------------------------------- -- Buffer operations newRef :: MonadEditor m => m Int newRef = withEditor (refSupplyA %= (+ 1) >> use refSupplyA) newBufRef :: MonadEditor m => m BufferRef newBufRef = liftM BufferRef newRef -- | Create and fill a new buffer, using contents of string. -- | Does not focus the window, or make it the current window. -- | Call newWindowE or switchToBufferE to take care of that. stringToNewBuffer :: MonadEditor m => BufferId -- ^ The buffer indentifier -> YiString -- ^ The contents with which to populate -- the buffer -> m BufferRef stringToNewBuffer nm cs = withEditor $ do u <- newBufRef defRegStyle <- configRegionStyle <$> askCfg insertBuffer $ newB u nm cs m <- asks configFundamentalMode withGivenBuffer u $ do putRegionStyle defRegStyle setAnyMode m return u insertBuffer :: MonadEditor m => FBuffer -> m () insertBuffer b = withEditor . modify $ \e -> -- insert buffers at the end, so that -- "background" buffers do not interfere. e { bufferStack = nub (bufferStack e <> (bkey b :| [])) , buffers = M.insert (bkey b) b (buffers e)} -- Prevent possible space leaks in the editor structure forceFold1 :: Foldable t => t a -> t a forceFold1 x = foldr seq x x forceFoldTabs :: Foldable t => t Tab -> t Tab forceFoldTabs x = foldr (seq . forceTab) x x -- | Delete a buffer (and release resources associated with it). deleteBuffer :: MonadEditor m => BufferRef -> m () deleteBuffer k = withEditor $ do -- If the buffer has an associated close action execute that now. -- Unless the buffer is the last buffer in the editor. In which case -- it cannot be closed and, I think, the close action should not be -- applied. -- -- The close actions seem dangerous, but I know of no other simple -- way to resolve issues related to what buffer receives actions -- after the minibuffer closes. gets bufferStack >>= \case _ :| [] -> return () _ -> M.lookup k <$> gets onCloseActions >>= \m_action -> fromMaybe (return ()) m_action -- Now try deleting the buffer. Checking, once again, that it is not -- the last buffer. bs <- gets bufferStack ws <- use windowsA case bs of b0 :| nextB : _ -> do let pickOther w = if bufkey w == k then w {bufkey = other} else w visibleBuffers = bufkey <$> toList ws -- This ‘head’ always works because we witness that length of -- bs ≥ 2 (through case) and ‘delete’ only deletes up to 1 -- element so we at worst we end up with something like -- ‘head $ [] ++ [foo]’ when bs ≡ visibleBuffers bs' = NE.toList bs other = head $ (bs' \\ visibleBuffers) ++ delete k bs' when (b0 == k) $ -- we delete the currently selected buffer: the next buffer -- will become active in the main window, therefore it must be -- assigned a new window. switchToBufferE nextB -- NOTE: This *only* works if not all bufferStack buffers are -- equivalent to ‘k’. Assuring that there are no duplicates in -- the bufferStack is equivalent in this case because of its -- length. modify $ \e -> e & bufferStackA %~ fromList . forceFold1 . NE.filter (k /=) & buffersA %~ M.delete k & tabs_A %~ forceFoldTabs . fmap (mapWindows pickOther) -- all windows open on that buffer must switch to another -- buffer. windowsA . mapped . bufAccessListA %= forceFold1 . filter (k /=) _ -> return () -- Don't delete the last buffer. -- | Return the buffers we have, /in no particular order/ bufferSet :: Editor -> [FBuffer] bufferSet = M.elems . buffers -- | Return a prefix that can be removed from all buffer paths while -- keeping them unique. commonNamePrefix :: Editor -> [FilePath] commonNamePrefix = commonPrefix . fmap (dropLast . splitPath) . fbufs . fmap (^. identA) . bufferSet where dropLast [] = [] dropLast x = init x fbufs xs = [ x | FileBuffer x <- xs ] -- drop the last component, so that it is never hidden. getBufferStack :: MonadEditor m => m (NonEmpty FBuffer) getBufferStack = withEditor $ do bufMap <- gets buffers gets $ fmap (bufMap M.!) . bufferStack findBuffer :: MonadEditor m => BufferRef -> m (Maybe FBuffer) findBuffer k = withEditor (gets (M.lookup k . buffers)) -- | Find buffer with this key findBufferWith :: BufferRef -> Editor -> FBuffer findBufferWith k e = case M.lookup k (buffers e) of Just x -> x Nothing -> error "Editor.findBufferWith: no buffer has this key" -- | Find buffers with this name findBufferWithName :: T.Text -> Editor -> [BufferRef] findBufferWithName n e = let bufs = M.elems $ buffers e sameIdent b = shortIdentString (length $ commonNamePrefix e) b == n in map bkey $ filter sameIdent bufs -- | Find buffer with given name. Fail if not found. getBufferWithName :: MonadEditor m => T.Text -> m BufferRef getBufferWithName bufName = withEditor $ do bs <- gets $ findBufferWithName bufName case bs of [] -> fail ("Buffer not found: " ++ T.unpack bufName) b:_ -> return b ------------------------------------------------------------------------ -- | Perform action with any given buffer, using the last window that -- was used for that buffer. withGivenBuffer :: MonadEditor m => BufferRef -> BufferM a -> m a withGivenBuffer k f = do b <- gets (findBufferWith k) withGivenBufferAndWindow (b ^. lastActiveWindowA) k f -- | Perform action with any given buffer withGivenBufferAndWindow :: MonadEditor m => Window -> BufferRef -> BufferM a -> m a withGivenBufferAndWindow w k f = withEditor $ do accum <- asks configKillringAccumulate let edit e = let b = findBufferWith k e (v, us, b') = runBufferFull w b f in (e & buffersA .~ mapAdjust' (const b') k (buffers e) & killringA %~ if accum && all updateIsDelete us then foldl (.) id $ reverse [ krPut dir s | Delete _ dir s <- us ] else id , (us, v)) (us, v) <- getsAndModify edit updHandler <- return . bufferUpdateHandler =<< ask unless (null us || null updHandler) $ forM_ updHandler (\h -> withGivenBufferAndWindow w k (h us)) return v -- | Perform action with current window's buffer withCurrentBuffer :: MonadEditor m => BufferM a -> m a withCurrentBuffer f = withEditor $ do w <- use currentWindowA withGivenBufferAndWindow w (bufkey w) f withEveryBuffer :: MonadEditor m => BufferM a -> m [a] withEveryBuffer action = withEditor (gets bufferStack) >>= mapM (`withGivenBuffer` action) . NE.toList currentWindowA :: Lens' Editor Window currentWindowA = windowsA . PL.focus -- | Return the current buffer currentBuffer :: Editor -> BufferRef currentBuffer = NE.head . bufferStack ----------------------- -- Handling of status -- | Prints a message with 'defaultStyle'. printMsg :: MonadEditor m => T.Text -> m () printMsg s = printStatus ([s], defaultStyle) -- | Prints a all given messages with 'defaultStyle'. printMsgs :: MonadEditor m => [T.Text] -> m () printMsgs s = printStatus (s, defaultStyle) printStatus :: MonadEditor m => Status -> m () printStatus = setTmpStatus 1 -- | Set the "background" status line setStatus :: MonadEditor m => Status -> m () setStatus = setTmpStatus maxBound -- | Clear the status line clrStatus :: EditorM () clrStatus = setStatus ([""], defaultStyle) statusLine :: Editor -> [T.Text] statusLine = fst . statusLineInfo statusLineInfo :: Editor -> Status statusLineInfo = snd . head . statusLines setTmpStatus :: MonadEditor m => Int -> Status -> m () setTmpStatus delay s = withEditor $ do statusLinesA %= DelayList.insert (delay, s) -- also show in the messages buffer, so we don't loose any message bs <- gets (filter ((== MemBuffer "messages") . view identA) . M.elems . buffers) b <- case bs of (b':_) -> return $ bkey b' [] -> stringToNewBuffer (MemBuffer "messages") mempty let m = listify $ R.fromText <$> fst s withGivenBuffer b $ botB >> insertN (m `R.snoc` '\n') -- --------------------------------------------------------------------- -- kill-register (vim-style) interface to killring. -- -- Note that our vim keymap currently has its own registers -- and doesn't use killring. -- | Put string into yank register setRegE :: R.YiString -> EditorM () setRegE s = killringA %= krSet s -- | Return the contents of the yank register getRegE :: EditorM R.YiString getRegE = uses killringA krGet -- --------------------------------------------------------------------- -- | Dynamically-extensible state components. -- -- These hooks are used by keymaps to store values that result from -- Actions (i.e. that restult from IO), as opposed to the pure values -- they generate themselves, and can be stored internally. -- -- The `dynamic' field is a type-indexed map. -- -- | Retrieve a value from the extensible state getEditorDyn :: (MonadEditor m, YiVariable a, Default a, Functor m) => m a getEditorDyn = fromMaybe def <$> getDyn (use dynamicA) (assign dynamicA) -- | Insert a value into the extensible state, keyed by its type putEditorDyn :: (MonadEditor m, YiVariable a, Functor m) => a -> m () putEditorDyn = putDyn (use dynamicA) (assign dynamicA) -- | Like fnewE, create a new buffer filled with the String @s@, -- Switch the current window to this buffer. Doesn't associate any -- file with the buffer (unlike fnewE) and so is good for popup -- internal buffers (like scratch) newBufferE :: BufferId -- ^ buffer name -> YiString -- ^ buffer contents -> EditorM BufferRef newBufferE f s = do b <- stringToNewBuffer f s switchToBufferE b return b -- | Like 'newBufferE' but defaults to empty contents. newEmptyBufferE :: BufferId -> EditorM BufferRef newEmptyBufferE f = newBufferE f Yi.Rope.empty alternateBufferE :: Int -> EditorM () alternateBufferE n = do Window { bufAccessList = lst } <- use currentWindowA if null lst || (length lst - 1) < n then fail "no alternate buffer" else switchToBufferE $ lst!!n -- | Create a new zero size window on a given buffer newZeroSizeWindow :: Bool -> BufferRef -> WindowRef -> Window newZeroSizeWindow mini bk ref = Window mini bk [] 0 0 emptyRegion ref 0 Nothing -- | Create a new window onto the given buffer. newWindowE :: Bool -> BufferRef -> EditorM Window newWindowE mini bk = newZeroSizeWindow mini bk . WindowRef <$> newRef -- | Attach the specified buffer to the current window switchToBufferE :: BufferRef -> EditorM () switchToBufferE bk = windowsA . PL.focus %= \w -> w & bufkeyA .~ bk & bufAccessListA %~ forceFold1 . (bufkey w:) . filter (bk /=) -- | Switch to the buffer specified as parameter. If the buffer name -- is empty, switch to the next buffer. switchToBufferWithNameE :: T.Text -> EditorM () switchToBufferWithNameE "" = alternateBufferE 0 switchToBufferWithNameE bufName = switchToBufferE =<< getBufferWithName bufName -- | Close a buffer. -- Note: close the current buffer if the empty string is given closeBufferE :: T.Text -> EditorM () closeBufferE nm = deleteBuffer =<< getBufferWithNameOrCurrent nm getBufferWithNameOrCurrent :: MonadEditor m => T.Text -> m BufferRef getBufferWithNameOrCurrent t = withEditor $ case T.null t of True -> gets currentBuffer False -> getBufferWithName t ------------------------------------------------------------------------ -- | Close current buffer and window, unless it's the last one. closeBufferAndWindowE :: EditorM () closeBufferAndWindowE = do -- Fetch the current buffer *before* closing the window. -- The tryCloseE, since it uses tabsA, will have the -- current buffer "fixed" to the buffer of the window that is -- brought into focus. If the current buffer is accessed after the -- tryCloseE then the current buffer may not be the same as the -- buffer before tryCloseE. This would be bad. b <- gets currentBuffer tryCloseE deleteBuffer b -- | Rotate focus to the next window nextWinE :: EditorM () nextWinE = windowsA %= PL.next -- | Rotate focus to the previous window prevWinE :: EditorM () prevWinE = windowsA %= PL.previous -- | Swaps the focused window with the first window. Useful for -- layouts such as 'HPairOneStack', for which the first window is the -- largest. swapWinWithFirstE :: EditorM () swapWinWithFirstE = windowsA %= swapFocus (fromJust . PL.moveTo 0) -- | Moves the focused window to the first window, and moves all other -- windows down the stack. pushWinToFirstE :: EditorM () pushWinToFirstE = windowsA %= pushToFirst where pushToFirst ws = case PL.delete ws of Nothing -> ws Just ws' -> PL.insertLeft (ws ^. PL.focus) (fromJust $ PL.moveTo 0 ws') -- | Swap focused window with the next one moveWinNextE :: EditorM () moveWinNextE = windowsA %= swapFocus PL.next -- | Swap focused window with the previous one moveWinPrevE :: EditorM () moveWinPrevE = windowsA %= swapFocus PL.previous -- | A "fake" accessor that fixes the current buffer after a change of -- the current window. -- -- Enforces invariant that top of buffer stack is the buffer of the -- current window. fixCurrentBufferA_ :: Lens' Editor Editor fixCurrentBufferA_ = lens id (\_old new -> let ws = windows new b = findBufferWith (bufkey $ PL._focus ws) new newBufferStack = nub (bkey b NE.<| bufferStack new) -- make sure we do not hold to old versions by seqing the length. in NE.length newBufferStack `seq` new & bufferStackA .~ newBufferStack) withWindowE :: Window -> BufferM a -> EditorM a withWindowE w = withGivenBufferAndWindow w (bufkey w) findWindowWith :: WindowRef -> Editor -> Window findWindowWith k e = head $ concatMap (\win -> [win | wkey win == k]) $ windows e -- | Return the windows that are currently open on the buffer whose -- key is given windowsOnBufferE :: BufferRef -> EditorM [Window] windowsOnBufferE k = do ts <- use tabsA let tabBufEq = concatMap (\win -> [win | bufkey win == k]) . (^. tabWindowsA) return $ concatMap tabBufEq ts -- | bring the editor focus the window with the given key. -- -- Fails if no window with the given key is found. focusWindowE :: WindowRef -> EditorM () focusWindowE k = do -- Find the tab index and window index ts <- use tabsA let check (False, i) win = if wkey win == k then (True, i) else (False, i + 1) check r@(True, _) _win = r searchWindowSet (False, tabIndex, _) ws = case foldl check (False, 0) (ws ^. tabWindowsA) of (True, winIndex) -> (True, tabIndex, winIndex) (False, _) -> (False, tabIndex + 1, 0) searchWindowSet r@(True, _, _) _ws = r case foldl searchWindowSet (False, 0, 0) ts of (False, _, _) -> fail $ "No window with key " ++ show k ++ "found. (focusWindowE)" (True, tabIndex, winIndex) -> do assign tabsA (fromJust $ PL.moveTo tabIndex ts) windowsA %= fromJust . PL.moveTo winIndex -- | Split the current window, opening a second window onto current buffer. -- TODO: unfold newWindowE here? splitE :: EditorM () splitE = do w <- gets currentBuffer >>= newWindowE False windowsA %= PL.insertRight w -- | Prints the description of the current layout manager in the status bar layoutManagersPrintMsgE :: EditorM () layoutManagersPrintMsgE = do lm <- use $ currentTabA . tabLayoutManagerA printMsg . T.pack $ describeLayout lm -- | Cycle to the next layout manager, or the first one if the current -- one is nonstandard. layoutManagersNextE :: EditorM () layoutManagersNextE = withLMStackE PL.next >> layoutManagersPrintMsgE -- | Cycle to the previous layout manager, or the first one if the -- current one is nonstandard. layoutManagersPreviousE :: EditorM () layoutManagersPreviousE = withLMStackE PL.previous >> layoutManagersPrintMsgE -- | Helper function for 'layoutManagersNext' and 'layoutManagersPrevious' withLMStackE :: (PL.PointedList AnyLayoutManager -> PL.PointedList AnyLayoutManager) -> EditorM () withLMStackE f = askCfg >>= \cfg -> currentTabA . tabLayoutManagerA %= go (layoutManagers cfg) where go [] lm = lm go lms lm = case findPL (layoutManagerSameType lm) lms of Nothing -> head lms Just lmsPL -> f lmsPL ^. PL.focus -- | Next variant of the current layout manager, as given by 'nextVariant' layoutManagerNextVariantE :: EditorM () layoutManagerNextVariantE = do currentTabA . tabLayoutManagerA %= nextVariant layoutManagersPrintMsgE -- | Previous variant of the current layout manager, as given by -- 'previousVariant' layoutManagerPreviousVariantE :: EditorM () layoutManagerPreviousVariantE = do currentTabA . tabLayoutManagerA %= previousVariant layoutManagersPrintMsgE -- | Sets the given divider position on the current tab setDividerPosE :: DividerRef -> DividerPosition -> EditorM () setDividerPosE ref = assign (currentTabA . tabDividerPositionA ref) -- | Creates a new tab containing a window that views the current buffer. newTabE :: EditorM () newTabE = do bk <- gets currentBuffer win <- newWindowE False bk ref <- newRef tabsA %= PL.insertRight (makeTab1 ref win) -- | Moves to the next tab in the round robin set of tabs nextTabE :: EditorM () nextTabE = tabsA %= PL.next -- | Moves to the previous tab in the round robin set of tabs previousTabE :: EditorM () previousTabE = tabsA %= PL.previous -- | Moves the focused tab to the given index, or to the end if the -- index is not specified. moveTabE :: Maybe Int -> EditorM () moveTabE Nothing = do count <- uses tabsA PL.length tabsA %= fromJust . PL.moveTo (pred count) moveTabE (Just n) = do newTabs <- uses tabsA (PL.moveTo n) when (isNothing newTabs) failure assign tabsA $ fromJust newTabs where failure = fail $ "moveTab " ++ show n ++ ": no such tab" -- | Deletes the current tab. If there is only one tab open then error out. -- When the last tab is focused, move focus to the left, otherwise -- move focus to the right. deleteTabE :: EditorM () deleteTabE = tabsA %= fromMaybe failure . deleteTab where failure = error "deleteTab: cannot delete sole tab" deleteTab tabs = if PL.atEnd tabs then PL.deleteLeft tabs else PL.deleteRight tabs -- | Close the current window. If there is only one tab open and the tab -- contains only one window then do nothing. tryCloseE :: EditorM () tryCloseE = do ntabs <- uses tabsA PL.length nwins <- uses windowsA PL.length unless (ntabs == 1 && nwins == 1) $ if nwins == 1 -- Could the Maybe response from deleteLeft be used instead of the -- def 'if'? then tabsA %= fromJust . PL.deleteLeft else windowsA %= fromJust . PL.deleteLeft -- | Make the current window the only window on the screen closeOtherE :: EditorM () closeOtherE = windowsA %= PL.deleteOthers -- | Switch focus to some other window. If none is available, create one. shiftOtherWindow :: MonadEditor m => m () shiftOtherWindow = withEditor $ do len <- uses windowsA PL.length if len == 1 then splitE else nextWinE -- | Execute the argument in the context of an other window. Create -- one if necessary. The current window is re-focused after the -- argument has completed. withOtherWindow :: MonadEditor m => m a -> m a withOtherWindow f = do shiftOtherWindow x <- f withEditor prevWinE return x acceptedInputs :: EditorM [T.Text] acceptedInputs = do km <- defaultKm <$> askCfg keymap <- withCurrentBuffer $ gets (withMode0 modeKeymap) let l = I.accepted 3 . I.mkAutomaton . extractTopKeymap . keymap $ km return $ fmap T.unwords l -- | Shows the current key bindings in a new window acceptedInputsOtherWindow :: EditorM () acceptedInputsOtherWindow = do ai <- acceptedInputs b <- stringToNewBuffer (MemBuffer "keybindings") (fromText $ T.unlines ai) w <- newWindowE False b windowsA %= PL.insertRight w addJumpHereE :: EditorM () addJumpHereE = addJumpAtE =<< withCurrentBuffer pointB addJumpAtE :: Point -> EditorM () addJumpAtE point = do w <- use currentWindowA shouldAddJump <- case jumpList w of Just (PL.PointedList _ (Jump mark bf) _) -> do bfStillAlive <- gets (M.lookup bf . buffers) case bfStillAlive of Nothing -> return False _ -> do p <- withGivenBuffer bf . use $ markPointA mark return $! (p, bf) /= (point, bufkey w) _ -> return True when shouldAddJump $ do m <- withCurrentBuffer setMarkHereB let bf = bufkey w j = Jump m bf assign currentWindowA $ w & jumpListA %~ addJump j return () jumpBackE :: EditorM () jumpBackE = addJumpHereE >> modifyJumpListE jumpBack jumpForwardE :: EditorM () jumpForwardE = modifyJumpListE jumpForward modifyJumpListE :: (JumpList -> JumpList) -> EditorM () modifyJumpListE f = do w <- use currentWindowA case f $ w ^. jumpListA of Nothing -> return () Just (PL.PointedList _ (Jump mark bf) _) -> do switchToBufferE bf withCurrentBuffer $ use (markPointA mark) >>= moveTo currentWindowA . jumpListA %= f -- | Creates an in-memory buffer with a unique name. newTempBufferE :: EditorM BufferRef newTempBufferE = do e <- gets id -- increment the index of the hint until no buffer is found with that name let find_next currentName (nextName:otherNames) = case findBufferWithName currentName e of (_b : _) -> find_next nextName otherNames [] -> currentName find_next _ [] = error "Looks like nearly infinite list has just ended." next_tmp_name = find_next name names (name : names) = (fmap (("tmp-" Mon.<>) . T.pack . show) [0 :: Int ..]) newEmptyBufferE (MemBuffer next_tmp_name) yi-0.12.6/src/library/Yi/Eval.hs0000644000000000000000000003154512717763531014472 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} #ifdef HINT {-# LANGUAGE FlexibleContexts #-} #endif {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Eval -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Evaluator for actions ('Action', 'YiAction'). Uses a @GHCi@ session -- under the hood. module Yi.Eval ( -- * Main (generic) evaluation interface execEditorAction, getAllNamesInScope, describeNamedAction, Evaluator(..), evaluator, -- ** Standard evaluators #ifdef HINT ghciEvaluator, #endif publishedActionsEvaluator, publishedActions, publishAction, -- * Eval/Interpretation jumpToErrorE, jumpToE, consoleKeymap ) where import Prelude hiding (mapM_) import Control.Applicative ( (<$>), (<*>) ) import Control.Lens ( (^.), (<&>), (.=), (%=) ) import Control.Monad (when) import Data.Array ( elems ) import Data.Binary ( Binary ) import Data.Default ( Default, def ) import Data.Foldable ( mapM_ ) import qualified Data.HashMap.Strict as M ( HashMap, insert, lookup, empty, keys ) import Data.Monoid ( mempty, Monoid, (<>) ) import Data.Typeable ( Typeable ) #ifdef HINT import Control.Concurrent ( takeMVar, putMVar, newEmptyMVar, MVar, forkIO ) import Control.Monad ( Monad((>>), (>>=), return), void, forever ) import Control.Monad.Base ( MonadBase ) import Control.Monad.Catch ( try ) import Control.Monad.Trans ( lift ) import Data.Binary ( get, put ) import Data.List ( sort ) import qualified Language.Haskell.Interpreter as LHI ( typeOf, setImportsQ, searchPath, set, runInterpreter, ModuleElem(Data, Class, Fun), getModuleExports, as, loadModules, languageExtensions, OptionVal((:=)), InterpreterError, Extension(OverloadedStrings), setTopLevelModules, interpret ) import System.Directory ( doesFileExist ) import Yi.Boot.Internal ( reload ) import Yi.Core ( errorEditor ) import Yi.Editor ( getEditorDyn, putEditorDyn, MonadEditor) import qualified Yi.Paths ( getEvaluatorContextFilename ) import Yi.String ( showT ) import Yi.Utils ( io ) #endif import Text.Read ( readMaybe ) import Yi.Buffer ( gotoLn, moveXorEol, BufferM, readLnB, pointB, botB, insertN, getBookmarkB, markPointA ) import Yi.Config.Simple.Types ( customVariable, Field, ConfigM ) import Yi.Core ( runAction ) import Yi.Types ( YiVariable, YiConfigVariable ) import Yi.Editor ( printMsg, askCfg, withCurrentBuffer, withCurrentBuffer ) import Yi.File ( openingNewFile ) import Yi.Hooks ( runHook ) import Yi.Keymap ( YiM, Action, YiAction, makeAction, Keymap, write ) import Yi.Keymap.Keys ( event, Event(..), Key(KEnter) ) import Yi.Regex ( Regex, makeRegex, matchOnceText ) import qualified Yi.Rope as R ( toString, YiString, splitAt, length ) import Yi.Utils ( makeLensesWithSuffix ) -- TODO: should we be sticking Text here? -- | Runs the action, as written by the user. -- -- The behaviour of this function can be customised by modifying the -- 'Evaluator' variable. execEditorAction :: String -> YiM () execEditorAction = runHook execEditorActionImpl -- | 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'. -- -- Set this variable using 'evaluator'. See 'ghciEvaluator' and -- 'finiteListEvaluator' for two implementation. data Evaluator = Evaluator { execEditorActionImpl :: String -> YiM () -- ^ 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 -- 'getAllNamesInScope'. evaluator :: Field Evaluator evaluator = customVariable -- * 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 #ifdef HINT type HintRequest = (String, MVar (Either LHI.InterpreterError Action)) newtype HintThreadVar = HintThreadVar (Maybe (MVar HintRequest)) deriving (Typeable, Default) instance Binary HintThreadVar where put _ = return () get = return def instance YiVariable HintThreadVar getHintThread :: (MonadEditor m, MonadBase IO m) => m (MVar HintRequest) getHintThread = do HintThreadVar x <- getEditorDyn case x of Just t -> return t Nothing -> do req <- io newEmptyMVar contextFile <- Yi.Paths.getEvaluatorContextFilename void . io . forkIO $ hintEvaluatorThread req contextFile putEditorDyn . HintThreadVar $ Just req return req hintEvaluatorThread :: MVar HintRequest -> FilePath -> IO () hintEvaluatorThread request contextFile = do haveUserContext <- doesFileExist contextFile void $ LHI.runInterpreter $ do LHI.set [LHI.searchPath LHI.:= []] LHI.set [LHI.languageExtensions LHI.:= [ LHI.OverloadedStrings ]] when haveUserContext $ do LHI.loadModules [contextFile] LHI.setTopLevelModules ["Env"] -- Yi.Keymap: Action lives there LHI.setImportsQ [("Yi", Nothing), ("Yi.Keymap",Just "Yi.Keymap")] forever $ do (s,response) <- lift $ takeMVar request res <- try $ LHI.interpret ("Yi.makeAction (" ++ s ++ ")") (LHI.as :: Action) lift $ putMVar response res -- Evaluator implemented by calling GHCi. This evaluator can run -- arbitrary expressions in the class 'YiAction'. -- -- The following two imports are always present: -- -- > import Yi -- > import qualified Yi.Keymap as Yi.Keymap -- -- Also, if the file -- -- > $HOME/.config/yi/local/Env.hs -- -- exists, it is imported unqualified. ghciEvaluator :: Evaluator ghciEvaluator = Evaluator { execEditorActionImpl = execAction , getAllNamesInScopeImpl = getNames , describeNamedActionImpl = describeName -- TODO: use haddock to add docs } where execAction :: String -> YiM () execAction "reload" = reload execAction s = do request <- getHintThread res <- io $ do response <- newEmptyMVar putMVar request (s,response) takeMVar response case res of Left err -> errorEditor (showT err) Right action -> runAction action getNames :: YiM [String] getNames = do NamesCache cache <- getEditorDyn result <- if null cache then do res <- io $ LHI.runInterpreter $ do LHI.set [LHI.searchPath LHI.:= []] LHI.getModuleExports "Yi" return $ case res of Left err ->[show err] Right exports -> flattenExports exports else return $ sort cache putEditorDyn $ NamesCache result return result flattenExports :: [LHI.ModuleElem] -> [String] flattenExports = concatMap flattenExport flattenExport :: LHI.ModuleElem -> [String] 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 #endif -- * 'PublishedActions' evaluator newtype PublishedActions = PublishedActions { _publishedActions :: M.HashMap String Action } deriving(Typeable, Monoid) instance Default PublishedActions where def = mempty makeLensesWithSuffix "A" ''PublishedActions instance YiConfigVariable PublishedActions -- | Accessor for the published actions. Consider using -- 'publishAction'. publishedActions :: Field (M.HashMap String Action) publishedActions = customVariable . _publishedActionsA -- | Publish the given action, by the given name. This will overwrite -- any existing actions by the same name. publishAction :: (YiAction a x, Show x) => String -> a -> ConfigM () publishAction s a = publishedActions %= M.insert s (makeAction a) -- | Evaluator based on a fixed list of published actions. Has a few -- differences from 'ghciEvaluator': -- -- * expressions can't be evaluated -- -- * all suggested actions are actually valued -- -- * (related to the above) doesn't contain junk actions from Prelude -- -- * doesn't require GHCi backend, so uses less memory publishedActionsEvaluator :: Evaluator publishedActionsEvaluator = Evaluator { 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 -- | Jumps to specified position in a given file. jumpToE :: FilePath -- ^ Filename to make the jump in. -> Int -- ^ Line to jump to. -> Int -- ^ Column to jump to. -> YiM () jumpToE filename line column = openingNewFile filename $ gotoLn line >> moveXorEol column -- | Regex parsing the error message format. errorRegex :: Regex errorRegex = makeRegex ("^(.+):([0-9]+):([0-9]+):.*$" :: String) -- | Parses an error message. Fails if it can't parse out the needed -- information, namely filename, line number and column number. parseErrorMessage :: R.YiString -> Maybe (String, Int, Int) parseErrorMessage ln = do (_ ,result, _) <- matchOnceText errorRegex (R.toString ln) case take 3 $ map fst $ elems result of [_, fname, l, c] -> (,,) <$> return fname <*> readMaybe l <*> readMaybe c _ -> Nothing -- | Tries to parse an error message at current line using -- 'parseErrorMessage'. parseErrorMessageB :: BufferM (Maybe (String, Int, Int)) parseErrorMessageB = parseErrorMessage <$> readLnB -- | Tries to jump to error at the current line. See -- 'parseErrorMessageB'. jumpToErrorE :: YiM () jumpToErrorE = withCurrentBuffer parseErrorMessageB >>= \case Nothing -> printMsg "Couldn't parse out an error message." Just (f, l, c) -> jumpToE f l c prompt :: R.YiString prompt = "Yi> " -- | Tries to strip the 'prompt' from the front of the given 'String'. -- If the prompt is not found, returns the input command as-is. takeCommand :: R.YiString -> R.YiString takeCommand t = case R.splitAt (R.length prompt) t of (f, s) -> if f == prompt then s else t consoleKeymap :: Keymap consoleKeymap = do _ <- event (Event KEnter []) write $ withCurrentBuffer readLnB >>= \x -> case parseErrorMessage x of Just (f,l,c) -> jumpToE f l c Nothing -> do withCurrentBuffer $ do p <- pointB botB p' <- pointB when (p /= p') $ insertN ("\n" <> prompt <> takeCommand x) insertN "\n" pt <- pointB insertN prompt bm <- getBookmarkB "errorInsert" markPointA bm .= pt execEditorAction . R.toString $ takeCommand x instance Default Evaluator where #ifdef HINT def = ghciEvaluator #else def = publishedActionsEvaluator #endif instance YiConfigVariable Evaluatoryi-0.12.6/src/library/Yi/Event.hs0000644000000000000000000000367712720072011014645 0ustar0000000000000000module Yi.Event ( Event(..), prettyEvent, Key(..), Modifier(..), -- * Key codes eventToChar ) where import Data.Bits (setBit) import Data.Char (chr, ord) import Data.Monoid (mappend) data Modifier = MShift | MCtrl | MMeta | MSuper | MHyper deriving (Show,Eq,Ord) data Key = KEsc | KFun Int | KPrtScr | KPause | KASCII Char | KBS | KIns | KHome | KPageUp | KDel | KEnd | KPageDown | KNP5 | KUp | KMenu | KLeft | KDown | KRight | KEnter | KTab deriving (Eq,Show,Ord) data Event = Event Key [Modifier] deriving (Eq) instance Ord Event where compare (Event k1 m1) (Event k2 m2) = compare m1 m2 `mappend` compare k1 k2 -- so, all Ctrl+char, meta+char, etc. all form a continuous range instance Show Event where show = prettyEvent prettyEvent :: Event -> String prettyEvent (Event k mods) = concatMap ((++ "-") . prettyModifier) mods ++ prettyKey k where prettyKey (KFun i) = 'F' : show i prettyKey (KASCII c) = [c] prettyKey key = tail $ show key prettyModifier m = [ show m !! 1] -- | Map an Event to a Char. This is used in the emacs keymap for Ctrl-Q and vim keymap 'insertSpecialChar' eventToChar :: Event -> Char eventToChar (Event KEnter _) = '\CR' eventToChar (Event KEsc _) = '\ESC' eventToChar (Event KBS _) = '\127' eventToChar (Event KTab _) = '\t' eventToChar (Event (KASCII c) mods) = (if MMeta `elem` mods then setMeta else id) $ (if MCtrl `elem` mods then ctrlLowcase else id) c eventToChar _ev = '?' remapChar :: Char -> Char -> Char -> Char -> Char -> Char remapChar a1 b1 a2 _ c | a1 <= c && c <= b1 = chr $ ord c - ord a1 + ord a2 | otherwise = c ctrlLowcase :: Char -> Char ctrlLowcase = remapChar 'a' 'z' '\^A' '\^Z' -- set the meta bit, as if Mod1/Alt had been pressed setMeta :: Char -> Char setMeta c = chr (setBit (ord c) metaBit) metaBit :: Int metaBit = 7 yi-0.12.6/src/library/Yi/File.hs0000644000000000000000000001532312717763531014456 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.File -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.File ( -- * File-based actions editFile, openingNewFile, openNewFile, viWrite, viWriteTo, viSafeWriteTo, fwriteE, fwriteBufferE, fwriteAllY, fwriteToE, backupE, revertE, -- * Helper functions setFileName, deservesSave, -- * Configuration preSaveHooks ) where import Control.Applicative ((<$>)) import Control.Lens (assign, makeLenses, use, view, (^.)) import Control.Monad (filterM, void, when) import Control.Monad.Base (liftBase) import Data.Default (Default, def) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, append, cons, pack, unpack) import Data.Time (getCurrentTime) import Data.Typeable (Typeable) import System.Directory (doesDirectoryExist, doesFileExist) import System.FriendlyPath (userToCanonPath) import Yi.Buffer import Yi.Config.Simple.Types (Field, customVariable) import Yi.Core (errorEditor, runAction) import Yi.Dired (editFile) import Yi.Editor import Yi.Keymap () import Yi.Monad (gets) import qualified Yi.Rope as R (readFile, writeFile, writeFileUsingText) import Yi.String (showT) import Yi.Types import Yi.Utils (io) newtype PreSaveHooks = PreSaveHooks { _unPreSaveHooks :: [Action] } deriving Typeable instance Default PreSaveHooks where def = PreSaveHooks [] instance YiConfigVariable PreSaveHooks makeLenses ''PreSaveHooks preSaveHooks :: Field [Action] preSaveHooks = customVariable . unPreSaveHooks -- | Tries to open a new buffer with 'editFile' and runs the given -- action on the buffer handle if it succeeds. -- -- If the 'editFile' fails, just the failure message is printed. openingNewFile :: FilePath -> BufferM a -> YiM () openingNewFile fp act = editFile fp >>= \case Left m -> printMsg m Right ref -> void $ withGivenBuffer ref act -- | Same as @openingNewFile@ with no action to run after. openNewFile :: FilePath -> YiM () openNewFile = flip openingNewFile $ return () -- | Revert to the contents of the file on disk revertE :: YiM () revertE = withCurrentBuffer (gets file) >>= \case Just fp -> do now <- io getCurrentTime rf <- liftBase $ R.readFile fp >>= \case Left m -> print ("Can't revert: " <> m) >> return Nothing Right (c, cv) -> return $ Just (c, Just cv) case rf of Nothing -> return () Just (s, conv) -> do withCurrentBuffer $ revertB s conv now printMsg ("Reverted from " <> showT fp) Nothing -> printMsg "Can't revert, no file associated with buffer." -- | Try to write a file in the manner of vi/vim -- Need to catch any exception to avoid losing bindings viWrite :: YiM () viWrite = withCurrentBuffer (gets file) >>= \case 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 () viWriteTo f = do bufInfo <- withCurrentBuffer bufInfoB let s = T.pack $ bufInfoFileName bufInfo succeed <- fwriteToE f let message = f `T.append` if f == s then " written" else ' ' `T.cons` s `T.append` " written" when succeed $ printMsg message -- | Try to write to a named file if it doesn't exist. Error out if it does. viSafeWriteTo :: T.Text -> YiM () viSafeWriteTo f = do existsF <- liftBase $ doesFileExist (T.unpack f) if existsF then errorEditor $ f <> ": File exists (add '!' to override)" else viWriteTo f -- | Write current buffer to disk, if this buffer is associated with a file fwriteE :: YiM Bool fwriteE = fwriteBufferE =<< gets currentBuffer -- | Write a given buffer to disk if it is associated with a file. fwriteBufferE :: BufferRef -> YiM Bool fwriteBufferE bufferKey = do nameContents <- withGivenBuffer bufferKey $ do fl <- gets file st <- streamB Forward 0 conv <- use encodingConverterNameA return (fl, st, conv) case nameContents of (Just f, contents, conv) -> io (doesDirectoryExist f) >>= \case True -> printMsg "Can't save over a directory, doing nothing." >> return False False -> do hooks <- view preSaveHooks <$> askCfg mapM_ runAction hooks mayErr <- liftBase $ case conv of Nothing -> R.writeFileUsingText f contents >> return Nothing Just cn -> R.writeFile f contents cn case mayErr of Just err -> printMsg err >> return False Nothing -> io getCurrentTime >>= withGivenBuffer bufferKey . markSavedB >> return True (Nothing, _, _) -> printMsg "Buffer not associated with a file" >> return False -- | Write current buffer to disk as @f@. The file is also set to @f@. fwriteToE :: T.Text -> YiM Bool fwriteToE f = do b <- gets currentBuffer setFileName b (T.unpack f) fwriteBufferE b -- | Write all open buffers 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 () backupE = error "backupE not implemented" -- | Associate buffer with file; canonicalize the given path name. setFileName :: BufferRef -> FilePath -> YiM () setFileName b filename = do cfn <- liftBase $ userToCanonPath filename withGivenBuffer b $ assign identA $ FileBuffer cfn -- | Checks if the given buffer deserves a save: whether it's a file -- buffer and whether it's pointing at a file rather than a directory. deservesSave :: FBuffer -> YiM Bool deservesSave b | isUnchangedBuffer b = return False | otherwise = isFileBuffer b -- | Is there a proper file associated with the buffer? -- In other words, does it make sense to offer to save it? isFileBuffer :: FBuffer -> YiM Bool isFileBuffer b = case b ^. identA of MemBuffer _ -> return False FileBuffer fn -> not <$> liftBase (doesDirectoryExist fn) yi-0.12.6/src/library/Yi/History.hs0000644000000000000000000001262712717763531015244 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.History -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- ‘Command history’ implementation. module Yi.History where import Control.Applicative (liftA3, (<$>)) import Control.Lens (Lens', lens, set, (^.)) import Data.Binary (Binary, get, put) import Data.Default (Default, def) import Data.List (nub) import qualified Data.Map as M (Map, findWithDefault, insert, mapKeys) import Data.Monoid (mempty, (<>)) import qualified Data.Text as T (Text, isPrefixOf, null, pack, unpack) import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8) import Data.Typeable (Typeable) import Yi.Buffer (elemsB, replaceBufferContent) import Yi.Editor import qualified Yi.Rope as R (fromText, toText) import Yi.Types (YiVariable) newtype Histories = Histories (M.Map T.Text History) deriving (Show, Eq, Typeable) instance Binary Histories where put (Histories m) = put $ M.mapKeys T.unpack m get = Histories . M.mapKeys T.pack <$> get instance Default Histories where def = Histories def data History = History { _historyCurrent :: Int , _historyContents :: [T.Text] , _historyPrefix :: T.Text } deriving (Show, Eq, Typeable) instance Default History where def = History (-1) [] mempty instance Binary History where put (History cu co pr) = put cu >> put (map E.encodeUtf8 co) >> put (E.encodeUtf8 pr) get = liftA3 History get (fmap E.decodeUtf8 <$> get) (E.decodeUtf8 <$> get) instance YiVariable Histories dynKeyA :: (Default v, Ord k) => k -> Lens' (M.Map k v) v dynKeyA key = lens (M.findWithDefault def key) (flip (M.insert key)) miniBuffer :: T.Text miniBuffer = "minibuffer" historyUp :: EditorM () historyUp = historyMove miniBuffer 1 historyDown :: EditorM () historyDown = historyMove miniBuffer (-1) historyStart :: EditorM () historyStart = historyStartGen miniBuffer -- | Start an input session with History historyStartGen :: T.Text -> EditorM () historyStartGen ident = do Histories histories <- getEditorDyn let (History _cur cont pref) = histories ^. dynKeyA ident setHistory ident (History 0 (nub ("":cont)) pref) histories historyFinish :: EditorM () historyFinish = historyFinishGen miniBuffer (R.toText <$> withCurrentBuffer elemsB) -- | Finish the current input session with history. historyFinishGen :: T.Text -> EditorM T.Text -> EditorM () historyFinishGen ident getCurValue = do Histories histories <- getEditorDyn let History _cur cont pref = histories ^. dynKeyA ident curValue <- getCurValue let cont' = dropWhile (curValue ==) . dropWhile T.null $ cont curValue `seq` -- force the new value, otherwise we'll hold -- on to the buffer from which it's computed cont' `seq` -- force checking the top of the history, -- otherwise we'll build up thunks setHistory ident (History (-1) (curValue:cont') pref) histories historyFind :: [T.Text] -> Int -> Int -> Int -> T.Text -> Int historyFind cont len cur delta pref = case (next < 0, next >= len) of (True,_) -> next (_,True) -> next (_,_) -> if pref `T.isPrefixOf` (cont !! next) then next else historyFind cont len cur deltaLarger pref where next = cur + delta deltaLarger = delta + signum delta historyMove :: T.Text -> Int -> EditorM () historyMove ident delta = do s <- historyMoveGen ident delta (R.toText <$> withCurrentBuffer elemsB) withCurrentBuffer . replaceBufferContent . R.fromText $ s historyMoveGen :: T.Text -> Int -> EditorM T.Text -> EditorM T.Text historyMoveGen ident delta getCurValue = do Histories histories <- getEditorDyn let History cur cont pref = histories ^. dynKeyA ident curValue <- getCurValue let len = length cont next = historyFind cont len cur delta pref nextValue = cont !! next case (next < 0, next >= len) of (True, _) -> do printMsg $ "end of " <> ident <> " history, no next item." return curValue (_, True) -> do printMsg $ "beginning of " <> ident <> " history, no previous item." return curValue (_,_) -> do let contents = take cur cont ++ [curValue] ++ drop (cur + 1) cont setHistory ident (History next contents pref) histories return nextValue historyPrefixSet :: T.Text -> EditorM () historyPrefixSet = historyPrefixSet' miniBuffer historyPrefixSet' :: T.Text -> T.Text -> EditorM () historyPrefixSet' ident pref = do Histories histories <- getEditorDyn let History cur cont _pref = histories ^. dynKeyA ident setHistory ident (History cur cont pref) histories -- | Helper that sets the given history at ident and 'putEditorDyn's -- the result. setHistory :: (MonadEditor m, Functor m) => T.Text -- ^ identifier -> History -- ^ History to set -> M.Map T.Text History -- ^ Map of existing histories -> m () setHistory i h = putEditorDyn . Histories . set (dynKeyA i) h yi-0.12.6/src/library/Yi/Hoogle.hs0000644000000000000000000000740312717763531015014 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Hoogle -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Provides functions for calling Hoogle on the commandline, and -- processing results into a form useful for completion or insertion. module Yi.Hoogle where import Control.Applicative ((<$>)) import Control.Arrow ((&&&)) import Data.Char (isUpper) import Data.List (nub) import qualified Data.Text as T (isInfixOf, lines, pack) import System.Exit (ExitCode (ExitFailure)) import Yi.Buffer (readRegionB, regionOfB, replaceRegionB, unitWord) import Yi.Editor (printMsgs, withCurrentBuffer) import Yi.Keymap (YiM) import Yi.Process (runProgCommand) import qualified Yi.Rope as R (YiString, fromText, head, null, toString, toText, words) import Yi.String (showT) import Yi.Utils (io) -- | Remove anything starting with uppercase letter. These denote -- either module names or types. caseSensitize :: [R.YiString] -> [R.YiString] caseSensitize = filter p where p :: R.YiString -> Bool p t = case R.head t of Nothing -> False Just c -> not $ isUpper c -- | Hoogle's output includes a sort of type keyword, telling whether -- a hit is a package name, syntax, a module name, etc. But we care -- primarily about the function names, so we filter out anything -- containing the keywords. gv :: [R.YiString] -> [R.YiString] gv = filter f where ks = ["module ", " type ", "package ", " data ", " keyword "] f x = not $ any (`T.isInfixOf` R.toText x) ks -- | Query Hoogle, with given search and options. This errors out on no -- results or if the hoogle command is not on path. hoogleRaw :: R.YiString -> R.YiString -> IO [R.YiString] hoogleRaw srch opts = do let options = filter (not . R.null) [opts, srch] outp@(_status, out, _err) <- runProgCommand "hoogle" (R.toString <$> options) case outp of (ExitFailure 1, "", "") -> -- no output, probably failed to run binary fail "Error running hoogle command. Is hoogle on path?" (ExitFailure 1, xs, _) -> fail $ "hoogle failed with: " ++ xs _ -> return () -- TODO: bench ‘R.fromText . T.lines . T.pack’ vs ‘R.lines . R.fromString’ let results = fmap R.fromText . T.lines $ T.pack out if results == ["No results found"] then fail "No Hoogle results" else return results -- | Filter the output of 'hoogleRaw' to leave just functions. hoogleFunctions :: R.YiString -> IO [R.YiString] hoogleFunctions a = caseSensitize . gv . nub . map ((!!1) . R.words) <$> hoogleRaw a "" -- | Return module-function pairs. hoogleFunModule :: R.YiString -> IO [(R.YiString, R.YiString)] hoogleFunModule a = map ((head &&& (!! 1)) . R.words) . gv <$> hoogleRaw a "" -- | Call out to 'hoogleFunModule', and overwrite the word at point with -- the first returned function. hoogle :: YiM R.YiString hoogle = do (wordRegion,word) <- withCurrentBuffer $ do wordRegion <- regionOfB unitWord word <- readRegionB wordRegion return (wordRegion, word) ((modl,fun):_) <- io $ hoogleFunModule word withCurrentBuffer $ replaceRegionB wordRegion fun return modl -- | Call out to 'hoogleRaw', and print inside the Minibuffer the results of -- searching Hoogle with the word at point. hoogleSearch :: YiM () hoogleSearch = do word <- withCurrentBuffer $ do wordRegion <- regionOfB unitWord readRegionB wordRegion results <- io $ hoogleRaw word "" -- The quotes help legibility between closely-packed results printMsgs $ map showT results yi-0.12.6/src/library/Yi/Hooks.hs0000644000000000000000000000661312717763531014664 0ustar0000000000000000{- | This module provides assistance in implementing \"hooks\" in Yi. This module provides no major new functionality -- only assistance in using 'YiConfigVariable's more easily to implement hooks. We consider a simple example. Suppose we have a function > promptForFile :: Maybe FilePath -> YiM FilePath which prompts the user to select a file from their file system, starting with the provided directory (if actually provided). Since this is a frequent task in Yi, it is important for it to be as user-friendly as possible. If opinions vary on the meaning of \"user-friendly\", then we would really like to provide multiple implementations of @promptForFile@, and allow users to select which implementation to use in their config files. A way to achieve this is using hooks, as follows: > -- create a new type > newtype FilePrompter = FilePrompter > { runFilePrompter :: Maybe FilePath -> YiM FilePath } > deriving (Typeable) > $(nameDeriveAccessors ''FilePrompter (n -> Just (n ++ "A"))) > > -- give some implementations > filePrompter1, filePrompter2, filePrompter3 :: FilePrompter > ... > > -- declare FilePrompter as a YiConfigVariable (so it can go in the Config) > instance YiConfigVariable FilePrompter > > -- specify the default FilePrompter > instance Default FilePrompter where > def = filePrompter1 > > -- replace the old promptForFile function with a shim > promptForFile :: Maybe FilePath -> YiM FilePath > promptForFile = runHook runFilePrompter > > -- provide a custom-named Field for Yi.Config.Simple (not > -- strictly necessary, but user-friendly) > filePrompter :: Field FilePrompter > filePrompter = customVariable The user can write > ... > filePrompter %= filePrompter2 > ... in their config file, and calls to @promptForFile@ will now use the different prompter. Library code which called @promptForFile@ does not need to be changed, but it gets the new @filePrompter2@ behaviour automatically. See "Yi.Eval" for a real example of hooks. -} module Yi.Hooks( -- * Convenience function 'runHook' runHook, HookType, -- * Re-exports from "Yi.Config.Simple" customVariable, Field, ) where import Control.Lens ((^.)) import Yi.Config (configVariable) import Yi.Config.Simple.Types (Field, customVariable) import Yi.Editor (EditorM, askCfg) import Yi.Keymap (YiM) import Yi.Types (YiConfigVariable) -- | Looks up the configured value for the hook, and runs it. The -- argument to 'runHook' will typically be a record accessor. See -- 'HookType' for the valid hook types. runHook :: (HookType ty, YiConfigVariable var) => (var -> ty) -> ty runHook = runHookImpl -- | The class of \"valid hooks\". This class is exported abstractly, -- but the instances can be phrased quite simply: the functions (of -- arbitrarily many arguments, including zero) which run in either the -- 'EditorM' or 'YiM' monads. -- --A typical example would be something like -- -- @Int -> String -> 'EditorM' String@. class HookType ty where runHookImpl :: YiConfigVariable var => (var -> ty) -> ty instance HookType (EditorM a) where runHookImpl lookupHook = do cfg <- askCfg lookupHook (cfg ^. configVariable) instance HookType (YiM a) where runHookImpl lookupHook = do cfg <- askCfg lookupHook (cfg ^. configVariable) instance HookType b => HookType (a -> b) where runHookImpl lookupHook a = runHookImpl (($a) . lookupHook) yi-0.12.6/src/library/Yi/IReader.hs0000644000000000000000000001570012717763531015111 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.IReader -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- 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 -- . module Yi.IReader where import Control.Exception (SomeException, catch) import Control.Monad (join, void) import Data.Binary (Binary, decode, encodeFile) import qualified Data.ByteString.Char8 as B (ByteString, pack, readFile, unpack) import qualified Data.ByteString.Lazy.Char8 as BL (fromChunks) import Data.Default (Default, def) import Data.Functor ((<$>)) import Data.Sequence as S (Seq, ViewL (EmptyL, (:<)), ViewR ((:>)), empty, length, null, splitAt, viewl, viewr, (<|), (><), (|>)) import Data.Typeable (Typeable) import Yi.Buffer.HighLevel (replaceBufferContent, topB) import Yi.Buffer.Misc (elemsB, getBufferDyn, putBufferDyn) import Yi.Editor (withCurrentBuffer) import Yi.Keymap (YiM) import Yi.Paths (getArticleDbFilename) import qualified Yi.Rope as R (fromString, toString) import Yi.Types (YiVariable) import Yi.Utils (io) -- | TODO: Why 'B.ByteString'? type Article = B.ByteString newtype ArticleDB = ADB { unADB :: Seq Article } deriving (Typeable, Binary) instance Default ArticleDB where def = ADB S.empty instance YiVariable ArticleDB -- | Take an 'ArticleDB', and return the first 'Article' and an -- ArticleDB - *without* that article. split :: ArticleDB -> (Article, ArticleDB) split (ADB adb) = case viewl adb of EmptyL -> (B.pack "", def) (a :< b) -> (a, ADB b) -- | 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 - every article gets equal time. getLatestArticle :: ArticleDB -> Article getLatestArticle = fst . split -- we only want the article -- | We remove the old first article, and we stick it on the end of the -- list using the presumably modified version. removeSetLast :: ArticleDB -> Article -> ArticleDB removeSetLast adb old = ADB (unADB (snd (split adb)) S.|> old) -- we move the last entry to the entry 'length `div` n'from the -- beginning; so 'shift 1' would do nothing (eg. the last index is 50, -- 50 `div` 1 == 50, so the item would be moved to where it is) 'shift -- 2' will move it to the middle of the list, though; last index = 50, -- then 50 `div` 2 will shift the item to index 25, and so on down to -- 50 `div` 50 - the head of the list/Seq. shift :: Int ->ArticleDB -> ArticleDB shift n adb = if n < 2 || lst < 2 then adb else ADB $ (r S.|> lastentry) >< s' where lst = S.length (unADB adb) - 1 (r,s) = S.splitAt (lst `div` n) (unADB adb) (s' :> lastentry) = S.viewr s -- | Insert a new article with top priority (that is, at the front of the list). insertArticle :: ArticleDB -> Article -> ArticleDB insertArticle (ADB adb) new = ADB (new S.<| adb) -- | Serialize given 'ArticleDB' out. writeDB :: ArticleDB -> YiM () writeDB adb = void $ io . join . fmap (`encodeFile` adb) $ getArticleDbFilename -- | Read in database from 'getArticleDbFilename' and then parse it -- into an 'ArticleDB'. readDB :: YiM ArticleDB readDB = io $ (getArticleDbFilename >>= r) `catch` returnDefault where r = fmap (decode . BL.fromChunks . return) . B.readFile -- We read in with strict bytestrings to guarantee the file is -- closed, and then we convert it to the lazy bytestring -- data.binary expects. This is inefficient, but alas... returnDefault (_ :: SomeException) = return def -- | Returns the database as it exists on the disk, and the current Yi -- buffer contents. Note that the Default typeclass gives us an empty -- Seq. So first we try the buffer state in the hope we can avoid a -- very expensive read from disk, and if we find nothing (that is, if -- we get an empty Seq), only then do we call 'readDB'. oldDbNewArticle :: YiM (ArticleDB, Article) oldDbNewArticle = do saveddb <- withCurrentBuffer getBufferDyn newarticle <- B.pack . R.toString <$> withCurrentBuffer elemsB if not $ S.null (unADB saveddb) then return (saveddb, newarticle) else readDB >>= \olddb -> return (olddb, newarticle) -- | Given an 'ArticleDB', dump the scheduled article into the buffer -- (replacing previous contents). setDisplayedArticle :: ArticleDB -> YiM () setDisplayedArticle newdb = do let next = getLatestArticle newdb withCurrentBuffer $ do replaceBufferContent $ R.fromString (B.unpack next) topB -- replaceBufferContents moves us to bottom? putBufferDyn newdb -- | Go to next one. This ignores the buffer, but it doesn't remove -- anything from the database. However, the ordering does change. nextArticle :: YiM () nextArticle = do (oldb,_) <- oldDbNewArticle -- Ignore buffer, just set the first article last let newdb = removeSetLast oldb (getLatestArticle oldb) writeDB newdb setDisplayedArticle newdb -- | Delete current article (the article as in the database), and go -- to next one. deleteAndNextArticle :: YiM () deleteAndNextArticle = do (oldb,_) <- oldDbNewArticle -- throw away changes let ndb = ADB $ case viewl (unADB oldb) of -- drop 1st article EmptyL -> empty (_ :< b) -> b writeDB ndb setDisplayedArticle ndb -- | The main action. We fetch the old database, we fetch the modified -- article from the buffer, then we call the function 'updateSetLast' -- which removes the first article and pushes our modified article to -- the end of the list. saveAndNextArticle :: Int -> YiM () saveAndNextArticle n = do (oldb,newa) <- oldDbNewArticle let newdb = shift n $ removeSetLast oldb newa writeDB newdb setDisplayedArticle newdb -- | Assume the buffer is an entirely new article just imported this -- second, and save it. We don't want to use 'updateSetLast' since -- that will erase an article. saveAsNewArticle :: YiM () saveAsNewArticle = do oldb <- readDB -- make sure we read from disk - we aren't in iread-mode! (_,newa) <- oldDbNewArticle -- we ignore the fst - the Default is 'empty' let newdb = insertArticle oldb newa writeDB newdb yi-0.12.6/src/library/Yi/IncrementalParse.hs0000644000000000000000000000275112717763531017034 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} module Yi.IncrementalParse (recoverWith, symbol, eof, lookNext, testNext, State, P, Parser(..), AlexState (..), scanner) where import Parser.Incremental (Parser (..), Process, eof, evalL, evalR, lookNext, mkProcess, pushEof, pushSyms, recoverWith, symbol, testNext) import Yi.Lexer.Alex (AlexState (..)) import Yi.Syntax (Scanner (..)) type P s a = Parser s a type State st token result = (st, Process token result) scanner :: forall st token result. Parser token result -> Scanner st token -> Scanner (State st token result) result scanner parser input = Scanner { scanInit = (scanInit input, mkProcess parser), scanLooked = scanLooked input . fst, scanRun = run, scanEmpty = fst $ evalR $ pushEof $ mkProcess parser } where run :: State st token result -> [(State st token result, result)] run (st,process) = updateState0 process $ scanRun input st updateState0 :: Process token result -> [(st,token)] -> [(State st token result, result)] updateState0 _ [] = [] updateState0 curState toks@((st,tok):rest) = ((st, curState), result) : updateState0 nextState rest where nextState = evalL $ pushSyms [tok] curState result = fst $ evalR $ pushEof $ pushSyms (fmap snd toks) curState yi-0.12.6/src/library/Yi/Interact.hs0000644000000000000000000002623612717763531015355 0ustar0000000000000000{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK show-extensions #-} {-| Module : Yi.Interact License : GPL-2 Maintainer : yi-devel@googlegroups.com Stability : experimental Portability : portable This is a library of interactive processes combinators, usable to define extensible keymaps. (Inspired by the Parsec library, written by Koen Claessen) The processes are: * composable: in parallel using '<|>', in sequence using monadic bind. * extensible: it is always possible to override a behaviour by combination of 'adjustPriority' and '<|>'. (See also '<||' for a convenient combination of the two.) * monadic: sequencing is done via monadic bind. (leveraging the whole battery of monadic tools that Haskell provides) The processes can parse input, and write output that depends on it. The semantics are quite obvious; only disjunction deserve a bit more explanation: in @p = (a '<|>' b)@, what happens if @a@ and @b@ recognize the same input (prefix), but produce conflicting output? * if the output is the same (as by the Eq class), then the processes (prefixes) are "merged" * if a Write is more prioritized than the other, the one with low priority will be discarded * otherwise, the output will be delayed until one of the branches can be discarded. * if there is no way to disambiguate, then no output will be generated anymore. This situation can be detected by using 'possibleActions' however. -} module Yi.Interact ( I, P (Chain,End), InteractState (..), MonadInteract (..), deprioritize, important, (<||), (||>), option, oneOf, processOneEvent, computeState, event, events, choice, mkAutomaton, idAutomaton, runWrite, anyEvent, eventBetween, accepted ) where import Control.Applicative (Alternative ((<|>), empty), Applicative ((<*>), pure)) import Control.Arrow (first) import Control.Lens (Field1 (_1), Field2 (_2), view) import Control.Monad.State (MonadPlus (..), MonadTrans (lift), StateT) import Data.Function (on) import Data.List (groupBy) import Data.Monoid (Monoid (mappend, mempty)) import qualified Data.Text as T (Text, append, pack) ------------------------------------------------ -- Classes -- | Abstraction of monadic interactive processes class (Eq w, Monad m, Alternative m, Applicative m, MonadPlus m) => MonadInteract m w e | m -> w e where write :: w -> m () -- ^ Outputs a result. eventBounds :: Ord e => Maybe e -> Maybe e -> m e -- ^ Consumes and returns the next character. -- Fails if there is no input left, or outside the given bounds. adjustPriority :: Int -> m () ------------------------------------------------- -- State transformation -- Needs -fallow-undecidable-instances -- TODO: abstract over MonadTransformer instance MonadInteract m w e => MonadInteract (StateT s m) w e where write = lift . write eventBounds l h = lift (eventBounds l h) adjustPriority p = lift (adjustPriority p) --------------------------------------------------------------------------- -- | Interactive process description -- TODO: Replace 'Doc:' by ^ when haddock supports GADTs data I ev w a where Returns :: a -> I ev w a Binds :: I ev w a -> (a -> I ev w b) -> I ev w b Gets :: Ord ev => Maybe ev -> Maybe ev -> I ev w ev -- Doc: Accept any character between given bounds. Bound is ignored if 'Nothing'. Fails :: I ev w a Writes :: w -> I ev w () Priority :: Int -> I ev w () Plus :: I ev w a -> I ev w a -> I ev w a instance Functor (I event w) where fmap f i = pure f <*> i instance Applicative (I ev w) where pure = return a <*> b = do f <- a; x <- b; return (f x) instance Alternative (I ev w) where empty = Fails (<|>) = Plus instance Monad (I event w) where return = Returns fail _ = Fails (>>=) = Binds instance Eq w => MonadPlus (I event w) where mzero = Fails mplus = Plus instance Eq w => MonadInteract (I event w) w event where write = Writes eventBounds = Gets adjustPriority = Priority infixl 3 <|| deprioritize :: (MonadInteract f w e) => f () deprioritize = adjustPriority 1 (<||), (||>) :: (MonadInteract f w e) => f a -> f a -> f a a <|| b = a <|> (deprioritize >> b) (||>) = flip (<||) -- | Just like '(<||)' but in prefix form. It 'deprioritize's the -- second argument. important :: MonadInteract f w e => f a -> f a -> f a important a b = a <|| b -- | Convert a process description to an "executable" process. mkProcess :: Eq w => I ev w a -> (a -> P ev w) -> P ev w mkProcess (Returns x) = \fut -> fut x mkProcess Fails = const Fail mkProcess (m `Binds` f) = \fut -> mkProcess m (\a -> mkProcess (f a) fut) mkProcess (Gets l h) = Get l h mkProcess (Writes w) = \fut -> Write w (fut ()) mkProcess (Priority p) = \fut -> Prior p (fut ()) mkProcess (Plus a b) = \fut -> Best (mkProcess a fut) (mkProcess b fut) ---------------------------------------------------------------------- -- Process type -- | Operational representation of a process data P event w = Ord event => Get (Maybe event) (Maybe event) (event -> P event w) | Fail | Write w (P event w) | Prior Int (P event w) -- low numbers indicate high priority | Best (P event w) (P event w) | End | forall mid. (Show mid, Eq mid) => Chain (P event mid) (P mid w) accepted :: (Show ev) => Int -> P ev w -> [[T.Text]] accepted 0 _ = [[]] accepted d (Get (Just low) (Just high) k) = do t <- accepted (d - 1) (k low) let h = if low == high then showT low else showT low `T.append` ".." `T.append` showT high return (h : t) accepted _ (Get Nothing Nothing _) = [[""]] accepted _ (Get Nothing (Just e) _) = [[".." `T.append` showT e]] accepted _ (Get (Just e) Nothing _) = [[showT e `T.append` ".."]] accepted _ Fail = [] accepted _ (Write _ _) = [[]] -- this should show what action we get... accepted d (Prior _ p) = accepted d p accepted d (Best p q) = accepted d p ++ accepted d q accepted _ End = [] accepted _ (Chain _ _) = error "accepted: chain not supported" -- Utility function showT :: Show a => a -> T.Text showT = T.pack . show -- --------------------------------------------------------------------------- -- Operations over P runWrite :: Eq w => P event w -> [event] -> [w] runWrite _ [] = [] runWrite p (c:cs) = let (ws, p') = processOneEvent p c in ws ++ runWrite p' cs processOneEvent :: Eq w => P event w -> event -> ([w], P event w) processOneEvent p e = pullWrites $ pushEvent p e -- | Push an event in the automaton pushEvent :: P ev w -> ev -> P ev w pushEvent (Best c d) e = Best (pushEvent c e) (pushEvent d e) pushEvent (Write w c) e = Write w (pushEvent c e) pushEvent (Prior p c) e = Prior p (pushEvent c e) pushEvent (Get l h f) e = if test (e >=) l && test (e <=) h then f e else Fail where test = maybe True pushEvent Fail _ = Fail pushEvent End _ = End pushEvent (Chain p q) e = Chain (pushEvent p e) q -- | Abstraction of the automaton state. data InteractState event w = Ambiguous [(Int,w,P event w)] | Waiting | Dead | Running w (P event w) instance Monoid (InteractState event w) where -- not used at the moment: mappend (Running w c) _ = Running w c mappend _ (Running w c) = Running w c -- don't die if that can be avoided mappend Dead p = p mappend p Dead = p -- If a branch is not determined, wait for it. mappend Waiting _ = Waiting mappend _ Waiting = Waiting -- ambiguity remains mappend (Ambiguous a) (Ambiguous b) = Ambiguous (a ++ b) mempty = Ambiguous [] -- | find all the writes that are accessible. findWrites :: Int -> P event w -> InteractState event w findWrites p (Best c d) = findWrites p c `mappend` findWrites p d findWrites p (Write w c) = Ambiguous [(p,w,c)] findWrites p (Prior dp c) = findWrites (p+dp) c findWrites _ Fail = Dead findWrites _ End = Dead findWrites _ (Get{}) = Waiting findWrites p (Chain a b) = case computeState a of Dead -> Dead Ambiguous _ -> Dead -- If ambiguity, don't try to do anything clever for now; die. Running w c -> findWrites p (Chain c (pushEvent b w)) -- pull as much as possible from the left automaton Waiting -> case findWrites p b of Ambiguous choices -> Ambiguous [(p',w',Chain a c') | (p',w',c') <- choices] Running w' c' -> Running w' (Chain a c') -- when it has nothing more, pull from the right. Dead -> Dead Waiting -> Waiting computeState :: Eq w => P event w -> InteractState event w computeState a = case findWrites 0 a of Ambiguous actions -> let prior = minimum $ map (view _1) actions bests = groupBy ((==) `on` view _2) $ filter ((prior ==) . view _1) actions in case bests of [(_,w,c):_] -> Running w c _ -> Ambiguous $ map head bests s -> s pullWrites :: Eq w => P event w -> ([w], P event w) pullWrites a = case computeState a of Running w c -> first (w:) (pullWrites c) _ -> ([], a) instance (Show w, Show ev) => Show (P ev w) where show (Get Nothing Nothing _) = "?" show (Get (Just l) (Just h) _p) | l == h = show l -- ++ " " ++ show (p l) show (Get l h _) = maybe "" show l ++ ".." ++ maybe "" show h show (Prior p c) = ":" ++ show p ++ show c show (Write w c) = "!" ++ show w ++ "->" ++ show c show (End) = "." show (Fail) = "*" show (Best p q) = "{" ++ show p ++ "|" ++ show q ++ "}" show (Chain a b) = show a ++ ">>>" ++ show b -- --------------------------------------------------------------------------- -- Derived operations oneOf :: (Ord event, MonadInteract m w event) => [event] -> m event oneOf s = choice $ map event s anyEvent :: (Ord event, MonadInteract m w event) => m event anyEvent = eventBounds Nothing Nothing eventBetween :: (Ord e, MonadInteract m w e) => e -> e -> m e eventBetween l h = eventBounds (Just l) (Just h) event :: (Ord event, MonadInteract m w event) => event -> m event -- ^ Parses and returns the specified character. event e = eventBetween e e events :: (Ord event, MonadInteract m w event) => [event] -> m [event] -- ^ Parses and returns the specified list of events (lazily). events = mapM event choice :: (MonadInteract m w e) => [m a] -> m a -- ^ Combines all parsers in the specified list. choice [] = fail "No choice succeeds" choice [p] = p choice (p:ps) = p `mplus` choice ps option :: (MonadInteract m w e) => a -> m a -> m a -- ^ @option x p@ will either parse @p@ or return @x@ without consuming -- any input. option x p = p `mplus` return x mkAutomaton :: Eq w => I ev w a -> P ev w mkAutomaton i = mkProcess i (const End) -- An automaton that produces its input idAutomaton :: (Ord a, Eq a) => P a a idAutomaton = Get Nothing Nothing $ \e -> Write e idAutomaton -- It would be much nicer to write: -- mkAutomaton (forever 0 (anyEvent >>= write)) -- however this creates a memory leak. Unfortunately I don't understand why. -- To witness: -- dist/build/yi/yi +RTS -hyI -hd -- Then type some characters. (Binds grows linearly) yi-0.12.6/src/library/Yi/JumpList.hs0000644000000000000000000000251212717763531015342 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} module Yi.JumpList ( JumpList , Jump(..) , addJump , jumpBack , jumpForward ) where import GHC.Generics (Generic) import Data.Binary (Binary) import Data.List.PointedList as PL (PointedList (..), next, previous) import Yi.Buffer.Basic (BufferRef, Mark) type JumpList = Maybe (PL.PointedList Jump) data Jump = Jump { jumpMark :: Mark , jumpBufferRef :: BufferRef } deriving (Generic) instance Binary Jump instance Show Jump where show (Jump mark bufref) = "" addJump :: Jump -> JumpList -> JumpList addJump j (Just (PL.PointedList past present _future)) = Just $ PL.PointedList (present:past) j [] addJump j Nothing = Just $ PL.PointedList [] j [] jumpBack :: JumpList -> JumpList jumpBack = modifyJumpList previous jumpForward :: JumpList -> JumpList jumpForward = modifyJumpList next modifyJumpList :: (PointedList Jump -> Maybe (PointedList Jump)) -> JumpList -> JumpList modifyJumpList f (Just jumps) = case f jumps of Nothing -> Just jumps Just jumps' -> Just jumps' modifyJumpList _ Nothing = Nothing yi-0.12.6/src/library/Yi/Keymap.hs0000644000000000000000000000767612717763531015041 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeSynonymInstances #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- 'Keymap', 'YiM' and 'Action's. module Yi.Keymap ( Action(..) , emptyAction , Interact , KeymapM , Keymap , KeymapEndo , KeymapProcess , KeymapSet(..) , topKeymapA , insertKeymapA , extractTopKeymap , modelessKeymapSet , YiM(..) , withUI , unsafeWithEditor , readEditor , catchDynE , catchJustE , handleJustE , YiAction (..) , Yi(..) , IsRefreshNeeded(..) , YiVar(..) , write , withModeY -- * Lenses , yiSubprocessesA , yiEditorA , yiSubprocessIdSupplyA , yiConfigA , yiInputA , yiOutputA , yiUiA , yiVarA ) where import Control.Exception (Exception, catch, catchJust) import Control.Monad.Reader (ReaderT (ReaderT, runReaderT)) import Control.Monad.State (gets) import Yi.Buffer () import qualified Yi.Editor as Editor (currentBuffer, findBuffer) import qualified Yi.Interact as I (MonadInteract, write) import Yi.Monad (with) import Yi.Types import Yi.UI.Common (UI) import Yi.Utils (io, makeLensesWithSuffix) ----------------------- -- Keymap basics -- | @write a@ returns a keymap that just outputs the action @a@. write :: (I.MonadInteract m Action ev, YiAction a x, Show x) => a -> m () write x = I.write (makeAction x) -------------------------------- -- Uninteresting glue code withUI :: (UI Editor -> IO a) -> YiM a withUI = with yiUi readEditor :: MonadEditor m => (Editor -> a) -> m a readEditor f = withEditor (gets f) catchDynE :: Exception exception => YiM a -> (exception -> YiM a) -> YiM a catchDynE (YiM inner) handler = YiM $ ReaderT (\r -> catch (runReaderT inner r) (\e -> runReaderT (runYiM $ handler e) r)) catchJustE :: (Exception e) => (e -> Maybe b) -- ^ Predicate to select exceptions -> YiM a -- ^ Computation to run -> (b -> YiM a) -- ^ Handler -> YiM a catchJustE p (YiM c) h = YiM $ ReaderT (\r -> catchJust p (runReaderT c r) (\b -> runReaderT (runYiM $ h b) r)) handleJustE :: (Exception e) => (e -> Maybe b) -> (b -> YiM a) -> YiM a -> YiM a handleJustE p h c = catchJustE p c h -- ------------------------------------------- class YiAction a x | a -> x where makeAction :: Show x => a -> Action instance YiAction (IO x) x where makeAction = YiA . io instance YiAction (YiM x) x where makeAction = YiA instance YiAction (EditorM x) x where makeAction = EditorA instance YiAction (BufferM x) x where makeAction = BufferA instance YiAction Action () where makeAction = id makeLensesWithSuffix "A" ''KeymapSet modelessKeymapSet :: Keymap -> KeymapSet modelessKeymapSet k = KeymapSet { insertKeymap = k , topKeymap = k } -- | @withModeY f@ runs @f@ on the current buffer's mode. As this runs in -- the YiM monad, we're able to do more than with just 'withModeB' such as -- prompt the user for something before running the action. withModeY :: (forall syntax. Mode syntax -> YiM ()) -> YiM () withModeY f = do bufref <- gets Editor.currentBuffer mfbuf <- Editor.findBuffer bufref case mfbuf of Nothing -> return () Just (FBuffer {bmode = m}) -> f m makeLensesWithSuffix "A" ''YiVar makeLensesWithSuffix "A" ''Yi yi-0.12.6/src/library/Yi/Keymap/Completion.hs0000644000000000000000000000404112717763531017131 0ustar0000000000000000-- | This is a little helper for completion interfaces. module Yi.Keymap.Completion ( CompletionTree(CT), stepTree, obvious, mergeTrees, listToTree, complete) where import Control.Arrow (first) import Data.List (find, groupBy, intercalate, sortBy) -- inside a completion tree, the a's must be unique on each level data CompletionTree a = CT [(a,CompletionTree a)] instance (Show a) => Show (CompletionTree a) where show = show' show' :: (Show a) => CompletionTree a -> String show' (CT []) = [] show' (CT [(a,st)]) = shows a $ show' st show' (CT trees) = "[" ++ intercalate "|" (map (\(x,y)->shows x $ show' y) trees) ++ "]" compareBy :: (Ord b) => (a->b)->a->a->Ordering compareBy f a b = compare (f a) (f b) listToTree :: [a] -> CompletionTree a listToTree = foldr (\a b->CT [(a,b)]) (CT []) stepTree :: Eq a => CompletionTree a->a->Maybe ([a],CompletionTree a) stepTree (CT completions) letter = Just $ obvious $ CT $ filter ((letter==).fst) completions obvious :: CompletionTree a -> ([a],CompletionTree a) obvious (CT [(letter,moretrees)]) = first ((:) letter) $ obvious moretrees obvious remainingchoice = ([],remainingchoice) mergeTrees :: Ord a => [CompletionTree a] -> CompletionTree a mergeTrees a = mergeTrees' (map sort' a) where sort' = CT . sortBy (compareBy fst) . (\(CT l)->l) mergeTrees':: Ord a => [CompletionTree a] -> CompletionTree a mergeTrees' trees = CT $ map (\x->(fst $ head x,mergeTrees $ map snd x)) $ groupBy (((EQ==).).compareBy fst) $ sortBy (compareBy fst) $ concatMap (\(CT x)->x) trees complete :: Eq a => CompletionTree a -> [a] -> ([a],CompletionTree a) complete tree [] = ([],tree) complete (CT []) _ = ([],CT []) complete (CT level) (a:ta) = first ((:) a) $ case match of Just m -> complete (snd m) ta Nothing -> ([],CT []) where match = find ((a==).fst) level --alternatives :: CompletionTree a->[[a]] yi-0.12.6/src/library/Yi/Keymap/Cua.hs0000644000000000000000000001303412725740550015525 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Cua -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Cua keymap. module Yi.Keymap.Cua ( keymap , portableKeymap , customizedCuaKeymapSet , cut , paste , copy , del ) where import Control.Applicative (Alternative ((<|>)), (<$>)) import Control.Lens (assign, use) import Control.Monad (unless, when) import qualified Data.Text as T (drop, take) import Yi.Buffer import Yi.Editor import Yi.File (fwriteE) import Yi.Keymap (Keymap, KeymapSet, YiM, modelessKeymapSet, write) import Yi.Keymap.Emacs.Utils (askQuitEditor, findFile, isearchKeymap) import Yi.Keymap.Keys import Yi.MiniBuffer (commentRegion) import Yi.Misc (adjBlock, selectAll) import Yi.Rectangle (getRectangle, killRectangle, yankRectangle) import qualified Yi.Rope as R (YiString, length, singleton, withText) import Yi.String (lines', unlines') import Yi.Keymap.Emacs.KillRing (clipboardToKillring, killringToClipboard) customizedCuaKeymapSet :: Keymap -> KeymapSet customizedCuaKeymapSet userKeymap = modelessKeymapSet $ selfInsertKeymap <|> move <|> select <|> rect <|> userKeymap <|> other ctrl keymap :: KeymapSet keymap = portableKeymap ctrl -- | Introduce a keymap that is compatible with both windows and osx, -- by parameterising the event modifier required for commands portableKeymap :: (Event -> Event) -> KeymapSet portableKeymap cmd = modelessKeymapSet $ selfInsertKeymap <|> move <|> select <|> rect <|> other cmd selfInsertKeymap :: Keymap selfInsertKeymap = do c <- printableChar let action = (withCurrentBuffer . replaceSel $ R.singleton c) :: EditorM () write action setMark :: Bool -> BufferM () setMark b = do isSet <- use highlightSelectionA assign rectangleSelectionA b unless isSet $ do assign highlightSelectionA True pointB >>= setSelectionMarkPointB unsetMark :: BufferM () unsetMark = assign highlightSelectionA False replaceSel :: R.YiString -> BufferM () replaceSel s = do hasSel <- use highlightSelectionA if hasSel then getSelectRegionB >>= flip replaceRegionB s else do when (R.length s == 1) (adjBlock 1) insertN s deleteSel :: BufferM () -> YiM () deleteSel act = do haveSelection <- withCurrentBuffer $ use highlightSelectionA if haveSelection then withEditor del else withCurrentBuffer (adjBlock (-1) >> act) cut :: YiM () cut = copy >> withEditor del del :: EditorM () del = do asRect <- withCurrentBuffer $ use rectangleSelectionA if asRect then killRectangle else withCurrentBuffer $ deleteRegionB =<< getSelectRegionB copy :: YiM () copy = do text <- withCurrentBuffer $ do asRect <- use rectangleSelectionA if not asRect then getSelectRegionB >>= readRegionB else do (reg, l, r) <- getRectangle let dropOutside = fmap (T.take (r - l) . T.drop l) R.withText (unlines' . dropOutside . lines') <$> readRegionB reg withEditor $ setRegE text killringToClipboard paste :: YiM () paste = do clipboardToKillring asRect <- withCurrentBuffer (use rectangleSelectionA) withEditor $ if asRect then yankRectangle else withCurrentBuffer . replaceSel =<< getRegE moveKeys :: [(Event, BufferM ())] moveKeys = [ (spec KHome , maybeMoveB Line Backward), (spec KEnd , maybeMoveB Line Forward), (super (spec KRight) , maybeMoveB Line Forward), (super (spec KLeft ) , maybeMoveB Line Backward), (ctrl (spec KHome) , maybeMoveB Document Backward), (ctrl (spec KEnd) , maybeMoveB Document Forward), (super (spec KUp) , maybeMoveB Document Backward), (super (spec KDown) , maybeMoveB Document Forward), (ctrl (spec KRight) , moveB unitWord Forward), (ctrl (spec KLeft ) , moveB unitWord Backward), (spec KUp , moveB VLine Backward), (spec KDown , moveB VLine Forward), (spec KRight , moveB Character Forward), (spec KLeft , moveB Character Backward), (spec KPageUp , scrollScreensB (-1)), (spec KPageDown , scrollScreensB 1) ] move, select, rect :: Keymap other :: (Event -> Event) -> Keymap move = choice [ k ?>>! unsetMark >> a | (k,a) <- moveKeys] select = choice [ shift k ?>>! setMark False >> a | (k,a) <- moveKeys] rect = choice [meta (shift k) ?>>! setMark True >> a | (k,a) <- moveKeys] other cmd = choice [ spec KBS ?>>! deleteSel bdeleteB, spec KDel ?>>! deleteSel (deleteN 1), spec KEnter ?>>! replaceSel $ R.singleton '\n', cmd (char 'q') ?>>! askQuitEditor, cmd (char 'f') ?>> isearchKeymap Forward, cmd (char 'x') ?>>! cut, cmd (char 'c') ?>>! copy, cmd (char 'v') ?>>! paste, cmd (spec KIns) ?>>! copy, shift (spec KIns) ?>>! paste, cmd (char 'z') ?>>! undoB, cmd (char 'y') ?>>! redoB, cmd (char 's') ?>>! fwriteE, cmd (char 'o') ?>>! findFile, cmd (char '/') ?>>! commentRegion, cmd (char ']') ?>>! autoIndentB IncreaseOnly, cmd (char '[') ?>>! autoIndentB DecreaseOnly, cmd (char 'a') ?>>! selectAll ] yi-0.12.6/src/library/Yi/Keymap/Emacs.hs0000644000000000000000000003300612725740550016046 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE LambdaCase #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Emacs -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module aims at a mode that should be (mostly) intuitive to -- emacs users, but mapping things into the Yi world when convenient. -- Hence, do not go into the trouble of trying 100% emulation. For -- example, @M-x@ gives access to Yi (Haskell) functions, with their -- native names. module Yi.Keymap.Emacs ( keymap , mkKeymap , defKeymap , ModeMap(..) , eKeymap , completionCaseSensitive ) where import Control.Applicative (Alternative ((<|>), empty, some)) import Control.Lens (assign, makeLenses, (%=)) import Control.Monad (replicateM_, unless, void) import Control.Monad.State (gets) import Data.Char (digitToInt, isDigit) import Data.Maybe (fromMaybe) import Data.Prototype (Proto (Proto), extractValue) import Data.Text () import Yi.Buffer import Yi.Command (shellCommandE) import Yi.Core import Yi.Dired (dired) import Yi.Editor import Yi.File (fwriteE, fwriteToE) import Yi.Keymap (Keymap, KeymapSet, YiAction (..), YiM, modelessKeymapSet, write) import Yi.Keymap.Emacs.KillRing import Yi.Keymap.Emacs.Utils import Yi.Keymap.Keys import Yi.MiniBuffer import Yi.Misc (adjBlock, adjIndent, placeMark, selectAll) import Yi.Mode.Buffers (listBuffers) import Yi.Rectangle import Yi.Search (isearchFinishWithE, resetRegexE, getRegexE) import Yi.TextCompletion (resetComplete, wordComplete') data ModeMap = ModeMap { _eKeymap :: Keymap , _completionCaseSensitive :: Bool } $(makeLenses ''ModeMap) keymap :: KeymapSet keymap = mkKeymap defKeymap mkKeymap :: Proto ModeMap -> KeymapSet mkKeymap = modelessKeymapSet . _eKeymap . extractValue defKeymap :: Proto ModeMap defKeymap = Proto template where template self = ModeMap { _eKeymap = emacsKeymap , _completionCaseSensitive = False } where emacsKeymap :: Keymap emacsKeymap = selfInsertKeymap Nothing isDigit <|> completionKm (_completionCaseSensitive self) <|> do univArg <- readUniversalArg selfInsertKeymap univArg (not . isDigit) <|> emacsKeys univArg selfInsertKeymap :: Maybe Int -> (Char -> Bool) -> Keymap selfInsertKeymap univArg condition = do c <- printableChar unless (condition c) empty let n = argToInt univArg write (adjBlock n >> replicateM_ n (insertB c)) completionKm :: Bool -> Keymap completionKm caseSensitive = do void $ some (meta (char '/') ?>>! wordComplete' caseSensitive) deprioritize write resetComplete -- 'adjustPriority' is there to lift the ambiguity between "continuing" completion -- and resetting it (restarting at the 1st completion). deleteB' :: BufferM () deleteB' = adjBlock (-1) >> deleteN 1 -- | Wrapper around 'moveE' which also cancels incremental search. See -- issue #499 for details. moveE :: TextUnit -> Direction -> EditorM () moveE u d = do getRegexE >>= \case -- let's check whether searching is in progress (issues #738, #610) Nothing -> return () _ -> isearchFinishWithE resetRegexE withCurrentBuffer (moveB u d) emacsKeys :: Maybe Int -> Keymap emacsKeys univArg = choice [ -- First all the special key bindings spec KTab ?>>! adjIndent IncreaseCycle , shift (spec KTab) ?>>! adjIndent DecreaseCycle , spec KEnter ?>>! repeatingArg newlineB , spec KDel ?>>! deleteRegionOr deleteForward , spec KBS ?>>! deleteRegionOr deleteBack , spec KHome ?>>! repeatingArg moveToSol , spec KEnd ?>>! repeatingArg moveToEol , spec KLeft ?>>! repeatingArg $ moveE Character Backward , spec KRight ?>>! repeatingArg $ moveE Character Forward , spec KUp ?>>! repeatingArg $ moveE VLine Backward , spec KDown ?>>! repeatingArg $ moveE VLine Forward , spec KPageDown ?>>! repeatingArg downScreenB , spec KPageUp ?>>! repeatingArg upScreenB , shift (spec KUp) ?>>! repeatingArg (scrollB (-1)) , shift (spec KDown) ?>>! repeatingArg (scrollB 1) -- All the keybindings of the form 'Ctrl + special key' , ctrl (spec KLeft) ?>>! repeatingArg prevWordB , ctrl (spec KRight) ?>>! repeatingArg nextWordB , ctrl (spec KHome) ?>>! repeatingArg topB , ctrl (spec KEnd) ?>>! repeatingArg botB , ctrl (spec KUp) ?>>! repeatingArg (prevNParagraphs 1) , ctrl (spec KDown) ?>>! repeatingArg (nextNParagraphs 1) -- All the keybindings of the form "C-c" where 'c' is some character , ctrlCh '@' ?>>! placeMark , ctrlCh ' ' ?>>! placeMark , ctrlCh '/' ?>>! repeatingArg undoB , ctrlCh '_' ?>>! repeatingArg undoB , ctrlCh 'a' ?>>! repeatingArg (maybeMoveB Line Backward) , ctrlCh 'b' ?>>! repeatingArg $ moveE Character Backward , ctrlCh 'd' ?>>! deleteForward , ctrlCh 'e' ?>>! repeatingArg (maybeMoveB Line Forward) , ctrlCh 'f' ?>>! repeatingArg $ moveE Character Forward , ctrlCh 'g' ?>>! setVisibleSelection False , ctrlCh 'h' ?>> char 'b' ?>>! acceptedInputsOtherWindow , ctrlCh 'i' ?>>! adjIndent IncreaseOnly , ctrlCh 'j' ?>>! newlineAndIndentB , ctrlCh 'k' ?>>! killLine univArg , ctrlCh 'l' ?>>! (withCurrentBuffer scrollToCursorB >> userForceRefresh) , ctrlCh 'm' ?>>! repeatingArg (insertB '\n') , ctrlCh 'n' ?>>! repeatingArg (moveE VLine Forward) , ctrlCh 'o' ?>>! repeatingArg (insertB '\n' >> leftB) , ctrlCh 'p' ?>>! repeatingArg (moveE VLine Backward) , ctrlCh 'q' ?>> insertNextC univArg , ctrlCh 'r' ?>> isearchKeymap Backward , ctrlCh 's' ?>> isearchKeymap Forward , ctrlCh 't' ?>>! repeatingArg swapB , ctrlCh 'v' ?>>! scrollDownE univArg , ctrlCh 'w' ?>>! killRegion , ctrlCh 'y' ?>>! yank , ctrlCh 'z' ?>>! suspendEditor , ctrlCh '+' ?>>! repeatingArg (increaseFontSize 1) , ctrlCh '-' ?>>! repeatingArg (decreaseFontSize 1) -- All the keybindings of the form "C-M-c" where 'c' is some character , ctrl (metaCh 'w') ?>>! appendNextKillE , ctrl (metaCh ' ') ?>>! layoutManagersNextE , ctrl (metaCh ',') ?>>! layoutManagerNextVariantE , ctrl (metaCh '.') ?>>! layoutManagerPreviousVariantE , ctrl (metaCh 'j') ?>>! nextWinE , ctrl (metaCh 'k') ?>>! prevWinE , ctrl (meta $ spec KEnter) ?>>! swapWinWithFirstE -- All the keybindings of the form "S-C-M-c" where 'c' is some key , shift (ctrl $ metaCh 'j') ?>>! moveWinNextE , shift (ctrl $ metaCh 'k') ?>>! moveWinPrevE , shift (ctrl $ meta $ spec KEnter) ?>>! pushWinToFirstE , Event (KASCII ' ') [MShift,MCtrl,MMeta] ?>>! layoutManagersPreviousE -- All the key-bindings which are preceded by a 'C-x' , ctrlCh 'x' ?>> ctrlX , ctrlCh 'c' ?>> ctrlC -- All The key-bindings of the form M-c where 'c' is some character. , metaCh ' ' ?>>! justOneSep univArg , metaCh 'v' ?>>! scrollUpE univArg , metaCh '!' ?>>! shellCommandE , metaCh '<' ?>>! repeatingArg topB , metaCh '>' ?>>! repeatingArg botB , metaCh '%' ?>>! queryReplaceE , metaCh '^' ?>>! joinLinesE univArg , metaCh ';' ?>>! commentRegion , metaCh 'a' ?>>! repeatingArg (moveE unitSentence Backward) , metaCh 'b' ?>>! repeatingArg prevWordB , metaCh 'c' ?>>! repeatingArg capitaliseWordB , metaCh 'd' ?>>! repeatingArg killWordB , metaCh 'e' ?>>! repeatingArg (moveE unitSentence Forward) , metaCh 'f' ?>>! repeatingArg nextWordB , metaCh 'h' ?>>! (setSelectRegionB =<< regionOfB unitParagraph) , metaCh 'k' ?>>! repeatingArg (deleteB unitSentence Forward) , metaCh 'l' ?>>! repeatingArg lowercaseWordB , metaCh 'm' ?>>! firstNonSpaceB , metaCh 'q' ?>>! withSyntax modePrettify , metaCh 'r' ?>>! repeatingArg moveToMTB , metaCh 'u' ?>>! repeatingArg uppercaseWordB , metaCh 't' ?>>! repeatingArg (transposeB unitWord Forward) , metaCh 'w' ?>>! killRingSave , metaCh 'x' ?>>! executeExtendedCommandE , metaCh 'y' ?>>! yankPopE , metaCh '.' ?>>! promptTag , metaCh '{' ?>>! repeatingArg (prevNParagraphs 1) , metaCh '}' ?>>! repeatingArg (nextNParagraphs 1) , metaCh '=' ?>>! countWordsRegion , metaCh '\\' ?>>! deleteHorizontalSpaceB univArg , metaCh '@' ?>>! repeatingArg markWord -- Other meta key-bindings , meta (spec KBS) ?>>! repeatingArg bkillWordB , metaCh 'g' ?>> optMod meta (char 'g') >>! (gotoLn . fromDoc :: Int ::: LineNumber -> BufferM Int) ] where -- inserting the empty string prevents the deletion from appearing in the killring -- which is a good thing when we are deleting individuals characters. See -- http://code.google.com/p/yi-editor/issues/detail?id=212 blockKillring = insertN "" withUnivArg :: YiAction (m ()) () => (Maybe Int -> m ()) -> YiM () withUnivArg cmd = runAction $ makeAction (cmd univArg) repeatingArg :: (Monad m, YiAction (m ()) ()) => m () -> YiM () repeatingArg f = withIntArg $ \n -> replicateM_ n f withIntArg :: YiAction (m ()) () => (Int -> m ()) -> YiM () withIntArg cmd = withUnivArg $ \arg -> cmd (fromMaybe 1 arg) deleteBack :: YiM () deleteBack = repeatingArg $ blockKillring >> adjBlock (-1) >> bdeleteB deleteForward :: YiM () deleteForward = repeatingArg $ blockKillring >> deleteB' -- Deletes current region if any, otherwise executes the given -- action. deleteRegionOr :: (Show a, YiAction (m a) a) => m a -> YiM () deleteRegionOr f = do b <- gets currentBuffer r <- withGivenBuffer b getSelectRegionB if regionSize r == 0 then runAction $ makeAction f else withGivenBuffer b $ deleteRegionB r ctrlC = choice [ ctrlCh 'c' ?>>! commentRegion ] rectangleFunctions = choice [ char 'a' ?>>! alignRegionOn , char 'o' ?>>! openRectangle , char 't' ?>>! stringRectangle , char 'k' ?>>! killRectangle , char 'y' ?>>! yankRectangle ] tabFunctions :: Keymap tabFunctions = choice [ optMod ctrl (char 'n') >>! nextTabE , optMod ctrl (char 'p') >>! previousTabE , optMod ctrl (char 't') >>! newTabE , optMod ctrl (char 'e') >>! findFileNewTab , optMod ctrl (char 'd') >>! deleteTabE , charOf id '0' '9' >>=! moveTabE . Just . digitToInt ] -- These keybindings are all preceded by a 'C-x' so for example to -- quit the editor we do a 'C-x C-c' ctrlX = choice [ ctrlCh 'o' ?>>! deleteBlankLinesB , char '0' ?>>! closeWindowEmacs , char '1' ?>>! closeOtherE , char '2' ?>>! splitE , char 'h' ?>>! selectAll , char 's' ?>>! askSaveEditor , ctrlCh 'b' ?>>! listBuffers , ctrlCh 'c' ?>>! askQuitEditor , ctrlCh 'f' ?>>! findFile , ctrlCh 'r' ?>>! findFileReadOnly , ctrlCh 'q' ?>>! ((withCurrentBuffer (readOnlyA %= not)) :: EditorM ()) , ctrlCh 's' ?>>! fwriteE , ctrlCh 'w' ?>>! promptFile "Write file:" (void . fwriteToE) , ctrlCh 'x' ?>>! (exchangePointAndMarkB >> assign highlightSelectionA True) , char 'b' ?>>! switchBufferE , char 'd' ?>>! dired , char 'e' ?>> char 'e' ?>>! evalRegionE , char 'o' ?>>! nextWinE , char 'k' ?>>! killBufferE , char 'r' ?>> rectangleFunctions , char 'u' ?>>! repeatingArg undoB , optMod ctrl (char 't') >> tabFunctions ] yi-0.12.6/src/library/Yi/Keymap/Emacs/KillRing.hs0000644000000000000000000000706112725740550017563 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Emacs.KillRing -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Emacs.KillRing where import Control.Lens (assign, use, uses, (%=), (.=)) import Control.Monad (replicateM_, when) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Maybe (fromMaybe) import Yi.Buffer import Yi.Editor (EditorM, killringA, withCurrentBuffer) import Yi.Keymap (YiM) import Yi.KillRing (Killring (_krContents), krKilled, krPut) import qualified Yi.Rope as R (YiString, fromString, toString) import Yi.Types (withEditor) import Yi.Utils (io) import System.Hclip (getClipboard, setClipboard) -- * Killring actions -- | Adds system clipboard's contents on top of the killring if not already there clipboardToKillring :: YiM () clipboardToKillring = do text <- fmap R.fromString $ io getClipboard withEditor $ do text' <- killringGet when (text' /= text) $ killringPut Forward text -- | Adds the top of the killring to the system clipboard killringToClipboard :: YiM () killringToClipboard = do text <- withEditor killringGet io . setClipboard $ R.toString text -- This is like @kill-region-or-backward-word@. killRegionB :: BufferM () killRegionB = getSelectRegionB >>= \r -> if regionStart r == regionEnd r then bkillWordB else deleteRegionB r -- | C-w -- Like `killRegionB`, but with system clipboard synchronization killRegion :: YiM () killRegion = withCurrentBuffer killRegionB >> killringToClipboard -- | Kills current line killLineB :: Maybe Int -> BufferM () killLineB mbr = replicateM_ (fromMaybe 1 mbr) $ do eol <- atEol let tu = if eol then Character else Line deleteRegionB =<< regionOfPartNonEmptyB tu Forward -- | C-k -- | Like `killLineB`, but with system clipboard synchronization killLine :: Maybe Int -> YiM () killLine mbr = withCurrentBuffer (killLineB mbr) >> killringToClipboard killringGet :: EditorM R.YiString killringGet = do text :| _ <- uses killringA _krContents return text killringPut :: Direction -> R.YiString -> EditorM () killringPut dir s = killringA %= krPut dir s -- | Yanks top of killbuffer yankE :: EditorM () yankE = do text :| _ <- uses killringA _krContents withCurrentBuffer $ pointB >>= setSelectionMarkPointB >> insertN text -- | C-y -- Like `yankE`, but with system clipboard synchronization yank :: YiM () yank = clipboardToKillring >> withEditor yankE -- | Saves current selection to killring and then clears it killRingSaveE :: EditorM () killRingSaveE = do (r, text) <- withCurrentBuffer $ do r <- getSelectRegionB text <- readRegionB r assign highlightSelectionA False return (r, text) killringPut (regionDirection r) text -- | M-w -- Like `killRingSaveE`, but with system clipboard synchronization killRingSave :: YiM () killRingSave = withEditor killRingSaveE >> killringToClipboard -- | M-y -- TODO: Handle argument, verify last command was a yank yankPopE :: EditorM () yankPopE = do kr <- use killringA withCurrentBuffer (deleteRegionB =<< getRawestSelectRegionB) killringA .= let x :| xs = _krContents kr in kr { _krContents = case xs of [] -> x :| [] y:ys -> y :| ys ++ [x] } yankE -- | C-M-w appendNextKillE :: EditorM () appendNextKillE = killringA . krKilled .= True yi-0.12.6/src/library/Yi/Keymap/Emacs/Utils.hs0000644000000000000000000003656612717763531017171 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Emacs.Utils -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module is aimed at being a helper for the Emacs keybindings. -- In particular this should be useful for anyone that has a custom -- keymap derived from or based on the Emacs one. module Yi.Keymap.Emacs.Utils ( UnivArgument , argToInt , askQuitEditor , askSaveEditor , modifiedQuitEditor , withMinibuffer , queryReplaceE , isearchKeymap , cabalConfigureE , cabalBuildE , reloadProjectE , executeExtendedCommandE , evalRegionE , readUniversalArg , scrollDownE , scrollUpE , switchBufferE , killBufferE , insertNextC , findFile , findFileReadOnly , findFileNewTab , promptFile , promptTag , justOneSep , joinLinesE , countWordsRegion ) where import Control.Applicative (Alternative ((<|>), many, some), Applicative (pure), optional, (<$>)) import Control.Lens (use, (.=)) import Control.Monad (filterM, replicateM_, void) import Control.Monad.Base () import Data.List ((\\)) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, concat, null, pack, singleton, snoc, unpack, unwords) import System.FilePath (takeDirectory, takeFileName, ()) import System.FriendlyPath () import Yi.Buffer import Yi.Command (cabalBuildE, cabalConfigureE, reloadProjectE) import Yi.Core (quitEditor) import Yi.Editor import Yi.Eval (execEditorAction, getAllNamesInScope) import Yi.File (deservesSave, editFile, fwriteBufferE, openingNewFile) import Yi.Keymap (Keymap, KeymapM, YiM, write) import Yi.Keymap.Keys import Yi.MiniBuffer import Yi.Misc (promptFile) import Yi.Monad (gets) import Yi.Rectangle (getRectangle) import Yi.Regex (makeSearchOptsM) import qualified Yi.Rope as R (countNewLines, fromText, length, replicateChar, toText, words) import Yi.Search import Yi.String (showT) import Yi.Tag import Yi.Utils (io) type UnivArgument = Maybe Int ---------------------------- -- | Quits the editor if there are no unmodified buffers -- if there are unmodified buffers then we ask individually for -- each modified buffer whether or not the user wishes to save -- it or not. If we get to the end of this list and there are still -- some modified buffers then we ask again if the user wishes to -- quit, but this is then a simple yes or no. askQuitEditor :: YiM () askQuitEditor = askIndividualSave True =<< getModifiedBuffers askSaveEditor :: YiM () askSaveEditor = askIndividualSave False =<< getModifiedBuffers getModifiedBuffers :: YiM [FBuffer] getModifiedBuffers = filterM deservesSave =<< gets bufferSet -------------------------------------------------- -- Takes in a list of buffers which have been identified -- as modified since their last save. askIndividualSave :: Bool -> [FBuffer] -> YiM () askIndividualSave True [] = modifiedQuitEditor askIndividualSave False [] = return () askIndividualSave hasQuit allBuffers@(firstBuffer : others) = void (withEditor (spawnMinibufferE saveMessage (const askKeymap))) where saveMessage = T.concat [ "do you want to save the buffer: " , bufferName , "? (y/n/", if hasQuit then "q/" else "", "c/!)" ] bufferName = identString firstBuffer askKeymap = choice ([ char 'n' ?>>! noAction , char 'y' ?>>! yesAction , char '!' ?>>! allAction , oneOf [char 'c', ctrl $ char 'g'] >>! closeBufferAndWindowE -- cancel ] ++ [char 'q' ?>>! quitEditor | hasQuit]) yesAction = do void $ fwriteBufferE (bkey firstBuffer) withEditor closeBufferAndWindowE continue noAction = do withEditor closeBufferAndWindowE continue allAction = do mapM_ fwriteBufferE $ fmap bkey allBuffers withEditor closeBufferAndWindowE askIndividualSave hasQuit [] continue = askIndividualSave hasQuit others --------------------------- --------------------------- -- | Quits the editor if there are no unmodified buffers -- if there are then simply confirms with the user that they -- with to quit. modifiedQuitEditor :: YiM () modifiedQuitEditor = do modifiedBuffers <- getModifiedBuffers if null modifiedBuffers then quitEditor else withEditor $ void (spawnMinibufferE modifiedMessage (const askKeymap)) where modifiedMessage = "Modified buffers exist really quit? (y/n)" askKeymap = choice [ char 'n' ?>>! noAction , char 'y' ?>>! quitEditor ] noAction = closeBufferAndWindowE ----------------------------- -- isearch selfSearchKeymap :: Keymap selfSearchKeymap = do Event (KASCII c) [] <- anyEvent write . isearchAddE $ T.singleton c searchKeymap :: Keymap searchKeymap = selfSearchKeymap <|> choice [ -- ("C-g", isearchDelE) -- Only if string is not empty. ctrl (char 'r') ?>>! isearchPrevE , ctrl (char 's') ?>>! isearchNextE , ctrl (char 'w') ?>>! isearchWordE , meta (char 'p') ?>>! isearchHistory 1 , meta (char 'n') ?>>! isearchHistory (-1) , spec KBS ?>>! isearchDelE ] isearchKeymap :: Direction -> Keymap isearchKeymap dir = do write $ isearchInitE dir void $ many searchKeymap choice [ ctrl (char 'g') ?>>! isearchCancelE , oneOf [ctrl (char 'm'), spec KEnter] >>! isearchFinishWithE resetRegexE ] <|| write isearchFinishE ---------------------------- -- query-replace queryReplaceE :: YiM () queryReplaceE = withMinibufferFree "Replace:" $ \replaceWhat -> withMinibufferFree "With:" $ \replaceWith -> do b <- gets currentBuffer win <- use currentWindowA let repStr = R.fromText replaceWith replaceKm = choice [ char 'n' ?>>! qrNext win b re , char '!' ?>>! qrReplaceAll win b re repStr , oneOf [char 'y', char ' '] >>! qrReplaceOne win b re repStr , oneOf [char 'q', ctrl (char 'g')] >>! qrFinish ] -- TODO: Yi.Regex to Text Right re = makeSearchOptsM [] (T.unpack replaceWhat) question = T.unwords [ "Replacing", replaceWhat , "with", replaceWith, " (y,n,q,!):" ] withEditor $ do setRegexE re void $ spawnMinibufferE question (const replaceKm) qrNext win b re executeExtendedCommandE :: YiM () executeExtendedCommandE = withMinibuffer "M-x" scope act where act = execEditorAction . T.unpack scope = const $ map T.pack <$> getAllNamesInScope evalRegionE :: YiM () evalRegionE = do -- FIXME: do something sensible. void $ withCurrentBuffer (getSelectRegionB >>= readRegionB) return () -- * Code for various commands -- This ideally should be put in their own module, -- without a prefix, so M-x ... would be easily implemented -- by looking up that module's contents -- | Insert next character, "raw" insertNextC :: UnivArgument -> KeymapM () insertNextC a = do c <- anyEvent write $ replicateM_ (argToInt a) $ insertB (eventToChar c) -- | Convert the universal argument to a number of repetitions argToInt :: UnivArgument -> Int argToInt = fromMaybe 1 digit :: (Event -> Event) -> KeymapM Char digit f = charOf f '0' '9' -- TODO: replace tt by digit meta tt :: KeymapM Char tt = do Event (KASCII c) _ <- foldr1 (<|>) $ fmap (event . metaCh ) ['0'..'9'] return c -- doing the argument precisely is kind of tedious. -- read: http://www.gnu.org/software/emacs/manual/html_node/Arguments.html -- and: http://www.gnu.org/software/emacs/elisp-manual/html_node/elisp_318.html readUniversalArg :: KeymapM (Maybe Int) readUniversalArg = optional ((ctrlCh 'u' ?>> (read <$> some (digit id) <|> pure 4)) <|> (read <$> some tt)) -- | Finds file and runs specified action on the resulting buffer findFileAndDo :: T.Text -- ^ Prompt -> BufferM a -- ^ Action to run on the resulting buffer -> YiM () findFileAndDo prompt act = promptFile prompt $ \filename -> do printMsg $ "loading " <> filename openingNewFile (T.unpack filename) act -- | Open a file using the minibuffer. We have to set up some stuff to -- allow hints and auto-completion. findFile :: YiM () findFile = findFileAndDo "find file:" $ return () -- | Like 'findFile' but sets the resulting buffer to read-only. findFileReadOnly :: YiM () findFileReadOnly = findFileAndDo "find file (read only):" $ readOnlyA .= True -- | Open a file in a new tab using the minibuffer. findFileNewTab :: YiM () findFileNewTab = promptFile "find file (new tab): " $ \filename -> do withEditor newTabE printMsg $ "loading " <> filename void . editFile $ T.unpack filename scrollDownE :: UnivArgument -> BufferM () scrollDownE a = case a of Nothing -> downScreenB Just n -> scrollB n scrollUpE :: UnivArgument -> BufferM () scrollUpE a = case a of Nothing -> upScreenB Just n -> scrollB (negate n) -- | Prompts the user for a buffer name and switches to the chosen buffer. switchBufferE :: YiM () switchBufferE = promptingForBuffer "switch to buffer:" (withEditor . switchToBufferE) (\o b -> (b \\ o) ++ o) -- | Prompts the user for a buffer name and kills the chosen buffer. -- Prompts about really closing if the buffer is marked as changed -- since last save. killBufferE :: YiM () killBufferE = promptingForBuffer "kill buffer:" k (\o b -> o ++ (b \\ o)) where k :: BufferRef -> YiM () k b = do buf <- withEditor . gets $ findBufferWith b ch <- deservesSave buf let askKeymap = choice [ char 'n' ?>>! closeBufferAndWindowE , char 'y' ?>>! delBuf >> closeBufferAndWindowE , ctrlCh 'g' ?>>! closeBufferAndWindowE ] delBuf = deleteBuffer b question = identString buf <> " changed, close anyway? (y/n)" withEditor $ if ch then void $ spawnMinibufferE question (const askKeymap) else delBuf -- | If on separators (space, tab, unicode seps), reduce multiple -- separators to just a single separator (or however many given -- through 'UnivArgument'). -- -- If we aren't looking at a separator, insert a single space. This is -- like emacs ‘just-one-space’ but doesn't deal with negative argument -- case but works with other separators than just space. What counts -- as a separator is decided by 'isAnySep' modulo @\n@ character. -- -- Further, it will only reduce a single type of separator at once: if -- we have hard tabs followed by spaces, we are able to reduce one and -- not the other. justOneSep :: UnivArgument -> BufferM () justOneSep u = readB >>= \c -> pointB >>= \point -> case point of Point 0 -> if isSep c then deleteSeparators else insertMult c Point x -> if isSep c then deleteSeparators else readAtB (Point $ x - 1) >>= \d -> -- We weren't looking at separator but there might be one behind us if isSep d then moveB Character Backward >> deleteSeparators else insertMult ' ' -- no separators, insert a space just -- like emacs does where isSep c = c /= '\n' && isAnySep c insertMult c = insertN $ R.replicateChar (maybe 1 (max 1) u) c deleteSeparators = do genMaybeMoveB unitSepThisLine (Backward, InsideBound) Backward moveB Character Forward doIfCharB isSep $ deleteB unitSepThisLine Forward -- | Join this line to previous (or next N if universal) joinLinesE :: UnivArgument -> BufferM () joinLinesE Nothing = return () joinLinesE (Just _) = do moveB VLine Forward moveToSol >> transformB (const " ") Character Backward >> justOneSep Nothing -- | Shortcut to use a default list when a blank list is given. -- Used for default values to emacs queries maybeList :: [a] -> [a] -> [a] maybeList def [] = def maybeList _ ls = ls maybeTag :: Tag -> T.Text -> Tag maybeTag def t = if T.null t then def else Tag t -------------------------------------------------- -- TAGS - See Yi.Tag for more info -- | Prompt the user to give a tag and then jump to that tag promptTag :: YiM () promptTag = do -- default tag is where the buffer is on defaultTag <- withCurrentBuffer $ Tag . R.toText <$> readUnitB unitWord -- if we have tags use them to generate hints tagTable <- withEditor getTags -- Hints are expensive - only lazily generate 10 let hinter = return . take 10 . maybe (fail . T.unpack) hintTags tagTable -- Completions are super-cheap. Go wild let completer = return . maybe id completeTag tagTable p = "Find tag: (default " <> _unTag defaultTag `T.snoc` ')' withMinibufferGen "" hinter p completer (const $ return ()) $ -- if the string is "" use the defaultTag gotoTag . maybeTag defaultTag -- | Opens the file that contains @tag@. Uses the global tag table and prompts -- the user to open one if it does not exist gotoTag :: Tag -> YiM () gotoTag tag = visitTagTable $ \tagTable -> case lookupTag tag tagTable of [] -> printMsg $ "No tags containing " <> _unTag tag (filename, line):_ -> openingNewFile filename $ gotoLn line -- | Call continuation @act@ with the TagTable. Uses the global table -- and prompts the user if it doesn't exist visitTagTable :: (TagTable -> YiM ()) -> YiM () visitTagTable act = do posTagTable <- withEditor getTags -- does the tagtable exist? case posTagTable of Just tagTable -> act tagTable Nothing -> promptFile "Visit tags table: (default tags)" $ \path -> do -- default emacs behavior, append tags let p = T.unpack path filename = maybeList "tags" $ takeFileName p tagTable <- io $ importTagTable $ takeDirectory p filename withEditor $ setTags tagTable act tagTable -- TODO: use TextUnit to count things inside region for better experience -- | Counts the number of lines, words and characters inside selected -- region. Coresponds to emacs' @count-words-region@. countWordsRegion :: YiM () countWordsRegion = do (l, w, c) <- withEditor $ do t <- withCurrentBuffer $ getRectangle >>= \(reg, _, _) -> readRegionB reg let nls = R.countNewLines t return (if nls == 0 then 1 else nls, length $ R.words t, R.length t) printMsg $ T.unwords [ "Region has", showT l, p l "line" <> "," , showT w, p w "word" <> ", and" , showT c, p w "character" <> "." ] where p x w = if x == 1 then w else w <> "s" yi-0.12.6/src/library/Yi/Keymap/Keys.hs0000644000000000000000000000704312717763531015740 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Keys -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Combinators for building keymaps. module Yi.Keymap.Keys ( module Yi.Event, module Yi.Interact, printableChar, textChar, charOf, shift, meta, ctrl, super, hyper, spec, char, (>>!), (>>=!), (?>>), (?>>!), (?*>>), (?*>>!), ctrlCh, metaCh, hyperCh, optMod, pString ) where import Prelude hiding (error) import Control.Monad (unless) import Data.Char (isAlpha, isPrint, toUpper) import Data.List (nub, sort) import Yi.Debug (error) import Yi.Event (Event (..), Key (..), Modifier (..), eventToChar, prettyEvent) import Yi.Interact hiding (write) import Yi.Keymap (Action, KeymapM, YiAction, write) printableChar :: (MonadInteract m w Event) => m Char printableChar = do Event (KASCII c) [] <- anyEvent unless (isPrint c) $ fail "unprintable character" return c -- | Parse any character that can be inserted in the text. textChar :: KeymapM Char textChar = do -- Why only ASCII? Event (KASCII c) [] <- anyEvent return c pString :: (MonadInteract m w Event) => String -> m [Event] pString = events . map char charOf :: (MonadInteract m w Event) => (Event -> Event) -> Char -> Char -> m Char charOf modifier l h = do Event (KASCII c) _ <- eventBetween (modifier $ char l) (modifier $ char h) return c shift,ctrl,meta,super,hyper :: Event -> Event shift (Event (KASCII c) ms) | isAlpha c = Event (KASCII (toUpper c)) ms | otherwise = error "shift: unhandled event" shift (Event k ms) = Event k $ nub $ sort (MShift:ms) ctrl (Event k ms) = Event k $ nub $ sort (MCtrl:ms) meta (Event k ms) = Event k $ nub $ sort (MMeta:ms) super (Event k ms) = Event k $ nub $ sort (MSuper:ms) hyper (Event k ms) = Event k $ nub $ sort (MHyper:ms) char :: Char -> Event char '\t' = Event KTab [] char '\r' = Event KEnter [] char '\n' = Event KEnter [] char c = Event (KASCII c) [] ctrlCh :: Char -> Event ctrlCh = ctrl . char metaCh :: Char -> Event metaCh = meta . char hyperCh :: Char -> Event hyperCh = hyper . char -- | @optMod f ev@ produces a 'MonadInteract' that consumes @ev@ or @f ev@ optMod ::(MonadInteract m w Event) => (Event -> Event) -> Event -> m Event optMod f ev = oneOf [ev, f ev] -- | Convert a special key into an event spec :: Key -> Event spec k = Event k [] -- | > p >>! act = p >> 'write' act (>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => m b -> a -> m () p >>! act = p >> write act -- | > p >>=! act = p >>= 'write' . act (>>=!) :: (MonadInteract m Action Event, YiAction a x, Show x) => m b -> (b -> a) -> m () p >>=! act = p >>= write . act -- | @ ev ?>> proc = 'event' ev >> proc @ (?>>) :: (MonadInteract m action Event) => Event -> m a -> m a ev ?>> proc = event ev >> proc -- | @ ev ?>>! act = 'event' ev >> 'write' act @ (?>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => Event -> a -> m () ev ?>>! act = event ev >> write act -- | @ ev ?*>> proc = 'events' ev >> proc @ (?*>>) :: (MonadInteract m action Event) => [Event] -> m a -> m a ev ?*>> proc = events ev >> proc -- | @ ev ?*>>! act = 'events' ev >> 'write' act @ (?*>>!) :: (MonadInteract m Action Event, YiAction a x, Show x) => [Event] -> a -> m () ev ?*>>! act = events ev >> write act infixl 1 >>! infixl 1 >>=! infixr 0 ?>>! infixr 0 ?>> infixr 0 ?*>>! infixr 0 ?*>> yi-0.12.6/src/library/Yi/Keymap/Vim.hs0000644000000000000000000001640212720302155015540 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- The vim keymap. module Yi.Keymap.Vim ( keymapSet , mkKeymapSet , defVimConfig , VimBinding (..) , VimOperator (..) , VimConfig (..) , pureEval , impureEval , relayoutFromTo ) where import Control.Applicative ((<$>)) import Data.Char (toUpper) import Data.List (find) import Data.Monoid (Monoid (mempty), (<>)) import Data.Prototype (Proto (Proto), extractValue) import Yi.Buffer.Adjusted (commitUpdateTransactionB, startUpdateTransactionB) import Yi.Editor import Yi.Event (Event (..), Key (KASCII), Modifier (MCtrl, MMeta)) import Yi.Keymap (Keymap, KeymapM, KeymapSet, YiM, modelessKeymapSet, write) import Yi.Keymap.Keys (anyEvent) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.Digraph (defDigraphs) import Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents) import Yi.Keymap.Vim.Ex (ExCommand, defExCommandParsers) import Yi.Keymap.Vim.ExMap (defExMap) import Yi.Keymap.Vim.InsertMap (defInsertMap) import Yi.Keymap.Vim.NormalMap (defNormalMap) import Yi.Keymap.Vim.NormalOperatorPendingMap (defNormalOperatorPendingMap) import Yi.Keymap.Vim.Operator (VimOperator (..), defOperators) import Yi.Keymap.Vim.ReplaceMap (defReplaceMap) import Yi.Keymap.Vim.ReplaceSingleCharMap (defReplaceSingleMap) import Yi.Keymap.Vim.SearchMotionMap (defSearchMotionMap) import Yi.Keymap.Vim.StateUtils import Yi.Keymap.Vim.Utils (selectBinding, selectPureBinding) import Yi.Keymap.Vim.VisualMap (defVisualMap) data VimConfig = VimConfig { vimKeymap :: Keymap , vimBindings :: [VimBinding] , vimOperators :: [VimOperator] , vimExCommandParsers :: [EventString -> Maybe ExCommand] , vimDigraphs :: [(String, Char)] , vimRelayout :: Char -> Char } mkKeymapSet :: Proto VimConfig -> KeymapSet mkKeymapSet = modelessKeymapSet . vimKeymap . extractValue keymapSet :: KeymapSet keymapSet = mkKeymapSet defVimConfig defVimConfig :: Proto VimConfig defVimConfig = Proto $ \this -> VimConfig { vimKeymap = defVimKeymap this , vimBindings = concat [ defNormalMap (vimOperators this) , defNormalOperatorPendingMap (vimOperators this) , defExMap (vimExCommandParsers this) , defInsertMap (vimDigraphs this) , defReplaceSingleMap , defReplaceMap , defVisualMap (vimOperators this) , defSearchMotionMap ] , vimOperators = defOperators , vimExCommandParsers = defExCommandParsers , vimDigraphs = defDigraphs , vimRelayout = id } defVimKeymap :: VimConfig -> KeymapM () defVimKeymap config = do e <- anyEvent write $ impureHandleEvent config e True -- This is not in Yi.Keymap.Vim.Eval to avoid circular dependency: -- eval needs to know about bindings, which contains normal bindings, -- which contains '.', which needs to eval things -- So as a workaround '.' just saves a string that needs eval in VimState -- and the actual evaluation happens in impureHandleEvent pureEval :: VimConfig -> EventString -> EditorM () pureEval config = sequence_ . map (pureHandleEvent config) . parseEvents impureEval :: VimConfig -> EventString -> Bool -> YiM () impureEval config s needsToConvertEvents = sequence_ actions where actions = map (\e -> impureHandleEvent config e needsToConvertEvents) $ parseEvents s pureHandleEvent :: VimConfig -> Event -> EditorM () pureHandleEvent config ev = genericHandleEvent allPureBindings selectPureBinding config ev False impureHandleEvent :: VimConfig -> Event -> Bool -> YiM () impureHandleEvent = genericHandleEvent vimBindings selectBinding genericHandleEvent :: MonadEditor m => (VimConfig -> [VimBinding]) -> (EventString -> VimState -> [VimBinding] -> MatchResult (m RepeatToken)) -> VimConfig -> Event -> Bool -> m () genericHandleEvent getBindings pick config unconvertedEvent needsToConvertEvents = do currentState <- withEditor getEditorDyn let event = if needsToConvertEvents then convertEvent (vsMode currentState) (vimRelayout config) unconvertedEvent else unconvertedEvent evs = vsBindingAccumulator currentState <> eventToEventString event bindingMatch = pick evs currentState (getBindings config) prevMode = vsMode currentState case bindingMatch of NoMatch -> withEditor dropBindingAccumulatorE PartialMatch -> withEditor $ do accumulateBindingEventE event accumulateEventE event WholeMatch action -> do repeatToken <- action withEditor $ do dropBindingAccumulatorE accumulateEventE event case repeatToken of Drop -> do resetActiveRegisterE dropAccumulatorE Continue -> return () Finish -> do resetActiveRegisterE flushAccumulatorE withEditor $ do newMode <- vsMode <$> getEditorDyn -- TODO: we should introduce some hook mechanism like autocommands in vim case (prevMode, newMode) of (Insert _, Insert _) -> return () (Insert _, _) -> withCurrentBuffer commitUpdateTransactionB (_, Insert _) -> withCurrentBuffer startUpdateTransactionB _ -> return () performEvalIfNecessary config updateModeIndicatorE currentState performEvalIfNecessary :: VimConfig -> EditorM () performEvalIfNecessary config = do stateAfterAction <- getEditorDyn -- see comment for 'pureEval' modifyStateE $ \s -> s { vsStringToEval = mempty } pureEval config (vsStringToEval stateAfterAction) allPureBindings :: VimConfig -> [VimBinding] allPureBindings config = filter isPure $ vimBindings config where isPure (VimBindingE _) = True isPure _ = False convertEvent :: VimMode -> (Char -> Char) -> Event -> Event convertEvent (Insert _) f (Event (KASCII c) mods) | MCtrl `elem` mods || MMeta `elem` mods = Event (KASCII (f c)) mods convertEvent Ex _ e = e convertEvent (Insert _) _ e = e convertEvent InsertNormal _ e = e convertEvent InsertVisual _ e = e convertEvent Replace _ e = e convertEvent ReplaceSingleChar _ e = e convertEvent (Search _ _) _ e = e convertEvent _ f (Event (KASCII c) mods) = Event (KASCII (f c)) mods convertEvent _ _ e = e relayoutFromTo :: String -> String -> (Char -> Char) relayoutFromTo keysFrom keysTo = \c -> maybe c fst (find ((== c) . snd) (zip (keysTo ++ fmap toUpper' keysTo) (keysFrom ++ fmap toUpper' keysFrom))) where toUpper' ';' = ':' toUpper' a = toUpper a yi-0.12.6/src/library/Yi/Keymap/Vim/Common.hs0000644000000000000000000001414512720072011016765 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Common -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Common types used by the vim keymap. module Yi.Keymap.Vim.Common ( VimMode(..) , VimBinding(..) , GotoCharCommand(..) , VimState(..) , Register(..) , RepeatToken(..) , RepeatableAction(..) , MatchResult(..) , EventString(..), unEv , OperatorName(..), unOp , RegisterName , module Yi.Keymap.Vim.MatchResult , lookupBestMatch, matchesString ) where import GHC.Generics (Generic) import Control.Applicative (Alternative ((<|>)), (<$>)) import Control.Lens (makeLenses) import Data.Binary (Binary (..)) import Data.Default (Default (..)) import qualified Data.HashMap.Strict as HM (HashMap) import Data.Monoid (Monoid (mappend, mempty), (<>)) import Data.String (IsString (..)) import qualified Data.Text as T (Text, isPrefixOf, pack) import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8) import Data.Typeable (Typeable) import Yi.Buffer.Adjusted (Direction, Point, RegionStyle) import Yi.Editor (EditorM) import Yi.Keymap (YiM) import Yi.Keymap.Vim.MatchResult (MatchResult (..)) import Yi.Rope (YiString) import Yi.Types (YiVariable) newtype EventString = Ev { _unEv :: T.Text } deriving (Show, Eq, Ord) instance IsString EventString where fromString = Ev . T.pack newtype OperatorName = Op { _unOp :: T.Text } deriving (Show, Eq) instance IsString OperatorName where fromString = Op . T.pack instance Monoid EventString where mempty = Ev mempty Ev t `mappend` Ev t' = Ev $ t <> t' instance Monoid OperatorName where mempty = Op mempty Op t `mappend` Op t' = Op $ t <> t' instance Binary EventString where get = Ev . E.decodeUtf8 <$> get put (Ev t) = put $ E.encodeUtf8 t instance Binary OperatorName where get = Op . E.decodeUtf8 <$> get put (Op t) = put $ E.encodeUtf8 t makeLenses ''EventString makeLenses ''OperatorName -- 'lookupBestMatch' and 'matchesString' pulled out of MatchResult -- module to prevent cyclic dependencies. Screw more bootfiles. lookupBestMatch :: EventString -> [(EventString, a)] -> MatchResult a lookupBestMatch key = foldl go NoMatch where go m (k, x) = m <|> fmap (const x) (key `matchesString` k) matchesString :: EventString -> EventString -> MatchResult () matchesString (Ev got) (Ev expected) | expected == got = WholeMatch () | got `T.isPrefixOf` expected = PartialMatch | otherwise = NoMatch type RegisterName = Char type MacroName = Char data RepeatableAction = RepeatableAction { raPreviousCount :: !Int , raActionString :: !EventString } deriving (Typeable, Eq, Show, Generic) data Register = Register { regRegionStyle :: RegionStyle , regContent :: YiString } deriving (Generic) data VimMode = Normal | NormalOperatorPending OperatorName | Insert Char -- ^ char denotes how state got into insert mode ('i', 'a', etc.) | Replace | ReplaceSingleChar | InsertNormal -- ^ after C-o | InsertVisual -- ^ after C-o and one of v, V, C-v | Visual RegionStyle | Ex | Search { previousMode :: VimMode, direction :: Direction } deriving (Typeable, Eq, Show, Generic) data GotoCharCommand = GotoCharCommand !Char !Direction !RegionStyle deriving (Generic) data VimState = VimState { vsMode :: !VimMode , vsCount :: !(Maybe Int) , vsAccumulator :: !EventString -- ^ for repeat and potentially macros , vsTextObjectAccumulator :: !EventString , vsRegisterMap :: !(HM.HashMap RegisterName Register) , vsActiveRegister :: !RegisterName , vsRepeatableAction :: !(Maybe RepeatableAction) , vsStringToEval :: !EventString -- ^ see Yi.Keymap.Vim.vimEval comment , vsOngoingInsertEvents :: !EventString , vsLastGotoCharCommand :: !(Maybe GotoCharCommand) , vsBindingAccumulator :: !EventString , vsSecondaryCursors :: ![Point] , vsPaste :: !Bool -- ^ like vim's :help paste , vsCurrentMacroRecording :: !(Maybe (MacroName, EventString)) } deriving (Typeable, Generic) instance Binary RepeatableAction instance Binary Register instance Binary GotoCharCommand instance Default VimMode where def = Normal instance Binary VimMode instance Default VimState where def = VimState Normal -- mode Nothing -- count mempty -- accumulator mempty -- textobject accumulator mempty -- register map '\0' -- active register Nothing -- repeatable action mempty -- string to eval mempty -- ongoing insert events Nothing -- last goto char command mempty -- binding accumulator mempty -- secondary cursors False -- :set paste Nothing -- current macro recording instance Binary VimState instance YiVariable VimState -- Whether an action can be repeated through the use of the '.' key. -- -- Actions with a RepeatToken of: -- -- - Finish are repeatable. -- - Drop are not repeatable. -- - Continue are currently in progress. They will become repeatable when -- completed. It is possible to cancel a in progress action, in which case -- it will not be repeatable. data RepeatToken = Finish | Drop | Continue deriving Show -- Distinction between YiM and EditorM variants is for testing. data VimBinding = VimBindingY (EventString -> VimState -> MatchResult (YiM RepeatToken)) | VimBindingE (EventString -> VimState -> MatchResult (EditorM RepeatToken)) yi-0.12.6/src/library/Yi/Keymap/Vim/Digraph.hs0000644000000000000000000000271112717763531017133 0ustar0000000000000000module Yi.Keymap.Vim.Digraph ( charFromDigraph , defDigraphs ) where import Control.Applicative (Alternative ((<|>))) charFromDigraph :: [(String, Char)] -> Char -> Char -> Maybe Char charFromDigraph digraphTable c1 c2 = lookup [c1, c2] digraphTable <|> lookup [c2, c1] digraphTable defDigraphs :: [(String, Char)] defDigraphs = [ ("ae", 'æ') , ("a'", 'á') , ("e'", 'é') , ("e`", 'è') , ("o\"", 'Å‘') , ("o:", 'ö') , ("a:", 'ä') , ("e:", 'ë') , ("u:", 'ü') , ("AE", 'Æ') , ("Ae", 'Æ') , ("A'", 'Ã') , ("E'", 'É') , ("E`", 'È') , ("O\"", 'Å') , ("O:", 'Ö') , ("A:", 'Ä') , ("E:", 'Ë') , ("U:", 'Ãœ') , ("=e", '€') , ("Cu", '¤') , ("+-", '±') , ("-+", '∓') , ("^1", '¹') , ("^2", '²') , ("^3", '³') , ("^4", 'â´') , ("^5", 'âµ') , ("^6", 'â¶') , ("^7", 'â·') , ("^8", 'â¸') , ("^9", 'â¹') , ("0S", 'â°') , ("1S", '¹') , ("2S", '²') , ("3S", '³') , ("4S", 'â´') , ("5S", 'âµ') , ("6S", 'â¶') , ("7S", 'â·') , ("8S", 'â¸') , ("9S", 'â¹') , ("0S", 'â°') , ("0s", 'â‚€') , ("1s", 'â‚') , ("2s", 'â‚‚') , ("3s", '₃') , ("4s", 'â‚„') , ("5s", 'â‚…') , ("6s", '₆') , ("7s", '₇') , ("8s", '₈') , ("9s", '₉') , ("0s", 'â‚€') , ("'0", 'Ëš') ] yi-0.12.6/src/library/Yi/Keymap/Vim/Eval.hs0000644000000000000000000000122512717763531016443 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Eval -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module doesn't contains actual eval, see -- 'Yi.Keymap.Vim.vimEval' comment. module Yi.Keymap.Vim.Eval (scheduleActionStringForEval) where import Yi.Editor (EditorM) import Yi.Keymap.Vim.Common (EventString, VimState (vsStringToEval)) import Yi.Keymap.Vim.StateUtils (modifyStateE) scheduleActionStringForEval :: EventString -> EditorM () scheduleActionStringForEval s = modifyStateE $ \st -> st { vsStringToEval = s } yi-0.12.6/src/library/Yi/Keymap/Vim/EventUtils.hs0000644000000000000000000001151112717763531017655 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.EventUtils -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.EventUtils ( stringToEvent , eventToEventString , parseEvents , stringToRepeatableAction , normalizeCount , splitCountedCommand ) where import Data.Char (isDigit, toUpper) import Data.List (foldl') import qualified Data.Map as M (Map, fromList, lookup) import Data.Monoid ((<>)) import qualified Data.Text as T (break, cons, null, pack, singleton, snoc, span, unpack) import Data.Tuple (swap) import Yi.Event import Yi.Keymap.Keys (char, ctrl, meta, spec) import Yi.Keymap.Vim.Common (EventString (Ev), RepeatableAction (RepeatableAction)) import Yi.String (showT) specMap :: M.Map EventString Key specMap = M.fromList specList invSpecMap :: M.Map Key EventString invSpecMap = M.fromList $ fmap swap specList specList :: [(EventString, Key)] specList = [ (Ev "Esc", KEsc) , (Ev "CR", KEnter) , (Ev "BS", KBS) , (Ev "Tab", KTab) , (Ev "Down", KDown) , (Ev "Up", KUp) , (Ev "Left", KLeft) , (Ev "Right", KRight) , (Ev "PageUp", KPageUp) , (Ev "PageDown", KPageDown) , (Ev "Home", KHome) , (Ev "End", KEnd) , (Ev "Ins", KIns) , (Ev "Del", KDel) ] stringToEvent :: String -> Event stringToEvent "<" = error "Invalid event string \"<\"" stringToEvent "" = (Event (KASCII ' ') [MCtrl]) stringToEvent s@('<':'C':'-':_) = stringToEvent' 3 s ctrl stringToEvent s@('<':'M':'-':_) = stringToEvent' 3 s meta stringToEvent s@('<':'a':'-':_) = stringToEvent' 3 s meta stringToEvent "" = char '<' stringToEvent [c] = char c stringToEvent ('<':'F':d:'>':[]) | isDigit d = spec (KFun $ read [d]) stringToEvent ('<':'F':'1':d:'>':[]) | isDigit d = spec (KFun $ 10 + read [d]) stringToEvent s@('<':_) = stringToEvent' 1 s id stringToEvent s = error ("Invalid event string " ++ show s) stringToEvent' :: Int -> String -> (Event -> Event) -> Event stringToEvent' toDrop inputString modifier = let analyzedString = drop toDrop inputString in case analyzedString of [c,'>'] -> modifier (char c) _ -> if last analyzedString /= '>' then error ("Invalid event string " ++ show inputString) else case M.lookup (Ev . T.pack $ init analyzedString) specMap of Just k -> modifier (Event k []) Nothing -> error $ "Couldn't convert string " ++ show inputString ++ " to event" eventToEventString :: Event -> EventString eventToEventString e = case e of Event (KASCII '<') [] -> Ev "" Event (KASCII ' ') [MCtrl] -> Ev "" Event (KASCII c) [] -> Ev $ T.singleton c Event (KASCII c) [MCtrl] -> Ev $ mkMod MCtrl c Event (KASCII c) [MMeta] -> Ev $ mkMod MMeta c Event (KASCII c) [MShift] -> Ev . T.singleton $ toUpper c Event (KFun x) [] -> Ev $ " showT x `T.snoc` '>' v@(Event k mods) -> case M.lookup k invSpecMap of Just (Ev s) -> case mods of [] -> Ev $ '<' `T.cons` s `T.snoc` '>' [MCtrl] -> Ev $ " s `T.snoc` '>' [MMeta] -> Ev $ " s `T.snoc` '>' _ -> error $ "Couldn't convert event <" ++ show v ++ "> to string, because of unknown modifiers" Nothing -> error $ "Couldn't convert event <" ++ show v ++ "> to string" where f MCtrl = 'C' f MMeta = 'M' f _ = '×' mkMod m c = '<' `T.cons` f m `T.cons` '-' `T.cons` c `T.cons` T.singleton '>' parseEvents :: EventString -> [Event] parseEvents (Ev x) = fst . foldl' go ([], []) $ T.unpack x where go (evs, s) '\n' = (evs, s) go (evs, []) '<' = (evs, "<") go (evs, []) c = (evs ++ [char c], []) go (evs, s) '>' = (evs ++ [stringToEvent (s ++ ">")], []) go (evs, s) c = (evs, s ++ [c]) stringToRepeatableAction :: EventString -> RepeatableAction stringToRepeatableAction s = RepeatableAction count command where (count, command) = splitCountedCommand s splitCountedCommand :: EventString -> (Int, EventString) splitCountedCommand (Ev s) = (count, Ev commandString) where (countString, commandString) = T.span isDigit s count = case countString of "" -> 1 x -> read $ T.unpack x -- 2d3w -> 6dw -- 6dw -> 6dw -- dw -> dw normalizeCount :: EventString -> EventString normalizeCount s = if T.null countedObject then s else Ev $ showT (operatorCount * objectCount) <> operator <> object where (operatorCount, Ev rest1) = splitCountedCommand s (operator, countedObject) = T.break isDigit rest1 (objectCount, Ev object) = splitCountedCommand (Ev countedObject) yi-0.12.6/src/library/Yi/Keymap/Vim/Ex.hs0000644000000000000000000000504612717763531016135 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex ( exEvalE , exEvalY , evStringToExCommand , ExCommand(..) , defExCommandParsers ) where import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Buffer as Buffer (parse) import qualified Yi.Keymap.Vim.Ex.Commands.BufferDelete as BufferDelete (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Buffers as Buffers (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Cabal as Cabal (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Edit as Edit (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Global as Global (parse) import qualified Yi.Keymap.Vim.Ex.Commands.GotoLine as GotoLine (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Help as Help (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Make as Make (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Nohl as Nohl (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Paste as Paste (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Quit as Quit (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Reload as Reload (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Shell as Shell (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Sort as Sort (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Substitute as Substitute (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Tag as Tag (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Undo as Undo (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Write as Write (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Yi as Yi (parse) import Yi.Keymap.Vim.Ex.Eval (exEvalE, exEvalY) import Yi.Keymap.Vim.Ex.Types (ExCommand (..), evStringToExCommand) defExCommandParsers :: [EventString -> Maybe ExCommand] defExCommandParsers = [ Buffer.parse , Buffers.parse , BufferDelete.parse , Cabal.parse , Delete.parse , 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 ] yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Common.hs0000644000000000000000000002612512717763531021127 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Common -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Implements common 'ExCommand's for the Vim keymap. module Yi.Keymap.Vim.Ex.Commands.Common ( parse , parseWithBang , parseWithBangAndCount , parseRange , BoolOptionAction(..) , TextOptionAction(..) , parseBoolOption , parseTextOption , filenameComplete , forAllBuffers , pureExCommand , impureExCommand , errorNoWrite , commandArgs , needsSaving ) where import Control.Applicative (Alternative ((<|>)), Applicative ((*>), (<*)), (<$>)) import Control.Lens (use) import Control.Monad (void, (>=>)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Monoid (Monoid (mconcat), (<>)) import qualified Data.Text as T (Text, concat, cons, drop, isPrefixOf, length, pack, singleton, snoc, unpack) import System.Directory (getCurrentDirectory) import qualified Text.ParserCombinators.Parsec as P (GenParser, anyChar, char, digit, many, many1, noneOf, oneOf, optionMaybe, parse, space, string) import Text.Read (readMaybe) import Yi.Buffer import Yi.Editor import Yi.File (deservesSave) import Yi.Keymap (Action, YiM, readEditor) import Yi.Keymap.Vim.Common (EventString (Ev)) import Yi.Keymap.Vim.Ex.Types (ExCommand (..)) import Yi.Misc (matchingFileNames) import Yi.Monad (gets) import Yi.Style (errorStyle) import Yi.Utils (io) parse :: P.GenParser Char () ExCommand -> EventString -> Maybe ExCommand 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 -> P.GenParser Char () ExCommand) -- ^ A parser for the remaining command arguments. -> EventString -- ^ The string to parse. -> Maybe ExCommand parseWithBangAndCount nameParser argumentParser (Ev s) = either (const Nothing) Just (P.parse parser "" $ T.unpack s) where parser = do mcount <- parseCount a <- nameParser bang <- parseBang argumentParser a bang mcount parseWithBang :: P.GenParser Char () a -- ^ The command name parser. -> (a -> Bool -> P.GenParser Char () ExCommand) -- ^ A parser for the remaining command arguments. -> EventString -- ^ The string to parse. -> Maybe ExCommand parseWithBang nameParser argumentParser (Ev s) = either (const Nothing) Just (P.parse parser "" $ T.unpack s) where parser = do a <- nameParser bang <- parseBang argumentParser a bang parseBang :: P.GenParser Char () Bool parseBang = P.string "!" *> return True <|> return False parseCount :: P.GenParser Char () (Maybe Int) parseCount = readMaybe <$> P.many P.digit parseRange :: P.GenParser Char s (Maybe (BufferM Region)) parseRange = fmap Just parseFullRange <|> fmap Just parsePointRange <|> return Nothing 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 (T.unpack name) bangs <- P.many (P.string "!") qs <- P.many (P.string "?") return $ pureExCommand { cmdShow = T.concat [ "set " , T.pack $ concat nos , name , T.pack $ concat bangs , T.pack $ concat qs ] , cmdAction = action $ case fmap (not . null) [qs, bangs, invs, nos] of [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 return $! if pwd' `T.snoc` '/' `T.isPrefixOf` path then T.drop (1 + T.length pwd') path else path filenameComplete :: T.Text -> YiM [T.Text] filenameComplete f = if f == "%" then -- current buffer is minibuffer -- actual file is in the second buffer in bufferStack gets bufferStack >>= \case _ :| [] -> do printMsg "filenameComplete: Expected to see minibuffer!" return [] _ :| bufferRef : _ -> do currentFileName <- fmap T.pack . withGivenBuffer bufferRef $ fmap bufInfoFileName bufInfoB let sanitizedFileName = if "//" `T.isPrefixOf` currentFileName then '/' `T.cons` currentFileName else currentFileName return <$> removePwd sanitizedFileName else do files <- matchingFileNames Nothing f case files of [] -> return [] [x] -> return <$> removePwd x xs -> sequence $ fmap removePwd xs forAllBuffers :: MonadEditor m => (BufferRef -> m ()) -> m () forAllBuffers f = readEditor bufferStack >>= \(b :| bs) -> f b >> mapM_ f bs pureExCommand :: ExCommand pureExCommand = ExCommand { cmdIsPure = True , cmdComplete = return [] , cmdAcceptsRange = False , cmdAction = undefined , cmdShow = undefined } impureExCommand :: ExCommand impureExCommand = pureExCommand { cmdIsPure = False } -- | Show an error on the status line. errorEditor :: T.Text -> EditorM () errorEditor s = printStatus (["error: " <> s], errorStyle) -- | Show the common error message about an unsaved file on the status line. errorNoWrite :: EditorM () errorNoWrite = errorEditor "No write since last change (add ! to override)" -- | Useful parser for any Ex command that acts kind of like a shell commandArgs :: P.GenParser Char () [T.Text] commandArgs = P.many commandArg -- | Parse a single command, with a space in front commandArg :: P.GenParser Char () T.Text commandArg = fmap mconcat $ P.many1 P.space *> normArg -- | Unquoted arg, allows for escaping of \, ", ', and space. Includes quoted arg -- as a subset, because of things like aa"bbb" normArg :: P.GenParser Char () [T.Text] normArg = P.many1 $ quoteArg '\"' <|> quoteArg '\"' <|> T.singleton <$> escapeChar <|> T.singleton <$> P.noneOf " \"\'\\" -- | Quoted arg with char delim. Allows same escapes, but doesn't require escaping -- of the opposite kind or space. However, it does allow escaping opposite kind like -- 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.char delim -- | Parser for a single escape character escapeChar :: P.GenParser Char () Char escapeChar = P.char '\\' *> P.oneOf " \"\'\\" needsSaving :: BufferRef -> YiM Bool needsSaving = findBuffer >=> maybe (return False) deservesSave yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Buffer.hs0000644000000000000000000000554312717763531021111 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Buffer -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- :buffer ex command to switch to named or numbered buffer. module Yi.Keymap.Vim.Ex.Commands.Buffer (parse) where import Control.Applicative (Alternative ((<|>)), Applicative ((*>)), (<$>)) import Control.Monad (void) import Control.Monad.State (gets) import qualified Data.Text as T (pack) import qualified Text.ParserCombinators.Parsec as P (GenParser, anyChar, digit, eof, many, many1, parse, space, string, try) import Yi.Buffer.Basic (BufferRef (..)) import Yi.Buffer.Misc (bkey, isUnchangedBuffer) import Yi.Editor import Yi.Keymap (Action (EditorA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (errorNoWrite, parseWithBangAndCount, pureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) parse :: EventString -> Maybe ExCommand parse = Common.parseWithBangAndCount nameParser $ \ _ bang mcount -> do bufIdent <- P.try ( P.many1 P.digit <|> bufferSymbol) <|> P.many1 P.space *> P.many P.anyChar <|> P.eof *> return "" return $ Common.pureExCommand { cmdShow = "buffer" , cmdAction = EditorA $ do unchanged <- withCurrentBuffer $ gets isUnchangedBuffer if bang || unchanged then case mcount of Nothing -> switchToBuffer bufIdent Just i -> switchByRef $ BufferRef i else Common.errorNoWrite } where bufferSymbol = P.string "%" <|> P.string "#" nameParser :: P.GenParser Char () () nameParser = void $ P.try ( P.string "buffer") <|> P.try ( P.string "buf") <|> P.try ( P.string "bu") <|> P.try ( P.string "b") switchToBuffer :: String -> EditorM () switchToBuffer s = case P.parse bufferRef "" s of Right ref -> switchByRef ref Left _e -> switchByName s where bufferRef = BufferRef . read <$> P.many1 P.digit switchByName :: String -> EditorM () switchByName "" = return () switchByName "%" = return () switchByName "#" = switchToBufferWithNameE "" switchByName bufName = switchToBufferWithNameE (T.pack bufName) switchByRef :: BufferRef -> EditorM () switchByRef ref = do mBuf <- findBuffer ref maybe (return ()) (switchToBufferE . bkey) mBuf yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Buffers.hs0000644000000000000000000000474312717763531021275 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.BufferDelete -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- :buffers or :ls ex command to list buffers. module Yi.Keymap.Vim.Ex.Commands.Buffers (parse) where import Control.Applicative (Alternative ((<|>))) import Control.Lens (view) import Control.Monad (void) import qualified Data.Map as M (elems, mapWithKey) import qualified Data.Text as T (intercalate, pack, unlines) import qualified Text.ParserCombinators.Parsec as P (string, try) import Yi.Buffer.Basic (BufferRef (BufferRef)) import Yi.Buffer.Misc (BufferId (MemBuffer), identA) import Yi.Editor import Yi.Keymap (Action (EditorA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) import Yi.Monad (gets) import Yi.Rope (fromText) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do void $ P.try ( P.string "buffers") <|> P.try ( P.string "ls") <|> P.try ( P.string "files" ) return $ Common.pureExCommand { cmdShow = "buffers" , cmdAction = EditorA $ withEditor printBuffers } printBuffers :: EditorM () printBuffers = do -- TODO Don't keep recreating new buffers. Use a pre-existing one. -- See the cabal buffer used in Command.hs for an example. -- TODO Add some simple keymaps to the buffer, like to open the buffer? bufs <- gets buffers let bufLines = M.elems $ M.mapWithKey bufLine bufs if length bufLines > 1 then withEditor . void $ newBufferE (MemBuffer "Buffer list") (fromText $ T.unlines bufLines) else printMsgs bufLines where tab = T.pack "\t" -- TODO shorten this name string perhaps. -- TODO Add more information: modified status, line number. bufLine (BufferRef bufNum) buf = T.intercalate tab [ T.pack . show $ bufNum , T.pack . show . view identA $ buf ] yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/BufferDelete.hs0000644000000000000000000000232112717763531022223 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.BufferDelete -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.BufferDelete (parse) where import Control.Applicative (Alternative ((<|>))) import Control.Monad (void) import Data.Text () import qualified Text.ParserCombinators.Parsec as P (string, try) import Yi.Editor (closeBufferAndWindowE) import Yi.Keymap (Action (EditorA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do void $ P.try ( P.string "bdelete") <|> P.try ( P.string "bdel") <|> P.try (P.string "bd") return $ Common.pureExCommand { cmdShow = "bdelete" , cmdAction = EditorA closeBufferAndWindowE } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Cabal.hs0000644000000000000000000000271212717763531020675 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Cabal -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Cabal (parse) where import Control.Applicative (Alternative ((<|>))) import Control.Monad (void) import qualified Data.Text as T (pack) import qualified Text.ParserCombinators.Parsec as P (string, try) import Yi.Command (cabalBuildE) import Yi.Keymap (Action (YiA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (commandArgs, impureExCommand, parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) import Yi.MiniBuffer (CommandArguments (CommandArguments)) -- TODO: Either hack Text into these parsec parsers or use Attoparsec. -- Attoparsec is faster anyway and backtracks by default so we may -- want to use that anyway. parse :: EventString -> Maybe ExCommand parse = Common.parse $ do void $ P.try (P.string "cabal build") <|> P.try (P.string "cabal") args <- Common.commandArgs return $ Common.impureExCommand { cmdShow = T.pack "cabal build" , cmdAction = YiA $ cabalBuildE $ CommandArguments args } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Delete.hs0000644000000000000000000000227712717763531021103 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Delete -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Delete (parse) where import Control.Applicative (Alternative ((<|>))) import Control.Monad (void) import Data.Text () import qualified Text.ParserCombinators.Parsec as P (string, try) import Yi.Buffer.Adjusted hiding (Delete) import Yi.Keymap (Action (BufferA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do void $ P.try ( P.string "delete") <|> P.string "d" return $ Common.pureExCommand { cmdShow = "delete" , cmdAction = BufferA $ do deleteUnitB Line Forward deleteN 1 } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Edit.hs0000644000000000000000000000344612717763531020565 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Edit -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Implements quit commands. module Yi.Keymap.Vim.Ex.Commands.Edit (parse) where import Control.Applicative (Alternative ((<|>)), (<$>)) import Control.Monad (void, when) import qualified Data.Text as T (Text, append, pack, unpack) import qualified Text.ParserCombinators.Parsec as P (anyChar, many, many1, space, string, try) import Yi.Editor (MonadEditor (withEditor), newTabE) import Yi.File (openNewFile) import Yi.Keymap (Action (YiA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (filenameComplete, impureExCommand, parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdComplete, cmdShow)) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do tab <- P.many (P.string "tab") void $ P.try ( P.string "edit") <|> P.string "e" void $ P.many1 P.space filename <- T.pack <$> P.many1 P.anyChar return $! edit (not (null tab)) filename edit :: Bool -> T.Text -> ExCommand edit tab f = Common.impureExCommand { cmdShow = showEdit tab f , cmdAction = YiA $ do when tab $ withEditor newTabE openNewFile $ T.unpack f , cmdComplete = (fmap . fmap) (showEdit tab) (Common.filenameComplete f) } showEdit :: Bool -> T.Text -> T.Text showEdit tab f = (if tab then "tab" else "") `T.append` "edit " `T.append` f yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Global.hs0000644000000000000000000000537712717763531021105 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Global -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Global (parse) where import Control.Applicative (Alternative ((<|>)), (<$>)) import Control.Lens (use) import Control.Monad (forM_, void, when) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, isInfixOf, pack, snoc) import qualified Text.ParserCombinators.Parsec as P (anyChar, char, many, noneOf, string, try) import Yi.Buffer.Adjusted import Yi.Editor (withCurrentBuffer) import Yi.Keymap (Action (BufferA, EditorA)) import Yi.Keymap.Vim.Common (EventString (Ev)) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand) import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete (parse) import qualified Yi.Keymap.Vim.Ex.Commands.Substitute as Substitute (parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow), evStringToExCommand) import qualified Yi.Rope as R (toText) import Yi.String (showT) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do void $ P.try (P.string "global/") <|> P.string "g/" predicate <- T.pack <$> P.many (P.noneOf "/") void $ P.char '/' cmdString <- Ev . T.pack <$> P.many P.anyChar cmd <- case evStringToExCommand allowedCmds cmdString of Just c -> return c _ -> fail "Unexpected command argument for global command." return $! global predicate cmd global :: T.Text -> ExCommand -> ExCommand global p c = Common.pureExCommand { cmdShow = "g/" <> p `T.snoc` '/' <> showT c , cmdAction = EditorA $ do mark <- withCurrentBuffer setMarkHereB lineCount <- withCurrentBuffer lineCountB forM_ (reverse [1..lineCount]) $ \l -> do ln <- withCurrentBuffer $ gotoLn l >> R.toText <$> readLnB when (p `T.isInfixOf` ln) $ case cmdAction c of BufferA action -> withCurrentBuffer $ void action EditorA action -> void action _ -> error "Impure command as an argument to global." withCurrentBuffer $ do use (markPointA mark) >>= moveTo deleteMarkB mark } allowedCmds :: [EventString -> Maybe ExCommand] allowedCmds = [Delete.parse, Substitute.parse] yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/GotoLine.hs0000644000000000000000000000204212717763531021407 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.GotoLine -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.GotoLine (parse) where import Data.Char (isDigit) import qualified Data.Text as T (all, null, unpack) import Yi.Buffer.Adjusted (firstNonSpaceB, gotoLn) import Yi.Keymap (Action (BufferA)) import Yi.Keymap.Vim.Common (EventString (Ev)) import Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) parse :: EventString -> Maybe ExCommand parse (Ev s) = if not (T.null s) && T.all isDigit s then let l = read $ T.unpack s in Just $ pureExCommand { cmdAction = BufferA $ gotoLn l >> firstNonSpaceB , cmdShow = s } else Nothing yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Help.hs0000644000000000000000000000257312717763531020570 0ustar0000000000000000{-# 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.Applicative ((<$>)) import Control.Monad (void) import qualified Data.Text as T (append, pack) import qualified Text.ParserCombinators.Parsec as P (anyChar, many1, option, space, string, try) import Yi.Command.Help (displayHelpFor) import Yi.Keymap (Action (YiA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) 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 } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Make.hs0000644000000000000000000000224512717763531020551 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Make -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Make (parse) where import Control.Applicative (Applicative ((*>))) import qualified Data.Text as T (pack) import qualified Text.ParserCombinators.Parsec as P (string) import Yi.Command (makeBuildE) import Yi.Keymap (Action (YiA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (commandArgs, impureExCommand, parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) import Yi.MiniBuffer (CommandArguments (CommandArguments)) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do args <- P.string "make" *> Common.commandArgs return $ Common.impureExCommand { cmdShow = T.pack "make" , cmdAction = YiA $ makeBuildE $ CommandArguments args } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Nohl.hs0000644000000000000000000000165512717763531020600 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Nohl -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Nohl (parse) where import Data.Text () import Yi.Keymap (Action (EditorA)) import Yi.Keymap.Vim.Common (EventString) import Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) import Yi.Search (resetRegexE) parse :: EventString -> Maybe ExCommand parse s = if s == "nohl" || s == "nohlsearch" then Just nohl else Nothing nohl :: ExCommand nohl = pureExCommand { cmdAction = EditorA resetRegexE , cmdShow = "nohlsearch" } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Paste.hs0000644000000000000000000000256112717763531020751 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Paste -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Implements quit commands. module Yi.Keymap.Vim.Ex.Commands.Paste (parse) where import Control.Applicative ((<$>)) import Data.Monoid ((<>)) import Yi.Editor (getEditorDyn, printMsg) import Yi.Keymap (Action (EditorA)) import Yi.Keymap.Vim.Common (EventString, VimState (vsPaste)) import Yi.Keymap.Vim.Ex.Commands.Common (BoolOptionAction (..), parseBoolOption) import Yi.Keymap.Vim.Ex.Types (ExCommand) import Yi.Keymap.Vim.StateUtils (modifyStateE) import Yi.String (showT) parse :: EventString -> Maybe ExCommand parse = parseBoolOption "paste" action action :: BoolOptionAction -> Action action BoolOptionAsk = EditorA $ do value <- vsPaste <$> getEditorDyn printMsg $ "paste = " <> showT value action (BoolOptionSet b) = modPaste $ const b action BoolOptionInvert = modPaste not modPaste :: (Bool -> Bool) -> Action modPaste f = EditorA . modifyStateE $ \s -> s { vsPaste = f (vsPaste s) } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Quit.hs0000644000000000000000000000772412717763531020625 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Quit -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Implements quit commands. module Yi.Keymap.Vim.Ex.Commands.Quit (parse) where import Control.Applicative (Alternative ((<|>)), (<$>)) import Control.Lens (use, uses) import Control.Monad (void, when) import Data.Foldable (find) import qualified Data.List.PointedList.Circular as PL (length) import Data.Monoid ((<>)) import qualified Data.Text as T (append) import qualified Text.ParserCombinators.Parsec as P (char, choice, many, string, try) import Yi.Buffer (bkey, file) import Yi.Core (closeWindow, errorEditor, quitEditor) import Yi.Editor import Yi.File (deservesSave, fwriteAllY, viWrite) import Yi.Keymap (Action (YiA), YiM, readEditor) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, needsSaving, parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) import Yi.Monad (gets) import Yi.String (showT) import Yi.Window (bufkey) parse :: EventString -> Maybe ExCommand parse = Common.parse $ P.choice [ do void $ P.try ( P.string "xit") <|> P.string "x" bangs <- P.many (P.char '!') return (quit True (not $ null bangs) False) , do ws <- P.many (P.char 'w') void $ P.try ( P.string "quit") <|> P.string "q" as <- P.many (P.try ( P.string "all") <|> P.string "a") bangs <- P.many (P.char '!') return $! quit (not $ null ws) (not $ null bangs) (not $ null as) ] quit :: Bool -> Bool -> Bool -> ExCommand quit w f a = Common.impureExCommand { cmdShow = (if w then "w" else "") `T.append` "quit" `T.append` (if a then "all" else "") `T.append` (if f then "!" else "") , cmdAction = YiA $ action w f a } action :: Bool -> Bool -> Bool -> YiM () action False False False = quitWindowE action False False True = quitAllE action True False False = viWrite >> closeWindow action True False True = saveAndQuitAllE action False True False = closeWindow action False True True = quitEditor action True True False = viWrite >> closeWindow action True True True = saveAndQuitAllE quitWindowE :: YiM () quitWindowE = do nw <- gets currentBuffer >>= Common.needsSaving ws <- withEditor $ use currentWindowA >>= windowsOnBufferE . bufkey if length ws == 1 && nw then errorEditor "No write since last change (add ! to override)" else do winCount <- withEditor $ uses windowsA PL.length tabCount <- withEditor $ uses tabsA PL.length if winCount == 1 && tabCount == 1 -- if its the last window, quitting will quit the editor then quitAllE else closeWindow quitAllE :: YiM () quitAllE = do let needsWindow b = (b,) <$> deservesSave b bs <- readEditor bufferSet >>= mapM needsWindow -- Vim only shows the first modified buffer in the error. case find snd bs of Nothing -> quitEditor Just (b, _) -> do bufferName <- withEditor $ withGivenBuffer (bkey b) $ gets file errorEditor $ "No write since last change for buffer " <> showT bufferName <> " (add ! to override)" saveAndQuitAllE :: YiM () saveAndQuitAllE = do succeed <- fwriteAllY when succeed quitEditor yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Reload.hs0000644000000000000000000000144112717763531021077 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Reload -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Reload (parse) where import Data.Text () import Yi.Boot.Internal (reload) import Yi.Keymap (Action (YiA)) import Yi.Keymap.Vim.Common (EventString) import Yi.Keymap.Vim.Ex.Commands.Common (impureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) parse :: EventString -> Maybe ExCommand parse "reload" = Just $ impureExCommand { cmdShow = "reload" , cmdAction = YiA reload } parse _ = Nothing yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Shell.hs0000644000000000000000000000226612717763531020746 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Shell -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Shell (parse) where import Control.Applicative ((<$>)) import Control.Monad (void) import qualified Data.Text as T (pack) import qualified Text.ParserCombinators.Parsec as P (char, many1, noneOf) import Yi.Command (buildRun) import Yi.Keymap (Action (YiA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (commandArgs, impureExCommand, parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do void $ P.char '!' cmd <- T.pack <$> P.many1 (P.noneOf " ") args <- Common.commandArgs return $ Common.impureExCommand { cmdShow = T.pack "!" , cmdAction = YiA $ buildRun cmd args (const $ return ()) } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Sort.hs0000644000000000000000000000237612717763531020630 0ustar0000000000000000{-# 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 (void) import qualified Text.ParserCombinators.Parsec as P (string) import Yi.Buffer import Yi.Keymap (Action (BufferA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, parseRange, pureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdComplete, cmdShow)) 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 yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Substitute.hs0000644000000000000000000001327112717763531022050 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Substitute -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Substitute (parse) where import Control.Applicative (Alternative ((<|>)), (<$>)) import Control.Monad (void) import Data.Monoid ((<>)) import qualified Data.Text as T (cons, snoc) import qualified Text.ParserCombinators.Parsec as P (char, many, noneOf, oneOf, string, try) import Yi.Buffer.Adjusted import Yi.Editor (EditorM, closeBufferAndWindowE, printMsg, withCurrentBuffer) import Yi.Keymap (Action (EditorA), Keymap) import Yi.Keymap.Keys (char, choice, (?>>!)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (parse, pureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) import Yi.MiniBuffer (spawnMinibufferE) import Yi.Regex (makeSearchOptsM) import qualified Yi.Rope as R (YiString, fromString, length, null, toText, toString) import Yi.Search parse :: EventString -> Maybe ExCommand parse = Common.parse $ do percents <- P.many (P.char '%') void $ P.try (P.string "substitute") <|> P.string "s" delimiter <- P.oneOf "!@#$%^&*()[]{}<>/.,~';:?-=" from <- R.fromString <$> P.many (P.noneOf [delimiter]) void $ P.char delimiter to <- R.fromString <$> P.many (P.noneOf [delimiter]) void $ P.char delimiter flagChars <- P.many (P.oneOf "gic") return $! substitute from to delimiter ('g' `elem` flagChars) ('i' `elem` flagChars) ('c' `elem` flagChars) (not $ null percents) substitute :: R.YiString -> R.YiString -> Char -> Bool -> Bool -> Bool -> Bool -> ExCommand substitute from to delimiter global caseInsensitive confirm allLines = Common.pureExCommand { cmdShow = (if allLines then "%" else "") <> "substitute" <> (delimiter `T.cons` R.toText from) <> (delimiter `T.cons` R.toText to) `T.snoc` delimiter <> (if confirm then "c" else "") <> (if caseInsensitive then "i" else "") <> (if global then "g" else "") , cmdAction = EditorA $ do let opts = QuoteRegex : if caseInsensitive then [IgnoreCase] else [] regex <- if R.null from then getRegexE else return . (either (const Nothing) Just) . makeSearchOptsM opts . R.toString $ from case regex of Nothing -> printMsg "No previous search pattern" Just regex' -> if confirm then substituteConfirm regex' to global allLines else withCurrentBuffer $ do let replace = void $ regionOfB Line >>= searchAndRepRegion0 regex' to global if allLines then withEveryLineB replace else replace moveToSol } -- | Run substitution in confirm mode substituteConfirm :: SearchExp -> R.YiString -> Bool -> Bool -> EditorM () substituteConfirm regex to global allLines = do setRegexE regex regions <- withCurrentBuffer $ findMatches regex global allLines substituteMatch to 0 False regions -- | All matches to replace under given flags findMatches :: SearchExp -> Bool -> Bool -> BufferM [Region] findMatches regex global allLines = do lns <- if allLines then do lineCount <- lineCountB lineRegions [1..lineCount] else return <$> regionOfB Line let f = if global then id else take 1 concat <$> mapM (fmap f . regexRegionB regex) lns -- | Get regions corresponding to all lines lineRegions :: [Int] -> BufferM [Region] lineRegions = mapM $ \ln -> gotoLn ln >> regionOfB Line -- | Offsets a region (to account for a region prior being modified) offsetRegion :: Int -> Region -> Region offsetRegion k reg = mkRegion (regionStart reg + k') (regionEnd reg + k') where k' = fromIntegral k -- | Runs a list of matches using itself as a continuation substituteMatch :: R.YiString -> Int -> Bool -> [Region] -> EditorM () substituteMatch _ _ _ [] = resetRegexE substituteMatch to co autoAll (m:ms) = do let m' = offsetRegion co m withCurrentBuffer . moveTo $ regionStart m' len <- withCurrentBuffer $ R.length <$> readRegionB m' let diff = R.length to - len tex = "replace with " <> R.toText to <> " (y/n/a/q)?" if autoAll then do withCurrentBuffer $ replaceRegionB m' to substituteMatch to (co + diff) True ms else void . spawnMinibufferE tex . const $ askKeymap to co (co + diff) m ms -- | Actual choices during confirm mode. askKeymap :: R.YiString -> Int -> Int -> Region -> [Region] -> Keymap askKeymap to co co' m ms = choice [ char 'n' ?>>! cleanUp >> substituteMatch to co False ms , char 'a' ?>>! do cleanUp replace substituteMatch to co' True ms , char 'y' ?>>! do cleanUp replace substituteMatch to co' False ms , char 'q' ?>>! cleanUp >> resetRegexE ] where cleanUp = closeBufferAndWindowE replace = withCurrentBuffer $ replaceRegionB (offsetRegion co m) to yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Tag.hs0000644000000000000000000000432012717763531020403 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Tag -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Tag (parse) where import Control.Applicative (Alternative ((<|>)), (<$>)) import Control.Monad (void) import Data.Monoid ((<>)) import qualified Data.Text as T (pack) import qualified Text.ParserCombinators.Parsec as P (GenParser, anyChar, eof, many1, optionMaybe, space, string) import Yi.Keymap (Action (YiA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdComplete, cmdShow)) import Yi.Keymap.Vim.Tag (completeVimTag, gotoTag, nextTag, unpopTag) import Yi.Tag (Tag (Tag)) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do void $ P.string "t" parseTag <|> parseNext parseTag :: P.GenParser Char () ExCommand parseTag = do void $ P.string "a" void . P.optionMaybe $ P.string "g" t <- P.optionMaybe $ do void $ P.many1 P.space P.many1 P.anyChar case t of Nothing -> P.eof >> return (tag Nothing) Just t' -> return $! tag (Just (Tag (T.pack t'))) parseNext :: P.GenParser Char () ExCommand parseNext = do void $ P.string "next" return next tag :: Maybe Tag -> ExCommand tag Nothing = Common.impureExCommand { cmdShow = "tag" , cmdAction = YiA unpopTag , cmdComplete = return ["tag"] } tag (Just (Tag t)) = Common.impureExCommand { cmdShow = "tag " <> t , cmdAction = YiA $ gotoTag (Tag t) 0 Nothing , cmdComplete = map ("tag " <>) <$> completeVimTag t } next :: ExCommand next = Common.impureExCommand { cmdShow = "tnext" , cmdAction = YiA nextTag , cmdComplete = return ["tnext"] } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Undo.hs0000644000000000000000000000223012717763531020573 0ustar0000000000000000{-# 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 (redoB, undoB) import Yi.Keymap (Action (BufferA)) import Yi.Keymap.Vim.Common (EventString (Ev)) import Yi.Keymap.Vim.Ex.Commands.Common (pureExCommand) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdComplete, cmdShow)) 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 yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Write.hs0000644000000000000000000000433612717763531020771 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Commands.Write -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Commands.Write (parse) where import Control.Applicative (Alternative ((<|>)), Applicative ((*>)), (<$>)) import Control.Monad (void, when) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, pack) import qualified Text.ParserCombinators.Parsec as P (anyChar, many, many1, space, string, try) import Yi.Buffer (BufferRef) import Yi.Editor (printMsg) import Yi.File (fwriteBufferE, viWrite, viWriteTo) import Yi.Keymap (Action (YiA), YiM) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (forAllBuffers, impureExCommand, needsSaving, parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) parse :: EventString -> Maybe ExCommand parse = Common.parse $ (P.try (P.string "write") <|> P.string "w") *> (parseWriteAs <|> parseWrite) where parseWrite = do alls <- P.many (P.try ( P.string "all") <|> P.string "a") return $! writeCmd $ not (null alls) parseWriteAs = do void $ P.many1 P.space filename <- T.pack <$> P.many1 P.anyChar return $! writeAsCmd filename writeCmd :: Bool -> ExCommand writeCmd allFlag = Common.impureExCommand { cmdShow = "write" <> if allFlag then "all" else "" , cmdAction = YiA $ if allFlag then Common.forAllBuffers tryWriteBuffer >> printMsg "All files written" else viWrite } writeAsCmd :: T.Text -> ExCommand writeAsCmd filename = Common.impureExCommand { cmdShow = "write " <> filename , cmdAction = YiA $ viWriteTo filename } tryWriteBuffer :: BufferRef -> YiM () tryWriteBuffer buf = do ns <- Common.needsSaving buf when ns . void $ fwriteBufferE buf yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Commands/Yi.hs0000644000000000000000000000213312717763531020251 0ustar0000000000000000{-# 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.Yi (parse) where import Control.Monad (void) import qualified Data.Text as T (pack) import qualified Text.ParserCombinators.Parsec as P (anyChar, many1, space, string) import Yi.Eval (execEditorAction) import Yi.Keymap (Action (YiA)) import Yi.Keymap.Vim.Common (EventString) import qualified Yi.Keymap.Vim.Ex.Commands.Common as Common (impureExCommand, parse) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction, cmdShow)) parse :: EventString -> Maybe ExCommand parse = Common.parse $ do void $ P.string "yi" void $ P.many1 P.space cmd <- P.many1 P.anyChar return $! Common.impureExCommand { cmdAction = YiA $ execEditorAction cmd , cmdShow = T.pack cmd } yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Types.hs0000644000000000000000000000163412717763531017240 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Types -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Types where import Data.Maybe (listToMaybe, mapMaybe) import Data.Text (Text, unpack) import Yi.Keymap (Action, YiM) import Yi.Keymap.Vim.Common (EventString) data ExCommand = ExCommand { cmdComplete :: YiM [Text] , cmdIsPure :: Bool , cmdAction :: Action , cmdAcceptsRange :: Bool , cmdShow :: Text } instance Show ExCommand where show = unpack . cmdShow data LineRange = MarkRange String String -- ^ 'a,'b | FullRange -- ^ % | CurrentLineRange evStringToExCommand :: [EventString -> Maybe ExCommand] -> EventString -> Maybe ExCommand evStringToExCommand parsers s = listToMaybe . mapMaybe ($ s) $ parsers yi-0.12.6/src/library/Yi/Keymap/Vim/Ex/Eval.hs0000644000000000000000000000311612717763531017020 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Ex.Eval -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Ex.Eval ( exEvalE , exEvalY ) where import Control.Monad (void) import Data.Monoid ((<>)) import qualified Data.Text as T (unpack) import Yi.Editor (EditorM, MonadEditor (withEditor), withCurrentBuffer) import Yi.Keymap (Action (BufferA, EditorA, YiA), YiM) import Yi.Keymap.Vim.Common (EventString (_unEv)) import Yi.Keymap.Vim.Ex.Types (ExCommand (cmdAction), evStringToExCommand) exEvalE :: [EventString -> Maybe ExCommand] -> EventString -> EditorM () exEvalE cmds cmdString = evalHelper id (const $ error msg) cmds cmdString where msg = T.unpack . _unEv $ "exEvalE got impure command" <> cmdString exEvalY :: [EventString -> Maybe ExCommand] -> EventString -> YiM () exEvalY = evalHelper withEditor id evalHelper :: MonadEditor m => (EditorM () -> m ()) -> (YiM () -> m ()) -> [EventString -> Maybe ExCommand] -> EventString -> m () evalHelper pureHandler impureHandler cmds cmdString = case evStringToExCommand cmds cmdString of Just cmd -> case cmdAction cmd of BufferA actionB -> pureHandler $ withCurrentBuffer (void actionB) EditorA actionE -> pureHandler (void actionE) YiA actionY -> impureHandler (void actionY) _ -> return () yi-0.12.6/src/library/Yi/Keymap/Vim/ExMap.hs0000644000000000000000000001551612717763531016576 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.ExMap -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- I'm a module waiting for some kind soul to give me a commentary! module Yi.Keymap.Vim.ExMap (defExMap) where import Control.Applicative ((<$), (<$>)) import Control.Monad (when) import Data.Char (isSpace) import Data.Maybe (fromJust) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, drop, head, length, split, unwords) import System.FilePath (isPathSeparator) import Yi.Buffer.Adjusted hiding (Insert) import Yi.Editor import Yi.History (historyDown, historyFinish, historyPrefixSet, historyUp) import Yi.Keymap (YiM) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.Ex import Yi.Keymap.Vim.StateUtils (modifyStateE, resetCountE, switchModeE) import Yi.Keymap.Vim.Utils (matchFromBool) import qualified Yi.Rope as R (fromText, toText) import Yi.String (commonTPrefix') defExMap :: [EventString -> Maybe ExCommand] -> [VimBinding] defExMap cmdParsers = [ exitBinding , completionBinding cmdParsers , finishBindingY cmdParsers , finishBindingE cmdParsers , failBindingE , historyBinding , printable ] completionBinding :: [EventString -> Maybe ExCommand] -> VimBinding completionBinding commandParsers = VimBindingY f where f "" (VimState { vsMode = Ex }) = WholeMatch $ do commandString <- Ev . R.toText <$> withCurrentBuffer elemsB case evStringToExCommand commandParsers commandString of Just cmd -> complete cmd Nothing -> return () return Drop f _ _ = NoMatch complete :: ExCommand -> YiM () complete cmd = do possibilities <- cmdComplete cmd case possibilities of [] -> return () (s:[]) -> updateCommand s ss -> do let s = commonTPrefix' ss updateCommand s printMsg . T.unwords . fmap (dropToLastWordOf s) $ ss updateCommand :: T.Text -> YiM () updateCommand s = do withCurrentBuffer $ replaceBufferContent (R.fromText s) withEditor $ do historyPrefixSet s modifyStateE $ \state -> state { vsOngoingInsertEvents = Ev s } -- | TODO: verify whether 'T.split' works fine here in place of -- @split@'s 'splitWhen'. If something breaks then you should use -- 'splitWhen' + 'T.pack'/'T.unpack'. dropToLastWordOf :: T.Text -> T.Text -> T.Text dropToLastWordOf s = case reverse . T.split isWordSep $ s of [] -> id [_] -> id _ : ws -> T.drop . succ . T.length . T.unwords $ ws where isWordSep :: Char -> Bool isWordSep c = isPathSeparator c || isSpace c exitEx :: Bool -> EditorM () exitEx success = do when success historyFinish resetCountE switchModeE Normal closeBufferAndWindowE withCurrentBuffer $ setVisibleSelection False exitBinding :: VimBinding exitBinding = VimBindingE f where f "" (VimState { vsMode = Ex, vsOngoingInsertEvents = Ev "" }) = WholeMatch action f evs (VimState { vsMode = Ex }) = action <$ matchFromBool (evs `elem` ["", ""]) f _ _ = NoMatch action = exitEx False >> return Drop finishBindingY :: [EventString -> Maybe ExCommand] -> VimBinding finishBindingY commandParsers = VimBindingY f where f evs state = finishAction commandParsers exEvalY <$ finishPrereq commandParsers (not . cmdIsPure) evs state finishBindingE :: [EventString -> Maybe ExCommand] -> VimBinding finishBindingE commandParsers = VimBindingE f where f evs state = finishAction commandParsers exEvalE <$ finishPrereq commandParsers cmdIsPure evs state finishPrereq :: [EventString -> Maybe ExCommand] -> (ExCommand -> Bool) -> EventString -> VimState -> MatchResult () finishPrereq commandParsers cmdPred evs s = matchFromBool . and $ [ vsMode s == Ex , evs `elem` ["", ""] , case evStringToExCommand commandParsers (vsOngoingInsertEvents s) of Just cmd -> cmdPred cmd _ -> False ] finishAction :: MonadEditor m => [EventString -> Maybe ExCommand] -> ([EventString -> Maybe ExCommand] -> EventString -> m ()) -> m RepeatToken finishAction commandParsers execute = do s <- withEditor $ withCurrentBuffer elemsB withEditor $ exitEx True execute commandParsers (Ev $ R.toText s) -- TODO return Drop failBindingE :: VimBinding failBindingE = VimBindingE f where f evs s | vsMode s == Ex && evs == "" = WholeMatch $ do exitEx False state <- getEditorDyn printMsg . _unEv $ "Not an editor command: " <> vsOngoingInsertEvents state return Drop f _ _ = NoMatch printable :: VimBinding printable = VimBindingE f where f evs (VimState { vsMode = Ex }) = WholeMatch $ editAction evs f _ _ = NoMatch historyBinding :: VimBinding historyBinding = VimBindingE f where f evs (VimState { vsMode = Ex }) | evs `elem` fmap fst binds = WholeMatch $ do fromJust $ lookup evs binds command <- withCurrentBuffer elemsB modifyStateE $ \state -> state { vsOngoingInsertEvents = Ev $ R.toText command } return Drop f _ _ = NoMatch binds = [ ("", historyUp) , ("", historyUp) , ("", historyDown) , ("", historyDown) ] editAction :: EventString -> EditorM RepeatToken editAction (Ev evs) = do withCurrentBuffer $ case evs of "" -> bdeleteB "" -> bdeleteB "" -> do r <- regionOfPartNonEmptyB unitViWordOnLine Backward deleteRegionB r "" -> return () -- TODO "" -> insertB '<' "" -> deleteB Character Forward "" -> moveXorSol 1 "" -> moveXorSol 1 "" -> moveXorEol 1 "" -> moveXorEol 1 "" -> moveToSol "" -> moveToSol "" -> moveToEol "" -> moveToEol "" -> moveToSol >> deleteToEol "" -> deleteToEol evs' -> case T.length evs' of 1 -> insertB $ T.head evs' _ -> error $ "Unhandled event " ++ show evs' ++ " in ex mode" command <- R.toText <$> withCurrentBuffer elemsB historyPrefixSet command modifyStateE $ \state -> state { vsOngoingInsertEvents = Ev command } return Drop yi-0.12.6/src/library/Yi/Keymap/Vim/InsertMap.hs0000644000000000000000000002367112717763531017467 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.InsertMap -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.InsertMap (defInsertMap) where import Prelude hiding (head) import Control.Applicative ((<$)) import Control.Lens (use) import Control.Monad (forM, liftM2, replicateM_, void, when) import Data.Char (isDigit) import Data.List.NonEmpty (NonEmpty (..), head, toList) import Data.Monoid (Monoid (mempty), (<>)) import qualified Data.Text as T (pack, unpack) import qualified Yi.Buffer as B (bdeleteB, deleteB, deleteRegionB, insertB, insertN) import Yi.Buffer.Adjusted as BA hiding (Insert) import Yi.Editor (EditorM, getEditorDyn, withCurrentBuffer) import Yi.Event (Event) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.Digraph (charFromDigraph) import Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents) import Yi.Keymap.Vim.Motion (Move (Move), stringToMove) import Yi.Keymap.Vim.StateUtils import Yi.Keymap.Vim.Utils (selectBinding, selectPureBinding) import Yi.Monad (whenM) import qualified Yi.Rope as R (fromString, fromText) import Yi.TextCompletion (CompletionScope (..), completeWordB) defInsertMap :: [(String, Char)] -> [VimBinding] defInsertMap digraphs = [rawPrintable] <> specials digraphs <> [printable] specials :: [(String, Char)] -> [VimBinding] specials digraphs = [exitBinding digraphs, pasteRegisterBinding, digraphBinding digraphs , oneshotNormalBinding, completionBinding, cursorBinding] exitBinding :: [(String, Char)] -> VimBinding exitBinding digraphs = VimBindingE f where f :: EventString -> VimState -> MatchResult (EditorM RepeatToken) f evs (VimState { vsMode = (Insert _) }) | evs `elem` ["", ""] = WholeMatch $ do count <- getCountE (Insert starter) <- fmap vsMode getEditorDyn when (count > 1) $ do inputEvents <- fmap (parseEvents . vsOngoingInsertEvents) getEditorDyn replicateM_ (count - 1) $ do when (starter `elem` ['O', 'o']) $ withCurrentBuffer $ insertB '\n' replay digraphs inputEvents modifyStateE $ \s -> s { vsOngoingInsertEvents = mempty } withCurrentBuffer $ moveXorSol 1 modifyStateE $ \s -> s { vsSecondaryCursors = mempty } resetCountE switchModeE Normal withCurrentBuffer $ whenM isCurrentLineAllWhiteSpaceB $ moveToSol >> deleteToEol return Finish f _ _ = NoMatch rawPrintable :: VimBinding rawPrintable = VimBindingE f where f :: EventString -> VimState -> MatchResult (EditorM RepeatToken) f evs s@(VimState { vsMode = (Insert _)}) | vsPaste s && evs `notElem` ["", ""] = WholeMatch . withCurrentBuffer $ do case evs of "" -> insertB '<' "" -> newlineB "" -> insertB '\t' "" -> bdeleteB "" -> bdeleteB "" -> deleteB Character Forward "" -> moveToSol "" -> moveToEol "" -> scrollScreensB (-1) "" -> scrollScreensB 1 c -> insertN (R.fromText $ _unEv c) return Continue f _ _ = NoMatch replay :: [(String, Char)] -> [Event] -> EditorM () replay _ [] = return () replay digraphs (e1:es1) = do state <- getEditorDyn let recurse = replay digraphs evs1 = eventToEventString e1 bindingMatch1 = selectPureBinding evs1 state (defInsertMap digraphs) case bindingMatch1 of WholeMatch action -> void action >> recurse es1 PartialMatch -> case es1 of [] -> return () (e2:es2) -> do let evs2 = evs1 <> eventToEventString e2 bindingMatch2 = selectPureBinding evs2 state (defInsertMap digraphs) case bindingMatch2 of WholeMatch action -> void action >> recurse es2 _ -> recurse es2 _ -> recurse es1 oneshotNormalBinding :: VimBinding oneshotNormalBinding = VimBindingE (f . T.unpack . _unEv) where f "" (VimState { vsMode = Insert _ }) = PartialMatch f ('<':'C':'-':'o':'>':evs) (VimState { vsMode = Insert _ }) = action evs <$ stringToMove (Ev . T.pack $ dropWhile isDigit evs) f _ _ = NoMatch action evs = do let (countString, motionCmd) = span isDigit evs WholeMatch (Move _style _isJump move) = stringToMove . Ev . T.pack $ motionCmd withCurrentBuffer $ move (if null countString then Nothing else Just (read countString)) return Continue pasteRegisterBinding :: VimBinding pasteRegisterBinding = VimBindingE (f . T.unpack . _unEv) where f "" (VimState { vsMode = Insert _ }) = PartialMatch f ('<':'C':'-':'r':'>':regName:[]) (VimState { vsMode = Insert _ }) = WholeMatch $ do mr <- getRegisterE regName case mr of Nothing -> return () Just (Register _style rope) -> withCurrentBuffer $ insertRopeWithStyleB rope Inclusive return Continue f _ _ = NoMatch digraphBinding :: [(String, Char)] -> VimBinding digraphBinding digraphs = VimBindingE (f . T.unpack . _unEv) where f ('<':'C':'-':'k':'>':c1:c2:[]) (VimState { vsMode = Insert _ }) = WholeMatch $ do maybe (return ()) (withCurrentBuffer . insertB) $ charFromDigraph digraphs c1 c2 return Continue f ('<':'C':'-':'k':'>':_c1:[]) (VimState { vsMode = Insert _ }) = PartialMatch f "" (VimState { vsMode = Insert _ }) = PartialMatch f _ _ = NoMatch printable :: VimBinding printable = VimBindingE f where f evs state@(VimState { vsMode = Insert _ } ) = case selectBinding evs state (specials undefined) of NoMatch -> WholeMatch (printableAction evs) _ -> NoMatch f _ _ = NoMatch printableAction :: EventString -> EditorM RepeatToken printableAction evs = do saveInsertEventStringE evs currentCursor <- withCurrentBuffer pointB IndentSettings et _ sw <- withCurrentBuffer indentSettingsB secondaryCursors <- fmap vsSecondaryCursors getEditorDyn let allCursors = currentCursor :| secondaryCursors marks <- withCurrentBuffer $ forM' allCursors $ \cursor -> do moveTo cursor getMarkB Nothing -- Using autoindenting with multiple cursors -- is just too broken. let (insertB', insertN', deleteB', bdeleteB', deleteRegionB') = if null secondaryCursors then (BA.insertB, BA.insertN, BA.deleteB, BA.bdeleteB, BA.deleteRegionB) else (B.insertB, B.insertN, B.deleteB, B.bdeleteB, B.deleteRegionB) let bufAction = case T.unpack . _unEv $ evs of (c:[]) -> insertB' c "" -> do isOldLineEmpty <- isCurrentLineEmptyB shouldTrimOldLine <- isCurrentLineAllWhiteSpaceB if isOldLineEmpty then newlineB else if shouldTrimOldLine then savingPointB $ do moveToSol newlineB else do newlineB indentAsTheMostIndentedNeighborLineB firstNonSpaceB "" -> do if et then insertN' . R.fromString $ replicate sw ' ' else insertB' '\t' "" -> modifyIndentB (+ sw) "" -> modifyIndentB (max 0 . subtract sw) "" -> insertCharWithBelowB "" -> insertCharWithAboveB "" -> bdeleteB' "" -> bdeleteB' "" -> moveToSol "" -> moveToEol >> leftOnEol "" -> scrollScreensB (-1) "" -> scrollScreensB 1 "" -> deleteB' Character Forward "" -> deleteRegionB' =<< regionOfPartNonEmptyB unitViWordOnLine Backward "" -> bdeleteLineB "" -> insertB' '<' evs' -> error $ "Unhandled event " <> show evs' <> " in insert mode" updatedCursors <- withCurrentBuffer $ do updatedCursors <- forM' marks $ \mark -> do moveTo =<< use (markPointA mark) bufAction pointB mapM_ deleteMarkB $ toList marks moveTo $ head updatedCursors return $ toList updatedCursors modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 updatedCursors } return Continue where forM' :: Monad m => NonEmpty a -> (a -> m b) -> m (NonEmpty b) forM' (x :| xs) f = liftM2 (:|) (f x) (forM xs f) completionBinding :: VimBinding completionBinding = VimBindingE (f . T.unpack . _unEv) where f evs (VimState { vsMode = (Insert _) }) | evs `elem` ["", ""] = WholeMatch $ do let _direction = if evs == "" then Forward else Backward completeWordB FromAllBuffers return Continue f _ _ = NoMatch cursorBinding :: VimBinding cursorBinding = VimBindingE f where f evs (VimState { vsMode = (Insert _) }) | evs `elem` ["", "", "", ""] = WholeMatch $ do let WholeMatch (Move _style _isJump move) = stringToMove evs withCurrentBuffer $ move Nothing return Continue f _ _ = NoMatch yi-0.12.6/src/library/Yi/Keymap/Vim/MatchResult.hs0000644000000000000000000000200612717763531020005 0ustar0000000000000000{-# LANGUAGE DeriveFunctor #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.MatchResult -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.MatchResult where import Control.Applicative (Alternative ((<|>), empty), Applicative ((<*>), pure)) data MatchResult a = NoMatch | PartialMatch | WholeMatch a deriving Functor instance Applicative MatchResult where pure = WholeMatch WholeMatch f <*> WholeMatch x = WholeMatch (f x) _ <*> _ = NoMatch instance Alternative MatchResult where empty = NoMatch WholeMatch x <|> _ = WholeMatch x _ <|> WholeMatch x = WholeMatch x PartialMatch <|> _ = PartialMatch _ <|> PartialMatch = PartialMatch _ <|> _ = NoMatch instance Show (MatchResult a) where show (WholeMatch _) = "WholeMatch" show PartialMatch = "PartialMatch" show NoMatch = "NoMatch" yi-0.12.6/src/library/Yi/Keymap/Vim/Motion.hs0000644000000000000000000002134012717763531017021 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Operator -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- TODO: -- -- respecting wrap in gj, g0, etc -- -- gm, go -- ]], [[, [], ][ -- [(, [{, ]), ]} -- ]m, ]M, [m, [M -- [#, ]# -- [*, [/, ]*, ]/ -- -- Traversing changelist -- TODO: -- from vim help: -- -- Special case: "cw" and "cW" are treated like "ce" and "cE" if the cursor is -- on a non-blank. This is because "cw" is interpreted as change-word, and a -- word does not include the following white space. {Vi: "cw" when on a blank -- followed by other blanks changes only the first blank; this is probably a -- bug, because "dw" deletes all the blanks} -- -- Another special case: When using the "w" motion in combination with an -- operator and the last word moved over is at the end of a line, the end of -- that word becomes the end of the operated text, not the first word in the -- next line. -- -- The original Vi implementation of "e" is buggy. For example, the "e" command -- will stop on the first character of a line if the previous line was empty. -- But when you use "2e" this does not happen. In Vim "ee" and "2e" are the -- same, which is more logical. However, this causes a small incompatibility -- between Vi and Vim. module Yi.Keymap.Vim.Motion ( Move(..) , CountedMove(..) , stringToMove , regionOfMoveB , changeMoveStyle ) where import Prelude hiding (repeat) import Control.Applicative (Alternative ((<|>)), Applicative ((<*>)), (<$>)) import Control.Lens (Field3 (_3), over, use) import Control.Monad (replicateM_, void, when, (<=<)) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T (unpack) import Yi.Buffer.Adjusted import Yi.Keymap.Vim.Common (EventString (_unEv), MatchResult (..), lookupBestMatch) import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion) data Move = Move { moveStyle :: !RegionStyle , moveIsJump :: !Bool , moveAction :: Maybe Int -> BufferM () } data CountedMove = CountedMove !(Maybe Int) !Move stringToMove :: EventString -> MatchResult Move stringToMove s = lookupMove s -- TODO: get rid of unpack <|> matchGotoCharMove (T.unpack . _unEv $ s) <|> matchGotoMarkMove (T.unpack . _unEv $ s) lookupMove :: EventString -> MatchResult Move lookupMove s = findMoveWithStyle Exclusive exclusiveMotions <|> findMoveWithStyle Inclusive inclusiveMotions <|> findMoveWithStyle LineWise linewiseMotions where findMoveWithStyle style choices = fmap (uncurry (Move style)) (lookupBestMatch s (fmap regroup choices)) regroup (a, b, c) = (a, (b, c)) changeMoveStyle :: (RegionStyle -> RegionStyle) -> Move -> Move changeMoveStyle smod (Move s j m) = Move (smod s) j m -- Linewise motions which treat no count as being the same as a count of 1. linewiseMotions :: [(EventString, Bool, Maybe Int -> BufferM ())] linewiseMotions = fmap withDefaultCount [ ("j", False, void . lineMoveRel) , ("gj", False, void . lineMoveVisRel) , ("gk", False, void . lineMoveVisRel . negate) , ("k", False, void . lineMoveRel . negate) , ("", False, void . lineMoveRel) , ("", False, void . lineMoveRel . negate) , ("-", False, const firstNonSpaceB <=< void . lineMoveRel . negate) , ("+", False, const firstNonSpaceB <=< void . lineMoveRel) , ("_", False, \n -> do when (n > 1) $ void $ lineMoveRel (n - 1) firstNonSpaceB) , ("gg", True, void . gotoLn) -- TODO: save column , ("", False, scrollScreensB . negate) , ("", False, scrollScreensB . negate) , ("", False, scrollScreensB) , ("", False, scrollScreensB) , ("H", True, downFromTosB . pred) , ("M", True, const middleB) , ("L", True, upFromBosB . pred) ] <> [ ("G", True, gotoXOrEOF) ] -- Exclusive motions which treat no count as being the same as a count of 1. exclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())] exclusiveMotions = fmap withDefaultCount [ ("h", False, moveXorSol) , ("l", False, moveXorEol) , ("", False, moveXorSol) , ("", False, moveXorEol) , ("w", False, moveForwardB unitViWord) , ("W", False, moveForwardB unitViWORD) , ("b", False, moveBackwardB unitViWord) , ("B", False, moveBackwardB unitViWORD) , ("^", False, const firstNonSpaceB) , ("g^", False, const firstNonSpaceB) -- TODO: respect wrapping , ("g0", False, const moveToSol) -- TODO: respect wrapping , ("", False, const moveToSol) -- "0" sort of belongs here, but is currently handled as a special case in some modes , ("|", False, \n -> moveToSol >> moveXorEol (n - 1)) , ("(", True, moveBackwardB unitSentence) , (")", True, moveForwardB unitSentence) , ("{", True, moveBackwardB unitEmacsParagraph) , ("}", True, moveForwardB unitEmacsParagraph) ] -- Inclusive motions which treat no count as being the same as a count of 1. inclusiveMotions :: [(EventString, Bool, Maybe Int -> BufferM ())] inclusiveMotions = fmap (\(key, action) -> (key, False, action . fromMaybe 1)) [ -- Word motions ("e", repeat $ genMoveB unitViWord (Forward, InsideBound) Forward) , ("E", repeat $ genMoveB unitViWORD (Forward, InsideBound) Forward) , ("ge", repeat $ genMoveB unitViWord (Forward, InsideBound) Backward) , ("gE", repeat $ genMoveB unitViWORD (Forward, InsideBound) Backward) -- Intraline stuff , ("g$", \n -> do when (n > 1) $ void $ lineMoveRel (n - 1) moveToEol) , ("", const $ moveToEol >> leftOnEol) , ("$", \n -> do when (n > 1) $ void $ lineMoveRel (n - 1) moveToEol leftOnEol) , ("g_", \n -> do when (n > 1) $ void $ lineMoveRel (n - 1) lastNonSpaceB) ] <> [("%", True, \maybeCount -> case maybeCount of Nothing -> findMatchingPairB Just percent -> movePercentageFileB percent) ] repeat :: BufferM () -> Int -> BufferM () repeat = flip replicateM_ regionOfMoveB :: CountedMove -> BufferM StyledRegion regionOfMoveB = normalizeRegion <=< regionOfMoveB' regionOfMoveB' :: CountedMove -> BufferM StyledRegion regionOfMoveB' (CountedMove n (Move style _isJump move)) = do region <- mkRegion <$> pointB <*> destinationOfMoveB (move n >> when (style == Inclusive) leftOnEol) return $! StyledRegion style region moveForwardB, moveBackwardB :: TextUnit -> Int -> BufferM () moveForwardB unit = repeat $ genMoveB unit (Backward,InsideBound) Forward moveBackwardB unit = repeat $ moveB unit Backward gotoXOrEOF :: Maybe Int -> BufferM () gotoXOrEOF n = case n of Nothing -> botB >> moveToSol Just n' -> gotoLn n' >> moveToSol withDefaultCount :: (EventString, Bool, Int -> BufferM ()) -> (EventString, Bool, Maybe Int -> BufferM ()) withDefaultCount = over _3 (. fromMaybe 1) matchGotoMarkMove :: String -> MatchResult Move matchGotoMarkMove (m:_) | m `notElem` ['\'', '`'] = NoMatch matchGotoMarkMove (_:[]) = PartialMatch matchGotoMarkMove (m:c:[]) = WholeMatch $ Move style True action where style = if m == '`' then Inclusive else LineWise action _mcount = do mmark <- mayGetMarkB [c] case mmark of Nothing -> fail $ "Mark " <> show c <> " not set" Just mark -> moveTo =<< use (markPointA mark) matchGotoMarkMove _ = NoMatch matchGotoCharMove :: String -> MatchResult Move matchGotoCharMove (m:[]) | m `elem` ('f' : "FtT") = PartialMatch matchGotoCharMove (m:"") | m `elem` ('f' : "FtT") = matchGotoCharMove (m:"<") matchGotoCharMove (m:c:[]) | m `elem` ('f' : "FtT") = WholeMatch $ Move style False action where (dir, style, move) = case m of 'f' -> (Forward, Inclusive, nextCInLineInc c) 't' -> (Forward, Inclusive, nextCInLineExc c) 'F' -> (Backward, Exclusive, prevCInLineInc c) 'T' -> (Backward, Exclusive, prevCInLineExc c) _ -> error "can't happen" action mcount = do let count = fromMaybe 1 mcount p0 <- pointB replicateM_ (count - 1) $ do move moveB Character dir p1 <- pointB move p2 <- pointB when (p1 == p2) $ moveTo p0 matchGotoCharMove _ = NoMatch yi-0.12.6/src/library/Yi/Keymap/Vim/NormalMap.hs0000644000000000000000000005130712717763531017450 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.NormalMap -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.NormalMap (defNormalMap) where import Prelude hiding (lookup) import Control.Applicative ((<$>)) import Control.Lens (assign, use, (.=)) import Control.Monad (replicateM_, unless, void, when) import Data.Char (ord) import Data.HashMap.Strict (lookup, singleton) import Data.List (group) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid (mempty), (<>)) import qualified Data.Text as T (drop, empty, pack, replicate, unpack) import System.Directory (doesFileExist) import System.FriendlyPath (expandTilda) import Yi.Buffer.Adjusted hiding (Insert) import Yi.Core (closeWindow, quitEditor) import Yi.Editor import Yi.Event (Event (Event), Key (KASCII, KEnter, KEsc, KTab), Modifier (MCtrl)) import Yi.File (fwriteE, openNewFile) import Yi.History (historyPrefixSet, historyStart) import Yi.Keymap (YiM) import Yi.Keymap.Keys (char, ctrlCh, spec) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.Eval (scheduleActionStringForEval) import Yi.Keymap.Vim.Motion (CountedMove (CountedMove), regionOfMoveB, stringToMove) import Yi.Keymap.Vim.Operator (VimOperator (..), opChange, opDelete, opYank) import Yi.Keymap.Vim.Search (doVimSearch) import Yi.Keymap.Vim.StateUtils import Yi.Keymap.Vim.StyledRegion (StyledRegion (StyledRegion), transformCharactersInLineN) import Yi.Keymap.Vim.Tag (gotoTag, popTag) import Yi.Keymap.Vim.Utils import Yi.MiniBuffer (spawnMinibufferE) import Yi.Misc (printFileInfoE) import Yi.Monad (maybeM, whenM) import Yi.Regex (makeSearchOptsM, seInput) import qualified Yi.Rope as R (fromText, null, toString, toText) import Yi.Search (getRegexE, isearchInitE, makeSimpleSearch, setRegexE) import Yi.String (showT) import Yi.Tag (Tag (..)) import Yi.Utils (io) data EOLStickiness = Sticky | NonSticky deriving Eq mkDigitBinding :: Char -> VimBinding mkDigitBinding c = mkBindingE Normal Continue (char c, return (), mutate) where mutate vs@(VimState {vsCount = Nothing}) = vs { vsCount = Just d } mutate vs@(VimState {vsCount = Just count}) = vs { vsCount = Just $ count * 10 + d } d = ord c - ord '0' defNormalMap :: [VimOperator] -> [VimBinding] defNormalMap operators = [recordMacroBinding, finishRecordingMacroBinding, playMacroBinding] <> [zeroBinding, repeatBinding, motionBinding, searchBinding] <> [chooseRegisterBinding, setMarkBinding] <> fmap mkDigitBinding ['1' .. '9'] <> operatorBindings operators <> finishingBingings <> continuingBindings <> nonrepeatableBindings <> jumpBindings <> fileEditBindings <> [tabTraversalBinding] <> [tagJumpBinding, tagPopBinding] tagJumpBinding :: VimBinding tagJumpBinding = mkBindingY Normal (Event (KASCII ']') [MCtrl], f, id) where f = withCurrentBuffer readCurrentWordB >>= g . Tag . R.toText g tag = gotoTag tag 0 Nothing tagPopBinding :: VimBinding tagPopBinding = mkBindingY Normal (Event (KASCII 't') [MCtrl], f, id) where f = popTag motionBinding :: VimBinding motionBinding = mkMotionBinding Drop $ \m -> case m of Normal -> True _ -> False chooseRegisterBinding :: VimBinding chooseRegisterBinding = mkChooseRegisterBinding ((== Normal) . vsMode) zeroBinding :: VimBinding zeroBinding = VimBindingE f where f "0" (VimState {vsMode = Normal}) = WholeMatch $ do currentState <- getEditorDyn case vsCount currentState of Just c -> do setCountE (10 * c) return Continue Nothing -> do withCurrentBuffer moveToSol resetCountE withCurrentBuffer $ stickyEolA .= False return Drop f _ _ = NoMatch repeatBinding :: VimBinding repeatBinding = VimBindingE (f . T.unpack . _unEv) where f "." (VimState {vsMode = Normal}) = WholeMatch $ do currentState <- getEditorDyn case vsRepeatableAction currentState of Nothing -> return () Just (RepeatableAction prevCount (Ev actionString)) -> do let count = showT $ fromMaybe prevCount (vsCount currentState) scheduleActionStringForEval . Ev $ count <> actionString resetCountE return Drop f _ _ = NoMatch jumpBindings :: [VimBinding] jumpBindings = fmap (mkBindingE Normal Drop) [ (ctrlCh 'o', jumpBackE, id) , (spec KTab, jumpForwardE, id) , (ctrlCh '^', controlCarrot, resetCount) , (ctrlCh '6', controlCarrot, resetCount) ] where controlCarrot = alternateBufferE . (+ (-1)) =<< getCountE finishingBingings :: [VimBinding] finishingBingings = fmap (mkStringBindingE Normal Finish) [ ("x", cutCharE Forward NonSticky =<< getCountE, resetCount) , ("", cutCharE Forward NonSticky =<< getCountE, resetCount) , ("X", cutCharE Backward NonSticky =<< getCountE, resetCount) , ("D", do region <- withCurrentBuffer $ regionWithTwoMovesB (return ()) moveToEol void $ operatorApplyToRegionE opDelete 1 $ StyledRegion Exclusive region , id) -- Pasting , ("p", pasteAfter, id) , ("P", pasteBefore, id) -- Miscellaneous. , ("~", do count <- getCountE withCurrentBuffer $ do transformCharactersInLineN count switchCaseChar leftOnEol , resetCount) , ("J", do count <- fmap (flip (-) 1 . max 2) getCountE withCurrentBuffer $ do (StyledRegion s r) <- case stringToMove "j" of WholeMatch m -> regionOfMoveB $ CountedMove (Just count) m _ -> error "can't happen" void $ lineMoveRel $ count - 1 moveToEol joinLinesB =<< convertRegionToStyleB r s , resetCount) ] pasteBefore :: EditorM () pasteBefore = do -- TODO: use count register <- getRegisterE . vsActiveRegister =<< getEditorDyn case register of Nothing -> return () Just (Register LineWise rope) -> withCurrentBuffer $ unless (R.null rope) $ -- Beware of edge cases ahead insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise Just (Register style rope) -> withCurrentBuffer $ pasteInclusiveB rope style pasteAfter :: EditorM () pasteAfter = do -- TODO: use count register <- getRegisterE . vsActiveRegister =<< getEditorDyn case register of Nothing -> return () Just (Register LineWise rope) -> withCurrentBuffer $ do -- Beware of edge cases ahead moveToEol eof <- atEof when eof $ insertB '\n' rightB insertRopeWithStyleB (addNewLineIfNecessary rope) LineWise when eof $ savingPointB $ do newSize <- sizeB moveTo (newSize - 1) curChar <- readB when (curChar == '\n') $ deleteN 1 Just (Register style rope) -> withCurrentBuffer $ do whenM (fmap not atEol) rightB pasteInclusiveB rope style operatorBindings :: [VimOperator] -> [VimBinding] operatorBindings = fmap mkOperatorBinding where mkT (Op o) = (Ev o, return (), switchMode . NormalOperatorPending $ Op o) mkOperatorBinding (VimOperator {operatorName = opName}) = mkStringBindingE Normal Continue $ mkT opName continuingBindings :: [VimBinding] continuingBindings = fmap (mkStringBindingE Normal Continue) [ ("r", return (), switchMode ReplaceSingleChar) -- TODO make it just a binding -- Transition to insert mode , ("i", return (), switchMode $ Insert 'i') , ("", return (), switchMode $ Insert 'i') , ("I", withCurrentBuffer firstNonSpaceB, switchMode $ Insert 'I') , ("a", withCurrentBuffer $ moveXorEol 1, switchMode $ Insert 'a') , ("A", withCurrentBuffer moveToEol, switchMode $ Insert 'A') , ("o", withCurrentBuffer $ do moveToEol newlineB indentAsTheMostIndentedNeighborLineB , switchMode $ Insert 'o') , ("O", withCurrentBuffer $ do moveToSol newlineB leftB indentAsNextB , switchMode $ Insert 'O') -- Transition to visual , ("v", enableVisualE Inclusive, resetCount . switchMode (Visual Inclusive)) , ("V", enableVisualE LineWise, resetCount . switchMode (Visual LineWise)) , ("", enableVisualE Block, resetCount . switchMode (Visual Block)) ] nonrepeatableBindings :: [VimBinding] nonrepeatableBindings = fmap (mkBindingE Normal Drop) [ (spec KEsc, return (), resetCount) , (ctrlCh 'c', return (), resetCount) -- Changing , (char 'C', do region <- withCurrentBuffer $ regionWithTwoMovesB (return ()) moveToEol void $ operatorApplyToRegionE opChange 1 $ StyledRegion Exclusive region , switchMode $ Insert 'C') , (char 's', cutCharE Forward Sticky =<< getCountE, switchMode $ Insert 's') , (char 'S', do region <- withCurrentBuffer $ regionWithTwoMovesB firstNonSpaceB moveToEol void $ operatorApplyToRegionE opDelete 1 $ StyledRegion Exclusive region , switchMode $ Insert 'S') -- Replacing , (char 'R', return (), switchMode Replace) -- Yanking , ( char 'Y' , do region <- withCurrentBuffer $ regionWithTwoMovesB (return ()) moveToEol void $ operatorApplyToRegionE opYank 1 $ StyledRegion Exclusive region , id ) -- Search , (char '*', addVimJumpHereE >> searchWordE True Forward, resetCount) , (char '#', addVimJumpHereE >> searchWordE True Backward, resetCount) , (char 'n', addVimJumpHereE >> withCount (continueSearching id), resetCount) , (char 'N', addVimJumpHereE >> withCount (continueSearching reverseDir), resetCount) , (char ';', repeatGotoCharE id, id) , (char ',', repeatGotoCharE reverseDir, id) -- Repeat , (char '&', return (), id) -- TODO -- Transition to ex , (char ':', do void (spawnMinibufferE ":" id) historyStart historyPrefixSet "" , switchMode Ex) -- Undo , (char 'u', withCountOnBuffer undoB >> withCurrentBuffer leftOnEol, id) , (char 'U', withCountOnBuffer undoB >> withCurrentBuffer leftOnEol, id) -- TODO , (ctrlCh 'r', withCountOnBuffer redoB >> withCurrentBuffer leftOnEol, id) -- scrolling ,(ctrlCh 'b', getCountE >>= withCurrentBuffer . upScreensB, id) ,(ctrlCh 'f', getCountE >>= withCurrentBuffer . downScreensB, id) ,(ctrlCh 'u', getCountE >>= withCurrentBuffer . vimScrollByB (negate . (`div` 2)), id) ,(ctrlCh 'd', getCountE >>= withCurrentBuffer . vimScrollByB (`div` 2), id) ,(ctrlCh 'y', getCountE >>= withCurrentBuffer . vimScrollB . negate, id) ,(ctrlCh 'e', getCountE >>= withCurrentBuffer . vimScrollB, id) -- unsorted TODO , (char '-', return (), id) , (char '+', return (), id) , (spec KEnter, return (), id) ] <> fmap (mkStringBindingE Normal Drop) [ ("g*", searchWordE False Forward, resetCount) , ("g#", searchWordE False Backward, resetCount) , ("gd", withCurrentBuffer $ withModeB modeGotoDeclaration, resetCount) , ("gD", withCurrentBuffer $ withModeB modeGotoDeclaration, resetCount) , ("", printFileInfoE, resetCount) , ("c", tryCloseE, resetCount) , ("o", closeOtherE, resetCount) , ("s", splitE, resetCount) , ("w", nextWinE, resetCount) , ("", nextWinE, resetCount) -- TODO: please implement downWinE , ("", nextWinE, resetCount) -- TODO: please implement rightWinE , ("", nextWinE, resetCount) , ("W", prevWinE, resetCount) , ("p", prevWinE, resetCount) , ("", prevWinE, resetCount) -- TODO: please implement upWinE , ("", prevWinE, resetCount) -- TODO: please implement leftWinE , ("l", layoutManagersNextE, resetCount) , ("L", layoutManagersPreviousE, resetCount) --, (" ", layoutManagersNextE, resetCount) , ("v", layoutManagerNextVariantE, resetCount) , ("V", layoutManagerPreviousVariantE, resetCount) , ("", getCountE >>= withCurrentBuffer . incrementNextNumberByB, resetCount) , ("", getCountE >>= withCurrentBuffer . incrementNextNumberByB . negate, resetCount) -- z commands -- TODO Add prefix count , ("zt", withCurrentBuffer scrollCursorToTopB, resetCount) , ("zb", withCurrentBuffer scrollCursorToBottomB, resetCount) , ("zz", withCurrentBuffer scrollToCursorB, resetCount) {- -- TODO Horizantal scrolling , ("ze", withCurrentBuffer .., resetCount) , ("zs", withCurrentBuffer .., resetCount) , ("zH", withCurrentBuffer .., resetCount) , ("zL", withCurrentBuffer .., resetCount) , ("zh", withCurrentBuffer .., resetCount) , ("zl", withCurrentBuffer .., resetCount) -} , ("z.", withCurrentBuffer $ scrollToCursorB >> moveToSol, resetCount) , ("z+", withCurrentBuffer scrollToLineBelowWindowB, resetCount) , ("z-", withCurrentBuffer $ scrollCursorToBottomB >> moveToSol, resetCount) , ("z^", withCurrentBuffer scrollToLineAboveWindowB, resetCount) {- -- TODO Code folding , ("zf", .., resetCount) , ("zc", .., resetCount) , ("zo", .., resetCount) , ("za", .., resetCount) , ("zC", .., resetCount) , ("zO", .., resetCount) , ("zA", .., resetCount) , ("zr", .., resetCount) , ("zR", .., resetCount) , ("zm", .., resetCount) , ("zM", .., resetCount) -} -- Z commands ] <> fmap (mkStringBindingY Normal) [ ("ZQ", quitEditor, id) -- TODO ZZ should replicate :x not :wq , ("ZZ", fwriteE >> closeWindow, id) ] fileEditBindings :: [VimBinding] fileEditBindings = fmap (mkStringBindingY Normal) [ ("gf", openFileUnderCursor Nothing, resetCount) , ("gf", openFileUnderCursor $ Just newTabE, resetCount) , ("f", openFileUnderCursor $ Just (splitE >> prevWinE), resetCount) ] setMarkBinding :: VimBinding setMarkBinding = VimBindingE (f . T.unpack . _unEv) where f _ s | vsMode s /= Normal = NoMatch f "m" _ = PartialMatch f ('m':c:[]) _ = WholeMatch $ do withCurrentBuffer $ setNamedMarkHereB [c] return Drop f _ _ = NoMatch searchWordE :: Bool -> Direction -> EditorM () searchWordE wholeWord dir = do word <- withCurrentBuffer readCurrentWordB let search re = do setRegexE re assign searchDirectionA dir withCount $ continueSearching (const dir) if wholeWord then case makeSearchOptsM [] $ "\\<" <> R.toString word <> "\\>" of Right re -> search re Left _ -> return () else search $ makeSimpleSearch word searchBinding :: VimBinding searchBinding = VimBindingE (f . T.unpack . _unEv) where f evs (VimState { vsMode = Normal }) | evs `elem` group ['/', '?'] = WholeMatch $ do state <- fmap vsMode getEditorDyn let dir = if evs == "/" then Forward else Backward switchModeE $ Search state dir isearchInitE dir historyStart historyPrefixSet T.empty return Continue f _ _ = NoMatch continueSearching :: (Direction -> Direction) -> EditorM () continueSearching fdir = getRegexE >>= \case Just regex -> do dir <- fdir <$> use searchDirectionA printMsg . T.pack $ (if dir == Forward then '/' else '?') : seInput regex void $ doVimSearch Nothing [] dir Nothing -> printMsg "No previous search pattern" repeatGotoCharE :: (Direction -> Direction) -> EditorM () repeatGotoCharE mutateDir = do prevCommand <- fmap vsLastGotoCharCommand getEditorDyn count <- getCountE withCurrentBuffer $ case prevCommand of Just (GotoCharCommand c dir style) -> do let newDir = mutateDir dir let move = gotoCharacterB c newDir style True p0 <- pointB replicateM_ (count - 1) $ do move when (style == Exclusive) $ moveB Character newDir p1 <- pointB move p2 <- pointB when (p1 == p2) $ moveTo p0 Nothing -> return () enableVisualE :: RegionStyle -> EditorM () enableVisualE style = withCurrentBuffer $ do putRegionStyle style rectangleSelectionA .= (Block == style) setVisibleSelection True pointB >>= setSelectionMarkPointB cutCharE :: Direction -> EOLStickiness -> Int -> EditorM () cutCharE dir stickiness count = do r <- withCurrentBuffer $ do p0 <- pointB (if dir == Forward then moveXorEol else moveXorSol) count p1 <- pointB let region = mkRegion p0 p1 rope <- readRegionB region deleteRegionB $ mkRegion p0 p1 when (stickiness == NonSticky) leftOnEol return rope regName <- fmap vsActiveRegister getEditorDyn setRegisterE regName Inclusive r tabTraversalBinding :: VimBinding tabTraversalBinding = VimBindingE (f . T.unpack . _unEv) where f "g" (VimState { vsMode = Normal }) = PartialMatch f ('g':c:[]) (VimState { vsMode = Normal }) | c `elem` ['t', 'T'] = WholeMatch $ do count <- getCountE replicateM_ count $ if c == 'T' then previousTabE else nextTabE resetCountE return Drop f _ _ = NoMatch openFileUnderCursor :: Maybe (EditorM ()) -> YiM () openFileUnderCursor editorAction = do fileName <- fmap R.toString . withCurrentBuffer $ readUnitB unitViWORD fileExists <- io $ doesFileExist =<< expandTilda fileName if fileExists then do maybeM withEditor editorAction openNewFile $ fileName else withEditor . fail $ "Can't find file \"" <> fileName <> "\"" recordMacroBinding :: VimBinding recordMacroBinding = VimBindingE (f . T.unpack . _unEv) where f "q" (VimState { vsMode = Normal , vsCurrentMacroRecording = Nothing }) = PartialMatch f ['q', c] (VimState { vsMode = Normal }) = WholeMatch $ do modifyStateE $ \s -> s { vsCurrentMacroRecording = Just (c, mempty) } return Finish f _ _ = NoMatch finishRecordingMacroBinding :: VimBinding finishRecordingMacroBinding = VimBindingE (f . T.unpack . _unEv) where f "q" (VimState { vsMode = Normal , vsCurrentMacroRecording = Just (macroName, Ev macroBody) }) = WholeMatch $ do let reg = Register Exclusive (R.fromText (T.drop 2 macroBody)) modifyStateE $ \s -> s { vsCurrentMacroRecording = Nothing , vsRegisterMap = singleton macroName reg <> vsRegisterMap s } return Finish f _ _ = NoMatch playMacroBinding :: VimBinding playMacroBinding = VimBindingE (f . T.unpack . _unEv) where f "@" (VimState { vsMode = Normal }) = PartialMatch f ['@', c] (VimState { vsMode = Normal , vsRegisterMap = registers , vsCount = mbCount }) = WholeMatch $ do resetCountE case lookup c registers of Just (Register _ evs) -> do let count = fromMaybe 1 mbCount mkAct = Ev . T.replicate count . R.toText scheduleActionStringForEval . mkAct $ evs return Finish Nothing -> return Drop f _ _ = NoMatch -- TODO: withCount name implies that parameter has type (Int -> EditorM ()) -- Is there a better name for this function? withCount :: EditorM () -> EditorM () withCount action = flip replicateM_ action =<< getCountE withCountOnBuffer :: BufferM () -> EditorM () withCountOnBuffer action = withCount $ withCurrentBuffer action yi-0.12.6/src/library/Yi/Keymap/Vim/NormalOperatorPendingMap.hs0000644000000000000000000001626212717772136022473 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.NormalOperatorPendingMap -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.NormalOperatorPendingMap (defNormalOperatorPendingMap) where import Control.Applicative ((<$>)) import Control.Monad (void, when) import Data.Char (isDigit) import Data.List (isPrefixOf) import Data.Maybe (fromJust, fromMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T (init, last, pack, snoc, unpack) import Yi.Buffer.Adjusted hiding (Insert) import Yi.Editor (getEditorDyn, withCurrentBuffer) import Yi.Keymap.Keys (Key (KEsc), spec) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.Motion import Yi.Keymap.Vim.Operator import Yi.Keymap.Vim.StateUtils import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion) import Yi.Keymap.Vim.TextObject import Yi.Keymap.Vim.Utils (mkBindingE) defNormalOperatorPendingMap :: [VimOperator] -> [VimBinding] defNormalOperatorPendingMap operators = [textObject operators, escBinding] textObject :: [VimOperator] -> VimBinding textObject operators = VimBindingE f where f evs vs = case vsMode vs of NormalOperatorPending _ -> WholeMatch $ action evs _ -> NoMatch action (Ev evs) = do currentState <- getEditorDyn let partial = vsTextObjectAccumulator currentState opChar = Ev . T.pack $ lastCharForOperator op op = fromJust $ stringToOperator operators opname (NormalOperatorPending opname) = vsMode currentState -- vim treats cw as ce let evs' = if opname == Op "c" && T.last evs == 'w' && (case parseOperand opChar (evr evs) of JustMove _ -> True _ -> False) then T.init evs `T.snoc` 'e' else evs -- TODO: fix parseOperand to take EventString as second arg evr x = T.unpack . _unEv $ partial <> Ev x operand = parseOperand opChar (evr evs') case operand of NoOperand -> do dropTextObjectAccumulatorE resetCountE switchModeE Normal return Drop PartialOperand -> do accumulateTextObjectEventE (Ev evs) return Continue _ -> do count <- getCountE dropTextObjectAccumulatorE token <- case operand of JustTextObject cto@(CountedTextObject n _) -> do normalizeCountE (Just n) operatorApplyToTextObjectE op 1 $ changeTextObjectCount (count * n) cto JustMove (CountedMove n m) -> do mcount <- getMaybeCountE normalizeCountE n region <- withCurrentBuffer $ regionOfMoveB $ CountedMove (maybeMult mcount n) m operatorApplyToRegionE op 1 region JustOperator n style -> do normalizeCountE (Just n) normalizedCount <- getCountE region <- withCurrentBuffer $ regionForOperatorLineB normalizedCount style curPoint <- withCurrentBuffer pointB token <- operatorApplyToRegionE op 1 region when (opname == Op "y") $ withCurrentBuffer $ moveTo curPoint return token _ -> error "can't happen" resetCountE return token regionForOperatorLineB :: Int -> RegionStyle -> BufferM StyledRegion regionForOperatorLineB n style = normalizeRegion =<< StyledRegion style <$> savingPointB (do current <- pointB if n == 1 then do firstNonSpaceB p0 <- pointB return $! mkRegion p0 current else do void $ lineMoveRel (n-2) moveToEol rightB firstNonSpaceB p1 <- pointB return $! mkRegion current p1) escBinding :: VimBinding escBinding = mkBindingE ReplaceSingleChar Drop (spec KEsc, return (), resetCount . switchMode Normal) data OperandParseResult = JustTextObject !CountedTextObject | JustMove !CountedMove | JustOperator !Int !RegionStyle -- ^ like dd and d2vd | PartialOperand | NoOperand parseOperand :: EventString -> String -> OperandParseResult parseOperand opChar s = parseCommand mcount styleMod opChar commandString where (mcount, styleModString, commandString) = splitCountModifierCommand s styleMod = case styleModString of "" -> id "V" -> const LineWise "" -> const Block "v" -> \style -> case style of Exclusive -> Inclusive _ -> Exclusive _ -> error "Can't happen" -- | TODO: should this String be EventString? parseCommand :: Maybe Int -> (RegionStyle -> RegionStyle) -> EventString -> String -> OperandParseResult parseCommand _ _ _ "" = PartialOperand parseCommand _ _ _ "i" = PartialOperand parseCommand _ _ _ "a" = PartialOperand parseCommand _ _ _ "g" = PartialOperand parseCommand n sm o s | o' == s = JustOperator (fromMaybe 1 n) (sm LineWise) where o' = T.unpack . _unEv $ o parseCommand n sm _ "0" = let m = Move Exclusive False (const moveToSol) in JustMove (CountedMove n (changeMoveStyle sm m)) parseCommand n sm _ s = case stringToMove . Ev $ T.pack s of WholeMatch m -> JustMove $ CountedMove n $ changeMoveStyle sm m PartialMatch -> PartialOperand NoMatch -> case stringToTextObject s of Just to -> JustTextObject $ CountedTextObject (fromMaybe 1 n) $ changeTextObjectStyle sm to Nothing -> NoOperand -- TODO: setup doctests -- Parse event string that can go after operator -- w -> (Nothing, "", "w") -- 2w -> (Just 2, "", "w") -- V2w -> (Just 2, "V", "w") -- v2V3w -> (Just 6, "", "w") -- vvvvvvvvvvvvvw -> (Nothing, "v", "w") -- 0 -> (Nothing, "", "0") -- V0 -> (Nothing, "V", "0") splitCountModifierCommand :: String -> (Maybe Int, String, String) splitCountModifierCommand = go "" Nothing [""] where go "" Nothing mods "0" = (Nothing, head mods, "0") go ds count mods (h:t) | isDigit h = go (ds <> [h]) count mods t go ds@(_:_) count mods s@(h:_) | not (isDigit h) = go [] (maybeMult count (Just (read ds))) mods s go [] count mods (h:t) | h `elem` ['v', 'V'] = go [] count ([h]:mods) t go [] count mods s | "" `isPrefixOf` s = go [] count ("":mods) (drop 5 s) go [] count mods s = (count, head mods, s) go ds count mods [] = (maybeMult count (Just (read ds)), head mods, []) go (_:_) _ _ (_:_) = error "Can't happen because isDigit and not isDigit cover every case" yi-0.12.6/src/library/Yi/Keymap/Vim/Operator.hs0000644000000000000000000002134712717772136017357 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Operator -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Implements some operators for the Vim keymap. module Yi.Keymap.Vim.Operator ( VimOperator(..) , defOperators , opDelete , opChange , opYank , opFormat , stringToOperator , mkCharTransformOperator , operatorApplyToTextObjectE , lastCharForOperator ) where import Control.Applicative ((<$>)) import Control.Monad (when) import Data.Char (isSpace, toLower, toUpper) import Data.Foldable (find) import Data.Maybe (fromJust) import Data.Monoid ((<>)) import qualified Data.Text as T (unpack) import Yi.Buffer.Adjusted hiding (Insert) import Yi.Editor (EditorM, getEditorDyn, withCurrentBuffer) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents) import Yi.Keymap.Vim.StateUtils (setRegisterE, switchModeE) import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), transformCharactersInRegionB) import Yi.Keymap.Vim.TextObject (CountedTextObject, regionOfTextObjectB) import Yi.Keymap.Vim.Utils (indentBlockRegionB) import Yi.Misc (rot13Char) import Yi.Rope (YiString) import qualified Yi.Rope as R data VimOperator = VimOperator { operatorName :: !OperatorName , operatorApplyToRegionE :: Int -> StyledRegion -> EditorM RepeatToken } defOperators :: [VimOperator] defOperators = [ opYank , opDelete , opChange , opFormat , mkCharTransformOperator "gu" toLower , mkCharTransformOperator "gU" toUpper , mkCharTransformOperator "g~" switchCaseChar , mkCharTransformOperator "g?" rot13Char , mkShiftOperator ">" id , mkShiftOperator "" negate ] stringToOperator :: [VimOperator] -> OperatorName -> Maybe VimOperator stringToOperator ops name = find ((== name) . operatorName) ops operatorApplyToTextObjectE :: VimOperator -> Int -> CountedTextObject -> EditorM RepeatToken operatorApplyToTextObjectE op count cto = do styledRegion <- withCurrentBuffer $ regionOfTextObjectB cto operatorApplyToRegionE op count styledRegion opYank :: VimOperator opYank = VimOperator { operatorName = "y" , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do s <- withCurrentBuffer $ readRegionRopeWithStyleB reg style regName <- fmap vsActiveRegister getEditorDyn setRegisterE regName style s withCurrentBuffer $ moveTo . regionStart =<< convertRegionToStyleB reg style switchModeE Normal return Finish } opDelete :: VimOperator opDelete = VimOperator { operatorName = "d" , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do s <- withCurrentBuffer $ readRegionRopeWithStyleB reg style regName <- fmap vsActiveRegister getEditorDyn setRegisterE regName style s withCurrentBuffer $ do point <- deleteRegionWithStyleB reg style moveTo point eof <- atEof if eof then do leftB c <- readB when (c == '\n') $ deleteN 1 >> moveToSol else leftOnEol switchModeE Normal return Finish } opChange :: VimOperator opChange = VimOperator { operatorName = "c" , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do s <- withCurrentBuffer $ readRegionRopeWithStyleB reg style regName <- fmap vsActiveRegister getEditorDyn setRegisterE regName style s withCurrentBuffer $ do point <- deleteRegionWithStyleB reg style moveTo point when (style == LineWise) $ do insertB '\n' leftB switchModeE $ Insert 'c' return Continue } opFormat :: VimOperator opFormat = VimOperator { operatorName = "gq" , operatorApplyToRegionE = \_count (StyledRegion style reg) -> do withCurrentBuffer $ formatRegionB style reg switchModeE Normal return Finish } formatRegionB :: RegionStyle -> Region -> BufferM () formatRegionB Block _reg = return () formatRegionB _style reg = do 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 { operatorName = name , operatorApplyToRegionE = \count sreg -> do withCurrentBuffer $ transformCharactersInRegionB sreg $ foldr (.) id (replicate count f) switchModeE Normal return Finish } mkShiftOperator :: OperatorName -> (Int -> Int) -> VimOperator mkShiftOperator name countMod = VimOperator { operatorName = name , operatorApplyToRegionE = \count (StyledRegion style reg) -> do withCurrentBuffer $ if style == Block then indentBlockRegionB (countMod count) reg else do reg' <- convertRegionToStyleB reg style shiftIndentOfRegionB (countMod count) reg' switchModeE Normal return Finish } lastCharForOperator :: VimOperator -> String lastCharForOperator (VimOperator { operatorName = name }) -- This cast here seems stupid, maybe we should only have one -- type? = case parseEvents (Ev . _unOp $ name) of [] -> error $ "invalid operator name " <> T.unpack (_unOp name) evs -> T.unpack . _unEv . eventToEventString $ last evs yi-0.12.6/src/library/Yi/Keymap/Vim/ReplaceMap.hs0000644000000000000000000000607312717763531017573 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.ReplaceMap -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.ReplaceMap (defReplaceMap) where import Control.Monad (replicateM_, when) import Data.Monoid (Monoid (mempty), (<>)) import qualified Data.Text as T (unpack) import Yi.Buffer.Adjusted import Yi.Editor (EditorM, getEditorDyn, withCurrentBuffer) import Yi.Keymap.Keys (Key (KEsc), ctrlCh, spec) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.EventUtils (eventToEventString, parseEvents) import Yi.Keymap.Vim.StateUtils import Yi.Keymap.Vim.Utils (mkBindingE) defReplaceMap :: [VimBinding] defReplaceMap = specials <> [printable] specials :: [VimBinding] specials = fmap (mkBindingE Replace Finish) [ (spec KEsc, exitReplaceMode, resetCount . switchMode Normal) , (ctrlCh 'c', exitReplaceMode, resetCount . switchMode Normal) ] exitReplaceMode :: EditorM () exitReplaceMode = do count <- getCountE when (count > 1) $ do inputEvents <- fmap (parseEvents . vsOngoingInsertEvents) getEditorDyn replicateM_ (count - 1) $ mapM_ (printableAction . eventToEventString) inputEvents modifyStateE $ \s -> s { vsOngoingInsertEvents = mempty } withCurrentBuffer $ moveXorSol 1 printable :: VimBinding printable = VimBindingE f where f evs s | Replace == vsMode s = WholeMatch $ printableAction evs f _ _ = NoMatch printableAction :: EventString -> EditorM RepeatToken printableAction evs = do saveInsertEventStringE evs withCurrentBuffer $ case T.unpack . _unEv $ evs of [c] -> insertOrReplaceB c "" -> insertOrReplaceB '\n' -- For testing purposes assume noexpandtab, tw=4 "" -> replicateM_ 4 $ insertOrReplaceB ' ' "" -> return () -- TODO "" -> return () -- TODO "" -> insertOrReplaceCharWithBelowB "" -> insertOrReplaceCharWithAboveB "" -> return () -- TODO "" -> return () -- TODO "" -> return () -- TODO "" -> return () -- TODO "" -> return () -- TODO "" -> return () -- TODO evs' -> error $ "Unhandled event " <> evs' <> " in replace mode" return Continue insertOrReplaceB :: Char -> BufferM () insertOrReplaceB c = do currentChar <- readB if currentChar == '\n' then insertB c else replaceCharB c rightB insertOrReplaceCharWithBelowB :: BufferM () insertOrReplaceCharWithBelowB = do currentChar <- readB if currentChar == '\n' then insertCharWithBelowB else replaceCharWithBelowB rightB insertOrReplaceCharWithAboveB :: BufferM () insertOrReplaceCharWithAboveB = do currentChar <- readB if currentChar == '\n' then insertCharWithAboveB else replaceCharWithAboveB rightB yi-0.12.6/src/library/Yi/Keymap/Vim/ReplaceSingleCharMap.hs0000644000000000000000000000414012717763531021524 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.ReplaceSingleCharMap -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.ReplaceSingleCharMap ( defReplaceSingleMap ) where import Control.Monad (replicateM_, when) import Data.Maybe (fromMaybe) import qualified Data.Text as T (unpack) import Yi.Buffer.Adjusted import Yi.Editor (getEditorDyn, withCurrentBuffer) import Yi.Keymap.Keys (Key (KEsc), spec) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.StateUtils (resetCount, resetCountE, switchMode, switchModeE) import Yi.Keymap.Vim.Utils (mkBindingE) import Yi.Utils (SemiNum ((~-))) defReplaceSingleMap :: [VimBinding] defReplaceSingleMap = [escBinding, actualReplaceBinding] escBinding :: VimBinding escBinding = mkBindingE ReplaceSingleChar Drop (spec KEsc, return (), resetCount . switchMode Normal) actualReplaceBinding :: VimBinding actualReplaceBinding = VimBindingE (f . T.unpack . _unEv) where f evs s | ReplaceSingleChar == vsMode s = WholeMatch $ do currentState <- getEditorDyn let count = fromMaybe 1 $ vsCount currentState let replacer = case evs of (c:[]) -> replaceCharB c "" -> replaceCharB '<' "" -> replaceCharWithBelowB "" -> replaceCharWithAboveB _ -> return () withCurrentBuffer $ do -- Is there more easy way to get distance to eol? here <- pointB moveToEol eol <- pointB moveTo here let effectiveCount = min count (fromSize $ eol ~- here) when (effectiveCount > 0) $ do replicateM_ effectiveCount $ replacer >> rightB leftB resetCountE switchModeE Normal return Finish f _ _ = NoMatch yi-0.12.6/src/library/Yi/Keymap/Vim/Search.hs0000644000000000000000000000323212717763531016761 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Search -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Search (doVimSearch, continueVimSearch) where import Data.Maybe (listToMaybe) import Data.Text () import Yi.Buffer.Adjusted import Yi.Editor (EditorM, printMsg, withCurrentBuffer) import Yi.Search (SearchOption, getRegexE, searchInit) doVimSearch :: Maybe String -> [SearchOption] -> Direction -> EditorM () doVimSearch Nothing _ dir = do mbRegex <- getRegexE case mbRegex of Just regex -> withCurrentBuffer $ continueVimSearch (regex, dir) Nothing -> printMsg "No previous search pattern" doVimSearch (Just needle) opts dir = searchInit needle dir opts >>= withCurrentBuffer . continueVimSearch continueVimSearch :: (SearchExp, Direction) -> BufferM () continueVimSearch (searchExp, dir) = do mp <- savingPointB $ do moveB Character dir -- start immed. after cursor rs <- regexB dir searchExp moveB Document (reverseDir dir) -- wrap around ls <- regexB dir searchExp return $ listToMaybe $ rs ++ ls -- regionFirst doesn't work right here, because something inside -- Buffer.Implementation.regexRegionBI breaks Region invariant and -- may return Region (Forward, A, B) where A > B -- TODO: investigate maybe (return ()) (moveTo . regionFirst') mp regionFirst' :: Region -> Point regionFirst' r = Point $ min a b where a = fromPoint $ regionStart r b = fromPoint $ regionEnd r yi-0.12.6/src/library/Yi/Keymap/Vim/SearchMotionMap.hs0000644000000000000000000000627612717763531020620 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.SearchMotionMap -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.SearchMotionMap (defSearchMotionMap) where import Control.Applicative ((<$)) import Control.Monad (replicateM_) import Data.Maybe (fromMaybe) import qualified Data.Text as T (pack, unpack) import Yi.Buffer.Adjusted (Direction (Backward, Forward), elemsB) import Yi.Editor (getEditorDyn, withCurrentBuffer) import Yi.History (historyFinish, historyPrefixSet) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.Search (continueVimSearch) import Yi.Keymap.Vim.StateUtils (getCountE, switchModeE) import Yi.Keymap.Vim.Utils (matchFromBool) import qualified Yi.Rope as R (toText) import Yi.Search defSearchMotionMap :: [VimBinding] defSearchMotionMap = [enterBinding, editBinding, exitBinding] enterBinding :: VimBinding enterBinding = VimBindingE f where f "" (VimState { vsMode = Search {}} ) = WholeMatch $ do Search prevMode dir <- fmap vsMode getEditorDyn -- TODO: parse cmd into regex and flags isearchFinishE historyFinish switchModeE prevMode count <- getCountE getRegexE >>= \case Nothing -> return () Just regex -> withCurrentBuffer $ if count == 1 && dir == Forward then do -- Workaround for isearchFinishE leaving cursor after match continueVimSearch (regex, Backward) continueVimSearch (regex, Forward) else replicateM_ (count - 1) $ continueVimSearch (regex, dir) case prevMode of Visual _ -> return Continue _ -> return Finish f _ _ = NoMatch editBinding :: VimBinding editBinding = VimBindingE (f . T.unpack . _unEv) where f evs (VimState { vsMode = Search {}} ) = action evs <$ matchFromBool (evs `elem` fmap (T.unpack . fst) binds || null (drop 1 evs)) f _ _ = NoMatch action evs = do let evs' = T.pack evs fromMaybe (isearchAddE evs') (lookup evs' binds) withCurrentBuffer elemsB >>= historyPrefixSet . R.toText return Continue binds = [ ("", isearchDelE) , ("", isearchDelE) , ("", isearchHistory 1) , ("", isearchHistory 1) , ("", isearchHistory (-1)) , ("", isearchHistory (-1)) , ("", isearchAddE "<") ] exitBinding :: VimBinding exitBinding = VimBindingE f where f _ (VimState { vsMode = Search {}} ) = WholeMatch $ do Search prevMode _dir <- fmap vsMode getEditorDyn isearchCancelE switchModeE prevMode return Drop f _ _ = NoMatch yi-0.12.6/src/library/Yi/Keymap/Vim/StateUtils.hs0000644000000000000000000001404112717763531017655 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.StateUtils -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.StateUtils ( switchMode , switchModeE , resetCount , resetCountE , setCountE , modifyStateE , getMaybeCountE , getCountE , accumulateEventE , accumulateBindingEventE , accumulateTextObjectEventE , flushAccumulatorE , dropAccumulatorE , dropBindingAccumulatorE , dropTextObjectAccumulatorE , setRegisterE , getRegisterE , normalizeCountE , maybeMult , updateModeIndicatorE , saveInsertEventStringE , resetActiveRegisterE ) where import Control.Applicative ((<$>)) import Control.Monad (when) import qualified Data.HashMap.Strict as HM (insert, lookup) import Data.Maybe (fromMaybe, isJust) import Data.Monoid (Monoid (mempty), (<>)) import qualified Data.Text as T (null) import Yi.Buffer.Normal (RegionStyle (Block, LineWise)) import Yi.Editor (EditorM, getEditorDyn, putEditorDyn, setStatus) import Yi.Event (Event) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.EventUtils import Yi.Rope (YiString) import Yi.String (showT) import Yi.Style (defaultStyle) switchMode :: VimMode -> VimState -> VimState switchMode mode state = state { vsMode = mode } switchModeE :: VimMode -> EditorM () switchModeE mode = modifyStateE $ switchMode mode modifyStateE :: (VimState -> VimState) -> EditorM () modifyStateE f = do currentState <- getEditorDyn putEditorDyn $ f currentState resetCount :: VimState -> VimState resetCount s = s { vsCount = Nothing } resetCountE :: EditorM () resetCountE = modifyStateE resetCount getMaybeCountE :: EditorM (Maybe Int) getMaybeCountE = fmap vsCount getEditorDyn getCountE :: EditorM Int getCountE = do currentState <- getEditorDyn return $! fromMaybe 1 (vsCount currentState) setCountE :: Int -> EditorM () setCountE n = modifyStateE $ \s -> s { vsCount = Just n } accumulateBindingEventE :: Event -> EditorM () accumulateBindingEventE e = modifyStateE $ \s -> s { vsBindingAccumulator = vsBindingAccumulator s <> eventToEventString e } accumulateEventE :: Event -> EditorM () accumulateEventE e = modifyStateE $ \s -> s { vsAccumulator = vsAccumulator s <> eventToEventString e } accumulateTextObjectEventE :: EventString -> EditorM () accumulateTextObjectEventE evs = modifyStateE $ \s -> s { vsTextObjectAccumulator = vsTextObjectAccumulator s <> evs } flushAccumulatorE :: EditorM () flushAccumulatorE = do accum <- vsAccumulator <$> getEditorDyn let repeatableAction = stringToRepeatableAction accum modifyStateE $ \s -> s { vsRepeatableAction = Just repeatableAction , vsAccumulator = mempty , vsCurrentMacroRecording = fmap (fmap (<> accum)) (vsCurrentMacroRecording s) } dropAccumulatorE :: EditorM () dropAccumulatorE = modifyStateE $ \s -> let accum = vsAccumulator s in s { vsAccumulator = mempty , vsCurrentMacroRecording = fmap (fmap (<> accum)) (vsCurrentMacroRecording s) } dropBindingAccumulatorE :: EditorM () dropBindingAccumulatorE = modifyStateE $ \s -> s { vsBindingAccumulator = mempty } dropTextObjectAccumulatorE :: EditorM () dropTextObjectAccumulatorE = modifyStateE $ \s -> s { vsTextObjectAccumulator = mempty } getRegisterE :: RegisterName -> EditorM (Maybe Register) getRegisterE name = fmap (HM.lookup name . vsRegisterMap) getEditorDyn setRegisterE :: RegisterName -> RegionStyle -> YiString -> EditorM () setRegisterE name style rope = do rmap <- fmap vsRegisterMap getEditorDyn let rmap' = HM.insert name (Register style rope) rmap modifyStateE $ \state -> state { vsRegisterMap = rmap' } normalizeCountE :: Maybe Int -> EditorM () normalizeCountE n = do mcount <- getMaybeCountE modifyStateE $ \s -> s { vsCount = maybeMult mcount n , vsAccumulator = Ev (showT . fromMaybe 1 $ maybeMult mcount n) <> snd (splitCountedCommand . normalizeCount $ vsAccumulator s) } maybeMult :: Num a => Maybe a -> Maybe a -> Maybe a maybeMult (Just a) (Just b) = Just (a * b) maybeMult Nothing Nothing = Nothing maybeMult a Nothing = a maybeMult Nothing b = b updateModeIndicatorE :: VimState -> EditorM () updateModeIndicatorE prevState = do currentState <- getEditorDyn let mode = vsMode currentState prevMode = vsMode prevState paste = vsPaste currentState isRecording = isJust . vsCurrentMacroRecording $ currentState prevRecording = isJust . vsCurrentMacroRecording $ prevState when (mode /= prevMode || isRecording /= prevRecording) $ do let modeName = case mode of Insert _ -> "INSERT" <> if paste then " (paste) " else "" InsertNormal -> "(insert)" InsertVisual -> "(insert) VISUAL" Replace -> "REPLACE" Visual Block -> "VISUAL BLOCK" Visual LineWise -> "VISUAL LINE" Visual _ -> "VISUAL" _ -> "" decoratedModeName' = if T.null modeName then mempty else "-- " <> modeName <> " --" decoratedModeName = if isRecording then decoratedModeName' <> "recording" else decoratedModeName' setStatus ([decoratedModeName], defaultStyle) saveInsertEventStringE :: EventString -> EditorM () saveInsertEventStringE evs = modifyStateE $ \s -> s { vsOngoingInsertEvents = vsOngoingInsertEvents s <> evs } resetActiveRegisterE :: EditorM () resetActiveRegisterE = modifyStateE $ \s -> s { vsActiveRegister = '\0' } yi-0.12.6/src/library/Yi/Keymap/Vim/StyledRegion.hs0000644000000000000000000000536212717763531020172 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.StyledRegion -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- I'm a module waiting for some kind soul to give me a commentary! module Yi.Keymap.Vim.StyledRegion ( StyledRegion(..) , normalizeRegion , transformCharactersInRegionB , transformCharactersInLineN ) where import Control.Monad (forM_) import qualified Data.Text as T (map) import Yi.Buffer.Adjusted import qualified Yi.Rope as R (withText) import Yi.Utils (SemiNum ((-~))) data StyledRegion = StyledRegion !RegionStyle !Region -- | from vim help: -- -- 1. If the motion is exclusive and the end of the motion is in -- column 1, the end of the motion is moved to the end of the -- previous line and the motion becomes inclusive. Example: "}" -- moves to the first line after a paragraph, but "d}" will not -- include that line. -- -- 2. If the motion is exclusive, the end of the motion is in column 1 -- and the start of the motion was at or before the first non-blank -- in the line, the motion becomes linewise. Example: If a -- paragraph begins with some blanks and you do "d}" while standing -- on the first non-blank, all the lines of the paragraph are -- deleted, including the blanks. If you do a put now, the deleted -- lines will be inserted below the cursor position. -- -- TODO: case 2 normalizeRegion :: StyledRegion -> BufferM StyledRegion normalizeRegion sr@(StyledRegion style reg) = if style == Exclusive then do let end = regionEnd reg (_, endColumn) <- getLineAndColOfPoint end return (if endColumn == 0 then StyledRegion Inclusive $ reg { regionEnd = end -~ 2 } else sr) else return sr transformCharactersInRegionB :: StyledRegion -> (Char -> Char) -> BufferM () transformCharactersInRegionB (StyledRegion Block reg) f = do subregions <- splitBlockRegionToContiguousSubRegionsB reg forM_ subregions $ \sr -> transformCharactersInRegionB (StyledRegion Exclusive sr) f case subregions of (sr:_) -> moveTo (regionStart sr) [] -> error "Should never happen" transformCharactersInRegionB (StyledRegion style reg) f = do reg' <- convertRegionToStyleB reg style s <- readRegionB reg' replaceRegionB reg' (R.withText (T.map f) s) moveTo (regionStart reg') transformCharactersInLineN :: Int -> (Char -> Char) -> BufferM () transformCharactersInLineN count action = do p0 <- pointB moveXorEol count p1 <- pointB let sreg = StyledRegion Exclusive $ mkRegion p0 p1 transformCharactersInRegionB sreg action moveTo p1 yi-0.12.6/src/library/Yi/Keymap/Vim/Tag.hs0000644000000000000000000001654112717763531016276 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Tag -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Keymap.Vim.Tag ( completeVimTag , gotoTag , nextTag , popTag , unpopTag ) where import GHC.Generics (Generic) import Control.Applicative ((<$>)) import Control.Lens (view) import Control.Monad (foldM, void) import Data.Binary (Binary (..)) import Data.Default (Default (..)) import Data.Maybe (maybeToList) import Data.Monoid ((<>)) import qualified Data.Text as T (Text) import Data.Typeable (Typeable) import System.Directory (doesFileExist) import System.FilePath (takeDirectory, ()) import System.FriendlyPath (userToCanonPath) import Yi.Buffer import Yi.Core (errorEditor) import Yi.Editor import Yi.File (openingNewFile) import Yi.Keymap (YiM) import Yi.Tag import Yi.Types (YiVariable) import Yi.Utils (io) -- | List of tags and the file/line/char that they originate from. -- (the location that :tag or Ctrl-[ was called from). data VimTagStack = VimTagStack { tagStackList :: [(Tag, Int, FilePath, Int, Int)] , tagStackIndex :: Int } deriving (Typeable, Generic) instance Default VimTagStack where def = VimTagStack [] 0 instance YiVariable VimTagStack instance Binary VimTagStack -- | Returns tag, tag index, filepath, line number, char number getTagList :: EditorM [(Tag, Int, FilePath, Int, Int)] getTagList = do VimTagStack ts _ <- getEditorDyn return ts getTagIndex :: EditorM Int getTagIndex = do VimTagStack _ ti <- getEditorDyn return ti setTagList :: [(Tag, Int, FilePath, Int, Int)] -> EditorM () setTagList tl = do t@(VimTagStack _ _) <- getEditorDyn putEditorDyn $ t { tagStackList = tl } setTagIndex :: Int -> EditorM () setTagIndex ti = do t@(VimTagStack _ _) <- getEditorDyn putEditorDyn $ t { tagStackIndex = ti } -- | Push tag at index. pushTagStack :: Tag -> Int -> FilePath -> Int -> Int -> EditorM () pushTagStack tag ind fp ln cn = do tl <- getTagList ti <- getTagIndex setTagList $ (take ti tl) ++ [(tag, ind, fp, ln, cn)] setTagIndex $ ti + 1 -- | Get tag and decrement index (so that when a new push is done, the current -- tag is popped) popTagStack :: EditorM (Maybe (Tag, Int, FilePath, Int, Int)) popTagStack = do tl <- getTagList ti <- getTagIndex case tl of [] -> return Nothing _ -> case ti of 0 -> return Nothing _ -> setTagIndex (ti - 1) >> return (Just $ tl !! (ti - 1)) -- | Opens the file that contains @tag@. Uses the global tag table or uses -- the first valid tag file in @TagsFileList@. gotoTag :: Tag -> Int -> Maybe (FilePath, Int, Int) -> YiM () gotoTag tag ind ret = void . visitTagTable $ \tagTable -> do let lis = lookupTag tag tagTable if (length lis) <= ind then errorEditor $ "tag not found: " <> _unTag tag else do bufinf <- withCurrentBuffer bufInfoB let (filename, line) = lis !! ind (fn, ln, cn) = case ret of Just ret' -> ret' Nothing -> (bufInfoFileName bufinf, bufInfoLineNo bufinf, bufInfoColNo bufinf) withEditor $ pushTagStack tag ind fn ln cn openingNewFile filename $ gotoLn line -- | Goes to the next tag. (:tnext) nextTag :: YiM () nextTag = do prev <- withEditor popTagStack case prev of Nothing -> errorEditor $ "tag stack empty" Just (tag, ind, fn, ln, cn) -> gotoTag tag (ind + 1) (Just (fn, ln, cn)) -- | Return to location from before last tag jump. popTag :: YiM () popTag = do tl <- withEditor getTagList case tl of [] -> errorEditor "tag stack empty" _ -> do posloc <- withEditor popTagStack case posloc of Nothing -> errorEditor "at bottom of tag stack" Just (_, _, fn, ln, cn) -> openingNewFile fn $ moveToLineColB ln cn -- | Go to next tag in the tag stack. Represents :tag without any -- specified tag. unpopTag :: YiM () unpopTag = do tl <- withEditor getTagList ti <- withEditor getTagIndex if ti >= length tl then case tl of [] -> errorEditor "tag stack empty" _ -> errorEditor "at top of tag stack" else let (tag, ind, _, _, _) = tl !! ti in void . visitTagTable $ \tagTable -> do let lis = lookupTag tag tagTable if (length lis) <= ind then errorEditor $ "tag not found: " <> _unTag tag else do bufinf <- withCurrentBuffer bufInfoB let (filename, line) = lis !! ind ln = bufInfoLineNo bufinf cn = bufInfoColNo bufinf fn = bufInfoFileName bufinf tl' = take ti tl ++ (tag, ind, fn, ln, cn):(drop (ti + 1) tl) withEditor $ setTagList tl' openingNewFile filename $ gotoLn line completeVimTag :: T.Text -> YiM [T.Text] completeVimTag s = fmap maybeToList . visitTagTable $ return . flip completeTag s -- | Gets the first valid tags file in @TagsFileList@, if such a valid -- file exists. tagsFile :: YiM (Maybe FilePath) tagsFile = do fs <- view tagsFileList <$> askCfg let g f' f = do case f' of Just _ -> return f' Nothing -> tagsFileLocation f foldM g Nothing fs -- | Handles paths of the form ./[path], which represents a tags file relative -- to the path of the current directory of a file rather than the directory -- of the process. tagsFileLocation :: String -> YiM (Maybe FilePath) tagsFileLocation s | length s < 2 || take 2 s /= "./" = check s | otherwise = do let s' = drop 2 s dir <- takeDirectory <$> (withCurrentBuffer $ bufInfoB >>= return . bufInfoFileName) check $ dir s' where check f = do f' <- io $ userToCanonPath f fileExists <- io $ doesFileExist f' if fileExists then return $ Just f' else return Nothing -- | Call continuation @act@ with the TagTable. Uses the global table -- or, if it doesn't exist, uses the first valid tag file in -- @TagsFileList@. visitTagTable :: (TagTable -> YiM a) -> YiM (Maybe a) visitTagTable act = do posTagTable <- withEditor getTags case posTagTable of Just tagTable -> Just <$> act tagTable Nothing -> do f <- tagsFile case f of Nothing -> errorEditor "No tags file" >> return Nothing Just f' -> do tagTable <- io $ importTagTable f' withEditor $ setTags tagTable Just <$> act tagTable yi-0.12.6/src/library/Yi/Keymap/Vim/TextObject.hs0000644000000000000000000000510212717763531017625 0ustar0000000000000000module Yi.Keymap.Vim.TextObject ( TextObject(..) , CountedTextObject(..) , regionOfTextObjectB , changeTextObjectCount , changeTextObjectStyle , stringToTextObject ) where import Control.Monad (replicateM_, (<=<)) import Yi.Buffer.Adjusted import Yi.Keymap.Vim.StyledRegion (StyledRegion (..), normalizeRegion) data TextObject = TextObject !RegionStyle !TextUnit data CountedTextObject = CountedTextObject !Int !TextObject changeTextObjectCount :: Int -> CountedTextObject -> CountedTextObject changeTextObjectCount n (CountedTextObject _ to) = CountedTextObject n to regionOfTextObjectB :: CountedTextObject -> BufferM StyledRegion regionOfTextObjectB = normalizeRegion <=< textObjectRegionB' textObjectRegionB' :: CountedTextObject -> BufferM StyledRegion textObjectRegionB' (CountedTextObject count (TextObject style unit)) = fmap (StyledRegion style) $ regionWithTwoMovesB (maybeMoveB unit Backward) (replicateM_ count $ moveB unit Forward) changeTextObjectStyle :: (RegionStyle -> RegionStyle) -> TextObject -> TextObject changeTextObjectStyle smod (TextObject s u) = TextObject (smod s) u stringToTextObject :: String -> Maybe TextObject stringToTextObject ('i':s) = parseTextObject InsideBound s stringToTextObject ('a':s) = parseTextObject OutsideBound s stringToTextObject _ = Nothing parseTextObject :: BoundarySide -> String -> Maybe TextObject parseTextObject bs (c:[]) = fmap (TextObject Exclusive . ($ bs == OutsideBound)) mkUnit where mkUnit = lookup c [('w', toOuter unitViWord unitViWordAnyBnd) ,('W', toOuter unitViWORD unitViWORDAnyBnd) ,('p', toOuter unitEmacsParagraph unitEmacsParagraph) -- TODO inner could be inproved ,('s', toOuter unitSentence unitSentence) -- TODO inner could be inproved ,('"', unitDelimited '"' '"') ,('`', unitDelimited '`' '`') ,('\'', unitDelimited '\'' '\'') ,('(', unitDelimited '(' ')') ,(')', unitDelimited '(' ')') ,('b', unitDelimited '(' ')') ,('[', unitDelimited '[' ']') ,(']', unitDelimited '[' ']') ,('{', unitDelimited '{' '}') ,('}', unitDelimited '{' '}') ,('B', unitDelimited '{' '}') ,('<', unitDelimited '<' '>') ,('>', unitDelimited '<' '>') -- TODO: 't' ] parseTextObject _ _ = Nothing -- TODO: this probably belongs to Buffer.TextUnit toOuter :: TextUnit -> TextUnit -> Bool -> TextUnit toOuter outer _ True = leftBoundaryUnit outer toOuter _ inner False = inner yi-0.12.6/src/library/Yi/Keymap/Vim/Utils.hs0000644000000000000000000002017712725740550016656 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.Utils -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Utils for the Vim keymap. module Yi.Keymap.Vim.Utils ( mkBindingE , mkBindingY , mkStringBindingE , mkStringBindingY , splitCountedCommand , selectBinding , selectPureBinding , matchFromBool , mkMotionBinding , mkChooseRegisterBinding , pasteInclusiveB , addNewLineIfNecessary , indentBlockRegionB , addVimJumpHereE , exportRegisterToClipboard , pasteFromClipboard ) where import Control.Applicative ((<$), (<$>)) import Control.Lens ((.=), use) import Control.Monad (forM_, void, when) import Data.Char (isSpace) import Data.Foldable (asum) import Data.List (group) import qualified Data.Text as T (unpack) import Safe (headDef) import Yi.Buffer.Adjusted hiding (Insert) import Yi.Editor import Yi.Event (Event) import Yi.Keymap (YiM) import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.EventUtils (eventToEventString, splitCountedCommand) import Yi.Keymap.Vim.Motion (Move (Move), stringToMove) import Yi.Keymap.Vim.StateUtils (getMaybeCountE, modifyStateE, resetCountE, getRegisterE) import Yi.Monad (whenM) import Yi.Rope (YiString, countNewLines, last) import qualified Yi.Rope as R (replicateChar, snoc, toString, fromString) import Yi.Utils (io) import System.Hclip (getClipboard, setClipboard) -- 'mkBindingE' and 'mkBindingY' are helper functions for bindings -- where VimState mutation is not dependent on action performed -- and prerequisite has form (mode == ... && event == ...) mkStringBindingE :: VimMode -> RepeatToken -> (EventString, EditorM (), VimState -> VimState) -> VimBinding mkStringBindingE mode rtoken (eventString, action, mutate) = VimBindingE f where f _ vs | vsMode vs /= mode = NoMatch f evs _ = combineAction action mutate rtoken <$ evs `matchesString` eventString mkStringBindingY :: VimMode -> (EventString, YiM (), VimState -> VimState) -> VimBinding mkStringBindingY mode (eventString, action, mutate) = VimBindingY f where f _ vs | vsMode vs /= mode = NoMatch f evs _ = combineAction action mutate Drop <$ evs `matchesString` eventString mkBindingE :: VimMode -> RepeatToken -> (Event, EditorM (), VimState -> VimState) -> VimBinding mkBindingE mode rtoken (event, action, mutate) = VimBindingE f where f evs vs = combineAction action mutate rtoken <$ matchFromBool (vsMode vs == mode && evs == eventToEventString event) mkBindingY :: VimMode -> (Event, YiM (), VimState -> VimState) -> VimBinding mkBindingY mode (event, action, mutate) = VimBindingY f where f evs vs = combineAction action mutate Drop <$ matchFromBool (vsMode vs == mode && evs == eventToEventString event) combineAction :: MonadEditor m => m () -> (VimState -> VimState) -> RepeatToken -> m RepeatToken combineAction action mutateState rtoken = do action withEditor $ modifyStateE mutateState return rtoken -- | All impure bindings will be ignored. selectPureBinding :: EventString -> VimState -> [VimBinding] -> MatchResult (EditorM RepeatToken) selectPureBinding evs state = asum . fmap try where try (VimBindingE matcher) = matcher evs state try (VimBindingY _) = NoMatch selectBinding :: EventString -> VimState -> [VimBinding] -> MatchResult (YiM RepeatToken) selectBinding input state = asum . fmap try where try (VimBindingY matcher) = matcher input state try (VimBindingE matcher) = fmap withEditor $ matcher input state matchFromBool :: Bool -> MatchResult () matchFromBool b = if b then WholeMatch () else NoMatch setUnjumpMarks :: Point -> BufferM () setUnjumpMarks p = do solP <- solPointB p lineStream <- indexedStreamB Forward solP let fstNonBlank = headDef solP [ p' | (p', ch) <- lineStream, not (isSpace ch) || ch == '\n' ] (.= p) . markPointA =<< getMarkB (Just "`") (.= fstNonBlank) . markPointA =<< getMarkB (Just "'") addVimJumpAtE :: Point -> EditorM () addVimJumpAtE p = do withCurrentBuffer $ setUnjumpMarks p addJumpAtE p addVimJumpHereE :: EditorM () addVimJumpHereE = do withCurrentBuffer $ setUnjumpMarks =<< pointB addJumpHereE mkMotionBinding :: RepeatToken -> (VimMode -> Bool) -> VimBinding mkMotionBinding token condition = VimBindingE f where -- TODO: stringToMove and go both to EventString f :: EventString -> VimState -> MatchResult (EditorM RepeatToken) f evs state | condition (vsMode state) = fmap (go . T.unpack . _unEv $ evs) (stringToMove evs) f _ _ = NoMatch go :: String -> Move -> EditorM RepeatToken go evs (Move _style isJump move) = do count <- getMaybeCountE prevPoint <- withCurrentBuffer $ do p <- pointB move count leftOnEol return p when isJump $ addVimJumpAtE prevPoint resetCountE sticky <- withCurrentBuffer $ use stickyEolA -- moving with j/k after $ sticks cursor to the right edge when (evs == "$") . withCurrentBuffer $ stickyEolA .= True when (evs `elem` group "jk" && sticky) $ withCurrentBuffer $ moveToEol >> moveXorSol 1 when (evs `notElem` group "jk$") . withCurrentBuffer $ stickyEolA .= False let m = head evs when (m `elem` ('f' : "FtT")) $ do let c = Prelude.last evs (dir, style) = case m of 'f' -> (Forward, Inclusive) 't' -> (Forward, Exclusive) 'F' -> (Backward, Inclusive) 'T' -> (Backward, Exclusive) _ -> error "can't happen" command = GotoCharCommand c dir style modifyStateE $ \s -> s { vsLastGotoCharCommand = Just command} return token mkChooseRegisterBinding :: (VimState -> Bool) -> VimBinding mkChooseRegisterBinding statePredicate = VimBindingE (f . T.unpack . _unEv) where f "\"" s | statePredicate s = PartialMatch f ['"', c] s | statePredicate s = WholeMatch $ do modifyStateE $ \s' -> s' { vsActiveRegister = c } return Continue f _ _ = NoMatch indentBlockRegionB :: Int -> Region -> BufferM () indentBlockRegionB count reg = do indentSettings <- indentSettingsB (start, lengths) <- shapeOfBlockRegionB reg moveTo start forM_ (zip [1..] lengths) $ \(i, _) -> do whenM (not <$> atEol) $ do let w = shiftWidth indentSettings if count > 0 then insertN $ R.replicateChar (count * w) ' ' else go (abs count * w) moveTo start void $ lineMoveRel i moveTo start where go 0 = return () go n = do c <- readB when (c == ' ') $ deleteN 1 >> go (n - 1) pasteInclusiveB :: YiString -> RegionStyle -> BufferM () pasteInclusiveB rope style = do p0 <- pointB insertRopeWithStyleB rope style if countNewLines rope == 0 && style `elem` [ Exclusive, Inclusive ] then leftB else moveTo p0 trailingNewline :: YiString -> Bool trailingNewline t = case Yi.Rope.last t of Just '\n' -> True _ -> False addNewLineIfNecessary :: YiString -> YiString addNewLineIfNecessary rope = if trailingNewline rope then rope else rope `R.snoc` '\n' pasteFromClipboard :: YiM () pasteFromClipboard = do text <- fmap R.fromString $ io getClipboard withCurrentBuffer $ insertRopeWithStyleB text Inclusive exportRegisterToClipboard :: RegisterName -> YiM () exportRegisterToClipboard name = do mbr <- withEditor $ getRegisterE name io . setClipboard $ maybe "" (R.toString . regContent) mbr yi-0.12.6/src/library/Yi/Keymap/Vim/VisualMap.hs0000644000000000000000000002542512717772136017466 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Keymap.Vim.VisualMap -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- I'm a module waiting for some kind soul to give me a commentary! module Yi.Keymap.Vim.VisualMap ( defVisualMap ) where import Control.Applicative ((<$), (<$>)) import Control.Lens ((.=)) import Control.Monad (forM_, void) import Data.Char (ord) import Data.List (group) import Data.Maybe (fromJust) import qualified Data.Text as T (unpack) import Yi.Buffer.Adjusted hiding (Insert) import Yi.Editor import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.Operator (VimOperator (..), opDelete, stringToOperator) import Yi.Keymap.Vim.StateUtils import Yi.Keymap.Vim.StyledRegion (StyledRegion (StyledRegion), transformCharactersInRegionB) import Yi.Keymap.Vim.Tag (gotoTag) import Yi.Keymap.Vim.Utils (matchFromBool, mkChooseRegisterBinding, mkMotionBinding) import Yi.MiniBuffer (spawnMinibufferE) import Yi.Monad (whenM) import qualified Yi.Rope as R (toText) import Yi.Tag (Tag (Tag)) import Yi.Utils (SemiNum ((-~))) defVisualMap :: [VimOperator] -> [VimBinding] defVisualMap operators = [escBinding, motionBinding, changeVisualStyleBinding, setMarkBinding] ++ [chooseRegisterBinding] ++ operatorBindings operators ++ digitBindings ++ [replaceBinding, switchEdgeBinding] ++ [insertBinding, exBinding, shiftDBinding] ++ [tagJumpBinding] escAction :: EditorM RepeatToken escAction = do resetCountE clrStatus withCurrentBuffer $ do setVisibleSelection False putRegionStyle Inclusive switchModeE Normal return Drop escBinding :: VimBinding escBinding = VimBindingE f where f evs (VimState { vsMode = (Visual _) }) = escAction <$ matchFromBool (evs `elem` ["", ""]) f _ _ = NoMatch exBinding :: VimBinding exBinding = VimBindingE f where f ":" (VimState { vsMode = (Visual _) }) = WholeMatch $ do void $ spawnMinibufferE ":" id withCurrentBuffer $ writeN "'<,'>" switchModeE Ex return Finish f _ _ = NoMatch digitBindings :: [VimBinding] digitBindings = zeroBinding : fmap mkDigitBinding ['1' .. '9'] zeroBinding :: VimBinding zeroBinding = VimBindingE f where f "0" (VimState { vsMode = (Visual _) }) = WholeMatch $ do currentState <- getEditorDyn case vsCount currentState of Just c -> do setCountE (10 * c) return Continue Nothing -> do withCurrentBuffer moveToSol resetCountE withCurrentBuffer $ stickyEolA .= False return Continue f _ _ = NoMatch setMarkBinding :: VimBinding setMarkBinding = VimBindingE (f . T.unpack . _unEv) where f "m" (VimState { vsMode = (Visual _) }) = PartialMatch f ('m':c:[]) (VimState { vsMode = (Visual _) }) = WholeMatch $ do withCurrentBuffer $ setNamedMarkHereB [c] return Continue f _ _ = NoMatch changeVisualStyleBinding :: VimBinding changeVisualStyleBinding = VimBindingE f where f evs (VimState { vsMode = (Visual _) }) | evs `elem` ["v", "V", ""] = WholeMatch $ do currentMode <- fmap vsMode getEditorDyn let newStyle = case evs of "v" -> Inclusive "V" -> LineWise "" -> Block _ -> error "Just silencing false positive warning." newMode = Visual newStyle if newMode == currentMode then escAction else do modifyStateE $ \s -> s { vsMode = newMode } withCurrentBuffer $ do putRegionStyle newStyle rectangleSelectionA .= (Block == newStyle) setVisibleSelection True return Finish f _ _ = NoMatch mkDigitBinding :: Char -> VimBinding mkDigitBinding c = VimBindingE (f . T.unpack . _unEv) where f [c'] (VimState { vsMode = (Visual _) }) | c == c' = WholeMatch $ do modifyStateE mutate return Continue f _ _ = NoMatch mutate vs@(VimState {vsCount = Nothing}) = vs { vsCount = Just d } mutate vs@(VimState {vsCount = Just count}) = vs { vsCount = Just $ count * 10 + d } d = ord c - ord '0' motionBinding :: VimBinding motionBinding = mkMotionBinding Continue $ \m -> case m of Visual _ -> True _ -> False regionOfSelectionB :: BufferM Region regionOfSelectionB = savingPointB $ do start <- getSelectionMarkPointB stop <- pointB return $! mkRegion start stop operatorBindings :: [VimOperator] -> [VimBinding] operatorBindings operators = fmap mkOperatorBinding $ operators ++ visualOperators where visualOperators = fmap synonymOp [ ("x", "d") , ("s", "c") , ("S", "c") , ("C", "c") , ("~", "g~") , ("Y", "y") , ("u", "gu") , ("U", "gU") ] synonymOp (newName, existingName) = VimOperator newName . operatorApplyToRegionE . fromJust . stringToOperator operators $ existingName chooseRegisterBinding :: VimBinding chooseRegisterBinding = mkChooseRegisterBinding $ \s -> case s of (VimState { vsMode = (Visual _) }) -> True _ -> False shiftDBinding :: VimBinding shiftDBinding = VimBindingE (f . T.unpack . _unEv) where f "D" (VimState { vsMode = (Visual _) }) = WholeMatch $ do (Visual style) <- vsMode <$> getEditorDyn reg <- withCurrentBuffer regionOfSelectionB case style of Block -> withCurrentBuffer $ do (start, lengths) <- shapeOfBlockRegionB reg moveTo start startCol <- curCol forM_ (reverse [0 .. length lengths - 1]) $ \l -> do moveTo start void $ lineMoveRel l whenM (fmap (== startCol) curCol) deleteToEol leftOnEol _ -> do reg' <- withCurrentBuffer $ convertRegionToStyleB reg LineWise reg'' <- withCurrentBuffer $ mkRegionOfStyleB (regionStart reg') (regionEnd reg' -~ Size 1) Exclusive void $ operatorApplyToRegionE opDelete 1 $ StyledRegion LineWise reg'' resetCountE switchModeE Normal return Finish f _ _ = NoMatch mkOperatorBinding :: VimOperator -> VimBinding mkOperatorBinding op = VimBindingE f where f evs (VimState { vsMode = (Visual _) }) = action <$ evs `matchesString` Ev (_unOp $ operatorName op) f _ _ = NoMatch action = do (Visual style) <- vsMode <$> getEditorDyn region <- withCurrentBuffer regionOfSelectionB count <- getCountE token <- operatorApplyToRegionE op count $ StyledRegion style region resetCountE clrStatus withCurrentBuffer $ do setVisibleSelection False putRegionStyle Inclusive return token replaceBinding :: VimBinding replaceBinding = VimBindingE (f . T.unpack . _unEv) where f evs (VimState { vsMode = (Visual _) }) = case evs of "r" -> PartialMatch ('r':c:[]) -> WholeMatch $ do (Visual style) <- vsMode <$> getEditorDyn region <- withCurrentBuffer regionOfSelectionB withCurrentBuffer $ transformCharactersInRegionB (StyledRegion style region) (\x -> if x == '\n' then x else c) switchModeE Normal return Finish _ -> NoMatch f _ _ = NoMatch switchEdgeBinding :: VimBinding switchEdgeBinding = VimBindingE (f . T.unpack . _unEv) where f [c] (VimState { vsMode = (Visual _) }) | c `elem` ['o', 'O'] = WholeMatch $ do (Visual style) <- vsMode <$> getEditorDyn withCurrentBuffer $ do here <- pointB there <- getSelectionMarkPointB (here', there') <- case (c, style) of ('O', Block) -> flipRectangleB here there (_, _) -> return (there, here) moveTo here' setSelectionMarkPointB there' return Continue f _ _ = NoMatch insertBinding :: VimBinding insertBinding = VimBindingE (f . T.unpack . _unEv) where f evs (VimState { vsMode = (Visual _) }) | evs `elem` group "IA" = WholeMatch $ do (Visual style) <- vsMode <$> getEditorDyn region <- withCurrentBuffer regionOfSelectionB cursors <- withCurrentBuffer $ case evs of "I" -> leftEdgesOfRegionB style region "A" -> rightEdgesOfRegionB style region _ -> error "Just silencing ghc's false positive warning." case cursors of (mainCursor : _) -> withCurrentBuffer (moveTo mainCursor) modifyStateE $ \s -> s { vsSecondaryCursors = drop 1 cursors } switchModeE $ Insert (head evs) return Continue f _ _ = NoMatch tagJumpBinding :: VimBinding tagJumpBinding = VimBindingY (f . T.unpack . _unEv) where f "" (VimState { vsMode = (Visual _) }) = WholeMatch $ do tag <- Tag . R.toText <$> withCurrentBuffer (regionOfSelectionB >>= readRegionB) withEditor $ switchModeE Normal gotoTag tag 0 Nothing return Finish f _ _ = NoMatch yi-0.12.6/src/library/Yi/KillRing.hs0000644000000000000000000000564012717763531015313 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.KillRing -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Killring operations. module Yi.KillRing ( Killring , _krKilled , _krContents , krKilled , krContents , krEndCmd , krPut , krSet, krGet , krEmpty , krLastYank ) where import Prelude hiding (head, tail, take) import Control.Applicative ((<$>), (<*>)) import Control.Lens (makeLenses, (^.)) import Data.Binary (Binary, get, put) import Data.List.NonEmpty (NonEmpty (..), head, take) import Data.Monoid (mempty, (<>)) import Yi.Buffer.Basic (Direction (..)) import qualified Yi.Rope as R (YiString, length) data Killring = Killring { _krKilled :: Bool , _krAccumulate :: Bool , _krContents :: NonEmpty R.YiString , _krLastYank :: Bool } deriving (Show, Eq) instance Binary Killring where put (Killring k a c l) = let putNE (x :| xs) = put x >> put xs in put k >> put a >> putNE c >> put l get = let getNE = (:|) <$> get <*> get in Killring <$> get <*> get <*> getNE <*> get makeLenses ''Killring maxDepth :: Int maxDepth = 10 krEmpty :: Killring krEmpty = Killring { _krKilled = False , _krAccumulate = False , _krContents = mempty :| mempty , _krLastYank = False } -- | Finish an atomic command, for the purpose of killring accumulation. krEndCmd :: Killring -> Killring krEndCmd kr = kr { _krKilled = False , _krAccumulate = kr ^. krKilled } -- | Put some text in the killring. -- It's accumulated if the last command was a kill too krPut :: Direction -> R.YiString -> Killring -> Killring krPut dir s kr@Killring { _krContents = r@(x :| xs) } = kr { _krKilled = True , _krContents = if kr ^. krAccumulate then (case dir of Forward -> x <> s Backward -> s <> x) :| xs else push s r } -- | Push a string in the killring. push :: R.YiString -> NonEmpty R.YiString -> NonEmpty R.YiString push s r@(h :| t) = s :| if R.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. krSet :: R.YiString -> Killring -> Killring krSet s kr@Killring {_krContents = _ :| xs} = kr {_krContents = s :| xs} -- | Get the top of the killring. krGet :: Killring -> R.YiString krGet = head . _krContents yi-0.12.6/src/library/Yi/Layout.hs0000644000000000000000000004045512725740550015053 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-} -- we might as well unbox our Ints. -- | This module defines the layout manager interface (see 'LayoutManager'). To desgin a new layout manager, just make an instance of this class. module Yi.Layout ( -- * Concrete layouts Layout(..), Orientation(..), DividerPosition, DividerRef, RelativeSize, dividerPositionA, findDivider, -- * Layout managers -- ** The interface LayoutManager(..), AnyLayoutManager(..), layoutManagerSameType, -- ** Standard managers wide, tall, slidyTall, slidyWide, hPairNStack, vPairNStack, -- * Utility functions -- ** Layouts as rectangles Rectangle(..), HasNeighborWest, layoutToRectangles, -- ** Transposing things Transposable(..), Transposed(..), -- ** 'DividerRef' combinators -- $divRefCombinators LayoutM, pair, singleWindow, stack, evenStack, runLayoutM, ) where import Control.Applicative (pure, (<$>), (<*>), (<|>)) import Control.Arrow (first) import Control.Lens (Lens', lens) import qualified Control.Monad.State.Strict as Monad (State, evalState, get, put) import Data.Default (Default, def) import Data.List (foldl', mapAccumL) import Data.Maybe (fromMaybe, isNothing) import Data.Typeable (Typeable, cast, typeOf) -------------------------------- Some design notes ---------------------- -- [Treatment of mini windows] -- Mini windows are not subject to layout; instead, they are always -- placed at the bottom of the screen. There are multiple reasons for -- this, as discussed in -- https://groups.google.com/d/topic/yi-devel/vhTObC25dpY/discussion, one -- being that for many layouts, the bottom (or top) of the screen is the -- only reasonable place for mini windows (for example, think about -- side-by-side layouts). -- [Design of the 'Layout' datatype] -- The 'Layout' datatype is currently implemented in terms of -- horizontal stacks and vertical stacks. An alternative approach, -- which xmonad uses, is the following: a 'Layout a' could be a -- function @a -> Rectangle@ which specifies in coordinates where a -- window should be placed. -- -- While this alternative is more flexible than the current approach -- in allowing spiral layouts and the like, the vty UI doesn't support -- this: only vertical and horizontal composition of images is -- allowed. ----------------------------------- Concrete 'Layout's. -- | UI-agnostic layout schema. The basic constructs are -- (horizontal/vertical) stacks with fixed ratios between window -- sizes; and (horizontal/vertical) pairs with a slider in between (if -- available). data Layout a = SingleWindow a | Stack { orientation :: !Orientation, -- ^ Orientation wins :: [(Layout a, RelativeSize)] -- ^ The layout stack, with the given weights -- TODO: fix strictness for stack (it's still lazy) } | Pair { orientation :: !Orientation, -- ^ Orientation divPos :: !DividerPosition, -- ^ Initial position of the divider divRef :: !DividerRef, -- ^ Index of the divider (for updating the divider position) pairFst :: !(Layout a), -- ^ Upper of of the pair pairSnd :: !(Layout a) -- ^ Lower of the pair } deriving(Typeable, Eq, Functor) -- | Accessor for the 'DividerPosition' with given reference dividerPositionA :: DividerRef -> Lens' (Layout a) DividerPosition dividerPositionA ref = lens getter (flip setter) where setter pos = set' where set' s@(SingleWindow _) = s set' p@Pair{} | divRef p == ref = p{ divPos = pos } | otherwise = p{ pairFst = set' (pairFst p), pairSnd = set' (pairSnd p) } set' s@Stack{} = s{ wins = fmap (first set') (wins s) } getter = fromMaybe invalidRef . get' get' (SingleWindow _) = Nothing get' p@Pair{} | divRef p == ref = Just (divPos p) | otherwise = get' (pairFst p) <|> get' (pairSnd p) get' s@Stack{} = foldl' (<|>) Nothing (fmap (get' . fst) (wins s)) invalidRef = error "Yi.Layout.dividerPositionA: invalid DividerRef" -- | Find the divider nearest to a given window, or just the first one -- in case the argument is 'Nothing' findDivider :: Eq a => Maybe a -> Layout a -> Maybe DividerRef findDivider mbw = go [] where go path (SingleWindow w) = maybe Nothing (\w' -> if w == w' && not (null path) then Just (head path) else Nothing) mbw go path (Pair _ _ ref l1 l2) = if isNothing mbw then Just ref else let p' = ref : path in go p' l1 <|> go p' l2 go path (Stack _ ws) = foldr (<|>) Nothing $ map (go path . fst) ws instance Show a => Show (Layout a) where show (SingleWindow a) = show a show (Stack o s) = show o ++ " stack " ++ show s show p@(Pair{}) = show (orientation p) ++ " " ++ show (pairFst p, pairSnd p) -- | The def layout consists of a single window instance Default a => Default (Layout a) where def = SingleWindow def -- | Orientations for 'Stack' and 'Pair' data Orientation = Horizontal | Vertical deriving(Eq, Show) -- | Divider reference type DividerRef = Int -- | Divider position, in the range (0,1) type DividerPosition = Double -- | Relative sizes, for 'Stack' type RelativeSize = Double ----------------------------------------------------- Layout managers -- TODO: add Binary requirement when possible -- | The type of layout managers. See the layout managers 'tall', 'hPairNStack' and 'slidyTall' for some example implementations. class (Typeable m, Eq m) => LayoutManager m where -- | Given the old layout and the new list of windows, construct a -- layout for the new list of windows. -- -- If the layout manager uses sliding dividers, then a user will expect that most -- of these dividers don't move when adding a new window. It is the layout -- manager's responsibility to ensure that this is the case, and this is the -- purpose of the @Layout a@ argument. -- -- The old layout may come from a different layout manager, in which case the layout manager is free to ignore it. pureLayout :: m -> Layout a -> [a] -> Layout a -- | Describe the layout in a form suitable for the user. describeLayout :: m -> String -- | Cycles to the next variant, if there is one (the default is 'id') nextVariant :: m -> m nextVariant = id -- | Cycles to the previous variant, if there is one (the default is 'id' previousVariant :: m -> m previousVariant = id -- | Existential wrapper for 'Layout' data AnyLayoutManager = forall m. LayoutManager m => AnyLayoutManager !m deriving(Typeable) instance Eq AnyLayoutManager where (AnyLayoutManager l1) == (AnyLayoutManager l2) = maybe False (== l2) (cast l1) instance LayoutManager (AnyLayoutManager) where pureLayout (AnyLayoutManager l) = pureLayout l describeLayout (AnyLayoutManager l) = describeLayout l nextVariant (AnyLayoutManager l) = AnyLayoutManager (nextVariant l) previousVariant (AnyLayoutManager l) = AnyLayoutManager (previousVariant l) -- | The default layout is 'tallLayout' instance Default AnyLayoutManager where def = hPairNStack 1 -- | True if the internal layout managers have the same type (but are not necessarily equal). layoutManagerSameType :: AnyLayoutManager -> AnyLayoutManager -> Bool layoutManagerSameType (AnyLayoutManager l1) (AnyLayoutManager l2) = typeOf l1 == typeOf l2 ------------------------------ Standard layouts -- | Tall windows (i.e. places windows side-by-side, equally spaced) data Tall = Tall deriving(Eq, Typeable) -- | Windows placed side-by-side, equally spaced. tall :: AnyLayoutManager tall = AnyLayoutManager Tall instance LayoutManager Tall where pureLayout Tall _oldLayout ws = runLayoutM $ evenStack Horizontal (fmap singleWindow ws) describeLayout Tall = "Windows positioned side-by-side" -- | Wide windows (windows placed on top of one another, equally spaced) data Wide = Wide deriving(Eq, Typeable) instance LayoutManager Wide where pureLayout Wide _oldLayout ws = runLayoutM $ evenStack Vertical (fmap singleWindow ws) describeLayout Wide = "Windows positioned above one another" -- | Windows placed on top of one another, equally spaced wide :: AnyLayoutManager wide = AnyLayoutManager Wide -- | Tall windows, with arranged in a balanced binary tree with sliders in between them data SlidyTall = SlidyTall deriving(Eq, Typeable) -- | Tall windows, arranged in a balanced binary tree with sliders in between them. slidyTall :: AnyLayoutManager slidyTall = AnyLayoutManager SlidyTall instance LayoutManager SlidyTall where -- an error on input [] is easier to debug than an infinite loop. pureLayout SlidyTall _oldLayout [] = error "Yi.Layout: empty window list unexpected" pureLayout SlidyTall oldLayout xs = runLayoutM (go (Just oldLayout) xs) where go _layout [x] = singleWindow x go layout (splitList -> (lxs, rxs)) = case layout of -- if the old layout had a pair in the same point of the tree, use its divider position Just (Pair Horizontal pos _ l r) -> pair Horizontal pos (go (Just l) lxs) (go (Just r) rxs) -- otherwise, just use divider position 0.5 _ -> pair Horizontal 0.5 (go Nothing lxs) (go Nothing rxs) describeLayout SlidyTall = "Slidy tall windows, with balanced-position sliders" splitList :: [a] -> ([a], [a]) splitList xs = splitAt ((length xs + 1) `div` 2) xs -- | Transposed version of 'SlidyTall' newtype SlidyWide = SlidyWide (Transposed SlidyTall) deriving(Eq, Typeable) -- | Transposed version of 'slidyTall' slidyWide :: AnyLayoutManager slidyWide = AnyLayoutManager (SlidyWide (Transposed SlidyTall)) instance LayoutManager SlidyWide where pureLayout (SlidyWide w) = pureLayout w describeLayout _ = "Slidy wide windows, with balanced-position sliders" -- | Fixed number of \"main\" windows on the left; stack of windows on the right data HPairNStack = HPairNStack !Int deriving(Eq, Typeable) -- | @n@ windows on the left; stack of windows on the right. hPairNStack :: Int -> AnyLayoutManager hPairNStack n | n < 1 = error "Yi.Layout.hPairNStackLayout: n must be at least 1" | otherwise = AnyLayoutManager (HPairNStack n) instance LayoutManager HPairNStack where pureLayout (HPairNStack n) oldLayout (fmap singleWindow -> xs) | length xs <= n = runLayoutM $ evenStack Vertical xs | otherwise = runLayoutM $ case splitAt n xs of (ls, rs) -> pair Horizontal pos (evenStack Vertical ls) (evenStack Vertical rs) where pos = case oldLayout of Pair Horizontal pos' _ _ _ -> pos' _ -> 0.5 describeLayout (HPairNStack n) = show n ++ " windows on the left; remaining windows on the right" nextVariant (HPairNStack n) = HPairNStack (n+1) previousVariant (HPairNStack n) = HPairNStack (max (n-1) 1) newtype VPairNStack = VPairNStack (Transposed HPairNStack) deriving(Eq, Typeable) -- | Transposed version of 'hPairNStack'. vPairNStack :: Int -> AnyLayoutManager vPairNStack n = AnyLayoutManager (VPairNStack (Transposed (HPairNStack n))) instance LayoutManager VPairNStack where pureLayout (VPairNStack lm) = pureLayout lm previousVariant (VPairNStack lm) = VPairNStack (previousVariant lm) nextVariant (VPairNStack lm) = VPairNStack (nextVariant lm) describeLayout (VPairNStack (Transposed (HPairNStack n))) = show n ++ " windows on top; remaining windows beneath" ----------------------- Utils -- | A general bounding box data Rectangle = Rectangle { rectX, rectY, rectWidth, rectHeight :: !Double } deriving(Eq, Show) -- | Used by the vty frontend to draw vertical separators type HasNeighborWest = Bool layoutToRectangles :: HasNeighborWest -> Rectangle -> Layout a -> [(a, Rectangle, HasNeighborWest)] layoutToRectangles nb bounds (SingleWindow a) = [(a, bounds, nb)] layoutToRectangles nb bounds (Stack o ts) = handleStack o bounds ts' where ts' = if o == Vertical then setNbs nb ts else case ts of (l, s) : xs -> (l, s, nb) : setNbs True xs [] -> [] setNbs val = map (\(l, s) -> (l, s, val)) layoutToRectangles nb bounds (Pair o p _ a b) = handleStack o bounds [(a,p,nb), (b,1-p,nb')] where nb' = if o == Horizontal then True else nb handleStack :: Orientation -> Rectangle -> [(Layout a, RelativeSize, HasNeighborWest)] -> [(a, Rectangle, HasNeighborWest)] handleStack o bounds tiles = concat . snd . mapAccumL doTile startPos $ tiles where (totalSpace, startPos, mkBounds) = case o of Vertical -> (rectHeight bounds, rectY bounds, \pos size -> bounds { rectY = pos, rectHeight = size }) Horizontal -> (rectWidth bounds, rectX bounds, \pos size -> bounds { rectX = pos, rectWidth = size }) totalWeight' = sum . fmap (\(_, s, _) -> s) $ tiles totalWeight = if totalWeight' > 0 then totalWeight' else error "Yi.Layout: Stacks must have positive weights" spacePerWeight = totalSpace / totalWeight doTile pos (t, wt, nb) = (pos + wt * spacePerWeight, layoutToRectangles nb (mkBounds pos (wt * spacePerWeight)) t) ----------- Flipping things -- | Things with orientations which can be flipped class Transposable r where transpose :: r -> r instance Transposable Orientation where { transpose Horizontal = Vertical; transpose Vertical = Horizontal } instance Transposable (Layout a) where transpose (SingleWindow a) = SingleWindow a transpose (Stack o ws) = Stack (transpose o) (fmap (first transpose) ws) transpose (Pair o p r a b) = Pair (transpose o) p r (transpose a) (transpose b) -- | Same as 'lm', but with all 'Orientation's 'transpose'd. See 'slidyWide' for an example of its use. newtype Transposed lm = Transposed lm deriving(Eq, Typeable) instance LayoutManager lm => LayoutManager (Transposed lm) where pureLayout (Transposed lm) l ws = transpose (pureLayout lm (transpose l) ws) describeLayout (Transposed lm) = "Transposed version of: " ++ describeLayout lm nextVariant (Transposed lm) = Transposed (nextVariant lm) previousVariant (Transposed lm) = Transposed (previousVariant lm) -------------------- 'DividerRef' combinators -- $divRefCombinators -- It is tedious and error-prone for 'LayoutManager's to assign 'DividerRef's themselves. Better is to use these monadic smart constructors for 'Layout'. For example, the layout -- -- @'Pair' 'Horizontal' 0.5 0 ('Pair' 'Vertical' 0.5 1 ('SingleWindow' w1) ('SingleWindow' w2)) ('SingleWindow' w3)@ -- -- could be with the combinators below as -- -- @'runLayoutM' $ 'pair' 'Horizontal' 0.5 ('pair' 'Vertical' 0.5 ('singleWindow' w1) ('singleWindow' w2)) ('singleWindow' w3)@ -- -- These combinators do will also ensure strictness of the 'wins' field of 'Stack'. They also tidy up and do some error checking: length-1 stacks are removed (they are unnecessary); length-0 stacks raise errors. -- | A 'Layout a' wrapped in a state monad for tracking 'DividerRef's. This type is /not/ itself a monad, but should rather be thought of as a 'DividerRef'-free version of the 'Layout' type. newtype LayoutM a = LayoutM (Monad.State DividerRef (Layout a)) singleWindow :: a -> LayoutM a singleWindow a = LayoutM (pure (SingleWindow a)) pair :: Orientation -> DividerPosition -> LayoutM a -> LayoutM a -> LayoutM a pair o p (LayoutM l1) (LayoutM l2) = LayoutM $ do ref <- Monad.get Monad.put (ref+1) Pair o p ref <$> l1 <*> l2 stack :: Orientation -> [(LayoutM a, RelativeSize)] -> LayoutM a stack _ [] = error "Yi.Layout: Length-0 stack" stack _ [l] = fst l stack o ls = LayoutM (Stack o <$> mapM (\(LayoutM lm,rs) -> (,rs) <$> lm) ls) -- | Special case of 'stack' with all 'RelativeSize's equal. evenStack :: Orientation -> [LayoutM a] -> LayoutM a evenStack o ls = stack o (fmap (\l -> (l,1)) ls) runLayoutM :: LayoutM a -> Layout a runLayoutM (LayoutM l) = Monad.evalState l 0 yi-0.12.6/src/library/Yi/Main.hs0000644000000000000000000001377612717763531014475 0ustar0000000000000000{-# LANGUAGE CPP #-} -- | This is the main module of Yi, called with configuration from the user. -- Here we mainly process command line arguments. module Yi.Main ( -- * Static main main, -- * Command line processing do_args, ConsoleConfig(..), Err(..), ) where import Control.Monad.Error import Data.Char import Data.List (intercalate) import Distribution.Text (display) import System.Console.GetOpt import System.Exit #ifndef HLINT #include "ghcconfig.h" #endif import Yi.Buffer import Yi.Config import Yi.Config.Default import Yi.Core (startEditor) import Yi.Debug import Yi.Editor import Yi.File import Yi.Keymap import Yi.Paths (getConfigDir) import Paths_yi frontendNames :: [String] frontendNames = fmap fst' availableFrontends where fst' :: (a,UIBoot) -> a fst' (x,_) = x data Err = Err String ExitCode instance Error Err where strMsg s = Err s (ExitFailure 1) -- | Configuration information which can be set in the command-line, but not -- in the user's configuration file. data ConsoleConfig = ConsoleConfig { ghcOptions :: [String], selfCheck :: Bool, userConfigDir :: IO FilePath } defaultConsoleConfig :: ConsoleConfig defaultConsoleConfig = ConsoleConfig { ghcOptions = [], selfCheck = False, userConfigDir = Yi.Paths.getConfigDir } -- --------------------------------------------------------------------- -- | Argument parsing. Pretty standard. data Opts = Help | Version | LineNo String | EditorNm String | File String | Frontend String | ConfigFile String | SelfCheck | GhcOption String | Debug | OpenInTabs -- | List of editors for which we provide an emulation. editors :: [(String,Config -> Config)] editors = [("emacs", toEmacsStyleConfig), ("vim", toVimStyleConfig), ("cua", toCuaStyleConfig)] options :: [OptDescr Opts] options = [ Option [] ["self-check"] (NoArg SelfCheck) "Run self-checks" , Option ['f'] ["frontend"] (ReqArg Frontend "FRONTEND") frontendHelp , Option ['y'] ["config-file"] (ReqArg ConfigFile "PATH") "Specify a folder containing a configuration yi.hs file" , Option ['V'] ["version"] (NoArg Version) "Show version information" , Option ['h'] ["help"] (NoArg Help) "Show this help" , Option [] ["debug"] (NoArg Debug) "Write debug information in a log file" , Option ['l'] ["line"] (ReqArg LineNo "NUM") "Start on line number" , Option [] ["as"] (ReqArg EditorNm "EDITOR") editorHelp , Option [] ["ghc-option"] (ReqArg GhcOption "OPTION") "Specify option to pass to ghc when compiling configuration file" , Option [openInTabsShort] [openInTabsLong] (NoArg OpenInTabs) "Open files in tabs" ] where frontendHelp = "Select frontend, which can be one of:\n" ++ intercalate ", " frontendNames editorHelp = "Start with editor keymap, where editor is one of:\n" ++ (intercalate ", " . fmap fst) editors openInTabsShort :: Char openInTabsShort = 'p' openInTabsLong :: String openInTabsLong = "open-in-tabs" -- | usage string. usage, versinfo :: String usage = usageInfo "Usage: yi [option...] [file]" options versinfo = "yi " ++ display version -- | Transform the config with options do_args :: Config -> [String] -> Either Err (Config, ConsoleConfig) do_args cfg args = case getOpt (ReturnInOrder File) options args of (os, [], []) -> foldM (getConfig shouldOpenInTabs) (cfg, defaultConsoleConfig) (reverse os) (_, _, errs) -> fail (concat errs) where shouldOpenInTabs = ("--" ++ openInTabsLong) `elem` args || ('-':[openInTabsShort]) `elem` args -- | Update the default configuration based on a command-line option. getConfig :: Bool -> (Config, ConsoleConfig) -> Opts -> Either Err (Config, ConsoleConfig) getConfig shouldOpenInTabs (cfg, cfgcon) opt = case opt of Frontend f -> case lookup f availableFrontends of Just frontEnd -> return (cfg { startFrontEnd = frontEnd }, cfgcon) Nothing -> fail "Panic: frontend not found" Help -> throwError $ Err usage ExitSuccess Version -> throwError $ Err versinfo ExitSuccess Debug -> return (cfg { debugMode = True }, cfgcon) LineNo l -> case startActions cfg of x : xs -> return (cfg { startActions = x:makeAction (gotoLn (read l)):xs }, cfgcon) [] -> fail "The `-l' option must come after a file argument" File filename -> if shouldOpenInTabs && not (null (startActions cfg)) then prependActions [YiA $ openNewFile filename, EditorA newTabE] else prependAction $ openNewFile filename EditorNm emul -> case lookup (fmap toLower emul) editors of Just modifyCfg -> return (modifyCfg cfg, cfgcon) Nothing -> fail $ "Unknown emulation: " ++ show emul GhcOption ghcOpt -> return (cfg, cfgcon { ghcOptions = ghcOptions cfgcon ++ [ghcOpt] }) ConfigFile f -> return (cfg, cfgcon { userConfigDir = return f }) _ -> return (cfg, cfgcon) where prependActions as = return (cfg { startActions = fmap makeAction as ++ startActions cfg }, cfgcon) prependAction a = return (cfg { startActions = makeAction a : startActions cfg}, cfgcon) -- --------------------------------------------------------------------- -- | Static main. This is the front end to the statically linked -- application, and the real front end, in a sense. 'dynamic_main' calls -- this after setting preferences passed from the boot loader. -- main :: (Config, ConsoleConfig) -> Maybe Editor -> IO () main (cfg, _cfgcon) state = do when (debugMode cfg) $ initDebug ".yi.dbg" startEditor cfg state yi-0.12.6/src/library/Yi/MiniBuffer.hs0000644000000000000000000004365712717763531015640 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Minibuffer -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Functions working with the minibuffer. module Yi.MiniBuffer ( spawnMinibufferE, withMinibufferFree, withMinibuffer , withMinibufferGen, withMinibufferFin, noHint , noPossibilities, mkCompleteFn, simpleComplete , infixComplete, infixComplete', anyModeByName , getAllModeNames, matchingBufferNames, anyModeByNameM , anyModeName, (:::)(..), LineNumber, RegexTag , FilePatternTag, ToKill, CommandArguments(..) , commentRegion, promptingForBuffer, debugBufferContent ) where import Control.Applicative ((<$>)) import Control.Concurrent (threadDelay) import Control.Lens (use, (%=)) import Control.Monad (forM, void, when, (<=<), (>=>)) import Data.Foldable (find, toList) import Data.IORef (newIORef, readIORef, writeIORef) import qualified Data.List.PointedList.Circular as PL (find, insertRight) import Data.Maybe (catMaybes, fromJust, fromMaybe) import Data.Monoid (mempty) import Data.Proxy (Proxy) import Data.String (IsString) import qualified Data.Text as T (Text, append, head, isInfixOf, null, pack, snoc, unpack, words) import Data.Typeable (Typeable) import System.CanonicalizePath (replaceShorthands) import Yi.Buffer import Yi.Completion import Yi.Config (modeTable) import Yi.Core (forkAction, runAction) import Yi.Editor import Yi.History (historyFinishGen, historyMove, historyStartGen) import Yi.Keymap import Yi.Keymap.Keys import Yi.Monad (gets) import qualified Yi.Rope as R (YiString, fromText, toText) import Yi.String (commonTPrefix) import Yi.Style (defaultStyle) import Yi.Utils (io) import Yi.Window (bufkey) -- | Prints out the rope of the current buffer as-is to stdout. -- -- The only way to stop it is to close the buffer in question which -- should free up the 'BufferRef'. debugBufferContent :: YiM () debugBufferContent = promptingForBuffer "buffer to trace:" debugBufferContentUsing (\_ x -> x) debugBufferContentUsing :: BufferRef -> YiM () debugBufferContentUsing b = do mv <- io $ newIORef mempty keepGoing <- io $ newIORef True let delay = threadDelay 100000 >> readIORef keepGoing void . forkAction delay NoNeedToRefresh $ findBuffer b >>= \case Nothing -> io $ writeIORef keepGoing True Just _ -> do ns <- withGivenBuffer b elemsB :: YiM R.YiString io $ readIORef mv >>= \c -> when (c /= ns) (print ns >> void (writeIORef mv ns)) -- | Prompts for a buffer name, turns it into a 'BufferRef' and passes -- it on to the handler function. Uses all known buffers for hinting. promptingForBuffer :: T.Text -- ^ Prompt -> (BufferRef -> YiM ()) -- ^ Handler -> ([BufferRef] -> [BufferRef] -> [BufferRef]) -- ^ Hint pre-processor. It takes the list of open -- buffers and a list of all buffers, and should -- spit out all the buffers to possibly hint, in -- the wanted order. Note the hinter uses name -- prefix for filtering regardless of what you do -- here. -> YiM () promptingForBuffer prompt act hh = do openBufs <- fmap bufkey . toList <$> use windowsA names <- withEditor $ do bs <- toList . fmap bkey <$> getBufferStack let choices = hh openBufs bs prefix <- gets commonNamePrefix forM choices $ \k -> gets (shortIdentString (length prefix) . findBufferWith k) withMinibufferFin prompt names (withEditor . getBufferWithName >=> act) -- | Prompts the user for comment syntax to use for the current mode. commentRegion :: YiM () commentRegion = withCurrentBuffer (gets $ withMode0 modeToggleCommentSelection) >>= \case Nothing -> withMinibufferFree "No comment syntax is defined. Use: " $ \cString -> withCurrentBuffer $ do let toggle = toggleCommentB (R.fromText cString) void toggle modifyMode $ \x -> x { modeToggleCommentSelection = Just toggle } Just b -> withCurrentBuffer b -- | Open a minibuffer window with the given prompt and keymap -- The third argument is an action to perform after the minibuffer -- is opened such as move to the first occurence of a searched for -- string. If you don't need this just supply @return ()@ spawnMinibufferE :: T.Text -> KeymapEndo -> EditorM BufferRef spawnMinibufferE prompt kmMod = do b <- stringToNewBuffer (MemBuffer prompt) mempty -- Now create the minibuffer keymap and switch to the minibuffer window withGivenBuffer b $ modifyMode $ \m -> m { modeKeymap = \kms -> kms { topKeymap = kmMod (insertKeymap kms) } } -- The minibuffer window must not be moved from the position newWindowE places it! -- First: This way the minibuffer is just below the window that was in focus when -- the minibuffer was spawned. This clearly indicates what window is the target of -- some actions. Such as searching or the :w (save) command in the Vim keymap. -- Second: The users of the minibuffer expect the window and buffer that was in -- focus when the minibuffer was spawned to be in focus when the minibuffer is closed -- Given that window focus works as follows: -- - The new window is broguht into focus. -- - The previous window in focus is to the left of the new window in the window -- set list. -- - When a window is deleted and is in focus then the window to the left is brought -- into focus. -- -- If the minibuffer is moved then when the minibuffer is deleted the window brought -- into focus may not be the window that spawned the minibuffer. w <- newWindowE True b windowsA %= PL.insertRight w return b -- | @withMinibuffer prompt completer act@: open a minibuffer with @prompt@. Once -- a string @s@ is obtained, run @act s@. @completer@ can be used to complete -- functions: it returns a list of possible matches. withMinibuffer :: T.Text -> (T.Text -> YiM [T.Text]) -> (T.Text -> YiM ()) -> YiM () withMinibuffer prompt getPossibilities = withMinibufferGen "" giveHint prompt completer (const $ return ()) where giveHint s = catMaybes . fmap (prefixMatch s) <$> getPossibilities s completer = simpleComplete getPossibilities -- | Makes a completion function. mkCompleteFn :: (T.Text -> (T.Text -> Maybe T.Text) -> [T.Text] -> EditorM T.Text) -- ^ List completion, such as 'completeInList'. -> (T.Text -> T.Text -> Maybe T.Text) -- ^ Matcher such as 'prefixMatch' -> (T.Text -> YiM [T.Text]) -- ^ Function to fetch possibilites for completion. -> T.Text -- ^ Input to try and complete against -> YiM T.Text mkCompleteFn completeInListFn match getPossibilities s = do possibles <- getPossibilities s withEditor $ completeInListFn s (match s) possibles simpleComplete :: (T.Text -> YiM [T.Text]) -> T.Text -> YiM T.Text simpleComplete = mkCompleteFn completeInList prefixMatch infixComplete' :: Bool -> (T.Text -> YiM [T.Text]) -> T.Text -> YiM T.Text infixComplete' caseSensitive = mkCompleteFn completeInList' $ containsMatch' caseSensitive infixComplete :: (T.Text -> YiM [T.Text]) -> T.Text -> YiM T.Text infixComplete = infixComplete' True -- | Hint function that does nothing, for use with @'withMinibufferGen'@ noHint :: a -> YiM [a] noHint = const $ return [] noPossibilities :: String -> YiM [ String ] noPossibilities _s = return [] -- | @withMinibufferFree prompt act@: -- Simple version of @'withMinibufferGen'@ withMinibufferFree :: T.Text -> (T.Text -> YiM ()) -> YiM () withMinibufferFree prompt = withMinibufferGen "" noHint prompt return (const $ return ()) -- | @withMinibufferGen proposal getHint prompt completer onTyping act@: -- open a minibuffer with @prompt@, and initial content @proposal@. Once -- a string @s@ is obtained, run @act s@. @completer@ can be used to -- complete inputs by returning an incrementally better match, and -- getHint can give an immediate feedback to the user on the current -- input. -- -- @on Typing@ is an extra action which will fire with every user -- key-press and receives minibuffer contents. Use something like -- @const $ return ()@ if you don't need this. withMinibufferGen :: T.Text -> (T.Text -> YiM [T.Text]) -> T.Text -> (T.Text -> YiM T.Text) -> (T.Text -> YiM ()) -> (T.Text -> YiM ()) -> YiM () withMinibufferGen proposal getHint prompt completer onTyping act = do initialBuffer <- gets currentBuffer initialWindow <- use currentWindowA let innerAction :: YiM () -- ^ Read contents of current buffer (which should be the minibuffer), and -- apply it to the desired action closeMinibuffer = closeBufferAndWindowE >> windowsA %= fromJust . PL.find initialWindow showMatchings = showMatchingsOf . R.toText =<< withCurrentBuffer elemsB showMatchingsOf userInput = printStatus =<< withDefaultStyle <$> getHint userInput withDefaultStyle msg = (msg, defaultStyle) typing = onTyping . R.toText =<< withCurrentBuffer elemsB innerAction = do lineString <- withEditor $ do let bufToText = R.toText <$> withCurrentBuffer elemsB historyFinishGen prompt bufToText lineString <- bufToText closeMinibuffer switchToBufferE initialBuffer -- The above ensures that the action is performed on the buffer -- that originated the minibuffer. return lineString act lineString up = historyMove prompt 1 down = historyMove prompt (-1) rebindings = choice [oneOf [spec KEnter, ctrl $ char 'm'] >>! innerAction, oneOf [spec KUp, meta $ char 'p'] >>! up, oneOf [spec KDown, meta $ char 'n'] >>! down, oneOf [spec KTab, ctrl $ char 'i'] >>! completionFunction completer >>! showMatchings, ctrl (char 'g') ?>>! closeMinibuffer] showMatchingsOf "" withEditor $ do historyStartGen prompt void $ spawnMinibufferE (prompt `T.snoc` ' ') (\bindings -> rebindings <|| (bindings >> write showMatchings >> write typing)) withCurrentBuffer . replaceBufferContent . R.fromText $ replaceShorthands proposal -- | Open a minibuffer, given a finite number of suggestions. withMinibufferFin :: T.Text -> [T.Text] -> (T.Text -> YiM ()) -> YiM () withMinibufferFin prompt possibilities act = withMinibufferGen "" hinter prompt completer (const $ return ()) (act . best) where -- The function for returning the hints provided to the user underneath -- the input, basically all those that currently match. hinter s = return $ match s -- All those which currently match. match s = filter (s `T.isInfixOf`) possibilities -- The best match from the list of matches -- If the string matches completely then we take that -- otherwise we just take the first match. best s | s `elem` matches = s | null matches = s | otherwise = head matches where matches = match s -- We still want "TAB" to complete even though the user could just -- press return with an incomplete possibility. The reason is we -- 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 $ fromMaybe s $ commonTPrefix $ catMaybes (infixMatch s <$> possibilities) -- | TODO: decide whether we should be keeping 'T.Text' here or moving -- to 'YiString'. completionFunction :: (T.Text -> YiM T.Text) -> YiM () completionFunction f = do p <- withCurrentBuffer pointB let r = mkRegion 0 p text <- withCurrentBuffer $ readRegionB r compl <- R.fromText <$> f (R.toText text) -- it's important to do this before removing the text, so if the -- completion function raises an exception, we don't delete the -- buffer contents. withCurrentBuffer $ replaceRegionB r compl class Promptable a where getPromptedValue :: T.Text -> YiM a getPrompt :: Proxy a -> T.Text getMinibuffer :: Proxy a -> T.Text -> (T.Text -> YiM ()) -> YiM () getMinibuffer _ = withMinibufferFree doPrompt :: forall a. Promptable a => (a -> YiM ()) -> YiM () doPrompt act = getMinibuffer witness (getPrompt witness `T.append` ":") (act <=< getPromptedValue) where witness = undefined witness :: Proxy a instance Promptable String where getPromptedValue = return . T.unpack getPrompt _ = "String" instance Promptable Char where getPromptedValue x = if T.null x then error "Please supply a character." else return $ T.head x getPrompt _ = "Char" instance Promptable Int where getPromptedValue = return . read . T.unpack getPrompt _ = "Integer" instance Promptable T.Text where getPromptedValue = return getPrompt _ = "Text" instance Promptable R.YiString where getPromptedValue = return . R.fromText getPrompt _ = "YiString" -- helper functions: getPromptedValueList :: [(T.Text, a)] -> T.Text -> YiM a getPromptedValueList vs s = maybe (error "Invalid choice") return (lookup s vs) getMinibufferList :: [(T.Text, a)] -> Proxy a -> T.Text -> (T.Text -> YiM ()) -> YiM () getMinibufferList vs _ prompt = withMinibufferFin prompt (fmap fst vs) enumAll :: (Enum a, Bounded a, Show a) => [(T.Text, a)] enumAll = fmap (\v -> (T.pack $ show v, v)) [minBound..] instance Promptable Direction where getPromptedValue = getPromptedValueList enumAll getPrompt _ = "Direction" getMinibuffer = getMinibufferList enumAll textUnits :: [(T.Text, TextUnit)] textUnits = [("Character", Character), ("Document", Document), ("Line", Line), ("Paragraph", unitParagraph), ("Word", unitWord), ("ViWord", unitViWord) ] instance Promptable TextUnit where getPromptedValue = getPromptedValueList textUnits getPrompt _ = "Unit" getMinibuffer = getMinibufferList textUnits instance Promptable Point where getPromptedValue s = Point <$> getPromptedValue s getPrompt _ = "Point" anyModeName :: AnyMode -> T.Text anyModeName (AnyMode m) = modeName m -- TODO: Better name anyModeByNameM :: T.Text -> YiM (Maybe AnyMode) anyModeByNameM n = find ((n==) . anyModeName) . modeTable <$> askCfg anyModeByName :: T.Text -> YiM AnyMode anyModeByName n = anyModeByNameM n >>= \case Nothing -> fail $ "anyModeByName: no such mode: " ++ T.unpack n Just m -> return m getAllModeNames :: YiM [T.Text] getAllModeNames = fmap anyModeName . modeTable <$> askCfg instance Promptable AnyMode where getPrompt _ = "Mode" getPromptedValue = anyModeByName getMinibuffer _ prompt act = do names <- getAllModeNames withMinibufferFin prompt names act instance Promptable BufferRef where getPrompt _ = "Buffer" getPromptedValue = getBufferWithNameOrCurrent getMinibuffer _ prompt act = do bufs <- matchingBufferNames withMinibufferFin prompt bufs act -- | Returns all the buffer names matchingBufferNames :: YiM [T.Text] matchingBufferNames = withEditor $ do p <- gets commonNamePrefix bs <- gets bufferSet return $ fmap (shortIdentString $ length p) bs instance (YiAction a x, Promptable r) => YiAction (r -> a) x where makeAction f = YiA $ doPrompt (runAction . makeAction . f) -- | Tag a type with a documentation newtype (:::) t doc = Doc {fromDoc :: t} deriving (Eq, Typeable, Num, IsString) instance Show x => Show (x ::: t) where show (Doc d) = show d instance (DocType doc, Promptable t) => Promptable (t ::: doc) where getPrompt _ = typeGetPrompt (error "typeGetPrompt should not enter its argument" :: doc) getPromptedValue x = Doc <$> getPromptedValue x class DocType t where -- | What to prompt the user when asked this type? typeGetPrompt :: t -> T.Text data LineNumber instance DocType LineNumber where typeGetPrompt _ = "Line" data ToKill instance DocType ToKill where typeGetPrompt _ = "kill buffer" data RegexTag deriving Typeable instance DocType RegexTag where typeGetPrompt _ = "Regex" data FilePatternTag deriving Typeable instance DocType FilePatternTag where typeGetPrompt _ = "File pattern" newtype CommandArguments = CommandArguments [T.Text] deriving (Show, Eq, Typeable) instance Promptable CommandArguments where getPromptedValue = return . CommandArguments . T.words getPrompt _ = "Command arguments" yi-0.12.6/src/library/Yi/Misc.hs0000644000000000000000000002246312717763531014475 0ustar0000000000000000{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Misc -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Various high-level functions to further classify. module Yi.Misc ( getAppropriateFiles, getFolder, cd, pwd, matchingFileNames , rot13Char, placeMark, selectAll, adjBlock, adjIndent , promptFile , promptFileChangingHints, matchFile, completeFile , printFileInfoE, debugBufferContent ) where import Control.Applicative ((<$>), (<*>)) import Control.Monad (filterM, (>=>)) import Control.Monad.Base (liftBase) import Data.Char (chr, isAlpha, isLower, isUpper, ord) import Data.List ((\\)) import Data.Maybe (isNothing) import qualified Data.Text as T (Text, append, concat, isPrefixOf, pack, stripPrefix, unpack) import System.CanonicalizePath (canonicalizePath, replaceShorthands, replaceShorthands) import System.Directory (doesDirectoryExist, getCurrentDirectory, getDirectoryContents, setCurrentDirectory) import System.Environment (lookupEnv) import System.FilePath (addTrailingPathSeparator, hasTrailingPathSeparator, takeDirectory, takeFileName, ()) import System.FriendlyPath (expandTilda, isAbsolute') import Yi.Buffer import Yi.Completion (completeInList') import Yi.Editor (EditorM, printMsg, withCurrentBuffer) import Yi.Keymap (YiM) import Yi.MiniBuffer (debugBufferContent, mkCompleteFn, withMinibufferGen) import Yi.Monad (gets) import qualified Yi.Rope as R (fromText) import Yi.Utils (io) -- | Given a possible starting path (which if not given defaults to -- the current directory) and a fragment of a path we find all files -- within the given (or current) directory which can complete the -- given path fragment. We return a pair of both directory plus the -- filenames on their own that is without their directories. The -- reason for this is that if we return all of the filenames then we -- get a 'hint' which is way too long to be particularly useful. getAppropriateFiles :: Maybe T.Text -> T.Text -> YiM (T.Text, [ T.Text ]) getAppropriateFiles start s' = do curDir <- case start of Nothing -> do bufferPath <- withCurrentBuffer $ gets file liftBase $ getFolder bufferPath Just path -> return $ T.unpack path let s = T.unpack $ replaceShorthands s' sDir = if hasTrailingPathSeparator s then s else takeDirectory s searchDir | null sDir = curDir | isAbsolute' sDir = sDir | otherwise = curDir sDir searchDir' <- liftBase $ expandTilda searchDir let fixTrailingPathSeparator f = do isDir <- doesDirectoryExist (searchDir' f) return . T.pack $ if isDir then addTrailingPathSeparator f else f files <- liftBase $ getDirectoryContents searchDir' -- Remove the two standard current-dir and parent-dir as we do not -- need to complete or hint about these as they are known by users. let files' = files \\ [ ".", ".." ] fs <- liftBase $ mapM fixTrailingPathSeparator files' let matching = filter (T.isPrefixOf . T.pack $ takeFileName s) fs return (T.pack sDir, matching) -- | Given a path, trim the file name bit if it exists. If no path -- given, return current directory. getFolder :: Maybe String -> IO String getFolder Nothing = getCurrentDirectory getFolder (Just path) = do isDir <- doesDirectoryExist path let dir = if isDir then path else takeDirectory path if null dir then getCurrentDirectory else return dir -- | Given a possible path and a prefix, return matching file names. matchingFileNames :: Maybe T.Text -> T.Text -> YiM [T.Text] matchingFileNames start s = do (sDir, files) <- getAppropriateFiles start s -- There is one common case when we don't need to prepend @sDir@ to @files@: -- -- Suppose user just wants to edit a file "foobar" in current directory -- and inputs ":e foo" -- -- @sDir@ in this case equals to "." and "foo" would not be -- a prefix of ("." "foobar"), resulting in a failed completion -- -- However, if user inputs ":e ./foo", we need to prepend @sDir@ to @files@ let results = if isNothing start && sDir == "." && not ("./" `T.isPrefixOf` s) then files else fmap (T.pack . (T.unpack sDir ) . T.unpack) files return results -- | Place mark at current point. If there's an existing mark at point -- already, deactivate mark. placeMark :: BufferM () placeMark = (==) <$> pointB <*> getSelectionMarkPointB >>= \case True -> setVisibleSelection False False -> setVisibleSelection True >> pointB >>= setSelectionMarkPointB -- | Select the contents of the whole buffer selectAll :: BufferM () selectAll = botB >> placeMark >> topB >> setVisibleSelection True adjBlock :: Int -> BufferM () adjBlock x = withSyntaxB' (\m s -> modeAdjustBlock m s x) -- | A simple wrapper to adjust the current indentation using -- the mode specific indentation function but according to the -- given indent behaviour. adjIndent :: IndentBehaviour -> BufferM () adjIndent ib = withSyntaxB' (\m s -> modeIndent m s ib) -- | Generic emacs style prompt file action. Takes a @prompt@ and a continuation -- @act@ and prompts the user with file hints. promptFile :: T.Text -> (T.Text -> YiM ()) -> YiM () promptFile prompt act = promptFileChangingHints prompt (const return) act -- | As 'promptFile' but additionally allows the caller to transform -- the list of hints arbitrarily, such as only showing directories. promptFileChangingHints :: T.Text -- ^ Prompt -> (T.Text -> [T.Text] -> YiM [T.Text]) -- ^ Hint transformer: current path, generated hints -> (T.Text -> YiM ()) -- ^ Action over choice -> YiM () promptFileChangingHints prompt ht act = do maybePath <- withCurrentBuffer $ gets file startPath <- T.pack . addTrailingPathSeparator <$> liftBase (canonicalizePath =<< getFolder maybePath) -- TODO: Just call withMinibuffer withMinibufferGen startPath (\x -> findFileHint startPath x >>= ht x) prompt (completeFile startPath) showCanon (act . replaceShorthands) where showCanon = withCurrentBuffer . replaceBufferContent . R.fromText . replaceShorthands matchFile :: T.Text -> T.Text -> Maybe T.Text matchFile path proposedCompletion = let realPath = replaceShorthands path in T.append path <$> T.stripPrefix realPath proposedCompletion completeFile :: T.Text -> T.Text -> YiM T.Text completeFile startPath = mkCompleteFn completeInList' matchFile $ matchingFileNames (Just startPath) -- | For use as the hint when opening a file using the minibuffer. We -- essentially return all the files in the given directory which have -- the given prefix. findFileHint :: T.Text -> T.Text -> YiM [T.Text] findFileHint startPath s = snd <$> getAppropriateFiles (Just startPath) s onCharLetterCode :: (Int -> Int) -> Char -> Char onCharLetterCode f c | isAlpha c = chr (f (ord c - a) `mod` 26 + a) | otherwise = c where a | isUpper c = ord 'A' | isLower c = ord 'a' | otherwise = undefined -- | Like @M-x cd@, it changes the current working directory. Mighty -- useful when we don't start Yi from the project directory or want to -- switch projects, as many tools only use the current working -- directory. cd :: YiM () cd = promptFileChangingHints "switch directory to:" dirs $ \path -> io $ getFolder (Just $ T.unpack path) >>= clean . T.pack >>= System.Directory.setCurrentDirectory . addTrailingPathSeparator where replaceHome p@('~':'/':xs) = lookupEnv "HOME" >>= return . \case Nothing -> p Just h -> h xs replaceHome p = return p clean = replaceHome . T.unpack . replaceShorthands >=> canonicalizePath x y = T.pack $ takeDirectory (T.unpack x) T.unpack y dirs :: T.Text -> [T.Text] -> YiM [T.Text] dirs x xs = do xsc <- io $ mapM (\y -> (,y) <$> clean (x y)) xs filterM (io . doesDirectoryExist . fst) xsc >>= return . map snd -- | Shows current working directory. Also see 'cd'. pwd :: YiM () pwd = io getCurrentDirectory >>= printMsg . T.pack rot13Char :: Char -> Char rot13Char = onCharLetterCode (+13) printFileInfoE :: EditorM () printFileInfoE = printMsg . showBufInfo =<< withCurrentBuffer bufInfoB where showBufInfo :: BufferFileInfo -> T.Text showBufInfo bufInfo = T.concat [ T.pack $ bufInfoFileName bufInfo , " Line " , T.pack . show $ bufInfoLineNo bufInfo , " [" , bufInfoPercent bufInfo , "]" ] yi-0.12.6/src/library/Yi/Mode/Abella.hs0000644000000000000000000001161712717763531015645 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Abella -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- 'Mode's and utility function for working with the Abella -- interactive theorem prover. module Yi.Mode.Abella ( abellaModeEmacs , abella , abellaEval , abellaEvalFromProofPoint , abellaUndo , abellaGet , abellaSend ) where import Control.Applicative (Applicative ((<*>)), (<$>)) import Control.Lens (assign, use, (%~), (&), (.=), (.~)) import Control.Monad (join, when) import Data.Binary (Binary) import Data.Char (isSpace) import Data.Default (Default) import Data.Maybe (isJust) import qualified Data.Text as T (isInfixOf, snoc, unpack) import Data.Typeable (Typeable) import Yi.Buffer import Yi.Core (sendToProcess) import Yi.Editor import Yi.Keymap (YiM, topKeymapA) import Yi.Keymap.Keys (Event, choice, ctrlCh, (<||), (?*>>!)) import qualified Yi.Lexer.Abella as Abella (Token, lexer) import Yi.MiniBuffer (CommandArguments (..)) import qualified Yi.Mode.Interactive as Interactive (spawnProcess) import Yi.Modes (TokenBasedMode, anyExtension, styleMode) import qualified Yi.Rope as R (YiString, toText) import Yi.Types (YiVariable) abellaModeGen :: (Char -> [Event]) -> TokenBasedMode Abella.Token abellaModeGen abellaBinding = styleMode Abella.lexer & modeNameA .~ "abella" & modeAppliesA .~ anyExtension ["thm"] & modeToggleCommentSelectionA .~ Just (toggleCommentB "%") & modeKeymapA .~ topKeymapA %~ (<||) (choice [ abellaBinding 'p' ?*>>! abellaUndo , abellaBinding 'e' ?*>>! abellaEval , abellaBinding 'n' ?*>>! abellaNext , abellaBinding 'a' ?*>>! abellaAbort , abellaBinding '\r' ?*>>! abellaEvalFromProofPoint ]) abellaModeEmacs :: TokenBasedMode Abella.Token abellaModeEmacs = abellaModeGen (\ch -> [ctrlCh 'c', ctrlCh ch]) newtype AbellaBuffer = AbellaBuffer {_abellaBuffer :: Maybe BufferRef} deriving (Default, Typeable, Binary) instance YiVariable AbellaBuffer getProofPointMark :: BufferM Mark getProofPointMark = getMarkB $ Just "p" getTheoremPointMark :: BufferM Mark getTheoremPointMark = getMarkB $ Just "t" abellaEval :: YiM () abellaEval = do reg <- withCurrentBuffer . savingPointB $ do join (assign . markPointA <$> getProofPointMark <*> pointB) leftB readRegionB =<< regionOfNonEmptyB unitSentence abellaSend reg abellaEvalFromProofPoint :: YiM () abellaEvalFromProofPoint = abellaSend =<< withCurrentBuffer f where f = do mark <- getProofPointMark p <- use $ markPointA mark cur <- pointB markPointA mark .= cur readRegionB $ mkRegion p cur abellaNext :: YiM () abellaNext = do reg <- withCurrentBuffer $ rightB >> (readRegionB =<< regionOfNonEmptyB unitSentence) abellaSend reg withCurrentBuffer $ do moveB unitSentence Forward rightB untilB_ (not . isSpace <$> readB) rightB untilB_ ((/= '%') <$> readB) $ moveToEol >> rightB >> firstNonSpaceB join (assign . markPointA <$> getProofPointMark <*> pointB) abellaUndo :: YiM () abellaUndo = do abellaSend "undo." withCurrentBuffer $ do moveB unitSentence Backward join (assign . markPointA <$> getProofPointMark <*> pointB) abellaAbort :: YiM () abellaAbort = do abellaSend "abort." withCurrentBuffer $ do moveTo =<< use . markPointA =<< getTheoremPointMark join (assign . markPointA <$> getProofPointMark <*> pointB) -- | Start Abella in a buffer abella :: CommandArguments -> YiM BufferRef abella (CommandArguments args) = do b <- Interactive.spawnProcess "abella" (T.unpack <$> args) withEditor . putEditorDyn . AbellaBuffer $ Just b return b -- | Return Abella's buffer; create it if necessary. -- Show it in another window. abellaGet :: YiM BufferRef abellaGet = withOtherWindow $ do AbellaBuffer mb <- withEditor getEditorDyn case mb of Nothing -> abella (CommandArguments []) Just b -> do stillExists <- isJust <$> findBuffer b if stillExists then do withEditor $ switchToBufferE b return b else abella (CommandArguments []) -- | Send a command to Abella abellaSend :: R.YiString -> YiM () abellaSend cmd' = do let cmd = R.toText cmd' when ("Theorem" `T.isInfixOf` cmd) $ withCurrentBuffer $ join (assign . markPointA <$> getTheoremPointMark <*> pointB) b <- abellaGet withGivenBuffer b botB sendToProcess b . T.unpack $ cmd `T.snoc` '\n' yi-0.12.6/src/library/Yi/Mode/Buffers.hs0000644000000000000000000000445612717763531016064 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Buffers -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- A minimalist emulation of emacs buffer menu mode, to be fleshed out later module Yi.Mode.Buffers (listBuffers) where import Control.Applicative ((<$>)) import Control.Category ((>>>)) import Control.Lens (assign, (%~), (.~)) import Data.List.NonEmpty (toList) import qualified Data.Text as T (intercalate, pack) import System.FilePath (takeFileName) import Yi.Buffer import Yi.Editor import Yi.Keymap (Keymap, YiM, topKeymapA) import Yi.Keymap.Keys import qualified Yi.Rope as R (fromText, toString) -- | Retrieve buffer list and open a them in buffer mode using the -- 'bufferKeymap'. listBuffers :: YiM () listBuffers = do withEditor $ do bs <- toList <$> getBufferStack let bufferList = R.fromText . T.intercalate "\n" $ map identString bs bufRef <- stringToNewBuffer (MemBuffer "Buffer List") bufferList switchToBufferE bufRef withCurrentBuffer $ do modifyMode $ modeKeymapA .~ topKeymapA %~ bufferKeymap >>> modeNameA .~ "buffers" assign readOnlyA True -- | Switch to the buffer with name at current name. If it it starts -- with a @/@ then assume it's a file and try to open it that way. switch :: YiM () switch = do -- the YiString -> FilePath -> Text conversion sucks s <- R.toString <$> withCurrentBuffer readLnB let short = T.pack $ if take 1 s == "/" then takeFileName s else s withEditor $ switchToBufferWithNameE short -- | Keymap for the buffer mode. -- -- @ -- __p__ → line up -- __n__ or __SPACE__ → line down -- __ENTER__ or __f__ → open buffer -- __v__ → open buffer as read-only -- @ bufferKeymap :: Keymap -> Keymap bufferKeymap = important $ choice [ char 'p' ?>>! lineUp , oneOf [ char 'n', char ' ' ] >>! lineDown , oneOf [ spec KEnter, char 'f' ] >>! (switch >> setReadOnly False) , char 'v' ?>>! (switch >> setReadOnly True) ] where setReadOnly = withCurrentBuffer . assign readOnlyA yi-0.12.6/src/library/Yi/Mode/Compilation.hs0000644000000000000000000000323012717763531016733 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Compilation -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- A 'Mode' for working with buffers showing the results of compilations. module Yi.Mode.Compilation where import Control.Lens ((%~), (&), (.~)) import Data.Text () import Yi.Buffer import Yi.Core (withSyntax) import Yi.Editor (shiftOtherWindow, withCurrentBuffer) import Yi.File (openingNewFile) import Yi.Keymap (Action (YiA), topKeymapA) import Yi.Keymap.Keys (Key (KEnter), spec, (<||), (?>>!)) import Yi.Lexer.Alex (Posn (..), Tok (..)) import qualified Yi.Lexer.Compilation as Compilation (Token (Report), lexer) import Yi.Modes (TokenBasedMode, styleMode) import qualified Yi.Syntax.OnlineTree as OnlineTree (tokAtOrBefore) mode :: TokenBasedMode Compilation.Token mode = styleMode Compilation.lexer & modeAppliesA .~ modeNeverApplies & modeNameA .~ "compilation" & modeKeymapA .~ topKeymapA %~ ((spec KEnter ?>>! withSyntax modeFollow) <||) & modeFollowA .~ YiA . follow where follow errs = withCurrentBuffer pointB >>= \point -> case OnlineTree.tokAtOrBefore point errs of Just t@Tok {tokT = Compilation.Report filename line col _} -> do withCurrentBuffer . moveTo . posnOfs $ tokPosn t shiftOtherWindow openingNewFile filename $ gotoLn line >> rightN col _ -> return () yi-0.12.6/src/library/Yi/Mode/GHCi.hs0000644000000000000000000000606612717763531015241 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.GHCi -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- A mode for GHCi, implemented as tweaks on Interaction mode module Yi.Mode.GHCi where import GHC.Generics (Generic) import Control.Lens (makeLenses, (%~), (&), (.~)) import Data.Binary (Binary (..)) import Data.Default (Default (..)) import Data.Text () import qualified Data.Text as T (findIndex) import Data.Typeable (Typeable) import Yi.Buffer import Yi.Keymap (YiM, topKeymapA) import Yi.Keymap.Keys (Key (KHome), important, spec, (?>>!)) import Yi.Lexer.Alex (Tok) import Yi.Lexer.Compilation (Token ()) import qualified Yi.Mode.Interactive as I (mode, spawnProcessMode) import qualified Yi.Rope as R (toText) import Yi.Syntax.OnlineTree (Tree) import Yi.Types (YiVariable) -- | The process name to use to spawn GHCi. data GhciProcessName = GhciProcessName { _ghciProcessName :: FilePath -- ^ Command to run when spawning GHCi. , _ghciProcessArgs :: [String] -- ^ Args to pass to the process. } deriving (Typeable, Show, Generic) -- | The process name defaults to @ghci@. instance Default GhciProcessName where def = GhciProcessName { _ghciProcessName = "ghci" , _ghciProcessArgs = [] } instance Binary GhciProcessName makeLenses ''GhciProcessName -- | Setting this is a bit like '(setq haskell-program-name foo)' in -- emacs' @haskell-mode@. instance YiVariable GhciProcessName -- | Mode used for GHCi. Currently it just overrides 'KHome' key to go -- just before the prompt through the use of 'homeKey'. mode :: Mode (Tree (Tok Token)) mode = I.mode & modeNameA .~ "ghci" & modeKeymapA .~ topKeymapA %~ important (spec KHome ?>>! homeKey) -- | The GHCi prompt always begins with ">"; this goes to just before -- it, or if one is already at the start of the prompt, goes to the -- beginning of the line. (If at the beginning of the line, this -- pushes you forward to it.) homeKey :: BufferM () homeKey = readLnB >>= \l -> case T.findIndex ('>' ==) (R.toText l) of Nothing -> moveToSol Just pos -> do (_,mypos) <- getLineAndCol moveToSol >> if mypos == (pos + 2) then return () else moveXorEol (pos + 2) -- | Spawns an interactive process ("Yi.Mode.Interactive") with GHCi -- 'mode' over it. spawnProcess :: FilePath -- ^ Command to use. -> [String] -- ^ Process args. -> YiM BufferRef -- ^ Reference to the spawned buffer. spawnProcess = I.spawnProcessMode mode yi-0.12.6/src/library/Yi/Mode/Haskell.hs0000644000000000000000000005010012717763531016036 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Haskell -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Collection of 'Mode's for working with Haskell. module Yi.Mode.Haskell ( -- * Modes haskellAbstract, cleverMode, preciseMode, literateMode, fastMode, -- * IO-level operations ghciGet, ghciSend, ghciLoadBuffer, ghciInferType, ghciSetProcessName, ghciSetProcessArgs ) where import Prelude hiding (all, concatMap, elem, error, notElem, exp) import Control.Applicative (Applicative ((*>)), (<$>)) import Control.Lens ((&), (.~), (^.)) import Control.Monad (unless, void, when) import Data.Binary (Binary) import Data.Default (Default) import Data.Foldable (Foldable, all, concatMap, elem, forM_, notElem) import Data.Maybe (isJust, listToMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T (any, concat, drop, pack, unpack, unwords) import Data.Typeable (Typeable) import Text.Read (readMaybe) import Yi.Buffer import Yi.Core (sendToProcess) import Yi.Debug (error, trace) import Yi.Editor import Yi.File (fwriteE) import qualified Yi.IncrementalParse as IncrParser (State, scanner) import Yi.Keymap (YiM) import Yi.Lexer.Alex import Yi.Lexer.Haskell as Haskell import qualified Yi.Lexer.LiterateHaskell as LiterateHaskell (HlState, alexScanToken, initState) import Yi.MiniBuffer (noHint, withMinibufferFree, withMinibufferGen) import qualified Yi.Mode.GHCi as GHCi (ghciProcessArgs, ghciProcessName, spawnProcess) import qualified Yi.Mode.Interactive as Interactive (queryReply) import Yi.Modes (anyExtension, extensionOrContentsMatch) import Yi.Monad (gets) import qualified Yi.Rope as R import Yi.String (fillText, showT) import Yi.Syntax (ExtHL (..), Scanner, skipScanner) import qualified Yi.Syntax.Driver as Driver (mkHighlighter) import Yi.Syntax.Haskell as Hask import Yi.Syntax.Layout (State) import Yi.Syntax.OnlineTree as OnlineTree (Tree, manyToks) import Yi.Syntax.Paren as Paren import Yi.Syntax.Strokes.Haskell as HS (getStrokes) import Yi.Syntax.Tree import Yi.Types (YiVariable) import Yi.Utils (groupBy') -- | General ‘template’ for actual Haskell modes. -- -- It applies over @extensions = ["hs", "x", "hsc", "hsinc"]@ which -- may be a little questionable but for now Yi is mostly used by -- Haskell hackers so it should be fine, at least for now. haskellAbstract :: Mode (tree TT) haskellAbstract = emptyMode & modeAppliesA .~ extensionOrContentsMatch extensions shebangPattern & modeNameA .~ "haskell" & modeToggleCommentSelectionA .~ Just (toggleCommentB "--") where extensions = ["hs", "x", "hsc", "hsinc"] shebangPattern = "^#![[:space:]]*/usr/bin/env[[:space:]]+runhaskell" -- | "Clever" haskell mode, using the paren-matching syntax. cleverMode :: Mode (Paren.Tree (Tok Haskell.Token)) cleverMode = haskellAbstract & modeIndentA .~ cleverAutoIndentHaskellB & modeGetStrokesA .~ strokesOfParenTree & modeHLA .~ mkParenModeHL (skipScanner 50) haskellLexer & modeAdjustBlockA .~ adjustBlock & modePrettifyA .~ cleverPrettify . allToks fastMode :: Mode (OnlineTree.Tree TT) fastMode = haskellAbstract & modeNameA .~ "fast haskell" & modeHLA .~ mkOnlineModeHL haskellLexer & modeGetStrokesA .~ tokenBasedStrokes Paren.tokenToStroke literateMode :: Mode (Paren.Tree TT) literateMode = haskellAbstract & modeNameA .~ "literate haskell" & modeAppliesA .~ anyExtension ["lhs"] & modeHLA .~ mkParenModeHL id literateHaskellLexer & modeGetStrokesA .~ strokesOfParenTree -- FIXME I think that 'begin' should not be ignored & modeAdjustBlockA .~ adjustBlock & modeIndentA .~ cleverAutoIndentHaskellB & modePrettifyA .~ cleverPrettify . allToks -- | Experimental Haskell mode, using a rather precise parser for the syntax. preciseMode :: Mode (Hask.Tree TT) preciseMode = haskellAbstract & modeNameA .~ "precise haskell" & modeIndentA .~ cleverAutoIndentHaskellC & modeGetStrokesA .~ (\ast point begin end -> HS.getStrokes point begin end ast) & modeHLA .~ mkHaskModeHL haskellLexer & modePrettifyA .~ cleverPrettify . allToks -- strokesOfParenTree :: Paren.Tree TT -> Point -> Point -> Point -> [Stroke] strokesOfParenTree t p b e = Paren.getStrokes p b e t type CharToTTScanner s = CharScanner -> Scanner (AlexState s) TT mkParenModeHL :: (IsTree tree, Show state) => (Scanner (IncrParser.State (State Token lexState) TT (Paren.Tree TT)) (Paren.Tree TT) -> Scanner state (tree (Tok tt))) -> CharToTTScanner lexState -> ExtHL (tree (Tok tt)) mkParenModeHL f l = ExtHL $ Driver.mkHighlighter scnr where scnr = f . IncrParser.scanner Paren.parse . Paren.indentScanner . l mkHaskModeHL :: Show st => CharToTTScanner st -> ExtHL (Exp (Tok Token)) mkHaskModeHL l = ExtHL $ Driver.mkHighlighter scnr where scnr = IncrParser.scanner Hask.parse . Hask.indentScanner . l mkOnlineModeHL :: Show st => (CharScanner -> Scanner st (Tok tt)) -> ExtHL (OnlineTree.Tree (Tok tt)) mkOnlineModeHL l = ExtHL $ Driver.mkHighlighter scnr where scnr = IncrParser.scanner OnlineTree.manyToks . l haskellLexer :: CharScanner -> Scanner (AlexState Haskell.HlState) TT haskellLexer = lexScanner (commonLexer Haskell.alexScanToken Haskell.initState) literateHaskellLexer :: CharScanner -> Scanner (AlexState LiterateHaskell.HlState) TT literateHaskellLexer = lexScanner (commonLexer LiterateHaskell.alexScanToken LiterateHaskell.initState) adjustBlock :: Paren.Tree (Tok Token) -> Int -> BufferM () adjustBlock e len = do p <- pointB l <- curLn let t = Paren.getIndentingSubtree e p l case t of Nothing -> return () Just it -> savingExcursionB $ do let (_startOfs, height) = Paren.getSubtreeSpan it col <- curCol forM_ [1..height] $ const $ do lineDown indent <- indentOfB =<< readLnB -- it might be that we have 1st column comments in the block, -- which should not be changed. when (indent > col) $ if len >= 0 then do insertN $ R.replicateChar len ' ' leftN len else deleteN (negate len) -- | Returns true if the token should be indented to look as "inside" -- the group. insideGroup :: Token -> Bool insideGroup (Special c) = T.any (== c) "',;})]" insideGroup _ = True -- | 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 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) . filter (not . isErrorTok . tokT) . concatMap allToks let stopsOf :: [Paren.Tree TT] -> [Int] stopsOf (g@(Paren.Paren open ctnt close):ts') | isErrorTok (tokT close) || getLastOffset g >= solPnt = [groupIndent open ctnt] -- stop here: we want to be "inside" that group. | otherwise = stopsOf ts' -- this group is closed before this line; just skip it. stopsOf (Paren.Atom (Tok {tokT = t}):_) | startsLayout t = [nextIndent, previousIndent + indentLevel] -- of; where; etc. we want to start the block here. -- Also use the next line's indent: -- maybe we are putting a new 1st statement in the block here. stopsOf (Paren.Atom _:ts) = stopsOf ts -- any random part of expression, we ignore it. stopsOf (t@(Paren.Block _):ts) = shiftBlock + maybe 0 (posnCol . tokPosn) (getFirstElement t) : stopsOf ts stopsOf (_:ts) = stopsOf ts stopsOf [] = [] firstTokOnLine = fmap tokT $ listToMaybe $ dropWhile ((solPnt >) . tokBegin) $ takeWhile ((eolPnt >) . tokBegin) $ -- for laziness. filter (not . isErrorTok . tokT) $ allToks e shiftBlock = case firstTokOnLine of Just (Reserved t) | t `elem` [Where, Deriving] -> indentLevel Just (ReservedOp Haskell.Pipe) -> indentLevel Just (ReservedOp Haskell.Equal) -> indentLevel _ -> 0 deepInGroup = maybe True insideGroup firstTokOnLine groupIndent (Tok {tokT = Special openChar, tokPosn = Posn _ _ openCol}) ctnt | deepInGroup = case firstTokNotOnLine ctnt of -- examine the first token of the group (but not on the line we are indenting!) Nothing -> openCol + nominalIndent openChar -- no such token: indent normally. Just t -> posnCol . tokPosn $ t -- indent along that other token | otherwise = openCol groupIndent (Tok {}) _ = error "unable to indent code" case getLastPath [e] solPnt of Nothing -> return () Just path -> let stops = stopsOf path in trace ("Stops = " <> showT stops) $ trace ("firstTokOnLine = " <> showT firstTokOnLine) $ cycleIndentsB behaviour stops cleverAutoIndentHaskellC :: Exp TT -> IndentBehaviour -> BufferM () cleverAutoIndentHaskellC e behaviour = do (indentLevel, previousIndent, nextIndent, solPnt, eolPnt) <- indentInfoB let onThisLine ofs = ofs >= solPnt && ofs <= eolPnt firstTokNotOnLine = listToMaybe . filter (not . onThisLine . posnOfs . tokPosn) . filter (not . isErrorTok . tokT) . concatMap allToks let stopsOf :: [Hask.Exp TT] -> [Int] stopsOf (g@(Hask.Paren (Hask.PAtom open _) ctnt (Hask.PAtom close _)):ts) | isErrorTok (tokT close) || getLastOffset g >= solPnt = [groupIndent open ctnt] -- stop here: we want to be "inside" that group. | otherwise = stopsOf ts -- this group is closed before this line; just skip it. stopsOf (Hask.PAtom (Tok {tokT = t}) _:_) | startsLayout t || (t == ReservedOp Equal) = [nextIndent, previousIndent + indentLevel] -- of; where; etc. ends the previous line. We want to start the block here. -- Also use the next line's indent: -- maybe we are putting a new 1st statement in the block here. stopsOf (l@(Hask.PLet _ (Hask.Block _) _):ts') = [colOf' l | lineStartsWith (Reserved Haskell.In)] <> stopsOf ts' -- offer to align with let only if this is an "in" stopsOf (t@(Hask.Block _):ts') = (shiftBlock + colOf' t) : stopsOf ts' -- offer add another statement in the block stopsOf (Hask.PGuard' (PAtom pipe _) _ _:ts') = [tokCol pipe | lineStartsWith (ReservedOp Haskell.Pipe)] <> stopsOf ts' -- offer to align against another guard stopsOf (d@(Hask.PData {}):ts') = colOf' d + indentLevel : stopsOf ts' --FIXME! stopsOf (Hask.RHS (Hask.PAtom{}) exp:ts') = [case firstTokOnLine of Just (Operator op') -> opLength op' (colOf' exp) -- Usually operators are aligned against the '=' sign -- case of an operator should check so that value always is at least 1 _ -> colOf' exp | lineIsExpression ] <> stopsOf ts' -- offer to continue the RHS if this looks like an expression. stopsOf [] = [0] -- maybe it's new declaration in the module stopsOf (_:ts) = stopsOf ts -- by default, there is no reason to indent against an expression. -- calculate indentation of operator (must be at least 1 to be valid) opLength ts' r = let l = r - (length ts' + 1) -- I find this dubious... in if l > 0 then l else 1 lineStartsWith tok = firstTokOnLine == Just tok lineIsExpression = all (`notElem` [ReservedOp Haskell.Pipe, ReservedOp Haskell.Equal, ReservedOp RightArrow]) toksOnLine && not (lineStartsWith (Reserved Haskell.In)) -- TODO: check the tree instead of guessing by looking at tokens firstTokOnLine = listToMaybe toksOnLine toksOnLine = fmap tokT $ dropWhile ((solPnt >) . tokBegin) $ takeWhile ((eolPnt >) . tokBegin) $ -- for laziness. filter (not . isErrorTok . tokT) $ allToks e shiftBlock = case firstTokOnLine of Just (Reserved t) | t `elem` [Where, Deriving] -> indentLevel Just (ReservedOp Haskell.Pipe) -> indentLevel Just (ReservedOp Haskell.Equal) -> indentLevel _ -> 0 deepInGroup = maybe True insideGroup firstTokOnLine groupIndent (Tok {tokT = Special openChar, tokPosn = Posn _ _ openCol}) ctnt | deepInGroup = case firstTokNotOnLine ctnt of -- examine the first token of the group -- (but not on the line we are indenting!) Nothing -> openCol + nominalIndent openChar -- no such token: indent normally. Just t -> posnCol . tokPosn $ t -- indent along that other token | otherwise = openCol groupIndent (Tok{}) _ = error "unable to indent code" case getLastPath [e] solPnt of Nothing -> return () Just path ->let stops = stopsOf path in trace ("Path = " <> showT path) $ trace ("Stops = " <> showT stops) $ trace ("Previous indent = " <> showT previousIndent) $ trace ("Next indent = " <> showT nextIndent) $ trace ("firstTokOnLine = " <> showT firstTokOnLine) $ cycleIndentsB behaviour stops colOf' :: Foldable t => t TT -> Int colOf' = maybe 0 tokCol . getFirstElement tokCol :: Tok t -> Int tokCol = posnCol . tokPosn nominalIndent :: Char -> Int nominalIndent '{' = 2 nominalIndent _ = 1 tokText :: Tok t -> BufferM R.YiString tokText = readRegionB . tokRegion tokRegion :: Tok t -> Region tokRegion t = mkRegion (tokBegin t) (tokEnd t) isLineComment :: TT -> Bool isLineComment = (Just Haskell.Line ==) . tokTyp . tokT contiguous :: Tok t -> Tok t -> Bool contiguous a b = lb - la <= 1 where [la,lb] = fmap (posnLine . tokPosn) [a,b] coalesce :: Tok Token -> Tok Token -> Bool coalesce a b = isLineComment a && isLineComment b && contiguous a b cleverPrettify :: [TT] -> BufferM () cleverPrettify toks = do pnt <- pointB let groups = groupBy' coalesce toks isCommentGroup g = tokTyp (tokT $ head g) `elem` fmap Just [Haskell.Line] thisCommentGroup = listToMaybe $ dropWhile ((pnt >) . tokEnd . last) $ filter isCommentGroup groups -- FIXME: laziness case thisCommentGroup of Nothing -> return () Just g -> do text <- T.unwords . fmap (T.drop 2 . R.toText) <$> mapM tokText g let region = mkRegion (tokBegin . head $ g) (tokEnd . last $ g) mkGrp = const . R.unlines $ R.append "-- " <$> fillText 80 (R.fromText text) modifyRegionB mkGrp region tokTyp :: Token -> Maybe Haskell.CommentType tokTyp (Comment t) = Just t tokTyp _ = Nothing -- TODO: export or remove -- -- Keyword-based auto-indenter for haskell. -- autoIndentHaskellB :: IndentBehaviour -> BufferM () -- autoIndentHaskellB = -- autoIndentWithKeywordsB [ "if" -- , "then" -- , "else" -- , "|" -- , "->" -- , "case" -- hmm -- , "in" -- -- Note tempted by having '=' in here that would -- -- potentially work well for 'data' declarations -- -- but I think '=' is so common in other places -- -- that it would introduce many spurious/annoying -- -- hints. -- ] -- [ "where" -- , "let" -- , "do" -- , "mdo" -- , "{-" -- , "{-|" -- , "--" -- ] -- --------------------------- -- * Interaction with GHCi -- | Variable storing the possibe buffer reference where GHCi is -- currently running. newtype GhciBuffer = GhciBuffer {_ghciBuffer :: Maybe BufferRef} deriving (Default, Typeable, Binary) instance YiVariable GhciBuffer -- | Start GHCi in a buffer ghci :: YiM BufferRef ghci = do g <- getEditorDyn b <- GHCi.spawnProcess (g ^. GHCi.ghciProcessName) (g ^. GHCi.ghciProcessArgs) withEditor . putEditorDyn . GhciBuffer $ Just b return b -- | Return GHCi's buffer; create it if necessary. -- Show it in another window. ghciGet :: YiM BufferRef ghciGet = withOtherWindow $ do GhciBuffer mb <- withEditor getEditorDyn case mb of Nothing -> ghci Just b -> do stillExists <- isJust <$> findBuffer b if stillExists then do withEditor $ switchToBufferE b return b else ghci -- | Send a command to GHCi ghciSend :: String -> YiM () ghciSend cmd = do b <- ghciGet withGivenBuffer b botB sendToProcess b (cmd <> "\n") -- | Load current buffer in GHCi ghciLoadBuffer :: YiM () ghciLoadBuffer = do void fwriteE f <- withCurrentBuffer (gets file) case f of Nothing -> error "Couldn't get buffer filename in ghciLoadBuffer" Just filename -> ghciSend $ ":load " <> show filename -- Tells ghci to infer the type of the identifier at point. Doesn't -- check for errors (yet) ghciInferType :: YiM () ghciInferType = do nm <- withCurrentBuffer (readUnitB unitWord) unless (R.null nm) $ withMinibufferGen (R.toText nm) noHint "Insert type of which identifier?" return (const $ return ()) (ghciInferTypeOf . R.fromText) ghciInferTypeOf :: R.YiString -> YiM () ghciInferTypeOf nm = do buf <- ghciGet result <- Interactive.queryReply buf (":t " <> R.toString nm) let successful = (not . R.null) nm && nm == result when successful . withCurrentBuffer $ moveToSol *> insertB '\n' *> leftB *> insertN result *> rightB ghciSetProcessName :: YiM () ghciSetProcessName = do g <- getEditorDyn let nm = g ^. GHCi.ghciProcessName prompt = T.concat [ "Command to call for GHCi, currently ‘" , T.pack nm, "’: " ] withMinibufferFree prompt $ \s -> putEditorDyn $ g & GHCi.ghciProcessName .~ T.unpack s ghciSetProcessArgs :: YiM () ghciSetProcessArgs = do 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 , ":" ] withMinibufferFree prompt $ \arg -> case readMaybe $ T.unpack arg of Nothing -> printMsg "Could not parse as [String], keep old args." Just arg' -> putEditorDyn $ g & GHCi.ghciProcessArgs .~ arg' yi-0.12.6/src/library/Yi/Mode/Haskell/Dollarify.hs0000644000000000000000000001572112717763531017775 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PatternGuards #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Haskell.Dollarify -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Mode.Haskell.Dollarify where import Control.Applicative (Applicative ((<*>)), (<$>)) import Control.Monad (unless) import Data.Function (on) import Data.List (sortBy) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import Data.Text () import Yi.Buffer hiding (Block) import Yi.Debug (trace) import Yi.Lexer.Alex (Tok (..), posnOfs) import Yi.Lexer.Haskell (TT, Token (..), isComment) import qualified Yi.Rope as R (YiString, null) import Yi.String (showT) import qualified Yi.Syntax.Haskell as H (Exp (..), Tree) import Yi.Syntax.Paren (Expr, Tree (..)) import Yi.Syntax.Tree (getAllSubTrees, getFirstOffset, getLastOffset, getLastPath) dollarify :: Tree TT -> BufferM () dollarify t = maybe (return ()) dollarifyWithin . selectedTree [t] =<< getSelectRegionB dollarifyWithin :: Tree TT -> BufferM () dollarifyWithin = trace . ("dollarifyWithin: " <>) . showT <*> runQ . (dollarifyTop =<<) . getAllSubTrees data QueuedUpdate = QueuedUpdate { qUpdatePoint :: Point , qInsert :: R.YiString , qDelete :: Int } deriving (Eq, Ord, Show) runQ :: [QueuedUpdate] -> BufferM () runQ = trace . ("runQ: " <>) . showT <*> mapM_ run1Q . sortBy (flip compare) where run1Q :: QueuedUpdate -> BufferM () run1Q (QueuedUpdate { qUpdatePoint = p, qInsert = i, qDelete = d }) = do deleteNAt Forward d p unless (R.null i) $ insertNAt i p openParen, closeParen :: Token openParen = Special '(' closeParen = Special ')' isNormalParen :: Tree TT -> Bool isNormalParen (Paren t1 xs t2) = tokT t1 == openParen && tokT t2 == closeParen && not (any isTuple xs) isNormalParen _ = False isTuple ::Tree TT -> Bool isTuple (Atom t) = tokT t == Special ',' isTuple _ = False -- Assumes length of token is one character queueDelete :: TT -> QueuedUpdate queueDelete = queueReplaceWith "" -- Assumes length of token is one character queueReplaceWith :: R.YiString -> TT -> QueuedUpdate queueReplaceWith s t = QueuedUpdate { qUpdatePoint = posnOfs $ tokPosn t , qInsert = s , qDelete = 1 } -- Only strips comments from the top level stripComments :: Expr TT -> Expr TT stripComments = filter $ \t -> case t of { (Atom x) -> not (isComment $ tokT x); _ -> True } dollarifyTop :: Tree TT -> [QueuedUpdate] dollarifyTop p@(Paren t1 e t2) | isNormalParen p = case stripComments e of [Paren{}] -> [queueDelete t2, queueDelete t1] e' -> dollarifyExpr e' dollarifyTop (Block blk) = dollarifyExpr . stripComments =<< [x | Expr x <- blk] dollarifyTop _ = [] -- Expression must not contain comments dollarifyExpr :: Expr TT -> [QueuedUpdate] dollarifyExpr e@(_:_) | p@(Paren t e2 t2) <- last e , isNormalParen p , all isSimple e = let dollarifyLoop :: Expr TT -> [QueuedUpdate] dollarifyLoop [] = [] dollarifyLoop e3@[Paren{}] = dollarifyExpr e3 dollarifyLoop e3 = if isCollapsible e3 then [queueDelete t2, queueReplaceWith "$ " t] else [] in dollarifyLoop $ stripComments e2 dollarifyExpr _ = [] isSimple :: Tree TT -> Bool isSimple (Paren{}) = True isSimple (Block{}) = False isSimple (Atom t) = tokT t `elem` [Number, CharTok, StringTok, VarIdent, ConsIdent] isSimple _ = False -- Expression must not contain comments isCollapsible :: Expr TT -> Bool isCollapsible = ((&&) `on` isSimple) . head <*> last selectedTree :: Expr TT -> Region -> Maybe (Tree TT) selectedTree e r = findLargestWithin r <$> getLastPath e (regionLast r) -- List must be non-empty findLargestWithin :: Region -> [Tree TT] -> Tree TT findLargestWithin r = fromMaybe . head <*> safeLast . takeWhile (within r) within :: Region -> Tree TT -> Bool within r t = includedRegion ((mkRegion . getFirstOffset <*> getLastOffset) t) r safeLast :: [a] -> Maybe a safeLast [] = Nothing safeLast s = return $ last s -- Here follows code for the precise haskell mode dollarifyP :: H.Tree TT -> BufferM () dollarifyP e = maybe (return ()) dollarifyWithinP . selectedTreeP [e] =<< getSelectRegionB dollarifyWithinP :: H.Exp TT -> BufferM () dollarifyWithinP = trace . ("dollarifyWithin: " <>) . showT <*> runQ . (dollarifyTopP =<<) . getAllSubTrees isNormalParenP :: H.Exp TT -> Bool isNormalParenP (H.Paren (H.PAtom r _) xs (H.PAtom r' _)) = tokT r == openParen && tokT r' == closeParen && not (any isTupleP xs) isNormalParenP _ = False isTupleP :: H.Exp TT -> Bool isTupleP (H.PAtom t _) = tokT t == Special ',' isTupleP _ = False -- Only strips comments from the top level stripCommentsP :: [H.Exp TT] -> [H.Exp TT] stripCommentsP = filter $ \t -> case t of { (H.PAtom x _) -> not (isComment $ tokT x); _ -> True } dollarifyTopP :: H.Exp TT -> [QueuedUpdate] dollarifyTopP p@(H.Paren (H.PAtom t1 _) e (H.PAtom t2 _)) | isNormalParenP p = case stripCommentsP e of [H.Paren{}] -> [queueDelete t2, queueDelete t1] e' -> dollarifyExprP e' dollarifyTopP (H.Block bList) = dollarifyExprP . stripCommentsP $ bList dollarifyTopP _ = [] -- Expression must not contain comments dollarifyExprP :: [H.Exp TT] -> [QueuedUpdate] dollarifyExprP e@(_:_) | p@(H.Paren (H.PAtom t _) e2 (H.PAtom t2 _)) <- last e , isNormalParenP p , all isSimpleP e = let dollarifyLoop :: [H.Exp TT] -> [QueuedUpdate] dollarifyLoop [] = [] dollarifyLoop e3@[H.Paren{}] = dollarifyExprP e3 dollarifyLoop e3 = if isCollapsibleP e3 then [queueDelete t2, queueReplaceWith "$ " t] else [] in dollarifyLoop $ stripCommentsP e2 dollarifyExprP _ = [] isSimpleP :: H.Exp TT -> Bool isSimpleP (H.Paren{}) = True isSimpleP (H.Block{}) = False isSimpleP (H.PAtom t _) = tokT t `elem` [Number, CharTok, StringTok, VarIdent, ConsIdent] isSimpleP _ = False -- Expression must not contain comments isCollapsibleP :: [H.Exp TT] -> Bool isCollapsibleP = ((&&) `on` isSimpleP) . head <*> last selectedTreeP :: [H.Exp TT] -> Region -> Maybe (H.Exp TT) selectedTreeP e r = findLargestWithinP r <$> getLastPath e (regionLast r) -- List must be non-empty findLargestWithinP :: Region -> [H.Exp TT] -> H.Exp TT findLargestWithinP r = fromMaybe . head <*> safeLast . takeWhile (withinP r) withinP :: Region -> H.Exp TT -> Bool withinP r t = includedRegion ((mkRegion . getFirstOffset <*> getLastOffset) t) r safeLastP :: [a] -> Maybe a safeLastP [] = Nothing safeLastP s = return $ last s yi-0.12.6/src/library/Yi/Mode/IReader.hs0000644000000000000000000000261412717763531015775 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.IReader -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- A simple text mode; it does very little besides define a comment -- syntax. We have it as a separate mode so users can bind the -- commands to this mode specifically. module Yi.Mode.IReader where import Control.Lens ((%~)) import Data.Char (intToDigit) import Data.Text () import Yi.Buffer.Misc import Yi.Editor (printMsg, withCurrentBuffer) import Yi.IReader import Yi.Keymap (YiM, topKeymapA) import Yi.Keymap.Keys (choice, important, metaCh, (?>>!)) import Yi.Modes (anyExtension, fundamentalMode) abstract :: Mode syntax abstract = fundamentalMode { modeApplies = anyExtension ["irtxt"] , modeKeymap = topKeymapA %~ ikeys } where ikeys = important $ choice m m = [ metaCh '`' ?>>! saveAsNewArticle , metaCh '0' ?>>! deleteAndNextArticle ] ++ map (\x -> metaCh (intToDigit x) ?>>! saveAndNextArticle x) [1..9] ireaderMode :: Mode syntax ireaderMode = abstract { modeName = "interactive reading of text" } ireadMode :: YiM () ireadMode = do withCurrentBuffer $ setAnyMode $ AnyMode ireaderMode nextArticle printMsg "M-` new; M-0 delete; M-[1-9]: save w/higher priority" yi-0.12.6/src/library/Yi/Mode/Interactive.hs0000644000000000000000000001104012717763531016730 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Interactive -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Collection of 'Mode's for working with Haskell. module Yi.Mode.Interactive where import Control.Applicative ((<$>)) import Control.Concurrent (threadDelay) import Control.Lens (use, (%~), (.=)) import Data.Monoid ((<>)) import qualified Data.Text as T (Text) import Yi.Buffer import Yi.Core (sendToProcess, startSubprocess, withSyntax) import Yi.Editor import Yi.History (historyFinishGen, historyMoveGen, historyStartGen) import Yi.Keymap (YiM, topKeymapA) import Yi.Keymap.Keys (Key (KEnter, KHome), char, choice, meta, spec, (<||), (?>>!)) import Yi.Lexer.Alex (Tok) import Yi.Lexer.Compilation (Token) import qualified Yi.Mode.Compilation as Compilation (mode) import Yi.Modes (lookupMode) import Yi.Monad (gets) import qualified Yi.Rope as R (YiString, fromText, toString, toText) import qualified Yi.Syntax.OnlineTree as OnlineTree (Tree) import Yi.Utils (io) mode :: Mode (OnlineTree.Tree (Tok Token)) mode = Compilation.mode { modeApplies = modeNeverApplies, modeName = "interactive", modeKeymap = topKeymapA %~ (<||) (choice [spec KHome ?>>! moveToSol, spec KEnter ?>>! do eof <- withCurrentBuffer atLastLine if eof then feedCommand else withSyntax modeFollow, meta (char 'p') ?>>! interactHistoryMove 1, meta (char 'n') ?>>! interactHistoryMove (-1) ]) } interactId :: T.Text interactId = "Interact" -- | TODO: we're just converting back and forth here, 'historyMoveGen' -- and friends need to migrate to YiString it seems. interactHistoryMove :: Int -> EditorM () interactHistoryMove delta = historyMoveGen interactId delta (R.toText <$> withCurrentBuffer getInput) >>= inp where inp = withCurrentBuffer . setInput . R.fromText interactHistoryFinish :: EditorM () interactHistoryFinish = historyFinishGen interactId (R.toText <$> withCurrentBuffer getInput) interactHistoryStart :: EditorM () interactHistoryStart = historyStartGen interactId getInputRegion :: BufferM Region getInputRegion = do mo <- getMarkB (Just "StdOUT") p <- pointAt botB q <- use $ markPointA mo return $ mkRegion p q getInput :: BufferM R.YiString getInput = readRegionB =<< getInputRegion setInput :: R.YiString -> BufferM () setInput val = flip replaceRegionB val =<< getInputRegion -- | Open a new buffer for interaction with a process. spawnProcess :: String -> [String] -> YiM BufferRef spawnProcess = spawnProcessMode mode -- | open a new buffer for interaction with a process, using any -- interactive-derived mode spawnProcessMode :: Mode syntax -> FilePath -> [String] -> YiM BufferRef spawnProcessMode interMode cmd args = do b <- startSubprocess cmd args (const $ return ()) withEditor interactHistoryStart mode' <- lookupMode $ AnyMode interMode withCurrentBuffer $ do m1 <- getMarkB (Just "StdERR") m2 <- getMarkB (Just "StdOUT") modifyMarkB m1 (\v -> v {markGravity = Backward}) modifyMarkB m2 (\v -> v {markGravity = Backward}) setAnyMode mode' return b -- | Send the type command to the process feedCommand :: YiM () feedCommand = do b <- gets currentBuffer withEditor interactHistoryFinish cmd <- withCurrentBuffer $ do botB newlineB me <- getMarkB (Just "StdERR") mo <- getMarkB (Just "StdOUT") p <- pointB q <- use $ markPointA mo cmd <- readRegionB $ mkRegion p q markPointA me .= p markPointA mo .= p return $ R.toString cmd withEditor interactHistoryStart sendToProcess b cmd -- | Send command, recieve reply queryReply :: BufferRef -> String -> YiM R.YiString queryReply buf cmd = do start <- withGivenBuffer buf (botB >> pointB) sendToProcess buf (cmd <> "\n") io $ threadDelay 50000 -- Hack to let ghci finish writing its output. withGivenBuffer buf $ do botB moveToSol leftB -- There is probably a much better way to do this moving around, but it works end <- pointB result <- readRegionB (mkRegion start end) botB return result yi-0.12.6/src/library/Yi/Mode/JavaScript.hs0000644000000000000000000001271212717763531016530 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.JavaScript -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Module defining the 'Mode' for JavaScript. 'javaScriptMode' uses -- the parser defined at "Yi.Syntax.JavaScript". module Yi.Mode.JavaScript (javaScriptMode, hooks) where import Control.Applicative ((<$>)) import Control.Lens ((%~)) import Control.Monad.Writer.Lazy (execWriter) import Data.Binary (Binary) import Data.Default (Default) import Data.DList as D (toList) import Data.Foldable as F (toList) import Data.List (nub) import Data.Maybe (isJust) import Data.Monoid (Monoid (mempty), (<>)) import qualified Data.Text as T (unlines) import Data.Typeable (Typeable) import System.FilePath.Posix (takeBaseName) import Yi.Buffer import Yi.Core (withSyntax) import Yi.Editor import Yi.Event (Event (..), Key (..)) import Yi.File (fwriteE) import Yi.IncrementalParse (scanner) import Yi.Interact (choice) import Yi.Keymap (Action (..), YiM, topKeymapA) import Yi.Keymap.Keys (ctrlCh, important, (?>>), (?>>!)) import Yi.Lexer.Alex (AlexState, CharScanner, Tok, commonLexer, lexScanner) import Yi.Lexer.JavaScript (HlState, TT, Token, alexScanToken, initState) import Yi.Modes (anyExtension) import Yi.Monad (gets) import qualified Yi.Rope as R (fromString, fromText) import Yi.String (showT) import Yi.Syntax (ExtHL (..), Scanner, mkHighlighter) import Yi.Syntax.JavaScript (Tree, getStrokes, parse) import Yi.Syntax.Tree (getLastPath) import Yi.Types (YiVariable) import Yi.Verifier.JavaScript (verify) javaScriptAbstract :: Mode syntax javaScriptAbstract = emptyMode { modeApplies = anyExtension ["js"] , modeName = "javascript" , modeToggleCommentSelection = Just (toggleCommentB "//") } javaScriptMode :: Mode (Tree TT) javaScriptMode = javaScriptAbstract { modeIndent = jsSimpleIndent , modeHL = ExtHL $ mkHighlighter (scanner parse . jsLexer) , modeGetStrokes = getStrokes } jsSimpleIndent :: Tree TT -> IndentBehaviour -> BufferM () jsSimpleIndent t behave = do indLevel <- shiftWidth <$> indentSettingsB prevInd <- getNextNonBlankLineB Backward >>= indentOfB solPnt <- pointAt moveToSol let path = getLastPath (F.toList t) solPnt case path of Nothing -> indentTo [indLevel, 0] Just _ -> indentTo [prevInd, prevInd + indLevel, prevInd - indLevel] where -- Given a list of possible columns to indent to, removes any -- duplicates from it and cycles between the resulting -- indentations. indentTo :: [Int] -> BufferM () indentTo = cycleIndentsB behave . nub jsLexer :: CharScanner -> Scanner (AlexState HlState) (Tok Token) jsLexer = lexScanner (commonLexer alexScanToken initState) -------------------------------------------------------------------------------- -- tta :: Yi.Lexer.Alex.Tok Token -> Maybe (Yi.Syntax.Span String) -- tta = sequenceA . tokToSpan . (fmap Main.tokenToText) -- | Hooks for the JavaScript mode. hooks :: Mode (Tree TT) -> Mode (Tree TT) hooks mode = mode { modeKeymap = topKeymapA %~ important (choice m) , modeFollow = YiA . jsCompile } where m = [ ctrlCh 'c' ?>> ctrlCh 'l' ?>>! withSyntax modeFollow , Event KEnter [] ?>>! newlineAndIndentB ] newtype JSBuffer = JSBuffer (Maybe BufferRef) deriving (Default, Typeable, Binary) instance YiVariable JSBuffer -- | The "compiler." jsCompile :: Tree TT -> YiM () jsCompile tree = do _ <- fwriteE Just filename <- withCurrentBuffer $ gets file buf <- getJSBuffer withOtherWindow $ withEditor $ switchToBufferE buf jsErrors filename buf (D.toList $ execWriter $ verify tree) -- | Returns the JS verifier buffer, creating it if necessary. getJSBuffer :: YiM BufferRef getJSBuffer = withOtherWindow $ do JSBuffer mb <- withEditor getEditorDyn case mb of Nothing -> mkJSBuffer Just b -> do stillExists <- isJust <$> findBuffer b if stillExists then return b else mkJSBuffer -- | Creates a new empty buffer and returns it. mkJSBuffer :: YiM BufferRef mkJSBuffer = stringToNewBuffer (MemBuffer "js") mempty -- | Given a filename, a BufferRef and a list of errors, prints the -- errors in that buffer. jsErrors :: Show a => String -> BufferRef -> [a] -> YiM () jsErrors fname buf errs = let problems = T.unlines $ map item errs item x = "* " <> showT x str = if null errs then "No problems found!" else "Problems in " <> R.fromString (takeBaseName fname) <> ":\n" <> R.fromText problems in withGivenBuffer buf (replaceBufferContent str) yi-0.12.6/src/library/Yi/Mode/Latex.hs0000644000000000000000000000426612717763531015544 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Mode.Latex -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Collection of 'Mode's for working with LaTeX. module Yi.Mode.Latex (latexMode3, latexMode2, fastMode) where import Data.Text () import Yi.Buffer import qualified Yi.IncrementalParse as IncrParser (scanner) import Yi.Lexer.Alex (AlexState, CharScanner, Tok, commonLexer, lexScanner) import qualified Yi.Lexer.Latex as Latex (HlState, Token, alexScanToken, initState) import Yi.Modes (anyExtension, fundamentalMode) import Yi.Syntax (ExtHL (ExtHL), Scanner, mkHighlighter) import qualified Yi.Syntax.Driver as Driver (mkHighlighter) import qualified Yi.Syntax.Latex as Latex (TT, Tree, getStrokes, parse, tokenToStroke) import Yi.Syntax.OnlineTree (Tree, manyToks) import Yi.Syntax.Tree (tokenBasedStrokes) abstract :: Mode syntax abstract = fundamentalMode { modeApplies = anyExtension ["tex", "sty", "ltx"], modeToggleCommentSelection = Just (toggleCommentB "%") } fastMode :: Mode (Tree Latex.TT) fastMode = abstract { modeName = "fast latex", modeHL = ExtHL $ mkHighlighter (IncrParser.scanner manyToks . latexLexer), modeGetStrokes = tokenBasedStrokes Latex.tokenToStroke } -- | syntax-based latex mode latexMode2 :: Mode (Latex.Tree Latex.TT) latexMode2 = abstract { modeName = "latex", modeHL = ExtHL $ mkHighlighter (IncrParser.scanner Latex.parse . latexLexer), modeGetStrokes = \t point begin end -> Latex.getStrokes point begin end t } -- | syntax-based latex mode latexMode3 :: Mode (Latex.Tree Latex.TT) latexMode3 = abstract { modeName = "latex", modeHL = ExtHL $ Driver.mkHighlighter (IncrParser.scanner Latex.parse . latexLexer), modeGetStrokes = \t point begin end -> Latex.getStrokes point begin end t } latexLexer :: CharScanner -> Scanner (AlexState Latex.HlState) (Tok Latex.Token) latexLexer = lexScanner (commonLexer Latex.alexScanToken Latex.initState) yi-0.12.6/src/library/Yi/Modes.hs0000644000000000000000000002330112717763531014641 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Modes -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Definitions for the bulk of modes shipped with Yi. module Yi.Modes (TokenBasedMode, fundamentalMode, cMode, objectiveCMode, cppMode, cabalMode, clojureMode, srmcMode, ocamlMode, ottMode, gnuMakeMode, perlMode, pythonMode, javaMode, jsonMode, anyExtension, extensionOrContentsMatch, linearSyntaxMode, svnCommitMode, hookModes, applyModeHooks, lookupMode, whitespaceMode, gitCommitMode, rubyMode, styleMode ) where import Control.Applicative ((<$>)) import Control.Lens ((%~), (&), (.~), (^.)) import Data.List (isPrefixOf) import Data.Maybe (fromMaybe, isJust) import System.FilePath (takeDirectory, takeExtension, takeFileName) import qualified Data.Text as T (Text) import qualified Data.Text.ICU as ICU (regex, find, MatchOption(..)) import Yi.Buffer import qualified Yi.IncrementalParse as IncrParser (scanner) import Yi.Keymap (YiM) import Yi.Lexer.Alex import qualified Yi.Lexer.C as C (lexer) import qualified Yi.Lexer.Cabal as Cabal (lexer) import qualified Yi.Lexer.Clojure as Clojure (lexer) import qualified Yi.Lexer.Cplusplus as Cplusplus (lexer) import qualified Yi.Lexer.GitCommit as GitCommit (Token, lexer) import qualified Yi.Lexer.GNUMake as GNUMake (lexer) import qualified Yi.Lexer.Java as Java (lexer) import qualified Yi.Lexer.JSON as JSON (lexer) import qualified Yi.Lexer.ObjectiveC as ObjectiveC (lexer) import qualified Yi.Lexer.OCaml as OCaml (Token, lexer) import qualified Yi.Lexer.Ott as Ott (lexer) import qualified Yi.Lexer.Perl as Perl (lexer) import qualified Yi.Lexer.Python as Python (lexer) import qualified Yi.Lexer.Ruby as Ruby (lexer) import qualified Yi.Lexer.Srmc as Srmc (lexer) import qualified Yi.Lexer.SVNCommit as SVNCommit (lexer) import qualified Yi.Lexer.Whitespace as Whitespace (lexer) import Yi.MiniBuffer (anyModeByNameM) import qualified Yi.Rope as R (YiString, toText) import Yi.Search (makeSimpleSearch) import Yi.Style (StyleName) import Yi.Syntax (ExtHL (ExtHL)) import Yi.Syntax.Driver (mkHighlighter) import Yi.Syntax.OnlineTree (Tree, manyToks) import Yi.Syntax.Tree (tokenBasedStrokes) type TokenBasedMode tok = Mode (Tree (Tok tok)) type StyleBasedMode = TokenBasedMode StyleName fundamentalMode :: Mode syntax fundamentalMode = emptyMode { modeName = "fundamental" , modeApplies = modeAlwaysApplies , modeIndent = const autoIndentB , modePrettify = const fillParagraph , modeGotoDeclaration = do currentPoint <- pointB currentWord <- readCurrentWordB currentWordBeginningPoint <- regionStart <$> regionOfB unitWord _ <- gotoLn 0 word <- return $ makeSimpleSearch currentWord searchResults <- regexB Forward word case searchResults of (declarationRegion : _) -> do searchPoint <- return $ regionStart declarationRegion if currentWordBeginningPoint /= searchPoint then moveTo searchPoint else moveTo currentPoint [] -> moveTo currentPoint } -- | Creates a 'TokenBasedMode' from a 'Lexer' and a function that -- turns tokens into 'StyleName'. linearSyntaxMode' :: Show (l s) => Lexer l s (Tok t) i -> (t -> StyleName) -> TokenBasedMode t linearSyntaxMode' scanToken tts = fundamentalMode & modeHLA .~ ExtHL (mkHighlighter $ IncrParser.scanner manyToks . lexer) & modeGetStrokesA .~ tokenBasedStrokes tokenToStroke where tokenToStroke = fmap tts . tokToSpan lexer = lexScanner scanToken -- | Specialised version of 'linearSyntaxMode'' for the common case, -- wrapping up into a 'Lexer' with 'commonLexer'. linearSyntaxMode :: Show s => s -- ^ Starting state -> TokenLexer AlexState s (Tok t) AlexInput -> (t -> StyleName) -> TokenBasedMode t linearSyntaxMode initSt scanToken = linearSyntaxMode' (commonLexer scanToken initSt) styleMode :: Show (l s) => StyleLexer l s t i -> TokenBasedMode t styleMode l = linearSyntaxMode' (l ^. styleLexer) (l ^. tokenToStyle) cMode :: StyleBasedMode cMode = styleMode C.lexer & modeNameA .~ "c" & modeAppliesA .~ anyExtension [ "c", "h" ] objectiveCMode :: StyleBasedMode objectiveCMode = styleMode ObjectiveC.lexer & modeNameA .~ "objective-c" & modeAppliesA .~ anyExtension [ "m", "mm" ] cppMode :: StyleBasedMode cppMode = styleMode Cplusplus.lexer & modeAppliesA .~ anyExtension [ "cxx", "cpp", "hxx" ] & modeNameA .~ "c++" cabalMode :: StyleBasedMode cabalMode = styleMode Cabal.lexer & modeNameA .~ "cabal" & modeAppliesA .~ anyExtension [ "cabal" ] & modeToggleCommentSelectionA .~ Just (toggleCommentB "--") clojureMode :: StyleBasedMode clojureMode = styleMode Clojure.lexer & modeNameA .~ "clojure" & modeAppliesA .~ anyExtension [ "clj", "edn" ] srmcMode :: StyleBasedMode srmcMode = styleMode Srmc.lexer & modeNameA .~ "srmc" & modeAppliesA .~ anyExtension [ "pepa", "srmc" ] -- pepa is a subset of srmc gitCommitMode :: TokenBasedMode GitCommit.Token gitCommitMode = styleMode GitCommit.lexer & modeNameA .~ "git-commit" & modeAppliesA .~ isCommit where isCommit p _ = case (takeFileName p, takeFileName $ takeDirectory p) of ("COMMIT_EDITMSG", ".git") -> True _ -> False svnCommitMode :: StyleBasedMode svnCommitMode = styleMode SVNCommit.lexer & modeNameA .~ "svn-commit" & modeAppliesA .~ isCommit where isCommit p _ = "svn-commit" `isPrefixOf` p && extensionMatches ["tmp"] p ocamlMode :: TokenBasedMode OCaml.Token ocamlMode = styleMode OCaml.lexer & modeNameA .~ "ocaml" & modeAppliesA .~ anyExtension [ "ml", "mli", "mly" , "mll", "ml4", "mlp4" ] perlMode :: StyleBasedMode perlMode = styleMode Perl.lexer & modeNameA .~ "perl" & modeAppliesA .~ anyExtension [ "t", "pl", "pm" ] rubyMode :: StyleBasedMode rubyMode = styleMode Ruby.lexer & modeNameA .~ "ruby" & modeAppliesA .~ anyExtension [ "rb", "ru" ] pythonMode :: StyleBasedMode pythonMode = base & modeNameA .~ "python" & modeAppliesA .~ anyExtension [ "py" ] & modeToggleCommentSelectionA .~ Just (toggleCommentB "#") & modeIndentSettingsA %~ (\x -> x { expandTabs = True, tabSize = 4 }) where base = styleMode Python.lexer javaMode :: StyleBasedMode javaMode = styleMode Java.lexer & modeNameA .~ "java" & modeAppliesA .~ anyExtension [ "java" ] jsonMode :: StyleBasedMode jsonMode = styleMode JSON.lexer & modeNameA .~ "json" & modeAppliesA .~ anyExtension [ "json" ] gnuMakeMode :: StyleBasedMode gnuMakeMode = styleMode GNUMake.lexer & modeNameA .~ "Makefile" & modeAppliesA .~ isMakefile & modeIndentSettingsA %~ (\x -> x { expandTabs = False, shiftWidth = 8 }) where isMakefile :: FilePath -> a -> Bool isMakefile path _contents = matches $ takeFileName path where matches "Makefile" = True matches "makefile" = True matches "GNUmakefile" = True matches filename = extensionMatches [ "mk" ] filename ottMode :: StyleBasedMode ottMode = styleMode Ott.lexer & modeNameA .~ "ott" & modeAppliesA .~ anyExtension [ "ott" ] whitespaceMode :: StyleBasedMode whitespaceMode = styleMode Whitespace.lexer & modeNameA .~ "whitespace" & modeAppliesA .~ anyExtension [ "ws" ] & modeIndentA .~ (\_ _ -> insertB '\t') -- | Determines if the file's extension is one of the extensions in the list. extensionMatches :: [String] -> FilePath -> Bool extensionMatches extensions fileName = extension `elem` extensions' where extension = takeExtension fileName extensions' = ['.' : ext | ext <- extensions] -- | When applied to an extensions list, creates a 'Mode.modeApplies' function. anyExtension :: [String] -- ^ List of extensions -> FilePath -- ^ Path to compare against -> a -- ^ File contents. Currently unused but see -- 'extensionOrContentsMatch'. -> Bool anyExtension extensions fileName _contents = extensionMatches extensions fileName -- | When applied to an extensions list and regular expression pattern, creates -- a 'Mode.modeApplies' function. extensionOrContentsMatch :: [String] -> T.Text -> FilePath -> R.YiString -> Bool extensionOrContentsMatch extensions pattern fileName contents = extensionMatches extensions fileName || isJust m where r = ICU.regex [] pattern m = ICU.find r $ R.toText contents -- | Adds a hook to all matching hooks in a list hookModes :: (AnyMode -> Bool) -> BufferM () -> [AnyMode] -> [AnyMode] hookModes p h = map $ \am@(AnyMode m) -> if p am then AnyMode (m & modeOnLoadA %~ (>> h)) else am -- | Apply a list of mode hooks to a list of AnyModes applyModeHooks :: [(AnyMode -> Bool, BufferM ())] -> [AnyMode] -> [AnyMode] applyModeHooks hs ms = flip map ms $ \am -> case filter (($ am) . fst) hs of [] -> am ls -> onMode (modeOnLoadA %~ \x -> foldr ((>>) . snd) x ls) am -- | Check whether a mode of the same name is already in modeTable and -- returns the original mode, if it isn't the case. lookupMode :: AnyMode -> YiM AnyMode lookupMode am@(AnyMode m) = fromMaybe am <$> anyModeByNameM (modeName m) yi-0.12.6/src/library/Yi/Monad.hs0000644000000000000000000000217312717763531014634 0ustar0000000000000000module Yi.Monad ( gets, getsAndModify, maybeM, repeatUntilM, whenM, with, ) where import Control.Monad.Base (MonadBase, liftBase) import Control.Monad.Reader (MonadReader, ask) import Control.Monad.State (MonadState, get, gets, put, when) -- | Combination of the Control.Monad.State 'modify' and 'gets' getsAndModify :: MonadState s m => (s -> (s,a)) -> m a getsAndModify f = do e <- get let (e',result) = f e put e' return result with :: (MonadReader r m, MonadBase b m) => (r -> a) -> (a -> b c) -> m c with f g = do yi <- ask liftBase $ g (f yi) whenM :: Monad m => m Bool -> m () -> m () whenM mtest ma = mtest >>= flip when ma maybeM :: Monad m => (x -> m ()) -> Maybe x -> m () maybeM _ Nothing = return () maybeM f (Just x) = f x -- | Rerun the monad until the boolean result is false, collecting list of results. repeatUntilM :: Monad m => m (Bool,a) -> m [a] repeatUntilM m = do (proceed,x) <- m if proceed then (do xs <- repeatUntilM m return (x:xs)) else return [x] yi-0.12.6/src/library/Yi/Paths.hs0000644000000000000000000000624512717763531014661 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE NoMonomorphismRestriction #-} module Yi.Paths ( getEvaluatorContextFilename , getConfigFilename , getConfigModules , getArticleDbFilename , getPersistentStateFilename , getConfigDir , getConfigPath , getCustomConfigPath , getDataPath ) where import Control.Monad.Base (MonadBase, liftBase) import System.Directory (createDirectoryIfMissing, doesDirectoryExist, getAppUserDataDirectory) import qualified System.Environment.XDG.BaseDir as XDG (getUserConfigDir, getUserDataDir) import System.FilePath (()) appUserDataCond ::(MonadBase IO m) => (String -> IO FilePath) -> m FilePath appUserDataCond dirQuery = liftBase $ do oldDir <- getAppUserDataDirectory "yi" newDir <- dirQuery "yi" oldDirExists <- doesDirectoryExist oldDir newDirExists <- doesDirectoryExist newDir if newDirExists -- overrides old-style then return newDir else if oldDirExists -- old-style exists, use it then return oldDir else do createDirectoryIfMissing True newDir -- none exists, use new style, but create it return newDir getConfigDir ::(MonadBase IO m) => m FilePath getConfigDir = appUserDataCond XDG.getUserConfigDir getDataDir ::(MonadBase IO m) => m FilePath getDataDir = appUserDataCond XDG.getUserDataDir -- | Given a path relative to application data directory, -- this function finds a path to a given data file. getDataPath :: (MonadBase IO m) => FilePath -> m FilePath getDataPath fp = fmap ( fp) getDataDir -- | Given a path relative to application configuration directory, -- this function finds a path to a given configuration file. getConfigPath :: MonadBase IO m => FilePath -> m FilePath getConfigPath = getCustomConfigPath getConfigDir -- | Given an action that retrieves config path, and a path relative to it, -- this function joins the two together to create a config file path. getCustomConfigPath :: MonadBase IO m => m FilePath -> FilePath -> m FilePath getCustomConfigPath cd fp = ( fp) `fmap` cd -- Note: Dyre also uses XDG cache dir - that would be: --getCachePath = getPathHelper XDG.getUserCacheDirectory -- Below are all points that are used in Yi code (to keep it clean.) getEvaluatorContextFilename, getConfigFilename, getConfigModules, getArticleDbFilename, getPersistentStateFilename :: (MonadBase IO m) => m FilePath -- | Get Yi master configuration script. getConfigFilename = getConfigPath "yi.hs" getConfigModules = getConfigPath "modules" -- | Get articles.db database of locations to visit (for Yi.IReader.) getArticleDbFilename = getConfigPath "articles.db" -- | Get path to Yi history that stores state between runs. getPersistentStateFilename = getDataPath "history" -- | Get path to environment file that defines namespace used by Yi -- command evaluator. getEvaluatorContextFilename = getConfigPath $ "local" "Env.hs" yi-0.12.6/src/library/Yi/PersistentState.hs0000644000000000000000000001222612717763531016737 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE Haskell2010 #-} {-# LANGUAGE NoMonomorphismRestriction #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -- | This module implements persistence across different Yi runs. -- It includes minibuffer command history, marks etc. -- Warning: Current version will _not_ check whether two or more instances -- of Yi are run at the same time. module Yi.PersistentState(loadPersistentState, savePersistentState, maxHistoryEntries, persistentSearch) where import GHC.Generics (Generic) import Control.Exc (ignoringException) import Control.Lens (assign, makeLenses, use) import Control.Monad (when) import Data.Binary (Binary, decodeFile, encodeFile) import Data.Default (Default, def) import qualified Data.Map as M (map) import Data.Typeable (Typeable) import System.Directory (doesFileExist) import Yi.Config.Simple.Types (Field, customVariable) import Yi.Editor import Yi.History (Histories (..), History (..)) import Yi.Keymap (YiM) import Yi.KillRing (Killring (..)) import Yi.Paths (getPersistentStateFilename) import Yi.Regex (SearchExp (..)) import Yi.Search.Internal (getRegexE, setRegexE) import Yi.Types (YiConfigVariable) import Yi.Utils (io) data PersistentState = PersistentState { histories :: !Histories , aKillring :: !Killring , aCurrentRegex :: Maybe SearchExp } deriving (Generic) instance Binary PersistentState newtype MaxHistoryEntries = MaxHistoryEntries { _unMaxHistoryEntries :: Int } deriving(Typeable, Binary) instance Default MaxHistoryEntries where def = MaxHistoryEntries 1000 instance YiConfigVariable MaxHistoryEntries makeLenses ''MaxHistoryEntries maxHistoryEntries :: Field Int maxHistoryEntries = customVariable . unMaxHistoryEntries newtype PersistentSearch = PersistentSearch { _unPersistentSearch :: Bool } deriving(Typeable, Binary) instance Default PersistentSearch where def = PersistentSearch True instance YiConfigVariable PersistentSearch makeLenses ''PersistentSearch persistentSearch :: Field Bool persistentSearch = customVariable . unPersistentSearch -- | Trims per-command histories to contain at most N completions each. trimHistories :: Int -> Histories -> Histories trimHistories maxHistory (Histories m) = Histories $ M.map trimH m where trimH (History cur content prefix) = History cur (trim content) prefix trim content = drop (max 0 (length content - maxHistory)) content -- | Here is a persistent history saving part. -- We assume each command is a single line. -- To add new components, one has to: -- -- * add new field in @PersistentState@ structure, -- * add write and read parts in @loadPersistentState@/@savePersistentState@, -- * add a trimming code in @savePersistentState@ to prevent blowing up -- of save file. savePersistentState :: YiM () savePersistentState = do MaxHistoryEntries histLimit <- withEditor askConfigVariableA pStateFilename <- getPersistentStateFilename (hist :: Histories) <- withEditor getEditorDyn kr <- withEditor $ use killringA curRe <- withEditor getRegexE let pState = PersistentState { histories = trimHistories histLimit hist , aKillring = kr -- trimmed during normal operation , aCurrentRegex = curRe -- just a single value -> no need to trim } io $ encodeFile pStateFilename pState -- | Reads and decodes a persistent state in both strict, and exception robust -- way. readPersistentState :: YiM (Maybe PersistentState) readPersistentState = do pStateFilename <- getPersistentStateFilename pStateExists <- io $ doesFileExist pStateFilename if not pStateExists then return Nothing else io $ ignoringException $ strictDecoder pStateFilename where strictDecoder filename = do (state :: PersistentState) <- decodeFile filename state `seq` return (Just state) -- | Loads a persistent state, and sets Yi state variables accordingly. loadPersistentState :: YiM () loadPersistentState = do maybePState <- readPersistentState case maybePState of Nothing -> return () Just pState -> do putEditorDyn $ histories pState assign killringA $ aKillring pState PersistentSearch keepSearch <- askConfigVariableA when keepSearch . withEditor $ maybe (return ()) setRegexE $ aCurrentRegex pState yi-0.12.6/src/library/Yi/Process.hs0000644000000000000000000000777712717763531015233 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} module Yi.Process (runProgCommand, runShellCommand, shellFileName, createSubprocess, readAvailable, SubprocessInfo(..), SubprocessId) where import Control.Exc (orException) import Foreign.C.String (peekCStringLen) import Foreign.Marshal.Alloc (allocaBytes) import System.Directory (findExecutable) import System.Environment (getEnv) import System.Exit (ExitCode (ExitFailure)) import System.IO (BufferMode (NoBuffering), Handle, hGetBufNonBlocking, hSetBuffering) import System.Process (ProcessHandle, readProcessWithExitCode, runProcess) import Yi.Buffer.Basic (BufferRef) import Yi.Monad (repeatUntilM) #ifndef mingw32_HOST_OS import System.Posix.IO (createPipe, fdToHandle) #endif runProgCommand :: String -> [String] -> IO (ExitCode,String,String) runProgCommand prog args = do loc <- findExecutable prog case loc of Nothing -> return (ExitFailure 1,"","") Just fp -> readProcessWithExitCode fp args "" ------------------------------------------------------------------------ -- | Run a command using the system shell, returning stdout, stderr and exit code shellFileName :: IO String shellFileName = orException (getEnv "SHELL") (return "/bin/sh") shellCommandSwitch :: String shellCommandSwitch = "-c" runShellCommand :: String -> IO (ExitCode,String,String) runShellCommand cmd = do sh <- shellFileName readProcessWithExitCode sh [shellCommandSwitch, cmd] "" -------------------------------------------------------------------------------- -- Subprocess support (ie. async processes whose output goes to a buffer) type SubprocessId = Integer data SubprocessInfo = SubprocessInfo { procCmd :: FilePath, procArgs :: [String], procHandle :: ProcessHandle, hIn :: Handle, hOut :: Handle, hErr :: Handle, bufRef :: BufferRef, separateStdErr :: Bool } {- Simon Marlow said this: It turns out to be dead easy to bind stderr and stdout to the same pipe. After a couple of minor tweaks the following now works: createProcess (proc cmd args){ std_out = CreatePipe, std_err = UseHandle stdout } Therefore it should be possible to simplifiy the following greatly with the new process package. -} createSubprocess :: FilePath -> [String] -> BufferRef -> IO SubprocessInfo createSubprocess cmd args bufref = do #ifdef mingw32_HOST_OS (inp,out,err,handle) <- runInteractiveProcess cmd args Nothing Nothing let separate = True #else (inpReadFd,inpWriteFd) <- System.Posix.IO.createPipe (outReadFd,outWriteFd) <- System.Posix.IO.createPipe [inpRead,inpWrite,outRead,outWrite] <- mapM fdToHandle [inpReadFd,inpWriteFd,outReadFd,outWriteFd] handle <- runProcess cmd args Nothing Nothing (Just inpRead) (Just outWrite) (Just outWrite) let inp = inpWrite out = outRead err = outRead separate = False #endif hSetBuffering inp NoBuffering hSetBuffering out NoBuffering hSetBuffering err NoBuffering return SubprocessInfo { procCmd=cmd, procArgs=args, procHandle=handle, hIn=inp, hOut=out, hErr=err, bufRef=bufref, separateStdErr=separate } -- Read as much as possible from handle without blocking readAvailable :: Handle -> IO String readAvailable handle = fmap concat $ repeatUntilM $ readChunk handle -- Read a chunk from a handle, bool indicates if there is potentially more data available readChunk :: Handle -> IO (Bool,String) readChunk handle = do let bufferSize = 1024 allocaBytes bufferSize $ \buffer -> do bytesRead <- hGetBufNonBlocking handle buffer bufferSize s <- peekCStringLen (buffer,bytesRead) let mightHaveMore = bytesRead == bufferSize return (mightHaveMore, s) yi-0.12.6/src/library/Yi/Rectangle.hs0000644000000000000000000000731712717763531015507 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE PackageImports #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Rectangle -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- emacs-style rectangle manipulation functions. module Yi.Rectangle where import Control.Applicative ((<$>)) import Control.Monad (forM_) import Data.List (sort, transpose) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, concat, justifyLeft, length, pack, unpack) import qualified Data.Text.ICU as ICU (regex, find, unfold, group) import Yi.Buffer import Yi.Editor (EditorM, getRegE, setRegE, withCurrentBuffer) import qualified Yi.Rope as R import Yi.String (lines', mapLines, unlines') alignRegion :: T.Text -> BufferM () alignRegion str = do s <- getSelectRegionB >>= unitWiseRegion Line modifyRegionB (R.fromText . alignText str . R.toText) s where regexSplit :: T.Text -> T.Text -> [T.Text] regexSplit pattern l = case ICU.find (ICU.regex [] pattern) l of Nothing -> error "regexSplit: text does not match" Just m -> drop 1 $ ICU.unfold ICU.group m alignText :: T.Text -> T.Text -> T.Text alignText regex text = unlines' ls' where ls, ls' :: [T.Text] ls = lines' text columns :: [[T.Text]] columns = regexSplit regex <$> ls columnsWidth :: [Int] columnsWidth = fmap (maximum . fmap T.length) $ transpose columns columns' :: [[T.Text]] columns' = fmap (zipWith (`T.justifyLeft` ' ') columnsWidth) columns ls' = T.concat <$> columns' -- | Align each line of the region on the given regex. -- Fails if it is not found in any line. alignRegionOn :: T.Text -> BufferM () alignRegionOn s = alignRegion $ "^(.*)(" <> s <> ")(.*)" -- | Get the selected region as a rectangle. -- Returns the region extended to lines, plus the start and end columns of the rectangle. getRectangle :: BufferM (Region, Int, Int) getRectangle = do r <- getSelectRegionB extR <- unitWiseRegion Line r [lowCol,highCol] <- sort <$> mapM colOf [regionStart r, regionEnd r] return (extR, lowCol, highCol) -- | Split text at the boundaries given multiSplit :: [Int] -> R.YiString -> [R.YiString] multiSplit [] l = [l] multiSplit (x:xs) l = left : multiSplit (fmap (subtract x) xs) right where (left, right) = R.splitAt x l onRectangle :: (Int -> Int -> R.YiString -> R.YiString) -> BufferM () onRectangle f = do (reg, l, r) <- getRectangle modifyRegionB (mapLines (f l r)) reg openRectangle :: BufferM () openRectangle = onRectangle openLine where openLine l r line = left <> R.replicateChar (r - l) ' ' <> right where (left, right) = R.splitAt l line stringRectangle :: R.YiString -> BufferM () stringRectangle inserted = onRectangle stringLine where stringLine l r line = left <> inserted <> right where [left,_,right] = multiSplit [l,r] line killRectangle :: EditorM () killRectangle = do cutted <- withCurrentBuffer $ do (reg, l, r) <- getRectangle text <- readRegionB reg let (cutted, rest) = unzip $ fmap cut $ R.lines' text cut :: R.YiString -> (R.YiString, R.YiString) cut line = let [left,mid,right] = multiSplit [l,r] line in (mid, left <> right) replaceRegionB reg (R.unlines rest) return cutted setRegE (R.unlines cutted) yankRectangle :: EditorM () yankRectangle = do text <- R.lines' <$> getRegE withCurrentBuffer $ forM_ text $ \t -> do savingPointB $ insertN t lineDown yi-0.12.6/src/library/Yi/Snippets.hs0000644000000000000000000003507012717763531015405 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Snippets -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Snippets where import GHC.Generics (Generic) import Control.Applicative (some) import Control.Arrow (second) import Control.Lens (use, (.=)) import Control.Monad.RWS (MonadPlus (mplus), MonadReader (ask), MonadState, MonadTrans (..), MonadWriter (tell), Monoid (mappend, mempty), RWST, evalRWST, filterM, forM, forM_, liftM2, unless, when, (<>)) import Data.Binary (Binary) import Data.Char (isSpace) import Data.Default (Default, def) import Data.Foldable (find) import Data.List (foldl', groupBy, intersperse, nub, sort) import Data.Maybe (catMaybes) import qualified Data.Text as T (Text) import Data.Typeable (Typeable) import Yi.Buffer import Yi.Editor (withCurrentBuffer) import Yi.Keymap (Action) import Yi.Keymap.Keys import qualified Yi.Rope as R import Yi.TextCompletion (resetComplete, wordCompleteString') import Yi.Types (YiVariable) type SnippetCmd = RWST (Int, Int) [MarkInfo] () BufferM data SnippetMark = SimpleMark !Int | ValuedMark !Int R.YiString | DependentMark !Int data MarkInfo = SimpleMarkInfo { userIndex :: !Int , startMark :: !Mark } | ValuedMarkInfo { userIndex :: !Int , startMark :: !Mark , endMark :: !Mark } | DependentMarkInfo { userIndex :: !Int , startMark :: !Mark , endMark :: !Mark } deriving (Eq, Show, Generic) instance Binary MarkInfo newtype BufferMarks = BufferMarks { bufferMarks :: [MarkInfo] } deriving (Eq, Show, Monoid, Typeable, Binary) newtype DependentMarks = DependentMarks { marks :: [[MarkInfo]] } deriving (Eq, Show, Monoid, Typeable, Binary) instance Default BufferMarks where def = BufferMarks [] instance Default DependentMarks where def = DependentMarks [] instance YiVariable BufferMarks instance YiVariable DependentMarks instance Ord MarkInfo where a `compare` b = userIndex a `compare` userIndex b cursor :: Int -> SnippetMark cursor = SimpleMark cursorWith :: Int -> R.YiString -> SnippetMark cursorWith = ValuedMark dep :: Int -> SnippetMark dep = DependentMark isDependentMark :: MarkInfo -> Bool isDependentMark (SimpleMarkInfo{}) = False isDependentMark (ValuedMarkInfo{}) = False isDependentMark (DependentMarkInfo{}) = True bufferMarkers :: MarkInfo -> [Mark] bufferMarkers (SimpleMarkInfo _ s) = [s] bufferMarkers m = [startMark m, endMark m] -- used to translate a datatype into a snippet cmd for -- freely combining data with '&' class MkSnippetCmd a b | a -> b where mkSnippetCmd :: a -> SnippetCmd b instance MkSnippetCmd String () where mkSnippetCmd = text . R.fromString instance MkSnippetCmd R.YiString () where mkSnippetCmd = text instance MkSnippetCmd T.Text () where mkSnippetCmd = text . R.fromText instance MkSnippetCmd (SnippetCmd a) a where mkSnippetCmd = id -- mkSnippetCmd for 'cursor...'-functions instance MkSnippetCmd SnippetMark () where mkSnippetCmd (SimpleMark i) = do mk <- mkMark tell [SimpleMarkInfo i mk] mkSnippetCmd (ValuedMark i str) = do start <- mkMark lift $ insertN str end <- mkMark tell [ValuedMarkInfo i start end] mkSnippetCmd (DependentMark i) = do start <- mkMark end <- mkMark tell [DependentMarkInfo i start end] -- create a mark at current position mkMark :: MonadTrans t => t BufferM Mark mkMark = lift $ do p <- pointB newMarkB $ MarkValue p Backward -- Indentation support has been temporarily removed text :: R.YiString -> SnippetCmd () text txt = do (_, indent) <- ask indentSettings <- lift indentSettingsB lift . foldl' (>>) (return ()) . intersperse (newlineB >> indentToB indent) . map (if expandTabs indentSettings then insertN . expand indentSettings "" else insertN) $ lines' txt where lines' txt' = case R.last txt' of Just '\n' -> R.lines txt' <> [mempty] _ -> R.lines txt expand :: IndentSettings -> R.YiString -> R.YiString -> R.YiString expand is str rst = case R.head rst of Nothing -> R.reverse str Just '\t' -> let t = R.replicateChar (tabSize is) ' ' <> str in expand is t (R.drop 1 rst) Just s -> expand is (s `R.cons` str) rst -- unfortunatelly data converted to snippets are no monads, but '&' is -- very similar to '>>' and '&>' is similar to '>>=', since -- SnippetCmd's can be used monadically infixr 5 & (&) :: (MkSnippetCmd a any , MkSnippetCmd b c) => a -> b -> SnippetCmd c str & rst = mkSnippetCmd str >> mkSnippetCmd rst (&>) :: (MkSnippetCmd a b, MkSnippetCmd c d) => a -> (b -> c) -> SnippetCmd d str &> rst = mkSnippetCmd str >>= mkSnippetCmd . rst runSnippet :: Bool -> SnippetCmd a -> BufferM a runSnippet deleteLast s = do line <- lineOf =<< pointB indent <- indentOfCurrentPosB (a, markInfo) <- evalRWST s (line, indent) () unless (null markInfo) $ do let newMarks = sort $ filter (not . isDependentMark) markInfo let newDepMarks = filter (not . len1) $ groupBy belongTogether $ sort markInfo getBufferDyn >>= putBufferDyn.(BufferMarks newMarks `mappend`) unless (null newDepMarks) $ getBufferDyn >>= putBufferDyn.(DependentMarks newDepMarks `mappend`) moveToNextBufferMark deleteLast return a where len1 (_:[]) = True len1 _ = False belongTogether a b = userIndex a == userIndex b updateUpdatedMarks :: [Update] -> BufferM () updateUpdatedMarks upds = findEditedMarks upds >>= mapM_ updateDependents findEditedMarks :: [Update] -> BufferM [MarkInfo] findEditedMarks upds = fmap (nub . concat) (mapM findEditedMarks' upds) where findEditedMarks' :: Update -> BufferM [MarkInfo] findEditedMarks' upd = do let p = updatePoint upd ms <- return . nub . concat . marks =<< getBufferDyn ms' <- forM ms $ \m ->do r <- adjMarkRegion m return $ if (updateIsDelete upd && p `nearRegion` r) || p `inRegion` r then Just m else Nothing return . catMaybes $ ms' dependentSiblings :: MarkInfo -> [[MarkInfo]] -> [MarkInfo] dependentSiblings mark deps = case find (elem mark) deps of Nothing -> [] Just lst -> filter (not . (mark==)) lst updateDependents :: MarkInfo -> BufferM () updateDependents m = getBufferDyn >>= updateDependents' m . marks updateDependents' :: MarkInfo -> [[MarkInfo]] -> BufferM () updateDependents' mark deps = case dependentSiblings mark deps of [] -> return () deps' -> do txt <- markText mark forM_ deps' $ \d -> do dTxt <- markText d when (txt /= dTxt) $ setMarkText txt d markText :: MarkInfo -> BufferM R.YiString markText m = markRegion m >>= readRegionB setMarkText :: R.YiString -> MarkInfo -> BufferM () setMarkText txt (SimpleMarkInfo _ start) = do p <- use $ markPointA start c <- readAtB p if isSpace c then insertNAt txt p else do r <- regionOfPartNonEmptyAtB unitViWordOnLine Forward p modifyRegionB (const txt) r setMarkText txt mi = do start <- use $ markPointA $ startMark mi end <- use $ markPointA $ endMark mi let r = mkRegion start end modifyRegionB (const txt) r when (start == end) $ markPointA (endMark mi) .= end + Point (R.length txt) withSimpleRegion :: MarkInfo -> (Region -> BufferM Region) -> BufferM Region withSimpleRegion (SimpleMarkInfo _ s) f = do p <- use $ markPointA s c <- readAtB p if isSpace c then return $ mkRegion p p -- return empty region else f =<< regionOfPartNonEmptyAtB unitViWordOnLine Forward p withSimpleRegion r _ = error $ "withSimpleRegion: " <> show r markRegion :: MarkInfo -> BufferM Region markRegion m@SimpleMarkInfo{} = withSimpleRegion m $ \r -> do os <- findOverlappingMarksWith safeMarkRegion concat True r m rOs <- mapM safeMarkRegion os return . mkRegion (regionStart r) $ foldl' minEnd (regionEnd r) rOs where minEnd end r = if regionEnd r < end then end else min end $ regionStart r markRegion m = liftM2 mkRegion (use $ markPointA $ startMark m) (use $ markPointA $ endMark m) safeMarkRegion :: MarkInfo -> BufferM Region safeMarkRegion m@(SimpleMarkInfo _ _) = withSimpleRegion m return safeMarkRegion m = markRegion m adjMarkRegion :: MarkInfo -> BufferM Region adjMarkRegion s@(SimpleMarkInfo _ _) = markRegion s adjMarkRegion m = do s <- use $ markPointA $ startMark m e <- use $ markPointA $ endMark m c <- readAtB e when (isWordChar c) $ do adjustEnding e repairOverlappings e e' <- use $ markPointA $ endMark m s' <- adjustStart s e' return $ mkRegion s' e' where adjustEnding end = do r' <- regionOfPartNonEmptyAtB unitViWordOnLine Forward end markPointA (endMark m) .= (regionEnd r') adjustStart s e = do txt <- readRegionB (mkRegion s e) let sP = s + (Point . R.length $ R.takeWhile isSpace txt) when (sP > s) $ markPointA (startMark m) .= sP return sP -- test if we generated overlappings and repair repairOverlappings origEnd = do overlappings <- allOverlappingMarks True m unless (null overlappings) $ markPointA (endMark m) .= origEnd findOverlappingMarksWith :: (MarkInfo -> BufferM Region) -> ([[MarkInfo]] -> [MarkInfo]) -> Bool -> Region -> MarkInfo -> BufferM [MarkInfo] findOverlappingMarksWith fMarkRegion flattenMarks border r m = let markFilter = filter (m /=) . flattenMarks . marks regOverlap = fmap (regionsOverlap border r) . fMarkRegion in fmap markFilter getBufferDyn >>= filterM regOverlap findOverlappingMarks :: ([[MarkInfo]] -> [MarkInfo]) -> Bool -> Region -> MarkInfo -> BufferM [MarkInfo] findOverlappingMarks = findOverlappingMarksWith markRegion regionsOverlappingMarks :: Bool -> Region -> MarkInfo -> BufferM [MarkInfo] regionsOverlappingMarks = findOverlappingMarks concat overlappingMarks :: Bool -> Bool -> MarkInfo -> BufferM [MarkInfo] overlappingMarks border belongingTogether mark = do r <- markRegion mark findOverlappingMarks (if belongingTogether then dependentSiblings mark else concat) border r mark allOverlappingMarks :: Bool -> MarkInfo -> BufferM [MarkInfo] allOverlappingMarks border = overlappingMarks border False dependentOverlappingMarks :: Bool -> MarkInfo -> BufferM [MarkInfo] dependentOverlappingMarks border = overlappingMarks border True nextBufferMark :: Bool -> BufferM (Maybe MarkInfo) nextBufferMark deleteLast = do BufferMarks ms <- getBufferDyn if null ms then return Nothing else do let mks = if deleteLast then const $ tail ms else (tail ms <>) putBufferDyn . BufferMarks . mks $ [head ms] return . Just $ head ms isDependentMarker :: (MonadState FBuffer m, Functor m) => Mark -> m Bool isDependentMarker bMark = do DependentMarks ms <- getBufferDyn return . elem bMark . concatMap bufferMarkers . concat $ ms safeDeleteMarkB :: Mark -> BufferM () safeDeleteMarkB m = do b <- isDependentMarker m unless b (deleteMarkB m) moveToNextBufferMark :: Bool -> BufferM () moveToNextBufferMark deleteLast = nextBufferMark deleteLast >>= \case Just p -> mv p Nothing -> return () where mv (SimpleMarkInfo _ m) = do moveTo =<< use (markPointA m) when deleteLast $ safeDeleteMarkB m mv (ValuedMarkInfo _ s e) = do sp <- use $ markPointA s ep <- use $ markPointA e deleteRegionB (mkRegion sp ep) moveTo sp when deleteLast $ do safeDeleteMarkB s safeDeleteMarkB e mv r = error $ "moveToNextBufferMark.mv: " <> show r -- Keymap support newtype SupertabExt = Supertab (R.YiString -> Maybe (BufferM ())) instance Monoid SupertabExt where mempty = Supertab $ const Nothing (Supertab f) `mappend` (Supertab g) = Supertab $ \s -> f s `mplus` g s superTab :: (MonadInteract m Action Event) => Bool -> SupertabExt -> m () superTab caseSensitive (Supertab expander) = some (spec KTab ?>>! doSuperTab) >> deprioritize >>! resetComplete where doSuperTab = do canExpand <- withCurrentBuffer $ do sol <- atSol ws <- hasWhiteSpaceBefore return $ sol || ws if canExpand then insertTab else runCompleter insertTab = withCurrentBuffer $ mapM_ insertB =<< tabB runCompleter = do w <- withCurrentBuffer readPrevWordB case expander w of Just cmd -> withCurrentBuffer $ bkillWordB >> cmd _ -> autoComplete autoComplete = wordCompleteString' caseSensitive >>= withCurrentBuffer . (bkillWordB >>) . (insertN . R.fromText) -- | Convert snippet description list into a SuperTab extension fromSnippets :: Bool -> [(R.YiString, SnippetCmd ())] -> SupertabExt fromSnippets deleteLast snippets = Supertab $ \str -> lookup str $ map (second $ runSnippet deleteLast) snippets snippet :: MkSnippetCmd a b => a -> SnippetCmd b snippet = mkSnippetCmd yi-0.12.6/src/library/Yi/Snippets/Haskell.hs0000644000000000000000000000116512717763531016766 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Snippets.Haskell -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable module Yi.Snippets.Haskell where import qualified Yi.Rope as R (singleton) import Yi.Snippets (SnippetCmd, cursor, cursorWith, snippet, (&)) hsFunction :: SnippetCmd () hsFunction = snippet $ cursorWith 1 (R.singleton 'f') & " :: " & cursor 2 & "\n" & cursor 3 & " = " & cursor 4 & "\n" hsClass :: SnippetCmd () hsClass = snippet $ "class " & cursor 1 & " " & cursor 2 & " where\n " & cursor 3 yi-0.12.6/src/library/Yi/Search.hs0000644000000000000000000003740612717763531015012 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Search -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Search/Replace functions module Yi.Search ( setRegexE, -- :: SearchExp -> EditorM () resetRegexE, -- :: EditorM () getRegexE, -- :: EditorM (Maybe SearchExp) SearchMatch, SearchResult(..), SearchOption(..), doSearch, -- :: (Maybe String) -> [SearchOption] -- -> Direction -> YiM () searchInit, -- :: String -- -> [SearchOption] -- -> IO SearchExp continueSearch, -- :: SearchExp -- -> IO SearchResult makeSimpleSearch, -- * Batch search-replace searchReplaceRegionB, searchReplaceSelectionB, replaceString, searchAndRepRegion, searchAndRepRegion0, searchAndRepUnit, -- :: String -> String -> Bool -> TextUnit -> EditorM Bool -- * Incremental Search isearchInitE, isearchIsEmpty, isearchAddE, isearchPrevE, isearchNextE, isearchWordE, isearchHistory, isearchDelE, isearchCancelE, isearchFinishE, isearchCancelWithE, isearchFinishWithE, -- * Replace qrNext, qrReplaceAll, qrReplaceOne, qrFinish ) where import Control.Applicative ((<$>)) import Control.Lens (assign) import Control.Monad (void, when) import Data.Binary (Binary, get, put) import Data.Char (isAlpha, isUpper) import Data.Default (Default, def) import Data.Maybe (listToMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, any, break, empty, length, null, takeWhile, unpack) import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8) import Data.Typeable (Typeable) import Yi.Buffer import Yi.Editor import Yi.History (historyFinishGen, historyMoveGen, historyStartGen) import Yi.Regex import qualified Yi.Rope as R (YiString, null, toString, toText) import Yi.Search.Internal (getRegexE, resetRegexE, setRegexE) import Yi.String (showT) import Yi.Types (YiVariable) import Yi.Utils (fst3) import Yi.Window (Window) -- --------------------------------------------------------------------- -- -- | Global searching. Search for regex and move point to that position. -- @Nothing@ means reuse the last regular expression. @Just s@ means use -- @s@ as the new regular expression. Direction of search can be -- specified as either @Backward@ or @Forward@ (forwards in the buffer). -- Arguments to modify the compiled regular expression can be supplied -- as well. -- type SearchMatch = Region data SearchResult = PatternFound | PatternNotFound | SearchWrapped deriving Eq doSearch :: Maybe String -- ^ @Nothing@ means used previous -- pattern, if any. Complain otherwise. -- Use getRegexE to check for previous patterns -> [SearchOption] -- ^ Flags to modify the compiled regex -> Direction -- ^ @Backward@ or @Forward@ -> EditorM SearchResult doSearch (Just re) fs d = searchInit re d fs >>= withCurrentBuffer . continueSearch doSearch Nothing _ d = do mre <- getRegexE case mre of Nothing -> fail "No previous search pattern" -- NB Just r -> withCurrentBuffer (continueSearch (r,d)) -- | Set up a search. searchInit :: String -> Direction -> [SearchOption] -> EditorM (SearchExp, Direction) searchInit re d fs = do let Right c_re = makeSearchOptsM fs re setRegexE c_re assign searchDirectionA d return (c_re,d) -- | Do a search, placing cursor at first char of pattern, if found. -- Keymaps may implement their own regex language. How do we provide for this? -- Also, what's happening with ^ not matching sol? continueSearch :: (SearchExp, Direction) -> BufferM SearchResult continueSearch (c_re, dir) = do mp <- savingPointB $ do moveB Character dir -- start immed. after cursor rs <- regexB dir c_re moveB Document (reverseDir dir) -- wrap around ls <- regexB dir c_re return $ listToMaybe $ fmap Right rs ++ fmap Left ls maybe (return ()) (moveTo . regionStart . either id id) mp return $ f mp where f (Just (Right _)) = PatternFound f (Just (Left _)) = SearchWrapped f Nothing = PatternNotFound ------------------------------------------------------------------------ -- Batch search and replace -- -- | Search and Replace all within the current region. -- Note the region is the final argument since we might perform -- the same search and replace over multiple regions however we are -- unlikely to perform several search and replaces over the same region -- since the first such may change the bounds of the region. searchReplaceRegionB :: R.YiString -- ^ The string to search for -> R.YiString -- ^ The string to replace it with -> Region -- ^ The region to perform this over -> BufferM Int searchReplaceRegionB from to = searchAndRepRegion0 (makeSimpleSearch from) to True -- | Peform a search and replace on the selection searchReplaceSelectionB :: R.YiString -- ^ text to search for -> R.YiString -- ^ text to replace it with -> BufferM Int searchReplaceSelectionB from to = getSelectRegionB >>= searchReplaceRegionB from to -- | Replace a string by another everywhere in the document replaceString :: R.YiString -> R.YiString -> BufferM Int replaceString a b = regionOfB Document >>= searchReplaceRegionB a b ------------------------------------------------------------------------ -- | Search and replace in the given region. -- -- If the input boolean is True, then the replace is done globally, -- otherwise only the first match is replaced. Returns the number of -- replacements done. searchAndRepRegion0 :: SearchExp -> R.YiString -> Bool -> Region -> BufferM Int searchAndRepRegion0 c_re str globally region = do mp <- (if globally then id else take 1) <$> regexRegionB c_re region -- find the regex -- mp' is a maybe not reversed version of mp, the goal -- is to avoid replaceRegionB to mess up the next regions. -- So we start from the end. let mp' = mayReverse (reverseDir $ regionDirection region) mp mapM_ (`replaceRegionB` str) mp' return (length mp) searchAndRepRegion :: R.YiString -> R.YiString -> Bool -> Region -> EditorM Bool searchAndRepRegion s str globally region = case R.null s of False -> return False True -> do let c_re = makeSimpleSearch s setRegexE c_re -- store away for later use assign searchDirectionA Forward withCurrentBuffer $ (/= 0) <$> searchAndRepRegion0 c_re str globally region ------------------------------------------------------------------------ -- | Search and replace in the region defined by the given unit. -- The rest is as in 'searchAndRepRegion'. searchAndRepUnit :: R.YiString -> R.YiString -> Bool -> TextUnit -> EditorM Bool searchAndRepUnit re str g unit = withCurrentBuffer (regionOfB unit) >>= searchAndRepRegion re str g -------------------------- -- Incremental search newtype Isearch = Isearch [(T.Text, Region, Direction)] deriving (Typeable, Show) instance Binary Isearch where put (Isearch ts) = put (map3 E.encodeUtf8 ts) get = Isearch . map3 E.decodeUtf8 <$> get map3 :: (a -> d) -> [(a, b, c)] -> [(d, b, c)] map3 _ [] = [] map3 f ((a, b, c):xs) = (f a, b, c) : map3 f xs -- This contains: (string currently searched, position where we -- searched it, direction, overlay for highlighting searched text) -- Note that this info cannot be embedded in the Keymap state: the state -- modification can depend on the state of the editor. instance Default Isearch where def = Isearch [] instance YiVariable Isearch isearchInitE :: Direction -> EditorM () isearchInitE dir = do historyStartGen iSearch p <- withCurrentBuffer pointB resetRegexE putEditorDyn (Isearch [(T.empty ,mkRegion p p, dir)]) printMsg "I-search: " isearchIsEmpty :: EditorM Bool isearchIsEmpty = do Isearch s <- getEditorDyn return . not . T.null . fst3 $ head s isearchAddE :: T.Text -> EditorM () isearchAddE inc = isearchFunE (<> inc) -- | Create a SearchExp that matches exactly its argument makeSimpleSearch :: R.YiString -> SearchExp makeSimpleSearch s = se where Right se = makeSearchOptsM [QuoteRegex] (R.toString s) makeISearch :: T.Text -> SearchExp makeISearch s = case makeSearchOptsM opts (T.unpack s) of Left _ -> SearchExp (T.unpack s) emptyRegex emptyRegex [] Right search -> search where opts = QuoteRegex : if T.any isUpper s then [] else [IgnoreCase] isearchFunE :: (T.Text -> T.Text) -> EditorM () isearchFunE fun = do Isearch s <- getEditorDyn let (previous,p0,direction) = head s current = fun previous srch = makeISearch current printMsg $ "I-search: " <> current setRegexE srch prevPoint <- withCurrentBuffer pointB matches <- withCurrentBuffer $ do moveTo $ regionStart p0 when (direction == Backward) $ moveN $ T.length current regexB direction srch let onSuccess p = do withCurrentBuffer $ moveTo (regionEnd p) putEditorDyn $ Isearch ((current, p, direction) : s) case matches of (p:_) -> onSuccess p [] -> do matchesAfterWrap <- withCurrentBuffer $ do case direction of Forward -> moveTo 0 Backward -> do bufferLength <- sizeB moveTo bufferLength regexB direction srch case matchesAfterWrap of (p:_) -> onSuccess p [] -> do withCurrentBuffer $ moveTo prevPoint -- go back to where we were putEditorDyn $ Isearch ((current, p0, direction) : s) printMsg $ "Failing I-search: " <> current isearchDelE :: EditorM () isearchDelE = do Isearch s <- getEditorDyn case s of (_:(text,p,dir):rest) -> do withCurrentBuffer $ moveTo $ regionEnd p putEditorDyn $ Isearch ((text,p,dir):rest) setRegexE $ makeISearch text printMsg $ "I-search: " <> text _ -> return () -- if the searched string is empty, don't try to remove chars from it. isearchHistory :: Int -> EditorM () isearchHistory delta = do Isearch ((current,_p0,_dir):_) <- getEditorDyn h <- historyMoveGen iSearch delta (return current) isearchFunE (const h) isearchPrevE :: EditorM () isearchPrevE = isearchNext0 Backward isearchNextE :: EditorM () isearchNextE = isearchNext0 Forward isearchNext0 :: Direction -> EditorM () isearchNext0 newDir = do Isearch ((current,_p0,_dir):_rest) <- getEditorDyn if T.null current then isearchHistory 1 else isearchNext newDir isearchNext :: Direction -> EditorM () isearchNext direction = do Isearch ((current, p0, _dir) : rest) <- getEditorDyn withCurrentBuffer $ moveTo (regionStart p0 + startOfs) mp <- withCurrentBuffer $ regexB direction (makeISearch current) case mp of [] -> do endPoint <- withCurrentBuffer $ do moveTo (regionEnd p0) -- revert to offset we were before. sizeB printMsg "isearch: end of document reached" let wrappedOfs = case direction of Forward -> mkRegion 0 0 Backward -> mkRegion endPoint endPoint putEditorDyn $ Isearch ((current,wrappedOfs,direction):rest) -- prepare to wrap around. (p:_) -> do withCurrentBuffer $ moveTo (regionEnd p) printMsg $ "I-search: " <> current putEditorDyn $ Isearch ((current,p,direction):rest) where startOfs = case direction of Forward -> 1 Backward -> -1 isearchWordE :: EditorM () isearchWordE = do -- add maximum 32 chars at a time. text <- R.toText <$> withCurrentBuffer (pointB >>= nelemsB 32) let (prefix, rest) = T.break isAlpha text word = T.takeWhile isAlpha rest isearchAddE $ prefix <> word -- | Succesfully finish a search. Also see 'isearchFinishWithE'. isearchFinishE :: EditorM () isearchFinishE = isearchEnd True -- | Cancel a search. Also see 'isearchCancelWithE'. isearchCancelE :: EditorM () isearchCancelE = isearchEnd False -- | Wrapper over 'isearchEndWith' that passes through the action and -- accepts the search as successful (i.e. when the user wants to stay -- at the result). isearchFinishWithE :: EditorM a -> EditorM () isearchFinishWithE act = isearchEndWith act True -- | Wrapper over 'isearchEndWith' that passes through the action and -- marks the search as unsuccessful (i.e. when the user wants to -- jump back to where the search started). isearchCancelWithE :: EditorM a -> EditorM () isearchCancelWithE act = isearchEndWith act False iSearch :: T.Text iSearch = "isearch" -- | Editor action describing how to end finish incremental search. -- The @act@ parameter allows us to specify an extra action to run -- before finishing up the search. For Vim, we don't want to do -- anything so we use 'isearchEnd' which just does nothing. For emacs, -- we want to cancel highlighting and stay where we are. isearchEndWith :: EditorM a -> Bool -> EditorM () isearchEndWith act accept = getEditorDyn >>= \case Isearch [] -> return () Isearch s@((lastSearched, _, dir):_) -> do let (_,p0,_) = last s historyFinishGen iSearch (return lastSearched) assign searchDirectionA dir if accept then do void act printMsg "Quit" else do resetRegexE withCurrentBuffer $ moveTo $ regionStart p0 -- | Specialised 'isearchEndWith' to do nothing as the action. isearchEnd :: Bool -> EditorM () isearchEnd = isearchEndWith (return ()) ----------------- -- Query-Replace -- | Find the next match and select it. -- Point is end, mark is beginning. qrNext :: Window -> BufferRef -> SearchExp -> EditorM () qrNext win b what = do mp <- withGivenBufferAndWindow win b $ regexB Forward what case mp of [] -> do printMsg "String to search not found" qrFinish (r:_) -> withGivenBufferAndWindow win b $ setSelectRegionB r -- | Replace all the remaining occurrences. qrReplaceAll :: Window -> BufferRef -> SearchExp -> R.YiString -> EditorM () qrReplaceAll win b what replacement = do n <- withGivenBufferAndWindow win b $ do exchangePointAndMarkB -- so we replace the current occurence too searchAndRepRegion0 what replacement True =<< regionOfPartB Document Forward printMsg $ "Replaced " <> showT n <> " occurrences" qrFinish -- | Exit from query/replace. qrFinish :: EditorM () qrFinish = do assign currentRegexA Nothing closeBufferAndWindowE -- the minibuffer. -- | We replace the currently selected match and then move to the next -- match. qrReplaceOne :: Window -> BufferRef -> SearchExp -> R.YiString -> EditorM () qrReplaceOne win b reg replacement = do qrReplaceCurrent win b replacement qrNext win b reg -- | This may actually be a bit more general it replaces the current -- selection with the given replacement string in the given window and -- buffer. qrReplaceCurrent :: Window -> BufferRef -> R.YiString -> EditorM () qrReplaceCurrent win b replacement = withGivenBufferAndWindow win b $ flip replaceRegionB replacement =<< getRawestSelectRegionB yi-0.12.6/src/library/Yi/Search/Internal.hs0000644000000000000000000000201212717763531016547 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Search.Internal -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Internal use for Yi.Search. module Yi.Search.Internal where import Control.Lens (assign, use) import Yi.Editor (EditorM, currentRegexA) import Yi.Regex (SearchExp) -- --------------------------------------------------------------------- -- Searching and substitutions with regular expressions -- -- The most recent regex is held by the editor. You can get at it with -- getRegeE. This is useful to determine if there was a previous -- pattern. -- -- | Put regex into regex 'register' setRegexE :: SearchExp -> EditorM () setRegexE re = assign currentRegexA (Just re) -- | Clear the regex 'register' resetRegexE :: EditorM () resetRegexE = assign currentRegexA Nothing -- | Return contents of regex register getRegexE :: EditorM (Maybe SearchExp) getRegexE = use currentRegexA yi-0.12.6/src/library/Yi/String.hs0000644000000000000000000001165312717763531015047 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.String -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- String manipulation utilities module Yi.String (isBlank, chomp, capitalize, capitalizeFirst, dropSpace, fillText, onLines, mapLines, lines', unlines', padLeft, padRight, commonTPrefix, commonTPrefix', listify, showT, overInit, overTail ) where import Data.Char (isAlphaNum, isSpace, toLower, toUpper) import Data.List (isSuffixOf) import Data.Maybe (fromMaybe) import Data.Monoid (mconcat, (<>)) import qualified Data.Text as T (Text, break, commonPrefixes, empty, intercalate, pack, splitAt, splitOn, toUpper) import qualified Yi.Rope as R (YiString, all, cons, head, init, intercalate, last, length, lines', snoc, tail, unwords, withText, words) -- | Helper that shows then packs the 'Text', for all those cases -- where we use 'show'. showT :: Show a => a -> T.Text showT = T.pack . show -- | This is kind of like the default Show instance for lists except -- over 'T.Text'. It does not leave the elements in extra quotes and -- should not be attempted to be 'show'n and 'read' back. listify :: [R.YiString] -> R.YiString listify t = '[' `R.cons` R.intercalate ", " t `R.snoc` ']' -- | Works by resupplying the found prefix back into the list, -- eventually either finding the prefix or not matching. commonTPrefix :: [T.Text] -> Maybe T.Text commonTPrefix (x:y:xs) = case T.commonPrefixes x y of Nothing -> Nothing Just (p, _, _) -> commonTPrefix (p : xs) commonTPrefix [x] = Just x commonTPrefix _ = Nothing -- | Like 'commonTPrefix' but returns empty text on failure. commonTPrefix' :: [T.Text] -> T.Text commonTPrefix' = fromMaybe T.empty . commonTPrefix capitalize :: String -> String capitalize [] = [] capitalize (c:cs) = toUpper c : map toLower cs capitalizeFirst :: R.YiString -> R.YiString capitalizeFirst = R.withText go where go x = case T.break isAlphaNum x of (f, b) -> f <> case T.splitAt 1 b of (h, hs) -> T.toUpper h <> hs -- | Remove any trailing strings matching /irs/ (input record separator) -- from input string. Like perl's chomp(1). chomp :: String -> String -> String chomp irs st | irs `isSuffixOf` st = let st' = reverse $ drop (length irs) (reverse st) in chomp irs st' | otherwise = st {-# INLINE chomp #-} -- | Trim spaces at beginning /and/ end dropSpace :: String -> String dropSpace = let f = reverse . dropWhile isSpace in f . f isBlank :: R.YiString -> Bool isBlank = R.all isSpace -- | Fills lines up to the given length, splitting the text up if -- necessary. fillText :: Int -> R.YiString -> [R.YiString] fillText margin = map (R.unwords . reverse) . fill 0 [] . R.words where fill _ acc [] = [acc] fill n acc (w:ws) | n + R.length w >= margin = acc : fill (R.length w) [w] ws | otherwise = fill (n + 1 + R.length w) (w:acc) ws -- | @overInit f@ runs f over the 'R.init' of the input if possible, -- preserving the 'R.last' element as-is. If given a string with -- length ≤ 1, it effectively does nothing. -- -- Also see 'overTail'. overInit :: (R.YiString -> R.YiString) -> R.YiString -> R.YiString overInit f t = case (R.init t, R.last t) of (Just xs, Just x) -> f xs `R.snoc` x _ -> t -- | @overInit f@ runs f over the 'R.tail' of the input if possible, -- preserving the 'R.head' element as-is. If given a string with -- length ≤ 1, it effectively does nothing. -- -- Also see 'overInit'. overTail :: (R.YiString -> R.YiString) -> R.YiString -> R.YiString overTail f t = case (R.head t, R.tail t) of (Just x, Just xs) -> x `R.cons` f xs _ -> t -- | Inverse of 'lines''. In contrast to 'Prelude.unlines', this does -- not add an empty line at the end. unlines' :: [T.Text] -> T.Text unlines' = T.intercalate "\n" -- | Split a Text in lines. Unlike 'Prelude.lines', this does not -- remove any empty line at the end. lines' :: T.Text -> [T.Text] lines' = T.splitOn "\n" -- | A helper function for creating functions suitable for -- 'modifySelectionB' and 'modifyRegionB'. -- To be used when the desired function should map across -- the lines of a region. mapLines :: (R.YiString -> R.YiString) -> R.YiString -> R.YiString mapLines f = onLines $ fmap f onLines :: ([R.YiString] -> [R.YiString]) -> R.YiString -> R.YiString onLines f = mconcat . f . R.lines' padLeft, padRight :: Int -> String -> String padLeft n [] = replicate n ' ' padLeft n (x:xs) = x : padLeft (n-1) xs padRight n = reverse . padLeft n . reverse yi-0.12.6/src/library/Yi/Syntax/Driver.hs0000644000000000000000000000552012717763531016316 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables, ExistentialQuantification, MultiParamTypeClasses #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- | This module defines implementations of syntax-awareness drivers. module Yi.Syntax.Driver where import Data.Map (Map) import qualified Data.Map as M (Map, assocs, empty, findWithDefault, fromList) import Yi.Buffer.Basic (WindowRef) import Yi.Lexer.Alex (Tok) import Yi.Syntax hiding (Cache) import Yi.Syntax.Tree (IsTree, fromNodeToFinal) type Path = [Int] data Cache state tree tt = Cache { path :: M.Map WindowRef Path, cachedStates :: [state], root :: tree (Tok tt), focused :: !(M.Map WindowRef (tree (Tok tt))) } mkHighlighter :: forall state tree tt. (IsTree tree, Show state) => (Scanner Point Char -> Scanner state (tree (Tok tt))) -> Highlighter (Cache state tree tt) (tree (Tok tt)) mkHighlighter scanner = Yi.Syntax.SynHL { hlStartState = Cache M.empty [] emptyResult M.empty , hlRun = updateCache , hlGetTree = \(Cache _ _ _ focused) w -> M.findWithDefault emptyResult w focused , hlFocus = focus } where startState :: state startState = scanInit (scanner emptyFileScan) emptyResult = scanEmpty (scanner emptyFileScan) updateCache :: Scanner Point Char -> Point -> Cache state tree tt -> Cache state tree tt updateCache newFileScan dirtyOffset (Cache path cachedStates oldResult _) = Cache path newCachedStates newResult M.empty where newScan = scanner newFileScan reused :: [state] reused = takeWhile ((< dirtyOffset) . scanLooked (scanner newFileScan)) cachedStates resumeState :: state resumeState = if null reused then startState else last reused newCachedStates = reused ++ fmap fst recomputed recomputed = scanRun newScan resumeState newResult :: tree (Tok tt) newResult = if null recomputed then oldResult else snd $ head recomputed focus r (Cache path states root _focused) = Cache path' states root focused where (path', focused) = unzipFM $ zipWithFM (\newpath oldpath -> fromNodeToFinal newpath (oldpath,root)) [] r path unzipFM :: Ord k => [(k,(u,v))] -> (Map k u, Map k v) unzipFM l = (M.fromList mu, M.fromList mv) where (mu, mv) = unzip [((k,u),(k,v)) | (k,(u,v)) <- l] zipWithFM :: Ord k => (u -> v -> w) -> v -> Map k u -> Map k v -> [(k,w)] zipWithFM f v0 mu mv = [ (k,f u (M.findWithDefault v0 k mv) ) | (k,u) <- M.assocs mu] yi-0.12.6/src/library/Yi/Syntax/Haskell.hs0000644000000000000000000006562612717763531016463 0ustar0000000000000000{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE TypeFamilies #-} -- we have lots of parsers which don't want signatures; and we have -- uniplate patterns {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-incomplete-patterns -fno-warn-name-shadowing #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Syntax.Haskell -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- NOTES: -- Note if the layout of the first line (not comments) -- is wrong the parser will only parse what is in the blocks given by Layout.hs module Yi.Syntax.Haskell ( PModule , PModuleDecl , PImport , Exp (..) , Tree , parse , indentScanner ) where import Control.Applicative (Alternative ((<|>), empty, many, some), Applicative (..), optional, (<$>)) import Control.Arrow ((&&&)) import Data.Foldable (Foldable) import Data.List ((\\)) import Data.Maybe (fromJust, isNothing) import Yi.IncrementalParse import Yi.Lexer.Alex (Posn (Posn, posnOfs), Tok (Tok, tokT), startPosn, tokBegin) import Yi.Lexer.Haskell import Yi.Syntax (Scanner) import Yi.Syntax.Layout (State, layoutHandler) import Yi.Syntax.Tree (IsTree (emptyNode, uniplate), sepBy1) indentScanner :: Scanner (AlexState lexState) TT -> Scanner (Yi.Syntax.Layout.State Token lexState) TT indentScanner = layoutHandler startsLayout [(Special '(', Special ')'), (Reserved Let, Reserved In), (Special '[', Special ']'), (Special '{', Special '}')] ignoredToken (Special '<', Special '>', Special '.') isBrace -- HACK: We insert the Special '<', '>', '.', which do not occur in -- normal haskell parsing. -- | Check if a token is a brace, this function is used to -- fix the layout so that do { works correctly isBrace :: TT -> Bool isBrace (Tok br _ _) = Special '{' == br -- | Theese are the tokens ignored by the layout handler. ignoredToken :: TT -> Bool ignoredToken (Tok t _ (Posn{})) = isComment t || t == CppDirective type Tree = PModule type PAtom = Exp type Block = Exp type PGuard = Exp type PModule = Exp type PModuleDecl = Exp type PImport = Exp -- | Exp can be expression or declaration data Exp t = PModule { comments :: [t] , progMod :: Maybe (PModule t) } | ProgMod { modDecl :: PModuleDecl t , body :: PModule t -- ^ The module declaration part } | Body { imports :: Exp t -- [PImport t] , content :: Block t , extraContent :: Block t -- ^ The body of the module } | PModuleDecl { moduleKeyword :: PAtom t , name :: PAtom t , exports :: Exp t , whereKeyword :: Exp t } | PImport { importKeyword :: PAtom t , qual :: Exp t , name' :: PAtom t , as :: Exp t , specification :: Exp t } | TS t [Exp t] -- ^ Type signature | PType { typeKeyword :: PAtom t , typeCons :: Exp t , equal :: PAtom t , btype :: Exp t } -- ^ Type declaration | PData { dataKeyword :: PAtom t , dtypeCons :: Exp t , dEqual :: Exp t , dataRhs :: Exp t } -- ^ Data declaration | PData' { dEqual :: PAtom t , dataCons :: Exp t -- ^ Data declaration RHS } | PClass { cKeyword :: PAtom t -- Can be class or instance , cHead :: Exp t , cwhere :: Exp t -- ^ Class declaration } -- declaration -- declarations and parts of them follow | Paren (PAtom t) [Exp t] (PAtom t) -- ^ A parenthesized, bracked or braced | Block [Exp t] -- ^ A block of things separated by layout | PAtom t [t] -- ^ An atom is a token followed by many comments | Expr [Exp t] -- ^ | PWhere (PAtom t) (Exp t) (Exp t) -- ^ Where clause | Bin (Exp t) (Exp t) -- an error with comments following so we never color comments in wrong -- color. The error has an extra token, the Special '!' token to -- indicate that it contains an error | PError { errorTok :: t , marker :: t , commentList :: [t] -- ^ An wrapper for errors } -- rhs that begins with Equal | RHS (PAtom t) (Exp t) -- ^ Righthandside of functions with = | Opt (Maybe (Exp t)) -- ^ An optional | Modid t [t] -- ^ Module identifier | Context (Exp t) (Exp t) (PAtom t) -- ^ | PGuard [PGuard t] -- ^ Righthandside of functions with | -- the PAtom in PGuard' does not contain any comments | PGuard' (PAtom t) (Exp t) (PAtom t) -- type constructor is just a wrapper to indicate which highlightning to -- use. | TC (Exp t) -- ^ Type constructor -- data constructor same as with the TC constructor | DC (Exp t) -- ^ Data constructor | PLet (PAtom t) (Exp t) (Exp t) -- ^ let expression | PIn t [Exp t] deriving (Show, Foldable) instance IsTree Exp where emptyNode = Expr [] uniplate tree = case tree of (ProgMod a b) -> ([a,b], \[a,b] -> ProgMod a b) (Body x exp exp') -> ([x, exp, exp'], \[x, exp, exp'] -> Body x exp exp') (PModule x (Just e)) -> ([e],\[e] -> PModule x (Just e)) (Paren l g r) -> -- TODO: improve (l:g ++ [r], \(l:gr) -> Paren l (init gr) (last gr)) (RHS l g) -> ([l,g],\[l,g] -> (RHS l g)) (Block s) -> (s,Block) (PLet l s i) -> ([l,s,i],\[l,s,i] -> PLet l s i) (PIn x ts) -> (ts,PIn x) (Expr a) -> (a,Expr) (PClass a b c) -> ([a,b,c],\[a,b,c] -> PClass a b c) (PWhere a b c) -> ([a,b,c],\[a,b,c] -> PWhere a b c) (Opt (Just x)) -> ([x],\[x] -> (Opt (Just x))) (Bin a b) -> ([a,b],\[a,b] -> (Bin a b)) (PType a b c d) -> ([a,b,c,d],\[a,b,c,d] -> PType a b c d) (PData a b c d) -> ([a,b,c,d],\[a,b,c,d] -> PData a b c d) (PData' a b) -> ([a,b] ,\[a,b] -> PData' a b) (Context a b c) -> ([a,b,c],\[a,b,c] -> Context a b c) (PGuard xs) -> (xs,PGuard) (PGuard' a b c) -> ([a,b,c],\[a,b,c] -> PGuard' a b c) (TC e) -> ([e],\[e] -> TC e) (DC e) -> ([e],\[e] -> DC e) PModuleDecl a b c d -> ([a,b,c,d],\[a,b,c,d] -> PModuleDecl a b c d) PImport a b c d e -> ([a,b,c,d,e],\[a,b,c,d,e] -> PImport a b c d e) t -> ([],const t) -- | The parser parse :: P TT (Tree TT) parse = pModule <* eof -- | @pModule@ parse a module pModule :: Parser TT (PModule TT) pModule = PModule <$> pComments <*> optional (pBlockOf' (ProgMod <$> pModuleDecl <*> pModBody <|> pBody)) -- | Parse a body that follows a module pModBody :: Parser TT (PModule TT) pModBody = (exact [startBlock] *> (Body <$> pImports <*> ((pTestTok elems *> pBod) <|> pEmptyBL) <* exact [endBlock] <*> pBod <|> Body <$> noImports <*> ((pBod <|> pEmptyBL) <* exact [endBlock]) <*> pBod)) <|> (exact [nextLine] *> pBody) <|> Body <$> pure emptyNode <*> pEmptyBL <*> pEmptyBL where pBod = Block <$> pBlocks pTopDecl elems = [Special ';', nextLine, startBlock] -- | @pEmptyBL@ A parser returning an empty block pEmptyBL :: Parser TT (Exp TT) pEmptyBL = Block <$> pEmpty -- | Parse a body of a program pBody :: Parser TT (PModule TT) pBody = Body <$> noImports <*> (Block <$> pBlocks pTopDecl) <*> pEmptyBL <|> Body <$> pImports <*> ((pTestTok elems *> (Block <$> pBlocks pTopDecl)) <|> pEmptyBL) <*> pEmptyBL where elems = [nextLine, startBlock] noImports :: Parser TT (Exp TT) noImports = notNext [Reserved Import] *> pure emptyNode where notNext f = testNext $ uncurry (||) . (&&&) isNothing (flip notElem f . tokT . fromJust) -- Helper functions for parsing follows -- | Parse Variables pVarId :: Parser TT (Exp TT) pVarId = pAtom [VarIdent, Reserved Other, Reserved As] -- | Parse VarIdent and ConsIdent pQvarid :: Parser TT (Exp TT) pQvarid = pAtom [VarIdent, ConsIdent, Reserved Other, Reserved As] -- | Parse an operator using please pQvarsym :: Parser TT (Exp TT) pQvarsym = pParen ((:) <$> please (PAtom <$> sym isOperator <*> pComments) <*> pEmpty) -- | Parse any operator isOperator :: Token -> Bool isOperator (Operator _) = True isOperator (ReservedOp _) = True isOperator (ConsOperator _) = True isOperator _ = False -- | Parse a consident pQtycon :: Parser TT (Exp TT) pQtycon = pAtom [ConsIdent] -- | Parse many variables pVars :: Parser TT (Exp TT) pVars = pMany pVarId -- | Parse a nextline token (the nexLine token is inserted by Layout.hs) nextLine :: Token nextLine = Special '.' -- | Parse a startBlock token startBlock :: Token startBlock = Special '<' -- | Parse a endBlock token endBlock :: Token endBlock = Special '>' pEmpty :: Applicative f => f [a] pEmpty = pure [] pToList :: Applicative f => f a -> f [a] pToList = (box <$>) where box x = [x] -- | @sym f@ returns a parser parsing @f@ as a special symbol sym :: (Token -> Bool) -> Parser TT TT sym f = symbol (f . tokT) -- | @exact tokList@ parse anything that is in @tokList@ exact :: [Token] -> Parser TT TT exact = sym . flip elem -- | @please p@ returns a parser parsing either @p@ or recovers with the -- (Special '!') token. please :: Parser TT (Exp TT) -> Parser TT (Exp TT) please = (<|>) (PError <$> recoverWith errTok <*> errTok <*> pEmpty) -- | Parse anything, as errors pErr :: Parser TT (Exp TT) pErr = PError <$> recoverWith (sym $ not . uncurry (||) . (&&&) isComment (== CppDirective)) <*> errTok <*> pComments -- | Parse an ConsIdent ppCons :: Parser TT (Exp TT) ppCons = ppAtom [ConsIdent] -- | Parse a keyword pKW :: [Token] -> Parser TT (Exp TT) -> Parser TT (Exp TT) pKW k r = Bin <$> pAtom k <*> r -- | Parse an unary operator with and without using please pOP :: [Token] -> Parser TT (Exp TT) -> Parser TT (Exp TT) pOP op r = Bin <$> pAtom op <*> r --ppOP op r = Bin <$> ppAtom op <*> r -- | Parse comments pComments :: Parser TT [TT] pComments = many $ sym $ uncurry (||) . (&&&) isComment (== CppDirective) -- | Parse something thats optional pOpt :: Parser TT (Exp TT) -> Parser TT (Exp TT) pOpt x = Opt <$> optional x -- | Parse an atom with, and without using please pAtom, ppAtom :: [Token] -> Parser TT (Exp TT) pAtom = flip pCAtom pComments ppAtom at = pAtom at <|> recoverAtom recoverAtom :: Parser TT (Exp TT) recoverAtom = PAtom <$> recoverWith errTok <*> pEmpty -- | Parse an atom with optional comments pCAtom :: [Token] -> Parser TT [TT] -> Parser TT (Exp TT) pCAtom r c = PAtom <$> exact r <*> c pBareAtom a = pCAtom a pEmpty -- | @pSepBy p sep@ parse /zero/ or more occurences of @p@, separated -- by @sep@, with optional ending @sep@, -- this is quite similar to the sepBy function provided in -- Parsec, but this one allows an optional extra separator at the end. -- -- > commaSep p = p `pSepBy` (symbol (==(Special ','))) pSepBy :: Parser TT (Exp TT) -> Parser TT (Exp TT) -> Parser TT [Exp TT] pSepBy p sep = pEmpty <|> (:) <$> p <*> (pSepBy1 p sep <|> pEmpty) <|> pToList sep -- optional ending separator where pSepBy1 r p' = (:) <$> p' <*> (pEmpty <|> pSepBy1 p' r) -- | Separate a list of things separated with comma inside of parenthesis pParenSep :: Parser TT (Exp TT) -> Parser TT (Exp TT) pParenSep = pParen . flip pSepBy pComma -- | Parse a comma separator pComma :: Parser TT (Exp TT) pComma = pAtom [Special ','] -- End of helper functions Parsing different parts follows -- | Parse a Module declaration pModuleDecl :: Parser TT (PModuleDecl TT) pModuleDecl = PModuleDecl <$> pAtom [Reserved Module] <*> ppAtom [ConsIdent] <*> pOpt (pParenSep pExport) <*> (optional (exact [nextLine]) *> (Bin <$> ppAtom [Reserved Where]) <*> pMany pErr) <* pTestTok elems where elems = [nextLine, startBlock, endBlock] pExport :: Parser TT (Exp TT) pExport = optional (exact [nextLine]) *> please ( pVarId <|> pEModule <|> Bin <$> pQvarsym <*> (DC <$> pOpt expSpec) -- typeOperator <|> Bin <$> (TC <$> pQtycon) <*> (DC <$> pOpt expSpec) ) where expSpec = pParen (pToList (please (pAtom [ReservedOp DoubleDot])) <|> pSepBy pQvarid pComma) -- | Check if next token is in given list pTestTok :: [Token] -> Parser TT () pTestTok f = testNext (uncurry (||) . (&&&) isNothing (flip elem f . tokT . fromJust)) -- | Parse several imports pImports :: Parser TT (Exp TT) -- [PImport TT] pImports = Expr <$> many (pImport <* pTestTok pEol <* optional (some $ exact [nextLine, Special ';'])) where pEol = [Special ';', nextLine, endBlock] -- | Parse one import pImport :: Parser TT (PImport TT) pImport = PImport <$> pAtom [Reserved Import] <*> pOpt (pAtom [Reserved Qualified]) <*> ppAtom [ConsIdent] <*> pOpt (pKW [Reserved As] ppCons) <*> (TC <$> pImpSpec) where pImpSpec = Bin <$> pKW [Reserved Hiding] (please pImpS) <*> pMany pErr <|> Bin <$> pImpS <*> pMany pErr <|> pMany pErr pImpS = DC <$> pParenSep pExp' pExp' = Bin <$> (PAtom <$> sym (uncurry (||) . (&&&) (`elem` [VarIdent, ConsIdent]) isOperator) <*> pComments <|> pQvarsym) <*> pOpt pImpS -- | Parse simple type synonyms pType :: Parser TT (Exp TT) pType = PType <$> (Bin <$> pAtom [Reserved Type] <*> pOpt (pAtom [Reserved Instance])) <*> (TC . Expr <$> pTypeExpr') <*> ppAtom [ReservedOp Equal] <*> (TC . Expr <$> pTypeExpr') -- | Parse data declarations pData :: Parser TT (Exp TT) pData = PData <$> pAtom [Reserved Data, Reserved NewType] <*> (TC . Expr <$> pTypeExpr') <*> pOpt (pDataRHS <|> pGadt) <*> pOpt pDeriving pGadt :: Parser TT (Exp TT) pGadt = pWhere pTypeDecl -- | Parse second half of the data declaration, if there is one pDataRHS :: Parser TT (Exp TT) pDataRHS = PData' <$> pAtom [ReservedOp Equal] <*> pConstrs -- | Parse a deriving pDeriving :: Parser TT (Exp TT) pDeriving = pKW [Reserved Deriving] (TC . Expr <$> pTypeExpr') pAtype :: Parser TT (Exp TT) pAtype = pAtype' <|> pErr pAtype' :: Parser TT (Exp TT) pAtype' = pTypeCons <|> pParen (many $ pExprElem []) <|> pBrack (many $ pExprElem []) pTypeCons :: Parser TT (Exp TT) pTypeCons = Bin <$> pAtom [ConsIdent] <*> please (pMany $ pAtom [VarIdent, ConsIdent]) pContext :: Parser TT (Exp TT) pContext = Context <$> pOpt pForAll <*> (TC <$> (pClass' <|> pParenSep pClass')) <*> ppAtom [ReservedOp DoubleRightArrow] where pClass' :: Parser TT (Exp TT) pClass' = Bin <$> pQtycon <*> (please pVarId <|> pParen ((:) <$> please pVarId <*> many pAtype')) -- | Parse for all pForAll :: Parser TT (Exp TT) pForAll = pKW [Reserved Forall] (Bin <$> pVars <*> ppAtom [Operator "."]) pConstrs :: Parser TT (Exp TT) pConstrs = Bin <$> (Bin <$> pOpt pContext <*> pConstr) <*> pMany (pOP [ReservedOp Pipe] (Bin <$> pOpt pContext <*> please pConstr)) pConstr :: Parser TT (Exp TT) pConstr = Bin <$> pOpt pForAll <*> (Bin <$> (Bin <$> (DC <$> pAtype) <*> (TC <$> pMany (strictF pAtype))) <*> pOpt st) <|> Bin <$> lrHs <*> pMany (strictF pAtype) <|> pErr where lrHs = pOP [Operator "!"] pAtype st = pEBrace (pTypeDecl `sepBy1` pBareAtom [Special ',']) -- named fields declarations -- | Parse optional strict variables strictF :: Parser TT (Exp TT) -> Parser TT (Exp TT) strictF a = Bin <$> pOpt (pAtom [Operator "!"]) <*> a -- | Exporting module pEModule ::Parser TT (Exp TT) pEModule = pKW [Reserved Module] $ please (Modid <$> exact [ConsIdent] <*> pComments) -- | Parse a Let expression pLet :: Parser TT (Exp TT) pLet = PLet <$> pAtom [Reserved Let] <*> pBlock pFunDecl <*> pOpt (pBareAtom [Reserved In]) -- | Parse a Do block pDo :: Parser TT (Exp TT) pDo = Bin <$> pAtom [Reserved Do] <*> pBlock (pExpr ((Special ';' : recognizedSometimes) \\ [ReservedOp LeftArrow])) -- | Parse part of a lambda binding. pLambda :: Parser TT (Exp TT) pLambda = Bin <$> pAtom [ReservedOp BackSlash] <*> (Bin <$> (Expr <$> pPattern) <*> please (pBareAtom [ReservedOp RightArrow])) -- | Parse an Of block pOf :: Parser TT (Exp TT) pOf = Bin <$> pAtom [Reserved Of] <*> pBlock pAlternative pAlternative = Bin <$> (Expr <$> pPattern) <*> please (pFunRHS (ReservedOp RightArrow)) -- | Parse classes and instances -- This is very imprecise, but shall suffice for now. -- At least is does not complain too often. pClass :: Parser TT (Exp TT) pClass = PClass <$> pAtom [Reserved Class, Reserved Instance] <*> (TC . Expr <$> pTypeExpr') <*> pOpt (please (pWhere pTopDecl)) -- use topDecl since we have associated types and such. -- | Parse some guards and a where clause pGuard :: Token -> Parser TT (Exp TT) pGuard equalSign = PGuard <$> some (PGuard' <$> pCAtom [ReservedOp Pipe] pEmpty <*> -- comments are by default parsed after this pExpr (recognizedSometimes -- these two symbols can appear in guards. \\ [ReservedOp LeftArrow, Special ',']) <*> please (pEq equalSign)) -- this must be -> if used in case -- | Right-hand-side of a function or case equation (after the pattern) pFunRHS :: Token -> Parser TT (Exp TT) pFunRHS equalSign = Bin <$> (pGuard equalSign <|> pEq equalSign) <*> pOpt (pWhere pFunDecl) pWhere :: Parser TT (Exp TT) -> Parser TT (Exp TT) pWhere p = PWhere <$> pAtom [Reserved Where] <*> please (pBlock p) <*> pMany pErr -- After a where there might "misaligned" code that do not "belong" to anything. -- Here we swallow it as errors. -- Note that this can both parse an equation and a type declaration. -- Since they can start with the same token, the left part is factored here. pDecl :: Bool -> Bool -> Parser TT (Exp TT) pDecl acceptType acceptEqu = Expr <$> ((Yuck $ Enter "missing end of type or equation declaration" $ pure []) <|> ((:) <$> pElem False recognizedSometimes <*> pToList (pDecl acceptType acceptEqu)) <|> ((:) <$> pBareAtom [Special ','] <*> pToList (pDecl acceptType False)) -- if a comma is found, then the rest must be a type -- declaration. <|> (if acceptType then pTypeEnding else empty) <|> (if acceptEqu then pEquEnding else empty)) where pTypeEnding = (:) <$> (TS <$> exact [ReservedOp DoubleColon] <*> pTypeExpr') <*> pure [] pEquEnding = (:) <$> pFunRHS (ReservedOp Equal) <*> pure [] pFunDecl = pDecl True True pTypeDecl = pDecl True False --pEquation = pDecl False True -- | The RHS of an equation. pEq :: Token -> Parser TT (Exp TT) pEq equalSign = RHS <$> pBareAtom [equalSign] <*> pExpr' -- | Parse many of something pMany :: Parser TT (Exp TT) -> Parser TT (Exp TT) pMany p = Expr <$> many p -- | Parse a some of something separated by the token (Special '.') pBlocks :: Parser TT r -> Parser TT [r] pBlocks p = p `sepBy1` exact [nextLine] -- | Parse a some of something separated by the token (Special '.'), or nothing --pBlocks' :: Parser TT r -> Parser TT (BL.BList r) pBlocks' p = pBlocks p <|> pure [] -- | Parse a block of some something separated by the tok (Special '.') pBlockOf :: Parser TT (Exp TT) -> Parser TT (Exp TT) pBlockOf p = Block <$> pBlockOf' (pBlocks p) -- see HACK above pBlock :: Parser TT (Exp TT) -> Parser TT (Exp TT) pBlock p = pBlockOf' (Block <$> pBlocks' p) <|> pEBrace (p `sepBy1` exact [Special ';'] <|> pure []) <|> (Yuck $ Enter "block expected" pEmptyBL) -- | Parse something surrounded by (Special '<') and (Special '>') pBlockOf' :: Parser TT a -> Parser TT a pBlockOf' p = exact [startBlock] *> p <* exact [endBlock] -- see HACK above -- note that, by construction, '<' and '>' will always be matched, so -- we don't try to recover errors with them. -- | Parse something that can contain a data, type declaration or a class pTopDecl :: Parser TT (Exp TT) pTopDecl = pFunDecl <|> pType <|> pData <|> pClass <|> pure emptyNode -- | A "normal" expression, where none of the following symbols are acceptable. pExpr' = pExpr recognizedSometimes recognizedSometimes = [ReservedOp DoubleDot, Special ',', ReservedOp Pipe, ReservedOp Equal, ReservedOp LeftArrow, ReservedOp RightArrow, ReservedOp DoubleRightArrow, ReservedOp BackSlash, ReservedOp DoubleColon ] -- | Parse an expression, as a concatenation of elements. pExpr :: [Token] -> Parser TT (Exp TT) pExpr at = Expr <$> pExprOrPattern True at -- | Parse an expression, as a concatenation of elements. pExprOrPattern :: Bool -> [Token] -> Parser TT [Exp TT] pExprOrPattern isExpresssion at = pure [] <|> ((:) <$> pElem isExpresssion at <*> pExprOrPattern True at) <|> ((:) <$> (TS <$> exact [ReservedOp DoubleColon] <*> pTypeExpr') <*> pure []) -- TODO: not really correct: in (x :: X , y :: Z), all after the -- first :: will be a "type". pPattern = pExprOrPattern False recognizedSometimes pExprElem = pElem True -- | Parse an "element" of an expression or a pattern. -- "at" is a list of symbols that, if found, should be considered errors. pElem :: Bool -> [Token] -> Parser TT (Exp TT) pElem isExpresssion at = pCParen (pExprOrPattern isExpresssion -- might be a tuple, so accept commas as noise (recognizedSometimes \\ [Special ','])) pEmpty <|> pCBrack (pExprOrPattern isExpresssion (recognizedSometimes \\ [ ReservedOp DoubleDot, ReservedOp Pipe , ReservedOp LeftArrow , Special ','])) pEmpty -- list thing <|> pCBrace (many $ pElem isExpresssion -- record: TODO: improve (recognizedSometimes \\ [ ReservedOp Equal, Special ',' , ReservedOp Pipe])) pEmpty <|> (Yuck $ Enter "incorrectly placed block" $ -- no error token, but the previous keyword will be one. (of, where, ...) pBlockOf (pExpr recognizedSometimes)) <|> (PError <$> recoverWith (sym $ flip elem $ isNoiseErr at) <*> errTok <*> pEmpty) <|> (PAtom <$> sym (`notElem` isNotNoise at) <*> pEmpty) <|> if isExpresssion then pLet <|> pDo <|> pOf <|> pLambda else empty -- TODO: support type expressions pTypeExpr at = many (pTypeElem at) pTypeExpr' = pTypeExpr (recognizedSometimes \\ [ReservedOp RightArrow, ReservedOp DoubleRightArrow]) pTypeElem :: [Token] -> Parser TT (Exp TT) pTypeElem at = pCParen (pTypeExpr (recognizedSometimes \\ [ ReservedOp RightArrow, ReservedOp DoubleRightArrow, -- might be a tuple, so accept commas as noise Special ','])) pEmpty <|> pCBrack pTypeExpr' pEmpty <|> pCBrace pTypeExpr' pEmpty -- TODO: this is an error: mark as such. <|> (Yuck $ Enter "incorrectly placed block" $ pBlockOf (pExpr recognizedSometimes)) <|> (PError <$> recoverWith (sym $ flip elem $ isNoiseErr at) <*> errTok <*> pEmpty) <|> (PAtom <$> sym (`notElem` isNotNoise at) <*> pEmpty) -- | List of things that always should be parsed as errors isNoiseErr :: [Token] -> [Token] isNoiseErr r = recoverableSymbols ++ r recoverableSymbols = recognizedSymbols \\ fmap Special "([{<>." -- We just don't recover opening symbols (only closing are "fixed"). -- Layout symbols "<>." are never recovered, because layout is -- constructed correctly. -- | List of things that should not be parsed as noise isNotNoise :: [Token] -> [Token] isNotNoise r = recognizedSymbols ++ r -- | These symbols are always properly recognized, and therefore they -- should never be accepted as "noise" inside expressions. recognizedSymbols = [ Reserved Let , Reserved In , Reserved Do , Reserved Of , Reserved Class , Reserved Instance , Reserved Deriving , Reserved Module , Reserved Import , Reserved Type , Reserved Data , Reserved NewType , Reserved Where] ++ fmap Special "()[]{}<>." -- | Parse parenthesis, brackets and braces containing -- an expression followed by possible comments pCParen, pCBrace, pCBrack :: Parser TT [Exp TT] -> Parser TT [TT] -> Parser TT (Exp TT) pCParen p c = Paren <$> pCAtom [Special '('] c <*> p <*> (recoverAtom <|> pCAtom [Special ')'] c) pCBrace p c = Paren <$> pCAtom [Special '{'] c <*> p <*> (recoverAtom <|> pCAtom [Special '}'] c) pCBrack p c = Paren <$> pCAtom [Special '['] c <*> p <*> (recoverAtom <|> pCAtom [Special ']'] c) pParen, pBrack :: Parser TT [Exp TT] -> Parser TT (Exp TT) pParen = flip pCParen pComments --pBrace = flip pCBrace pComments pBrack = flip pCBrack pComments -- pEBrace parse an opening brace, followed by zero comments -- then followed by an closing brace and some comments pEBrace p = Paren <$> pCAtom [Special '{'] pEmpty <*> p <*> (recoverAtom <|> pCAtom [Special '}'] pComments) -- | Create a special error token. (e.g. fill in where there is no -- correct token to parse) Note that the position of the token has to -- be correct for correct computation of node spans. errTok = mkTok <$> curPos where curPos = tB <$> lookNext tB Nothing = maxBound tB (Just x) = tokBegin x mkTok p = Tok (Special '!') 0 (startPosn {posnOfs = p}) yi-0.12.6/src/library/Yi/Syntax/JavaScript.hs0000644000000000000000000005161512717763531017137 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE FlexibleInstances #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Syntax.JavaScript -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Parser for the JavaScript language as described at -- . -- -- The mode using this parser can be found at "Yi.Mode.JavaScript". module Yi.Syntax.JavaScript where import Prelude hiding (elem,error,any,exp) import Control.Applicative (Alternative ((<|>), many), Applicative ((<*), (<*>), pure), optional, (<$>)) import Data.Data (Data) import Data.Foldable (Foldable (foldMap), any, elem, toList) import Data.Monoid (Endo (..), Monoid (mempty), (<>)) import qualified Data.Text as T (cons) import Data.Typeable (Typeable) import Yi.Buffer.Basic (Point (..)) import Yi.Debug (trace) import Yi.IncrementalParse (P, eof, recoverWith, symbol) import Yi.Lexer.Alex (Stroke, Tok (..), tokFromT, tokToSpan) import Yi.Lexer.JavaScript import Yi.String (showT) import Yi.Style (StyleName, errorStyle) import Yi.Syntax.Tree (IsTree (..), sepBy, sepBy1) -- * Data types, classes and instances -- | Instances of @Strokable@ are datatypes which can be syntax highlighted. class Strokable a where toStrokes :: a -> Endo [Stroke] -- | Instances of @Failable@ can represent failure. This is a useful class for -- future work, since then we can make stroking much easier. class Failable f where stupid :: t -> f t hasFailed :: f t -> Bool type BList a = [a] type Tree t = BList (Statement t) type Semicolon t = Maybe t data Statement t = FunDecl t t (Parameters t) (Block t) | VarDecl t (BList (VarDecAss t)) (Semicolon t) | Return t (Maybe (Expr t)) (Semicolon t) | While t (ParExpr t) (Block t) | DoWhile t (Block t) t (ParExpr t) (Semicolon t) | For t t (Expr t) (ForContent t) t (Block t) | If t (ParExpr t) (Block t) (Maybe (Statement t)) | Else t (Block t) | With t (ParExpr t) (Block t) | Comm t | Expr (Expr t) (Semicolon t) deriving (Show, Data, Typeable, Foldable) data Parameters t = Parameters t (BList t) t | ParErr t deriving (Show, Data, Typeable, Foldable) data ParExpr t = ParExpr t (BList (Expr t)) t | ParExprErr t deriving (Show, Data, Typeable, Foldable) data ForContent t = ForNormal t (Expr t) t (Expr t) | ForIn t (Expr t) | ForErr t deriving (Show, Data, Typeable, Foldable) data Block t = Block t (BList (Statement t)) t | BlockOne (Statement t) | BlockErr t deriving (Show, Data, Typeable, Foldable) -- | Represents either a variable name or a variable name assigned to an -- expression. @AssBeg@ is a variable name /maybe/ followed by an assignment. -- @AssRst@ is an equals sign and an expression. @(AssBeg 'x' (Just (AssRst -- '=' '5')))@ means @x = 5@. data VarDecAss t = AssBeg t (Maybe (VarDecAss t)) | AssRst t (Expr t) | AssErr t deriving (Show, Data, Typeable, Foldable) data Expr t = ExprObj t (BList (KeyValue t)) t | ExprPrefix t (Expr t) | ExprNew t (Expr t) | ExprSimple t (Maybe (Expr t)) | ExprParen t (Expr t) t (Maybe (Expr t)) | ExprAnonFun t (Parameters t) (Block t) | ExprTypeOf t (Expr t) | ExprFunCall t (ParExpr t) (Maybe (Expr t)) | OpExpr t (Expr t) | ExprCond t (Expr t) t (Expr t) | ExprArr t (Maybe (Array t)) t (Maybe (Expr t)) | PostExpr t | ExprErr t deriving (Show, Data, Typeable, Foldable) data Array t = ArrCont (Expr t) (Maybe (Array t)) | ArrRest t (Array t) (Maybe (Array t)) | ArrErr t deriving (Show, Data, Typeable, Foldable) data KeyValue t = KeyValue t t (Expr t) | KeyValueErr t deriving (Show, Data, Typeable, Foldable) instance IsTree Statement where subtrees (FunDecl _ _ _ x) = fromBlock x subtrees (While _ _ x) = fromBlock x subtrees (DoWhile _ x _ _ _) = fromBlock x subtrees (For _ _ _ _ _ x) = fromBlock x subtrees (If _ _ x mb) = fromBlock x <> maybe [] subtrees mb subtrees (Else _ x) = fromBlock x subtrees (With _ _ x) = fromBlock x subtrees _ = [] instance Failable ForContent where stupid = ForErr hasFailed t = case t of ForErr _ -> True _ -> False instance Failable Block where stupid = BlockErr hasFailed t = case t of BlockErr _ -> True _ -> False instance Failable VarDecAss where stupid = AssErr hasFailed t = case t of AssErr _ -> True _ -> False instance Failable Parameters where stupid = ParErr hasFailed t = case t of ParErr _ -> True _ -> False instance Failable ParExpr where stupid = ParExprErr hasFailed t = case t of ParExprErr _ -> True _ -> False instance Failable Expr where stupid = ExprErr hasFailed t = case t of ExprErr _ -> True _ -> False instance Failable KeyValue where stupid = KeyValueErr hasFailed t = case t of KeyValueErr _ -> True _ -> False -- | TODO: This code is *screaming* for some generic programming. -- -- TODO: Somehow fix Failable and failStroker to be more "generic". This will -- make these instances much nicer and we won't have to make ad-hoc stuff like -- this. instance Strokable (Statement TT) where toStrokes (FunDecl f n ps blk) = let s = if hasFailed blk then error else failStroker [n] in s f <> s n <> toStrokes ps <> toStrokes blk toStrokes (VarDecl v vs sc) = let s = if any hasFailed vs then error else normal in s v <> foldMap toStrokes vs <> maybe mempty s sc toStrokes (Return t exp sc) = normal t <> maybe mempty toStrokes exp <> maybe mempty normal sc toStrokes (While w exp blk) = let s = if hasFailed blk || hasFailed blk then error else normal in s w <> toStrokes exp <> toStrokes blk toStrokes (DoWhile d blk w exp sc) = let s1 = if hasFailed blk then error else normal s2 = if hasFailed exp then error else normal in s1 d <> toStrokes blk <> s2 w <> toStrokes exp <> maybe mempty normal sc toStrokes (For f l x c r blk) = let s = if hasFailed blk || hasFailed c || hasFailed x then error else failStroker [f, l, r] in s f <> s l <> toStrokes x <> toStrokes c <> s r <> toStrokes blk toStrokes (If i x blk e) = let s = if hasFailed blk then error else normal in s i <> toStrokes x <> toStrokes blk <> maybe mempty toStrokes e toStrokes (Else e blk) = normal e <> toStrokes blk toStrokes (With w x blk) = normal w <> toStrokes x <> toStrokes blk toStrokes (Expr exp sc) = toStrokes exp <> maybe mempty normal sc toStrokes (Comm t) = normal t instance Strokable (ForContent TT) where toStrokes (ForNormal s1 x2 s2 x3) = let s = if any hasFailed [x2, x3] then error else failStroker [s2] in s s1 <> toStrokes x2 <> s s2 <> toStrokes x3 toStrokes (ForIn i x) = let s = if hasFailed x then error else normal in s i <> toStrokes x toStrokes (ForErr t) = error t instance Strokable (Block TT) where toStrokes (BlockOne stmt) = toStrokes stmt toStrokes (Block l stmts r) = let s = failStroker [l, r] in s l <> foldMap toStrokes stmts <> s r toStrokes (BlockErr t) = error t instance Strokable (VarDecAss TT) where toStrokes (AssBeg t x) = normal t <> maybe mempty toStrokes x toStrokes (AssRst t exp) = let s = if hasFailed exp then error else normal in s t <> toStrokes exp toStrokes (AssErr t) = error t instance Strokable (Expr TT) where toStrokes (ExprSimple x exp) = normal x <> maybe mempty toStrokes exp toStrokes (ExprObj l kvs r) = let s = failStroker [l, r] in s l <> foldMap toStrokes kvs <> s r toStrokes (ExprPrefix t exp) = normal t <> toStrokes exp toStrokes (ExprNew t x) = normal t <> toStrokes x toStrokes (ExprParen l exp r op) = let s = failStroker [l, r] in s l <> toStrokes exp <> s r <> maybe mempty toStrokes op toStrokes (ExprAnonFun f ps blk) = normal f <> toStrokes ps <> toStrokes blk toStrokes (ExprTypeOf t x) = let s = if hasFailed x then error else normal in s t <> toStrokes x toStrokes (ExprFunCall n x m) = let s = if hasFailed x then error else normal in s n <> toStrokes x <> maybe mempty toStrokes m toStrokes (OpExpr op exp) = let s = if hasFailed exp then error else normal in s op <> toStrokes exp toStrokes (PostExpr t) = normal t toStrokes (ExprCond a x b y) = let s = failStroker [a, b] in s a <> toStrokes x <> s b <> toStrokes y toStrokes (ExprArr l x r m) = let s = failStroker [l, r] in s l <> maybe mempty toStrokes x <> s r <> maybe mempty toStrokes m toStrokes (ExprErr t) = error t instance Strokable (Parameters TT) where toStrokes (Parameters l ps r) = normal l <> foldMap toStrokes ps <> normal r toStrokes (ParErr t) = error t instance Strokable (ParExpr TT) where toStrokes (ParExpr l xs r) = let s = if isError r || any hasFailed xs then error else normal in s l <> foldMap toStrokes xs <> s r toStrokes (ParExprErr t) = error t instance Strokable (KeyValue TT) where toStrokes (KeyValue n c exp) = let s = failStroker [n, c] in s n <> s c <> toStrokes exp toStrokes (KeyValueErr t) = error t instance Strokable (Tok Token) where toStrokes t = if isError t then one (modStroke errorStyle . tokenToStroke) t else one tokenToStroke t instance Strokable (Array TT) where toStrokes (ArrCont x m) = toStrokes x <> maybe mempty toStrokes m toStrokes (ArrRest c a m) = normal c <> toStrokes a <> maybe mempty toStrokes m toStrokes (ArrErr t) = error t -- * Helper functions. -- | Normal stroker. normal :: TT -> Endo [Stroke] normal = one tokenToStroke -- | Error stroker. error :: TT -> Endo [Stroke] error = one (modStroke errorStyle . tokenToStroke) one :: (t -> a) -> t -> Endo [a] one f x = Endo (f x :) -- | Given a new style and a stroke, return a stroke with the new style appended -- to the old one. modStroke :: StyleName -> Stroke -> Stroke modStroke style = fmap (style <>) -- * Stroking functions -- | Given a list of tokens to check for errors (@xs@) and a list of tokens to -- stroke (@xs'@), returns normal strokes for @xs'@ if there were no errors. -- Otherwise returns error strokes for @xs'@. nError :: [TT] -> [TT] -> Endo [Stroke] nError xs = foldMap (failStroker xs) -- | Given a list of @TT@, if any of them is an error, returns an error stroker, -- otherwise a normal stroker. Using e.g. existentials, we could make this -- more general and have support for heterogeneous lists of elements which -- implement Failable, but I haven't had the time to fix this. failStroker :: [TT] -> TT -> Endo [Stroke] failStroker xs = if any isError xs then error else normal -- | Given a @TT@, return a @Stroke@ for it. tokenToStroke :: TT -> Stroke tokenToStroke = fmap tokenToStyle . tokToSpan -- | The main stroking function. getStrokes :: Tree TT -> Point -> Point -> Point -> [Stroke] getStrokes t0 _point _begin _end = trace ('\n' `T.cons` showT t0) result where result = appEndo (foldMap toStrokes t0) [] -- * The parser -- | Main parser. parse :: P TT (Tree TT) parse = many statement <* eof -- | Parser for statements such as "return", "while", "do-while", "for", etc. statement :: P TT (Statement TT) statement = FunDecl <$> res Function' <*> plzTok name <*> parameters <*> block <|> VarDecl <$> res Var' <*> plz varDecAss `sepBy1` spc ',' <*> semicolon <|> Return <$> res Return' <*> optional expression <*> semicolon <|> While <$> res While' <*> parExpr <*> block <|> DoWhile <$> res Do' <*> block <*> plzTok (res While') <*> parExpr <*> semicolon <|> For <$> res For' <*> plzSpc '(' <*> plzExpr <*> forContent <*> plzSpc ')' <*> block <|> If <$> res If' <*> parExpr <*> block <*> optional (Else <$> res Else' <*> block) <|> With <$> res With' <*> parExpr <*> block <|> Comm <$> comment <|> Expr <$> stmtExpr <*> semicolon where forContent :: P TT (ForContent TT) forContent = ForNormal <$> spc ';' <*> plzExpr <*> plzSpc ';' <*> plzExpr <|> ForIn <$> res In' <*> plzExpr <|> ForErr <$> hate 1 (symbol (const True)) <|> ForErr <$> hate 2 (pure errorToken) varDecAss :: P TT (VarDecAss TT) varDecAss = AssBeg <$> name <*> optional (AssRst <$> oper Assign' <*> plzExpr) -- | Parser for "blocks", i.e. a bunch of statements wrapped in curly brackets -- /or/ just a single statement. -- -- Note that this works for JavaScript 1.8 "lambda" style function bodies as -- well, e.g. "function hello() 5", since expressions are also statements and -- we don't require a trailing semi-colon. -- -- TODO: function hello() var x; is not a valid program. block :: P TT (Block TT) block = Block <$> spc '{' <*> many statement <*> plzSpc '}' <|> BlockOne <$> hate 1 statement <|> BlockErr <$> hate 2 (pure errorToken) -- | Parser for expressions which may be statements. In reality, any expression -- is also a valid statement, but this is a slight compromise to get rid of -- the massive performance loss which is introduced when allowing JavaScript -- objects to be valid statements. stmtExpr :: P TT (Expr TT) stmtExpr = ExprSimple <$> simpleTok <*> optional opExpr <|> ExprPrefix <$> preOp <*> plzExpr <|> ExprNew <$> res New' <*> plz funCall <|> funCall -- We hate the parenthesized expression just a tad because otherwise -- confirm('hello') will be seen as "confirm; ('hello');" <|> hate 1 (ExprParen <$> spc '(' <*> plzExpr <*> plzSpc ')' <*> optional opExpr) <|> ExprErr <$> hate 2 (symbol (const True)) where funCall :: P TT (Expr TT) funCall = ExprFunCall <$> name <*> parExpr <*> optional opExpr -- | The basic idea here is to parse "the rest" of expressions, e.g. @+ 3@ in @x -- + 3@ or @[i]@ in @x[i]@. Anything which is useful in such a scenario goes -- here. TODO: This accepts [], but shouldn't, since x[] is invalid. opExpr :: P TT (Expr TT) opExpr = OpExpr <$> inOp <*> plzExpr <|> ExprCond <$> spc '?' <*> plzExpr <*> plzSpc ':' <*> plzExpr <|> PostExpr <$> postOp <|> array -- | Parser for expressions. expression :: P TT (Expr TT) expression = ExprObj <$> spc '{' <*> keyValue `sepBy` spc ',' <*> plzSpc '}' <|> ExprAnonFun <$> res Function' <*> parameters <*> block <|> ExprTypeOf <$> res TypeOf' <*> plzExpr <|> stmtExpr <|> array where keyValue :: P TT (KeyValue TT) keyValue = KeyValue <$> name <*> plzSpc ':' <*> plzExpr <|> KeyValueErr <$> hate 1 (symbol (const True)) <|> KeyValueErr <$> hate 2 (pure errorToken) -- | Parses both empty and non-empty arrays. Should probably be split up into -- further parts to allow for the separation of @[]@ and @[1, 2, 3]@. array :: P TT (Expr TT) array = ExprArr <$> spc '[' <*> optional arrayContents <*> plzSpc ']' <*> optional opExpr where arrayContents :: P TT (Array TT) arrayContents = ArrCont <$> expression <*> optional arrRest arrRest :: P TT (Array TT) arrRest = ArrRest <$> spc ',' <*> (arrayContents <|> ArrErr <$> hate 1 (symbol (const True)) <|> ArrErr <$> hate 2 (pure errorToken)) <*> optional arrRest -- * Parsing helpers -- | Parses a semicolon if it's there. semicolon :: P TT (Maybe TT) semicolon = optional $ spc ';' -- | Parses a comma-separated list of valid identifiers. parameters :: P TT (Parameters TT) parameters = Parameters <$> spc '(' <*> plzTok name `sepBy` spc ',' <*> plzSpc ')' <|> ParErr <$> hate 1 (symbol (const True)) <|> ParErr <$> hate 2 (pure errorToken) parExpr :: P TT (ParExpr TT) parExpr = ParExpr <$> spc '(' <*> plzExpr `sepBy` spc ',' <*> plzSpc ')' <|> ParExprErr <$> hate 1 (symbol (const True)) <|> ParExprErr <$> hate 2 (pure errorToken) -- * Simple parsers -- | Parses a comment. comment :: P TT TT comment = symbol (\t -> case fromTT t of Comment _ -> True _ -> False) -- | Parses a prefix operator. preOp :: P TT TT preOp = symbol (\t -> case fromTT t of Op x -> x `elem` prefixOperators _ -> False) -- | Parses a infix operator. inOp :: P TT TT inOp = symbol (\t -> case fromTT t of Op x -> x `elem` infixOperators _ -> False) -- | Parses a postfix operator. postOp :: P TT TT postOp = symbol (\t -> case fromTT t of Op x -> x `elem` postfixOperators _ -> False) -- | Parses any literal. opTok :: P TT TT opTok = symbol (\t -> case fromTT t of Op _ -> True _ -> False) -- | Parses any literal. simpleTok :: P TT TT simpleTok = symbol (\t -> case fromTT t of Str _ -> True Number _ -> True ValidName _ -> True Const _ -> True Rex _ -> True Res y -> y `elem` [True', False', Undefined', Null', This'] _ -> False) -- | Parses any string. strTok :: P TT TT strTok = symbol (\t -> case fromTT t of Str _ -> True _ -> False) -- | Parses any valid number. numTok :: P TT TT numTok = symbol (\t -> case fromTT t of Number _ -> True _ -> False) -- | Parses any valid identifier. name :: P TT TT name = symbol (\t -> case fromTT t of ValidName _ -> True Const _ -> True _ -> False) -- | Parses any boolean. boolean :: P TT TT boolean = symbol (\t -> case fromTT t of Res y -> y `elem` [True', False'] _ -> False) -- | Parses a reserved word. res :: Reserved -> P TT TT res x = symbol (\t -> case fromTT t of Res y -> x == y _ -> False) -- | Parses a special token. spc :: Char -> P TT TT spc x = symbol (\t -> case fromTT t of Special y -> x == y _ -> False) -- | Parses an operator. oper :: Operator -> P TT TT oper x = symbol (\t -> case fromTT t of Op y -> y == x _ -> False) -- * Recovery parsers -- | Expects a token x, recovers with 'errorToken'. plzTok :: P TT TT -> P TT TT plzTok x = x <|> hate 1 (symbol (const True)) <|> hate 2 (pure errorToken) -- | Expects a special token. plzSpc :: Char -> P TT TT plzSpc x = plzTok (spc x) -- | Expects an expression. plzExpr :: P TT (Expr TT) plzExpr = plz expression plz :: Failable f => P TT (f TT) -> P TT (f TT) plz x = x <|> stupid <$> hate 1 (symbol (const True)) <|> stupid <$> hate 2 (pure errorToken) -- | General recovery parser, inserts an error token. anything :: P s TT anything = recoverWith (pure errorToken) -- | Weighted recovery. hate :: Int -> P s a -> P s a hate n = power n recoverWith where power 0 _ = id power m f = f . power (m - 1) f -- * Utility stuff fromBlock :: Block t -> [Statement t] fromBlock (Block _ x _) = toList x fromBlock (BlockOne x) = [x] fromBlock (BlockErr _) = [] firstTok :: Foldable f => f t -> t firstTok x = head (toList x) errorToken :: TT errorToken = toTT $ Special '!' isError :: TT -> Bool isError (Tok (Special '!') _ _) = True isError _ = False -- | Better name for 'tokFromT'. toTT :: t -> Tok t toTT = tokFromT -- | Better name for 'tokT'. fromTT :: Tok t -> t fromTT = tokT yi-0.12.6/src/library/Yi/Syntax/Latex.hs0000644000000000000000000001320212717763531016134 0ustar0000000000000000{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- uniplate patterns {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Syntax.Latex -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Parser used by the LaTeX modes. module Yi.Syntax.Latex where import Control.Applicative (Alternative ((<|>), empty, many), Applicative ((<*), (<*>), pure), (<$>)) import Data.Foldable (Foldable, foldMap) import Data.Monoid (Endo (..), Monoid (mappend, mempty), (<>)) import Data.Traversable (Traversable (sequenceA)) import Yi.IncrementalParse (P, eof, recoverWith, symbol) import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Lexer.Latex (Token (..), tokenToText) import Yi.Style import Yi.Syntax (Point, Span) import Yi.Syntax.Tree (IsTree (emptyNode, uniplate)) isNoise :: Token -> Bool isNoise Text = True isNoise Comment = True isNoise (Command _) = True isNoise NewCommand = True isNoise (Special ' ') = True isNoise (Special _) = False isNoise (Begin _) = False isNoise (End _) = False type TT = Tok Token type Expr t = [Tree t] data Tree t = Paren t (Tree t) t -- A parenthesized expression (maybe with [ ] ...) | Atom t | Error t | Expr (Expr t) deriving (Show, Functor, Foldable) instance IsTree Tree where uniplate (Paren l g r) = ([g], \[g'] -> Paren l g' r) uniplate (Expr g) = (g, Expr) uniplate t = ([],const t) emptyNode = Expr [] parse :: P TT (Tree TT) parse = pExpr True <* eof where -- Create a special character symbol newT c = tokFromT (Special c) -- errT = (\next -> case next of -- Nothing -> newT '!' -- Just (Tok {tokPosn = posn}) -> Tok { tokT = Special '!', tokPosn = posn-1, tokSize = 1 -- FIXME: size should be 1 char, not one byte! -- }) <$> lookNext errT = pure (newT '!') -- parse a special symbol sym' p = symbol (p . tokT) sym t = sym' (== t) pleaseSym c = recoverWith errT <|> sym c -- pleaseSym' c = recoverWith errT <|> sym' c -- pExpr :: P TT [Expr TT] pExpr outsideMath = Expr <$> many (pTree outsideMath) parens = [(Special x, Special y) | (x,y) <- zip "({[" ")}]"] openParens = fmap fst parens pBlock = sym' isBegin >>= \beg@Tok {tokT = Begin env} -> Paren <$> pure beg <*> pExpr True <*> pleaseSym (End env) pTree :: Bool -> P TT (Tree TT) pTree outsideMath = (if outsideMath then pBlock <|> (Paren <$> sym (Special '$') <*> pExpr False <*> pleaseSym (Special '$')) else empty) <|> foldr1 (<|>) [Paren <$> sym l <*> pExpr outsideMath <*> pleaseSym r | (l,r) <- parens] <|> (Atom <$> sym' isNoise) <|> (Error <$> recoverWith (sym' (not . ((||) <$> isNoise <*> (`elem` openParens))))) getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke] getStrokes point _begin _end t0 = appEndo result [] where getStrokes' :: Tree TT -> Endo [Stroke] getStrokes' (Expr g) = getStrokesL g getStrokes' (Atom t) = ts id t getStrokes' (Error t) = ts (modStroke errorStyle) t -- paint in red getStrokes' (Paren l g r) -- we have special treatment for (Begin, End) because these blocks are typically very large. -- we don't force the "end" part to prevent parsing the whole file. | isBegin (tokT l) = if posnOfs (tokPosn l) /= point then normalPaint else case (tokT l, tokT r) of (Begin b, End e) | b == e -> hintPaint _ -> errPaint | isErrorTok (tokT r) = errPaint -- left paren wasn't matched: paint it in red. -- note that testing this on the "Paren" node actually forces the parsing of the -- right paren, undermining online behaviour. | posnOfs (tokPosn l) == point || posnOfs (tokPosn r) == point - 1 = hintPaint | otherwise = normalPaint where normalPaint = ts id l <> getStrokes' g <> tsEnd id l r hintPaint = ts (modStroke hintStyle) l <> getStrokes' g <> tsEnd (modStroke hintStyle) l r errPaint = ts (modStroke errorStyle) l <> getStrokes' g tsEnd _ (Tok{tokT = Begin b}) t@(Tok{tokT = End e}) | b /= e = ts (modStroke errorStyle) t tsEnd f _ t = ts f t getStrokesL :: Expr TT -> Endo [Stroke] getStrokesL = foldMap getStrokes' ts f t | isErrorTok (tokT t) = mempty | otherwise = Endo (f (tokenToStroke t) :) result = getStrokes' t0 modStroke :: StyleName -> Stroke -> Stroke modStroke f = fmap (f `mappend`) tokenToStroke :: TT -> Stroke tokenToStroke = fmap tokenToStyle . tokToSpan tokenToAnnot :: TT -> Maybe (Span String) tokenToAnnot = sequenceA . tokToSpan . fmap tokenToText tokenToStyle :: Token -> StyleName tokenToStyle t = case t of Comment -> commentStyle Text -> defaultStyle Special _ -> defaultStyle Command _ -> typeStyle Begin _ -> keywordStyle End _ -> keywordStyle NewCommand -> keywordStyle isSpecial :: String -> Token -> Bool isSpecial cs (Special c) = c `elem` cs isSpecial _ _ = False isBegin, isEnd :: Token -> Bool isBegin (Begin _) = True isBegin _ = False isEnd (End _) = True isEnd _ = False isErrorTok :: Token -> Bool isErrorTok = isSpecial "!" yi-0.12.6/src/library/Yi/Syntax/Layout.hs0000644000000000000000000001471312717763531016344 0ustar0000000000000000{-# LANGUAGE PatternGuards #-} {-# LANGUAGE ScopedTypeVariables #-} -- Note: If the first line of the file has wrong indentation, some of the -- code might be left outside of the blocks module Yi.Syntax.Layout (layoutHandler, State) where import Data.List (find) import Data.Maybe (isJust) import Yi.Lexer.Alex (AlexState (..), Posn (Posn), Tok (Tok, tokPosn, tokT), startPosn) import Yi.Syntax (Scanner (..)) data BlockOpen t = Indent Int -- block opened because of indentation; parameter is the column of it. | Paren t -- block opened because of parentheses deriving Show isParen :: BlockOpen t -> Bool isParen (Paren _) = True isParen _ = False data IState t = IState [BlockOpen t] -- current block nesting Bool -- should we open a compound now ? Int -- last line number deriving Show type State t lexState = (IState t, AlexState lexState) -- | Transform a scanner into a scanner that also adds opening, -- closing and "next" tokens to indicate layout. -- @isSpecial@ predicate indicates a token that starts a compound, -- like "where", "do", ... -- @isIgnore@ predicate indicates a token that is to be ignored for -- layout. (eg. pre-processor directive...) -- @parens@ is a list of couple of matching parenthesis-like tokens -- "()[]{}...". layoutHandler :: forall t lexState. (Show t, Eq t) => (t -> Bool) -> [(t,t)] -> (Tok t -> Bool) -> (t,t,t) -> (Tok t -> Bool) -> Scanner (AlexState lexState) (Tok t) -> Scanner (State t lexState) (Tok t) layoutHandler isSpecial parens isIgnored (openT, closeT, nextT) isGroupOpen lexSource = Scanner { scanLooked = scanLooked lexSource . snd, scanEmpty = error "layoutHandler: scanEmpty", scanInit = (IState [] True (-1), scanInit lexSource), scanRun = \st -> let result = parse (fst st) (scanRun lexSource (snd st)) in --trace ("toks = " ++ show (fmap snd result)) $ result } where dummyAlexState = AlexState { stLexer = error "dummyAlexState: should not be reused for restart!", lookedOffset = maxBound, -- setting this to maxBound ensures nobody ever uses it. stPosn = startPosn } deepestIndent [] = -1 deepestIndent (Indent i:_) = i deepestIndent (_:levs) = deepestIndent levs deepestParen _ [] = False deepestParen p (Paren t:levs) = p == t || deepestParen p levs deepestParen p (_:levs) = deepestParen p levs findParen f t = find ((== t) . f) parens parse :: IState t -> [(AlexState lexState, Tok t)] -> [(State t lexState, Tok t)] parse iSt@(IState levels doOpen lastLine) toks@((aSt, tok @ Tok {tokPosn = Posn _nextOfs line col}) : tokss) -- ignore this token | isIgnored tok = (st, tok) : parse (IState levels doOpen line) tokss -- start a compound if the rest of the line is empty then skip to it! | doOpen = if isGroupOpen tok -- check so that the do is not followed by a { then parse (IState levels False lastLine) toks else (st', tt openT) : parse (IState (Indent col : levels) False line) toks -- if it's a block opening, we ignore the layout, and just let the "normal" rule -- handle the creation of another level. -- close, or prepare to close, a paren block | Just (openTok,_) <- findParen snd $ tokT tok, deepestParen openTok levels = case levels of Indent _:levs -> (st',tt closeT) : parse (IState levs False lastLine) toks -- close an indent level inside the paren block Paren openTok' :levs | openTok == openTok' -> (st', tok) : parse (IState levs False line) tokss | otherwise -> parse (IState levs False line) toks -- close one level of nesting. [] -> error $ "Parse: " ++ show iSt -- pop an indent block | col < deepestIndent levels = let (_lev:levs) = dropWhile isParen levels in (st', tt closeT) : parse (IState levs doOpen lastLine) toks -- drop all paren levels inside the indent -- next item | line > lastLine && col == deepestIndent levels = (st', tt nextT) : parse (IState (dropWhile isParen levels) doOpen line) toks -- drop all paren levels inside the indent -- open a paren block | isJust $ findParen fst $ tokT tok = (st', tok) : parse (IState (Paren (tokT tok):levels) (isSpecial (tokT tok)) line) tokss -- important note: the the token can be both special and an opening. This is the case of the -- haskell 'let' (which is closed by 'in'). In that case the inner block is that of the indentation. -- prepare to open a compound | isSpecial (tokT tok) = (st', tok) : parse (IState levels True line) tokss | otherwise = (st', tok) : parse (IState levels doOpen line) tokss where st = (iSt, aSt) st' = (iSt, aSt {lookedOffset = max peeked (lookedOffset aSt)}) tt t = Tok t 0 (tokPosn tok) peeked = case tokss of [] -> maxBound (AlexState {lookedOffset = p},_):_ -> p -- This function checked the position and kind of the -- next token. We peeked further, and so must -- update the lookedOffset accordingly. -- finish by closing all the indent states. parse iSt@(IState (Indent _:levs) doOpen posn) [] = ((iSt,dummyAlexState), Tok closeT 0 maxPosn) : parse (IState levs doOpen posn) [] parse (IState (Paren _:levs) doOpen posn) [] = parse (IState levs doOpen posn) [] parse (IState [] _ _) [] = [] maxPosn :: Posn maxPosn = Posn (-1) (-1) 0 -- HACK! here we have collusion between using (-1) here and the parsing of -- OnlineTrees, which relies on the position of the last token to stop -- the parsing. yi-0.12.6/src/library/Yi/Syntax/OnlineTree.hs0000644000000000000000000000272012717763531017126 0ustar0000000000000000{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} -- uniplate patterns {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Syntax.OnlineTree -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Module defining the 'Tree' used as part of many 'Mode's. module Yi.Syntax.OnlineTree (Tree(..), manyToks, tokAtOrBefore) where import Control.Applicative (Applicative ((<*>), pure), (<$>)) import Data.Foldable (Foldable) import Data.Traversable (Traversable) import Yi.IncrementalParse (P, Parser (Look), symbol) import Yi.Lexer.Alex (Tok) import Yi.Syntax.Tree (IsTree (emptyNode, uniplate), tokAtOrBefore) data Tree a = Bin (Tree a) (Tree a) | Leaf a | Tip deriving (Show, Functor, Foldable, Traversable) instance IsTree Tree where emptyNode = Tip uniplate (Bin l r) = ([l,r],\[l',r'] -> Bin l' r') uniplate t = ([],const t) manyToks :: P (Tok t) (Tree (Tok t)) manyToks = manyToks' 1 manyToks' :: Int -> P a (Tree a) manyToks' n = Look (pure Tip) (\_ -> Bin <$> subTree n <*> manyToks' (n * 2)) subTree :: Int -> P a (Tree a) subTree n = Look (pure Tip) . const $ case n of 0 -> pure Tip 1 -> Leaf <$> symbol (const True) _ -> let m = n `div` 2 in Bin <$> subTree m <*> subTree m yi-0.12.6/src/library/Yi/Syntax/Paren.hs0000644000000000000000000001554312717763531016136 0ustar0000000000000000{-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Syntax.Paren -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Parser for Haskell that only cares about parenthesis and layout. module Yi.Syntax.Paren where import Prelude hiding (elem) import Control.Applicative (Alternative ((<|>), many), Applicative ((*>), (<*), (<*>)), (<$>)) import Data.Foldable (Foldable (foldMap), elem, toList) import Data.Maybe (listToMaybe) import Data.Monoid (Endo (Endo, appEndo), Monoid (mappend), (<>)) import Data.Traversable (Traversable (sequenceA)) import Yi.IncrementalParse (P, Parser, eof, lookNext, recoverWith, symbol) import Yi.Lexer.Alex hiding (tokenToStyle) import Yi.Lexer.Haskell import Yi.Style (StyleName, errorStyle, hintStyle) import Yi.Syntax (Point, Scanner, Span) import Yi.Syntax.Layout (State, layoutHandler) import Yi.Syntax.Tree indentScanner :: Scanner (AlexState lexState) TT -> Scanner (Yi.Syntax.Layout.State Token lexState) TT indentScanner = layoutHandler startsLayout [(Special '(', Special ')'), (Special '[', Special ']'), (Special '{', Special '}')] ignoredToken (Special '<', Special '>', Special '.') isBrace -- HACK: We insert the Special '<', '>', '.', that don't occur in normal haskell -- parsing. isBrace :: TT -> Bool isBrace (Tok b _ _) = Special '{' == b ignoredToken :: TT -> Bool ignoredToken (Tok t _ _) = isComment t || t == CppDirective isNoise :: Token -> Bool isNoise (Special c) = c `elem` (";,`" :: String) isNoise _ = True type Expr t = [Tree t] data Tree t = Paren t (Expr t) t -- A parenthesized expression (maybe with [ ] ...) | Block ([Tree t]) -- A list of things separated by layout (as in do; etc.) | Atom t | Error t | Expr [Tree t] deriving (Show, Foldable, Functor) instance IsTree Tree where emptyNode = Expr [] uniplate (Paren l g r) = (g,\g' -> Paren l g' r) uniplate (Expr g) = (g,Expr) uniplate (Block s) = (s,Block) uniplate t = ([],const t) -- | Search the given list, and return the 1st tree after the given -- point on the given line. This is the tree that will be moved if -- something is inserted at the point. Precondition: point is in the -- given line. -- TODO: this should be optimized by just giving the point of the end -- of the line getIndentingSubtree :: Tree TT -> Point -> Int -> Maybe (Tree TT) getIndentingSubtree root offset line = listToMaybe [t | (t,posn) <- takeWhile ((<= line) . posnLine . snd) allSubTreesPosn, -- it's very important that we do a linear search -- here (takeWhile), so that the tree is evaluated -- lazily and therefore parsing it can be lazy. posnOfs posn > offset, posnLine posn == line] where allSubTreesPosn = [(t',posn) | t'@(Block _) <-filter (not . null . toList) (getAllSubTrees root), let (tok:_) = toList t', let posn = tokPosn tok] -- | Given a tree, return (first offset, number of lines). getSubtreeSpan :: Tree TT -> (Point, Int) getSubtreeSpan tree = (posnOfs first, lastLine - firstLine) where bounds@[first, _last] = fmap (tokPosn . assertJust) [getFirstElement tree, getLastElement tree] [firstLine, lastLine] = fmap posnLine bounds assertJust (Just x) = x assertJust _ = error "assertJust: Just expected" -- dropWhile' f = foldMap (\x -> if f x then mempty else Endo (x :)) -- -- isBefore l (Atom t) = isBefore' l t -- isBefore l (Error t) = isBefore l t -- isBefore l (Paren l g r) = isBefore l r -- isBefore l (Block s) = False -- -- isBefore' l (Tok {tokPosn = Posn {posnLn = l'}}) = parse :: P TT (Tree TT) parse = Expr <$> parse' tokT tokFromT parse' :: (TT -> Token) -> (Token -> TT) -> P TT [Tree TT] parse' toTok _ = pExpr <* eof where -- parse a special symbol sym c = symbol (isSpecial [c] . toTok) pleaseSym c = recoverWith errTok <|> sym c pExpr :: P TT (Expr TT) pExpr = many pTree pBlocks = (Expr <$> pExpr) `sepBy1` sym '.' -- the '.' is generated by the layout, see HACK above -- note that we can have empty statements, hence we use sepBy1. pTree :: P TT (Tree TT) pTree = (Paren <$> sym '(' <*> pExpr <*> pleaseSym ')') <|> (Paren <$> sym '[' <*> pExpr <*> pleaseSym ']') <|> (Paren <$> sym '{' <*> pExpr <*> pleaseSym '}') <|> (Block <$> (sym '<' *> pBlocks <* sym '>')) -- see HACK above <|> (Atom <$> symbol (isNoise . toTok)) <|> (Error <$> recoverWith (symbol (isSpecial "})]" . toTok))) -- note that, by construction, '<' and '>' will always be matched, so -- we don't try to recover errors with them. getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke] getStrokes point _begin _end t0 = -- trace (show t0) result where getStrokes' (Atom t) = one (ts t) getStrokes' (Error t) = one (modStroke errorStyle (ts t)) -- paint in red getStrokes' (Block s) = getStrokesL s getStrokes' (Expr g) = getStrokesL g getStrokes' (Paren l g r) | isErrorTok $ tokT r = one (modStroke errorStyle (ts l)) <> getStrokesL g -- left paren wasn't matched: paint it in red. -- note that testing this on the "Paren" node actually forces the parsing of the -- right paren, undermining online behaviour. | posnOfs (tokPosn l) == point || posnOfs (tokPosn r) == point - 1 = one (modStroke hintStyle (ts l)) <> getStrokesL g <> one (modStroke hintStyle (ts r)) | otherwise = one (ts l) <> getStrokesL g <> one (ts r) getStrokesL = foldMap getStrokes' ts = tokenToStroke result = appEndo (getStrokes' t0) [] one x = Endo (x :) tokenToStroke :: TT -> Stroke tokenToStroke = fmap tokenToStyle . tokToSpan modStroke :: StyleName -> Stroke -> Stroke modStroke f = fmap (f `mappend`) tokenToAnnot :: TT -> Maybe (Span String) tokenToAnnot = sequenceA . tokToSpan . fmap tokenToText -- | Create a special error token. (e.g. fill in where there is no correct token to parse) -- Note that the position of the token has to be correct for correct computation of -- node spans. errTok :: Parser (Tok t) (Tok Token) errTok = mkTok <$> curPos where curPos = tB <$> lookNext tB Nothing = maxBound tB (Just x) = tokBegin x mkTok p = Tok (Special '!') 0 (startPosn {posnOfs = p}) yi-0.12.6/src/library/Yi/Syntax/Tree.hs0000644000000000000000000004012712717763531015764 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- the CPP seems to confuse GHC; we have uniplate patterns {-# OPTIONS_GHC -fno-warn-unused-binds -fno-warn-incomplete-patterns #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Syntax.Tree -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- Generic syntax tree handling functions module Yi.Syntax.Tree (IsTree(..), toksAfter, allToks, tokAtOrBefore, toksInRegion, sepBy, sepBy1, getLastOffset, getFirstOffset, getFirstElement, getLastElement, getLastPath, getAllSubTrees, tokenBasedAnnots, tokenBasedStrokes, subtreeRegion, fromLeafToLeafAfter, fromNodeToFinal) where -- Some of this might be replaced by a generic package -- such as multirec, uniplace, emgm, ... import Prelude hiding (concatMap, error) import Control.Applicative (Alternative ((<|>), many), Applicative ((*>), (<*>), pure), (<$>)) import Control.Arrow (first) import Data.Foldable (Foldable (foldMap), concatMap, toList) import Data.List.NonEmpty (NonEmpty (..)) import qualified Data.List.NonEmpty as NE (reverse, toList, (<|)) import Data.Maybe (catMaybes, listToMaybe) import Data.Monoid (First (First, getFirst), Last (Last, getLast), (<>)) import Yi.Buffer.Basic (Point) import Yi.Debug (error, trace) import Yi.Lexer.Alex (Posn (Posn, posnLine, posnOfs), Tok (Tok, tokPosn), tokBegin, tokEnd) import Yi.Region (Region (regionEnd, regionStart), includedRegion, mkRegion) import Yi.String (showT) #ifdef TESTING import Test.QuickCheck import Test.QuickCheck.Property (unProperty) #endif -- Fundamental types type Path = [Int] type Node t = (Path, t) class Foldable tree => IsTree tree where -- | Direct subtrees of a tree subtrees :: tree t -> [tree t] subtrees = fst . uniplate uniplate :: tree t -> ([tree t], [tree t] -> tree t) emptyNode :: tree t toksAfter :: Foldable t1 => t -> t1 a -> [a] toksAfter _begin = allToks allToks :: Foldable t => t a -> [a] allToks = toList tokAtOrBefore :: Foldable t => Point -> t (Tok t1) -> Maybe (Tok t1) tokAtOrBefore p res = listToMaybe $ reverse $ toksInRegion (mkRegion 0 (p+1)) res toksInRegion :: Foldable t1 => Region -> t1 (Tok t) -> [Tok t] toksInRegion reg = takeWhile (\t -> tokBegin t <= regionEnd reg) . dropWhile (\t -> tokEnd t < regionStart reg) . toksAfter (regionStart reg) tokenBasedAnnots :: (Foldable t1) => (a1 -> Maybe a) -> t1 a1 -> t -> [a] tokenBasedAnnots tta t begin = catMaybes (tta <$> toksAfter begin t) tokenBasedStrokes :: (Foldable t3) => (a -> b) -> t3 a -> t -> t2 -> t1 -> [b] tokenBasedStrokes tts t _point begin _end = tts <$> toksAfter begin t -- | Prune the nodes before the given point. -- The path is used to know which nodes we can force or not. pruneNodesBefore :: IsTree tree => Point -> Path -> tree (Tok a) -> tree (Tok a) pruneNodesBefore _ [] t = t pruneNodesBefore p (x:xs) t = rebuild $ left' <> (pruneNodesBefore p xs c : rs) where (children,rebuild) = uniplate t (left,c:rs) = splitAt x children left' = fmap replaceEmpty left replaceEmpty s = if getLastOffset s < p then emptyNode else s -- | Given an approximate path to a leaf at the end of the region, -- return: (path to leaf at the end of the region,path from focused -- node to the leaf, small node encompassing the region) fromNodeToFinal :: IsTree tree => Region -> Node (tree (Tok a)) -> Node (tree (Tok a)) fromNodeToFinal r (xs,root) = trace ("r = " <> showT r) $ trace ("focused ~ " <> showT (subtreeRegion focused) ) $ trace ("pathFromFocusedToLeaf = " <> showT focusedToLeaf) $ trace ("pruned ~ " <> showT (subtreeRegion focused)) (xs', pruned) where n@(xs',_) = fromLeafToLeafAfter (regionEnd r) (xs,root) (_,(focusedToLeaf,focused)) = fromLeafAfterToFinal p0 n p0 = regionStart r pruned = pruneNodesBefore p0 focusedToLeaf focused -- | Return the first element that matches the predicate, or the last -- of the list if none matches. firstThat :: (a -> Bool) -> NonEmpty a -> a firstThat _ (x :| []) = x firstThat p (x :| [y]) = if p x then x else y firstThat p (x :| y : xs) = if p x then x else firstThat p (y :| xs) -- | Return the element before first element that violates the -- predicate, or the first of the list if that one violates the -- predicate. lastThat :: (a -> Bool) -> NonEmpty a -> a lastThat p (x :| xs) = if p x then work x xs else x where work x0 [] = x0 work x0 (y:ys) = if p y then work y ys else x0 -- | Given a path to a node, return a path+node which node that -- encompasses the given node + a point before it. fromLeafAfterToFinal :: IsTree tree => Point -> Node (tree (Tok a)) -> (Path, Node (tree (Tok a))) fromLeafAfterToFinal p n = -- trace ("reg = " <> showT (fmap (subtreeRegion . snd) nsPth)) $ firstThat (\(_,(_,s)) -> getFirstOffset s <= p) ns where ns = NE.reverse (nodesOnPath n) -- | Search the tree in pre-order starting at a given node, until -- finding a leaf which is at or after the given point. An effort is -- also made to return a leaf as close as possible to @p@. -- -- TODO: rename to fromLeafToLeafAt fromLeafToLeafAfter :: IsTree tree => Point -> Node (tree (Tok a)) -> Node (tree (Tok a)) fromLeafToLeafAfter p (xs, root) = trace "fromLeafToLeafAfter:" $ trace ("xs = " <> showT xs) $ trace ("xsValid = " <> showT xsValid) $ trace ("p = " <> showT p) $ trace ("leafBeforeP = " <> showT leafBeforeP) $ trace ("leaf ~ " <> showT (subtreeRegion leaf)) $ trace ("xs' = " <> showT xs') result where xs' = case candidateLeaves of [] -> [] c:cs -> fst $ firstOrLastThat (\(_,s) -> getFirstOffset s >= p) (c :| cs) candidateLeaves = allLeavesRelative relChild n (firstOrLastThat,relChild) = if leafBeforeP then (firstThat,afterChild) else (lastThat,beforeChild) (xsValid,leaf) = wkDown (xs,root) leafBeforeP = getFirstOffset leaf <= p n = (xsValid,root) result = (xs',root) allLeavesRelative :: IsTree tree => (Int -> [(Int, tree a)] -> [(Int, tree a)]) -> Node (tree a) -> [Node (tree a)] allLeavesRelative select = filter (not . nullSubtree . snd) . allLeavesRelative' select . NE.toList . NE.reverse . nodesAndChildIndex -- we remove empty subtrees because their region is [0,0]. -- | Takes a list of (node, index of already inspected child), and -- return all leaves in this node after the said child). allLeavesRelative' :: IsTree tree => (Int -> [(Int, tree a)] -> [(Int, tree a)]) -> [(Node (tree a), Int)] -> [Node (tree a)] allLeavesRelative' select l = [(xs <> xs', t') | ((xs,t),c) <- l , (xs',t') <- allLeavesRelativeChild select c t] -- | Given a root, return all the nodes encountered along it, their -- paths, and the index of the child which comes next. nodesAndChildIndex :: IsTree tree => Node (tree a) -> NonEmpty (Node (tree a), Int) nodesAndChildIndex ([],t) = return (([],t),negate 1) nodesAndChildIndex (x:xs, t) = case index x (subtrees t) of Just c' -> (([],t), x) NE.<| fmap (first $ first (x:)) (nodesAndChildIndex (xs,c')) Nothing -> return (([],t),negate 1) nodesOnPath :: IsTree tree => Node (tree a) -> NonEmpty (Path, Node (tree a)) nodesOnPath ([],t) = return ([],([],t)) nodesOnPath (x:xs,t) = ([],(x:xs,t)) NE.<| case index x (subtrees t) of Nothing -> error "nodesOnPath: non-existent path" Just c -> fmap (first (x:)) (nodesOnPath (xs,c)) beforeChild :: Int -> [a] -> [a] beforeChild (-1) = reverse -- (-1) indicates that all children should be taken. beforeChild c = reverse . take (c-1) afterChild :: Int -> [a] -> [a] afterChild c = drop (c+1) -- | Return all leaves after or before child depending on the relation -- which is given. allLeavesRelativeChild :: IsTree tree => (Int -> [(Int, tree a)] -> [(Int, tree a)]) -> Int -> tree a -> [Node (tree a)] allLeavesRelativeChild select c t | null ts = return ([], t) | otherwise = [(x:xs,t') | (x,ct) <- select c (zip [0..] ts), (xs, t') <- allLeavesIn select ct] where ts = subtrees t -- | Return all leaves (with paths) inside a given root. allLeavesIn :: (IsTree tree) => (Int -> [(Int, tree a)] -> [(Int, tree a)]) -> tree a -> [Node (tree a)] allLeavesIn select = allLeavesRelativeChild select (-1) -- | Return all subtrees in a tree; each element of the return list -- contains paths to nodes. (Root is at the start of each path) getAllPaths :: IsTree tree => tree t -> [[tree t]] getAllPaths t = fmap (<>[t]) ([] : concatMap getAllPaths (subtrees t)) goDown :: IsTree tree => Int -> tree t -> Maybe (tree t) goDown i = index i . subtrees index :: Int -> [a] -> Maybe a index _ [] = Nothing index 0 (h:_) = Just h index n (_:t) = index (n-1) t walkDown :: IsTree tree => Node (tree t) -> Maybe (tree t) walkDown ([],t) = return t walkDown (x:xs,t) = goDown x t >>= curry walkDown xs wkDown :: IsTree tree => Node (tree a) -> Node (tree a) wkDown ([],t) = ([],t) wkDown (x:xs,t) = case goDown x t of Nothing -> ([],t) Just t' -> first (x:) $ wkDown (xs,t') -- | Search the given list, and return the last tree before the given -- point; with path to the root. (Root is at the start of the path) getLastPath :: IsTree tree => [tree (Tok t)] -> Point -> Maybe [tree (Tok t)] getLastPath roots offset = case takeWhile ((< offset) . posnOfs . snd) allSubPathPosn of [] -> Nothing xs -> Just $ fst $ last xs where allSubPathPosn = [ (p,posn) | root <- roots , p@(t':_) <- getAllPaths root , Just tok <- [getFirstElement t'] , let posn = tokPosn tok ] -- | Return all subtrees in a tree, in preorder. getAllSubTrees :: IsTree tree => tree t -> [tree t] getAllSubTrees t = t : concatMap getAllSubTrees (subtrees t) -- | Return the 1st token of a subtree. getFirstElement :: Foldable t => t a -> Maybe a getFirstElement tree = getFirst $ foldMap (First . Just) tree nullSubtree :: Foldable t => t a -> Bool nullSubtree = null . toList getFirstTok, getLastTok :: Foldable t => t a -> Maybe a getFirstTok = getFirstElement getLastTok = getLastElement -- | Return the last token of a subtree. getLastElement :: Foldable t => t a -> Maybe a getLastElement tree = getLast $ foldMap (Last . Just) tree getFirstOffset, getLastOffset :: Foldable t => t (Tok t1) -> Point getFirstOffset = maybe 0 tokBegin . getFirstTok getLastOffset = maybe 0 tokEnd . getLastTok subtreeRegion :: Foldable t => t (Tok t1) -> Region subtreeRegion t = mkRegion (getFirstOffset t) (getLastOffset t) -- | Given a tree, return (first offset, number of lines). getSubtreeSpan :: (Foldable tree) => tree (Tok t) -> (Point, Int) getSubtreeSpan tree = (posnOfs firstOff, lastLine - firstLine) where bounds@[firstOff, _last] = fmap (tokPosn . assertJust) [getFirstElement tree, getLastElement tree] [firstLine, lastLine] = fmap posnLine bounds assertJust (Just x) = x assertJust _ = error "assertJust: Just expected" ------------------------------------- -- Should be in Control.Applicative.? sepBy :: (Alternative f) => f a -> f v -> f [a] sepBy p s = sepBy1 p s <|> pure [] sepBy1 :: (Alternative f) => f a -> f v -> f [a] sepBy1 p s = (:) <$> p <*> many (s *> p) ---------------------------------------------------- -- Testing code. #ifdef TESTING nodeRegion :: IsTree tree => Node (tree (Tok a)) -> Region nodeRegion n = subtreeRegion t where Just t = walkDown n data Test a = Empty | Leaf a | Bin (Test a) (Test a) deriving (Show, Eq, Foldable) instance IsTree Test where uniplate (Bin l r) = ([l,r],\[l',r'] -> Bin l' r') uniplate t = ([],\[] -> t) emptyNode = Empty type TT = Tok () instance Arbitrary (Test TT) where arbitrary = sized $ \size -> do arbitraryFromList [1..size+1] shrink (Leaf _) = [] shrink (Bin l r) = [l,r] <> (Bin <$> shrink l <*> pure r) <> (Bin <$> pure l <*> shrink r) tAt :: Point -> TT tAt idx = Tok () 1 (Posn (idx * 2) 0 0) arbitraryFromList :: [Int] -> Gen (Test TT) arbitraryFromList [] = error "arbitraryFromList expects non empty lists" arbitraryFromList [x] = pure (Leaf (tAt (fromIntegral x))) arbitraryFromList xs = do m <- choose (1,length xs - 1) let (l,r) = splitAt m xs Bin <$> arbitraryFromList l <*> arbitraryFromList r newtype NTTT = N (Node (Test TT)) deriving Show instance Arbitrary NTTT where arbitrary = do t <- arbitrary p <- arbitraryPath t return $ N (p,t) arbitraryPath :: Test t -> Gen Path arbitraryPath (Leaf _) = return [] arbitraryPath (Bin l r) = do c <- choose (0,1) let Just n' = index c [l,r] (c :) <$> arbitraryPath n' regionInside :: Region -> Gen Region regionInside r = do b :: Int <- choose (fromIntegral $ regionStart r, fromIntegral $ regionEnd r) e :: Int <- choose (b, fromIntegral $ regionEnd r) return $ mkRegion (fromIntegral b) (fromIntegral e) pointInside :: Region -> Gen Point pointInside r = do p :: Int <- choose (fromIntegral $ regionStart r, fromIntegral $ regionEnd r) return (fromIntegral p) prop_fromLeafAfterToFinal :: NTTT -> Property prop_fromLeafAfterToFinal (N n) = let fullRegion = subtreeRegion $ snd n in forAll (pointInside fullRegion) $ \p -> do let final@(_, (_, finalSubtree)) = fromLeafAfterToFinal p n finalRegion = subtreeRegion finalSubtree initialRegion = nodeRegion n whenFail (do putStrLn $ "final = " <> show final putStrLn $ "final reg = " <> show finalRegion putStrLn $ "initialReg = " <> show initialRegion putStrLn $ "p = " <> show p ) ((regionStart finalRegion <= p) && (initialRegion `includedRegion` finalRegion)) prop_allLeavesAfter :: NTTT -> Property prop_allLeavesAfter (N n@(xs,t)) = property $ do let after = allLeavesRelative afterChild n (xs',t') <- elements after let t'' = walkDown (xs',t) unProperty $ whenFail (do putStrLn $ "t' = " <> show t' putStrLn $ "t'' = " <> show t'' putStrLn $ "xs' = " <> show xs' ) (Just t' == t'' && xs <= xs') prop_allLeavesBefore :: NTTT -> Property prop_allLeavesBefore (N n@(xs,t)) = property $ do let after = allLeavesRelative beforeChild n (xs',t') <- elements after let t'' = walkDown (xs',t) unProperty $ whenFail (do putStrLn $ "t' = " <> show t' putStrLn $ "t'' = " <> show t'' putStrLn $ "xs' = " <> show xs' ) (Just t' == t'' && xs' <= xs) prop_fromNodeToLeafAfter :: NTTT -> Property prop_fromNodeToLeafAfter (N n) = forAll (pointInside (subtreeRegion $ snd n)) $ \p -> do let after = fromLeafToLeafAfter p n afterRegion = nodeRegion after whenFail (do putStrLn $ "after = " <> show after putStrLn $ "after reg = " <> show afterRegion ) (regionStart afterRegion >= p) prop_fromNodeToFinal :: NTTT -> Property prop_fromNodeToFinal (N t) = forAll (regionInside (subtreeRegion $ snd t)) $ \r -> do let final@(_, finalSubtree) = fromNodeToFinal r t finalRegion = subtreeRegion finalSubtree whenFail (do putStrLn $ "final = " <> show final putStrLn $ "final reg = " <> show finalRegion putStrLn $ "leaf after = " <> show (fromLeafToLeafAfter (regionEnd r) t) ) $ do r `includedRegion` finalRegion #endif yi-0.12.6/src/library/Yi/Syntax/Strokes/Haskell.hs0000644000000000000000000001462112717763531020102 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_GHC -fno-warn-incomplete-patterns #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Syntax.Strokes.Haskell -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Produces 'Stroke's from a tree of tokens, used by some of the -- Haskell modes. module Yi.Syntax.Strokes.Haskell (getStrokes, tokenToAnnot) where import Prelude hiding (any, error, exp) import Data.Foldable (Foldable (foldMap), any) import Data.Monoid (Endo (..), Monoid (mappend), (<>)) import Data.Traversable (Traversable (sequenceA)) import Yi.Debug (error, trace) import Yi.Lexer.Alex (Posn (posnOfs), Stroke, Tok (tokPosn, tokT), tokToSpan) import Yi.Lexer.Haskell import Yi.String (showT) import Yi.Style import Yi.Syntax (Point, Span) import Yi.Syntax.Haskell import Yi.Syntax.Tree (subtrees) -- TODO: (optimization) make sure we take in account the begin, so we -- don't return useless strokes getStrokes :: Point -> Point -> Point -> Tree TT -> [Stroke] getStrokes point begin _end t0 = trace (showT t0) result where result = appEndo (getStr tkDConst point begin _end t0) [] -- | Get strokes Module for module getStrokeMod :: Point -> Point -> Point -> PModuleDecl TT -> Endo [Stroke] getStrokeMod point begin _end tm@(PModuleDecl m na e w) = pKW tm m <> getStr tkImport point begin _end na <> getStrokes' e <> getStrokes' w where getStrokes' = getStr tkDConst point begin _end pKW b word | isErrN b = paintAtom errorStyle word | otherwise = getStrokes' word -- | Get strokes for Imports getStrokeImp :: Point -> Point -> Point -> PImport TT -> Endo [Stroke] getStrokeImp point begin _end imp@(PImport m qu na t t') = pKW imp m <> paintQu qu <> getStr tkImport point begin _end na <> paintAs t <> paintHi t' where getStrokes' = getStr tkDConst point begin _end paintAs (Opt (Just (Bin (PAtom n c) tw))) = one ((fmap (const keywordStyle) . tokToSpan) n) <> com c <> getStr tkImport point begin _end tw paintAs a = getStrokes' a paintQu (Opt (Just (PAtom n c))) = one ((fmap (const keywordStyle) . tokToSpan) n) <> com c paintQu a = getStrokes' a paintHi (TC (Bin (Bin (PAtom n c) tw) r)) = one ((fmap (const keywordStyle) . tokToSpan) n) <> com c <> getStr tkImport point begin _end tw <> getStrokes' r paintHi a = getStrokes' a pKW b word | isErrN b = paintAtom errorStyle word | otherwise = getStrokes' word -- | Get strokes for expressions and declarations getStr :: (TT -> Endo [Stroke]) -> Point -> Point -> Point -> Exp TT -> Endo [Stroke] getStr tk point begin _end = getStrokes' where getStrokes' :: Exp TT -> Endo [Stroke] getStrokes' t@(PImport {}) = getStrokeImp point begin _end t getStrokes' t@(PModuleDecl {}) = getStrokeMod point begin _end t getStrokes' (PModule c m) = com c <> foldMap getStrokes' m getStrokes' (PAtom t c) = tk t <> com c getStrokes' (TS col ts') = tk col <> foldMap (getStr tkTConst point begin _end) ts' getStrokes' (Modid t c) = tkImport t <> com c getStrokes' (Paren (PAtom l c) g (PAtom r c')) | isErr r = errStyle l <> getStrokesL g -- left paren wasn't matched: paint it in red. -- note that testing this on the "Paren" node actually forces the parsing of the -- right paren, undermining online behaviour. | posnOfs (tokPosn l) == point || posnOfs (tokPosn r) == point - 1 = pStyle hintStyle l <> com c <> getStrokesL g <> pStyle hintStyle r <> com c' | otherwise = tk l <> com c <> getStrokesL g <> tk r <> com c' getStrokes' (PError t _ c) = errStyle t <> com c getStrokes' da@(PData kw na exp eq) = pKW da kw <> getStrokes' na <> getStrokes' exp <> getStrokes' eq getStrokes' (PIn t l) = tk t <> getStrokesL l getStrokes' (TC l) = getStr tkTConst point begin _end l getStrokes' (DC (PAtom l c)) = tkDConst l <> com c getStrokes' (DC r) = getStrokes' r -- do not color operator dc getStrokes' g@(PGuard' t e t') = pKW g t <> getStrokes' e <> getStrokes' t' getStrokes' cl@(PClass e e' exp) = pKW cl e <> getStrokes' e' <> getStrokes' exp getStrokes' t = foldMap getStrokes' (subtrees t) -- by default deal with subtrees getStrokesL = foldMap getStrokes' pKW b word | isErrN b = paintAtom errorStyle word | otherwise = getStrokes' word -- Stroke helpers follows tokenToAnnot :: TT -> Maybe (Span String) tokenToAnnot = sequenceA . tokToSpan . fmap tokenToText ts :: TT -> Stroke ts = tokenToStroke pStyle :: StyleName -> TT -> Endo [Stroke] pStyle style = one . modStroke style . ts one :: Stroke -> Endo [Stroke] one x = Endo (x :) paintAtom :: StyleName -> Exp TT -> Endo [Stroke] paintAtom col (PAtom a c) = pStyle col a <> com c paintAtom _ _ = error "wrong usage of paintAtom" isErr :: TT -> Bool isErr = isErrorTok . tokT isErrN :: (Foldable v) => v TT -> Bool isErrN = any isErr -- -- || not $ null $ isError' t errStyle :: TT -> Endo [Stroke] errStyle = pStyle errorStyle tokenToStroke :: TT -> Stroke tokenToStroke = fmap tokenToStyle . tokToSpan modStroke :: StyleName -> Stroke -> Stroke modStroke f = fmap (f `mappend`) com :: [TT] -> Endo [Stroke] com = foldMap tkDConst tk' :: (TT -> Bool) -> (TT -> Endo [Stroke]) -> TT -> Endo [Stroke] tk' f s t | isErr t = errStyle t | tokT t `elem` fmap Reserved [As, Qualified, Hiding] = one $ (fmap (const variableStyle) . tokToSpan) t | f t = s t | otherwise = one (ts t) tkTConst :: TT -> Endo [Stroke] tkTConst = tk' (const False) (const (Endo id)) tkDConst :: TT -> Endo [Stroke] tkDConst = tk' ((== ConsIdent) . tokT) (pStyle dataConstructorStyle) tkImport :: TT -> Endo [Stroke] tkImport = tk' ((== ConsIdent) . tokT) (pStyle importStyle) yi-0.12.6/src/library/Yi/Tab.hs0000644000000000000000000001014712717763531014304 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Rank2Types #-} module Yi.Tab ( Tab, TabRef, tabWindowsA, tabLayoutManagerA, tabDividerPositionA, tkey, tabMiniWindows, tabFocus, forceTab, mapWindows, tabLayout, tabFoldl, makeTab, makeTab1, ) where import Prelude hiding (foldl, foldr) import Control.Applicative ((<$>), (<*>)) import Control.Lens (Lens', lens, over, (^.)) import qualified Data.Binary as Binary (Binary, get, put) import Data.Default (def) import Data.Foldable (foldl, foldr, toList) import qualified Data.List.PointedList as PL (PointedList, singleton, _focus) import Data.Typeable (Typeable) import Yi.Buffer.Basic (WindowRef) import Yi.Layout import Yi.Window (Window, isMini, wkey) type TabRef = Int -- | A tab, containing a collection of windows. data Tab = Tab { tkey :: !TabRef, -- ^ For UI sync; fixes #304 tabWindows :: !(PL.PointedList Window), -- ^ Visible windows tabLayout :: !(Layout WindowRef), -- ^ Current layout. Invariant: must be the layout generated by 'tabLayoutManager', up to changing the 'divPos's. tabLayoutManager :: !AnyLayoutManager -- ^ layout manager (for regenerating the layout when we add/remove windows) } deriving Typeable tabFocus :: Tab -> Window tabFocus = PL._focus . tabWindows -- | Returns a list of all mini windows associated with the given tab tabMiniWindows :: Tab -> [Window] tabMiniWindows = Prelude.filter isMini . toList . tabWindows -- | Accessor for the windows. If the windows (but not the focus) have changed when setting, then a relayout will be triggered to preserve the internal invariant. tabWindowsA :: Functor f => (PL.PointedList Window -> f (PL.PointedList Window)) -> Tab -> f Tab tabWindowsA f s = (`setter` s) <$> f (getter s) where setter ws t = relayoutIf (toList ws /= toList (tabWindows t)) (t { tabWindows = ws}) getter = tabWindows -- | Accessor for the layout manager. When setting, will trigger a relayout if the layout manager has changed. tabLayoutManagerA :: Functor f => (AnyLayoutManager -> f AnyLayoutManager) -> Tab -> f Tab tabLayoutManagerA f s = (`setter` s) <$> f (getter s) where setter lm t = relayoutIf (lm /= tabLayoutManager t) (t { tabLayoutManager = lm }) getter = tabLayoutManager -- | Gets / sets the position of the divider with the given reference. The caller must ensure that the DividerRef is valid, otherwise an error will (might!) occur. tabDividerPositionA :: DividerRef -> Lens' Tab DividerPosition tabDividerPositionA ref = lens tabLayout (\ t l -> t{tabLayout = l}) . dividerPositionA ref relayoutIf :: Bool -> Tab -> Tab relayoutIf False t = t relayoutIf True t = relayout t relayout :: Tab -> Tab relayout t = t { tabLayout = buildLayout (tabWindows t) (tabLayoutManager t) (tabLayout t) } instance Binary.Binary Tab where put (Tab tk ws _ _) = Binary.put tk >> Binary.put ws get = makeTab <$> Binary.get <*> Binary.get -- | Equality on tab identity (the 'tkey') instance Eq Tab where (==) t1 t2 = tkey t1 == tkey t2 instance Show Tab where show t = "Tab " ++ show (tkey t) -- | A specialised version of "fmap". mapWindows :: (Window -> Window) -> Tab -> Tab mapWindows f = over tabWindowsA (fmap f) -- | Forces all windows in the tab forceTab :: Tab -> Tab forceTab t = foldr seq t (t ^. tabWindowsA) -- | Folds over the windows in the tab tabFoldl :: (a -> Window -> a) -> a -> Tab -> a tabFoldl f z t = foldl f z (t ^. tabWindowsA) -- | Run the layout on the given tab, for the given aspect ratio buildLayout :: PL.PointedList Window -> AnyLayoutManager -> Layout WindowRef -> Layout WindowRef buildLayout ws m l = pureLayout m l . fmap wkey . Prelude.filter (not . isMini) . toList $ ws -- | Make a tab from multiple windows makeTab :: TabRef -> PL.PointedList Window -> Tab makeTab key ws = Tab key ws (buildLayout ws def def) def -- | Make a tab from one window makeTab1 :: TabRef -> Window -> Tab makeTab1 key win = makeTab key (PL.singleton win) yi-0.12.6/src/library/Yi/Tag.hs0000644000000000000000000001303312717763531014306 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Tag -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- A module for CTags integration. Note that this reads the ‘tags’ -- file produced by @hasktags@, not the ‘TAGS’ file which uses a -- different format (etags). module Yi.Tag ( lookupTag , importTagTable , hintTags , completeTag , Tag(..) , unTag' , TagTable(..) , getTags , setTags , resetTags , tagsFileList ) where import GHC.Generics (Generic) import Control.Applicative ((<$>)) import Control.Lens (makeLenses) import Data.Binary (Binary, get, put) import qualified Data.ByteString as BS (readFile) import Data.Default (Default, def) import qualified Data.Foldable as F (concat) import Data.Map (Map, fromListWith, keys, lookup) import Data.Maybe (mapMaybe) import qualified Data.Text as T (Text, append, isPrefixOf, lines, pack, unpack, words) import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8) import qualified Data.Text.Read as R (decimal) import qualified Data.Trie as Trie (Trie, certainSuffix, fromList, possibleSuffixes) import Data.Typeable (Typeable) import System.FilePath (takeDirectory, takeFileName, ()) import System.FriendlyPath (expandTilda) import Yi.Config.Simple.Types (Field, customVariable) import Yi.Editor (EditorM, getEditorDyn, putEditorDyn) import Yi.Types (YiConfigVariable, YiVariable) newtype TagsFileList = TagsFileList { _unTagsFileList :: [FilePath] } deriving (Typeable, Generic) instance Default TagsFileList where def = TagsFileList ["tags"] instance YiConfigVariable TagsFileList makeLenses ''TagsFileList tagsFileList :: Field [FilePath] tagsFileList = customVariable . unTagsFileList newtype Tags = Tags (Maybe TagTable) deriving (Typeable, Generic) instance Default Tags where def = Tags Nothing instance YiVariable Tags newtype Tag = Tag { _unTag :: T.Text } deriving (Show, Eq, Ord) unTag' :: Tag -> T.Text unTag' = _unTag instance Binary Tag where put (Tag t) = put (E.encodeUtf8 t) get = Tag . E.decodeUtf8 <$> get data TagTable = TagTable { tagFileName :: FilePath -- ^ local name of the tag file -- TODO: reload if this file is changed , tagBaseDir :: FilePath -- ^ path to the tag file directory -- tags are relative to this path , tagFileMap :: Map Tag [(FilePath, Int)] -- ^ map from tags to files , tagTrie :: Trie.Trie -- ^ trie to speed up tag hinting } deriving (Typeable, Generic) -- | Find the location of a tag using the tag table. -- Returns a full path and line number lookupTag :: Tag -> TagTable -> [(FilePath, Int)] lookupTag tag tagTable = do (file, line) <- F.concat . Data.Map.lookup tag $ tagFileMap tagTable return (tagBaseDir tagTable file, line) -- | Super simple parsing CTag format 1 parsing algorithm -- TODO: support search patterns in addition to lineno readCTags :: T.Text -> Map Tag [(FilePath, Int)] readCTags = fromListWith (++) . mapMaybe (parseTagLine . T.words) . T.lines where parseTagLine (tag:tagfile:lineno:_) = -- remove ctag control lines if "!_TAG_" `T.isPrefixOf` tag then Nothing else Just (Tag tag, [(T.unpack tagfile, getLineNumber lineno)]) where getLineNumber = (\(Right x) -> x) . fmap fst . R.decimal parseTagLine _ = Nothing -- | Read in a tag file from the system importTagTable :: FilePath -> IO TagTable importTagTable filename = do friendlyName <- expandTilda filename tagStr <- E.decodeUtf8 <$> BS.readFile friendlyName let cts = readCTags tagStr return TagTable { tagFileName = takeFileName filename , tagBaseDir = takeDirectory filename , tagFileMap = cts -- TODO either change word-trie to use Text or -- figure out a better way all together for this , tagTrie = Trie.fromList . map (T.unpack . _unTag) $ keys cts } -- | Gives all the possible expanded tags that could match a given @prefix@ hintTags :: TagTable -> T.Text -> [T.Text] hintTags tags prefix = map (T.append prefix . T.pack) sufs where sufs = Trie.possibleSuffixes (T.unpack prefix) $ tagTrie tags -- | Extends the string to the longest certain length completeTag :: TagTable -> T.Text -> T.Text completeTag tags prefix = prefix `T.append` T.pack (Trie.certainSuffix (T.unpack prefix) (tagTrie tags)) -- --------------------------------------------------------------------- -- Direct access interface to TagTable. -- | Set a new TagTable setTags :: TagTable -> EditorM () setTags = putEditorDyn . Tags . Just -- | Reset the TagTable resetTags :: EditorM () resetTags = putEditorDyn $ Tags Nothing -- | Get the currently registered tag table getTags :: EditorM (Maybe TagTable) getTags = do Tags t <- getEditorDyn return t instance Binary Tags instance Binary TagTable instance Binary TagsFileListyi-0.12.6/src/library/Yi/TextCompletion.hs0000644000000000000000000001747612717763531016570 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.TextCompletion -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Module providing text completion functions. module Yi.TextCompletion ( -- * Word completion wordComplete, wordComplete', wordCompleteString, wordCompleteString', mkWordComplete, resetComplete, completeWordB, CompletionScope(..) ) where import Control.Applicative ((<$>)) import Control.Monad (forM) import Data.Binary (Binary, get, put) import Data.Char (GeneralCategory (..), generalCategory) import Data.Default (Default, def) import Data.Function (on) import Data.List (findIndex) import Data.List.NonEmpty (NonEmpty (..)) import Data.Maybe (isJust) import qualified Data.Text as T (Text, drop, groupBy, head, isPrefixOf, length, null) import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8) import Data.Typeable (Typeable) import Yi.Buffer import Yi.Completion (completeInList, mkIsPrefixOf) import Yi.Editor import Yi.Keymap (YiM) import qualified Yi.Rope as R (fromText, toText) import Yi.Types (YiVariable) import Yi.Utils (nubSet) -- --------------------------------------------------------------------- -- | Word completion -- -- when doing keyword completion, we need to keep track of the word -- we're trying to complete. newtype Completion = Completion [T.Text] -- the list of all possible things we can complete to. -- (this seems very inefficient; but we use laziness to -- our advantage) deriving (Typeable, Show, Eq) instance Binary Completion where put (Completion ts) = put (E.encodeUtf8 <$> ts) get = Completion . map E.decodeUtf8 <$> get -- TODO: put this in keymap state instead instance Default Completion where def = Completion [] instance YiVariable Completion -- | Switch out of completion mode. resetComplete :: EditorM () resetComplete = putEditorDyn (Completion []) -- | Try to complete the current word with occurences found elsewhere in the -- editor. Further calls try other options. mkWordComplete :: YiM T.Text -- ^ Extract function -> (T.Text -> YiM [T.Text]) -- ^ Source function -> ([T.Text] -> YiM ()) -- ^ Message function -> (T.Text -> T.Text -> Bool) -- ^ Predicate matcher -> YiM T.Text mkWordComplete extractFn sourceFn msgFn predMatch = do Completion complList <- withEditor getEditorDyn case complList of (x:xs) -> do -- more alternatives, use them. msgFn (x:xs) withEditor . putEditorDyn $ Completion xs return x [] -> do -- no alternatives, build them. w <- extractFn ws <- sourceFn w let comps = nubSet (filter (matches w) ws) ++ [w] putEditorDyn $ Completion comps -- We put 'w' back at the end so we go back to it after seeing -- all possibilities. -- to pick the 1st possibility. mkWordComplete extractFn sourceFn msgFn predMatch where matches x y = x `predMatch` y && x/=y wordCompleteString' :: Bool -> YiM T.Text wordCompleteString' caseSensitive = mkWordComplete (withCurrentBuffer $ textRegion =<< regionOfPartB unitWord Backward) (\_ -> withEditor wordsForCompletion) (\_ -> return ()) (mkIsPrefixOf caseSensitive) where textRegion = fmap R.toText . readRegionB wordCompleteString :: YiM T.Text wordCompleteString = wordCompleteString' True wordComplete' :: Bool -> YiM () wordComplete' caseSensitive = do x <- R.fromText <$> wordCompleteString' caseSensitive withEditor $ withCurrentBuffer $ flip replaceRegionB x =<< regionOfPartB unitWord Backward wordComplete :: YiM () wordComplete = wordComplete' True ---------------------------- -- Alternative Word Completion {- 'completeWordB' is an alternative to 'wordCompleteB'. 'completeWordB' offers a slightly different interface. The user completes the word using the mini-buffer in the same way a user completes a buffer or file name when switching buffers or opening a file. This means that it never guesses and completes only as much as it can without guessing. I think there is room for both approaches. The 'wordCompleteB' approach which just guesses the completion from a list of possible completion and then re-hitting the key-binding will cause it to guess again. I think this is very nice for things such as completing a word within a TeX-buffer. However using the mini-buffer might be nicer when we allow syntax knowledge to allow completion for example we may complete from a Hoogle database. -} completeWordB :: CompletionScope -> EditorM () completeWordB = veryQuickCompleteWord data CompletionScope = FromCurrentBuffer | FromAllBuffers deriving (Eq, Show) {- This is a very quick and dirty way to complete the current word. It works in a similar way to the completion of words in the mini-buffer it uses the message buffer to give simple feedback such as, "Matches:" and "Complete, but not unique:" It is by no means perfect but it's also not bad, pretty usable. -} veryQuickCompleteWord :: CompletionScope -> EditorM () veryQuickCompleteWord scope = do (curWord, curWords) <- withCurrentBuffer wordsAndCurrentWord allWords <- fmap concat $ withEveryBuffer $ words' <$> (R.toText <$> elemsB) let match :: T.Text -> Maybe T.Text match x = if (curWord `T.isPrefixOf` x) && (x /= curWord) then Just x else Nothing wordsToChooseFrom = if scope == FromCurrentBuffer then curWords else allWords preText <- completeInList curWord match wordsToChooseFrom if T.null curWord then printMsg "No word to complete" else withCurrentBuffer . insertN . R.fromText $ T.drop (T.length curWord) preText wordsAndCurrentWord :: BufferM (T.Text, [T.Text]) wordsAndCurrentWord = do curText <- R.toText <$> elemsB curWord <- fmap R.toText $ readRegionB =<< regionOfPartB unitWord Backward return (curWord, words' curText) wordsForCompletionInBuffer :: BufferM [T.Text] wordsForCompletionInBuffer = do let readTextRegion = fmap R.toText . readRegionB above <- readTextRegion =<< regionOfPartB Document Backward below <- readTextRegion =<< regionOfPartB Document Forward return $ reverse (words' above) ++ words' below wordsForCompletion :: EditorM [T.Text] wordsForCompletion = do _ :| bs <- fmap bkey <$> getBufferStack w0 <- withCurrentBuffer wordsForCompletionInBuffer contents <- forM bs $ \b -> withGivenBuffer b (R.toText <$> elemsB) return $ w0 ++ concatMap words' contents words' :: T.Text -> [T.Text] words' = filter (isJust . charClass . T.head) . T.groupBy ((==) `on` charClass) charClass :: Char -> Maybe Int charClass c = findIndex (generalCategory c `elem`) [ [ UppercaseLetter, LowercaseLetter, TitlecaseLetter , ModifierLetter, OtherLetter , ConnectorPunctuation , NonSpacingMark, SpacingCombiningMark, EnclosingMark , DecimalNumber, LetterNumber, OtherNumber ] , [ MathSymbol, CurrencySymbol, ModifierSymbol, OtherSymbol ] ] {- Finally obviously we wish to have a much more sophisticated completeword. One which spawns a mini-buffer and allows searching in Hoogle databases or in other files etc. -} yi-0.12.6/src/library/Yi/Types.hs0000644000000000000000000004577612717763531014722 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFoldable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE ScopedTypeVariables #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Types -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module is the host of the most prevalent types throughout Yi. -- It is unfortunately a necessary evil to avoid use of bootfiles. -- -- You're encouraged to import from more idiomatic modules which will -- re-export these where appropriate. module Yi.Types where #ifdef FRONTEND_VTY import qualified Graphics.Vty as Vty (Config) #endif import Control.Applicative (Applicative, pure, (<$>), (<*>)) import Control.Concurrent (MVar, modifyMVar, modifyMVar_, readMVar) import Control.Monad.Base (MonadBase, liftBase) import Control.Monad.Reader (MonadReader, ReaderT, ask, asks, runReaderT) import Control.Monad.RWS.Strict (MonadWriter, RWS, ap, liftM3, void) import Control.Monad.State (MonadState (..), State, forever, runState) import Data.Binary (Binary) import qualified Data.Binary as B (get, put) import Data.Default (Default, def) import qualified Data.DelayList as DelayList (DelayList) import qualified Data.DynamicState as ConfigState (DynamicState) import qualified Data.DynamicState.Serializable as DynamicState (DynamicState) import Data.Foldable (Foldable) import Data.Function (on) import Data.List.NonEmpty (NonEmpty) import Data.List.PointedList (PointedList) import qualified Data.Map as M (Map) import qualified Data.Text as T (Text) import qualified Data.Text.Encoding as E (decodeUtf8, encodeUtf8) import Data.Time (UTCTime (..)) import Data.Traversable (Traversable) import Data.Typeable (Typeable) import Data.Word (Word8) import Yi.Buffer.Basic (BufferRef, WindowRef) import Yi.Buffer.Implementation import Yi.Buffer.Undo (URList) import Yi.Config.Misc (ScrollStyle) import Yi.Event (Event) import qualified Yi.Interact as I (I, P (End)) import Yi.KillRing (Killring) import Yi.Layout (AnyLayoutManager) import Yi.Monad (getsAndModify) import Yi.Process (SubprocessId, SubprocessInfo) import qualified Yi.Rope as R (ConverterName, YiString) import Yi.Style (StyleName) import Yi.Style.Library (Theme) import Yi.Syntax (ExtHL, Stroke) import Yi.Tab (Tab) import Yi.UI.Common (UI) import Yi.Window (Window) -- Yi.Keymap -- TODO: refactor this! data Action = forall a. Show a => YiA (YiM a) | forall a. Show a => EditorA (EditorM a) | forall a. Show a => BufferA (BufferM a) deriving Typeable emptyAction :: Action emptyAction = BufferA (return ()) class (Default a, Binary a, Typeable a) => YiVariable a class (Default a, Typeable a) => YiConfigVariable a instance Eq Action where _ == _ = False instance Show Action where show (YiA _) = "@Y" show (EditorA _) = "@E" show (BufferA _) = "@B" type Interact ev a = I.I ev Action a type KeymapM a = Interact Event a type Keymap = KeymapM () type KeymapEndo = Keymap -> Keymap type KeymapProcess = I.P Event Action data IsRefreshNeeded = MustRefresh | NoNeedToRefresh deriving (Show, Eq) data Yi = Yi { yiUi :: UI Editor , yiInput :: [Event] -> IO () -- ^ input stream , yiOutput :: IsRefreshNeeded -> [Action] -> IO () -- ^ output stream , yiConfig :: Config -- TODO: this leads to anti-patterns and seems like one itself -- too coarse for actual concurrency, otherwise pointless -- And MVars can be empty so this causes soundness problems -- Also makes code a bit opaque , yiVar :: MVar YiVar -- ^ The only mutable state in the program } deriving Typeable data YiVar = YiVar { yiEditor :: !Editor , yiSubprocessIdSupply :: !SubprocessId , yiSubprocesses :: !(M.Map SubprocessId SubprocessInfo) } -- | The type of user-bindable functions -- TODO: doc how these are actually user-bindable -- are they? newtype YiM a = YiM {runYiM :: ReaderT Yi IO a} deriving (Monad, Applicative, MonadReader Yi, MonadBase IO, Typeable, Functor) instance MonadState Editor YiM where get = yiEditor <$> (liftBase . readMVar =<< yiVar <$> ask) put v = liftBase . flip modifyMVar_ (\x -> return $ x {yiEditor = v}) =<< yiVar <$> ask instance MonadEditor YiM where askCfg = yiConfig <$> ask withEditor f = do r <- asks yiVar cfg <- asks yiConfig liftBase $ unsafeWithEditor cfg r f unsafeWithEditor :: Config -> MVar YiVar -> EditorM a -> IO a unsafeWithEditor cfg r f = modifyMVar r $ \var -> do let e = yiEditor var let (e',a) = runEditor cfg f e -- Make sure that the result of runEditor is evaluated before -- replacing the editor state. Otherwise, we might replace e -- with an exception-producing thunk, which makes it impossible -- to look at or update the editor state. -- Maybe this could also be fixed by -fno-state-hack flag? -- TODO: can we simplify this? e' `seq` a `seq` return (var {yiEditor = e'}, a) data KeymapSet = KeymapSet { topKeymap :: Keymap -- ^ Content of the top-level loop. , insertKeymap :: Keymap -- ^ For insertion-only modes } extractTopKeymap :: KeymapSet -> Keymap extractTopKeymap kms = forever (topKeymap kms) -- Note the use of "forever": this has quite subtle implications, as it means that -- failures in one iteration can yield to jump to the next iteration seamlessly. -- eg. in emacs keybinding, failures in incremental search, like , will "exit" -- incremental search and immediately move to the left. -- Yi.Buffer.Misc -- | The BufferM monad writes the updates performed. newtype BufferM a = BufferM { fromBufferM :: RWS Window [Update] FBuffer a } deriving (Monad, Functor, MonadWriter [Update], MonadState FBuffer, MonadReader Window, Typeable) -- | Currently duplicates some of Vim's indent settings. Allowing a -- buffer to specify settings that are more dynamic, perhaps via -- closures, could be useful. 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 } deriving (Eq, Show, Typeable) instance Applicative BufferM where pure = return (<*>) = ap data FBuffer = forall syntax. FBuffer { bmode :: !(Mode syntax) , rawbuf :: !(BufferImpl syntax) , attributes :: !Yi.Types.Attributes } deriving Typeable instance Eq FBuffer where (==) = (==) `on` bkey__ . attributes type WinMarks = MarkSet Mark data MarkSet a = MarkSet { fromMark, insMark, selMark :: !a } deriving (Traversable, Foldable, Functor) instance Binary a => Binary (MarkSet a) where 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) , stickyEol :: !Bool -- ^ stick to the end of line (used by vim bindings mostly) , 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 put (Yi.Types.Attributes n b u bd pc pv se pu selectionStyle_ _proc wm law lst ro ins _dc _pfw isTransacPresent transacAccum fv cn) = do let putTime (UTCTime x y) = B.put (fromEnum x) >> B.put (fromEnum y) B.put n >> B.put b >> B.put u >> B.put bd B.put pc >> B.put pv >> B.put se >> B.put pu >> B.put selectionStyle_ >> B.put wm B.put law >> putTime lst >> B.put ro >> B.put ins >> B.put _dc B.put isTransacPresent >> B.put transacAccum >> B.put fv >> B.put cn get = Yi.Types.Attributes <$> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> B.get <*> pure I.End <*> B.get <*> B.get <*> getTime <*> B.get <*> B.get <*> B.get <*> pure (const False) <*> B.get <*> B.get <*> B.get <*> B.get where getTime = UTCTime <$> (toEnum <$> B.get) <*> (toEnum <$> B.get) data BufferId = MemBuffer T.Text | FileBuffer FilePath deriving (Show, Eq, Ord) instance Binary BufferId where get = B.get >>= \case (0 :: Word8) -> MemBuffer . E.decodeUtf8 <$> B.get 1 -> FileBuffer <$> B.get x -> fail $ "Binary failed on BufferId, tag: " ++ show x put (MemBuffer t) = B.put (0 :: Word8) >> B.put (E.encodeUtf8 t) put (FileBuffer t) = B.put (1 :: Word8) >> B.put t data SelectionStyle = SelectionStyle { highlightSelection :: !Bool , rectangleSelection :: !Bool } deriving Typeable instance Binary SelectionStyle where put (SelectionStyle h r) = B.put h >> B.put r get = SelectionStyle <$> B.get <*> B.get data AnyMode = forall syntax. AnyMode (Mode syntax) deriving Typeable -- | A Mode customizes the Yi interface for editing a particular data -- format. It specifies when the mode should be used and controls -- file-specific syntax highlighting and command input, among other -- things. data Mode syntax = Mode { modeName :: T.Text -- ^ so this can be serialized, debugged. , modeApplies :: FilePath -> R.YiString -> Bool -- ^ What type of files does this mode apply to? , modeHL :: ExtHL syntax -- ^ Syntax highlighter , modePrettify :: syntax -> BufferM () -- ^ Prettify current \"paragraph\" , modeKeymap :: KeymapSet -> KeymapSet -- ^ Buffer-local keymap modification , modeIndent :: syntax -> IndentBehaviour -> BufferM () -- ^ emacs-style auto-indent line , modeAdjustBlock :: syntax -> Int -> BufferM () -- ^ adjust the indentation after modification , modeFollow :: syntax -> Action -- ^ Follow a \"link\" in the file. (eg. go to location of error message) , modeIndentSettings :: IndentSettings , modeToggleCommentSelection :: Maybe (BufferM ()) , modeGetStrokes :: syntax -> Point -> Point -> Point -> [Stroke] -- ^ Strokes that should be applied when displaying a syntax element -- should this be an Action instead? , modeOnLoad :: BufferM () -- ^ An action that is to be executed when this mode is set , modeModeLine :: [T.Text] -> BufferM T.Text -- ^ buffer-local modeline formatting method , modeGotoDeclaration :: BufferM () -- ^ go to the point where the variable is declared } -- | Used to specify the behaviour of the automatic indent command. 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. | DecreaseCycle -- ^ Decrease the indentation to the next smaller indentation -- hint. If we are currently at the smallest level then -- cycle back to the largest | IncreaseOnly -- ^ Increase the indentation to the next higher hint -- if no such hint exists do nothing. | DecreaseOnly -- ^ Decrease the indentation to the next smaller indentation -- hint, if no such hint exists do nothing. deriving (Eq, Show) -- Yi.Editor type Status = ([T.Text], StyleName) type Statuses = DelayList.DelayList Status -- | The Editor state data Editor = Editor { bufferStack :: !(NonEmpty BufferRef) -- ^ Stack of all the buffers. -- Invariant: first buffer is the current one. , buffers :: !(M.Map BufferRef FBuffer) , refSupply :: !Int -- ^ Supply for buffer, window and tab ids. , tabs_ :: !(PointedList Tab) -- ^ current tab contains the visible windows pointed list. , dynamic :: !DynamicState.DynamicState -- ^ dynamic components , statusLines :: !Statuses , maxStatusHeight :: !Int , killring :: !Killring , currentRegex :: !(Maybe SearchExp) -- ^ currently highlighted regex (also most recent regex for use -- in vim bindings) , searchDirection :: !Direction , pendingEvents :: ![Event] -- ^ Processed events that didn't yield any action yet. , onCloseActions :: !(M.Map BufferRef (EditorM ())) -- ^ Actions to be run when the buffer is closed; should be scrapped. } deriving Typeable newtype EditorM a = EditorM {fromEditorM :: ReaderT Config (State Editor) a} deriving (Monad, Applicative, MonadState Editor, MonadReader Config, Functor, Typeable) instance MonadEditor EditorM where askCfg = ask withEditor = id class (Monad m, MonadState Editor m) => MonadEditor m where askCfg :: m Config withEditor :: EditorM a -> m a withEditor f = do cfg <- askCfg getsAndModify (runEditor cfg f) withEditor_ :: EditorM a -> m () withEditor_ = withEditor . void runEditor :: Config -> EditorM a -> Editor -> (Editor, a) runEditor cfg f e = let (a, e') = runState (runReaderT (fromEditorM f) cfg) e in (e',a) -- Yi.Config data UIConfig = UIConfig { #ifdef FRONTEND_VTY configVty :: Vty.Config, #endif configFontName :: Maybe String, -- ^ Font name, for the UI that support it. configFontSize :: Maybe Int, -- ^ Font size, for the UI that support it. configScrollStyle :: Maybe ScrollStyle, -- ^ Style of scroll configScrollWheelAmount :: Int, -- ^ Amount to move the buffer when using the scroll wheel configLeftSideScrollBar :: Bool, -- ^ Should the scrollbar be shown on the left side? configAutoHideScrollBar :: Bool, -- ^ Hide scrollbar automatically if text fits on one page. configAutoHideTabBar :: Bool, -- ^ Hide the tabbar automatically if only one tab is present configLineWrap :: Bool, -- ^ Wrap lines at the edge of the window if too long to display. configCursorStyle :: CursorStyle, configWindowFill :: Char, -- ^ The char with which to fill empty window space. Usually '~' for vi-like -- editors, ' ' for everything else. configTheme :: Theme -- ^ UI colours } type UIBoot = Config -> ([Event] -> IO ()) -> ([Action] -> IO ()) -> Editor -> IO (UI Editor) -- | When should we use a "fat" cursor (i.e. 2 pixels wide, rather than 1)? Fat -- cursors have only been implemented for the Pango frontend. data CursorStyle = AlwaysFat | NeverFat | FatWhenFocused | FatWhenFocusedAndInserting -- | Configuration record. All Yi hooks can be set here. data Config = Config {startFrontEnd :: UIBoot, -- ^ UI to use. configUI :: UIConfig, -- ^ UI-specific configuration. startActions :: [Action], -- ^ Actions to run when the editor is started. initialActions :: [Action], -- ^ Actions to run after startup (after startActions) or reload. defaultKm :: KeymapSet, -- ^ Default keymap to use. configInputPreprocess :: I.P Event Event, modeTable :: [AnyMode], -- ^ List modes by order of preference. debugMode :: Bool, -- ^ Produce a .yi.dbg file with a lot of debug information. configRegionStyle :: RegionStyle, -- ^ Set to 'Exclusive' for an emacs-like behaviour. configKillringAccumulate :: Bool, -- ^ Set to 'True' for an emacs-like behaviour, where -- all deleted text is accumulated in a killring. configCheckExternalChangesObsessively :: Bool, bufferUpdateHandler :: [[Update] -> BufferM ()], layoutManagers :: [AnyLayoutManager], -- ^ List of layout managers for 'cycleLayoutManagersNext' configVars :: ConfigState.DynamicState -- ^ Custom configuration, containing the 'YiConfigVariable's. Configure with 'configVariableA'. } -- Yi.Buffer.Normal -- Region styles are relative to the buffer contents. -- They likely should be considered a TextUnit. data RegionStyle = LineWise | Inclusive | Exclusive | Block deriving (Eq, Typeable, Show) instance Binary RegionStyle where put LineWise = B.put (0 :: Word8) put Inclusive = B.put (1 :: Word8) put Exclusive = B.put (2 :: Word8) put Block = B.put (3 :: Word8) get = B.get >>= \case (0 :: Word8) -> return LineWise 1 -> return Inclusive 2 -> return Exclusive 3 -> return Block n -> fail $ "Binary RegionStyle fail with " ++ show n -- TODO: put in the buffer state proper. instance Default RegionStyle where def = Inclusive instance YiVariable RegionStyle yi-0.12.6/src/library/Yi/UI/Common.hs0000644000000000000000000000614412533751517015342 0ustar0000000000000000{-# LANGUAGE Rank2Types #-} module Yi.UI.Common where {- | Record presenting a frontend's interface. The functions 'layout' and 'refresh' are both run by the editor's main loop, in response to user actions and so on. Their relation is a little subtle, and is discussed here: * to see some code, look at the function @refreshEditor@ in "Yi.Core". This is the only place where 'layout' and 'refresh' are used. * the function 'layout' is responsible for updating the 'Editor' with the width and height of the windows. Some frontends, such as Pango, need to modify their internal state to do this, and will consequently change their display. This is expected. * the function 'refresh' should cause the UI to update its display with the information given in the 'Editor'. * the functionalities of 'layout' and 'refresh' overlap to some extent, in the sense that both may cause the frontend to update its display. The Yi core provides the following guarantees which the frontend may take advantage of: * in the main editor loop (i.e. in the @refreshEditor@ function), 'layout' will be run (possibly multiple times) and then 'refresh' will be run. This guarantee will hold even in the case of threading (the function @refreshEditor@ will always be run atomically, using @MVar@s). * between the last run of 'layout' and the run of 'refresh', some changes may be made to the 'Editor'. However, the text, text attributes, and (displayed) window region of all windows will remain the same. However, the cursor location may change. This guarantee allows frontends which calculate rendering of the text during the 'layout' stage to avoid recalculating the render again during 'refresh'. Pango is an example of such a frontend. The Yi core provides no guarantee about the OS thread from which the functions 'layout' and 'refresh' are called from. In particular, subprocesses (e.g. compilation, ghci) will run 'layout' and 'refresh' from new OS threads (see @startSubprocessWatchers@ in "Yi.Core"). The frontend must be preparaed for this: for instance, Gtk-based frontends should wrap GUI updates in @postGUIAsync@. -} data UI e = UI { main :: IO () -- ^ Main loop , end :: Bool -> IO () -- ^ Clean up, and also terminate if given 'true' , suspend :: IO () -- ^ Suspend (or minimize) the program , refresh :: e -> IO () -- ^ Refresh the UI with the given state , userForceRefresh :: IO () -- ^ User force-refresh (in case the screen has been messed up from outside) , layout :: e -> IO e -- ^ Set window width and height , reloadProject :: FilePath -> IO () -- ^ Reload cabal project views } dummyUI :: UI e dummyUI = UI { main = return () , end = const (return ()) , suspend = return () , refresh = const (return ()) , userForceRefresh = return () , layout = return , reloadProject = const (return ()) } yi-0.12.6/src/library/Yi/UI/Batch.hs0000644000000000000000000000057012717763531015133 0ustar0000000000000000 module Yi.UI.Batch (start) where import Yi.Config (UIBoot) import Yi.UI.Common (dummyUI) -- | Initialise the ui start :: UIBoot start _cfg _ch _outCh _ed = do mapM_ putStrLn ["Starting 'batch' UI...", "Are you sure you compiled with support for any real UI?", "(for example, pass -fvty to cabal install)"] return dummyUI yi-0.12.6/src/library/Yi/UI/SimpleLayout.hs0000644000000000000000000001655612725740550016547 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ViewPatterns #-} module Yi.UI.SimpleLayout ( Rect (..) , Layout (..) , Point2D (..) , Size2D (..) , coordsOfCharacterB , layout , verticalOffsetsForWindows ) where import Prelude hiding (concatMap, mapM) import Control.Lens (use, (.~), (&), (^.), to, _1) import Control.Monad.State (evalState, get, put) import Data.Foldable (find, toList) import Data.List (partition) import qualified Data.List.PointedList.Circular as PL (PointedList, focus) import qualified Data.Map.Strict as M (Map, fromList) import Data.Maybe (fromMaybe) import Data.Monoid ((<>)) import qualified Data.Text as T (uncons) import Data.Traversable (mapM) import Yi.Buffer import Yi.Editor import qualified Yi.Rope as R (take, toString, toText) import Yi.UI.Utils (arrangeItems) import Yi.Window import Yi.Tab (tabLayout) import qualified Yi.Layout as L (Layout) import Yi.Layout (Rectangle(..), HasNeighborWest, layoutToRectangles) data Layout = Layout { tabbarRect :: !Rect , windowRects :: !(M.Map WindowRef (Rect, HasNeighborWest)) , promptRect :: !Rect } data Rect = Rect { offsetX :: !Int , offsetY :: !Int , sizeX :: !Int , sizeY :: !Int } data Point2D = Point2D { pointCol :: !Int , pointRow :: !Int } data Size2D = Size2D { sizeWidth :: !Int , sizeHeight :: !Int } layout :: Int -> Int -> Editor -> (Editor, Layout) layout colCount rowCount e = ( e & windowsA .~ newWs , Layout tabRect winRects cmdRect ) where lt = e ^. tabsA . PL.focus . to tabLayout miniWs = filter isMini . toList $ windows e tabHeight = 1 tabRect = Rect 0 0 colCount tabHeight cmdHeight = length $ arrangeItems (fst $ statusLineInfo e) colCount (maxStatusHeight e) miniHeight = if null miniWs then 0 else 1 cmdRect = Rect 0 (rowCount - cmdHeight - miniHeight) colCount cmdHeight bounds = rectToRectangle $ Rect 0 tabHeight colCount $ rowCount - (max 1 $ cmdHeight + miniHeight) - tabHeight bigRects = layoutToRectangles False bounds lt & map (\(wr, r, nb) -> let r' = rectangleToRect r sx = sizeX r' - if nb then 1 else 0 w' = layoutWindow (findWindowWith wr e) e sx (sizeY r') in (w', r', nb)) miniRects = miniWs & map (\w -> let r' = Rect 0 (rowCount - 1) colCount 1 w' = layoutWindow w e (sizeX r') (sizeY r') in (w', r', False)) rects = bigRects <> miniRects winRects = rects & M.fromList . map (\(w, r, nb) -> (wkey w, (r, nb))) updWs = rects & map (^. _1) newWs = windows e & fmap (\w -> fromMaybe w $ find ((== wkey w) . wkey) updWs) rectToRectangle :: Rect -> Rectangle rectToRectangle (Rect x y sx sy) = Rectangle (fromIntegral x) (fromIntegral y) (fromIntegral sx) (fromIntegral sy) rectangleToRect :: Rectangle -> Rect rectangleToRect (Rectangle x y sx sy) = Rect (truncate x) (truncate y) (truncate (x + sx) - truncate x) (truncate (y + sy) - truncate y) layoutWindow :: Window -> Editor -> Int -> Int -> Window layoutWindow win e w h = win { height = h , width = w , winRegion = mkRegion fromMarkPoint toMarkPoint , actualLines = dispLnCount } where b = findBufferWith (bufkey win) e evalBuffer action = fst (runBuffer win b action) -- Mini windows don't have a mode line. h' = h - if isMini win then 0 else 1 -- Work around a problem with the mini window never displaying it's contents due to a -- fromMark that is always equal to the end of the buffer contents. Just (MarkSet fromM _ _) = evalBuffer (getMarks win) fromMarkPoint = if isMini win then Point 0 else evalBuffer $ use $ markPointA fromM -- TODO: I suspect that this costs quite a lot of CPU in the "dry run" which determines the window size; -- In that case, since attributes are also useless there, it might help to replace the call by a dummy value. -- This is also approximately valid of the call to "indexedAnnotatedStreamB". (toMarkPoint, wrapCount) = evalBuffer (lastVisiblePointAndWrapCountB (Size2D w h') fromMarkPoint) dispLnCount = h' - wrapCount coordsOfCharacterB :: Size2D -> Point -> Point -> BufferM (Maybe Point2D) coordsOfCharacterB _ topLeft char | topLeft > char = return Nothing coordsOfCharacterB (Size2D w h) (Point topLeft) (Point char) | char - topLeft >= w * h = return Nothing coordsOfCharacterB (Size2D w h) (Point topLeft) (Point char) = savingPointB $ do ts <- fmap tabSize indentSettingsB text <- fmap (R.toString . R.take (w * h)) (streamB Forward (Point topLeft)) 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 ('\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 ('\n', _) -> go 0 (y + 1) (n - 1) [c] ( _ , _) -> go (x + 1) y (n - 1) [c] where wOffset = w - 1 go !x !y _ _ = Just (Point2D x y) return (go 0 0 (char - topLeft) text) lastVisiblePointAndWrapCountB :: Size2D -> Point -> BufferM (Point, Int) lastVisiblePointAndWrapCountB (Size2D w h) (Point topLeft) = savingPointB $ do ts <- fmap tabSize indentSettingsB text <- fmap (R.toText . R.take (w * h)) (streamB Forward (Point topLeft)) let go !x !y !wc !n t | x > w = go (x - w) (y + 1) (wc + 1) n t go _ !y !wc !n _ | y >= h = (Point (n - 1), wc) go !x !y !wc !n (T.uncons -> Just (c, t)) = case c of '\t' -> go (x + ts) y wc (n + 1) t '\n' -> go 0 (y + 1) wc (n + 1) t _ -> go (x + 1) y wc (n + 1) t go _ _ !wc !n _ = (Point n, wc) return (go 0 0 0 topLeft text) verticalOffsetsForWindows :: Int -> PL.PointedList Window -> PL.PointedList Int verticalOffsetsForWindows startY ws = scanrT (+) startY (fmap (\w -> if isMini w then 0 else height w) ws) -- As scanr, but generalized to a traversable (TODO) scanrT :: (Int -> Int -> Int) -> Int -> PL.PointedList Int -> PL.PointedList Int scanrT (+*+) k t = evalState (mapM f t) k where f x = do s <- get let s' = s +*+ x put s' return s yi-0.12.6/src/library/Yi/UI/TabBar.hs0000644000000000000000000000407712717763531015253 0ustar0000000000000000{-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.UI.TabBar -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Tabs. module Yi.UI.TabBar where import Control.Applicative ((<$>)) import Control.Lens ((^.)) import qualified Data.List.PointedList.Circular as PL (PointedList (_focus), withFocus) import qualified Data.Text as T (Text, pack, unpack) import System.FilePath (isValid, splitPath) import Yi.Buffer (shortIdentString) import Yi.Editor (Editor (..), commonNamePrefix, findBufferWith, tabsA) import Yi.Tab (tabWindowsA) import Yi.Window (Window (bufkey)) -- | A TabDescr describes the properties of a UI tab independent of -- the particular GUI in use. data TabDescr = TabDescr { tabText :: T.Text , tabInFocus :: Bool } deriving (Show, Eq) type TabBarDescr = PL.PointedList TabDescr tabBarDescr :: Editor -> TabBarDescr tabBarDescr editor = tabDescr <$> PL.withFocus (editor ^. tabsA) where prefix = commonNamePrefix editor shorten = tabAbbrevTitle . shortIdentString (length prefix) mkHintWith f = shorten $ findBufferWith f editor hintForTab tab = mkHintWith (bufkey $ PL._focus (tab ^. tabWindowsA)) tabDescr (tab, True) = TabDescr (hintForTab tab) True tabDescr (tab, False) = TabDescr (hintForTab tab) False -- FIXME: it seems that using splitDirectories can abstract the '/' -- handling away. (Making it win32 friendly and simpler) tabAbbrevTitle :: T.Text -> T.Text tabAbbrevTitle title = if isValid fp then T.pack $ concatMap abbrev (splitPath fp) else title where fp = T.unpack title abbrev "/" = "/" abbrev path | head path == '.' && last path == '/' = take 2 path ++ "/" | last path == '/' = head path : "/" | otherwise = path yi-0.12.6/src/library/Yi/UI/Utils.hs0000644000000000000000000001222412717763531015211 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.UI.Utils -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Utilities shared by various UIs module Yi.UI.Utils where import Prelude hiding (mapM) import Control.Applicative ((<$>)) import Control.Arrow (second) import Control.Lens (Traversable, use) import Control.Monad.State (evalState, modify) import Control.Monad.State.Class (gets) import Data.Foldable (maximumBy) import Data.Function (on) import Data.List (transpose) import Data.List.Split (chunksOf) import Data.Monoid (Endo (appEndo)) import qualified Data.Text as T (Text, null, pack, unpack) import Data.Traversable (mapM) import Yi.Buffer import Yi.String (padLeft) import Yi.Style (Attributes, StyleName, UIStyle (baseAttributes, selectedStyle)) import Yi.Syntax (Span (..)) import Yi.Window (Window (height, isMini)) applyHeights :: Traversable t => [Int] -> t Window -> t Window applyHeights heights ws = evalState (mapM distribute ws) heights where distribute win = if isMini win then return win{height = 1} else (do h <- gets head modify tail return win{height = h}) spliceAnnots :: [(Point,Char)] -> [Span String] -> [(Point,Char)] spliceAnnots text [] = text spliceAnnots text (Span start x stop:anns) = l ++ zip (repeat start) x ++ spliceAnnots r anns where (l,rest) = span ((start >) . fst) text (_,r) = span ((stop >) . fst) rest -- | Turn a sequence of (from,style,to) strokes into a sequence -- of picture points (from,style), taking special care to -- ensure that the points are strictly increasing and introducing -- padding segments where neccessary. -- Precondition: Strokes are ordered and not overlapping. strokePicture :: [Span (Endo a)] -> [(Point,a -> a)] strokePicture [] = [] strokePicture wholeList@(Span leftMost _ _:_) = helper leftMost wholeList where helper :: Point -> [Span (Endo a)] -> [(Point,a -> a)] helper prev [] = [(prev,id)] helper prev (Span l f r:xs) | prev < l = (prev, id) : (l,appEndo f) : helper r xs | otherwise = (l,appEndo f) : helper r xs -- | Paint the given stroke-picture on top of an existing picture paintStrokes :: (a -> a) -> a -> [(Point,a -> a)] -> [(Point,a)] -> [(Point,a)] paintStrokes f0 _ [] lx = fmap (second f0) lx paintStrokes _ x0 lf [] = fmap (second ($ x0)) lf paintStrokes f0 x0 lf@((pf,f):tf) lx@((px,x):tx) = case pf `compare` px of LT -> (pf, f x0):paintStrokes f x0 tf lx EQ -> (pf, f x ):paintStrokes f x tf tx GT -> (px, f0 x ):paintStrokes f0 x lf tx paintPicture :: a -> [[Span (Endo a)]] -> [(Point,a)] paintPicture a = foldr (paintStrokes id a . strokePicture) [] attributesPictureB :: UIStyle -> Maybe SearchExp -> Region -> [[Span StyleName]] -> BufferM [(Point,Attributes)] attributesPictureB sty mexp region extraLayers = paintPicture (baseAttributes sty) <$> fmap (fmap (fmap ($ sty))) <$> (extraLayers ++) <$> strokesRangesB mexp region attributesPictureAndSelB :: UIStyle -> Maybe SearchExp -> Region -> BufferM [(Point,Attributes)] attributesPictureAndSelB sty mexp region = do selReg <- getSelectRegionB showSel <- use highlightSelectionA rectSel <- use rectangleSelectionA let styliseReg reg = Span (regionStart reg) selectedStyle (regionEnd reg) extraLayers | rectSel && showSel = (:[]) . fmap styliseReg <$> blockifyRegion selReg | showSel = return [[styliseReg selReg]] | otherwise = return [] attributesPictureB sty mexp region =<< extraLayers -- | Arrange a list of items in columns over maximum @maxNumberOfLines@ lines arrangeItems :: [T.Text] -> Int -> Int -> [T.Text] arrangeItems items _ _ | all T.null items = [] arrangeItems items maxWidth maxNumberOfLines = take maxNumberOfLines $ snd choice where choice = maximumBy (compare `on` fst) arrangements arrangements = fmap (arrangeItems' items maxWidth) (reverse [1..maxNumberOfLines]) -- | Arrange a list of items in columns over @numberOfLines@ lines. -- -- TODO: proper Text/YiString implementation arrangeItems' :: [T.Text] -> Int -> Int -> (Int, [T.Text]) arrangeItems' items' maxWidth numberOfLines = (fittedItems,theLines) where items = T.unpack <$> items' columns = chunksOf numberOfLines items columnsWidth = fmap (maximum . fmap length) columns 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 = T.pack . unwords . zipWith padLeft columnsWidth <$> transpose columns yi-0.12.6/src/library/Yi/Verifier/JavaScript.hs0000644000000000000000000000725012717763531017420 0ustar0000000000000000{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} -- TODO: -- ! User configuration. -- ! Checking for side-effect-less code, e.g. "1;". module Yi.Verifier.JavaScript where import Control.Monad (unless) import Control.Monad.Writer.Lazy (MonadWriter, Writer, tell) import qualified Data.DList as D (DList, singleton) import Data.Foldable (toList) import Data.Function (on) import Data.List (intercalate) import Yi.Lexer.Alex (Posn, Tok, tokPosn, tokT) import Yi.Lexer.JavaScript (TT, Token (..)) import Yi.Syntax.JavaScript hiding (res) -- * Types data Error = MultipleFunctionDeclaration String [Posn] deriving Eq data Warning = UnreachableCode Posn deriving Eq data Report = Err Error | Warn Warning deriving Eq -- * Instances instance Show Error where show (MultipleFunctionDeclaration n ps) = "Function `" ++ n ++ "' declared more than once: " ++ intercalate ", " (map show ps) instance Show Warning where show (UnreachableCode pos) = "Unreachable code at " ++ show pos instance Show Report where show (Err e) = "EE " ++ show e show (Warn w) = "WW " ++ show w -- * Main code -- | The main verifier which calls the sub-verifiers. verify :: Tree TT -> Writer (D.DList Report) () verify t = do let topfuns = findFunctions (toList t) checkMultipleFuns topfuns mapM_ (checkUnreachable . funBody) topfuns -- | Given a list of function declarations, checks for multiple function -- declarations, including the functions' subfunctions. checkMultipleFuns :: [Statement TT] -> Writer (D.DList Report) () checkMultipleFuns stmts = do let dupFuns = dupsBy (ttEq `on` funName) stmts unless (null dupFuns) (say (Err (MultipleFunctionDeclaration (nameOf $ tokT $ funName $ head dupFuns) (map (tokPosn . funName) dupFuns)))) let subFuns = map (findFunctions . funBody) (findFunctions stmts) mapM_ checkMultipleFuns subFuns checkUnreachable :: [Statement TT] -> Writer (D.DList Report) () checkUnreachable stmts = do let afterReturn = dropWhile' (not . isReturn) stmts unless (null afterReturn) (say (Warn (UnreachableCode (tokPosn $ firstTok $ head afterReturn)))) -- * Helper functions -- | Given two @Tok t@, compares the @t@s. ttEq :: Eq t => Tok t -> Tok t -> Bool ttEq x y = tokT x == tokT y say :: MonadWriter (D.DList a) m => a -> m () say = tell . D.singleton isReturn :: Statement t -> Bool isReturn (Return {}) = True isReturn _ = False -- | Returns a list of the functions in the given block. findFunctions :: [Statement t] -> [Statement t] findFunctions stmts = [ f | f@(FunDecl {}) <- stmts ] -- | Given a 'FunDecl', returns the token representing the name. funName :: Statement t -> t funName (FunDecl _ n _ _) = n funName _ = undefined -- | Given a 'FunDecl', returns its inner body as a list. funBody :: Statement t -> [Statement t] funBody (FunDecl _ _ _ blk) = case blk of Block _ stmts _ -> toList stmts BlockOne stmt -> [stmt] _ -> [] funBody _ = undefined -- | Given a @ValidName@ returns the string representing the name. nameOf :: Token -> String nameOf (ValidName n) = n nameOf _ = undefined -- * Misc -- | Like 'dropWhile' but drops the first element in the result. dropWhile' :: (a -> Bool) -> [a] -> [a] dropWhile' p xs = let res = dropWhile p xs in if null res then [] else drop 1 res dupsBy :: (a -> a -> Bool) -> [a] -> [a] dupsBy p xs = filter (\x -> length (filter (p x) xs) > 1) xs yi-0.12.6/src/library/Yi/Window.hs0000644000000000000000000000556612717763531015056 0ustar0000000000000000{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Window -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Operations on 'Window's, in the emacs sense of the word. module Yi.Window where import Control.Applicative (Applicative ((<*>)), (<$>)) import Data.Binary (Binary (..)) import Data.Default (Default (def)) import Data.Typeable (Typeable) import Yi.Buffer.Basic (BufferRef, WindowRef) import Yi.JumpList (JumpList) import Yi.Region (Region, emptyRegion) import Yi.Utils (makeLensesWithSuffix) ------------------------------------------------------------------------ -- | A window onto a buffer. data Window = Window { isMini :: !Bool -- ^ regular or mini window? , bufkey :: !BufferRef -- ^ the buffer this window opens to , bufAccessList :: ![BufferRef] -- ^ list of last accessed buffers (former bufKeys). Last -- accessed one is first element , height :: !Int -- ^ height of the window (in number of screen -- lines displayed) , width :: !Int -- ^ width of the window (in number of chars) , winRegion :: !Region -- ^ view area. note that the top point is -- also available as a buffer mark. , wkey :: !WindowRef -- ^ identifier for the window (for UI sync) -- This is required for accurate scrolling. -- Scrolling depends on the actual number of buffer -- lines displayed. Line wrapping changes that number -- relative to the height so we can't use height for that -- purpose. , actualLines :: !Int -- ^ The actual number of buffer lines displayed. Taking into -- account line wrapping , jumpList :: !JumpList } deriving (Typeable) makeLensesWithSuffix "A" ''Window instance Binary Window where put (Window mini bk bl _w _h _rgn key lns jl) = put mini >> put bk >> put bl >> put key >> put lns >> put jl get = Window <$> get <*> get <*> get <*> return 0 <*> return 0 <*> return emptyRegion <*> get <*> get <*> get -- | Get the identification of a window. winkey :: Window -> (Bool, BufferRef) winkey w = (isMini w, bufkey w) instance Show Window where show w = "Window to " ++ show (bufkey w) -- ++ "{" ++ show (tospnt w) ++ "->" ++ show (bospnt w) ++ "}" ++ "(" ++ show (height w) ++ ")" instance Eq Window where (==) w1 w2 = wkey w1 == wkey w2 {- -- | Is a given point within tospnt / bospnt? pointInWindow :: Point -> Window -> Bool pointInWindow point win = tospnt win <= point && point <= bospnt win -} -- | Return a "fake" window onto a buffer. dummyWindow :: BufferRef -> Window dummyWindow b = Window False b [] 0 0 emptyRegion def 0 Nothing yi-0.12.6/src/library/Yi/Char/Unicode.hs0000644000000000000000000001430712717763531016043 0ustar0000000000000000module Yi.Char.Unicode (greek, symbols, subscripts, superscripts, checkAmbs, disamb) where import Control.Applicative (Applicative (pure)) import Data.List (isPrefixOf) {-# ANN module "HLint: ignore Use string literal" #-} greek :: [(String, String)] greek = [(name, unicode) | (_,name,unicode) <- greekData] ++ [ ([leading,shorthand],unicode) | (Just shorthand,_,unicode) <- greekData , leading <- ['\'', 'g'] ] -- | Triples: (shorthand, name, unicode) greekData :: [(Maybe Char, String, String)] greekData = [(Just 'a', "alpha", "α") ,(Just 'b', "beta", "β") ,(Just 'g', "gamma", "γ") ,(Just 'G', "Gamma", "Γ") ,(Just 'd', "delta", "δ") ,(Just 'D', "Delta", "Δ") ,(Just 'e' , "epsilon", "ε") ,(Just 'z', "zeta", "ζ") ,(Just 'N' , "eta", "η") -- N is close to n which is graphically close ,(Just 'E' , "eta", "η") -- E is close to e which is the start of eta ,(Nothing , "theta", "θ") ,(Nothing , "Theta", "Θ") ,(Just 'i', "iota", "ι") ,(Just 'k', "kapa", "κ") ,(Just 'l', "lambda", "λ") ,(Just 'L', "Lambda", "Λ") ,(Just 'm', "mu", "μ") ,(Just 'n', "nu", "ν") ,(Just 'x', "xi", "ξ") ,(Just 'o', "omicron", "ο") ,(Just 'p' , "pi", "Ï€") ,(Just 'P' , "Pi", "Π") ,(Just 'r', "rho", "Ï") ,(Just 's', "sigma", "σ") ,(Just 'S', "Sigma", "Σ") ,(Just 't', "tau", "Ï„") ,(Just 'f' , "phi", "φ") ,(Just 'F' , "Phi", "Φ") ,(Just 'c', "chi", "χ") ,(Just 'C', "Chi", "Χ") ,(Nothing , "psi", "ψ") ,(Nothing , "Psi", "Ψ") ,(Just 'w', "omega", "ω") ,(Just 'O', "Omega", "Ω") ] symbols :: [(String, String)] symbols = [ -- parens ("<","⟨") ,(">","⟩") ,("<>","⟨⟩") ,(">>","⟫") ,("<<","⟪") -- These two confuse gnome-terminal. ,("|(","〖") ,(")|","〗") ,("{|", "⦃") ,("|}", "⦄") ,("[[","⟦") ,("]]","⟧") ,("|_","⌊") ,("_|","⌋") ,("|__|","⌊⌋") ,("r|_","⌈") ,("r_|","⌉") ,("r|__|","⌈⌉") ,("[]", "∎") -- quantifiers ,("forall", "∀") ,("all", "∀") ,("exists", "∃") ,("rA", "∀") -- reversed A ,("rE", "∃") -- reversed E ,("/rE", "∄") -- operators ,("<|","â—ƒ") -- ,("<|","â—") alternative ,("|>","â–¹") ,("><","⋈") ,("<)", "â—…") ,("(>", "â–»") ,("v","∨") ,("u","∪") ,("V","â‹") ,("+u","⊎") ,("u[]","⊔") ,("n[]","⊓") ,("^","∧") ,("/\\", "∧") ,("\\/", "∨") ,("o","∘") ,(".","·") ,("x","×") ,("neg","¬") --- arrows ,("<-","â†") ,("->","→") ,("|->","↦") ,("<-|","↤") ,("<--","⟵") ,("-->","⟶") ,("|-->","⟼") ,("==>","⟹") ,("=>","⇒") ,("<=","â‡") ,("<=>","⇔") ,("~>","â†") ,("<~","↜") ,("<-<", "↢") ,(">->", "↣") ,("<->", "↔") ,("|<-", "⇤") ,("->|", "⇥") ,(">>=","↠") --- relations ,("c=","⊆") ,("c","⊂") ,("c-","∈") ,("in","∈") ,("/c-","∉") ,("c/=","⊊") ,("rc=","⊇") -- r for reversed ,("rc","⊃") -- r for reversed ,("rc-","∋") -- r for reversed ,("r/c-","∌") -- r for reversed ,("rc/=","⊋") -- r for reversed ,(">=","≥") ,("=<","≤") ,("c[]","âŠ") ,("rc[]","âŠ") ,("c[]=","⊑") ,("rc[]=","⊒") ,("/c[]=","â‹¢") ,("/rc[]=","â‹£") ,("c[]/=","⋤") ,("rc[]/=","â‹¥") ---- equal signs ,("=def","â‰") ,("=?","≟") ,("==","≡") ,("~~","≈") ,("~-","≃") ,("~=","≅") ,("~","∼") ,("~~","≈") ,("/=","≠") ,("/==","≢") ,(":=","≔") ,("=:","≕") -- misc ,("_|_","⊥") ,("Top","⊤") ,("l","â„“") ,("::","∷") ,(":", "∶") ,("0", "∅") ,("*", "★") -- or "⋆" ,("/'l","Æ›") ,("d","∂") ,("#b","â™­") -- music bemol ,("#f","â™®") -- music flat ,("##","♯") -- music # ,("Hot","♨") ,("Cut","✂") ,("Pen","✎") ,("Tick","✓") -- dashes ,("-","−") -- quotes ,("\"","“â€") ,("r`","′") -- turnstyles ,("|-", "⊢") ,("|/-", "⊬") ,("-|", "⊣") ,("|=", "⊨") ,("|/=", "⊭") ,("||-", "⊩") -- circled/squared operators -- ⊠⟠⎊ ⎉ ,("o+","⊕") ,("o-","⊖") ,("ox","⊗") ,("o/","⊘") ,("o*","⊛") ,("o=","⊜") ,("o.","⊙") ,("oo","⊚") ,("[+]","⊞") ,("[-]","⊟") ,("[x]","⊠") ,("[.]","⊡") ,("[]","∎") ] ++ [ (leading:l, [u]) | leading <- ['|','b'], (l,u) <- [("N",'â„•') ,("H",'â„') ,("P",'â„™') ,("R",'â„') ,("D",'â……') ,("Q",'â„š') ,("Z",'ℤ') ,("gg",'ℽ') ,("gG",'ℾ') ,("gP",'â„¿') ,("gS",'â…€') ] ] ++ [ ("cP","℘") -- c for cal ,("cL","â„’") -- c for cal ,("cR","â„›") -- c for cal ] checkAmbs :: [(String, String)] -> [(String, String)] checkAmbs table = check where ambs = [ (x, y) | v@(x, _) <- table , w@(y, _) <- table , v /= w , x `isPrefixOf` y ] check | null ambs = table | otherwise = error $ "checkAmbs: ambiguous declarations for " ++ show ambs disamb :: [(String, String)] -> [(String, String)] disamb table = map f table where f v@(x, vx) = let ambs = [ w | w@(y, _) <- table , v /= w , x `isPrefixOf` y ] in if null ambs then v else (x ++ " ", vx) -- More: -- arrows: ⇸ ⇆ -- circled operators: ⊕ ⊖ ⊗ ⊘ ⊙ ⊚ ⊛ ⊜ ⊠⟠⎊ ⎉ -- squared operators: ⊞ ⊟ ⊠ ⊡ -- turnstyles: ⊦ ⊧ -- subscript: â‚” zipscripts :: Char -> String -> String -> [(String, String)] zipscripts c ascii unicode = zip (fmap ((c:) . pure) ascii) (fmap pure unicode) subscripts, superscripts :: [(String, String)] subscripts = zipscripts '_' "0123456789+-=()aeioruvx" "â‚€â‚₂₃₄₅₆₇₈₉₊₋₌â‚â‚Žâ‚ₑᵢₒᵣᵤᵥₓ" superscripts = zipscripts '^' -- NOTE that qCFQSVXYZ are missing "0123456789+-=()abcdefghijklmnoprstuvwxyzABDEGHIJKLMNOPRTUW" "â°Â¹Â²Â³â´âµâ¶â·â¸â¹âºâ»â¼â½â¾áµƒáµ‡á¶œáµˆáµ‰á¶ áµÊ°â±Ê²áµË¡áµâ¿áµ’ᵖʳˢᵗᵘᵛʷˣʸᶻᴬᴮᴰᴱᴳᴴᴵᴶᴷᴸᴹᴺᴼᴾᴿᵀáµáµ‚" yi-0.12.6/src/library/Yi/UI/Pango.hs0000644000000000000000000010433212717763531015157 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS_GHC -funbox-strict-fields #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.UI.Pango -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module defines a user interface implemented using gtk2hs and -- pango for direct text rendering. module Yi.UI.Pango (start, startGtkHook) where import Control.Applicative import Control.Concurrent import Control.Exception (catch, SomeException) import Control.Lens hiding (set, from) import Control.Monad hiding (forM_, mapM_, forM, mapM) import Data.Foldable import Data.IORef import qualified Data.List.PointedList as PL (moveTo) import qualified Data.List.PointedList.Circular as PL import qualified Data.Map as M import Data.Maybe import Data.Monoid import Data.Text (unpack, Text) import qualified Data.Text as T import Data.Traversable import qualified Graphics.UI.Gtk as Gtk import Graphics.UI.Gtk hiding (Region, Window, Action , Point, Style, Modifier, on) import qualified Graphics.UI.Gtk.Gdk.EventM as EventM import qualified Graphics.UI.Gtk.Gdk.GC as Gtk import Graphics.UI.Gtk.Gdk.GC hiding (foreground) import Prelude hiding (error, elem, mapM_, foldl, concat, mapM) import System.Glib.GError import Yi.Buffer import Yi.Config import Yi.Debug import Yi.Editor import Yi.Event import Yi.Keymap import Yi.Layout(DividerPosition, DividerRef) import Yi.Monad import qualified Yi.Rope as R import Yi.Style import Yi.Tab import Yi.Types (fontsizeVariation, attributes) import qualified Yi.UI.Common as Common import Yi.UI.Pango.Control (keyTable) #ifdef GNOME_ENABLED import Yi.UI.Pango.Gnome(watchSystemFont) #endif import Yi.UI.Pango.Layouts import Yi.UI.Pango.Utils import Yi.String (showT) import Yi.UI.TabBar import Yi.UI.Utils import Yi.Utils import Yi.Window -- We use IORefs in all of these datatypes for all fields which could -- possibly change over time. This ensures that no 'UI', 'TabInfo', -- 'WinInfo' will ever go out of date. data UI = UI { uiWindow :: Gtk.Window , uiNotebook :: SimpleNotebook , uiStatusbar :: Statusbar , tabCache :: IORef TabCache , uiActionCh :: Action -> IO () , uiConfig :: UIConfig , uiFont :: IORef FontDescription , uiInput :: IMContext } type TabCache = PL.PointedList TabInfo -- We don't need to know the order of the windows (the layout manages -- that) so we might as well use a map type WindowCache = M.Map WindowRef WinInfo data TabInfo = TabInfo { coreTabKey :: TabRef , layoutDisplay :: LayoutDisplay , miniwindowPage :: MiniwindowDisplay , tabWidget :: Widget , windowCache :: IORef WindowCache , fullTitle :: IORef Text , abbrevTitle :: IORef Text } instance Show TabInfo where show t = show (coreTabKey t) data WinInfo = WinInfo { coreWinKey :: WindowRef , coreWin :: IORef Window , shownTos :: IORef Point , lButtonPressed :: IORef Bool , insertingMode :: IORef Bool , inFocus :: IORef Bool , winLayoutInfo :: MVar WinLayoutInfo , winMetrics :: FontMetrics , textview :: DrawingArea , modeline :: Label , winWidget :: Widget -- ^ Top-level widget for this window. } data WinLayoutInfo = WinLayoutInfo { winLayout :: !PangoLayout, tos :: !Point, bos :: !Point, bufEnd :: !Point, cur :: !Point, buffer :: !FBuffer, regex :: !(Maybe SearchExp) } instance Show WinInfo where show w = show (coreWinKey w) instance Ord EventM.Modifier where x <= y = fromEnum x <= fromEnum y mkUI :: UI -> Common.UI Editor mkUI ui = Common.dummyUI { Common.main = main , Common.end = const end , Common.suspend = windowIconify (uiWindow ui) , Common.refresh = refresh ui , Common.layout = doLayout ui , Common.reloadProject = const reloadProject } updateFont :: UIConfig -> IORef FontDescription -> IORef TabCache -> Statusbar -> FontDescription -> IO () updateFont cfg fontRef tc status font = do maybe (return ()) (fontDescriptionSetFamily font) (configFontName cfg) writeIORef fontRef font widgetModifyFont status (Just font) tcs <- readIORef tc forM_ tcs $ \tabinfo -> do wcs <- readIORef (windowCache tabinfo) forM_ wcs $ \wininfo -> do withMVar (winLayoutInfo wininfo) $ \WinLayoutInfo{winLayout} -> layoutSetFontDescription winLayout (Just font) -- This will cause the textview to redraw widgetModifyFont (textview wininfo) (Just font) widgetModifyFont (modeline wininfo) (Just font) askBuffer :: Window -> FBuffer -> BufferM a -> a askBuffer w b f = fst $ runBuffer w b f -- | Initialise the ui start :: UIBoot start = startGtkHook (const $ return ()) -- | Initialise the ui, calling a given function -- on the Gtk window. This could be used to -- set additional callbacks, adjusting the window -- layout, etc. startGtkHook :: (Gtk.Window -> IO ()) -> UIBoot startGtkHook userHook cfg ch outCh ed = catch (startNoMsgGtkHook userHook cfg ch outCh ed) (\(GError _dom _code msg) -> fail $ unpack msg) startNoMsgGtkHook :: (Gtk.Window -> IO ()) -> UIBoot startNoMsgGtkHook userHook cfg ch outCh ed = do logPutStrLn "startNoMsgGtkHook" void unsafeInitGUIForThreadedRTS win <- windowNew ico <- loadIcon "yi+lambda-fat-32.png" vb <- vBoxNew False 1 -- Top-level vbox im <- imMulticontextNew imContextSetUsePreedit im False -- handler for preedit string not implemented -- Yi.Buffer.Misc.insertN for atomic input? let imContextCommitS :: Signal IMContext (String -> IO ()) imContextCommitS = imContextCommit im `on` imContextCommitS $ mapM_ (\k -> ch [Event (KASCII k) []]) set win [ windowDefaultWidth := 700 , windowDefaultHeight := 900 , windowTitle := ("Yi" :: T.Text) , windowIcon := Just ico , containerChild := vb ] win `on` deleteEvent $ io $ mainQuit >> return True win `on` keyPressEvent $ handleKeypress ch im paned <- hPanedNew tabs <- simpleNotebookNew panedAdd2 paned (baseWidget tabs) status <- statusbarNew -- Allow multiple lines in statusbar, GitHub issue #478 statusbarGetMessageArea status >>= containerGetChildren >>= \case [w] -> labelSetSingleLineMode (castToLabel w) False _ -> return () -- statusbarGetContextId status "global" set vb [ containerChild := paned , containerChild := status , boxChildPacking status := PackNatural ] fontRef <- fontDescriptionNew >>= newIORef let actionCh = outCh . return tc <- newIORef =<< newCache ed actionCh #ifdef GNOME_ENABLED let watchFont = watchSystemFont #else let watchFont = (fontDescriptionFromString ("Monospace 10" :: T.Text) >>=) #endif watchFont $ updateFont (configUI cfg) fontRef tc status -- I think this is the correct place to put it... userHook win -- use our magic threads thingy -- http://haskell.org/gtk2hs/archives/2005/07/24/writing-multi-threaded-guis/ void $ timeoutAddFull (yield >> return True) priorityDefaultIdle 50 widgetShowAll win let ui = UI win tabs status tc actionCh (configUI cfg) fontRef im -- Keep the current tab focus up to date let move n pl = fromMaybe pl (PL.moveTo n pl) runAction = uiActionCh ui . makeAction -- why does this cause a hang without postGUIAsync? simpleNotebookOnSwitchPage (uiNotebook ui) $ \n -> postGUIAsync $ runAction ((%=) tabsA (move n) :: EditorM ()) return (mkUI ui) main :: IO () main = logPutStrLn "GTK main loop running" >> mainGUI -- | Clean up and go home end :: IO () end = mainQuit -- | Modify GUI and the 'TabCache' to reflect information in 'Editor'. updateCache :: UI -> Editor -> IO () updateCache ui e = do cache <- readIORef $ tabCache ui -- convert to a map for convenient lookups let cacheMap = mapFromFoldable . fmap (\t -> (coreTabKey t, t)) $ cache -- build the new cache cache' <- forM (e ^. tabsA) $ \tab -> case M.lookup (tkey tab) cacheMap of Just t -> updateTabInfo e ui tab t >> return t Nothing -> newTab e ui tab -- store the new cache writeIORef (tabCache ui) cache' -- update the GUI simpleNotebookSet (uiNotebook ui) =<< forM cache' (\t -> (tabWidget t,) <$> readIORef (abbrevTitle t)) -- | Modify GUI and given 'TabInfo' to reflect information in 'Tab'. updateTabInfo :: Editor -> UI -> Tab -> TabInfo -> IO () updateTabInfo e ui tab tabInfo = do -- update the window cache wCacheOld <- readIORef (windowCache tabInfo) wCacheNew <- mapFromFoldable <$> forM (tab ^. tabWindowsA) (\w -> case M.lookup (wkey w) wCacheOld of Just wInfo -> updateWindow e ui w wInfo >> return (wkey w, wInfo) Nothing -> (wkey w,) <$> newWindow e ui w) writeIORef (windowCache tabInfo) wCacheNew -- TODO update renderer, etc? let lookupWin w = wCacheNew M.! w -- set layout layoutDisplaySet (layoutDisplay tabInfo) . fmap (winWidget . lookupWin) . tabLayout $ tab -- set minibox miniwindowDisplaySet (miniwindowPage tabInfo) . fmap (winWidget . lookupWin . wkey) . tabMiniWindows $ tab -- set focus setWindowFocus e ui tabInfo . lookupWin . wkey . tabFocus $ tab updateWindow :: Editor -> UI -> Window -> WinInfo -> IO () updateWindow e _ui win wInfo = do writeIORef (inFocus wInfo) False -- see also 'setWindowFocus' writeIORef (coreWin wInfo) win writeIORef (insertingMode wInfo) (askBuffer win (findBufferWith (bufkey win) e) $ use insertingA) setWindowFocus :: Editor -> UI -> TabInfo -> WinInfo -> IO () setWindowFocus e ui t w = do win <- readIORef (coreWin w) let bufferName = shortIdentString (length $ commonNamePrefix e) $ findBufferWith (bufkey win) e ml = askBuffer win (findBufferWith (bufkey win) e) $ getModeLine (T.pack <$> commonNamePrefix e) im = uiInput ui writeIORef (inFocus w) True -- see also 'updateWindow' update (textview w) widgetIsFocus True update (modeline w) labelText ml writeIORef (fullTitle t) bufferName writeIORef (abbrevTitle t) (tabAbbrevTitle bufferName) drawW <- catch (fmap Just $ widgetGetDrawWindow $ textview w) (\(_ :: SomeException) -> return Nothing) imContextSetClientWindow im drawW imContextFocusIn im getWinInfo :: UI -> WindowRef -> IO WinInfo getWinInfo ui ref = let tabLoop [] = error "Yi.UI.Pango.getWinInfo: window not found" tabLoop (t:ts) = do wCache <- readIORef (windowCache t) case M.lookup ref wCache of Just w -> return w Nothing -> tabLoop ts in readIORef (tabCache ui) >>= (tabLoop . toList) -- | Make the cache from the editor and the action channel newCache :: Editor -> (Action -> IO ()) -> IO TabCache newCache e actionCh = mapM (mkDummyTab actionCh) (e ^. tabsA) -- | Make a new tab, and populate it newTab :: Editor -> UI -> Tab -> IO TabInfo newTab e ui tab = do t <- mkDummyTab (uiActionCh ui) tab updateTabInfo e ui tab t return t -- | Make a minimal new tab, without any windows. -- This is just for bootstrapping the UI; 'newTab' should normally -- be called instead. mkDummyTab :: (Action -> IO ()) -> Tab -> IO TabInfo mkDummyTab actionCh tab = do ws <- newIORef M.empty ld <- layoutDisplayNew layoutDisplayOnDividerMove ld (handleDividerMove actionCh) mwp <- miniwindowDisplayNew tw <- vBoxNew False 0 set tw [containerChild := baseWidget ld, containerChild := baseWidget mwp, boxChildPacking (baseWidget ld) := PackGrow, boxChildPacking (baseWidget mwp) := PackNatural] ftRef <- newIORef "" atRef <- newIORef "" return (TabInfo (tkey tab) ld mwp (toWidget tw) ws ftRef atRef) -- | Make a new window. newWindow :: Editor -> UI -> Window -> IO WinInfo newWindow e ui w = do let b = findBufferWith (bufkey w) e f <- readIORef (uiFont ui) ml <- labelNew (Nothing :: Maybe Text) widgetModifyFont ml (Just f) set ml [ miscXalign := 0.01 ] -- so the text is left-justified. -- allow the modeline to be covered up, horizontally widgetSetSizeRequest ml 0 (-1) v <- drawingAreaNew widgetModifyFont v (Just f) widgetAddEvents v [Button1MotionMask] widgetModifyBg v StateNormal . mkCol False . Yi.Style.background . baseAttributes . configStyle $ uiConfig ui sw <- scrolledWindowNew Nothing Nothing scrolledWindowAddWithViewport sw v scrolledWindowSetPolicy sw PolicyAutomatic PolicyNever box <- if isMini w then do prompt <- labelNew (Just $ miniIdentString b) widgetModifyFont prompt (Just f) hb <- hBoxNew False 1 set hb [ containerChild := prompt, containerChild := sw, boxChildPacking prompt := PackNatural, boxChildPacking sw := PackGrow] return (castToBox hb) else do vb <- vBoxNew False 1 set vb [ containerChild := sw, containerChild := ml, boxChildPacking ml := PackNatural] return (castToBox vb) tosRef <- newIORef (askBuffer w b (use . markPointA =<< fromMark <$> askMarks)) context <- widgetCreatePangoContext v layout <- layoutEmpty context layoutRef <- newMVar (WinLayoutInfo layout 0 0 0 0 (findBufferWith (bufkey w) e) Nothing) language <- contextGetLanguage context metrics <- contextGetMetrics context f language ifLButton <- newIORef False imode <- newIORef False focused <- newIORef False winRef <- newIORef w layoutSetFontDescription layout (Just f) -- stops layoutGetText crashing (as of gtk2hs 0.10.1) layoutSetText layout T.empty let ref = wkey w win = WinInfo { coreWinKey = ref , coreWin = winRef , winLayoutInfo = layoutRef , winMetrics = metrics , textview = v , modeline = ml , winWidget = toWidget box , shownTos = tosRef , lButtonPressed = ifLButton , insertingMode = imode , inFocus = focused } updateWindow e ui w win v `on` buttonPressEvent $ handleButtonClick ui ref v `on` buttonReleaseEvent $ handleButtonRelease ui win v `on` scrollEvent $ handleScroll ui win -- todo: allocate event rather than configure? v `on` configureEvent $ handleConfigure ui v `on` motionNotifyEvent $ handleMove ui win void $ v `onExpose` render ui win -- also redraw when the window receives/loses focus uiWindow ui `on` focusInEvent $ io (widgetQueueDraw v) >> return False uiWindow ui `on` focusOutEvent $ io (widgetQueueDraw v) >> return False -- todo: consider adding an 'isDirty' flag to WinLayoutInfo, -- so that we don't have to recompute the Attributes when focus changes. return win refresh :: UI -> Editor -> IO () refresh ui e = do postGUIAsync $ do contextId <- statusbarGetContextId (uiStatusbar ui) ("global" :: T.Text) statusbarPop (uiStatusbar ui) contextId void $ statusbarPush (uiStatusbar ui) contextId $ T.intercalate " " $ statusLine e updateCache ui e -- The cursor may have changed since doLayout cache <- readIORef $ tabCache ui forM_ cache $ \t -> do wCache <- readIORef (windowCache t) forM_ wCache $ \w -> do updateWinInfoForRendering e ui w widgetQueueDraw (textview w) -- | Record all the information we need for rendering. -- -- This information is kept in an MVar so that the PangoLayout and -- tos/bos/buffer are in sync. updateWinInfoForRendering :: Editor -> UI -> WinInfo -> IO () updateWinInfoForRendering e _ui w = modifyMVar_ (winLayoutInfo w) $ \wli -> do win <- readIORef (coreWin w) return $! wli{buffer=findBufferWith (bufkey win) e,regex=currentRegex e} -- | Tell the 'PangoLayout' what colours to draw, and draw the 'PangoLayout' -- and the cursor onto the screen render :: UI -> WinInfo -> t -> IO Bool render ui w _event = withMVar (winLayoutInfo w) $ \WinLayoutInfo{winLayout=layout,tos,bos,cur,buffer=b,regex} -> do -- read the information win <- readIORef (coreWin w) -- add color attributes. let picture = askBuffer win b $ attributesPictureAndSelB sty regex (mkRegion tos bos) sty = configStyle $ uiConfig ui picZip = zip picture $ drop 1 (fst <$> picture) <> [bos] strokes = [ (start',s,end') | ((start', s), end') <- picZip , s /= emptyAttributes ] rel p = fromIntegral (p - tos) allAttrs = concat $ do (p1, Attributes fg bg _rv bd itlc udrl, p2) <- strokes let atr x = x (rel p1) (rel p2) if' p x y = if p then x else y return [ atr AttrForeground $ mkCol True fg , atr AttrBackground $ mkCol False bg , atr AttrStyle $ if' itlc StyleItalic StyleNormal , atr AttrUnderline $ if' udrl UnderlineSingle UnderlineNone , atr AttrWeight $ if' bd WeightBold WeightNormal ] layoutSetAttributes layout allAttrs drawWindow <- widgetGetDrawWindow $ textview w gc <- gcNew drawWindow -- see Note [PangoLayout width] -- draw the layout drawLayout drawWindow gc 1 0 layout -- calculate the cursor position im <- readIORef (insertingMode w) -- check focus, and decide whether we want a wide cursor bufferFocused <- readIORef (inFocus w) uiFocused <- Gtk.windowHasToplevelFocus (uiWindow ui) let focused = bufferFocused && uiFocused wideCursor = case configCursorStyle (uiConfig ui) of AlwaysFat -> True NeverFat -> False FatWhenFocused -> focused FatWhenFocusedAndInserting -> focused && im (PangoRectangle (succ -> curX) curY curW curH, _) <- layoutGetCursorPos layout (rel cur) -- tell the input method imContextSetCursorLocation (uiInput ui) $ Rectangle (round curX) (round curY) (round curW) (round curH) -- paint the cursor gcSetValues gc (newGCValues { Gtk.foreground = mkCol True . Yi.Style.foreground . baseAttributes . configStyle $ uiConfig ui , Gtk.lineWidth = if wideCursor then 2 else 1 }) -- tell the renderer if im then -- if we are inserting, we just want a line drawLine drawWindow gc (round curX, round curY) (round $ curX + curW, round $ curY + curH) -- we aren't inserting, we want a rectangle around the current character else do PangoRectangle (succ -> chx) chy chw chh <- layoutIndexToPos layout (rel cur) drawRectangle drawWindow gc False (round chx) (round chy) (if chw > 0 then round chw else 8) (round chh) return True doLayout :: UI -> Editor -> IO Editor doLayout ui e = do updateCache ui e tabs <- readIORef $ tabCache ui f <- readIORef (uiFont ui) dims <- fold <$> mapM (getDimensionsInTab ui f e) tabs let e' = (tabsA %~ fmap (mapWindows updateWin)) e updateWin w = case M.lookup (wkey w) dims of Nothing -> w Just (wi,h,rgn) -> w { width = wi, height = h, winRegion = rgn } -- Don't leak references to old Windows let forceWin x w = height w `seq` winRegion w `seq` x return $ (foldl . tabFoldl) forceWin e' (e' ^. tabsA) -- | Width, Height getDimensionsInTab :: UI -> FontDescription -> Editor -> TabInfo -> IO (M.Map WindowRef (Int,Int,Region)) getDimensionsInTab ui f e tab = do wCache <- readIORef (windowCache tab) forM wCache $ \wi -> do (wid, h) <- widgetGetSize $ textview wi win <- readIORef (coreWin wi) let metrics = winMetrics wi lineHeight = ascent metrics + descent metrics charWidth = max (approximateCharWidth metrics) (approximateDigitWidth metrics) width = round $ fromIntegral wid / charWidth - 1 height = round $ fromIntegral h / lineHeight b0 = findBufferWith (bufkey win) e rgn <- shownRegion ui f wi b0 return (width, height, rgn) shownRegion :: UI -> FontDescription -> WinInfo -> FBuffer -> IO Region shownRegion ui f w b = modifyMVar (winLayoutInfo w) $ \wli -> do (tos, cur, bos, bufEnd) <- updatePango ui f w b (winLayout wli) return (wli{tos,cur=clampTo tos bos cur,bos,bufEnd}, mkRegion tos bos) where clampTo lo hi x = max lo (min hi x) -- during scrolling, cur might not lie between tos and bos, -- so we clamp it to avoid Pango errors {-| == Note [PangoLayout width] We start rendering the PangoLayout one pixel from the left of the rendering area, which means a few +/-1 offsets in Pango rendering and point lookup code. The reason for this is to support the "wide cursor", which is 2 pixels wide. If we started rendering the PangoLayout directly from the left of the rendering area instead of at a 1-pixel offset, then the "wide cursor" would only be half-displayed when the cursor is at the beginning of the line, and would then be a "thin cursor". An alternative would be to special-case the wide cursor rendering at the beginning of the line, and draw it one pixel to the right of where it "should" be. I haven't tried this out to see how it looks. Reiner -} -- we update the regex and the buffer to avoid holding on to potential garbage. -- These will be overwritten with correct values soon, in -- updateWinInfoForRendering. updatePango :: UI -> FontDescription -> WinInfo -> FBuffer -> PangoLayout -> IO (Point, Point, Point, Point) updatePango ui font w b layout = do (width_', height') <- widgetGetSize $ textview w let width' = max 0 (width_' - 1) -- see Note [PangoLayout width] fontDescriptionToStringT :: FontDescription -> IO Text fontDescriptionToStringT = fontDescriptionToString -- Resize (and possibly copy) the currently used font. curFont <- case fromIntegral <$> configFontSize (uiConfig ui) of 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 if newSize == currentSize then return font else do -- This seems like it would be very expensive but I'm -- justifying it with that it only gets ran once per font -- size change. If the font size stays the same, we only -- enter this once per layout. We're effectivelly copying -- the default font for each layout that changes. An -- alternative would be to assign each buffer its own font -- but that seems a pain to maintain and if the user never -- changes font sizes, it's a waste of memory. nf <- fontDescriptionCopy font fontDescriptionSetSize nf newSize return nf oldFont <- layoutGetFontDescription layout oldFontStr <- maybe (return Nothing) (fmap Just . fontDescriptionToStringT) oldFont newFontStr <- Just <$> fontDescriptionToStringT curFont when (oldFontStr /= newFontStr) $ layoutSetFontDescription layout (Just curFont) win <- readIORef (coreWin w) let [width'', height''] = fmap fromIntegral [width', height'] metrics = winMetrics w lineHeight = ascent metrics + descent metrics charWidth = max (approximateCharWidth metrics) (approximateDigitWidth metrics) winw = max 1 $ floor (width'' / charWidth) winh = max 1 $ floor (height'' / lineHeight) maxChars = winw * winh conf = uiConfig ui (tos, size, point, text) = askBuffer win b $ do from <- use . markPointA =<< fromMark <$> askMarks rope <- streamB Forward from p <- pointB bufEnd <- sizeB let content = takeContent conf maxChars . fst $ R.splitAtLine winh rope -- allow BOS offset to be just after the last line let addNL = if R.countNewLines content == winh then id else (`R.snoc` '\n') return (from, bufEnd, p, R.toText $ addNL content) if configLineWrap conf then wrapToWidth layout WrapAnywhere width'' else do (Rectangle px _py pwidth _pheight, _) <- layoutGetPixelExtents layout widgetSetSizeRequest (textview w) (px+pwidth) (-1) -- optimize for cursor movement oldText <- layoutGetText layout when (oldText /= text) (layoutSetText layout text) (_, bosOffset, _) <- layoutXYToIndex layout width'' (fromIntegral winh * lineHeight - 1) return (tos, point, tos + fromIntegral bosOffset + 1, size) -- | This is a hack that makes this renderer not suck in the common -- case. There are two scenarios: we're line wrapping or we're not -- line wrapping. This function already assumes that the contents -- given have all the possible lines we can fit on the screen. -- -- If we are line wrapping then the most text we'll ever need to -- render is precisely the number of characters that can fit on the -- screen. If that's the case, that's precisely what we do, truncate -- up to the point where the text would be off-screen anyway. -- -- If we aren't line-wrapping then we can't simply truncate at the max -- number of characters: lines might be really long, but considering -- we're not truncating, we should still be able to see every single -- line that can fit on screen up to the screen bound. This suggests -- that we could simply render each line up to the bound. While this -- does work wonders for performance and would work regardless whether -- we're wrapping or not, currently our implementation of the rest of -- the module depends on all characters used being set into the -- layout: if we cut some text off, painting strokes on top or going -- to the end makes for strange effects. So currently we have no -- choice but to render all characters in the visible lines. If you -- have really long lines, this will kill the performance. -- -- So here we implement the hack for the line-wrapping case. Once we -- fix stroke painting &c, this distinction can be removed and we can -- simply snip at the screen boundary whether we're wrapping or not -- which actually results in great performance in the end. Until that -- 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 = if configLineWrap cf then R.take cl t else t -- | Wraps the layout according to the given 'LayoutWrapMode', using -- the specified width. -- -- In contrast to the past, it actually implements wrapping properly -- which was previously broken. wrapToWidth :: PangoLayout -> LayoutWrapMode -> Double -> IO () wrapToWidth l wm w = do layoutGetWrap l >>= \wr -> case (wr, wm) of -- No Eq instance… (WrapWholeWords, WrapWholeWords) -> return () (WrapAnywhere, WrapAnywhere) -> return () (WrapPartialWords, WrapPartialWords) -> return () _ -> layoutSetWrap l wm layoutGetWidth l >>= \case Just x | x == w -> return () _ -> layoutSetWidth l (Just w) reloadProject :: IO () reloadProject = return () mkCol :: Bool -- ^ is foreground? -> Yi.Style.Color -> Gtk.Color mkCol True Default = Color 0 0 0 mkCol False Default = Color maxBound maxBound maxBound mkCol _ (RGB x y z) = Color (fromIntegral x * 256) (fromIntegral y * 256) (fromIntegral z * 256) -- * GTK Event handlers -- | Process GTK keypress if IM fails handleKeypress :: ([Event] -> IO ()) -- ^ Event dispatcher (Yi.Core.dispatch) -> IMContext -> EventM EKey Bool handleKeypress ch im = do gtkMods <- eventModifier gtkKey <- eventKeyVal ifIM <- imContextFilterKeypress im let char = keyToChar gtkKey modsWithShift = M.keys $ M.filter (`elem` gtkMods) modTable mods | isJust char = filter (/= MShift) modsWithShift | otherwise = modsWithShift key = case char of Just c -> Just $ KASCII c Nothing -> M.lookup (keyName gtkKey) keyTable case (ifIM, key) of (True, _ ) -> return () (_, Nothing) -> logPutStrLn $ "Event not translatable: " <> showT key (_, Just k ) -> io $ ch [Event k mods] return True -- | Map Yi modifiers to GTK modTable :: M.Map Modifier EventM.Modifier modTable = M.fromList [ (MShift, EventM.Shift ) , (MCtrl, EventM.Control) , (MMeta, EventM.Alt ) , (MSuper, EventM.Super ) , (MHyper, EventM.Hyper ) ] -- | Same as Gtk.on, but discards the ConnectId on :: object -> Signal object callback -> callback -> IO () on widget signal handler = void $ Gtk.on widget signal handler handleButtonClick :: UI -> WindowRef -> EventM EButton Bool handleButtonClick ui ref = do (x, y) <- eventCoordinates click <- eventClick button <- eventButton io $ do w <- getWinInfo ui ref point <- pointToOffset (x, y) w let focusWindow = focusWindowE ref runAction = uiActionCh ui . makeAction runAction focusWindow win <- io $ readIORef (coreWin w) let selectRegion tu = runAction $ do b <- gets $ bkey . findBufferWith (bufkey win) withGivenBufferAndWindow win b $ moveTo point >> regionOfB tu >>= setSelectRegionB case (click, button) of (SingleClick, LeftButton) -> do io $ writeIORef (lButtonPressed w) True runAction $ do b <- gets $ bkey . findBufferWith (bufkey win) withGivenBufferAndWindow win b $ do m <- selMark <$> askMarks markPointA m .= point moveTo point setVisibleSelection False (DoubleClick, LeftButton) -> selectRegion unitWord (TripleClick, LeftButton) -> selectRegion Line _ -> return () return True handleButtonRelease :: UI -> WinInfo -> EventM EButton Bool handleButtonRelease ui w = do (x, y) <- eventCoordinates button <- eventButton io $ do point <- pointToOffset (x, y) w disp <- widgetGetDisplay $ textview w cb <- clipboardGetForDisplay disp selectionPrimary case button of MiddleButton -> pasteSelectionClipboard ui w point cb LeftButton -> setSelectionClipboard ui w cb >> writeIORef (lButtonPressed w) False _ -> return () return True handleScroll :: UI -> WinInfo -> EventM EScroll Bool handleScroll ui w = do scrollDirection <- eventScrollDirection xy <- eventCoordinates io $ do ifPressed <- readIORef $ lButtonPressed w -- query new coordinates let editorAction = withCurrentBuffer $ scrollB $ case scrollDirection of ScrollUp -> negate configAmount ScrollDown -> configAmount _ -> 0 -- Left/right scrolling not supported configAmount = configScrollWheelAmount $ uiConfig ui uiActionCh ui (EditorA editorAction) when ifPressed $ selectArea ui w xy return True handleConfigure :: UI -> EventM EConfigure Bool handleConfigure ui = do -- trigger a layout -- why does this cause a hang without postGUIAsync? io $ postGUIAsync $ uiActionCh ui (makeAction (return () :: EditorM())) return False -- allow event to be propagated handleMove :: UI -> WinInfo -> EventM EMotion Bool handleMove ui w = eventCoordinates >>= (io . selectArea ui w) >> return True handleDividerMove :: (Action -> IO ()) -> DividerRef -> DividerPosition -> IO () handleDividerMove actionCh ref pos = actionCh (makeAction (setDividerPosE ref pos)) -- | Convert point coordinates to offset in Yi window pointToOffset :: (Double, Double) -> WinInfo -> IO Point pointToOffset (x,y) w = withMVar (winLayoutInfo w) $ \WinLayoutInfo{winLayout,tos,bufEnd} -> do im <- readIORef (insertingMode w) -- see Note [PangoLayout width] (_, charOffsetX, extra) <- layoutXYToIndex winLayout (max 0 (x-1)) y return $ min bufEnd (tos + fromIntegral (charOffsetX + if im then extra else 0)) selectArea :: UI -> WinInfo -> (Double, Double) -> IO () selectArea ui w (x,y) = do p <- pointToOffset (x,y) w let editorAction = do txt <- withCurrentBuffer $ do moveTo p setVisibleSelection True readRegionB =<< getSelectRegionB setRegE txt uiActionCh ui (makeAction editorAction) -- drawWindowGetPointer (textview w) -- be ready for next message. pasteSelectionClipboard :: UI -> WinInfo -> Point -> Clipboard -> IO () pasteSelectionClipboard ui w p cb = do win <- io $ readIORef (coreWin w) let cbHandler :: Maybe R.YiString -> IO () cbHandler Nothing = return () cbHandler (Just txt) = uiActionCh ui $ EditorA $ do b <- gets $ bkey . findBufferWith (bufkey win) withGivenBufferAndWindow win b $ do pointB >>= setSelectionMarkPointB moveTo p insertN txt clipboardRequestText cb (cbHandler . fmap R.fromText) -- | Set selection clipboard contents to current selection setSelectionClipboard :: UI -> WinInfo -> Clipboard -> IO () setSelectionClipboard ui _w cb = do -- Why uiActionCh doesn't allow returning values? selection <- newIORef mempty let yiAction = do txt <- withCurrentBuffer $ fmap R.toText . readRegionB =<< getSelectRegionB :: YiM T.Text io $ writeIORef selection txt uiActionCh ui $ makeAction yiAction txt <- readIORef selection unless (T.null txt) $ clipboardSetText cb txt yi-0.12.6/src/library/Yi/UI/Pango/Control.hs0000644000000000000000000007664112717763531016612 0ustar0000000000000000{-# LANGUAGE RecordWildCards, ScopedTypeVariables, MultiParamTypeClasses , DeriveDataTypeable, OverloadedStrings , GeneralizedNewtypeDeriving, FlexibleContexts #-} -- this module isn't finished, and there's heaps of warnings. {-# OPTIONS_GHC -w #-} -- | -- Module : Yi.UI.Pango.Control -- License : GPL module Yi.UI.Pango.Control ( Control(..) , ControlM(..) , Buffer(..) , View(..) , Iter(..) , startControl , runControl , controlIO , liftYi , getControl , newBuffer , newView , getBuffer , setBufferMode , withCurrentBuffer , setText , getText , keyTable ) where import Data.Text (unpack, pack, Text) import qualified Data.Text as T import Prelude hiding (concatMap, concat, foldl, elem, mapM_) import Control.Exception (catch) import Control.Monad hiding (mapM_, forM_) import Control.Monad.Reader hiding (mapM_, forM_) import Control.Applicative import Control.Lens hiding (views, Action) import Data.Foldable import Data.Maybe (maybe, fromJust, fromMaybe) import Data.Monoid import Data.IORef import Data.List (nub, filter, drop, zip, take, length) import Data.Prototype import Yi.Rope (toText, splitAtLine, YiString) import qualified Yi.Rope as R import qualified Data.Map as Map import Yi.Core (startEditor, focusAllSyntax) import Yi.Buffer import Yi.Config import Yi.Tab import Yi.Window as Yi import Yi.Editor import Yi.Event import Yi.Keymap import Yi.Monad import Yi.Style import Yi.UI.Utils import Yi.Utils import Yi.Debug import Graphics.UI.Gtk as Gtk (Color(..), PangoRectangle(..), Rectangle(..), selectionDataSetText, targetString, clipboardSetWithData, clipboardRequestText, selectionPrimary, clipboardGetForDisplay, widgetGetDisplay, onMotionNotify, drawRectangle, drawLine, layoutIndexToPos, layoutGetCursorPos, drawLayout, widgetGetDrawWindow, layoutSetAttributes, widgetGrabFocus, scrolledWindowSetPolicy, scrolledWindowAddWithViewport, scrolledWindowNew, contextGetMetrics, contextGetLanguage, layoutSetFontDescription, layoutEmpty, widgetCreatePangoContext, widgetModifyBg, drawingAreaNew, FontDescription, ScrolledWindow, FontMetrics, Language, DrawingArea, layoutXYToIndex, layoutSetText, layoutGetText, widgetSetSizeRequest, layoutGetPixelExtents, layoutSetWidth, layoutGetWidth, layoutGetFontDescription, PangoLayout, descent, ascent, widgetGetSize, widgetQueueDraw, mainQuit, signalDisconnect, ConnectId(..), PolicyType(..), StateType(..), EventMask(..), AttrOp(..), Weight(..), PangoAttribute(..), Underline(..), FontStyle(..)) import Graphics.UI.Gtk.Gdk.GC as Gtk (newGCValues, gcSetValues, gcNew, foreground) import qualified Graphics.UI.Gtk as Gtk import qualified Graphics.UI.Gtk.Gdk.Events as Gdk.Events import System.Glib.GError import Control.Monad.Reader (ask, asks, MonadReader(..)) import Control.Monad.State (ap, get, put, modify) import Control.Monad.Base import Control.Concurrent (newMVar, modifyMVar, MVar, newEmptyMVar, putMVar, readMVar, isEmptyMVar) import Data.Typeable import qualified Data.List.PointedList as PL (insertRight, withFocus, PointedList(..), singleton) import Yi.Regex import Yi.String (showT) import System.FilePath import qualified Yi.UI.Common as Common data Control = Control { controlYi :: Yi , tabCache :: IORef [TabInfo] , views :: IORef (Map.Map WindowRef View) } -- { config :: Config -- , editor :: Editor -- , input :: Event -> IO () -- , output :: Action -> IO () -- } data TabInfo = TabInfo { coreTab :: Tab -- , page :: VBox } instance Show TabInfo where show t = show (coreTab t) --type ControlM = YiM newtype ControlM a = ControlM { runControl'' :: ReaderT Control IO a } deriving (Monad, MonadBase IO, MonadReader Control, Typeable, Functor, Applicative) -- Helper functions to avoid issues with mismatching monad libraries controlIO :: IO a -> ControlM a controlIO = liftBase getControl :: ControlM Control getControl = ask liftYi :: YiM a -> ControlM a liftYi m = do yi <- asks controlYi liftBase $ runReaderT (runYiM m) yi --instance MonadState Editor ControlM where -- get = readRef =<< editor <$> ask -- put v = flip modifyRef (const v) =<< editor <$> ask --instance MonadEditor ControlM where -- askCfg = config <$> ask -- withEditor f = do -- r <- asks editor -- cfg <- asks config -- liftBase $ controlUnsafeWithEditor cfg r f startControl :: Config -> ControlM () -> IO () startControl config main = startEditor (config { startFrontEnd = start main } ) Nothing runControl' :: ControlM a -> MVar Control -> IO (Maybe a) runControl' m yiMVar = do empty <- isEmptyMVar yiMVar if empty then return Nothing else do yi <- readMVar yiMVar result <- runControl m yi return $ Just result -- runControl :: ControlM a -> Yi -> IO a -- runControl m yi = runReaderT (runYiM m) yi runControl :: ControlM a -> Control -> IO a runControl f = runReaderT (runControl'' f) -- runControlEditor f yiMVar = yiMVar runAction :: Action -> ControlM () runAction action = do out <- liftYi $ asks yiOutput liftBase $ out MustRefresh [action] -- | Test 2 mkUI :: IO () -> MVar Control -> Common.UI Editor mkUI main yiMVar = Common.dummyUI { Common.main = main , Common.end = \_ -> void $ runControl' end yiMVar , Common.suspend = void $ runControl' suspend yiMVar , Common.refresh = \e -> void $ runControl' (refresh e) yiMVar , Common.layout = \e -> fmap (fromMaybe e) $ runControl' (doLayout e) yiMVar , Common.reloadProject = \f -> void $ runControl' (reloadProject f) yiMVar } start :: ControlM () -> UIBoot start main cfg ch outCh ed = catch (startNoMsg main cfg ch outCh ed) (\(GError _dom _code msg) -> fail $ unpack msg) makeControl :: MVar Control -> YiM () makeControl controlMVar = do controlYi <- ask tabCache <- liftBase $ newIORef [] views <- liftBase $ newIORef Map.empty liftBase $ putMVar controlMVar Control{..} startNoMsg :: ControlM () -> UIBoot startNoMsg main config input output ed = do control <- newEmptyMVar let wrappedMain = do output [makeAction $ makeControl control] void (runControl' main control) return (mkUI wrappedMain control) end :: ControlM () end = do liftBase $ putStrLn "Yi Control End" liftBase mainQuit suspend :: ControlM () suspend = do liftBase $ putStrLn "Yi Control Suspend" return () {-# ANN refresh ("HLint: ignore Redundant do" :: String) #-} refresh :: Editor -> ControlM () refresh e = do --contextId <- statusbarGetContextId (uiStatusbar ui) "global" --statusbarPop (uiStatusbar ui) contextId --statusbarPush (uiStatusbar ui) contextId $ intercalate " " $ statusLine e updateCache e -- The cursor may have changed since doLayout viewsRef <- asks views vs <- liftBase $ readIORef viewsRef forM_ (Map.elems vs) $ \v -> do let b = findBufferWith (viewFBufRef v) e -- when (not $ null $ b ^. pendingUpdatesA) $ do -- sig <- readIORef (renderer w) -- signalDisconnect sig -- writeRef (renderer w) -- =<< (textview w `onExpose` render e ui b (wkey (coreWin w))) liftBase $ widgetQueueDraw (drawArea v) doLayout :: Editor -> ControlM Editor doLayout e = do liftBase $ putStrLn "Yi Control Do Layout" updateCache e cacheRef <- asks tabCache tabs <- liftBase $ readIORef cacheRef dims <- concat <$> mapM (getDimensionsInTab e) tabs let e' = (tabsA %~ fmap (mapWindows updateWin)) e updateWin w = case find (\(ref,_,_,_) -> (wkey w == ref)) dims of Nothing -> w Just (_, wi, h,rgn) -> w { width = wi , height = h , winRegion = rgn } -- Don't leak references to old Windows let forceWin x w = height w `seq` winRegion w `seq` x return $ (foldl . tabFoldl) forceWin e' (e' ^. tabsA) -- | Width, Height getDimensionsInTab :: Editor -> TabInfo -> ControlM [(WindowRef,Int,Int,Region)] getDimensionsInTab e tab = do viewsRef <- asks views vs <- liftBase $ readIORef viewsRef foldlM (\a w -> case Map.lookup (wkey w) vs of Just v -> do (wi, h) <- liftBase $ widgetGetSize $ drawArea v let lineHeight = ascent (metrics v) + descent (metrics v) charWidth = Gtk.approximateCharWidth $ metrics v b0 = findBufferWith (viewFBufRef v) e rgn <- shownRegion e v b0 let ret= (windowRef v, round $ fromIntegral wi / charWidth, round $ fromIntegral h / lineHeight, rgn) return $ a <> [ret] Nothing -> return a) [] (coreTab tab ^. tabWindowsA) shownRegion :: Editor -> View -> FBuffer -> ControlM Region shownRegion e v b = do (tos, _, bos) <- updatePango e v b (layout v) return $ mkRegion tos bos updatePango :: Editor -> View -> FBuffer -> PangoLayout -> ControlM (Point, Point, Point) updatePango e v b layout = do (width', height') <- liftBase $ widgetGetSize $ drawArea v font <- liftBase $ layoutGetFontDescription layout --oldFont <- layoutGetFontDescription layout --oldFontStr <- maybe (return Nothing) -- (fmap Just . fontDescriptionToString) oldFont --newFontStr <- Just <$> fontDescriptionToString font --when (oldFontStr /= newFontStr) -- (layoutSetFontDescription layout (Just font)) let win = findWindowWith (windowRef v) e [width'', height''] = map fromIntegral [width', height'] lineHeight = ascent (metrics v) + descent (metrics v) winh = max 1 $ floor (height'' / lineHeight) (tos, point, text) = askBuffer win b $ do from <- (use . markPointA) =<< fromMark <$> askMarks rope <- streamB Forward from p <- pointB let content = fst $ splitAtLine winh rope -- allow BOS offset to be just after the last line let addNL = if R.countNewLines content == winh then id else (`R.snoc` '\n') return (from, p, R.toText $ addNL content) config <- liftYi askCfg if configLineWrap $ configUI config then do oldWidth <- liftBase $ layoutGetWidth layout when (oldWidth /= Just width'') $ liftBase $ layoutSetWidth layout $ Just width'' else do (Rectangle px _py pwidth _pheight, _) <- liftBase $ layoutGetPixelExtents layout liftBase $ widgetSetSizeRequest (drawArea v) (px+pwidth) (-1) -- optimize for cursor movement oldText <- liftBase $ layoutGetText layout when (oldText /= text) $ liftBase $ layoutSetText layout text (_, bosOffset, _) <- liftBase $ layoutXYToIndex layout width'' (fromIntegral winh * lineHeight - 1) return (tos, point, tos + fromIntegral bosOffset + 1) updateCache :: Editor -> ControlM () updateCache e = do let tabs = e ^. tabsA cacheRef <- asks tabCache cache <- liftBase $ readIORef cacheRef cache' <- syncTabs e (toList $ PL.withFocus tabs) cache liftBase $ writeIORef cacheRef cache' syncTabs :: Editor -> [(Tab, Bool)] -> [TabInfo] -> ControlM [TabInfo] syncTabs e (tfocused@(t,focused):ts) (c:cs) | t == coreTab c = do when focused $ setTabFocus c -- let vCache = views c (:) <$> syncTab e c t <*> syncTabs e ts cs | t `elem` map coreTab cs = do removeTab c syncTabs e (tfocused:ts) cs | otherwise = do c' <- insertTabBefore e t c when focused $ setTabFocus c' return (c':) `ap` syncTabs e ts (c:cs) syncTabs e ts [] = mapM (\(t,focused) -> do c' <- insertTab e t when focused $ setTabFocus c' return c') ts syncTabs _ [] cs = mapM_ removeTab cs >> return [] syncTab :: Editor -> TabInfo -> Tab -> ControlM TabInfo syncTab e tab ws = -- TODO Maybe do something here return tab setTabFocus :: TabInfo -> ControlM () setTabFocus t = -- TODO this needs to set the tab focus with callback -- but only if the tab focus has changed return () askBuffer :: Yi.Window -> FBuffer -> BufferM a -> a askBuffer w b f = fst $ runBuffer w b f setWindowFocus :: Editor -> TabInfo -> View -> ControlM () setWindowFocus e t v = do let bufferName = shortIdentString (length $ commonNamePrefix e) $ findBufferWith (viewFBufRef v) e window = findWindowWith (windowRef v) e ml = askBuffer window (findBufferWith (viewFBufRef v) e) $ getModeLine (T.pack <$> commonNamePrefix e) -- TODO -- update (textview w) widgetIsFocus True -- update (modeline w) labelText ml -- update (uiWindow ui) windowTitle $ bufferName <> " - Yi" -- update (uiNotebook ui) (notebookChildTabLabel (page t)) -- (tabAbbrevTitle bufferName) return () removeTab :: TabInfo -> ControlM () removeTab t = -- TODO this needs to close the views in the tab with callback return () removeView :: TabInfo -> View -> ControlM () removeView tab view = -- TODO this needs to close the view with callback return () -- | Make a new tab. newTab :: Editor -> Tab -> ControlM TabInfo newTab e ws = do let t' = TabInfo { coreTab = ws } -- cache <- syncWindows e t' (toList $ PL.withFocus ws) [] return t' -- { views = cache } {-# ANN insertTabBefore ("HLint: ignore Redundant do" :: String) #-} insertTabBefore :: Editor -> Tab -> TabInfo -> ControlM TabInfo insertTabBefore e ws c = do -- Just p <- notebookPageNum (uiNotebook ui) (page c) -- vb <- vBoxNew False 1 -- notebookInsertPage (uiNotebook ui) vb "" p -- widgetShowAll $ vb newTab e ws {-# ANN insertTab ("HLint: ignore Redundant do" :: String) #-} insertTab :: Editor -> Tab -> ControlM TabInfo insertTab e ws = do -- vb <- vBoxNew False 1 -- notebookAppendPage (uiNotebook ui) vb "" -- widgetShowAll $ vb newTab e ws {- insertWindowBefore :: Editor -> TabInfo -> Yi.Window -> WinInfo -> IO WinInfo insertWindowBefore e ui tab w _c = insertWindow e ui tab w insertWindowAtEnd :: Editor -> UI -> TabInfo -> Window -> IO WinInfo insertWindowAtEnd e ui tab w = insertWindow e ui tab w insertWindow :: Editor -> UI -> TabInfo -> Window -> IO WinInfo insertWindow e ui tab win = do let buf = findBufferWith (bufkey win) e liftBase $ do w <- newWindow e ui win buf set (page tab) $ [ containerChild := widget w , boxChildPacking (widget w) := if isMini (coreWin w) then PackNatural else PackGrow ] let ref = (wkey . coreWin) w textview w `onButtonRelease` handleClick ui ref textview w `onButtonPress` handleClick ui ref textview w `onScroll` handleScroll ui ref textview w `onConfigure` handleConfigure ui ref widgetShowAll (widget w) return w -} reloadProject :: FilePath -> ControlM () reloadProject _ = return () controlUnsafeWithEditor :: Config -> MVar Editor -> EditorM a -> IO a controlUnsafeWithEditor cfg r f = modifyMVar r $ \e -> do let (e',a) = runEditor cfg f e -- Make sure that the result of runEditor is evaluated before -- replacing the editor state. Otherwise, we might replace e -- with an exception-producing thunk, which makes it impossible -- to look at or update the editor state. -- Maybe this could also be fixed by -fno-state-hack flag? -- TODO: can we simplify this? e' `seq` a `seq` return (e', a) data Buffer = Buffer { fBufRef :: BufferRef } data View = View { viewFBufRef :: BufferRef , windowRef :: WindowRef , drawArea :: DrawingArea , layout :: PangoLayout , language :: Language , metrics :: FontMetrics , scrollWin :: ScrolledWindow , shownTos :: IORef Point , winMotionSignal :: IORef (Maybe (ConnectId DrawingArea)) } data Iter = Iter { iterFBufRef :: BufferRef , point :: Point } newBuffer :: BufferId -> R.YiString -> ControlM Buffer newBuffer id text = do fBufRef <- liftYi . withEditor . newBufferE id $ text return Buffer{..} newView :: Buffer -> FontDescription -> ControlM View newView buffer font = do control <- ask config <- liftYi askCfg let viewFBufRef = fBufRef buffer newWindow <- fmap (\w -> w { height=50 , winRegion = mkRegion (Point 0) (Point 2000) }) $ liftYi $ withEditor $ newWindowE False viewFBufRef let windowRef = wkey newWindow liftYi $ withEditor $ do windowsA %= PL.insertRight newWindow e <- get put $ focusAllSyntax e drawArea <- liftBase drawingAreaNew liftBase . widgetModifyBg drawArea StateNormal . mkCol False . Yi.Style.background . baseAttributes . configStyle $ configUI config context <- liftBase $ widgetCreatePangoContext drawArea layout <- liftBase $ layoutEmpty context liftBase $ layoutSetFontDescription layout (Just font) language <- liftBase $ contextGetLanguage context metrics <- liftBase $ contextGetMetrics context font language liftBase $ layoutSetText layout ("" :: Text) scrollWin <- liftBase $ scrolledWindowNew Nothing Nothing liftBase $ do scrolledWindowAddWithViewport scrollWin drawArea scrolledWindowSetPolicy scrollWin PolicyAutomatic PolicyNever initialTos <- liftYi . withEditor . withGivenBufferAndWindow newWindow viewFBufRef $ (use . markPointA) =<< fromMark <$> askMarks shownTos <- liftBase $ newIORef initialTos winMotionSignal <- liftBase $ newIORef Nothing let view = View {..} liftBase $ Gtk.widgetAddEvents drawArea [KeyPressMask] liftBase $ Gtk.set drawArea [Gtk.widgetCanFocus := True] liftBase $ drawArea `Gtk.onKeyPress` \event -> do putStrLn $ "Yi Control Key Press = " <> show event runControl (runAction $ makeAction $ do focusWindowE windowRef switchToBufferE viewFBufRef) control result <- processEvent (yiInput $ controlYi control) event widgetQueueDraw drawArea return result liftBase $ drawArea `Gtk.onButtonPress` \event -> do widgetGrabFocus drawArea runControl (handleClick view event) control liftBase $ drawArea `Gtk.onButtonRelease` \event -> runControl (handleClick view event) control liftBase $ drawArea `Gtk.onScroll` \event -> runControl (handleScroll view event) control liftBase $ drawArea `Gtk.onExpose` \event -> do (text, allAttrs, debug, tos, rel, point, inserting) <- runControl (liftYi $ withEditor $ do window <- findWindowWith windowRef <$> get (%=) buffersA (fmap (clearSyntax . clearHighlight)) let winh = height window let tos = max 0 (regionStart (winRegion window)) let bos = regionEnd (winRegion window) let rel p = fromIntegral (p - tos) withGivenBufferAndWindow window viewFBufRef $ do -- tos <- getMarkPointB =<< fromMark <$> askMarks rope <- streamB Forward tos point <- pointB inserting <- use insertingA modeNm <- gets (withMode0 modeName) -- let (tos, point, text, picture) = do runBu -- from <- getMarkPointB =<< fromMark <$> askMarks -- rope <- streamB Forward from -- p <- pointB let content = fst $ splitAtLine winh rope -- allow BOS offset to be just after the last line let addNL = if R.countNewLines content == winh then id else (`R.snoc` '\n') sty = configStyle $ configUI config -- attributesPictureAndSelB sty (currentRegex e) -- (mkRegion tos bos) -- return (from, p, addNL $ Rope.toString content, -- picture) let text = R.toText $ addNL content picture <- attributesPictureAndSelB sty Nothing (mkRegion tos bos) -- add color attributes. let picZip = zip picture $ drop 1 (fst <$> picture) <> [bos] strokes = [ (start',s,end') | ((start', s), end') <- picZip , s /= emptyAttributes ] rel p = fromIntegral (p - tos) allAttrs = concat $ do (p1, Attributes fg bg _rv bd itlc udrl, p2) <- strokes let atr x = x (rel p1) (rel p2) if' p x y = if p then x else y return [ atr AttrForeground $ mkCol True fg , atr AttrBackground $ mkCol False bg , atr AttrStyle $ if' itlc StyleItalic StyleNormal , atr AttrUnderline $ if' udrl UnderlineSingle UnderlineNone , atr AttrWeight $ if' bd WeightBold WeightNormal ] return (text, allAttrs, (picture, strokes, modeNm, window, tos, bos, winh), tos, rel, point, inserting)) control -- putStrLn $ "Setting Layout Attributes " <> show debug layoutSetAttributes layout allAttrs -- putStrLn "Done Stting Layout Attributes" dw <- widgetGetDrawWindow drawArea gc <- gcNew dw oldText <- layoutGetText layout when (text /= oldText) $ layoutSetText layout text drawLayout dw gc 0 0 layout liftBase $ writeIORef shownTos tos -- paint the cursor (PangoRectangle curx cury curw curh, _) <- layoutGetCursorPos layout (rel point) PangoRectangle chx chy chw chh <- layoutIndexToPos layout (rel point) gcSetValues gc (newGCValues { Gtk.foreground = mkCol True . Yi.Style.foreground . baseAttributes . configStyle $ configUI config }) if inserting then drawLine dw gc (round curx, round cury) (round $ curx + curw, round $ cury + curh) else drawRectangle dw gc False (round chx) (round chy) (if chw > 0 then round chw else 8) (round chh) return True liftBase $ widgetGrabFocus drawArea tabsRef <- asks tabCache ts <- liftBase $ readIORef tabsRef -- TODO: the Tab idkey should be assigned using -- Yi.Editor.newRef. But we can't modify that here, since our -- access to 'Yi' is readonly. liftBase $ writeIORef tabsRef (TabInfo (makeTab1 0 newWindow):ts) viewsRef <- asks views vs <- liftBase $ readIORef viewsRef liftBase $ writeIORef viewsRef $ Map.insert windowRef view vs return view where clearHighlight fb = -- if there were updates, then hide the selection. let h = view highlightSelectionA fb us = view pendingUpdatesA fb in highlightSelectionA .~ (h && null us) $ fb {-# ANN setBufferMode ("HLint: ignore Redundant do" :: String) #-} setBufferMode :: FilePath -> Buffer -> ControlM () setBufferMode f buffer = do let bufRef = fBufRef buffer -- adjust the mode tbl <- liftYi $ asks (modeTable . yiConfig) contents <- liftYi $ withGivenBuffer bufRef elemsB let header = R.toString $ R.take 1024 contents hmode = case header =~ ("\\-\\*\\- *([^ ]*) *\\-\\*\\-" :: String) of AllTextSubmatches [_,m] -> T.pack m _ -> "" Just mode = find (\(AnyMode m)-> modeName m == hmode) tbl <|> find (\(AnyMode m)-> modeApplies m f contents) tbl <|> Just (AnyMode emptyMode) case mode of AnyMode newMode -> do -- liftBase $ putStrLn $ show (f, modeName newMode) liftYi $ withEditor $ do withGivenBuffer bufRef $ do setMode newMode modify clearSyntax switchToBufferE bufRef -- withEditor focusAllSyntax withBuffer :: Buffer -> BufferM a -> ControlM a withBuffer Buffer{fBufRef = b} f = liftYi $ withGivenBuffer b f getBuffer :: View -> Buffer getBuffer view = Buffer {fBufRef = viewFBufRef view} setText :: Buffer -> YiString -> ControlM () setText b text = withBuffer b $ do r <- regionOfB Document replaceRegionB r text getText :: Buffer -> Iter -> Iter -> ControlM Text getText b Iter{point = p1} Iter{point = p2} = fmap toText . withBuffer b . readRegionB $ mkRegion p1 p2 mkCol :: Bool -- ^ is foreground? -> Yi.Style.Color -> Gtk.Color mkCol True Default = Color 0 0 0 mkCol False Default = Color maxBound maxBound maxBound mkCol _ (RGB x y z) = Color (fromIntegral x * 256) (fromIntegral y * 256) (fromIntegral z * 256) handleClick :: View -> Gdk.Events.Event -> ControlM Bool handleClick view event = do control <- ask -- (_tabIdx,winIdx,w) <- getWinInfo ref <$> readIORef (tabCache ui) logPutStrLn $ "Click: " <> showT (Gdk.Events.eventX event, Gdk.Events.eventY event, Gdk.Events.eventClick event) -- retrieve the clicked offset. (_,layoutIndex,_) <- io $ layoutXYToIndex (layout view) (Gdk.Events.eventX event) (Gdk.Events.eventY event) tos <- liftBase $ readIORef (shownTos view) let p1 = tos + fromIntegral layoutIndex let winRef = windowRef view -- maybe focus the window -- logPutStrLn $ "Clicked inside window: " <> show view -- let focusWindow = do -- TODO: check that tabIdx is the focus? -- (%=) windowsA (fromJust . PL.move winIdx) liftBase $ case (Gdk.Events.eventClick event, Gdk.Events.eventButton event) of (Gdk.Events.SingleClick, Gdk.Events.LeftButton) -> do cid <- onMotionNotify (drawArea view) False $ \event -> runControl (handleMove view p1 event) control writeIORef (winMotionSignal view) $ Just cid _ -> do maybe (return ()) signalDisconnect =<< readIORef (winMotionSignal view) writeIORef (winMotionSignal view) Nothing case (Gdk.Events.eventClick event, Gdk.Events.eventButton event) of (Gdk.Events.SingleClick, Gdk.Events.LeftButton) -> runAction . EditorA $ do -- b <- gets $ (bkey . findBufferWith (viewFBufRef view)) -- focusWindow window <- findWindowWith winRef <$> get withGivenBufferAndWindow window (viewFBufRef view) $ do moveTo p1 setVisibleSelection False -- (Gdk.Events.SingleClick, _) -> runAction focusWindow (Gdk.Events.ReleaseClick, Gdk.Events.MiddleButton) -> do disp <- liftBase $ widgetGetDisplay (drawArea view) cb <- liftBase $ clipboardGetForDisplay disp selectionPrimary let cbHandler :: Maybe R.YiString -> IO () cbHandler Nothing = return () cbHandler (Just txt) = runControl (runAction . EditorA $ do window <- findWindowWith winRef <$> get withGivenBufferAndWindow window (viewFBufRef view) $ do pointB >>= setSelectionMarkPointB moveTo p1 insertN txt) control liftBase $ clipboardRequestText cb (cbHandler . fmap R.fromText) _ -> return () liftBase $ widgetQueueDraw (drawArea view) return True handleScroll :: View -> Gdk.Events.Event -> ControlM Bool handleScroll view event = do let editorAction = withCurrentBuffer $ vimScrollB $ case Gdk.Events.eventDirection event of Gdk.Events.ScrollUp -> -1 Gdk.Events.ScrollDown -> 1 _ -> 0 -- Left/right scrolling not supported runAction $ EditorA editorAction liftBase $ widgetQueueDraw (drawArea view) return True handleMove :: View -> Point -> Gdk.Events.Event -> ControlM Bool handleMove view p0 event = do logPutStrLn $ "Motion: " <> showT (Gdk.Events.eventX event, Gdk.Events.eventY event) -- retrieve the clicked offset. (_,layoutIndex,_) <- liftBase $ layoutXYToIndex (layout view) (Gdk.Events.eventX event) (Gdk.Events.eventY event) tos <- liftBase $ readIORef (shownTos view) let p1 = tos + fromIntegral layoutIndex let editorAction = do txt <- withCurrentBuffer $ if p0 /= p1 then Just <$> do m <- selMark <$> askMarks markPointA m .= p0 moveTo p1 setVisibleSelection True readRegionB =<< getSelectRegionB else return Nothing maybe (return ()) setRegE txt runAction $ makeAction editorAction -- drawWindowGetPointer (textview w) -- be ready for next message. -- Relies on uiActionCh being synchronous selection <- liftBase $ newIORef "" let yiAction = do txt <- withCurrentBuffer (readRegionB =<< getSelectRegionB) :: YiM R.YiString liftBase $ writeIORef selection txt runAction $ makeAction yiAction txt <- liftBase $ readIORef selection disp <- liftBase $ widgetGetDisplay (drawArea view) cb <- liftBase $ clipboardGetForDisplay disp selectionPrimary liftBase $ clipboardSetWithData cb [(targetString,0)] (\0 -> void (selectionDataSetText $ R.toText txt)) (return ()) liftBase $ widgetQueueDraw (drawArea view) return True processEvent :: ([Event] -> IO ()) -> Gdk.Events.Event -> IO Bool processEvent ch ev = do -- logPutStrLn $ "Gtk.Event: " <> show ev -- logPutStrLn $ "Event: " <> show (gtkToYiEvent ev) case gtkToYiEvent ev of Nothing -> logPutStrLn $ "Event not translatable: " <> showT ev Just e -> ch [e] return True gtkToYiEvent :: Gdk.Events.Event -> Maybe Event gtkToYiEvent (Gdk.Events.Key {Gdk.Events.eventKeyName = key , Gdk.Events.eventModifier = evModifier , Gdk.Events.eventKeyChar = char}) = (\k -> Event k $ nub $ notMShift $ concatMap modif evModifier) <$> key' where (key',isShift) = case char of 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 _ = [] notMShift | isShift = filter (/= MShift) | otherwise = id gtkToYiEvent _ = Nothing -- | Map GTK long names to Keys keyTable :: Map.Map Text Key keyTable = Map.fromList [("Down", KDown) ,("Up", KUp) ,("Left", KLeft) ,("Right", KRight) ,("Home", KHome) ,("End", KEnd) ,("BackSpace", KBS) ,("Delete", KDel) ,("Page_Up", KPageUp) ,("Page_Down", KPageDown) ,("Insert", KIns) ,("Escape", KEsc) ,("Return", KEnter) ,("Tab", KTab) ,("ISO_Left_Tab", KTab) ] yi-0.12.6/src/library/Yi/UI/Vty.hs0000644000000000000000000004045512725740550014675 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE OverloadedStrings #-} -- | -- Module : Yi.UI.Vty -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- This module defines a user interface implemented using vty. -- -- Originally derived from: riot/UI.hs Copyright (c) Tuomo Valkonen 2004. module Yi.UI.Vty ( start ) where import Prelude hiding (concatMap, error, reverse) import Control.Applicative (Applicative ((<*>)), (<$>)) import Control.Concurrent (MVar, forkIO, myThreadId, newEmptyMVar, takeMVar, tryPutMVar, tryTakeMVar) import Control.Concurrent.STM (atomically, isEmptyTChan, readTChan) import Control.Exception (IOException, handle) import Control.Lens (use) import Control.Monad (void, when) import Data.Char (chr, ord) import qualified Data.DList as D (empty, snoc, toList) import Data.Foldable (concatMap, toList) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import qualified Data.List.PointedList.Circular as PL (PointedList (_focus), withFocus) import qualified Data.Map.Strict as M ((!)) import Data.Maybe (maybeToList) import Data.Monoid (Endo (appEndo), (<>)) import qualified Data.Text as T (Text, cons, empty, justifyLeft, length, pack, singleton, snoc, take, unpack) import GHC.Conc (labelThread) import qualified Graphics.Vty as Vty (Attr, Cursor (Cursor, NoCursor), Event (EvResize), Image, Input (_eventChannel), Output (displayBounds), Picture (picCursor), Vty (inputIface, outputIface, refresh, shutdown, update), bold, char, charFill, defAttr, emptyImage, horizCat, mkVty, picForLayers, reverseVideo, text', translate, underline, vertCat, withBackColor, withForeColor, withStyle, (<|>)) import Yi.Buffer import Yi.Config import Yi.Debug (logError, logPutStrLn) import Yi.Editor import Yi.Event (Event) import Yi.Style import qualified Yi.UI.Common as Common import qualified Yi.UI.SimpleLayout as SL import Yi.Layout (HasNeighborWest) import Yi.UI.TabBar (TabDescr (TabDescr), tabBarDescr) import Yi.UI.Utils (arrangeItems, attributesPictureAndSelB) import Yi.UI.Vty.Conversions (colorToAttr, fromVtyEvent) import Yi.Window (Window (bufkey, isMini, wkey)) data Rendered = Rendered { picture :: !Vty.Image , cursor :: !(Maybe (Int,Int)) } data FrontendState = FrontendState { fsVty :: Vty.Vty , fsConfig :: Config , fsEndMain :: MVar () , fsEndInputLoop :: MVar () , fsEndRenderLoop :: MVar () , fsDirty :: MVar () , fsEditorRef :: IORef Editor } start :: UIBoot start config submitEvents submitActions editor = do vty <- (Vty.mkVty . configVty . configUI) config let inputChan = Vty._eventChannel (Vty.inputIface vty) endInput <- newEmptyMVar endMain <- newEmptyMVar endRender <- newEmptyMVar dirty <- newEmptyMVar editorRef <- newIORef editor let -- | Action to read characters into a channel inputLoop :: IO () inputLoop = tryTakeMVar endInput >>= maybe (do let go evs = do e <- getEvent done <- atomically (isEmptyTChan inputChan) if done then submitEvents (D.toList (evs `D.snoc` e)) else go (evs `D.snoc` e) go D.empty inputLoop) (const $ return ()) -- | Read a key. UIs need to define a method for getting events. getEvent :: IO Yi.Event.Event getEvent = do event <- atomically (readTChan inputChan) case event of (Vty.EvResize _ _) -> do submitActions [] getEvent _ -> return (fromVtyEvent event) renderLoop :: IO () renderLoop = do takeMVar dirty tryTakeMVar endRender >>= maybe (handle (\(except :: IOException) -> do logPutStrLn "refresh crashed with IO Error" logError (T.pack (show except))) (readIORef editorRef >>= refresh fs >> renderLoop)) (const $ return ()) fs = FrontendState vty config endMain endInput endRender dirty editorRef inputThreadId <- forkIO inputLoop labelThread inputThreadId "VtyInput" renderThreadId <- forkIO renderLoop labelThread renderThreadId "VtyRender" return $! Common.dummyUI { Common.main = main fs , Common.end = end fs , Common.refresh = requestRefresh fs , Common.userForceRefresh = Vty.refresh vty , Common.layout = layout fs } main :: FrontendState -> IO () main fs = do tid <- myThreadId labelThread tid "VtyMain" takeMVar (fsEndMain fs) layout :: FrontendState -> Editor -> IO Editor layout fs e = do (colCount, rowCount) <- Vty.displayBounds (Vty.outputIface (fsVty fs)) let (e', _layout) = SL.layout colCount rowCount e return e' end :: FrontendState -> Bool -> IO () end fs mustQuit = do -- setTerminalAttributes stdInput (oAttrs ui) Immediately void $ tryPutMVar (fsEndInputLoop fs) () void $ tryPutMVar (fsEndRenderLoop fs) () Vty.shutdown (fsVty fs) when mustQuit $ void (tryPutMVar (fsEndMain fs) ()) requestRefresh :: FrontendState -> Editor -> IO () requestRefresh fs e = do writeIORef (fsEditorRef fs) e void $ tryPutMVar (fsDirty fs) () refresh :: FrontendState -> Editor -> IO () refresh fs e = do (colCount, rowCount) <- Vty.displayBounds (Vty.outputIface (fsVty fs)) let (_e, SL.Layout tabbarRect winRects promptRect) = SL.layout colCount rowCount e ws = windows e (cmd, cmdSty) = statusLineInfo e niceCmd = arrangeItems cmd (SL.sizeX promptRect) (maxStatusHeight e) mkLine = T.justifyLeft colCount ' ' . T.take colCount formatCmdLine text = withAttributes statusBarStyle (mkLine text) winImage (win, hasFocus) = let (rect, nb) = winRects M.! wkey win in renderWindow (configUI $ fsConfig fs) e rect nb (win, hasFocus) windowsAndImages = fmap (\(w, f) -> (w, winImage (w, f))) (PL.withFocus ws) bigImages = map (picture . snd) (filter (not . isMini . fst) (toList windowsAndImages)) miniImages = map (picture . snd) (filter (isMini . fst) (toList windowsAndImages)) statusBarStyle = ((appEndo <$> cmdSty) <*> baseAttributes) (configStyle (configUI (fsConfig fs))) tabBarImage = renderTabBar tabbarRect (configStyle (configUI (fsConfig fs))) (map (\(TabDescr t f) -> (t, f)) (toList (tabBarDescr e))) cmdImage = if null cmd then Vty.emptyImage else Vty.translate (SL.offsetX promptRect) (SL.offsetY promptRect) (Vty.vertCat (fmap formatCmdLine niceCmd)) cursorPos = let (w, image) = PL._focus windowsAndImages in case (isMini w, cursor image) of (False, Just (y, x)) -> Vty.Cursor (toEnum x) (toEnum y) (True, Just (_, x)) -> Vty.Cursor (toEnum x) (toEnum (rowCount - 1)) (_, Nothing) -> Vty.NoCursor logPutStrLn "refreshing screen." Vty.update (fsVty fs) (Vty.picForLayers ([tabBarImage, cmdImage] ++ bigImages ++ miniImages)) { Vty.picCursor = cursorPos } renderWindow :: UIConfig -> Editor -> SL.Rect -> HasNeighborWest -> (Window, Bool) -> Rendered renderWindow cfg e (SL.Rect x y w h) nb (win, focused) = Rendered (Vty.translate x y $ if nb then vertSep Vty.<|> pict else pict) (fmap (\(i, j) -> (i + y, j + x')) cur) where x' = x + if nb then 1 else 0 w' = w - if nb then 1 else 0 b = findBufferWith (bufkey win) e sty = configStyle cfg notMini = not (isMini win) -- off reserves space for the mode line. The mini window does not have a mode line. off = if notMini then 1 else 0 h' = h - off ground = baseAttributes sty wsty = attributesToAttr ground Vty.defAttr eofsty = appEndo (eofStyle sty) ground (point, _) = runBuffer win b pointB region = mkSizeRegion fromMarkPoint $ Size (w' * h') -- Work around a problem with the mini window never displaying it's contents due to a -- fromMark that is always equal to the end of the buffer contents. (Just (MarkSet fromM _ _), _) = runBuffer win b (getMarks win) fromMarkPoint = if notMini then fst $ runBuffer win b $ use $ markPointA fromM else Point 0 (text, _) = runBuffer win b (indexedStreamB Forward fromMarkPoint) (attributes, _) = runBuffer win b $ attributesPictureAndSelB sty (currentRegex e) region -- TODO: I suspect that this costs quite a lot of CPU in the "dry run" which determines the window size; -- In that case, since attributes are also useless there, it might help to replace the call by a dummy value. -- This is also approximately valid of the call to "indexedAnnotatedStreamB". colors = map (fmap (($ Vty.defAttr) . attributesToAttr)) attributes bufData = paintChars Vty.defAttr colors text tabWidth = tabSize . fst $ runBuffer win b indentSettingsB prompt = if isMini win then miniIdentString b else "" cur = (fmap (\(SL.Point2D curx cury) -> (cury, T.length prompt + curx)) . fst) (runBuffer win b (SL.coordsOfCharacterB (SL.Size2D w' h) fromMarkPoint point)) rendered = drawText wsty h' w' tabWidth ([(c, wsty) | c <- T.unpack prompt] ++ bufData ++ [(' ', wsty)]) -- we always add one character which can be used to position the cursor at the end of file commonPref = T.pack <$> commonNamePrefix e (modeLine0, _) = runBuffer win b $ getModeLine commonPref modeLine = if notMini then Just modeLine0 else Nothing prepare = withAttributes modeStyle . T.justifyLeft w' ' ' . T.take w' modeLines = map prepare $ maybeToList modeLine modeStyle = (if focused then appEndo (modelineFocusStyle sty) else id) (modelineAttributes sty) filler :: T.Text filler = if w' == 0 -- justify would return a single char at w = 0 then T.empty else T.justifyLeft w' ' ' $ T.singleton (configWindowFill cfg) pict = Vty.vertCat $ take h' (rendered <> repeat (withAttributes eofsty filler)) <> modeLines sepStyle = attributesToAttr (modelineAttributes sty) Vty.defAttr vertSep = Vty.charFill sepStyle ' ' 1 h withAttributes :: Attributes -> T.Text -> Vty.Image withAttributes sty = Vty.text' (attributesToAttr sty Vty.defAttr) attributesToAttr :: Attributes -> Vty.Attr -> Vty.Attr attributesToAttr (Attributes fg bg reverse bd _itlc underline') = (if reverse then (`Vty.withStyle` Vty.reverseVideo) else id) . (if bd then (`Vty.withStyle` Vty.bold) else id) . (if underline' then (`Vty.withStyle` Vty.underline) else id) . colorToAttr (flip Vty.withForeColor) fg . colorToAttr (flip Vty.withBackColor) bg -- | Apply the attributes in @sty@ and @changes@ to @cs@. If the -- attributes are not used, @sty@ and @changes@ are not evaluated. paintChars :: a -> [(Point, a)] -> [(Point, Char)] -> [(Char, a)] paintChars sty changes cs = zip (fmap snd cs) attrs where attrs = stys sty changes cs stys :: a -> [(Point, a)] -> [(Point, Char)] -> [a] stys sty [] cs = [ sty | _ <- cs ] stys sty ((endPos, sty') : xs) cs = [ sty | _ <- previous ] <> stys sty' xs later where (previous, later) = break ((endPos <=) . fst) cs drawText :: Vty.Attr -- ^ "Ground" attribute. -> Int -- ^ The height of the part of the window we are in -> Int -- ^ The width of the part of the window we are in -> Int -- ^ The number of spaces to represent a tab character with. -> [(Char, Vty.Attr)] -- ^ The data to draw. -> [Vty.Image] drawText wsty h w tabWidth bufData | h == 0 || w == 0 = [] | otherwise = renderedLines where -- the number of lines that taking wrapping into account, -- we use this to calculate the number of lines displayed. wrapped = concatMap (wrapLine w . addSpace . concatMap expandGraphic) $ take h $ lines' bufData lns0 = take h wrapped -- fill lines with blanks, so the selection looks ok. renderedLines = map fillColorLine lns0 colorChar (c, a) = Vty.char a c fillColorLine :: [(Char, Vty.Attr)] -> Vty.Image fillColorLine [] = Vty.charFill Vty.defAttr ' ' w 1 fillColorLine l = Vty.horizCat (map colorChar l) Vty.<|> Vty.charFill a ' ' (w - length l) 1 where (_, a) = last l addSpace :: [(Char, Vty.Attr)] -> [(Char, Vty.Attr)] addSpace [] = [(' ', wsty)] addSpace l = case mod lineLength w of 0 -> l _ -> l ++ [(' ', wsty)] where lineLength = length l -- | Cut a string in lines separated by a '\n' char. Note -- that we remove the newline entirely since it is no longer -- significant for drawing text. lines' :: [(Char, a)] -> [[(Char, a)]] lines' [] = [] lines' s = case s' of [] -> [l] ((_,_):s'') -> l : lines' s'' where (l, s') = break ((== '\n') . fst) s wrapLine :: Int -> [x] -> [[x]] wrapLine _ [] = [] wrapLine n l = let (x,rest) = splitAt n l in x : wrapLine n rest expandGraphic ('\t', p) = replicate tabWidth (' ', p) expandGraphic (c, p) | numeric < 32 = [('^', p), (chr (numeric + 64), p)] | otherwise = [(c, p)] where numeric = ord c renderTabBar :: SL.Rect -> UIStyle -> [(T.Text, Bool)] -> Vty.Image renderTabBar r uiStyle ts = (Vty.<|> padding) . Vty.horizCat $ fmap render ts where render (text, inFocus) = Vty.text' (tabAttr inFocus) (tabTitle text) tabTitle text = ' ' `T.cons` text `T.snoc` ' ' tabAttr b = baseAttr b $ tabBarAttributes uiStyle baseAttr True sty = attributesToAttr (appEndo (tabInFocusStyle uiStyle) sty) Vty.defAttr baseAttr False sty = attributesToAttr (appEndo (tabNotFocusedStyle uiStyle) sty) Vty.defAttr `Vty.withStyle` Vty.underline padding = Vty.charFill (tabAttr False) ' ' (SL.sizeX r - width) 1 width = sum . map ((+2) . T.length . fst) $ ts yi-0.12.6/src/library/Yi/UI/Vty/Conversions.hs0000644000000000000000000000713612717763531017211 0ustar0000000000000000module Yi.UI.Vty.Conversions ( colorToAttr , fromVtyEvent , fromVtyKey , fromVtyMod ) where import Data.List (nub, sort) import qualified Graphics.Vty as Vty (Attr, Color, Event (EvKey), Key (KBS, KBackTab, KBegin, KCenter, KChar, KDel, KDown, KEnd, KEnter, KEsc, KFun, KHome, KIns, KLeft, KMenu, KPageDown, KPageUp, KPause, KPrtScr, KRight, KUp), Modifier (..), black, blue, brightBlack, brightBlue, brightCyan, brightGreen, brightMagenta, brightRed, brightWhite, brightYellow, cyan, green, magenta, red, rgbColor, white, yellow) import qualified Yi.Event (Event (..), Key (..), Modifier (MCtrl, MMeta, MShift)) import qualified Yi.Style (Color (..)) fromVtyEvent :: Vty.Event -> Yi.Event.Event fromVtyEvent (Vty.EvKey Vty.KBackTab mods) = Yi.Event.Event Yi.Event.KTab (sort $ nub $ Yi.Event.MShift : map fromVtyMod mods) fromVtyEvent (Vty.EvKey k mods) = Yi.Event.Event (fromVtyKey k) (sort $ map fromVtyMod mods) fromVtyEvent _ = error "fromVtyEvent: unsupported event encountered." fromVtyKey :: Vty.Key -> Yi.Event.Key fromVtyKey (Vty.KEsc ) = Yi.Event.KEsc fromVtyKey (Vty.KFun x ) = Yi.Event.KFun x fromVtyKey (Vty.KPrtScr ) = Yi.Event.KPrtScr fromVtyKey (Vty.KPause ) = Yi.Event.KPause fromVtyKey (Vty.KChar '\t') = Yi.Event.KTab fromVtyKey (Vty.KChar c ) = Yi.Event.KASCII c fromVtyKey (Vty.KBS ) = Yi.Event.KBS fromVtyKey (Vty.KIns ) = Yi.Event.KIns fromVtyKey (Vty.KHome ) = Yi.Event.KHome fromVtyKey (Vty.KPageUp ) = Yi.Event.KPageUp fromVtyKey (Vty.KDel ) = Yi.Event.KDel fromVtyKey (Vty.KEnd ) = Yi.Event.KEnd fromVtyKey (Vty.KPageDown ) = Yi.Event.KPageDown fromVtyKey (Vty.KCenter ) = Yi.Event.KNP5 fromVtyKey (Vty.KUp ) = Yi.Event.KUp fromVtyKey (Vty.KMenu ) = Yi.Event.KMenu fromVtyKey (Vty.KLeft ) = Yi.Event.KLeft fromVtyKey (Vty.KDown ) = Yi.Event.KDown fromVtyKey (Vty.KRight ) = Yi.Event.KRight fromVtyKey (Vty.KEnter ) = Yi.Event.KEnter fromVtyKey (Vty.KBackTab ) = error "This should be handled in fromVtyEvent" fromVtyKey (Vty.KBegin ) = error "Yi.UI.Vty.fromVtyKey: can't handle KBegin" fromVtyKey _ = error "Unhandled key in fromVtyKey" fromVtyMod :: Vty.Modifier -> Yi.Event.Modifier fromVtyMod Vty.MShift = Yi.Event.MShift fromVtyMod Vty.MCtrl = Yi.Event.MCtrl fromVtyMod Vty.MMeta = Yi.Event.MMeta fromVtyMod Vty.MAlt = Yi.Event.MMeta -- | Convert a Yi Attr into a Vty attribute change. colorToAttr :: (Vty.Color -> Vty.Attr -> Vty.Attr) -> Yi.Style.Color -> Vty.Attr -> Vty.Attr colorToAttr set c = case c of Yi.Style.RGB 0 0 0 -> set Vty.black Yi.Style.RGB 128 128 128 -> set Vty.brightBlack Yi.Style.RGB 139 0 0 -> set Vty.red Yi.Style.RGB 255 0 0 -> set Vty.brightRed Yi.Style.RGB 0 100 0 -> set Vty.green Yi.Style.RGB 0 128 0 -> set Vty.brightGreen Yi.Style.RGB 165 42 42 -> set Vty.yellow Yi.Style.RGB 255 255 0 -> set Vty.brightYellow Yi.Style.RGB 0 0 139 -> set Vty.blue Yi.Style.RGB 0 0 255 -> set Vty.brightBlue Yi.Style.RGB 128 0 128 -> set Vty.magenta Yi.Style.RGB 255 0 255 -> set Vty.brightMagenta Yi.Style.RGB 0 139 139 -> set Vty.cyan Yi.Style.RGB 0 255 255 -> set Vty.brightCyan Yi.Style.RGB 165 165 165 -> set Vty.white Yi.Style.RGB 255 255 255 -> set Vty.brightWhite Yi.Style.Default -> id Yi.Style.RGB r g b -> set (Vty.rgbColor r g b) yi-0.12.6/src/library/Yi/Buffer/Implementation.hs0000644000000000000000000004333412717763531020000 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE PatternGuards #-} {-# LANGUAGE Rank2Types #-} {-# LANGUAGE TemplateHaskell #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.Buffer.Implementation -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- 'Buffer' implementation, wrapping Rope module Yi.Buffer.Implementation ( UIUpdate (..) , Update (..) , updateIsDelete , Point , Mark, MarkValue(..) , Size , Direction (..) , BufferImpl , Overlay (..) , mkOverlay , overlayUpdate , applyUpdateI , isValidUpdate , reverseUpdateI , nelemsBI , sizeBI , newBI , solPoint , solPoint' , eolPoint' , charsFromSolBI , regexRegionBI , getMarkDefaultPosBI , modifyMarkBI , getMarkValueBI , getMarkBI , newMarkBI , deleteMarkValueBI , setSyntaxBI , addOverlayBI , delOverlayBI , delOverlaysOfOwnerBI , getOverlaysOfOwnerBI , updateSyntax , getAst, focusAst , strokesRangesBI , getStream , getIndexedStream , lineAt , SearchExp , markPointAA , markGravityAA , mem ) where import GHC.Generics (Generic) import Control.Applicative (Applicative ((<*>), pure), (<$>)) import Data.Array ((!)) import Data.Binary (Binary (..)) import Data.Function (on) import Data.List (groupBy) import qualified Data.Map as M (Map, delete, empty, findMax, insert, lookup, map, maxViewWithKey) import Data.Maybe (fromMaybe) import Data.Monoid (Monoid (mconcat, mempty)) import qualified Data.Set as Set (Set, delete, empty, filter, insert, map, toList) import Data.Typeable (Typeable) import Yi.Buffer.Basic (Direction (..), Mark (..), WindowRef, reverseDir) import Yi.Regex (RegexLike (matchAll), SearchExp, searchRegex) import Yi.Region (Region (..), fmapRegion, mkRegion, nearRegion, regionSize) import Yi.Rope (YiString) import qualified Yi.Rope as R import Yi.Style (StyleName, UIStyle (hintStyle, strongHintStyle)) import Yi.Syntax import Yi.Utils (SemiNum ((+~), (~-)), makeLensesWithSuffix, mapAdjust') data MarkValue = MarkValue { markPoint :: !Point , markGravity :: !Direction} deriving (Ord, Eq, Show, Typeable, Generic) makeLensesWithSuffix "AA" ''MarkValue instance Binary MarkValue type Marks = M.Map Mark MarkValue data HLState syntax = forall cache. HLState !(Highlighter cache syntax) !cache data Overlay = Overlay { overlayOwner :: R.YiString , overlayBegin :: MarkValue , overlayEnd :: MarkValue , overlayStyle :: StyleName , overlayAnnotation :: R.YiString } instance Eq Overlay where 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 _ 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) -- Atm we can't store overlays because stylenames are functions (can't be serialized) -- TODO: ideally I'd like to get rid of overlays entirely; although we could imagine them storing mere styles. instance Binary (BufferImpl ()) where 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 -- just the components of the state that change. -- -- 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. -- -- 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 -- the data with the buffer. If it's an "Insert" we have to keep the data any way. data Update = Insert { updatePoint :: !Point , updateDirection :: !Direction , _insertUpdateString :: !YiString } | Delete { updatePoint :: !Point , updateDirection :: !Direction , _deleteUpdateString :: !YiString } deriving (Show, Typeable, Generic) instance Binary Update updateIsDelete :: Update -> Bool updateIsDelete Delete {} = True updateIsDelete Insert {} = False updateString :: Update -> YiString updateString (Insert _ _ s) = s updateString (Delete _ _ s) = s updateSize :: Update -> Size updateSize = Size . fromIntegral . R.length . updateString data UIUpdate = TextUpdate !Update | StyleUpdate !Point !Size deriving (Generic) instance Binary UIUpdate -------------------------------------------------- -- Low-level primitives. -- | New FBuffer filled from string. newBI :: YiString -> BufferImpl () newBI s = FBufferData s M.empty M.empty dummyHlState Set.empty 0 -- | Write string into buffer. insertChars :: YiString -> YiString -> Point -> YiString insertChars p cs (Point i) = left `R.append` cs `R.append` right where (left, right) = R.splitAt i p {-# INLINE insertChars #-} -- | Write string into buffer. deleteChars :: YiString -> Point -> Size -> YiString deleteChars p (Point i) (Size n) = left `R.append` right where (left, rest) = R.splitAt i p right = R.drop n rest {-# INLINE deleteChars #-} ------------------------------------------------------------------------ -- Mid-level insert/delete -- | Shift a mark position, supposing an update at a given point, by a given amount. -- Negative amount represent deletions. shiftMarkValue :: Point -> Size -> MarkValue -> MarkValue shiftMarkValue from by (MarkValue p gravity) = MarkValue shifted gravity where shifted | p < from = p | p == from = case gravity of Backward -> p Forward -> p' | otherwise {- p > from -} = p' where p' = max from (p +~ by) mapOvlMarks :: (MarkValue -> MarkValue) -> Overlay -> Overlay mapOvlMarks f (Overlay _owner s e v msg) = Overlay _owner (f s) (f e) v msg ------------------------------------- -- * "high-level" (exported) operations -- | Point of EOF sizeBI :: BufferImpl syntax -> Point sizeBI = Point . R.length . mem -- | Return @n@ Chars starting at @i@ of the buffer. nelemsBI :: Int -> Point -> BufferImpl syntax -> YiString nelemsBI n (Point i) = R.take n . R.drop i . mem getStream :: Direction -> Point -> BufferImpl syntax -> YiString getStream Forward (Point i) = R.drop i . mem getStream Backward (Point i) = R.reverse . R.take i . mem -- | TODO: This guy is a pretty big bottleneck and only one function -- uses it which in turn is only seldom used and most of the output is -- thrown away anyway. We could probably get away with never -- converting this to String here. The old implementation did so -- because it worked over ByteString but we don't have to. getIndexedStream :: Direction -> Point -> BufferImpl syntax -> [(Point,Char)] getIndexedStream Forward (Point p) = zip [Point p..] . R.toString . R.drop p . mem getIndexedStream Backward (Point p) = zip (dF (pred (Point p))) . R.toReverseString . R.take p . mem where dF n = n : dF (pred n) -- | Create an "overlay" for the style @sty@ between points @s@ and @e@ 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 _owner (MarkValue s _) (MarkValue e _) _ _ann) = StyleUpdate s (e ~- s) -- | Add a style "overlay" between the given points. addOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax addOverlayBI ov fb = fb{overlays = Set.insert ov (overlays fb)} -- | Remove a previously added "overlay" delOverlayBI :: Overlay -> BufferImpl syntax -> BufferImpl syntax delOverlayBI ov fb = fb{overlays = Set.delete ov (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 -- is derived from syntax highlighting, active overlays and current regexp. The -- returned list contains tuples @(l,s,r)@ where every tuple is to -- be interpreted as apply the style @s@ from position @l@ to @r@ in -- the buffer. In each list, the strokes are guaranteed to be -- ordered and non-overlapping. The lists of strokes are ordered by -- decreasing priority: the 1st layer should be "painted" on top. strokesRangesBI :: (Point -> Point -> Point -> [Stroke]) -> Maybe SearchExp -> Region -> Point -> BufferImpl syntax -> [[Stroke]] strokesRangesBI getStrokes regex rgn point fb = result where i = regionStart rgn j = regionEnd rgn dropBefore = dropWhile (\s ->spanEnd s <= i) takeIn = takeWhile (\s -> spanBegin s <= j) groundLayer = [Span i mempty j] -- 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` 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 _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) ------------------------------------------------------------------------ -- Point based editing -- | Checks if an Update is valid isValidUpdate :: Update -> BufferImpl syntax -> Bool isValidUpdate u b = case u of (Delete p _ _) -> check p && check (p +~ updateSize u) (Insert p _ _) -> check p where check (Point x) = x >= 0 && x <= R.length (mem b) -- | Apply a /valid/ update applyUpdateI :: Update -> BufferImpl syntax -> BufferImpl syntax 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 -- (problem is that marks can have different gravities) where (p', amount) = case u of Insert pnt _ cs -> (insertChars p cs pnt, sz) Delete pnt _ _ -> (deleteChars p pnt sz, negate sz) sz = updateSize u 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 reverseUpdateI (Insert p dir cs) = Delete p (reverseDir dir) cs ------------------------------------------------------------------------ -- Line based editing -- | Line at the given point. (Lines are indexed from 1) lineAt :: Point -- ^ Line for which to grab EOL for -> BufferImpl syntax -> Int lineAt (Point p) fb = 1 + R.countNewLines (R.take p $ mem fb) -- | Point that starts the given line (Lines are indexed from 1) solPoint :: Int -> BufferImpl syntax -> Point solPoint line fb = Point $ R.length $ fst $ R.splitAtLine (line - 1) (mem fb) -- | Point that's at EOL. Notably, this puts you right before the -- newline character if one exists, and right at the end of the text -- if one does not. eolPoint' :: Point -- ^ Point from which we take the line to find the EOL of -> BufferImpl syntax -> Point eolPoint' p@(Point ofs) fb = Point . checkEol . fst . R.splitAtLine ln $ mem fb where ln = lineAt p fb -- In case we're somewhere without trailing newline, we need to -- stay where we are checkEol t = let l' = R.length t in case R.last t of -- We're looking at EOL and we weren't asking for EOL past -- this point, so back up one for good visual effect Just '\n' | l' > ofs -> l' - 1 -- We asked for EOL past the last newline so just go to the -- very end of content _ -> l' -- | Get begining of the line relatively to @point@. solPoint' :: Point -> BufferImpl syntax -> Point solPoint' point fb = solPoint (lineAt point fb) fb charsFromSolBI :: Point -> BufferImpl syntax -> YiString charsFromSolBI pnt fb = nelemsBI (fromIntegral $ pnt - sol) sol fb where sol = solPoint' pnt fb -- | Return indices of all strings in buffer matching regex, inside the given region. regexRegionBI :: SearchExp -> Region -> forall syntax. BufferImpl syntax -> [Region] regexRegionBI se r fb = case dir of Forward -> fmap (fmapRegion addPoint . matchedRegion) $ matchAll' $ R.toString bufReg Backward -> fmap (fmapRegion subPoint . matchedRegion) $ matchAll' $ R.toReverseString bufReg where matchedRegion arr = let (off,len) = arr!0 in mkRegion (Point off) (Point (off+len)) addPoint (Point x) = Point (p + x) subPoint (Point x) = Point (q - x) matchAll' = matchAll (searchRegex dir se) dir = regionDirection r Point p = regionStart r Point q = regionEnd r Size s = regionSize r bufReg = R.take s . R.drop p $ mem fb newMarkBI :: MarkValue -> BufferImpl syntax -> (BufferImpl syntax, Mark) newMarkBI initialValue fb = let maxId = fromMaybe 0 $ markId . fst . fst <$> M.maxViewWithKey (marks fb) newMark = Mark $ maxId + 1 fb' = fb { marks = M.insert newMark initialValue (marks fb)} in (fb', newMark) getMarkValueBI :: Mark -> BufferImpl syntax -> Maybe MarkValue getMarkValueBI m (FBufferData { marks = marksMap } ) = M.lookup m marksMap deleteMarkValueBI :: Mark -> BufferImpl syntax -> BufferImpl syntax deleteMarkValueBI m fb = fb { marks = M.delete m (marks fb) } getMarkBI :: String -> BufferImpl syntax -> Maybe Mark getMarkBI name FBufferData {markNames = nms} = M.lookup name nms -- | Modify a mark value. modifyMarkBI :: Mark -> (MarkValue -> MarkValue) -> (forall syntax. BufferImpl syntax -> BufferImpl syntax) modifyMarkBI m f fb = fb {marks = mapAdjust' f m (marks fb)} -- NOTE: we must insert the value strictly otherwise we can hold to whatever structure the value of the mark depends on. -- (often a whole buffer) setSyntaxBI :: ExtHL syntax -> BufferImpl oldSyntax -> BufferImpl syntax setSyntaxBI (ExtHL e) fb = touchSyntax 0 $ fb {hlCache = HLState e (hlStartState e)} touchSyntax :: Point -> BufferImpl syntax -> BufferImpl syntax touchSyntax touchedIndex fb = fb { dirtyOffset = min touchedIndex (dirtyOffset fb)} updateSyntax :: BufferImpl syntax -> BufferImpl syntax updateSyntax fb@FBufferData {dirtyOffset = touchedIndex, hlCache = HLState hl cache} | touchedIndex == maxBound = fb | otherwise = fb {dirtyOffset = maxBound, hlCache = HLState hl (hlRun hl getText touchedIndex cache) } where getText = Scanner 0 id (error "getText: no character beyond eof") (\idx -> getIndexedStream Forward idx fb) ------------------------------------------------------------------------ -- | Returns the requested mark, creating a new mark with that name (at the supplied position) if needed getMarkDefaultPosBI :: Maybe String -> Point -> BufferImpl syntax -> (BufferImpl syntax, Mark) getMarkDefaultPosBI name defaultPos fb@FBufferData {marks = mks, markNames = nms} = case flip M.lookup nms =<< name of Just m' -> (fb, m') Nothing -> let newMark = Mark (1 + max 1 (markId $ fst (M.findMax mks))) nms' = case name of Nothing -> nms Just nm -> M.insert nm newMark nms mks' = M.insert newMark (MarkValue defaultPos Forward) mks in (fb {marks = mks', markNames = nms'}, newMark) getAst :: WindowRef -> BufferImpl syntax -> syntax getAst w FBufferData {hlCache = HLState (SynHL {hlGetTree = gt}) cache} = gt cache w focusAst :: M.Map WindowRef Region -> BufferImpl syntax -> BufferImpl syntax focusAst r b@FBufferData {hlCache = HLState s@(SynHL {hlFocus = foc}) cache} = b {hlCache = HLState s (foc r cache)} yi-0.12.6/src/library/Parser/Incremental.hs0000644000000000000000000003276412717763531016723 0ustar0000000000000000{-# LANGUAGE GADTs #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-} -- TODO: -- better interface -- have error messages in the right order -- have a message for plain failures as well / remove failure in recoveries -- Optimize profile info (no more Ints) module Parser.Incremental (Process, recoverWith, symbol, eof, lookNext, testNext, run, mkProcess, profile, pushSyms, pushEof, evalL, evalR, feedZ, Parser(Look, Enter, Yuck), countWidth, fullLog, LogEntry(..), evalL' ) where import Control.Arrow (first, second, (***)) import Control.Applicative (Alternative ((<|>), empty), Applicative ((<*>), pure)) import Data.Tree (Tree (Node)) data a :< b = (:<) {top :: a, _rest :: b} infixr :< -- | Parser specification data Parser s a where Pure :: a -> Parser s a Appl :: Parser s (b -> a) -> Parser s b -> Parser s a Bind :: Parser s a -> (a -> Parser s b) -> Parser s b Look :: Parser s a -> (s -> Parser s a) -> Parser s a Shif :: Parser s a -> Parser s a Empt :: Parser s a Disj :: Parser s a -> Parser s a -> Parser s a Yuck :: Parser s a -> Parser s a Enter :: String -> Parser s a -> Parser s a -- | Parser process data Steps s a where Val :: a -> Steps s r -> Steps s (a :< r) App :: Steps s ((b -> a) :< (b :< r)) -> Steps s (a :< r) Done :: Steps s () Shift :: Steps s a -> Steps s a Sh' :: Steps s a -> Steps s a Sus :: Steps s a -> (s -> Steps s a) -> Steps s a Best :: Ordering -> Profile -> Steps s a -> Steps s a -> Steps s a Dislike :: Steps s a -> Steps s a Log :: String -> Steps s a -> Steps s a Fail :: Steps s a -- profile !! s = number of Dislikes found to do s Shifts data Profile = PSusp | PFail | PRes Int | !Int :> Profile deriving Show mapSucc :: Profile -> Profile mapSucc PSusp = PSusp mapSucc PFail = PFail mapSucc (PRes x) = PRes (succ x) mapSucc (x :> xs) = succ x :> mapSucc xs -- Map lookahead to maximum dislike difference we accept. When looking much further, -- we are more prone to discard smaller differences. It's essential that this drops below 0 when -- its argument increases, so that we can discard things with dislikes using only -- finite lookahead. dislikeThreshold :: Int -> Int dislikeThreshold n | n < 5 = 0 | otherwise = -1 -- we looked 5 tokens ahead, and still have no clue who is the best. Pick at random. -- | Compute the combination of two profiles, as well as which one is the best. better :: Int -> Profile -> Profile -> (Ordering, Profile) better _ PFail p = (GT, p) -- avoid failure better _ p PFail = (LT, p) better _ PSusp _ = (EQ, PSusp) -- could not decide before suspension => leave undecided. better _ _ PSusp = (EQ, PSusp) better _ (PRes x) (PRes y) = if x <= y then (LT, PRes x) else (GT, PRes y) -- two results, just pick the best. better lk xs@(PRes x) (y:>ys) = if x == 0 || y-x > dislikeThreshold lk then (LT, xs) else min x y +> better (lk+1) xs ys better lk (y:>ys) xs@(PRes x) = if x == 0 || y-x > dislikeThreshold lk then (GT, xs) else min x y +> better (lk+1) ys xs better lk (x:>xs) (y:>ys) | x == 0 && y == 0 = recur -- never drop things with no error: this ensures to find a correct parse if it exists. | x - y > threshold = (GT, y:>ys) | y - x > threshold = (LT, x:>xs) -- if at any point something is too disliked, drop it. | otherwise = recur where threshold = dislikeThreshold lk recur = min x y +> better (lk + 1) xs ys (+>) :: Int -> (t, Profile) -> (t, Profile) x +> ~(ordering, xs) = (ordering, x :> xs) data LogEntry = LLog String | LEmpty | LDislike | LShift | LDone | LFail | LSusp | LS String deriving Show rightLog :: Steps s r -> Tree LogEntry rightLog (Val _ p) = rightLog p rightLog (App p) = rightLog p rightLog (Shift p) = Node LShift [rightLog p] rightLog (Done) = Node LDone [] rightLog (Fail) = Node LFail [] rightLog (Dislike p) = Node LDislike [rightLog p] rightLog (Log msg p) = Node (LLog msg) [rightLog p] rightLog (Sus _ _) = Node LSusp [] rightLog (Best _ _ l r) = Node LEmpty (rightLog l:[rightLog r]) rightLog (Sh' _) = error "Sh' should be hidden by Sus" profile :: Steps s r -> Profile profile (Val _ p) = profile p profile (App p) = profile p profile (Shift p) = 0 :> profile p profile (Done) = PRes 0 -- success with zero dislikes profile (Fail) = PFail profile (Dislike p) = mapSucc (profile p) profile (Log _ p) = profile p profile (Sus _ _) = PSusp profile (Best _ pr _ _) = pr profile (Sh' _) = error "Sh' should be hidden by Sus" instance Show (Steps s r) where show (Val _ p) = 'v' : show p show (App p) = '*' : show p show (Done) = "1" show (Shift p) = '>' : show p show (Sh' p) = '\'' : show p show (Dislike p) = '?' : show p show (Log msg p) = "[" ++ msg ++ "]" ++ show p show (Fail) = "0" show (Sus _ _) = "..." show (Best _ _ p q) = "(" ++ show p ++ ")" ++ show q countWidth :: Zip s r -> Int countWidth (Zip _ _ r) = countWidth' r where countWidth' :: Steps s r -> Int countWidth' r' = case r' of (Best _ _ p q) -> countWidth' p + countWidth' q (Val _ p) -> countWidth' p (App p) -> countWidth' p (Done) -> 1 (Shift p) -> countWidth' p (Sh' p) -> countWidth' p (Dislike p) -> countWidth' p (Log _ p) -> countWidth' p (Fail) -> 1 (Sus _ _) -> 1 instance Show (RPolish i o) where show (RPush _ p) = show p ++ "^" show (RApp p) = show p ++ "@" show (RStop) = "!" apply :: forall t t1 a. ((t -> a) :< (t :< t1)) -> a :< t1 apply ~(f:< ~(a: (r, [String]) evalR' Done = ((), []) evalR' (Val a r) = first (a :<) (evalR' r) evalR' (App s) = first apply (evalR' s) evalR' (Shift v) = evalR' v evalR' (Dislike v) = evalR' v evalR' (Log err v) = second (err:) (evalR' v) evalR' (Fail) = error "evalR: No parse!" evalR' (Sus _ _) = error "evalR: Not fully evaluated!" evalR' (Sh' _) = error "evalR: Sh' should be hidden by Sus" evalR' (Best choice _ p q) = case choice of LT -> evalR' p GT -> evalR' q EQ -> error $ "evalR: Ambiguous parse: " ++ show p ++ " ~~~ " ++ show q instance Functor (Parser s) where fmap f = (pure f <*>) instance Applicative (Parser s) where (<*>) = Appl pure = Pure instance Alternative (Parser s) where (<|>) = Disj empty = Empt instance Monad (Parser s) where (>>=) = Bind return = pure fail _message = Empt toQ :: Parser s a -> forall h r. ((h,a) -> Steps s r) -> h -> Steps s r toQ (Look a f) = \k h -> Sus (toQ a k h) (\s -> toQ (f s) k h) toQ (p `Appl` q) = \k -> toQ p $ toQ q $ \((h, b2a), b) -> k (h, b2a b) toQ (Pure a) = \k h -> k (h, a) toQ (Disj p q) = \k h -> iBest (toQ p k h) (toQ q k h) toQ (Bind p a2q) = \k -> toQ p (\(h,a) -> toQ (a2q a) k h) toQ Empt = \_k _h -> Fail toQ (Yuck p) = \k h -> Dislike $ toQ p k h toQ (Enter err p) = \k h -> Log err $ toQ p k h toQ (Shif p) = \k h -> Sh' $ toQ p k h toP :: Parser s a -> forall r. Steps s r -> Steps s (a :< r) toP (Look a f) = \fut -> Sus (toP a fut) (\s -> toP (f s) fut) toP (Appl f x) = App . toP f . toP x toP (Pure x) = Val x toP Empt = const Fail toP (Disj a b) = \fut -> iBest (toP a fut) (toP b fut) toP (Bind p a2q) = \fut -> toQ p (\(_,a) -> toP (a2q a) fut) () toP (Yuck p) = Dislike . toP p toP (Enter err p) = Log err . toP p toP (Shif p) = Sh' . toP p -- | Intelligent, caching best. iBest :: Steps s a -> Steps s a -> Steps s a iBest p q = let ~(choice, pr) = better 0 (profile p) (profile q) in Best choice pr p q symbol :: forall s. (s -> Bool) -> Parser s s symbol f = Look empty $ \s -> if f s then Shif $ pure s else empty eof :: forall s. Parser s () eof = Look (pure ()) (const empty) -- | Push a chunk of symbols or eof in the process. This forces some suspensions. feed :: Maybe [s] -> Steps s r -> Steps s r feed (Just []) p = p -- nothing more left to feed feed ss p = case p of (Sus nil cons) -> case ss of Just [] -> p -- no more info, stop feeding Nothing -> feed Nothing nil -- finish Just (s:_) -> feed ss (cons s) (Shift p') -> Shift (feed ss p') (Sh' p') -> Shift (feed (fmap (drop 1) ss) p') (Dislike p') -> Dislike (feed ss p') (Log err p') -> Log err (feed ss p') (Val x p') -> Val x (feed ss p') (App p') -> App (feed ss p') Done -> Done Fail -> Fail Best _ _ p' q' -> iBest (feed ss p') (feed ss q') -- TODO: it would be nice to be able to reuse the profile here. feedZ :: Maybe [s] -> Zip s r -> Zip s r feedZ x = onRight (feed x) -- Move the zipper to right, and simplify if something is pushed in -- the left part. evalL :: forall s output. Zip s output -> Zip s output evalL (Zip errs0 l0 r0) = help errs0 l0 r0 where help :: [String] -> RPolish mid output -> Steps s mid -> Zip s output help errs l rhs = case rhs of (Val a r) -> help errs (simplify (RPush a l)) r (App r) -> help errs (RApp l) r (Shift p) -> help errs l p (Log err p) -> help (err:errs) l p (Dislike p) -> help errs l p (Best choice _ p q) -> case choice of LT -> help errs l p GT -> help errs l q EQ -> reZip errs l rhs -- don't know where to go: don't speculate on evaluating either branch. _ -> reZip errs l rhs reZip :: [String] -> RPolish mid output -> Steps s mid -> Zip s output reZip errs l r = l `seq` Zip errs l r evalL' :: Zip s output -> Zip s output evalL' (Zip errs0 l0 r0) = Zip errs0 l0 (simplRhs r0) where simplRhs :: Steps s a ->Steps s a simplRhs rhs = case rhs of (Val a r) -> Val a (simplRhs r) (App r) -> App (simplRhs r) (Shift p) -> Shift (simplRhs p) (Log err p) -> Log err $ simplRhs p (Dislike p) -> Dislike $ simplRhs p (Best choice _ p q) -> case choice of LT -> simplRhs p GT -> simplRhs q EQ -> iBest (simplRhs p) (simplRhs q) x -> x -- | Push some symbols. pushSyms :: forall s r. [s] -> Zip s r -> Zip s r pushSyms x = feedZ (Just x) -- | Push eof pushEof :: forall s r. Zip s r -> Zip s r pushEof = feedZ Nothing -- | Make a parser into a process. mkProcess :: forall s a. Parser s a -> Process s a mkProcess p = Zip [] RStop (toP p Done) -- | Run a process (in case you do not need the incremental interface) run :: Process s a -> [s] -> (a, [String]) run p input = evalR $ pushEof $ pushSyms input p testNext :: (Maybe s -> Bool) -> Parser s () testNext f = Look (if f Nothing then ok else empty) (\s -> if f $ Just s then ok else empty) where ok = pure () lookNext :: Parser s (Maybe s) lookNext = Look (pure Nothing) (pure . Just) -- | Parse the same thing as the argument, but will be used only as -- backup. ie, it will be used only if disjuncted with a failing -- parser. recoverWith :: Parser s a -> Parser s a recoverWith = Enter "recoverWith" . Yuck ---------------------------------------------------- -------------------------------- -- The zipper for efficient evaluation: -- Arbitrary expressions in Reverse Polish notation. -- This can also be seen as an automaton that transforms a stack. -- RPolish is indexed by the types in the stack consumed by the automaton (input), -- and the stack produced (output) data RPolish input output where RPush :: a -> RPolish (a :< rest) output -> RPolish rest output RApp :: RPolish (b :< rest) output -> RPolish ((a -> b) :< a :< rest) output RStop :: RPolish rest rest -- Evaluate the output of an RP automaton, given an input stack evalRP :: RPolish input output -> input -> output evalRP RStop acc = acc evalRP (RPush v r) acc = evalRP r (v :< acc) evalRP (RApp r) ~(f :< ~(a :< rest)) = evalRP r (f a :< rest) -- execute the automaton as far as possible simplify :: RPolish s output -> RPolish s output simplify (RPush x (RPush f (RApp r))) = simplify (RPush (f x) r) simplify x = x evalR :: Zip token (a :< rest) -> (a, [String]) evalR (Zip errs l r) = ((top . evalRP l) *** (errs ++)) (evalR' r) -- Gluing a Polish expression and an RP automaton. -- This can also be seen as a zipper of Polish expressions. data Zip s output where Zip :: [String] -> RPolish mid output -> Steps s mid -> Zip s output -- note that the Stack produced by the Polish expression matches -- the stack consumed by the RP automaton. fullLog :: Zip s output -> ([String],Tree LogEntry) fullLog (Zip msg _ rhs) = (reverse msg, rightLog rhs) instance Show (Zip s output) where show (Zip errs l r) = show l ++ "<>" ++ show r ++ ", errs = " ++ show errs onRight :: (forall r. Steps s r -> Steps s r) -> Zip s a -> Zip s a onRight f (Zip errs x y) = Zip errs x (f y) type Process token result = Zip token (result :< ()) yi-0.12.6/src/library/Control/Exc.hs0000644000000000000000000000156512533751517015355 0ustar0000000000000000{-# LANGUAGE ScopedTypeVariables #-} -- | Utilities for working with new Control.Exception module Control.Exc (ignoringException, printingException, orException) where import Prelude import Control.Exception (catch, SomeException) -- | Execute IO (Maybe a) action replacing all exceptions with return value of Nothing. ignoringException :: IO (Maybe a) -> IO (Maybe a) ignoringException f = f `catch` ignore where ignore (_ :: SomeException) = return Nothing -- | Execute IO () action, replacing all exceptions with messages printingException :: String -> IO a -> IO a printingException desc f = f `catch` handler where handler (err :: SomeException) = fail $ concat [desc, " failed: ", show err] -- | Execute IO () action, replacing all exceptions with messages orException :: IO a -> IO a -> IO a orException f g = f `catch` handler where handler (_ :: SomeException) = g yi-0.12.6/src/library/Data/DelayList.hs0000644000000000000000000000132412533751517015752 0ustar0000000000000000-- maybe use package event-list instead. module Data.DelayList (insert, decrease, DelayList) where type DelayList a = [(Int, a)] -- | Subtraction, but treat maxBound as infinity. i.e. maxBound -? x == maxBound (-?) :: Int -> Int -> Int x -? y | x == maxBound = x | otherwise = x - y insert :: (Int, a) -> DelayList a -> DelayList a insert (d, a) [] = [(d, a)] insert (d, a) l@(h@(d', _):t) | d == d' = (d, a):t | d < d' = (d, a) : decrease d l -- d > d' | otherwise = h : insert (d -? d', a) t decrease :: Int -> DelayList a -> DelayList a decrease _ [] = [] decrease d l@((d',a):t) | d <= 0 = l | d < d' = (d' -? d, a):t -- d >= d' | otherwise = decrease (d - d') t yi-0.12.6/src/library/System/CanonicalizePath.hs0000644000000000000000000000673412717763531017724 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : System.CanonicalizePath -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- System.Directory.canonicalizePath replacement module System.CanonicalizePath ( canonicalizePath , normalisePath , replaceShorthands ) where #ifdef mingw32_HOST_OS import System.FilePath (normalise) import qualified System.Win32 as Win32 #endif import Control.Applicative ((<$>)) import Control.Exc (ignoringException) import Control.Monad (foldM) import Data.List.Split (splitOneOf) import Data.Monoid ((<>)) import qualified Data.Text as T (Text, empty, splitOn) import System.Directory (getCurrentDirectory) import System.FilePath (isAbsolute, isDrive, pathSeparator, pathSeparators, takeDirectory, ()) import System.PosixCompat.Files (readSymbolicLink) -- | Removes `/./` `//` and `/../` sequences from path, -- doesn't follow symlinks normalisePath :: FilePath -> IO FilePath normalisePath path = do absPath <- makeAbsolute path return $ foldl combinePath "/" $ splitPath absPath -- | Returns absolute name of the file, which doesn't contain -- any `/./`, `/../`, `//` sequences or symlinks canonicalizePath :: FilePath -> IO FilePath canonicalizePath path = do #if !defined(mingw32_HOST_OS) absPath <- makeAbsolute path foldM (\x y -> expandSym $ combinePath x y) "/" $ splitPath absPath #else Win32.getFullPathName . normalise $ path #endif -- | Dereferences symbolic links until regular -- file/directory/something_else appears expandSym :: FilePath -> IO FilePath expandSym fpath = do -- System.Posix.Files.getFileStatus dereferences symlink before -- checking its status, so it's useless here deref <- ignoringException (Just <$> readSymbolicLink fpath) case deref of Just slink -> expandSym (if isAbsolute slink then slink else foldl combinePath (takeDirectory fpath) $ splitPath slink) Nothing -> return fpath -- | Make a path absolute. makeAbsolute :: FilePath -> IO FilePath makeAbsolute f | not (null f) && head f `elem` ['~', pathSeparator] = return f | otherwise = fmap ( f) getCurrentDirectory -- | Combines two paths, moves up one level on .. combinePath :: FilePath -> String -> FilePath combinePath x "." = x combinePath x ".." = takeDirectory x combinePath "/" y = "/" y combinePath x y | isDrive x = (x ++ [pathSeparator]) y -- "C:" "bin" = "C:bin" | otherwise = x y -- Replace utility shorthands, similar to Emacs -- -- @ -- somepath//someotherpath ≅ /someotherpath -- somepath/~/someotherpath ≅ ~/someotherpath -- @ replaceShorthands :: T.Text -> T.Text replaceShorthands = r "/~" "~/" . r "//" "/" where r :: T.Text -> T.Text -> T.Text -> T.Text r s r' a = case T.splitOn s a of [] -> T.empty [a'] -> a' _ : as -> r' <> last as -- | Splits path into parts by path separator -- -- Text version would look like -- -- @'T.filter' (not . T.null) . T.split (`elem` pathSeparators)@ -- -- But we should move to @system-filepath@ package anyway. splitPath :: FilePath -> [String] splitPath = filter (not . null) . splitOneOf pathSeparators yi-0.12.6/src/library/System/FriendlyPath.hs0000644000000000000000000000234612717763531017074 0ustar0000000000000000module System.FriendlyPath ( userToCanonPath , expandTilda , isAbsolute' ) where import Control.Applicative ((<$>)) import System.CanonicalizePath (canonicalizePath) import System.Directory (getHomeDirectory) import System.FilePath (isAbsolute, normalise, pathSeparator) import System.PosixCompat.User (getUserEntryForName, homeDirectory) -- canonicalizePath follows symlinks, and does not work if the directory does not exist. -- | Canonicalize a user-friendly path userToCanonPath :: FilePath -> IO String userToCanonPath f = canonicalizePath =<< expandTilda f -- | Turn a user-friendly path into a computer-friendly path by expanding the leading tilda. expandTilda :: String -> IO FilePath expandTilda ('~':path) | null path || (head path == pathSeparator) = (++ path) <$> getHomeDirectory -- Home directory of another user, e.g. ~root/ | otherwise = let username = takeWhile (/= pathSeparator) path dirname = drop (length username) path in (normalise . (++ dirname) . homeDirectory) <$> getUserEntryForName username expandTilda path = return path -- | Is a user-friendly path absolute? isAbsolute' :: String -> Bool isAbsolute' ('~':_) = True isAbsolute' p = isAbsolute p yi-0.12.6/src/library/Yi/UI/Pango/Layouts.hs0000644000000000000000000003415412533751517016620 0ustar0000000000000000{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE TupleSections #-} {-# OPTIONS_HADDOCK show-extensions #-} -- | -- Module : Yi.UI.Pango.Layouts -- License : GPL-2 -- Maintainer : yi-devel@googlegroups.com -- Stability : experimental -- Portability : portable -- -- Provides abstract controls which implement 'Yi.Layout.Layout's and -- which manage the minibuffer. -- -- The implementation strategy is to first construct the layout -- managers @WeightedStack@ (implementing the 'Stack' constructor) and -- @SlidingPair@ (implementing the 'Pair' constructor), and then -- construct 'LayoutDisplay' as a tree of these, mirroring the -- structure of 'Layout'. module Yi.UI.Pango.Layouts ( -- * Getting the underlying widget WidgetLike(..), -- * Window layout LayoutDisplay, layoutDisplayNew, layoutDisplaySet, layoutDisplayOnDividerMove, -- * Miniwindow layout MiniwindowDisplay, miniwindowDisplayNew, miniwindowDisplaySet, -- * Tabs SimpleNotebook, simpleNotebookNew, simpleNotebookSet, simpleNotebookOnSwitchPage, -- * Utils update, ) where import Control.Applicative import Control.Arrow (first) import Control.Monad hiding (mapM, forM) import Data.Foldable (toList) import Data.IORef import qualified Data.List.PointedList as PL import qualified Data.Text as T import Data.Traversable import Graphics.UI.Gtk as Gtk hiding(Orientation, Layout) import Prelude hiding (mapM) import Yi.Layout(Orientation(..), RelativeSize, DividerPosition, Layout(..), DividerRef) class WidgetLike w where -- | Extracts the main widget. This is the widget to be added to the GUI. baseWidget :: w -> Widget ----------------------- The WeightedStack type {- | A @WeightedStack@ is like a 'VBox' or 'HBox', except that we may specify the ratios of the areas of the child widgets (so this implements the 'Stack' constructor of 'Yi.Layout.Layout'. Essentially, we implement this layout manager from scratch, by implementing the 'sizeRequest' and 'sizeAllocate' signals by hand (see the 'Container' documentation for details, and http://www.ibm.com/developerworks/linux/library/l-widget-pygtk/ for an example in Python). Ideally, we would directly subclass the abstract class 'Container', but Gtk2hs doesn't directly support this. Instead, we start off with the concrete class 'Fixed', and just override its layout behaviour. -} newtype WeightedStack = WS Fixed deriving(GObjectClass, ObjectClass, WidgetClass,ContainerClass) type StackDescr = [(Widget, RelativeSize)] weightedStackNew :: Orientation -> StackDescr -> IO WeightedStack weightedStackNew o s = do when (any ((<= 0) . snd) s) $ error "Yi.UI.Pango.WeightedStack.WeightedStack: all weights must be positive" l <- fixedNew set l (fmap ((containerChild :=) . fst) s) void $ Gtk.on l sizeRequest (doSizeRequest o s) void $ Gtk.on l sizeAllocate (relayout o s) return (WS l) -- | Requests the smallest size so that each widget gets its requested size doSizeRequest :: Orientation -> StackDescr -> IO Requisition doSizeRequest o s = let (requestAlong, requestAcross) = case o of Horizontal -> (\(Requisition w _) -> fromIntegral w, \(Requisition _ h) -> h) Vertical -> (\(Requisition _ h) -> fromIntegral h, \(Requisition w _) -> w) totalWeight = sum . fmap snd $ s reqsize (request, relSize) = requestAlong request / relSize sizeAlong widgetRequests = totalWeight * (maximum . fmap reqsize $ widgetRequests) sizeAcross widgetRequests = maximum . fmap (requestAcross . fst) $ widgetRequests mkRequisition wr = case o of Horizontal -> Requisition (round $ sizeAlong wr) (sizeAcross wr) Vertical -> Requisition (sizeAcross wr) (round $ sizeAlong wr) swreq (w, relSize) = (,relSize) <$> widgetSizeRequest w in boundRequisition =<< mkRequisition <$> mapM swreq s -- | Bounds the given requisition to not exceed screen dimensions boundRequisition :: Requisition -> IO Requisition boundRequisition r@(Requisition w h) = do mscr <- screenGetDefault case mscr of Just scr -> Requisition <$> (min w <$> screenGetWidth scr) <*> (min h <$> screenGetHeight scr) Nothing -> return r -- | Position the children appropriately for the given width and height relayout :: Orientation -> StackDescr -> Rectangle -> IO () relayout o s (Rectangle x y width height) = let totalWeight = sum . fmap snd $ s totalSpace = fromIntegral $ case o of Horizontal -> width Vertical -> height wtMult = totalSpace / totalWeight calcPosition pos (widget, wt) = (pos + wt * wtMult, (pos, wt * wtMult, widget)) widgetToRectangle (round -> pos, round -> size, widget) = case o of Horizontal -> (Rectangle pos y size height, widget) Vertical -> (Rectangle x pos width size, widget) startPosition = fromIntegral $ case o of Horizontal -> x Vertical -> y widgetPositions = fmap widgetToRectangle (snd (mapAccumL calcPosition startPosition s)) in forM_ widgetPositions $ \(rect, widget) -> widgetSizeAllocate widget rect ------------------------------------------------------- SlidingPair {-| 'SlidingPair' implements the 'Pair' constructor. Most of what is needed is already implemented by the 'HPaned' and 'VPaned' classes. The main feature added by 'SlidingPair' is that the divider position, *as a fraction of the available space*, remains constant even when resizing. -} newtype SlidingPair = SP Paned deriving(GObjectClass, ObjectClass, WidgetClass, ContainerClass) slidingPairNew :: (WidgetClass w1, WidgetClass w2) => Orientation -> w1 -> w2 -> DividerPosition -> (DividerPosition -> IO ()) -> IO SlidingPair slidingPairNew o w1 w2 pos handleNewPos = do p <- case o of Horizontal -> toPaned <$> hPanedNew Vertical -> toPaned <$> vPanedNew panedPack1 p w1 True True panedPack2 p w2 True True {- We want to catch the sizeAllocate signal. If this event is called, two things could have happened: the size could have changed; or the slider could have moved. We want to correct the slider position, but only if the size has changed. Furthermore, if the size only changes in the direction /orthogonal/ to the slider, then there is also no need to correct the slider position. -} posRef <- newIORef pos sizeRef <- newIORef 0 void $ Gtk.on p sizeAllocate $ \(Rectangle _ _ w h) -> do oldSz <- readIORef sizeRef oldPos <- readIORef posRef let sz = case o of Horizontal -> w Vertical -> h writeIORef sizeRef sz when (sz /= 0) $ if sz == oldSz then do -- the slider was moved; store its new position sliderPos <- get p panedPosition let newPos = fromIntegral sliderPos / fromIntegral sz writeIORef posRef newPos when (oldPos /= newPos) $ handleNewPos newPos else -- the size was changed; restore the slider position and -- save the new position set p [ panedPosition := round (oldPos * fromIntegral sz) ] return (SP p) ----------------------------- LayoutDisplay -- | A container implements 'Layout's. data LayoutDisplay = LD { mainWidget :: Bin, implWidget :: IORef (Maybe LayoutImpl), dividerCallbacks :: IORef [DividerRef -> DividerPosition -> IO ()] } -- | Tree mirroring 'Layout', which holds the layout widgets for 'LayoutDisplay' data LayoutImpl = SingleWindowI { singleWidget :: Widget } | StackI { orientationI :: Orientation, winsI :: [(LayoutImpl, RelativeSize)], stackWidget :: WeightedStack } | PairI { orientationI :: Orientation, pairFstI :: LayoutImpl, pairSndI :: LayoutImpl, divRefI :: DividerRef, pairWidget :: SlidingPair } --- construction layoutDisplayNew :: IO LayoutDisplay layoutDisplayNew = do cbRef <- newIORef [] implRef <- newIORef Nothing box <- toBin <$> alignmentNew 0 0 1 1 return (LD box implRef cbRef) -- | Registers a callback to a divider changing position. (There is -- currently no way to unregister.) layoutDisplayOnDividerMove :: LayoutDisplay -> (DividerRef -> DividerPosition -> IO ()) -> IO () layoutDisplayOnDividerMove ld cb = modifyIORef (dividerCallbacks ld) (cb:) --- changing the layout -- | Sets the layout to the given schema. -- -- * it is permissible to add or remove widgets in this process. -- -- * as an optimisation, this function will first check whether the -- layout has actually changed (so the caller need not be concerned -- with this) -- -- * will run 'widgetShowAll', and hence will show the underlying widgets too layoutDisplaySet :: LayoutDisplay -> Layout Widget -> IO () layoutDisplaySet ld lyt = do mimpl <- readIORef (implWidget ld) let applyLayout = do impl' <- buildImpl (runCb $ dividerCallbacks ld) lyt widgetShowAll (outerWidget impl') set (mainWidget ld) [containerChild := outerWidget impl'] writeIORef (implWidget ld) (Just impl') case mimpl of Nothing -> applyLayout Just impl -> unless (sameLayout impl lyt) $ do unattachWidgets (toContainer $ mainWidget ld) impl applyLayout runCb :: IORef [DividerRef -> DividerPosition -> IO ()] -> DividerRef -> DividerPosition -> IO () runCb cbRef dRef dPos = readIORef cbRef >>= mapM_ (\cb -> cb dRef dPos) buildImpl :: (DividerRef -> DividerPosition -> IO ()) -> Layout Widget -> IO LayoutImpl buildImpl cb = go where go (SingleWindow w) = return (SingleWindowI w) go (s@Stack{}) = do impls <- forM (wins s) $ \(lyt,relSize) -> (,relSize) <$> go lyt ws <- weightedStackNew (orientation s) (first outerWidget <$> impls) return (StackI (orientation s) impls ws) go (p@Pair{}) = do w1 <- go (pairFst p) w2 <- go (pairSnd p) sp <- slidingPairNew (orientation p) (outerWidget w1) (outerWidget w2) (divPos p) (cb $ divRef p) return $ PairI (orientation p) w1 w2 (divRef p) sp -- | true if the displayed layout agrees with the given schema, other -- than divider positions sameLayout :: LayoutImpl -> Layout Widget -> Bool sameLayout (SingleWindowI w) (SingleWindow w') = w == w' sameLayout (s@StackI{}) (s'@Stack{}) = orientationI s == orientation s' && length (winsI s) == length (wins s') && and (zipWith (\(impl, relSize) (layout, relSize') -> relSize == relSize' && sameLayout impl layout) (winsI s) (wins s')) sameLayout (p@PairI{}) (p'@Pair{}) = orientationI p == orientation p' && divRefI p == divRef p' && sameLayout (pairFstI p) (pairFst p') && sameLayout (pairSndI p) (pairSnd p') sameLayout _ _ = False -- removes all widgets from the layout unattachWidgets :: Container -> LayoutImpl -> IO () unattachWidgets parent (SingleWindowI w) = containerRemove parent w unattachWidgets parent s@StackI{} = do containerRemove parent (stackWidget s) mapM_ (unattachWidgets (toContainer $ stackWidget s) . fst) (winsI s) unattachWidgets parent p@PairI{} = do containerRemove parent (pairWidget p) mapM_ (unattachWidgets (toContainer $ pairWidget p)) [pairFstI p, pairSndI p] -- extract the main widget from the tree outerWidget :: LayoutImpl -> Widget outerWidget s@SingleWindowI{} = singleWidget s outerWidget s@StackI{} = toWidget . stackWidget $ s outerWidget p@PairI{} = toWidget . pairWidget $ p instance WidgetLike LayoutDisplay where baseWidget = toWidget . mainWidget ---------------- MiniwindowDisplay data MiniwindowDisplay = MD { mwdMainWidget :: VBox, mwdWidgets :: IORef [Widget] } miniwindowDisplayNew :: IO MiniwindowDisplay miniwindowDisplayNew = do vb <- vBoxNew False 1 wsRef <- newIORef [] return (MD vb wsRef) instance WidgetLike MiniwindowDisplay where baseWidget = toWidget . mwdMainWidget miniwindowDisplaySet :: MiniwindowDisplay -> [Widget] -> IO () miniwindowDisplaySet mwd ws = do curWs <- readIORef (mwdWidgets mwd) -- we could be more careful here, and only remove the widgets which we need to. when (ws /= curWs) $ do forM_ curWs $ containerRemove (mwdMainWidget mwd) forM_ ws $ \w -> boxPackEnd (mwdMainWidget mwd) w PackNatural 0 widgetShowAll $ mwdMainWidget mwd writeIORef (mwdWidgets mwd) ws ---------------------- SimpleNotebook data SimpleNotebook = SN { snMainWidget :: Notebook, snTabs :: IORef (Maybe (PL.PointedList (Widget, T.Text))) } instance WidgetLike SimpleNotebook where baseWidget = toWidget . snMainWidget -- | Constructs an empty notebook simpleNotebookNew :: IO SimpleNotebook simpleNotebookNew = do nb <- notebookNew ts <- newIORef Nothing return (SN nb ts) -- | Sets the tabs simpleNotebookSet :: SimpleNotebook -> PL.PointedList (Widget, T.Text) -> IO () simpleNotebookSet sn ts = do curTs <- readIORef (snTabs sn) let nb = snMainWidget sn tsList = toList ts curTsList = maybe [] toList curTs -- the common case is no change at all when (curTs /= Just ts) $ do -- update the tabs, if they have changed when (fmap fst curTsList /= fmap fst tsList) $ do forM_ curTsList $ const (notebookRemovePage nb (-1)) forM_ tsList $ uncurry (notebookAppendPage nb) -- now update the titles if they have changed forM_ tsList $ \(w,s) -> update nb (notebookChildTabLabel w) s -- now set the focus p <- notebookPageNum nb (fst $ PL._focus ts) maybe (return ()) (update nb notebookPage) p -- write the new status writeIORef (snTabs sn) (Just ts) -- display! widgetShowAll nb -- | The 'onSwitchPage' callback simpleNotebookOnSwitchPage :: SimpleNotebook -> (Int -> IO ()) -> IO () simpleNotebookOnSwitchPage sn = void . (snMainWidget sn `on` switchPage) ------------------- Utils -- Only set an attribute if has actually changed. -- This makes setting window titles much faster. update :: (Eq a) => o -> ReadWriteAttr o a a -> a -> IO () update w attr val = do oldVal <- get w attr when (val /= oldVal) $ set w [attr := val] yi-0.12.6/src/library/Yi/UI/Pango/Utils.hs0000644000000000000000000000117412533751517016254 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Random GTK utils module Yi.UI.Pango.Utils where import Control.Exception (catch, throw) import Data.Text (append) import Paths_yi import System.FilePath import Graphics.UI.Gtk import System.Glib.GError loadIcon :: FilePath -> IO Pixbuf loadIcon fpath = do iconfile <- getDataFileName $ "art" fpath icoProject <- catch (pixbufNewFromFile iconfile) (\(GError dom code msg) -> throw $ GError dom code $ msg `append` " -- use the yi_datadir environment variable to" `append` " specify an alternate location") pixbufAddAlpha icoProject (Just (0,255,0)) yi-0.12.6/src/executable/Main.hs0000644000000000000000000000026612533751517014554 0ustar0000000000000000-- | "Real" Frontend to the static binary. module Main (main) where import Yi.Boot (yiDriver) import Yi.Config.Default (defaultConfig) main :: IO () main = yiDriver defaultConfig yi-0.12.6/src/tests/TestSuite.hs0000644000000000000000000000063612533751517014643 0ustar0000000000000000module Main where import Test.Tasty (defaultMain, testGroup) import qualified Vim.TestPureBufferManipulations as VimBuffer import qualified Vim.TestPureEditorManipulations as VimEditor import qualified Vim.TestExCommandParsers as VimExCommand main :: IO () main = do tests <- VimBuffer.getTests defaultMain $ testGroup "Tests" [ tests , VimEditor.tests , VimExCommand.tests ] yi-0.12.6/src/tests/Driver.hs0000644000000000000000000000721212533751517014142 0ustar0000000000000000{-# LANGUAGE TypeSynonymInstances, GeneralizedNewtypeDeriving #-} module Driver where import System.Environment import Control.Monad import Test.QuickCheck hiding (promote) import System.Random hiding (next) import Text.Printf import Data.List (sort,group,intersperse) -- Following code shamelessly stolen from XMonad. main :: (Read t, Num t, PrintfArg t1, Num b, PrintfArg b) => [(t1, t -> IO (Bool, b))] -> IO () main tests = do args <- fmap (drop 1) getArgs let n = if null args then 100 else read (head args) (results, passed) <- fmap unzip $ mapM (\(s,a) -> printf "%-25s: " s >> a n) tests printf "Passed %d tests!\n" (sum passed) :: IO () when (not . and $ results) $ fail "Not all tests passed!" ------------------------------------------------------------------------ -- -- QC driver -- debug :: Bool debug = False mytest :: Testable a => a -> Int -> IO (Bool, Int) mytest a n = mycheck (stdArgs {maxSuccess = n}) a -- mytest a n = mycheck stdArgs -- { maxSuccess=n -- , configEvery = \o _ -> let s = show o in s ++ [ '\b' | _ <- s ] } a -- , configEvery= \n args -> if debug then show n ++ ":\n" ++ unlines args else [] } a mycheck :: Testable a => Args -> a -> IO (Bool, Int) mycheck config a = do rnd <- newStdGen results <- quickCheckWithResult config {replay = Just (rnd, 1)} a print results return $ case results of Success {} ->(True, maxSuccess config) GaveUp {numTests = n} ->(True, n) Failure {} -> (False, 0) NoExpectedFailure {} -> (True, 0) -- mytests :: Args -> Gen Result -> StdGen -> Int -> Int -> [[String]] -> IO (Bool, Int) -- mytests config gen rnd0 ntest nfail stamps -- | ntest == maxTest config = done "OK," ntest stamps >> return (True, ntest) -- | nfail == maxFail config = done "Arguments exhausted after" ntest stamps >> return (True, ntest) -- | otherwise = -- do putStr (configEvery config ntest (arguments result)) >> hFlush stdout -- case ok result of -- Nothing -> -- mytests config gen rnd1 ntest (nfail+1) stamps -- Just True -> -- mytests config gen rnd1 (ntest+1) nfail (stamp result:stamps) -- Just False -> -- putStr ( "Falsifiable after " -- ++ show ntest -- ++ " tests:\n" -- ++ unlines (arguments result) -- ) >> hFlush stdout >> return (False, ntest) -- where -- result = generate (maxSize config ntest) rnd2 gen -- (rnd1,rnd2) = split rnd0 done :: String -> Int -> [[String]] -> IO () done mesg ntest stamps = putStr ( mesg ++ " " ++ show ntest ++ " tests" ++ table ) where table = display . map entry . reverse . sort . map pairLength . group . sort . filter (not . null) $ stamps display [] = ".\n" display [x] = " (" ++ x ++ ").\n" display xs = ".\n" ++ unlines (map (++ ".") xs) pairLength xss@(xs:_) = (length xss, xs) pairLength [] = (0, []) entry (n, xs) = percentage n ntest ++ " " ++ concat (intersperse ", " xs) percentage n m = show ((100 * n) `div` m) ++ "%" ------------------------------------------------------------------------ integralRandomR :: (Integral a, RandomGen g) => (a,a) -> g -> (a,g) integralRandomR (a,b) g = case randomR (fromIntegral a :: Integer, fromIntegral b :: Integer) g of (x,h) -> (fromIntegral x, h) yi-0.12.6/src/tests/Generic/TestPureBufferManipulations.hs0000644000000000000000000001667612717763531021755 0ustar0000000000000000-- | This module aims to provide a generic back-end for other keymaps to -- use for pure buffer manipulations. Pure buffer manipulations are considered -- to be operations which simply change the contents of the buffer and move the -- cursor. For example, opening a second buffer is not considered a pure buffer -- operation. module Generic.TestPureBufferManipulations where import Test.Tasty.HUnit import Test.Tasty (TestTree, testGroup) import Control.Monad (filterM, forM, void, unless) import Control.Lens ((%=)) import Data.List (sort, isSuffixOf, intercalate, isPrefixOf) import Data.Ord (comparing) import System.Directory import System.FilePath import Text.Printf import Yi.Buffer import Yi.Config (Config) import Yi.Editor import Yi.Window import Yi.Region import Generic.TestUtils data KeymapTest = KeymapTest { ktName :: String , ktOptionalSettings :: [OptionalSetting] , ktInput :: String , ktOutput :: String , ktEventString :: String , ktKeysEval :: KeyEval } data OptionalSetting = WindowSize Int Int -- ^ WindowSize Width Height deriving Eq instance Show OptionalSetting where show (WindowSize w h) = unwords ["+WindowSize", (show w), (show h)] instance Eq KeymapTest where KeymapTest n s i o e _ == KeymapTest n' s' i' o' e' _ = n == n' && s == s' && i == i' && o == o' && e == e' instance Ord KeymapTest where compare = comparing ktName data TestResult = TestPassed String | TestFailed String String instance Show TestResult where show (TestPassed name) = "PASSED " ++ name show (TestFailed name msg) = "FAILED " ++ name ++ ":\n" ++ msg unlines' :: [String] -> String unlines' = intercalate "\n" optionalSettingPrefix :: String optionalSettingPrefix = "--+ " isOptionalSetting :: String -> Bool isOptionalSetting = (optionalSettingPrefix `isPrefixOf`) decodeOptionalSetting :: [String] -> OptionalSetting decodeOptionalSetting ["WindowSize", w, h] = WindowSize (read w) (read h) decodeOptionalSetting unknownSetting = error $ "Invalid Setting: " ++ (intercalate " " unknownSetting) loadTestFromDirectory :: FilePath -- ^ Directory of the test -> KeyEval -- ^ Function that can run -- ‘events’ commands -> IO KeymapTest loadTestFromDirectory path ev = do [input, output, events] <- mapM (readFile' . (path )) ["input", "output", "events"] return $ KeymapTest (joinPath . drop 1 . splitPath $ path) [] input output events ev isValidTestFile :: String -> Bool isValidTestFile text = case (skipOptionals . lines $ text) of [] -> False ("-- Input": ls) -> case break (== "-- Output") ls of (_, []) -> False (_, "-- Output":ls') -> "-- Events" `elem` ls' _ -> False _ -> False where skipOptionals = dropWhile isOptionalSetting -- | See Arguments to 'loadTestFromDirectory' loadTestFromFile :: FilePath -> KeyEval -> IO KeymapTest loadTestFromFile path ev = do text <- readFile' path unless (isValidTestFile text) $ void $ printf "Test %s is invalid\n" path let (optionals, testContents) = span isOptionalSetting (lines text) ls = tail testContents (input, rest) = break (== "-- Output") ls (output, rest2) = break (== "-- Events") $ tail rest eventText = tail rest2 return $ KeymapTest (joinPath . drop 1 . splitPath . dropExtension $ path) (map (decodeOptionalSetting . drop 1 . words) optionals) (unlines' input) (unlines' output) (unlines' eventText) ev containsTest :: FilePath -> IO Bool containsTest d = do files <- fmap (filter (`notElem` [".", ".."])) $ getDirectoryContents d return $ sort files == ["events", "input", "output"] getRecursiveFiles :: FilePath -> IO [FilePath] getRecursiveFiles topdir = do names <- getDirectoryContents topdir let properNames = filter (`notElem` [".", "..", ".git", ".svn"]) names paths <- forM properNames $ \name -> do let path = topdir name isDirectory <- doesDirectoryExist path if isDirectory then getRecursiveFiles path else return [path] return (concat paths) getRecursiveDirectories :: FilePath -> IO [FilePath] getRecursiveDirectories topdir = do names <- getDirectoryContents topdir let properNames = filter (`notElem` [".", "..", ".git", ".svn"]) names paths <- forM properNames $ \name -> do let path = topdir name isDirectory <- doesDirectoryExist path if isDirectory then fmap (path:) $ getRecursiveDirectories path else return [] return (concat paths) discoverTests :: FilePath -> KeyEval -> IO [KeymapTest] discoverTests topdir ev = do dirs <- getRecursiveDirectories topdir testDirs <- filterM containsTest dirs testFiles <- fmap (filter (isSuffixOf ".test")) $ getRecursiveFiles topdir testsFromDirs <- mapM (`loadTestFromDirectory` ev) testDirs testsFromFiles <- mapM (`loadTestFromFile` ev) testFiles return $ testsFromDirs ++ testsFromFiles optionalSettingAction :: OptionalSetting -> EditorM () optionalSettingAction (WindowSize w h) = let region = mkSizeRegion (Point 0) (Size (w*h)) in currentWindowA %= (\w -> w { height = h, actualLines = h, winRegion = region }) mkTestCase :: Config -> KeymapTest -> TestTree mkTestCase cf t = testCase (ktName t) $ do let setupActions = do let (cursorLine, '\n':text) = break (== '\n') (ktInput t) mapM_ optionalSettingAction $ ktOptionalSettings t insertText text setCursorPosition cursorLine preConditions _ _ = return () testActions _ = ktKeysEval t $ ktEventString t assertions editor _ = let actualOut = cursorPos editor ++ "\n" ++ extractBufferString cf editor in assertEqual (errorMsg actualOut) actualOut (ktOutput t) runTest setupActions preConditions testActions assertions cf where setCursorPosition cursorLine = let (x, y) = read cursorLine in withCurrentBuffer $ moveToLineColB x (y - 1) cursorPos = show . snd . runEditor cf (withCurrentBuffer $ do l <- curLn c <- curCol return (l, c + 1)) errorMsg actualOut = unlines $ optionalSettings ++ [ "Input:", ktInput t , "Expected:", ktOutput t , "Got:", actualOut , "Events:", ktEventString t , "---"] optionalSettings = map show $ ktOptionalSettings t -- | Takes a directory with the tests, a name of the keymap -- and an evaluation function for the keys contained in the tests. -- For Vim, we might do something like: -- -- @ -- getTests defaultVimConfig "src/tests/vimtests" -- "Vim" (pureEval $ extractValue defVimConfig) -- @ getTests :: Config -> FilePath -> String -> KeyEval -> IO TestTree getTests c fp n ev = do tests <- discoverTests fp ev return $ testGroup (n ++ " keymap tests") $ fmap (mkTestCase c) . sort $ tests readFile' :: FilePath -> IO String readFile' f = do s <- readFile f return $! length s `seq` s yi-0.12.6/src/tests/Generic/TestUtils.hs0000644000000000000000000000772412533751517016233 0ustar0000000000000000module Generic.TestUtils where import Control.Monad (unless) import Test.Tasty.HUnit import Yi.Buffer import Yi.Config (Config) import Yi.Editor import qualified Yi.Rope as R type KeyEval = String -> EditorM () -- | Run a pure editor manipulation test. -- -- Runs the @setupActions@ against an empty editor. Checks that @preConditions@ -- hold for that editor. Then runs @testActions@ against the setup editor. -- Finally checks that @assertions@ hold for the final editor state. -- -- @preConditions@, @testActions@ and @assertions@ are each passed the return -- value of @setupActions@. -- runTest :: EditorM a -- ^ Setup actions to initialize the editor. -> (Editor -> a -> Assertion) -- ^ Precondition assertions. Used to check that the editor -- is in the expected state prior to running the test actions. -> (a -> EditorM ()) -- ^ The actions to run as part of the test. The return value -- from the setup action is passed to this. -> (Editor -> a -> Assertion) -- ^ Assertions to check that the editor is in the expected -- state. The return value from the setup action is passed to -- this. -> Config -- ^ The 'Config' to use for this test. 'defaultVimConfig' is -- an example of a value we could provide. -> Assertion runTest setupActions preConditions testActions assertions c = do let (setupEditor, a) = runEditor c setupActions emptyEditor preConditions setupEditor a let finalEditor = fst $ runEditor c (testActions a) setupEditor assertions finalEditor a -- Return the contents of the current buffer as a string. extractBufferString :: Config -> Editor -> String extractBufferString c editor = R.toString $ snd (runEditor c (withCurrentBuffer elemsB) editor) -------------------------------------------------- -- Functions for altering the state of the editor. -- | Insert the given text into the editor inside an update transaction. insertText :: String -> EditorM () insertText text = withCurrentBuffer $ do startUpdateTransactionB insertN (R.fromString text) commitUpdateTransactionB -------------------------------------------------- -- Useful assertions. -- | Asserts that the specified actual value is not equal to the unexpected -- value. The output message will contain the prefix and the actual value. -- -- If the prefix is the empty string (i.e., @\"\"@), then the prefix is omitted -- and only the actual value is output. assertNotEqual :: (Eq a, Show a) => String -- ^ The message prefix -> a -- ^ The expected value -> a -- ^ The actual value -> Assertion assertNotEqual preface expected actual = unless (actual /= expected) (assertFailure msg) where msg = (if null preface then "" else preface ++ "\n") ++ "expected not to get: " ++ show expected -- | Asserts that the contents of the current buffer are equal to the expected -- value. The output message will contain the expected value and the actual value. assertContentOfCurrentBuffer :: Config -> String -> Editor -> Assertion assertContentOfCurrentBuffer c expectedContent editor = assertEqual "Unexpected buffer content" expectedContent (extractBufferString c editor) -- | Asserts that the current buffer is not the specified buffer. The output will -- contain the BufferKey of the current buffer. assertNotCurrentBuffer :: BufferRef -> Editor -> Assertion assertNotCurrentBuffer bufref editor = assertNotEqual "Unexpected current buffer" bufref (currentBuffer editor) -- | Asserts that the current buffer is the expected buffer. The output will -- contain the expected BufferKey and the acutal BufferKey of the current buffer. assertCurrentBuffer :: BufferRef -> Editor -> Assertion assertCurrentBuffer bufref editor = assertEqual "Unexpected current buffer" bufref (currentBuffer editor) yi-0.12.6/src/tests/Vim/EditorManipulations/BufferExCommand.hs0000644000000000000000000001454012533751517022443 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Tests for the :buffer ex command in the Vim keymap -- module Vim.EditorManipulations.BufferExCommand (tests) where import qualified Data.List.NonEmpty as NE import Generic.TestUtils import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit import Yi.Buffer import Yi.Config (Config) import Yi.Editor import Yi.Rope () type BufferName = String -- | Create three buffers and return the 'BufferRef' and buffer name of -- each. createInitialBuffers :: EditorM [(BufferRef, BufferName)] createInitialBuffers = do one <- newBufferE (FileBuffer "one") "Buffer one" two <- newBufferE (FileBuffer "two") "Buffer two" three <- newBufferE (FileBuffer "three") "Buffer three" return [(one, "one"), (two, "two"), (three, "three")] nthBufferRef :: Int -> [(BufferRef, BufferName)] -> BufferRef nthBufferRef n buffers = fst $ buffers !! n nthBufferName :: Int -> [(BufferRef, BufferName)] -> BufferName nthBufferName n buffers = snd $ buffers !! n tests :: Config -> KeyEval -> TestTree tests c ev = testGroup ":buffer" [ testCase ":buffer {bufname} switches to the named buffer" $ do let setupActions = createInitialBuffers preConditions editor buffers = assertNotCurrentBuffer (nthBufferRef 1 buffers) editor testActions buffers = ev $ ":buffer " ++ nthBufferName 1 buffers ++ "" assertions editor buffers = do assertContentOfCurrentBuffer c "Buffer two" editor assertCurrentBuffer (nthBufferRef 1 buffers) editor runTest setupActions preConditions testActions assertions c , testCase ":buffer N switches to the numbered buffer" $ do let setupActions = createInitialBuffers preConditions editor buffers = assertNotCurrentBuffer (nthBufferRef 1 buffers) editor testActions buffers = let (BufferRef bref) = nthBufferRef 1 buffers in ev $ ":buffer " ++ show bref ++ "" assertions editor buffers = do assertContentOfCurrentBuffer c "Buffer two" editor assertCurrentBuffer (nthBufferRef 1 buffers) editor runTest setupActions preConditions testActions assertions c , testCase ":buffer # switches to the previous buffer" $ do let setupActions = createInitialBuffers preConditions editor buffers = assertEqual "Unexpected buffer stack" [nthBufferRef 2 buffers, nthBufferRef 1 buffers] (take 2 . NE.toList $ bufferStack editor) testActions _ = ev $ ":buffer #" assertions editor buffers = do assertEqual "Unexpected buffer stack" [nthBufferRef 1 buffers, nthBufferRef 2 buffers] (take 2 . NE.toList $ bufferStack editor) runTest setupActions preConditions testActions assertions c , testCase ":buffer % is a no-op" $ do let setupActions = createInitialBuffers preConditions editor buffers = assertCurrentBuffer (nthBufferRef 2 buffers) editor testActions _ = ev $ ":buffer %" assertions editor buffers = do assertContentOfCurrentBuffer c "Buffer three" editor assertCurrentBuffer (nthBufferRef 2 buffers) editor runTest setupActions preConditions testActions assertions c , testCase ":buffer is a no-op" $ do let setupActions = createInitialBuffers preConditions editor buffers = assertCurrentBuffer (nthBufferRef 2 buffers) editor testActions _ = ev $ ":buffer" assertions editor buffers = do assertContentOfCurrentBuffer c "Buffer three" editor assertCurrentBuffer (nthBufferRef 2 buffers) editor runTest setupActions preConditions testActions assertions c , testCase "A modified buffer is not abandoned" $ do let setupActions = createInitialBuffers preConditions editor buffers = assertNotCurrentBuffer (nthBufferRef 1 buffers) editor testActions buffers = do withCurrentBuffer $ insertN "The buffer is altered" ev $ ":buffer " ++ nthBufferName 1 buffers ++ "" assertions editor buffers = do assertNotCurrentBuffer (nthBufferRef 1 buffers) editor runTest setupActions preConditions testActions assertions c , testCase "A modified buffer can be abandoned with a bang" $ do let setupActions = createInitialBuffers preConditions editor buffers = assertNotCurrentBuffer (nthBufferRef 1 buffers) editor testActions buffers = do withCurrentBuffer $ insertN "The buffer is altered" ev $ ":buffer! " ++ nthBufferName 1 buffers ++ "" assertions editor buffers = do assertCurrentBuffer (nthBufferRef 1 buffers) editor runTest setupActions preConditions testActions assertions c , testCase ":Nbuffer switches to the numbered buffer" $ do let setupActions = createInitialBuffers preConditions editor buffers = assertNotCurrentBuffer (nthBufferRef 1 buffers) editor testActions buffers = -- return () let (BufferRef bref) = nthBufferRef 1 buffers in ev $ ":" ++ show bref ++ "buffer" -- in ev $ ":buffer " ++ show bref ++ "" assertions editor buffers = do -- assertContentOfCurrentBuffer c "Buffer two" editor assertCurrentBuffer (nthBufferRef 1 buffers) editor runTest setupActions preConditions testActions assertions c -- , testCase "A named buffer can be shown in a split window" $ do -- , testCase "A numbered buffer can be shown in a split window" $ do ] yi-0.12.6/src/tests/Vim/TestExCommandParsers.hs0000644000000000000000000001233512533751517017517 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Vim.TestExCommandParsers (tests) where import Control.Applicative import Data.Maybe import Data.Monoid import qualified Data.Text as T import Test.QuickCheck import Test.Tasty (TestTree, testGroup) import Test.Tasty.QuickCheck import Yi.Keymap.Vim.Common import Yi.Keymap.Vim.Ex import qualified Yi.Keymap.Vim.Ex.Commands.Buffer as Buffer import qualified Yi.Keymap.Vim.Ex.Commands.BufferDelete as BufferDelete import qualified Yi.Keymap.Vim.Ex.Commands.Delete as Delete data CommandParser = CommandParser { cpDescription :: String , cpParser :: String -> Maybe ExCommand , cpNames :: [String] , cpAcceptsBang :: Bool , cpAcceptsCount :: Bool , cpArgs :: Gen String } addingSpace :: Gen String -> Gen String addingSpace = fmap (" " <>) numberString :: Gen String numberString = (\(NonNegative n) -> show n) <$> (arbitrary :: Gen (NonNegative Int)) -- | QuickCheck Generator of buffer identifiers. -- -- A buffer identifier is either an empty string, a "%" character, a "#" -- character, a string containing only numbers (optionally preceeded by -- a space), or a string containing any chars preceeded by a space. E.g., -- -- ["", "%", "#", " myBufferName", " 45", "45"] -- -- TODO Don't select "", "%", "#" half of the time. bufferIdentifier :: Gen String bufferIdentifier = oneof [ addingSpace arbitrary , addingSpace numberString , numberString , oneof [pure "%", pure " %"] , oneof [pure "#", pure " #"] , pure "" ] -- | QuickCheck generator of strings suitable for use as register names in Vim -- ex command lines. Does not include a preceding @"@. registerName :: Gen String registerName = (:[]) <$> oneof [ elements ['0'..'9'] , elements ['a'..'z'] , elements ['A'..'Z'] , elements ['"', '-', '=', '*', '+', '~', '_', '/'] -- TODO Should the read-only registers be included here? -- , element [':', '.', '%', '#'] ] -- | QuickCheck generator of strings suitable for use as counts in Vim ex -- command lines count :: Gen String count = numberString commandParsers :: [CommandParser] commandParsers = [ CommandParser "Buffer.parse" (Buffer.parse . Ev . T.pack) ["buffer", "buf", "bu", "b"] True True bufferIdentifier , CommandParser "BufferDelete.parse" (BufferDelete.parse . Ev . T.pack) ["bdelete", "bdel", "bd"] True False (unwords <$> listOf bufferIdentifier) , CommandParser "Delete.parse" (Delete.parse . Ev . T.pack) ["delete", "del", "de", "d"] -- XXX TODO support these weird abbreviations too? -- :dl, :dell, :delel, :deletl, :deletel -- :dp, :dep, :delp, :delep, :deletp, :deletep True False (oneof [ pure "" , addingSpace registerName , addingSpace count , (<>) <$> addingSpace registerName <*> addingSpace count ]) ] commandString :: CommandParser -> Gen String commandString cp = do name <- elements $ cpNames cp bang <- if cpAcceptsBang cp then elements ["!", ""] else pure "" count' <- if cpAcceptsCount cp then count else pure "" args <- cpArgs cp return $ concat [count', name, bang, args] expectedParserParses :: CommandParser -> TestTree expectedParserParses commandParser = testProperty (cpDescription commandParser <> " parses expected input") $ forAll (commandString commandParser) (isJust . cpParser commandParser) expectedParserSelected :: CommandParser -> TestTree expectedParserSelected expectedCommandParser = testProperty testName $ forAll (commandString expectedCommandParser) $ \s -> let expectedName = expectedCommandName (Ev $ T.pack s) actualName = actualCommandName (Ev $ T.pack s) in counterexample (errorMessage s actualName) (expectedName == actualName) where unE = T.unpack . _unEv expectedCommandName = commandNameFor [cpParser expectedCommandParser . unE] actualCommandName = commandNameFor defExCommandParsers commandNameFor parsers s = cmdShow <$> evStringToExCommand parsers s errorMessage s actualName = "Parsed " <> show s <> " to " <> show actualName <> " command" testName = cpDescription expectedCommandParser <> " selected for expected input" -- | Tests for the Ex command parsers in the Vim Keymap. -- -- Tests that the parsers parse the strings they are expected to and that -- the expected parser is selected for string. -- -- The actions of the ex commands are not tested here. tests :: TestTree tests = testGroup "Vim keymap ex command parsers" [ testGroup "Expected parser parses" $ map expectedParserParses commandParsers , testGroup "Expected parser selected" $ map expectedParserSelected commandParsers ] yi-0.12.6/src/tests/Vim/TestPureBufferManipulations.hs0000644000000000000000000000226312533751517021114 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -- | Tests for pure manipulations of a single buffer in the Vim Keymap. -- -- A manipulation of a single buffer is an operation or sequence of operations -- which do nothing other than change the contents or cursor position of a -- single buffer. -- -- This module loads the tests from files in @src/tests/vimtests@. Adding new -- tests, or altering existing tests is done by editing files there. The format -- should be self explanatory. -- -- If a test is pure and manipulates something other than the contents or cursor -- position of a single buffer, it should be added to the -- 'Vim.TestPureEditorManipulations' module. -- module Vim.TestPureBufferManipulations (getTests) where import qualified Data.Text as T import qualified Generic.TestPureBufferManipulations as GT import Test.Tasty (TestTree) import Yi (extractValue) import Yi.Config.Default (defaultVimConfig) import Yi.Keymap.Vim import Yi.Keymap.Vim.Common getTests :: IO TestTree getTests = GT.getTests defaultVimConfig "src/tests/vimtests" "Vim" (pureEval (extractValue defVimConfig) . Ev . T.pack) yi-0.12.6/src/tests/Vim/TestPureEditorManipulations.hs0000644000000000000000000000223512533751517021130 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} -- | Tests for pure manipulations of the editor in the Vim Keymap. -- -- Pure manipulations of the editor refers to such things as changing layout, -- navigating buffers, creating or deleting buffers, creating or deleting tabs. -- In short, anything which 1) doesn't perform IO and 2) interacts with -- something other than a single buffer. -- -- If a test is pure and manipulates only a single buffer, it would be better -- being part of the 'Vim.TestPureBufferManipulations' module. That module -- provides a nicer way of writing pure single buffer manipulation tests. -- module Vim.TestPureEditorManipulations (tests) where import qualified Data.Text as T import Test.Tasty (TestTree, testGroup) import qualified Vim.EditorManipulations.BufferExCommand as BufferExCommand import Yi (extractValue) import Yi.Config.Default (defaultVimConfig) import Yi.Keymap.Vim import Yi.Keymap.Vim.Common tests :: TestTree tests = testGroup "Vim pure editor manipulation tests" [ BufferExCommand.tests defaultVimConfig (pureEval (extractValue defVimConfig) . Ev . T.pack) ] yi-0.12.6/art/c-source.png0000644000000000000000000000030512533751517013432 0ustar0000000000000000‰PNG  IHDR Í XDgAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&I@IDATÓcèU úÿÿÿÿ£ JÿÑ_Ž|``Òþÿÿ—ƒèóÿÿ‡òÁô—#ú?„ÿh~{90ÀG}C1„®!IEND®B`‚yi-0.12.6/art/dependencies.png0000644000000000000000000000032712533751517014344 0ustar0000000000000000‰PNG  IHDRÉøˆygAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&IRIDATÓM± À0¿ËºtvçÒ¯4^2ò‚¸#Á$R®:™(&yn¹Z«[º™‘T 0ZP1'{Yî…ô"YJ‘ÜÇÿŠ  xù¾ß !Alň»ôIEND®B`‚yi-0.12.6/art/exposed-file-module.png0000644000000000000000000000032512533751517015563 0ustar0000000000000000‰PNG  IHDR Í XDgAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&IPIDATÓ-Ê!À0DA\ûj¸j\ê‚#.WÈqà(„~3b¸÷þ>†²+…\-œ¶t†nËBÅR~Û]B© G¹ÄWØÐÃ\Fþ2‚yÚüžBæ±ÓÕIEND®B`‚yi-0.12.6/art/exposed-module.png0000644000000000000000000000037612533751517014654 0ustar0000000000000000‰PNG  IHDR /ÙyssRGB®ÎégAMA± üa cHRMz&€„ú€èu0ê`:˜pœºQ<|IDAT(S}RÀ ªÿ?º­DõÚu«KÄæX£ÿ渡xÞ·uýwVèü—og =ArÚ„¨ ÈO &„h‹FUÂ@…x€„©$ik“W³ÃåZ[P ÅÇÒ{”þnç €2x 9À{ï&HÑ&8›Ý¾‘âÄÑy“p ä©IEND®B`‚yi-0.12.6/art/h-source.png0000644000000000000000000000031112533751517013434 0ustar0000000000000000‰PNG  IHDR Í XDgAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&IDIDATÓcèU úÿÿÿÿ£ DŸÿÿãˆöÿÿH9ÿ¿DûÿùÿDŸÿ¡a| Ñ?€æàá·—ƒ èBa»{IEND®B`‚yi-0.12.6/art/hidden-file-module.png0000644000000000000000000000034512533751517015351 0ustar0000000000000000‰PNG  IHDR]RgAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&I`IDATÓ-Ì1€0 CQo –^µ[ØÊÖˆ…{pºnÎf OO²ô1Íì<ÞƒS¼ ý£àñÐ ŠGº l?VSx¡ïšv$P‚ ÝcmÒÊ` _èy·„¤ ux Àm®JÄ Â) IEND®B`‚yi-0.12.6/art/hidden-module.png0000644000000000000000000000033012533751517014426 0ustar0000000000000000‰PNG  IHDR /ÙysgAMA± üaIDAT(S}’€ ÇÏ}š?›ƒ®uâb„`•â0·s {?Õù\ÝŸXÃFëíÖø£&И#0{‡ä?`Dj·‹E‡Cš ñÍ*€¼nçà«”@­r ©ü4cÅu&ˆC„½UÜ-ÏØR€ZFÃ÷j2—î t89b½-¨ó¯±ZPBÈéÀ;º 3uIEND®B`‚yi-0.12.6/art/hs-source-folder.png0000644000000000000000000000032012533751517015070 0ustar0000000000000000‰PNG  IHDRÉøˆygAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&IKIDATÓcX V€‹««‹¹@ óíÛ·/`°ÿ öÛÁȨ°ˆ‹ D¤Ä.âSãÙ‚«YÀ0Û,8n4›‹‹IEND®B`‚yi-0.12.6/art/license-file.png0000644000000000000000000000032612533751517014254 0ustar0000000000000000‰PNG  IHDR Í XDgAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&IQIDATÓcèU úÿÿÿÿ£ DØÿø¤?|ßð¡Ÿ¿ šÿ;æÞ¾L°.ø¢ÿsóƒéÜ?À|v(ÿÃèör`€…Ó:jD&C IEND®B`‚yi-0.12.6/art/package.png0000644000000000000000000000030212533751517013302 0ustar0000000000000000‰PNG  IHDR]RgAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&I=IDATÓcX ø@Ðd¬ø Æw (`XÁµâ}}}CWGDdL¨¦@ŒU @À…Ç ‰iKC 9ùIEND®B`‚yi-0.12.6/art/plain-folder.png0000644000000000000000000000027612533751517014275 0ustar0000000000000000‰PNG  IHDRÉøˆygAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&I9IDATÓcX V€‹««‹¹@ óíÛ·/`°ÿ öÛÁȨrE0@ÌvÆA;‹/Ï¢¾IEND®B`‚yi-0.12.6/art/project.png0000644000000000000000000000040512533751517013361 0ustar0000000000000000‰PNG  IHDRbØxsRGB®ÎégAMA± üa cHRMz&€„ú€èu0ê`:˜pœºQ<ƒIDAT(SR À ÓŸó´ýŒe ݉!˜´”«7nbÔÕ=!°`ÉàµW4DøÀ·!¨QÎcÕv™  Äqó®ž,žtä  ƒó*bY ˜èA"x‚[NüJ=§•ƒ­>Ë©zÈ%Nñ±V\ƒßniܨÏtCXŠçÜßÒ¹Gƒ‡ÚIEND®B`‚yi-0.12.6/art/setup-script.png0000644000000000000000000000036512533751517014362 0ustar0000000000000000‰PNG  IHDR]RgAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&IpIDATÓ-Ì1 €0À…ŠM¾°ÓOÙÅ.‹ÿ‘*`™O,.Ý™C·–»E°ÖîSJp˜¼`óLMÛEQÀíb>¤T}Ì‹`S&T)÷Ôw0ß*®köÅôAý7pÏwÃ\û׉Øã1¦ÏüAîÒ IEND®B`‚yi-0.12.6/art/text-file.png0000644000000000000000000000026712533751517013622 0ustar0000000000000000‰PNG  IHDR Í XDgAMA± üa0PLTE€€€€€€€€€ÀÀÀ€€€ÿÿÿÿÿÿÿÿÿÿÿÿO&I2IDATÓcèU úÿÿÿÿ£ Jÿ€Ðúttôgóÿ'ƒ¥ÛËA€)ëCPrÔIEND®B`‚yi-0.12.6/art/yi+lambda-fat-128.png0000644000000000000000000005425512533751517014644 0ustar0000000000000000‰PNG  IHDR€€“®½ˆbKGDùC» pHYsHHFÉk> vpAg€€0á1šWòIDATxÚí]u@TËÛ~æì.°4(¡ vb·bvwwww\óÚÝÝÝʵ[PT D@”îf÷Ì÷Çy×ߧW/ Ï?ÏõrÎœ9³gÞ™y“!_àС“'#"4ÿbE$Î5KbÇ×I\d¨ÄywI\à‚Äv$ÖË%qÌ~‰ýZHüöý»´Ä×KI|îûXQbÞ³]»-Ì̲{Trð»‚ew² _Nt´’ÈÔ@b'g‰ª$®í!qÁIt݉uêý`7ÊJýHbï…ï'±û¬ÄójnÈ9ÈHü1àË /›+±C{‰]¸ÄmhB–1—Ø$…nÌÚÞªÃ%¾M=že+ñÕ§óÊ9‚ ßV|9á´‚–š"q×õ·Ð‘ؾ²Äò¿³»ßßF—Ä“»J¼3Ib•gÖ‚Bã$î@Ó`‰Äž›%¾8Mâ#tƒ6X´Äo#¾œðòò—n'qoÚ·N”8Ï zý|ÙÝï´!âžÄSoJ¼qĪ'™+æt¢çîýòÿ'Í‘øÁ ‰—[K|æýÝ&›,©à—_)ëjH\¤±Äý6IÜ‘”sÖUè:Ev÷;cY\âqoÙ 1Ï—9‚`éD&»ý÷uQË%ÞO‚õ¯e{ßξ±ÊÁá—_)íè·ž(qZéûÑÖ¸½—F‹ÿ»"¸°Ä=Igqîžæ/+–ÆH<ÚPËItgŒÄSFJìvYbž”£•ƒCÈ/'¾Ak‰»RìèG‰씸pQ‰÷‰¯Õk‰g“¡°kƶŸ{ºÄ5¤ñÆuU-(ñ¶Ž7òËêÊÁã§Û|9áú¯ duXâf×%6,¥ãTPA0Sf+LXY¡¦pÀ¾øôçe”çŹÀ—ò…¼€$CÒ@°Ìõă§J?ïÇvýÝ$^u^b?Ö¿ûä÷КŽ«3k$r äÙݯ¶ö„ܤlêKJ¤!.[“½Y;ñ@9t¶‘mg^@°QPQßS€ß^ß/e€‘‰±½Y)À|‡¹›u~Àä†i¼Õr@ÏIo²þ9€›p…xàÜ›Oø6¾‰O ¶3L ´ó–ø:Y ¶~ß´ ‚bñ}!ñN| Š /B;„€Œzñ¤Ù&¾2ÓÑV±n²Äí$®IJ;Ùáìꧬ3ëʦªª¦) à¤×±«+ŠK®»Zº t–éUô£õË…ÇWq;P¼pÉBÕ’¼ôÃZM«Ñ¹›ÛWUtZêÙ|¦8Rý àMy}.‡´ÃH†´OH³`Ð'Á8ÊGâÛ4n^mµ»ß¬»Ä³Éß Tå >2_zÕ›–ôÿ¯dPû9H'²ìðí•Þ–<Þ†‘¸sýt[C¶—a@BßýØD`Å£¿*ô) <šþ ÏÙ÷ï“=’Å)\Óëf¬t§BesÕýT9\-¦…;PÔ¤ø©*jÀ †ÁI“3λ‹¾Œ/ä=È¡€Nz{½î/‰G\”8åò·w22+N¤ÄÌ>ËSR{·ÁC$~×\âÝd~Ý9›þÿ`º0g ÍÈtð•}~„ÄõH©4%Ä5èlÈ~^’â(ɪ¸Œ |pê¯c=V_vÝqf¦! ŽÛ©‡hÑŽ)ÌÐ{«¬jØ(vµøÀª‘@#—s}R§úe+Ô5ú g]}€¿áÅt¡ý´v:œ\›;RŒÁ¥æ}ët_¤e9<ØMs]²ß¯îALë–•DÁäay°¯Äë©Ç/H)ËÛeÒ¯“ƒt"ÃÀ·Wz+’ôƒi+8ôĹÞgÎkq2?E‡IGVƒ {“'`ø)‰“^I,ÐuæôA— 7Û¡!BmZ—±h¡ìJŒotÇ°ƒÀæùÆŽKní¸^îˆ@ôD±´÷Xÿ™A}“ü@=eûÝN­:´Ù1Ê0žbbnQàI¤·ôoœUUV‰É‹>;€î“(ØTâC†¼^Oâç$¸¶.À9øÅá®Àß^‰m•xß[‰EʤãNº‚±V· Íí2RNùÜ–Úoülñïšþ´kÖ¢™@%TC3_OÑJÔm‡„) õ‡í=·°õöÆ”Zoå=t5 ³G'XÙDûçÄ]‰kUP¹ªŠ§x¬«Šf߸”ƒ¬ŒP“¼¾mè® |½·õÂu@ì¬1b ßJÿŠñÀî~ÞÄ¢5ïµU”PôÒ­Ú–ï(r­ö$¿œ‰ÿ»#Óv_®”I%¶ˆVœGäðsžA|5[Ñf?ÛD×"ÔP¨ŒªhæWHÔõÕFÃ×+-” ÊoíÙÊ¢íõQá5·ó¿øQ®Nz·\]H)š’øüûÍÊžÈBå¡ aq¬ Àc0§¿º°*°†Ï/‹þÀë·žŸhn ôó”¨Vò] 7ÀÅ»¹Ý€ž@éeujÛ Û¬\råÞû6%áRBÁ¤)ã]m¿5Rýðh¸K¤G;;ƒ3+ȳ0žÂ‹£Éñ9aÃÙ„Ÿ.àWÇ¿Ì àWUG±ÂP!xw§Dçø±7+žˆ=z~å|àLÀɧëõ€øäø•ÑêÿݦP*jéê½ö?½è#ÐðI“ƒ½WbEÑQœ ±üÿ?Ç&Ì€ è~¾ž‡Á‚Æú] *:¶b2`êm:ǪÀ—ðéb¢jïÁ;rû«PeXµ2xâ)¿žšNE—Â-JHì@V’ ttËG9ízJœŸÌ©ÆìO‹wK|Šü<ÈC0éjvÿŽ r@&á+AÐG`Ÿ0¦ÃÌ„á+f¦|H9šôÖ°ò£M÷gŸ/ <šø°ÿ…ž@¼2n{´9P´Vqÿ*µ€z8tóô™Á`ã€÷áÝx!üÛUX£”A9ÀZ Ý„ç‹c\hðÍâ2ÑàEy>ñ)ÀF°±l+Àº±!ª{ƒõeCtJ¹m2µN²Þž J4bIG²Âä™Y½ŸÄNdÖ­HÖ™\$ºŒM$–™k9L¤Û &eïq²âüEV·YœŠíÏCŽÈd|)ô”HDâþnÄF²ñlk¿cl-Û+TRž§lMº ¨ýÔ×U{5ºo”Ö=0àmx3n @º©xJ‚¡2ª°f;É.°D€¹±»Ì`Øs–HÜ–Ø:þ8ö<Ô( rRÉÓá'<ÖÙe}aÚÙå[ŒâÉ!È™znOÊXšè¬GæŽÚòéLáßác²ìûÃ#²_ ‚B­¤{è@ºåZ²Î¬;›À ePàkù* ð^ü!þ·â+¡„ÀÚ³Nl€¸À¶‡fŸfÄò°I€ú©ú„jû!¦_„® «õÉxÙðÅæ;ÀKßçån/^¹½,t¯ m==l’|(qfv–o!‰kGJü>4»{ô»"Gd¾í"ÝMJ™Å×_‡t Ô?gÔc¶mc϶„­ÄMðLÈ °®¬'fɽ“‹$bÝbœ#|ðmáÁg7/_µzh|Hð÷xå¼}ö¦ã£‘@лÀÐ÷‡€¸ÄØy‘kõõUÉ4½B&B­+±¥[@GŒ­%ªÎ±Fdr@ãÄ“óáñÉ€¼«¼¼ð@/,949ŸÊ{ÃîÊ›q‡îÓT^ªÃÉe€¸CqÎÑËØ„˜INÀ§”qÞº€OaïÇ ý@›÷AÀÛ¾oÂW" DŒÄ'Çý-ê1êæ*ev¿ígèK hÀ02;Þ/'±%x9O[}oÊ>,f{øïŽ5 ,¹Jòƒ0!C›±sçá튷®dÓÀ¦yV3jEÕŽÚÒ[ïÂû&>¢çQ øzÐ+ß ¡g‚"6H<’Ð>¶€±Ž Š¨øqpš¨1VM¹ ŸEKìA¢èQœÄOh>R‚M‚5r¥Èi[$±™© );¯>•3£Ü„ùÉu¹e#¶ '`Òš—¤Ò`¦¤\3p ¦(I–'»ßT§àŸXr]Š¥÷ñq•Ø‚¨Þ”ø1½×;rùYJ÷i<ff÷åàKüá@p”Øj Äy),¸@u‰íÉeÙ¨'q}‰mFJ\ˆÎ¨–^¬ è82_éS°6g÷›~Fk´Ãh@×B·»~ 7HyÝð WË\&ÖëÇãmËNÌJ™ûæÔA½|VN[|½Úµýê£à®zŸ(Š óg÷kå }øÃ@[òP›m)qîáÐUw]89»{ª-tVèº505ü`š(>*lt_¬« l[Ò'Ÿž}]ý;ãMÛöàö|YS§zW…œ¿¿<²=)höÂŽ’_¢X¹6¶?5rZxÚlz6ê»{þ= `©ÂÉå¯oM :«u*è=/ÏÏóð\?Âñú߀ÖÜPŸUŸT­€´kýŽy?IŽ\ß ¯1ÞË\ů貃/ð‡ïLèl;’¶°ƒ(]uîÑtÁ‡Lz09ÒÄ¿”8–t ITÃðÕHËãV«òµ kjþ1×NkEÓ;¯Ì_N¾·Îp:¢,S@ƒ1›ö2úx X\——w×ñx^F ‹D@Ëä£"¹¦$¡+Ý4ùec7ràßD“x>UÔ9G…6šÒY¾•ÿ.I¾íz$(i&£ 7ÜTbñ>±&Ø…ìÛÏ©d™/¥ ¥ÌE/iÂ{SA“ªa¥8dw2Ÿïqæµ´Á¢èa ÛÞ¾{âÝÊúõÿ+/ðßx´ûþâóU—³Íß 8äëm¿¶¸9ÀKñ‚ˆÄ·'> =pF]Ö`ÃÙlâÙ}æÁ¼ÛÒÙ¬ë+;µÇ\Ý[U“_ Ïî_0?†?\hB+Í_ܧj¸TMØôšÄJ:*è‘V[F@Mf¬$ŠnK¦y‰¤TŒ¦\„ -èßKêeqîõÂœíï·|êp0;a“gø‰¼¹¨w5{@Ž:ÅS{£ØÛq®‘-€˜cÞ4ìŸ;¼+Q Ÿƒ…ØP6Š­àÁ¼˜#ÀüÆjl<›Â6ªÑªÞÉÓ€„^ æñU€ÄN‰¾q6ef½ïñÎòé¸æSç¿™µ³ý¬S”¸%Ž¢=4Y„/g÷/ší#¾ F‰Óð×wÿÎ}_'*I³9¯áÔZ¯ðm˜2/ØÛï‚WßÂíyÓŠ¾Ë•j;*;UlÊ nTlÈR ¸°UÆ ùH ©~’yü" òADDˆ=P>ÀæõbÀÛòMÊã–@ؚЫŸ AqrŸ‡@H«àa~'ô;Gô ?´~ELAn`e~î*ñ?”Tõ8å{ø É7Ñ"Õç 9øŠ’®"穱îFÝ`ýíœÜ9®Ö–¡œ¯Œ]þ€sÞ÷ÒÀ7Kîs^s‚³ª]ç¹õr'9”å\ÙZyÚH—s¬Á&¸§Þþ·9…æc:ô¤#–B›SKrƒoÞÂl(H&õ ©s[×X9‘óâ—JN©~só‘¹ÊZßä\ÖG6_~)½<­L†Â:¿IYöä k@a:rÚB?+q)³j§›I IÞZvbvh¾@–@ ^†4¡ÉwÞ$Rb‡[)±å$‰­(G_ñºôÿßeY· e½6ÊC†»:Ûu—zýõ®^l[Úõ)t Hºœ49¡ÖýÏJO{]p‘”¢‘ä }™vOs{ü¤Èé£h53ª¨cB>󹩨fqrvh ±…ö‹Â”e·ÕIУ’\ú”qǀ̃ìë„ß/¸Ëó°½¢Ê醽X½Fy³Öæzy*MV”¼˜y›/˽ 0¯cÑȦwrÞsE«fµÌËåá€^ ^UÀ²•~°aY@ç’Î ½öÑ3ä2yEå¿ŃâfÑ1zl»6-š™g÷Ô#Òe‰ûS”[GZÙí×H¬ë ±MxÅðìê©¡á&Ó0Àɦ¬n]OÀ®S>Ï¢F€£mˆ2}[Ó" ßΠ¿I À@4¨drP¬SÓ¶ƒ•eA¯Ê•ü €©ØÎüwÅ@ÇÑž·ø¾ý+¿ÛˆC¸WÕ›AβëµsFüកi…EY‰Sõ¿ê{²æ¹ê™ÄîëOíŽ&eš9õwº¯è=bn @w¤î)%øEœÃ6åy Ñà‹ø\t0½y)€çG°@BùÇ´ös3ù= &OÇ”{9ž‚?7rviB(•âI .ç`-RÎéا­=‘ŽÑT8%®¡Ä¯i‡ñ”<“üIwИê§Ú²q;“ =@o‚Þmý‘€j‘j„*/7ôä¡–ARÕ¥`'€-2ý†!ãÒ;>MÈá©e*ð¼—ƒžƒLDŽH¾—¸3­xÍ(f 2?-°[b3ª°GG”$€&ôr-~B1¾¤Sˆ 2êѤüÓ¥êÊ^¥Ö3áªðFö0›gv$·?ÀËr9 Ñ< ÐÆó?M(€‚¬ Àº±^˜c»žq¦ú6[ê2õÃXÏ¥gÌ.OV›M#êÏ—EüðÓrÁÈ?„òpÛFÿÞI)­ ZI¬C‘T”þ:âè“.Ò Ý¿j°”æ?tÍt»(ßò­Š'ºcù”ø°¸9Ñ¡âkÞ—·ÝPõ{=Òy £§—0ÛoÞËz%À£¹96xŒsHç~q”dÕ¶†m‚;À.07&,/+&,Ķb=Ñ HvI6NãfâÅ„¾q¦­wº]¼b½·ÄáYû"vÏŸñ‘ò"$ºH,.ÈÆ-ÿ9 C¡¦ 8Ñ_ÿaèWœ*ºµïUtÎXÀö„]§ v—ßÑeÆ GSo¼Á·ïß',ÓirC;Ó>TØÎó(BþÚúú0€1Àº°îl:€ã8϶íe>S²\l4 ŽǪ{ñ²¸ÑH1rKðvàµÒkƃ‚€Ÿ¹o¡瀰Jaë>îÂ_‡uø¸·ìjŸvÞüYǃ}Ðü{K½ó'ÊŠeøç¸Ä¯hÀ.e÷/ø§!GüdÐdêØÃ'0›f^ÑZU}T¾Cù|‹O(ÕÀor?ùß–ã_FÊÉzõ欘/›ÅbAWP ­<ÅkV`mX{6H.œ,&bŠÇL w"¦‡×*x/zcõ¸<p;àý›pÀ×ÌÇüùMàÃJÿ‚^ €çèêá%•³Ê(ù_Åßå÷q  ùþ™5PSxq(ù ¸Q´äNJ)v¢$ÒPO9éAŽøI‘·Q¾)Å”C“O%HLèúÜÀÛ°¾‰ƒ4ñ=¾Ÿ"˜ÉnŠª:#u›ñ¶qÏ¢E Ê1j~HðÑꣾw/À{Û›aOü@þ©À»±€÷´7ÅŸ”"KG. úÄ7ˆ;SP;¨“S|¥??DRõ¥ÿídå%ÎMLªÏJΣtXYxJâ×ͳû÷ÈA²GcÏæ‹]ó;g÷¬ÎÊc7ÏÆÇwn5´í?£¥îŠ«ç©,cØžózåDw á¼ÌÃrë—çÜ<(×1›áœ+K(ÿ2tç«°Z´—½|ƒò.ËÉœƒßB‰K™U7‹Ìc™_o‚ïÔûû–îi>bÁØ<›ü8/Þ¼¤^uûìžÙÅ‹(Ý8êdëÏ”ƒhF[[ª¢kCæ»’ë$nCöÿi›$^EÖƒKž¬8«Äv|0Ó—é5“^**+†éºpÀ$»'bVs") ',ɺßîÏBŽ' vè(‘ÞH‰MÉÓÍ”¢Þ©ðEÉùç!ÝJAÊÞWb¼Ä†ÕgHµîô5ž„Y-W %P-–SÄŠ&:3u{òpyn€ì’ÌKöþžÉFÌ›}dÁZ(#‹ôé›ÍôgDšôÚê2ÜèîÔ T6•t†é6cä;t«‰[“\ãŽyÒáaËKëÎtJôO\w Þ‰zS["Nþ±,õ8Yâ '$Ž^•åãô›ãO”T‡VbJjB+rÞa;Ñ„µ©(±&¸§9î˜Qî?Ê—o¨1ceV2ÑÏÊÍã=O½ÂÑ€â‚"Dw# o&Ÿ¨À"ÄòŠ­`YÃÊ&ßÀø¤qÝ\…Ý>zÇõ[ºGtcôÛfNæþyä€Ù³¹À0Åp¢ÙU@¯£ò¸ÁA@ÑQg¥Þ$@æ'ƒ\Ö²½Be@V]ÞM>­V<„‹²rw@VJ¨'Sì´p[ÖÚ²Þì-€“ì"K vVÝRmH¶jnÑejÛk6¦÷2 šq£(Bþ˜þý"ó?…?¿©`nç¡Ütùi%)Mʤ|¤U¶£•×‰\p­ÈaGIµëŒ¨òp™…J¨Šf€Ž™Ž«Þ@¯¿òŠáešØQ€m¸²ðn O^k›ü§Ã†Ì¦–£r·Êؼµ )X0mja¹Ð餳Yéè4Õ]¢|èÒ9¢Œäã»tª²i²uòÉNã2SX„¹¼3Àgñ)¼%€ÝØÜp{¼Äs~àÁ‚/€H`îx‚«ã!.x‰ü.€÷ðÁ3€7€P„"@4¢ À åPoNÇØ)±òÈéŒÇó\w€Ö>M¯íÈŽoåÏÆo*JR ­mdN*¨Ù‚SM>yû,ê9¿&’o|4Õ»ÿ´Xâûå‹,á]-À¤BÃ….Cû¬iu<ï|‘EË)ü C šô/ë;mt}ôÊ0@>F¾Ná`1[Îþ¢ÛD^DŠœôТwÏ`,`rɤÅ:@…Á+€_ã'Egî#Þ/óæâ\Åe¾[6Ȳú÷y´Q⦵$*–4”=øM€#­ôG=%v*þ¶þ %Š£´átæBŽ-ÏèïOד+lHé6†íÇŒÍs«[‰^)³«,š)‰OÕæ#®ñ¢Ü{|_ËG˜€1¼À—ðè0‘é±>À'·ç½Ï›íÖËÇöÞ•ñ~âqЭª3Iy(8µpryp².«[Ç(Ý ŒCí!qVr·²w½~@`‚•ìQ‹râDqè­(ƒ[¸ÎA–ùÞ!‰¤SéyEâ¡š¿ä‚¬Åo*4¨Cqús);o% Ö‘J[;)T·>¬­ÄOÉƒí¡»Äw5)°ì$v8Nc¿> iéPâ)Yd€C1T)ïÏ7ðµuª?"Áƒ­Ï¦V¨C#3SØ'ë³XÕØ>~óœIæb¯FýÈ÷Ë_éÌŒRŒçšŒ˜žûAž oÜû:ì¼$oÃÉöÝ6—iàÀÞ±(a3Àïð‹¢ €d$# ZI/öRÒÐÞTh9MìxR&F¾Ú©Ø¿Ïo¬úþOãE•Jð–¼1”'Š#á<0ÏAmWZ¶Šm`€„+ âÆ›s¯‹ü~­óþ×i¶ŽíªÅÊ”ð©ºè¢ìqcfM Èž¢Õ+ÉÞ„×æ@ÂÒž $UÐm2|®£ð¥ (BùÜZJœG?}㔟 º¿ÄÞ¤‹¸¬©g@ùSqؤ þÆ?þ4IhÛEâE”ÛO>¨€jß}%k,,_suÀš6›Fzœi¾ÖRnõ>oÞüß"xÞ‰Û©*åTP!® ÀSÿÐW±À’ù tßø+|¼´Nÿ›Ø—vWb 0Ô|äŒu†€£OÁºNíq©8MLÂÿ¢ 3w)oBsò ½ÿ¥0¦`$0\=3¸•$ 1•øé–Q壗d†F¿yv#Ã7uhS_“üM%¶¡RBi :ì…ú¼z­jÈžOËr/ÖëA—ª7>üÓïÐ qbbñøÉ€pN¸+ëÀ¬$"¾å/‡:€ØWl+þØö°›^¸Pÿhñ=ÖBŠÌFžjá°ïÃ÷éû¿žnÜÈUËBÏöc‚¢À³BMËåzJžŽêtž•™¥¬¢¢%Àf$ Å£’ÙãÚH“RmÃ_F‡¿H»ßŽ<4/“GÁ.ÃUH0ÕýÃÕω&èRhÀ4‰Ç6•ø*_íÂvÌ>&|z»Ø÷hW‘¹í¿’¾1/[Bwaˆð_e5Þâ °ÑÂ,!ä¾mÌüè¤Ðæch‹è•ÞnéµÑÛ®_ú 3dxã ždöøÚN•¸¡¦Ê0¾½Ð@$¥îwi#ñRî†u͘~éQú÷ú´Ó“]Ïì‘È*ä­`Jæ£ µ7—ÒòšÊè'…v Yöa)àÿÀoÃËÒKf Öý?n @HªÆy¸x`s÷»»o·;•ÛÊu»é¦· }…³® ìÎ -|Â'žžºD2È `sf À¶¬ #3s|åg ¸KÜ’\³M¦¤íaÁ´WšGº‚nd]¸C;ÔJïxH¨VFb‹T“³þ*Èß‹Q1Îä?0u¶Ä&e~ô E{Ýâ€yË\ÆÖkâŸJ–i;ad. Ta'îlˆMÄÊꩵvmwoðö§”E<‹¯|HEÊ«‹dÿNNsý6N˜+è˜Ìf°ƒ’ˆxüÏ `Sf °…l» °ê¬±pn /dÙÙyù>@&ÈA&äžÂ(a¦ d=dd®€ÌS-„ ÂAY €ufÝÙô †ˆE "Ê×Ö(=Óe:·BâÎtDÛH›1é4hšÓïo”ÑVˆlCNJ°/ ${s[ZAÆ‘`)ò8Ñ´¶(³–U•·L¼MçZ•J*[ëPÊÕÉɹ3P$¢˜y¥¾€ñ0ãF³ý'ӌϬ%k#<xE^LìG|Ýz éå×îG>ð7Q.oª¿ÚþàóJ}b!üÉC±€ö§paækTØ*f)Œ˜>³bcÁÄõ‰mãž1îÑêðó@$"§¹,ün¿º2ò] ¨N©æ'¿ÄÉâBq Èk™`vÀ¼Cî[@±%¬«uìNä}Rt‹IIÅ\Åi=×%)))g’Ôn3?é)ˆ3Û5nQÛTLë¯ðž”x#ÉLûFtÊ1‰íKiק#¯‘Öü¬øãt–%ã%½Bâ6äZjDÕm1(Õ¦j£.:J?emÃ!€ã‡Êt*]«jÚl(àYVU÷6Û'Âa% [Sw¢òÀøk1 àù:¬øb~—ø~O D*xgIYvÅUóD.‹Ÿ•†HpýC5 µì"®39 Þç–¼Ù:¢C àÍŒ—à5ùÅÓ»¿‡ï—¿¸ x/ûðÉ; auü‚˜&@ˆ„ç±:€jÊ9y#€Ä#À¬ýÿÏf [dù“0Ó=– p¾T'_Ç€KÛ+®müÔºƒu;G¹½:ùpòø„8rT¦÷÷N ¬Ì›ÉeØ“\»çÐïëLŸä¾}ÿÒ©’N+ÓÛ“Ÿ¨#9xt¡¢žƒÉµ´ f­Õ²§¸ Q.Ÿ*¨Z ùy^ºA“Æ=_Ú5.غðãò×#O£ÎæáNàVü-"ø:¾ŠC:kÂ(p¶}×>»"Û•¶å;Ø@æ2E•ÔžPz`™µß&¿Èçco]üy!Ï7O ¯7Á A¦~åøµñ¢½´B“ïLÒfÈr³ @ó®m†¾VíïXµë‹)-‡ö ó µ ¨·!1OW뮎†4”{‹Äí)õX+Z Ðê~O‰g‘µÁó€ÖMÿäøC€Á\‰›KZ÷M'˜Ì3u³ ¬r)¢Zøâè.å¤LKç2Í GÁAtbB”if=ègÁo²PÐ _Ž‚qúљޕ¹hÄW®£íx0ţߤ`‘kÄ×Iû?‚ÌI¿š|OÑaÅ-«ÌTW¾^sЃô6’c[¼fþ¬, «"¸ÊlþNþàâ_äuƒ1‰Ãf˜XîµUöI\s²Ä•Èc­ê.‰sÓ‘Á@“_?ƒìãßÀLÌÃ)@O¦×Þ  \¬ 0Œ,7çžn_È¿Î1¬ÔRÀÒÑJÌ·pÜY@æ$r;å)à00I4Ym(ú}6âAq³èà!îós+fÀ¦°Ý‰HDÃ}a™pZÐض‹½˜9Ë+ÌÄÑG݈1^«‚ ú–^zQúN=àmÇ×É'^Î/“îú…u þXoâf %9$aÀWÝȤRZU%ÃJ]¬Ùÿƒe£MÇõ½ï’?_û|kŠqùcÃŒ˜? s&˜ºŠŠŠºG¾c0À,^L|p¾ å¾wæõµ›úªª€pG2€]XýÿŸÈBY¼à„Ô ä/·…½vpŒ~²äað%ß‘‰ž3žéÞ(±2 ½¢D! O3çý_ü";€\d¦9B¾)³ÞQ¼9xÜ ³ý=Ú|¢l½)½ÒýhŽƒƒÏ$žöÝJ5fÌÇä¹ Œ™rgÏ+ ÿ$ÇG¥ûaKC|¬ø”y÷êiAàu?/÷ûúÀËÉ/<ît>ú˜ÿ]= ¾_\|T)@<#nQ?ÌèqL¦ñˆ³‘Ø„ò“þû¾Ës-¶9k<íZ‰u%ÛÕÚvP&‰ÏÄîy‹ói|oðhÅ-œæÇùZ‰H€´oJ›ö#7ò0@/Ìôçö:-4Û;{Á ÍEêÐ….”aQHB.PŽÅ¥¤«ñГõ=‚¿~ Gl2Ó„“Vö%y|…Ñʬΰ4ÒoýÂ8œŠþÛ¡ÐÈØ%¾uÞQK/„œ•mµ^6;N·0j "¿w‰’%#ktÌj›ÇçÉ xåz9òn9 zrth˜5l—ä™Ð@‚á÷£½å¤óˆ!C”&“™ý^Ðæ%•å½%ñF ²IŲn`²È´¤åÙ6Ë·UÜsÁg^×âê0õ£”Ó}2Ü!† `CÙ @žr#ÙXï²Ú`„!àvöªÅ¾Bß½vt/H9;žÌ£g4‚mdF÷ówÁ/"²'l¿ÿÒÐẵ”½­O†ø+ü¦š²æêŠÎƒsWú>Ègƒg‘,ëõ£Éq)ˆ”–÷hgô‚¢èîÑ‘À›‚•BÉ¥9Nã;GNÅJªÂ»‹VÌ6Z–ÜZÐìâ¤"BçAa¼†?+·û‰¤œÓ¿–Q/Êò°‚ÂB âExþ@˜sbúŠVo¿³¾“^hyáC:šžäaq=(£ú÷»áWÑdddO7!­¿é_ç·î¿¨g¥by˾ÎiçøºZ”Á8“­•n~ôúØû € ¶AËÉ<¼;ïÉ]Õ—‚Kˆq¢Xè>¥/Hgû›”˜â%É q•8™‚gpæ«f¿SG8"û¯M—¸e.ã?ÑÔr›ñ¦Üî±îÓÀ¸%-žUû‰mÕ¼òû7ppˆ++Ô>Wß~šî<Óii,?íæѱ+YA|ÓìÊý»ãwäâ©ÓSbSJÏmNÖ"´å-MʆÖp'²ØÓÊaHŒQÍ@ÓOï ³ÿ) 7ýXekd—`ÒÒ4Ò²PâP©A5v67mË´xzðEMÏ|·†P>;ïðŒrûÄS†Üýª¹†iyö¿q•rß}¢­³m*×?~6ìÔ‡åÊ[ö+?Èe¹óÙm¢±h"ZTîŒDó°tt¬"l2›ÁÉIõâÛ;nT>ÚHüÛ/íj«t?JÈ2vB<'Žð«€áé“À”¶²VT>º™óŠÐ ™”ƒeélkIVCÒæüCíÒ_'ÑÊ°*´ì óÅ –ô©þ¨:±ú–a@©$'µ³>`µÁ*$ß&•½¾½ÁBÃN›6»õ»úà]ȽnÖo÷+i…ÕʪX¦ÔÞ‘uÄ”h]R¹^N‘ùåOd„K Œ,TFVgm çœsž;Õ´æÿ 0ÛÃÎ Í—…_T¿ã<ìýÀø|OHá é ÇvT\t#}/?¬tùmÍ:FñêF#$6£³­íA‰ËQô•=me ÒÄ.EZ~Òö»K¬“½ïóoèŠz­ J#Œ}¶i.Pe@µ³-=q¶8P=à\_×Òôó5"+KÜ‚<òcd­à­ù‡åþ^_ºÏÚÓæmßVú¼Ï'zèÄw' B„°>l[ ˆ]Dõiàò¤ ãwzž7žFݸà1R1M¦H r3«FôWA6…Š‘ïÖtÚj×%­DfW%–eÛŠ®³['XÙÈ·ËþCñ§@Ói-Ö ž Œ½?iá΀óõ:m;œÓ¾½¨)Q~!g¾•¯Í8 ?+uŸüŽÐ\—=¥±)ï©4f8ªÕe]ÓU²adׄgÂGa©— ÐÁ·òi< I9YmÖL¸Ü·¹púpÒæXð*@½Y=IU/£Þë%íEFk ŒH[¿'²I¨É•NU,›ß?E‘[Ñ\7>Y3]Çhˆ –4î׫0¼Ð˜}£©of…±zV5Pþ`¥;+fqæ{ó¤a‹³'Ú:¼=2)Å%éHRsg¯X-t –Æ~S} J}ò„dµl8Ž‘Uàãqí®×W½,ó|Òíåo…V ÐñÁ=öˆy ùð¿ ¯á\°`6€°FØ+T^/}¥óà°?zw‡yá@¬^ÌÌð÷éï9«Ì걓€Akƒ{&ϼ&ê\Ñ•)‡ h é&.íú±qù}‘Mॹ\Jʧ¨mYóÜdÒû÷VVê†0ïfØëÍlÃ7'§Eͱ>®¡¯8Ðꯀj klu5Ì]réÛ¬Äçè5q¸ºj `n~ÈÚ•‘µ–KýÉ¡cCö8 ÄÛÆŸŒ)q'@i®?ÊðÈÉÏyv¿³òÓÊlL)¾*-“x‘¶vˆ‰ÄN¤0Ò8Õ²aÚ<Æ’§[fï’gØeÚ´_®°ñáŽS¼ðÑ| ?¨ó«©öðÇK0H5aF|(Àã€\~î¶g™Ê Á=áhÌt샮¿ï«OIß…¾ýÛ}Ø–Ä=®;^β ÷|iû¼ï­Ï¥JåäÑçHJÎFTæ¼9Ù¯ËQÁsò`dõˆ$åè¦ÌÛ«¢SûnrunCùr¥Ràӭ«×[)U¡R»WvNîSÄ,Ø,6OC »Ïž1[àcp€×›ÅÀVÏ §Çw^oñ²¸ß!ý=•µ—M’*í¯мÐ]ÖëÊì[€ÕØÜyí{—(mm›”Ðp¤¢Žâ–á­]s5Ù…sª‰ŸÅ²ìš‘¸Âv‰«ÑÚ›ÌOæ”–YNÅ$cÉ 6QâPÚ?¦ /0I[®ï®ü¦cbCËá– lí­Þ$['¿N®v 4ïûñ:µãÁÁñ]ÿÿA¸*xÈFow¾.ø¨80wôÌ>mZ1s¢ãÃÿ«NÍ<,Æ…' X›V÷4®[T ÒT¦Œ>í)²¿)]mÊÐûÎúv£~ä°îÛBÖ’äÝ?ösè’’v39"uÕ²$V|dÇI]óLÙ÷¬]‡ÛÛLj\¶r Õ';ŸÕ:s7Ô^c0²/à>äñð+?]_ÙJyÊHh’Ü,¾¿´ÐkUm˜)`m<É< ;©ï€¬ 'ÞJÊÈ.´ƒŠ»›#¾ÄÏ"R@+£­ä¬¬Ä*rMÑDõY~}ç—yåZQ'’€˜EÚa¹©Ö=™-ü-³üOú-ò Ì,=9°Y,Ù48Õ q!”h á«ÑįE=ŸS{üýíûU¤,½VAâ”»ð.å-à‡3vÜëPÌÅaÊ›`™ÚyöYtà>"pìèM‚a㣹ž_:Ã$ðA÷{%Ϧ»L `ÔÇ(Òü,ÐaPÕä@½­ ;v³ÃûôÖü1¿.¶ €âJÈÚIµ¦ "n[rÀ—øE<¢DútiKŸ@‚+Å.HeâkP™ÂE‡R2Hí'þgxã-(.)Ât·l‰°YÐZ•™‹Â‘çÐÄjIù{Í4Qk_M|N{RÎM¡LG]Éeïκ.ƒ'¾·©¶áI-´B–öÓɽuIÉÃºÛ ±n<8x¡O:M‰Tò ±?X|.0hÅpßÕ‹€F\,ûØŠ@…î[€?æÿü{âk`FæåŽô%Ègýw¡‘?¿Š'à”ÎþÉcкeª·½ùáÈJ̽bŽ€`,”Mdî²0yÀ¶b,“܃¥ÞÁEbÕw. Áö‰bŽ+ëFÚéxR€0wÈšqK"—éä2Ü„9¹¿[ˆ\ý@}P5OþwXƒÐƒ0ú;µ'ü -РÀÒ÷œÖæ@·½WÌ ØïôU\!öøaÞ‚›Ažza¦ftd\Kº“œ´ü";íñ•„§‰Ô@ãß 1S™Â”Yì»Á€ Ìd·ÍT¬íåZx<éáÈK·€cë/¯ÄÉãVFîKoo9Õ² p•xÅë7wx4­ÀÏèÈ’UÿkÜï-ñ¾Þ™õ™N]½@m¡îöNã€Á±#š¬¶÷ÐuÒÄÅâ1À~/…–_Û<·¡LJ¨’³ð›ïÊÕ•xäi¢ë’Ilû‹]XAVFX Êc1;%Òð_êwÎk"ðÄø‘á¥u€G±'¯->¬õæ5 Hhœk QXëQP‘eöP´Ú^ú¼hÅU5ÖºÅ,šiÖÑYºY#JýpBpƒ`æû€VvmúŽLõh:ºo ï§¯0^ ˆEGµ€|ÀdH ZÒ­¹jMÖ¤­[â{7½-ý.øE”€©ã³DW!ÉÆo$´­-X?6ˆ-kó‚™06`,Z¨$ìHp‰m|jó±å»ÙÀÓcî÷¯ÕÜCÇ^y¼sð¾â¾ˆµÙÙ@iæ?œp+ÑQâÁ´"m#×[4OWsYcÒ¬§<–§¹‰pF;Àö]L¡…@ÛžŸª5«q¬õ@æ!‹Gܜ뉧ñ³}z¡&3ñ(ïUŸ °ªrð—ßœlva}R9 W'‹:¦ˆ ê8*öl÷;xŽ§¸ÑümržäˆÄå@ðá K~Oãgu¯¯<⟿VxµäåÍ{&@ô®(ÃÐó€ø\¼ªÖT™—Üp´_ßS…@%¨R¨ŠíÏ>ñIÊQLÆJ­Ö4Ý-š¬3­fuè÷|Иe±@©âN2ç"¯ÅKŠ•¥‚)â0 }5SƒŒŽR)Øì ©oƒ´,óûá—ÕH.ž€o.ߟfÀÛš¯÷øÊ*¨_~zõ®Ö˜“×;º=;è©“¼^±êæð#À¬OSO·èl-·¡Èø@à^‘ÛïNF‘#î|5ñµ€Ž¥N;½€¢¯b‹î"mï’­Øà}vßâ£Ä£ÉUç(mõÛQ6eýt»pÇ·‹ ˆÊ ¼ñ~Ýáa@e¨òO™üÿ. dþ²T®¤ÄM?¿ÇŸªøEw¬cŒ1fá ´ȪWZRDV´V¥ƒãÚÇ>Ž±ÑáR`›O›|F)OSÊ&ÕÇgW£4£j¢5``o°Êd1PâQ©¥5žM+×t)ÜØîÖäÐà)<à–jc2²K륱@GfCQFâšÔ¿IäÑà¼þîšQOJñJÙ™ô8n{ÄfeÀªˆÕ³|gVÎVmSnÏP€|ùKdP%¥¯¡Cùzkø Úü‡ýq"àg×PŒ) ªR´V¸ç_ý¢È Øí„D#Üð>’‘ŒÄω>ÒŽí؇÷€‰·éDËÛ@9¯ þ 5{;´q-ê[q €Il:;€K÷/Œèq;=özøàâ'VY»‡Œ#Ç%kµ»>ÃApòS|üJªÚƒ2&YÜNc{”¨EcuÑ´Ÿ:ìÞç3)Ú>fâ&}ÀñHc's@,#æUOÈìaH¢”~4»hþ’Fe*DG¦D*î?0³ßàGñ“ è¼]–’VN¤,¿Ç©öËIréœ@öå c†P|4´M÷Ä÷A«˜¥˜Ÿ³Î4¾Ûô|¿6À„~Sï{ôŸ3øÌò†€“eY¡Îc@O©ìfPPíJŸ˜à¾+<ìÓå4Ž#›š=ãkD}½È¯à(í‹F“AZ'~2¹_¡p›•äÚ­u ½~Q^»Ý—¶ÇÎО…ꔄÑÂlA@ R”Yã¡K:^ôݘiáËñ-XÑûn"×ô…4ŽJ-œË³ÙtÐ¥zõ¤|©Gq(UWòé·  !A/ÆxÖ° µº›×¨Z¥z¯–›€š»jm_ È×þKqÈoÈuNÍ{‰Ïq•¸\­Ø_lÐHÌ•X#îï›ÖŸz´õv²Þ`1`UQ»Nˆ'´»îG!§b¨UèÈ1š@# îÑO£ài…NÙˆ×S{Éa)f¤Ä†äi©½  G“'=¯Žt>˜´Tè~¬w¡9WÝgºoõ÷¼4/$¾†¤ÔÚþ¯-ª=–Xƒ±i r!ónuÚ|¢,ɹ(šóCFw8ÃY€¶@úä•› 9ÕÆKÜ„VøÚTnÙŠ²Ù*ÒŸ:b ²¶@î'y®8øÕÃj5n=¨éæ\£] `ëe·»ð @¶JvT¾'rÑ}ÅCê*Vcþöû¬3&…çõíçëµs·]Òó¤Åñª©µµë §•6ù£ö¾ Š‚,D±É^ßu,³fFj9ñ9m‰}éßA[åäP㣠~OLI¼–€¨H¿ség©>ª4 ñ×Àµ„+µ÷Ô¬'Z_pœ¸ÔjÑx`$ œŽ >Oàð¿Rk]J„Ò‡2<œ¥#Mx*YRõIWÒ’‚¯ä”†]Fu”ñ ?­¿–:F+ˆ=eò©J„#9²èR+ ˜’ìÝöT]·<ùª[R.6=×L{£×ðge«ÈÜ/òj¶t¾Ó®)PóVíæíÛ¶sí62„$ÁXv—ŠÓÄ$n¸Ê÷!Õbž‚®`'{¾gÑäccË4h8;òÕ6/á^üÊ4c—ç¿;§¢s ƒÄ[2¨°†wú=R&¥b Éòk×ß/ñR$A²÷KrGi×^Wr¼YKö£NÚ¾‘ÆA¨ÇÕ>Ûæ 꼬7½óv€ýÍÖ³‡’¹‡öÅWµBEt¤$²Ûkþòí@%ú=OS0—¥¦nYOjÓ¸yUȨf4´º¢´Bos¸¬»Ä:Ú&ÅrÊ´7¸‚[L ˜ŸÉ5,ÏU ÆþZÏÛÆu¼ëÏë²°«”ײH@%|’¹âJqŽÈñ®x[}À ü9¤)UDxÉÊ=ö[×½ÚíUî^¼Š|äå#é‚Õÿ}¿ŠVÌØ ?öÒšòæÍ(‡âZ*Ó„Wh׎Šò/¼¥£ËdûI¼¤‰®N§áÿ Yò+ÑÊ:ŒòõctjwÆYÅnˆììê½5|Úi@~X¶Sž¨ePG¯ƒÀº³Þl.Àwò­|*2Hè’®©/)sÏQ>Š ï„c»Pt©åW¢AF1Ÿ³Oÿ´Ðr+X“ÂV+Ж^§Y¶õ¸:a`ÒÖSF]ö±&Ž›Öï@W «YϳùöÎÅãüõì v«Ox€{ü,ÒùÁœæâר§žÝMÚÚiªëžÒîþšhQi,Ï­G+K}2_í¤ º™¢ZjP4‚â{qû„MG¬ëôüQFÜ„r1N'ÁäIaÇj×´ŽÐ—H¦ïd Esþ£…ý1[cÌÛ;vl½9Õ¸Õä†ÿÑHN(‹ºëDZ¥ÔPC•ÖÖ¿‡Jä°Õî³UÀb¬eS»uŸÿE —úöýŠG›üô…H´!”®;éR9ü”§ô­–5ÇÕNlŒ“Oz¼{ Ð{iÿ% ;ö4)3`]Ø`á ÖË«W¸»ü4~p…ˆ$¥åVÛ–¶-ú I¦­bQRj©=O¡­pÔNí®/KG§MtÄ:DJ¦V4‘ ¾Êœ+ÒJAgÚGtæÿk¤Ä­)u˜ë‰WÓÑà= ñëÊB?2wN'O¼€öim!ªUäá `ë¸ã'n”q;yˆ|+ßÈ'l:›ÃŽãsºñƒ‚2Rõ{/q©%#J_ªù¹s¹Îüöý:ë‘ë§/I¦¥¸Jr˜´Ê*×Ì¾|”"(ñ±ÔÉš]€aåGÚ° h9´ãÊI@±ú%âªd/d±ò@´•ê®®à"߉ VŸ% Ž2ï[Õ_?óª÷`æÿ Á¨H­¤AE+otêJ1€i“ÍI‰äMzwiGp”’®¤­õX²G»”‘¸1åœ@AQW(¡JY]e•$Ü ÊM³é¨›æAT±È9Áo­.›\&ŽÜz_¹¼÷8 ÖÄ»Èþa2dù°4cÃØh¶¡Owgû:§;U•Q­ÁFTJÍ(öÛ÷鑲7ÏOw¬¥ˆ¢3æ(:Ã΢1Xs–KOQ¨/q gØ­Ê{­H$ÐóNß“óßcŽOì½½PùMUëfÝ®ºÛ”Q&†««|ßÁg!ƒ•AŸß›”;ÛB_÷òzx_‘€·žo:=¥¤J3EµÜúk "¥Rœ–é©/ÐJßþ¢ÄhEoJ+}7Ò6¢•u9ù¸ß%ŠPS‰y†ÎÒN%×vUb-é0Ôi^)cZE_óv4Ù2xê6àü¢3›7çR‚SÎ$¬ÐGðÆ—Gžæ{â ^0‡/;&êÅ5s%Çž:©D)0ò+0OYú,B§L8yN-$«Àu £éÃk@:úÚz‚­Öm©»Y¿Jb®Z]ji¿XV¸™¥kùÁíåm·Ù*2ŸƒBÄpñ•º€«ÿׂJì){#0œÁμøb>]„#ŒkTcZû?^¦÷»ésèÐþÊ‹ó¨ 64•.kÛ’„xÚœ&yjyMp²æ}æ¡[Úú‘ÝH"Ç¡%tt*LG*×Üim)ö`lшëÀ>Ï]‹g?Â[„mû¸h~§ÕØ¡º€é'Ó«'€XG,..ð /ù=H1ÿµÿ <B¡‚°Åæ}l§˜m¯æRój”¢©”,UÄá'G:=U´õ¼)q7:Óè/ñÍ)'=üöý)‡e•dåÓn-èµ°ÿ¼…®÷õ3pþ_"[mW)o÷¢ÃnÏ­ø€§ð(q¤³]2þçn c– À4LD :>ªOhO ä~P¨ iQRÄ@¸pí–¹ÉOÂiá–¬Àª²†Â€í`û˜/€"(Æ*SûB¬+¾½¸Vœ¦Þ¿á±ÇÛ5gÔ&Éž'Þt6ÕÒeøwG¥!CæÅk!ém)áEÂøزÀ‰‘G«þ]X³vE™Á>€Ïµw½ŸÎ£ŒN¦fzBoü/ÚP“æ+°l[ $÷N.’XÃ_ž|În×/J[z-k+²{„SC¹ÇPœõî(‰[Ñ;„ÌU×IÙts¦Ä£ÞÍøWÃKìˆQÿFgz6*å%ß$wSèË·‰­ÅÚê}‚Ažã»’šMf3pHn™l‘hìú°Ýbº70eÖ8eƒÁÀêØ ©=¹vv™\½|I±»à]ííã'ý€°j¡ƒº‰÷ÆÄÍØT6‡ùSy²Nû+ótêFé·¹½ÃpK±).†¢ÊXP*±®$V¤±:ï;:2Åý¢AX™…w´¢Ž¢Á#óô¶Äóp¹ØxŒ‡qóKû,<Õø°éìÑÍ•«˜eá1€¬µlˆ¼%„Y 9seCI ‹/èË®>3ß•xº xý0àbš“ššPHùôìáï!³ƒ¨˜¶)aÅKÇ?ž‹\`šJGm¤j²ç¿)žë»€d$!ÚGQ‰)Ǿø§åµkzÛT›dqc/DÎýßåò6ò™:€r¨þ£€ò£²¾á( Ÿ»½^ñC€uoÛ¡&áaÅ?=úìVëOŽÌXEfÏrEn§ÉÆKZs¶W[ÌÉ+ñôŸ×7ô§@ ÓÝHÉS‹ ýÑå1ŠÂ:Á@ÑüE/W>ÔÙ°j· d³Òvµ“p“Å–ïÅ5E”Î jjä«VÀ†]kFŠî¶½-;ñ ­O=Eº™N×(»Gökdz4àá Sê¨Ã{Ì^0ûúb>Ñ@ì¾õ6žã)¿Q7 Bºö!"D¨Ö•õd³±‹ØD<¸=½Rno `—Á¶šÓs17bª„ÏHsã”M6†\ZÈaƘV&ý»{ô52<øˉ¯ -ó0²·×2Z.  è0>‡Oç®{Ä^°|€³u£€žËúL˜·0Z`lažf žQ¤CàììêÁ¯æ†Ìœà{ÏØ£žXýšRïÎÔ:7µ¦õß6« tˆõGGtÅ”ìîej“NC™aY 3¶ørâ3rìCf yÀ™tÌô7"»/ÎF³ _Äçò΀[«;öù;¢¶N)ÄVˆ9‘/Ó{CØHf®Á¨“ý²êÉ¿:ÖoÜzèÙBÀ¶Ÿ]ùÎú¯n>¹þüÄß;çžÚ{|új±ÍÎ;<nÝ‚`hYÀ,ëNid›‘5ìNç¬îÁ·SéÌ”˜ïÿaðí4#Ç¡-]f•F‡™ €FL`SÙ^@ôˆ½«F—Zîì:µ=lâšÄ>ŽÜ‘YÉco(‹¬{›åãð‹C“ûq_¾£ÓÃo–þJ§Fv>›ßuñ½¿É®úÛFLS›n|ôæÁ£‹ÁrAÉ3É¡9MXµ¸—쥫ßÕ8hà“ø©ñÆÑ-¶u>~÷¼<Áp­ÒX¥ ͸Ç}5ÿ’ÈdĤËr¦D0å)ÌÙ<éßžø)Ùâ6J„Pb}ZÚÌht«ÙFöPVë©dÉg·ùo žÔàa÷ó—ÏÜÞÄKRn8ã Ö|$íoŠÒ{Q;»‡ãWÅaŸS1Q[3Xèuz°¡BЦÇáBXÃOoº>?n|äÞŠúÀ•»uw o¦ÆVËî^u:ÖWtiûÐc\ФS»N©_'þULkSx1ž_ôL¥mê±oÏ7%α$‘W’ÞZ3%®J.ç¥è(bF@NO<09ÍàÛ)B®›i…«Q0‹Ç9uhA S _Œ÷)þî©ûýö ã*Œ˜â¬Ó‚lÆPj'Yé*RætJÌxȆCN¾ˆ´ð îÜ­úa–°R°=º'ùcÒÞÄIVþÿ8^[¾??pdìÁ\Kw! ƒ÷ûqoð ôéiGÓJ-\åzVè[pþøÐglÛÆž¾Î÷ó=|þRc¾%Ç0…Í3W‰?'‘¥=ª#™‘ËS0WR&W¦Þ¶‹ÄFšTö×þ»wá£~P8cÌÊìÓpHÖqz0'E’¼Óɧےt›(l¶åºÖ&ÒÔ»¦Äû~úÜp¿ >"D¹%‘„ø¥çÙnv}^·qÇ71¯'=Þ ,¾wóü]ÀÓ¾îóÝjê1ꪨRœV”ö)s¿Îl`ìüIuvŒôýÁÆj˜ðú¼&OŽ$ǹò0Œ'ó°\fNGH9å0 # ÊCäöOkðåÄ·#ñ:²o7›™uCú# ¼&žúlÀ—[°Â?¶‡Z…t&t¸B?h;ú#´Œ̶øò{,j é|]D”cõJVö W zITlèCàZð•¦{GçÎ>·q%ò28Éo€©˜€L,Äf^Å<Áz<0+qó麀M mbÁŠ€¸Jœ+f}J^ ¢ ¾ Ñ©vá˶¦ ÿ7Šh6>Ë_á‡pŒ¬/¾½øšÌ53);lè…´µBý/: åLü¬Wœ ú·>žÁƒ»%¾KˆyÔ#£½Æ•rYÍ÷¹>âŒ?3eþî¹@]“7ºµ ­ טj™?)=ˆ‹Œ›µð›ãÛâå=Y„P'Ëæ•Dá6o§ÌF­i!ì·û»àˉŸ›JX-#í¢«&En¦~ÁdØCg*õäÿV¾œŸ/ñ:³ÇøüwûQô“Φ”R—'!™Šoÿ~û¥ï”—×0€Çóq gÔaG«SËìúä¾ä 0Ê`ü¡­"Pe@µ3-<ý!ú^ÆËè@‹:É+ii<€O¦ ¼ ìî0ÃÌ(Š—ÝOJÁv”¬uéno•Æ/Ùð_àˉŸ‡ÌË7KÜ’D²ŒKÓ%8GÿÇ3µ»^M9ÝÖ’c4ˆ;ù3“]ÿÅ÷%åÍFhõëì~ã?_ ‚Š±˜KQ©ÏÎÎñøe@,+æUO> sÝÇ@™5åþ®ÿ ZxÔêuEQÓÆ;nÛ ÔºU§c‡Ë€ÉeÓ^–"€§xÃÒQ%R¸ <—= û¾3 p{øüŒ…J {ÔU⎤ËêMõ'®¾“Æ)ÑýkÁùYðåÄ·¥äGSxf+ ce?Y!‘Ô@;r´£‰{I™¾*°l¤ÄVΛ’v?œò„h2Ãüì•–~[|Û:Õ¾ˆÄë(¶Ã|òæ ðo€mb;Ø+€-`ëG ¹G²MÂÀ÷ðû/¶ï%žµÜW?^¹5Ð÷Có7î@┄ü±VþÆ2 øw¿ì\óN*² _b ÛS°]d·­ î7ˆévD‹ñø*-@›)ÚöyœÆÑ\™Ú÷ξ8{ZÁVÑ–¹¹¦†]íÌùÙ~”t2v$½8yÚ…Yï4%3GÉcþÔ2Ð ¾üž5qäƒè,<¾kãTÃsÙ86‰íØ@6AH¸7÷Q‘#B­Ÿ7ïfz^ú>/{g>´-èÌû €o5ŸPϵ€õmÛçuÆ]Úö}”²rŠp–˜…ì,€÷xǵL DS’Ñ«”9i+•]£7]©¹2­ß7 €Ò”þyiSí=”ÉÔ_ë»àä°[‹˜ì ( ùL~”2˃t¯iËIa—”Ç5ås¶ðgàKA ³EâAT¨diÍRÏIHQ§(Œ"¬"À^0V`å˜3;  :ÃHÚ˜Ô!Áˆ_gÕЫ¥\m8P®V†ªq‹¸L4ðoøc|/ÏeŠÈ%ñer%ÞNÖ©ëäBûùÍ~ô{&°wº¹K,3Ȥ߅Vâ˜GSf·tÄxF•mü©°…;™ÓÞÑÖ:‚VüÈv««æLèü¾rrIïDgäéä(Sü6 }ÍFM&!kØ°ëÉúb>€ØÎ^X€Ù¼=À‡ñ¼<€$$!_ç» °ò`²ûŸ§ ¹TõyðÅŽÍèï@ÑÒ?'R´Z;Zaõµ¬(£ ÌŒ¡ KñÛŸ(›í£‘¿'eÙ£2¿¦äáäŠC‰Ľ9;‰¯täòíDZòd¶mFÂ2òËë2 ‰s$~GG‘st9D@îT2.©GV}ÿ_éŒÉ>>š’N¤4Òº ¾¼-”|þo“yìm‰ïÓýÏIÆ…,—8ŒŠªº¦…œ žƒìÄ—ß½’ê/T#3qÊdÕ”Ž˜6Ò÷”0R_£öeò8¸@;^ZáÕC²k>ü'öÖæé>:tEXtcomment Created with Inkscape (http://www.inkscape.org/) †µIEND®B`‚yi-0.12.6/art/yi+lambda-fat-16.png0000644000000000000000000000271312533751517014550 0ustar0000000000000000‰PNG  IHDROc#"bKGDùC» pHYsHHFÉk> vpAg\Æ­ÃIDATHÇ­•kTWÇg7¢!(ä!jŠ(…PA£Ò†X¡© jD(…ž*- ´Bµßl‹U©ÕRZÑ‚p@°>@Ä Cˆ!l?ìöƒôXm÷ËïÌΙÿ™¹÷.’Ÿ_T44“–Õ¸€+âMXMPô¡Ò6H€Í¸¯õƒCÔj#é…$F LF-þ$ÀÄsûËñ×À.ƒ—M^+ÁÄ"D(!ã—çôç1ýÚŽ¦ eéö¬kÜL÷³ËÚ‚Ä4ÍÇdª, 0FW£#9’|ü:èËæ¨ÆAøgJ…‡î_ñ+¿›¿Ž“¶L:²fäÞàÐN;y^÷ÑG\ܯ¿ë“…­aí³Œ´)ï»LÄcí)oÚ׬)+ ó˜ÅIlǯ'\s¸Ç—¨ŸÆz¶úÌûp3Ž{Ïd¬^O‚9À^¸ ±ŸUò–P2ºéÀÀ’üFØ'EïêÝTK˜8ÌMŒ¯’sv:Íâ{ 0¯j]Pù›W@ÿÝ­O&Øq ¸Àƒez©‘‹QÊÔ)xÁôX«0»0['»Mó8ìt†9ã¼%CL­_Tû´p9{ô- p~AŽÀ…^n`±ÀºÌ£Å“&òu+×6ŽíÐ ôc¬®ƒg¡m'ý£Fnùp¦äï8“"2Qëÿ ZJpô³Í^X~áÿiØ¥˜kE.Á¨ÕÇnæj„#ÏrlŸ"•-px|ø¾“ÙQs'b£˜ØÇφZhù?F ôs¶œß&ð°³ q•ˆܽP."AýÑÎZãê…g¹òª‘üdÐ}XEÞò/ my•î´.V›n¹¨da!~´Æ*Uªò‡‹j‘ËH2êv ÒŽQ)&Ta=äž/ÃÔHÁENåa]1¾Q›¡×®g¹B$¬Â· !÷%-)õŽONVÕy3h_Â](k%O3FÜÊ€^‘lS7–©y¦ùD9-W÷Ä=RÏÓ¶û¶å6D:D9E83¼bÄŽ».ì.¨è±Wª÷ÖÓM{âw|Ž( €ò#ì»ah zù,ç~ÈÀŒoï¥eúINPÏk~_ÿ€çM·RtØŸØ{z ½1îPkÒ½kuG2½p h`ª½ÍA+~÷)D!™ÇµºÔŠ/–e:tEXtcomment Created with Inkscape (http://www.inkscape.org/) †µIEND®B`‚yi-0.12.6/art/yi+lambda-fat-32.png0000644000000000000000000000742112533751517014547 0ustar0000000000000000‰PNG  IHDR #ꦷbKGDùC» pHYsHHFÉk> vpAg ‡úœVIDAThÞÅ™y\Íé÷ÀÏç.uëê¶/n®"ML{2JIeT(T¨e 1d„dÍØ*4ÙeåV*•2"ËWÖŒ­ÅÒ†6í®êÞêžßÏãû{á»à;^Î?ï×ýÜg;çy>çœç|øD‹32š›ßýb‡Z_"œÒ 0À¸Gcø ä2mò>ínNøÐiú°)×D¼ÑoÛÚ¸‹=”<7MXmCØ6æS×÷¥Â|šÂ0Œ.ða°ˆpò+ :…&L3‹ÙùÌ%æ>k1 eì™1h"×ê Àu^o¯/$TK dßþZàüëÇ­ÂÅ©A”ßµ÷õõôTWÿ¸ÇÃè§|Ñ­qaÙ>÷‹ñÕÙ'uWUØ”¬^û›ö0ÝÞ}mX'äzò™òH‡ä5'ìRÜÓªØâÿÚÂ$é&\8{?–nˆa¯Â]{ w¤ÓÍøZùLa\ •Ûµ‹ š¿¶¼ãd>izаY¶›^Ô8»ÇŒÙ1û.â ç¦;‡E"ªIÔOêf òzñù?ÉÍ)KÀºò¢„ô¿H7`ëcBû_è„üo­ñ¢M?PAx_“°²ð•³Š‰fi•ƒZhe\¥^ê 5ŒõCfNÛx 12e‹zŽrçáðykˆõü–QÃö@#´3£¿µ~ÿUXí„fÔY $t£QÂÒMušh¯4R`IÙzœ£Ôž©ÇèÆ"†·¬‘Š!.ž¦vh#¢CÑpwï£fÐq–*ø|k ?S”«Mè;ì2Ž0X°´û û*W±÷Ná£|DÃÒþÖ浈–Ö0â–ÜB : ôÀEÒ^0é[kô™â@ÃX.ÝÁ[ôd¤Ñ“òÔQ8Gå€jÄÓ£ªþ|€x4!Ñ¥²1éVÚÅF/Ĥi w—57uv^FP,]¯üù+ùFÂÒ ÔÐ%T5Ýrr»[ÞEA_íµ:A¢ê¼YUÛ¹ n·ß¥sÃqžÕqIÄI^þUá¡hÕß­óeÝúÑL1”^nÌæj4¶;)>à PnjIûImD‚ß»»z1½# ëÕZ}[/4¬…òÆ‹mFÊn<1™*„rõ¹ãyýáÇ“»R ГØý{—wúª×£-f|7“[WôúÆšNšt[v¾‹ ¿Ôì/ë† 5+ 묃¯;͔͉Žâ½0˜¬û‹ùÊ×£êNé}¿Ÿ‰âø´Èäœ ¼-œ{wÊyìéÍЛÜÏŠ½gÐ(Ó6ûÕ°TIª4IE@™ÇopR»éV^Ã24ÏD&§lO˜M·ˆ B«rB5Ì ê„å•_jÿQlÿ ,®zRÍC»¼]iNSˆe¬3ÞN^~vs«u'øû¬p¯¡ M·sÑË}ˆGK—W F<£›í,9‡˜š“U.Œ˜®™ãÝa¦GÚîMxºEy=aÍ Ý}îŠYŸÛá}Q  O ™Ú!7••:TÃCÆßEØ&+µóŽó$Ê©` ç #k 5DšÏtW„'í_¤ö´õ<è¾P·¯öxùh¨½™Yž)Ƚ’]¿àÚä+Õ)­ãº÷Ù^V$zNo£>ôn°Þš—šñ>WƒÏô\Zà°šN8µŒÐ–þ®ãŽýcÁÒÅÕ{v)8ü:¼Ì[C]È®d#‡ ÐÒ˜T­tÜ3dê,wk׃Ò3Òéí×we)ÌQ8Ík3½"hUÔŠ€²¾²ŠÎp°—U¯tue‹«VÇœ$QcÐKÛǶž_g\õ&Ûy}̪@¯"Î,ªø„u4 Õxÿoû±œ%pÞ@BïïÎ&<^„Î(…›ŠjJ+Sõ‡mvl_ˆ¾lÐaDtDZ sBpœ¶³Ž¡(ë9u^ |Lw®c±SŠ‹·ÿìÒŠ-ÊÛN^Ú,OŽ_}¬úI.â‘ÚS«+^"Žôu3 ¬¹B 2ÃŽî¨ÎÑJý»ÕüX¨%yôˆ÷ßB8t¡Ÿ3+˜µŽ°)ŒwQIØË®\ÌÔ1=,1bß%g¿ßŽÏ ¶>2ÓN¡ï¨çdÂ~é„6ë _$ÿPfßwLÚ ½ÔY·%z-ëÎ8e/´"n²ŒÎ¹ÐŠØk¿J_õƒˆ¤ý“_ ~eýÍVfw–Ӊߞaú0™m2oáýsÆ?ÈuO²hT>¢ÂÅ~J;ýªâVm}¾ò²ÛMkÄïhf¨(§¤·<uj ¥¼@^?«ÁqÇï»Ýì©(;ÞzúÔ«þˆvÍ®^qïGä&sk›ªž°ÓØE\+%V(+Š=ï«@‹¦¶«¨³LT%Ü–2RæVTóôÀåcýJÓÞöÄmØ·­ÐQ=Rc˜Þ D|ÝTƒ;JÜ Ü‹ŠYËia?õÛߟÇDZtqëXØää‘?ö^𠹘Éen³æ"%ë[?D ¼¦TuïYÆ´Ü ö…:Ö'‹¾ìÿ•Ï ¸…Þˆ‚_Ó{ð66}îáþ,Û‰8ÿõ¢‰»#ò×ð;ÕÔßíØ‹u„± ÍèxïÏs!ßâØqfr«¹jÜ‘ŠZ>dÒÐ1ˆ´ì•ÜŠ˜r?³©­YvM\’QÙbîSÜÑÞâñQ÷“…ó‰íÚ†aFE0ã;-ôhH¤”/mé°ôøÇ£ü‡[¯6HÅSÛ÷ÂË.ó.™Ôú@rn-龘–ºä´öÇ X4³¢¾Fïn÷îø.! Ñݬ·ÚðüA¬õõ}²DÅ&Q===e]®(\™úT@Àhf¤Ú´Ùö¨©I¨obÑZ¦œÎ ÿ61ú à &Ô¤´¥GueaΆôó©ãöGœÿëDaR^0ÇÍQøãïÞû‚ëB¾uhîPîæϼ‘Q/ß=åÅ©ˆè[»†Sñ@BéJÂ*õŽu“«võ¸çÅœ¿uì<€ìµLܱ€Égn0½  º@:ü këËÔ5Ïh†p<Ãði\˜DKy\ñ'n°BáöׄÅ2¦ð‡©°oéIzKû—#NI \±n3â¾á‡7Y žQʶ•$ÈÕ7…F÷äÁQZÍ­M¡ãÒƒVJèG£INa& k¿8 ¨“Õ¤Ë+ T˜Ë;€øKÙ´#kg#&y¤Ù5Ä#&gž½Þ„˜z-«Aâ’Ucð²ŸÙvOZ‰J¥/ƒò O4œ'G3»Âœz®H¡¬¥Å­bô³YOeóã¦í ¾+C<òÇ©!ˆ'®Š×W{ ¦eÉ%£Š„öR½¶Ì¥á®“æ Ô°EìξËØx%ÿyYVôƒHñL… ÅJñˆ>“ç„e SJW-G<œ½ûí v GéOË}íÑïw U;?Õ04Ã^6¶€©dÞ²Žê ;¹r]£]¤Õi ^vY¦ªd™¿qE\rzù죉ˆVù6—\­vØĸT›3¹ÌmVðzIBêäÒ?yŠ¸€?Œ7tµbö2I,‡Ê©ìÁlÎrDËeÖÁÎýMJV3ˆ:]º †ÿÌhfØ{ì'}C΀N¦°m4À÷ì0‰ÌÍ2årfY[iµµøUFS‹b2ÿ¬NËRÄSÛSç×[#ú&ú Zv®ã¸…Œ–”3ß- ‘þ¶)úRý9ŽW °±>zÑ…X€áÎN÷&qf×êËEF&]‘ïÏ÷ÿdg³ï5ì·›<ì”gž£‰^ì‘$J¨ÄZvúÇ2ï‡j±Ãô(¯ø犺  ¤Ì æ/–@§]gõ[ƒÝSR}ß 'õX@2$ÂÖO©YéýÜ?™°½æK qzOzÜë\3A¶:W=û¯æÂŽËÅÂœ…™Kä»XÞ¿>$c&€t¶T§=€ÓÌ5RxUZ²3Þú¹§ã´áw½eO&uût[Èʵ¨ÓÑW«J‘†ÁŸétÛ¨âŽï/C..pA±ý1þˆCäÍe}øF½@.É•Ø5£_ÊQ›øX™»Œ{RaøoŒÂ8%)‹ŒV—ðnÜÿ‡×)kh%:tEXtcomment Created with Inkscape (http://www.inkscape.org/) †µIEND®B`‚yi-0.12.6/art/yi+lambda-fat-64.png0000644000000000000000000002362512533751517014560 0ustar0000000000000000‰PNG  IHDR@@úù­bKGDùC» pHYsHHFÉk> vpAg@@êóø`&ÚIDATxÚí}g@×÷ö3³…]zAÁ†bņˆ½—{o±€Jì5jŒ½w¨i ö‚¬Q@‚TE•Þvïûaš‰&’ßû?_Ø™¹sçÜ;çžz‡Ã7&Ÿ  ¬¬ò¿êt°EŠ€]: Ø*\@Ë60_$`ʯ x€Ú¹£% s8°W/=½oý”ÿâ¾ö Ê xuÌJìé+à ›|' Î&:?èo“'@ õÊ!  Sâú‰Ḡ©=ý Þ#|ûêkóë[ÓŸ~ÃÎ8ØDÀqk¬·U@‘þ—íEÞ:—\p“·€J¿ž’(ý”v™&ày W‘¤¹®# Û÷¥ù÷­é³'À‡\'`Ï|]7 Ø\& h{… ¢ywˆ;Æ%\k® `5˜)» °ZÌœÝð)ì)\ÅO‘ÝAÀ U<~´ìȇ'‚¶€alZýÇ_†8ï­€‡ÂdG>—•Eü?½ðÏÕ°ñj=üô$î°_À¿ø²–Ör›¹«@Þ’<½ì~@b§„¢ÇÞ€"7«GÚ;°…MD£DóÄ}în#w@)JQR¾5m’KX;÷¯ïÞ뎀 –|øx•.¦ b¹éóØ_ù$þÔ?ü¦ëJã* «\@‹ÿ´C¼_]ôð äÞÙóK€ý¡»F¹·tÎêÕ4Îên­§h•4{Ѳ¸û öê:ò ù%ù#-7@ÕCå <€w’DµZwOF;8qƒ'¿®éecÓ¤e±qÜØØ»·?Ž/h# ôõ‡{—YKÀ`’,™'¿ö}múè(7ð4%åjI{»Ü§æv}¸–.`ί¾$`š«€E9êµcÖ¬*‹¨¾Ðü¢y’­¾®æh­ãúkp.Å$)>:HA¢\~|ÑÐ;°3i°¼Ý`Àãïêº[5}m64~ °¾¬ÓPŠ—õcàFQŽXO\Ý\ÜØ’»{"Œ„ß×Лo]nàó xš$ÂúÿÖ6KÇWÒ¸}1ú¨ðÇ ÐŒ”žcÄ«-¾Jq@À[ôÿ™½Þî%` )[Ù',¡ ¢Î`šœ½õlþ&ÿ¿h îCµûf‡ŒüÉ£ý¾nónÉRj&¥G;ÿùŽÖókf6ÚÌq_ô½w Ou•€¥³DÕ"€ó傹·@aÛÂ7ù¶WÚN´W·_r@^ßÜ(…ÏðšÔZ²®?p õ/Œtˆ‚c•=`_š>y (‰ÖúÄnZÑï/Én?Io„WoïùXP6nU …“V]€“²Óse@M©ÖYýz¤YÓÍuº.»*וhJoM÷ع'ynNõ} “ãå´Þ7lœe${'NŽún«:PîP.bN€*S•¢jœ ݼÿjÛ%…õ fçj)W˜ ŸG¤´î&à k³Â+{€¾6ýM PFŽËìEÊ•W5]( òôç:`'…ùä/–¼˜ò[`eQd›Úmù¯ ¾:toľ »ÏN0 Jü¬àaÀ1ÞÜF»—ì× Ûþ2 `2¦b^@ÜÓØ‘wçûv?øq`u¾¦­ýº„ë¥z%ñÅUû̾kÌ´å…œ8øvuëò½áuT7Ps³€y™朧=¾ÝÐ}úd3°ÜDxI—“VÍj}-›ÿäSër®‘Gî,½4ÓÒ³‡düܧ}bÎÝÉܬãoîsuÃ:ùÜ’Å# g#¿ÛneGÀü;‹mZÌŽÕbOœ†9Ç2ü¨¼©Ù‘@•–fí­Û…òżŽèÚ˜Z}tí Þ%ÄP¸k]…€M lBZÍ›M0ý*õ2YÀƒt~榯4^_œ¾º'ðK‘oßà‘Š!ÄvÙ0î —ÆoÚ®Vì\TZ°cÌ>Õ,6Võ5•­Ñøà<9o. `Õ˜!»”¬+î_8 PÌPD¦·â{={óðp}ùUCßØïëAáÎþfÂÝl ¨Mö>ŠþºwÌ@Ài“ܾ²²ùõ©ôŸ™eä×:¤öl@-f¼™ÍÕ".Ò ÚQ`•=7ÈÖ;³OæΗÔ*/äq‘@âŒøªñ϶<œ¤$&Ÿ‰ 2ý22^ŽJ]KÛºà&c¾¹€I§¼D:ÄfòÆ>¨l>ý×ˆÞ žD­L" !½QÖäsLðûBn·š×Yjn3«¶¤Ù…¨Ý5'ÕJmœÌ˜N˜î0£ÆDãD«Åƒ.ô`̘pÝ°ìÑž1¾?XTKe…Ã8Ž”´¶Âñ;*pV´€(&`Aý®Àú÷S%K‹ùŽ#‘Y›‚.;4"¥Ë`½€:ä‡POoó OÈ4njvÔ+,ܳïÌFÖœ Tëk¹±î(ÀÜÚ¢{íE®™ó2BSÍ&¿=´'nNœ¯¥ÐH9¸Ts*—_ÿsdKxGW@6Žý5*É‘sEÀäÓÒvÒ¥²s/Éï¨Ûkùçß+]fV¿cl÷yOµ¨xÆŽ§Äg,`Ì/ý”<Ç€1ÿ°S ¹-;©µÎ«¹­LvÒƸ³W~¸ý]IZeóéëÑßô|izJvvŠ´i)`šòïT0Dn|3“í|q¹ydKtoTØþ©~̦ˆƒM ß>ßÝéÙô8Ñ `E~À¤Ôd»ePº¥4ºd&PP<¸@È”Ó#+ª§× éÑ‚£{¼ÚyÇ9¾bâ= úö£æò+—oÿGïHû’Î÷†¿ ÊrÍ8'.`ídAô¿—òtõþZqŒ¹ßïyä(cóš/®| c½ŽõMœ–ÅXÃœl«úÔ\ió†ñ’«&ÓJ¥hàZ¢¾'@z£²ŸûÿèÄ“]®6XÀµ„ï'€(Kl*YʘÁ ÃSUï1&#Þ$µü‹¥¦úa:{Ž‘ƒe¿G“.`]»²ŸøKÑ¿Õ $Q«C"ߤ©€æÔßj–µ¦ T úßüœ€uHY4>P¾a¾ß‚/4ÏiuÐ FX™†qF>æ—“=¦[j(ãcU/àA檌k/í¶ÏÊ:yakÊ^ÊxL†£Ò¨²õ¹TÉ:@E¤}[ÀoìLJ½ÙR:qt¹ 7 P|þŸJ¸­J˜Ùuëlà;ñÐmówÕ‡Zî­·Ð5Õ½b¼»©Gk™b[±‰T à=ø|>ö\?®wÛ¸`Jõw7/‰ž¦j©²Q½Rusqº#®l>}>ýK'@.%}zS*—Î2-)ZWDÚÝË‘F« ø€Â´uèúy”rÆ£ÚåêEu·­]ÚLë¿à§ðcùËbAlÀ¦b#ë`8l9ÀÚ²n쀰ã윌‹œŠNh4HÕEYŸ%Þ€;•Í¥/AÿÒ  "ßz-çº ¨Ma%Y9ä+@Z›¨L,WMnüÚ-Í#y>—mfËUtGéi˜¤|;~,— p¥œ7 àºq=9o@¹\¹¨4ÈÈwÎ9¼ÎyÝ1y.ðÂýùÈØW!lî®>/›cvéå…6^"_²Rž’Ë8Š¬™‚*›sÿßÑéFÍcŒ1yØ°ç£|–í <*ž->,mó^©ëÐ'~ê6Æöõ>t*vc?íÿ¡9Œ;ù—õ!Œ9¹Ä´eÌÆÑ6²™+cÚvÚW 2Ækó5ùÆ0 S±™1ˆ!†DÕJh7ƒ\ü)Ÿ¡ é,Ü^7ø¨ž€š§'×™6gKñÛïô‡šô6’λ‹z¾ŸFóŒ‡T1Vuù^›ÉŒÉÆÊÎiœa k° W>æxúT|N.áfa•Í™O¥™ÀSŠ‡:õË€2uª’#Ȫ±€6´¶ÛRGõÉ}©¦¬ZÍ“LAuÌ`\©mInq«Üâ0Nà9 =ßÔjªÍP/¤ÝÔÖÉ¢;âK€øœø¹¤% S—Ðp¤Òaòµ€ª)«¡\T°#92qSÔª¯’éE+‹È<|(àRʈ¶Â¿œ¾ñÐ%¥®ÖO–UüØ>£ßI¹³¢ ­­†Ô Ä¸î–Üò2=6Q{Ÿv=)ýl}ÿ*F€A¨áB³:€É0Ó>–G]#½‹& ƒ>†U«ªù9¹‘f@s¹f©®1 ¾CC¬HŽKbÕV¢ ‘†Ø‡IÒ¥{±›h»ä>À-æ×óÆÙöŠ˜¬¯§ôϘÞcR÷&ùW)gPEÂÒß–¯ÿœ¾±8Œ‚<«HtkQ®|ø|•§€éô.ß'åë¡‘º³úIíïcêO}è¾sâèVÕ3,‹ëe5¾¡5Q{…Á9 xeqfá} ¼õ¥~ÇÓq®xº$0b¡k³¬`Rµ»Õ%u½òŽ‰BD×$E† •—jƒò>€kbö+{„«Â3äcó0¿á¾öõêYZ:åo­º»f|Ñy¼°¼®ÏŽsífní´Ôo™­ªE²µß–ߧo,ÌMt£ !{µ)Ý:$Á]J- 'Þ%‰´þDTà“Ì7…ƒÕòdmäƒÛŒPn+u-À±³ÌOÕYß“ëÏæc€§«cò"K û]òÌr÷+†ê·5Zëîkg®½i®¢¯ß€·pÃÙV?YgØ;x4$x„ì2>RxÕ&0å,]œÜf~È‹%!ûíhÓ‡üc¨>"r¥âÉ\}LÖÃãD“©¢¡$ùÛŽÇg†ü3zNqtw2—œ ؆‚A.IN¡÷Ú-`] ]Ï<船…ËíŒø7F©‹¦va½YWf¬ï© WfU j·ò&Pmuõ u\€¦7›§và%RäWËóy{G6î–ÓuE`áì5­WN:¸Ytýp@7€sãÜq€´ðÑ7›IÈÆ[ö¦CžÖ}­Aúï*­H'è™ àÊ*^A±Ÿ>^¤‰p€¢›mf È¥~«ù—)åÉ€²‰ÃHr4­Žx¼äšÌiàÐР]sñ…¾:G»u“DÖëa§×fÀÍàóÀ'óùüA ÞûY» /W-+4YYû3_¾ FÝòwj°Ë~i‡jÀœ: Õ½ÖjÝÕÖË#æÁö²yëçÉ{æç-tuotØÝhÇiP–ó< ;Ðþ×í¼¢D”q¤Kœºûµ9ü%À§’´‰€“(«á‹w‡¬P…Ý‘ÿò(í¡ôò6IäúÌÕ-FÖÂO_nrbÀñœ7PY©´Uã€j³ªÕÛ²Lg®…Ñáp¯Šî¨º«:­Ì‚d< ‚J¼_ŒaÊUÐ Ž\_àÌ ` ÎÖ1ýyÇKE–]ô®Á¶?ÎÈ"‰6Ÿt—á”FZXôá^˜R’éx w«9~mNÿË&€å¬ 2íùÄ8ÉŸ :I $C-P¿¤ÑHG d˶È0S²#žà1®jGÔÒä]3ËêíËyÖâ»Mê9{"»¡½M¶Çä^* 9ñ*ðefcþNËYϘï³`ÅÛ=Œù$¥)ó9tY!U]õ ŽP¼vOþiþš¤‡m€˜¾ñe­Û7”¿Ÿ¶¯Ž‹árÕº/¬»4ÉjÉ»Ê}4Kƒ;æãÈÇ=uZ×Mwð,j°±Íöª·šö»dÒ ýŠ kʈ#G‘˜ˆöäRƉÊ°Ï%2÷Ì©šoyòâ©’¦„üQäÜGñý8[¼Â[ÎùÕk·K?Nå–ãɘoXð·w[ùc½'êR!Gc*ؘJM7É<ûÓ@’_‚©Þýþ Îé½ëØ´w•^5Šk˜Ò(Æ)ƒ±žZ}šýÈؼ—‹ŸŸÇØñfVoL½'Üœÿc’Ya‹.«—œ«ìa¨˜¾’`LŽa)ÛFNéÝ×0”XAQ½W$–;¸ÈÃtx•aVšÀì๮OÖkj©ûEw‹–ç+€ÌÈ ÍÔ @â¯ñ?ý*nh]ó?ÉÇ^¹–quŽŸ<ƒÊÂëPÍ¢n"upŇûÍöižÖj­w-ixëMmòûÅšùX¶­±ÉNW:ÌüŒEœíeÀh‹É¬j5íÚf€t¬Ô[ž po¹b®7°&¾þ#Ç´È‘^~^9vÉg·ŽžtÞRh¿hÇWÑ9Q"ÇOT.Þ…ÌcZó¸寨f_}jÝF€í®:-Z êá/í$ýY^DZ1cMõ›7ír“±Qã¶þ¬ÁX‹ˆV†=‹3®e¢]-—1Q©ØF²åOo4åäÐÆQô#eìúÓrç33fnVëüžþ OõÉ™õ`µÿ”Srn0æ/=e“ÓŠ1ߤàÜ·žŒùrÁŠ ŒùZ×Slaìèßz/ë3fµñUg›²ö²(—Гòª ­ì‘)O_Ipd]°‰ôÃÎr'$… h@k¡EN3«½»uœ\5Æ'Zû¶tĸœ&Ù‡3B" Tw 7º@ð ‘Ž¸ªê Û¦Z©=3b ÙTUrµ“IîÑDŒ§M©ÒH9ëCJá1ýR 2ݶã澜Gç4¾br´ú¤ñ"fÍÌT¿{ÀŸãÏ›¦è=µ– \X«w©ŸÑ#õOŽ_?’|ã. ¨˜ôuøÿéô…­Ž²d4(kÖ˜Þ’Öx[2oê҃צû[¶ƒ L`ir/âñÀP#Í ¨ÆŒØµß5Ý] t§ê™ç-ìLz.,[ÔèjxãéÕa—žˆu-Op‰´”(i-Ç„÷÷íö››€¤’ AÑÉÎ>YnÝ>:¹Ïô´­›ÞìPZ*MT¥†· ‚bÆ0á,ìÃ.v¸½þæöÞ@椌©c*âOZzÂ(gñ?¿Ç” iñ³iK˜þ^#›<[ÀüvªÈç]±6ÍÿÈo¹2&)¿ªeÆVc=.¾?îíØ´OcÇÇ xs¥¾:Ó¨@6¤Š×p¿úŠ0àÞ–hµ÷Úþ§ÒÚÖåû!‹•·Ð.ñ,ôÞ˜Xîëë<@q‹1Ÿ#A>Y/óK a9RÆ~a^N`ÌhŠq7‹ŒOÍXîSÙ#÷…héŸÖп‡Êp–:1F.*«æ’–­»/elJø «í-7p’ëºÖŒ‰ˆ®I´ß_g׶¡i;GÆå?˜~N4éÌé¢!:=½.ùmIÓ~×1r ÉÉó¦Q¶é“ŇŸÃÎÏhþÇþå8Œ<8víÊc¡¼¿ù)ÇœÁÅ#ýZ‡ôË®ÆØÞÕ_<ÅXƒû”‡ÿbB7廉 “™Éfhô¡Dó€Ê¹/Dõˆå§ÈgŸCUCBry“Gì%myÚÓvv½57>\;x³æÕ+o¼Gù·JËb,`B¨Gþ:ÆVY_pñcê›ÔUÚáïjÒÇÔÙr[Á›¥†+û$ôo/ü.¢ Qcr´,$ƒú"­µs³©ÃÈ\)Y-ÇìÊîS†Ur«Škv~zØíDç3ÒÚ{nó¶MœÁX›írÆ1†0;þ<𢓢(‰ cêwáF1¶eß® ‘Ã6¾s ~åªâþWH›̑ºCIÛQ_ÀîäÛ®}°…ÀEšsÚ,O¹î¶ß¢ÙóóQ«)Æ0æç2,»c[&ïšyˆ1½æzé¦:¿cðkär]^yˆ†‰–ˆƒ¦R‚ˆ÷e3(}¼´€'Éþ¯òiÏáBèí…²ûqý¸Q\La꨽ã6þ,y=»SÓ.òQg˜‚ëÀõâ.ÿyàåÆrwÍ`ÆïÖjÁÆŽ\öYœê̘_ÓÙF±ã|¦¹fí´<ëš•WÙãö ¢AÏœ*ú(L.\Ÿç ð鼊÷ï&c ÙÖåèX¢W_׎oÆwä~¿_üð¢åsËØ-ÀâÂyG»w2;gü”ú¤¬U½;*b¡ˆòSyù¶Ëz“«9ÇîÓz+#~xŒp0I4ÄÈåZš6¥'K¶.œ,NU^Pî-uÃÖ²+ N­:RoDÜb)àhÕvç @´K,öX VEu›=„Ô îF›ß…*kOã¯>|'ÿ¨ÈP„BäW1ás'¸ç>9Î…?Ýúhé”Rç’RàÍôìç瀨ñOoÄw~¹Ù+8¸W3Òì\ tyiÿâ3e­22Ð>äiô£]ÈR¡ÿa]¯Yô¿ñ†ŠÎ´^S“5òFLë²"¨'¶»áX €)Óf綋mg3ˆ!Æ»àI˜žÓ|UYૃÎ;„?PNŒ;š¶äåüÃØA1¼"iÚÎÌ‹™i‰­Cb[ǸF îu‹l~Öx¼ïÑ“ð!@ú–×Év€ÊK5M)¯¨õ<hwŠ›_¸N.^¯EdéëQ®â»aþ4êOkж­ 0I<õÈæ| Ê3³cÖ=U¾*Ie`ïﶲýS̵ y(;÷ðhTYÌà[O„¯5ú:ßlc/Ú£óÂ~~ã@ç½’.§Yü0±ýÓ*1ËîÄÎÔÓÏõsJ/”–+Ô€-rù4Íc€õ Z6ÖϹ”gOÅñ,åë:eÍódf––í¨þyÝ­¶QÀé”C®h½k]Q Ê?šã pŒ»Í°»1@ ÔdÈ «8Ø.¡DÑí &ó9»¾1}¡%@ƒ=õû Ø…vþè¢Îqœ&7±A;6—ÍdNêñøËñÝ﮼¦Ù^w&ÐèV“Îv€Ó1çÁîUìͬ›•¤¬2^f:h/»”²*¹oô])ùŠ(o ¥Š¿ø÷ú«N{‡ö#älò6 H8JH)¤âÒhrÜØP‚††CYK­'µ‰ê¯LTNm¶1P鸞3`J–­Ú@ ¤õ£ˆ¬¨áô>¯dïÉœ“ „Ž µçÑêDÊn>é ·¾Ø¥ÍQêXÙ6îRÚI‹|úv‹t£ëÈ÷JÇ—’‹·¥c,—í~?ðZáÚ ÚNœ_[̽¾Ð×{0u«kÉŽ¡@£Â&EÎn€j>›¢Jˆ|’¦÷ªFböërÉ’Œ*rTŸèò‘ØŠìýC¤¼í%Ï\ÃËÔE)#(m}}w ‹¦€'þ´7ðͼëž.@Pÿ“6Û\e‚òRÉA€ÛÃäbPÁ&Öe¤FæiYvS»*õ¬Þ¹œÕÉ1—<¬Ýºý“Aþ+ª`t¥à‰·»€Á”ÓF>õó¶]Ooºó&õÊD²kYKû4t€ý1´'0×f‘î±7ÀÄæSgljÔigæØ=K¥U‘ê…²ÞÛ%Içf=îq(²Ø½Ø¾à7åò?ö¯„<‹…/ða"ÚÐuki1¬!`òð$òïù8ƒ’R{’è?\Vð1EÀÕ4ñ¿Û@uXµF gž¼¾­3¶ñÔ®½—U?U{•Àmà¶q7 L„bT@m)jÚ ŠEï×ïb†ö£t qñ ¡rK§+à>È1Ûe©,©‡ ›Z¹0 Ë¥nþã]ÛÁuòZ(Iž¤¶4P™ª$ªA.à,; ”ùØE¶¢.’I>²4ÆçØ?ØZû¥uªAÜÓ@ÊšÕ£7þ ùœh@~¥Ò£T« «O×U§ “J»|ß$â$-Hؾ¡=Œß…* ¾ÔÎJ[×}k”‡jiCT#|Ý:çwK×àuùZ|Àz²NL @)Ô~פô9ÓpcÝ%:…}œ\F·½Àq®ô}ƒETí¼—$ëÂ÷fè?¥rJ S¸ŸrÕìèoJyîœS¹ë—ÇËùó¸k{³öˆæM`×s|ïU?Ü€Z£¦M[tºÈjÊ"4~TZªÑª_•RõBÕÀ ]sò€£wÙ,Ÿ”üT"*ŠºzôØ11 ¨IÕ¤óVíVY:ÎEpzKžD;Þ7›‘ ààRæ*¢%Ù˜<¬bZjK?wü+Zn#ûQør%U䤔ÕÄ›Š—‰¤=^r– zã~:sŒ{ÇùºGžCÍ!ÕÑ¡ÏJ@Ú@:C~ȵÍ=¡pƒ³Ž§…ÊlåÃ’³›ÿM´]%‹“ñxñO’µçVfÉ2Ï'Ï¿AfRZù‚?ö/›Š0óÊmÑNÊènŠ:n'ïiâT½I%Ÿè¬ˆ”ćʹ„*;`[öGaó‚ØÜPàXÃ#;Wu?ñ,¾ (œ2·¦íDÇE×Ä¡—È¥ñoÍ;ˆJÅ?¼ò¼cì7uÞ¿-ºÐ¨œ¢NK…¨ãgüß#ž.õ‰ñ㕳nÏ]uðñÆM¾ƒ(nç¹úž¾õvc>ÞAþY¯óó9›}‚±¥¹«C«uØÖ®é^Æš=m©Õ½#cýîj2ëcÓ-gÞ® õz\ÒϳP–f{bp2íPÞåzžú#[ññ¾ 2¦È¿ßÑ÷—1n·†×c¬¶[Ý*-W16«åÅAuÆ<ÌzÆaÌÓÈëpÂEÆ [Oé}£¢àÒ-ª9Ôiõñ>}!Š LÚÄptµoï øÜ9“Â+m&úy„œË>žTÃ'<èŽB—1ŸãAYŒ  Æ| ƒyÅÆŽYŸ”¤ƒ±wÇø¯X˜Z/µ=êÍ~ǘ5ÜÞ–]CÒ¹ÖoÉ`Ê G[öaFìœüÍð·È¢>§äõù[§–!ŒTq”PR,u e¬Æj«— ž1fãV[ÜìcâÑâo^GžÍª_lÃÊ ýÎf­M"éEßšªèú2­—ÛÉíç*±*KÙ ÍÉÚxË[á Þ.œ•÷éï1™iIûß3êK1âs©ý˜Ž’ïK€Âü‚ƒy×êtÌjŸµ9mWà„ßFÄÆß½[kJ]™^÷7Ѐt^uÆLÄšöU…L¼zzGà‰%¿üãÉÓ„’5úDO )•uo$­·IÊG/!ß7›ÌƲú¿“ß/ºt¹Þýä„H O7×óíù É xc5ÔI¹‘Gþu£oè#PùøÓ·§5kcöfÍ—5¶Öì}a³ÁN—;Ý<Ÿ©vZ¶êªFç7œùõÐnÜ/žYlWý÷Ûç]ø¢zÇ;ìêØwˆ¾“þùⳎ‡&ÄŸòü½bNIw¡è½2 ª½”ÓRjAÇf”çtZ@™ýŸ$ÀgŠ¥O—E­†Óvm8ˆ¿Keáw“Ó(ÍÌ›’W’ÝÌ #íoª]£Šp’ùܹ öÚ9EJÖ@J/ÿ÷}Â%ày˜UÁ@â%Ž–´³Ð~+{ûÃûàW§\~~"§áY¿’ãÛ×éò×ÖÉ=?½]n&·œ—çL Ú´7§Mç—Ýî­rƧ4¶Ä¿¸é£ñTÂFJ®>™¹õÉE^‡ødJõ¢ÃËßYxíÇ®&íyhÙ÷öþþÀ—Q™DèÄÚ°’Çk æ8TyàKoþ*RêB+ÛfSXvUýû¾ŒJ⊽Š‚€¢ƒEý §d«¹«…ɵ6¶sNw ™Q1§÷B[¯¡@[­ö;d§åzšŸ¬fØbU1|,qJÔN­påÌÒ%²¦Ð‡>gºœ¬¡åº’•àL.몴cI™5õ„ü?­âË ¼+ %UŽUÐ…ö_ˆ?ä;j_R°"·ã«ç’ï%›Õæe½û#i·çèC ñ¤ì,%¥/´ÿW³/JÛ÷j©› (—*'–.T+UîªLŸ8öŒ=d“O¨×hcµ§;0Y{ÚЭO€™ñ?®ö°Z8;üܳ- a®±YguÅí+³ÔÒšÊ ÊÙÊí aóŠÎf—üDÿ"ú FwúÆòŠ8N˜žôåÐ'hñ?ä9pJ¨.þ-½éH]Kž¹Dˇ?ué£SŒyE/åÒ/>b_™þø‚Y@1ŠQxø$7sãvµòâ’ù|Ñ! h[¡KÞA ¾î³[O÷~ŽøñŒ;3-úÞí ? Ï9{ÐÿÉ –³®ŽÚ},ŠÝV„vñéñí¥9¡œge1YßI \KÉŠ#(ÚXÁóZLkHÕ³'“ 5–Du4ù ¢H4ÅQx*¹l³>¢D*h³%…A%ߦøAB Ù„¾l7ÛÎ\7ýÊB”ÊÒ©NîÒÕÒ©²Í|Xku£µwÖÉn¹(ì[à”-™VhuСo°·ì3Pê¢Å-Àp^´3êqúc}Ò–½¦—•ïI€ÄðU«EÁ”ôË>¦ Ê}*s¾Kš'Tø‘¼IÀ·eéßï„Òÿ}¾] ›Õf´ÄM!WïˆQ```fІgpK¹0³¹=%[XmV=|°±ˆaÇA1$~äâN$åM?•ïÿ‰UÖäÄ :tEXtcomment Created with Inkscape (http://www.inkscape.org/) †µIEND®B`‚yi-0.12.6/art/yi+lambda-fat.pdf0000644000000000000000000001431212533751517014307 0ustar0000000000000000%PDF-1.3 %Äåòåë§ó ÐÄÆ 0 0 obj << /Length 23 /Filter /FlateDecode >> stream xÚ+TT(c}·\C—|…@1´í endstream endobj 1 0 obj << /Type /Pages /MediaBox [0 0 612 792] /Count 1 /Kids [ << /Type /Page /Parent 1 0 R /Resources << /ProcSet [ /PDF ] /XObject << /Fm1 2 0 R >> >> /Contents 0 0 R /MediaBox [0 0 204.8 204.8] >> ] >> endobj 2 0 obj << /Length 4785 /Type /XObject /Subtype /Form /FormType 1 /BBox [0 0 204.8 204.8] /Resources << /ProcSet [ /PDF ] /ColorSpace << /Cs1 [ /ICCBased 3 0 R ] >> >> /Filter /FlateDecode >> stream xÚmšKríHŽDç\WÀŽÿgÜ+¨5ȬFÊAYî߬ÏAðê©;»rPzŒBÿ¹ÿuÿçþ¯ÿþ;ß_ßé3õµª?í•ê.ü´ë,½­ûﯻ¤ö¬;§·1×ý×wJíÎùi{ô~å5Ÿ:f½çÓÓîuÞyå'×ÒïöôÕgi÷×gRiãÎÏy~ûYi>XRJ¹”+þ´•û“oŽòäYö/cîûÉygLsö6Ûéã©y³×g—9ó¾x³×§—TïòlJ|³óÆbíÙ¥úÛb)¶3]ª?ØúÓË8%§>¯ÜX¡o~ó´Ñ†?°™ÅI÷S+_ó­:y¯•ö”œ&»¬œ¤}×ô´ŽŸ±à\{Õõpòó^™ÏÊóæ£cÊk,ü¡ãúR²®ÆS£Õ[÷ôÆ®y-óüèùšï´Åâlw<°Ö3sžì2õ§öÅ©²doÐÚR‹_ŽÚzü²–Ò®œpEßž»<5+=ÐR|/ï\ño®œ!³Ïä±t=[éöÞûi@\|Ý3y¼Ýž‘çsõÝç½8Ë^ïûyõ~/vÉê½3*Àìë^Ä©Ž^¯UXiãjÏÙûì÷Ä=©±ÀäñÉ º%õÞÝ„ºá3àÓàì §¶=ËÕ.|¦¨o"Öƺþ!R…¸”„£@E˃hf|™öÝê3ÓÂò|5¢9*' j©€‡¸æY Ô3É‘Jèçày,©ÍQ= heó4Ñ,“/ °I:a9Ga“‚¨Õ´+–Ô¾»ÍEP@ÆÜÕ 4#ps«EÌ‘Ÿsç R Žçÿ¤A„öIæÚä§dã‘ëì2ñö2ËHéW–qÀô'ƒ¿9AÁ‘#Ò"͵AŽ®-Sz¨ÃØâ,üPò]ªˆÕ]ƒ·?\dAo}Ó“±ý“cÝUìIŒROSÀ5ñ¶*iq`3€|¶_„´ Ö¿{1È,9%‚TôÑel’›£bùŽz ²t” Ü´¯-¨ZuŸ )o÷n†´Å±`,|T„¼þíÕ%KÚœ“Ppr‘³@N›ì;™ˆ/œQ»Á©âT‚x²C>áLkž×  Ú!íÍ–¤ÌìWÙ*›íšÀƒDY!ʀدdJ ò¬‹¸°mÀƒ;ò™MÞ¯ú"“2½oI†ôšdŽÐ' ‹S憯ƒ¬!ÉyÒ±ð"–ò´4öqfŸB.sκÑØÄz„8ƒPölûcqŸ O·ºæŸ§HŸ2껌Ñå@’6­ØÉgÐk}XŠcyB[³ÙÇ Y²þàwuWbi÷¦');4k¥‰?¿sy³Þæ©KƒÈÈËäÜeùÖ.úµ™Ó|·u¹žBêÈ@’r“XHÓÎão¹Œ·òñÔ‡AàÉ1'Ž’t\$_ý¦h °k­|…[`ã…v¤œÅ&Q+,œn]tO×î¨Ð<<öy@TtJÁ>‹P!n|w矂j;û¾´UÈí&Îœ`õØôáÂ7¬'ë=ËàK–4„ž¿šYõ2¨×[z¢ÛúhîàÚéÒ?ŒBU˜áÿ6,Ëó÷Àà:”:Óv•œ¡ÿÉg–t²ºQ–nÆ8>¥¨@œ·D™f3Š!)–!mÏZD)*”ëA;”¤_šñ) ë­{†Ù¬ÙMr¦#Y-ì?ñ”a*y³Übƒ<5åc2"Ñfx7‡<+|Kàw”T×Û+d’´¥.¨e †‡­QwZ$oˆ¢™£ÀÁ¹†tbõw;xŸHL-à¾Ë|¡îÍ×´oÈùóÐ'sX–§%4œ8ÞZS¯±Ò°ÐËåÂí[órØì“@uGqDø…¬Øò˜ÁÙð¡¤$Ì60‚8h‘,èyòÄñù¼6ŸTgØfï5ðF­óÍD…ͬçßµ^ÿФßÿ4ü›ÊåX|Ô†{å÷™øÿ¥ ™šjH×íeCÈÉ3’Û1KbâÀ—-šê†µ€î;0ç=”ÇôéøwéåƨŸA—‘v,¨9Î^¬H\ÒÌAŽ¤ÜÆÿ£uŒžºç$©X£)œwÏVš AOˈeL¿'õ«^/¼;–š8fç,DÝÓ[ÌýÿÄMn°è)u 9g;¢ª¬ƒPÂ.¶!‡…UK/ã×Â3¡ñ-鱑 ‰ ©Ø—„¥€÷±ð׊¯FÖ¨RРĹ*€z0ïÿÈG¼—ð¿@ aá[ Ú¿4öäõ˜ Eš,µ¨˜a)¤IÇ=Ò+Á¶éJ:\Ú¨ŽEyœ9žª6_[ ™ƒT¥PÓfÞNâ[ëPﯕš˜mZPµ*^uºü+‰Ý"Lðï ò¤>Ô€¶ï@g)©üɧi¥ëŸŽy©¹ì†«Ó¶’ªÑ!d=6mSY€_Ü­:{¸g+†› Mq}6•UQ[µ>¾‹€`)ÝŽÄÐÂŒC±Xw\|y­¿¢jÀSeë_”`ۙǖJd‰ý_–6JýõÞW<¥p±öYÛ¥à ¶)ëw«&kÂ(tÆ ¿ÛåàV¾±V k;¯ ‡ Õ¥ðO,vYÈÇ=)* z¤/‚!¥Ê9z©(ÌÓ_•# #³5°ôôsÓõ/•M:ba6gP@Z&õ´5פyê2 ÎÉ;˜F[`°]šß–ÒΖ²§w¡z¶T?GaµéVÇÓïØÔØq6ƒ‘°Cšk¡'2j¢'mz£êµ`%Ť„ð[Z¬›“HËD­õ°t+ã-'Ø Ùù2wXRL JÇOÕû”œ·zQ#-ÎtC™aR[¾NÜZ!Ïj™%K@ˆéáðã•îcßÔ?|ŽƒwÐ-ÞÚ;M'w}FíZr AG•­5,ËŠdÂç=ú˜ؚ†™B™“„dθlÑšdE~ÓÎÄÖ5œøˆD¦þ<ä0S.gmT¤íÔÌG‡B¨dxhZtæÑsgR:„2t‚ L5,Ý > {ŒúÒ!I§¨#]S™*wtá*§ò ÆP™¾ l4²¥ÅÄ“?ÓÐc‹vu÷Šàx‹B7ú6ä9ªhuJW¤a§Âg;¦“%1wüÈ|d_<Û{ 7DŸ± D jg„…úcùŠÄíé a<ñÝLÇWÖþT((²šÃÙqJ|_§Ïî÷ »†Ê)! ¸hœÔj0¡U’ÕÍ ›+ÞÃF¯=JXì60PÂÏ”èCxÛÞøË•ÆVÆ’Ü-:Q5Ùöû¦{fBLÄÜTR$i ˆ%XkDÿrDa(¼Æ˜¯9®Ûõ3Ö:Ú‚´Ê¢³%¯Ìä~èÅ¡¤cR~1êuö‰Ç´ í¢Ò m –e|øÅA¯5Ù@|ek9¯%8lØúÖ"1RäÓ‹ï•?Ãëi+b­qbèƒÍ]2†HÑ‹;ÈkŽi¬›©‡Ž%WöØFÁúËÂþg9mÙûÞvÞ·Éb›î.bMRe7E_kç®Ò`GleX@fu.iÇ´JæŠÙ¼ÝÕ£{óPMÞÁAêРÑéYÝÊÖ_œ`Ðu"ì〾ÇL‘˜èÉi®Wè|Æ0J&³Vr$f‹ŒßînÛù¶¼ƒ—YCu‰>JÜr¾IÓúÙ…À»J vZàb©X¿+¢…Bßô+›gÕ¯Sœ"´/ ™¢Øµ…ZÅV“åt(Š:²:«*M ÀÔËö³b¦+½¡œµW0é®%¬eÅ.ÕIpHj¨·ÁûS©Ew9l.èBÝO¿éMÛõa¥Óbí )ªÁÑ,Õ܈Ps N¦Óh»ÊM™DÐ84ªh£Si%²éíP¯¦¸;Ã0ö_Ûtðâ|s›‹W"É/#4(œ¹KAÆnkisÎ(uªÃ“3öԥ΢ /^µÅ,‚Û1ÞZ1ºÆ´þÍØ’· ÎÛ9þÞ PSx†aNJô+È ÄÔ²Cñ Ð`ßÑvŒýÎî³#ÊKí`w­tÞʶêIJR`Sš}…BiÅ µ¢û»$´§-(‡ÞÖ’ÙEÀ’cy*9‹Qò>§('Èîaw´8B‹+ªò€„2Ì‚L Ð\:à ÒÄö‡æ¤r19Â5rË¥9î¹Ðð+ö¹ì|:Fñ^†=. ¥KœÚ'¿µâ8é+†w°Êþc³A¤e 4h"Þc·3»:½3ÛšñN«£¦/˦^õþ ¤í¸’jûܨìMŽ’žég¼) —½ÊÒ)=ú=˜Ç©@1^}ͨr¼‡^õ,¦ÖÞL`AUFKD‘—”x¬ÞÑØÖ÷z×Ë– ]¶º-†²…O5>S>]îÕ $}•¸iÜç槶F?0°/úÖ¸|ú Œ¢š¾:8§Gv±=ZÃs¥ÁgÔ3²³Y–×o˱1þ–ñIX àðu+²ì7Ç¡œFz¢>*K*‚ÿÒ8×X‰ò>ü\Û/2 Ú£€Œ¸õêÃëY‰¢8þº"å®›¢xï‡boz5 ©ñDFÔÒ¥€ÞÈo~âýöB¡W/4œñ9 5;V\0{…“-O*’¦€wÆXf”L2¦4o)¡Jp„Ó)9›dXòëtoš—w܃8Žn˜ uã”ãºD1kYâbÛ«¹Ny,ù½Â©q[¥t]êa-ÙF ‹¢¶kYG‡”3fMž¸.ºrĽƒ×StZÌÛ’× øõX”>‰x:ËŒ¡lO#®%ǧHvh<ºrEÉŽ d‹‘ˆ–>¢+·ýcñãAd\Ž‹åmÝŒ•œJ/UÿœBÞ+æÓ‚gÓ`{sÄF _ÓŸ¬#3(X¾kÆØ+yé\Î6* ®ÙCµÎ¸ T„ÄS`9 7´™Ï{Ž;LH/׉ˆsñj“0âÝÞ…bžp±]k“ÁÇó¯P†4u9t¯a™ŽÉ¤rÿÜ!R;ì e²¯+®¸œÔü á;¦‡}9ˆðÄc„N9žÚN€·˜ç£}œ`¯¸.ª1zCÁbloŒ­u–ó}1lmg èýVÍGÉÍÊå°2þb€×¬ ñ—3†,ÉÌ#Þ`Å€Kùéd-ˆÈ˜7»åz Ç:Ì3eÕ6c0å æ=_ñ#iÆôûH8¸ê})&²n„Æ÷ ƒÕÔI1°?ß²ÁLkž¾Ò¿%@,ÛÔ³Ÿw²ƒø™—­n:h/ÇKŽÆßÞ¼½8ðm®žzs†@ š²3!‡ÃR~  Æ¶Áñ¯7v=÷u¿VòdŸ9ÊfJÖêŸaQH¬q}ÿ³#þ> *xqoüÕÏ_aëÙ‹=‹V?x±ßgü†`ñ€Ã¼;Z¶òþéLŸcüŠ³O•GXÐ>#úsôFùäÅß÷xÃû¢*XÑ£Á¥õÌ›#D‘˜V€‡¹ë|/âªRS@—æíÁiÜÖ -‘­ªP;ï—|§¹Ê¡¾œ?¤¸?sn£ƒãPÞËûDó(d!Ž·ö°^ß9k˜Ê{ç„1æ¹ç˜IÃ=P›!Îù†ƒë²WÂH%:pç^©&}àPÊ6$F0âxäÏ"E‡áÕH9b»ú“¬k€ÿÄîëþ÷ý¯ÿw~ht endstream endobj 3 0 obj << /Length 706 /N 3 /Alternate /DeviceRGB /Filter /FlateDecode >> stream xÚ}’OHQÇ¿³%B¬e&RðN¶Wí`ŒÝõoʶ¬k¦²Î¾ÙÞÌn%Bˆ.AÖ1ºXÑI:†‚b]"è(‚—í73»îˆÚƒ7ï3¿ÿ¿ß{@](mšz€yÃÉþ(»;>Áê7P‡A+­Xf$‘v™lqdí}…䜛áãõÿ] ‚U€Æ¬ÇמöxÀáû¶iO:¬äÒb“¸M¤’1âWÄg³>žöq†[ ñ2ñMÅ'"()Y'æ±ld4ƒä—‰»2–’'&ßÀSg^™öÐ}8õ¹&›°€åwÀ¥Öš,Ô \V:k²Ý¤;©iÝR;;\‘Œu?ÊåÝV þ°ÿ¼\þûº\ÞC9¾u¥(J•IÒÀëÃ]ýÜàBS˜s_ QP5ûFz¼Úë׋Gõ%«t{3qW°D÷0vz ¼ü \}\ø$€Ôu¡ºmþÀÍ+˜…–ÍÙ¬C–;XØ9:Y„^g±BÞ,Ú\°ACioci]g®©Å·¸(ñL;òz±Úï9ÚAnŒŽÐIó ¨Üê­°4“I÷ÐÝ x#Ã{zwA¼¨j}ƒÎ…Ðþ¤Š¾Q¥óš=˜ò8Ðmèñá Ã(Äo{1±cÚÑd5¾Ué­ÊgÒ·t¶üÆlaȱi"ßÐ\.5æ±”šËÅâ^Å8tph0èk€!‰~D† TÒhd¡‘”»6‚ØÂì±–:>f¤ß&Ÿm×çŠäíxÝA4Ž…¶ƒLþ&ÿ–·ä%ù­ük±¥ªiÄ”¦¬?ûCqÌÕ¸m¥&/¾By#¤Õ‘%iþ 'ËW©¯:ÕXl©Errð'ñ=_—Ü—)Œi7Ò¬›©äê,úF|ÙNšٮͯ6×rm^™Ü ®ÍšUáHWü «Ãÿ5;¿?ÿÍ°h endstream endobj 4 0 obj << /Type /Catalog /Pages 1 0 R >> endobj xref 0 5 0000000022 00000 n 0000000116 00000 n 0000000330 00000 n 0000005332 00000 n 0000006137 00000 n trailer << /Size 5 /Root 4 0 R >> startxref 6186 %%EOF yi-0.12.6/example-configs/yi-cua.hs0000644000000000000000000000234012533751517015223 0ustar0000000000000000import Yi -- Import the desired UI as needed. -- Some are not complied in, so we import none here. -- import Yi.UI.Vty (start) -- import Yi.UI.Pango (start) myConfig :: Config myConfig = defaultCuaConfig -- replace with defaultVimConfig or defaultCuaConfig defaultUIConfig :: UIConfig defaultUIConfig = configUI myConfig -- Change the below to your needs, following the explanation in comments. See -- module Yi.Config for more information on configuration. Other configuration -- examples can be found in the examples directory. You can also use or copy -- another user configuration, which can be found in modules Yi.Users.* main :: IO () main = yi $ myConfig { -- Keymap Configuration defaultKm = defaultKm myConfig, -- UI Configuration -- Override the default UI as such: startFrontEnd = startFrontEnd myConfig, -- Yi.UI.Vty.start -- for Vty -- (can be overridden at the command line) -- Options: configUI = defaultUIConfig { configFontSize = Nothing, -- 'Just 10' for specifying the size. configTheme = configTheme defaultUIConfig, -- darkBlueTheme -- Change the color scheme here. configWindowFill = ' ' } } yi-0.12.6/example-configs/yi-simple.hs0000644000000000000000000000116112533751517015744 0ustar0000000000000000import Yi import qualified Yi.Rope as R import Yi.Keymap.Emacs as Emacs import Yi.String (mapLines) increaseIndent :: BufferM () increaseIndent = do r <- getSelectRegionB r' <- unitWiseRegion Line r -- extend the region to full lines. modifyRegionB (mapLines (R.cons ' ')) r' main :: IO () main = yi $ defaultEmacsConfig { defaultKm = Emacs.mkKeymap $ override Emacs.defKeymap $ \parent _self -> parent { _eKeymap = (_eKeymap parent) ||> (metaCh '>' ?>>! increaseIndent) } -- bind M-> to increaseIndent and mix with default Emacs keymap. } yi-0.12.6/example-configs/yi-vim-colemak.hs0000644000000000000000000000517712717763531016675 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Yi hiding (super) import qualified Yi.Keymap.Vim as V2 import qualified Yi.Keymap.Vim.Common as V2 import qualified Yi.Keymap.Vim.Utils as V2 import qualified Yi.Mode.Haskell as Haskell import qualified Yi.Rope as R main :: IO () main = yi $ defaultVimConfig { modeTable = myModes ++ modeTable defaultVimConfig, defaultKm = myKeymapSet, configCheckExternalChangesObsessively = False } myKeymapSet :: KeymapSet myKeymapSet = V2.mkKeymapSet $ V2.defVimConfig `override` \super this -> let eval = V2.pureEval this in super { -- Here we can add custom bindings. -- See Yi.Keymap.Vim.Common for datatypes and -- Yi.Keymap.Vim.Utils for useful functions like mkStringBindingE -- In case of conflict, that is if there exist multiple bindings -- whose prereq function returns WholeMatch, -- the first such binding is used. -- So it's important to have custom bindings first. V2.vimBindings = myBindings eval ++ V2.vimBindings super , V2.vimRelayout = colemakRelayout } myBindings :: (V2.EventString -> EditorM ()) -> [V2.VimBinding] myBindings eval = let nmap x y = V2.mkStringBindingE V2.Normal V2.Drop (x, y, id) imap x y = V2.VimBindingE (\evs state -> case V2.vsMode state of V2.Insert _ -> fmap (const (y >> return V2.Continue)) (evs `V2.matchesString` x) _ -> V2.NoMatch) in [ -- Tab traversal nmap "" previousTabE , nmap "" nextTabE , nmap "" nextTabE -- Press space to clear incremental search highlight , nmap " " (eval ":nohlsearch") -- for times when you don't press shift hard enough , nmap ";" (eval ":") , nmap "" (withCurrentBuffer deleteTrailingSpaceB) , nmap "" (withCurrentBuffer moveToSol) , nmap "" (withCurrentBuffer readCurrentWordB >>= printMsg . R.toText) , imap "" (withCurrentBuffer moveToSol) , imap "" (withCurrentBuffer moveToEol) ] myModes :: [AnyMode] myModes = [ AnyMode Haskell.fastMode { -- Disable beautification modePrettify = const $ return () } ] colemakRelayout :: Char -> Char colemakRelayout = V2.relayoutFromTo colemakLayout qwertyLayout where colemakLayout = concat ["qwfpgjluy;[]", "arstdhneio'\\", "zxcvbkm,./"] qwertyLayout = concat ["qwertyuiop[]", "asdfghjkl;'\\", "zxcvbnm,./"] yi-0.12.6/example-configs/yi-vim.hs0000644000000000000000000000444712717763531015263 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} import Data.Monoid import Yi hiding (super) import qualified Yi.Keymap.Vim as V2 import qualified Yi.Keymap.Vim.Common as V2 import qualified Yi.Keymap.Vim.Utils as V2 import qualified Yi.Mode.Haskell as Haskell import qualified Yi.Rope as R main :: IO () main = yi $ defaultVimConfig { modeTable = myModes ++ modeTable defaultVimConfig, defaultKm = myKeymapSet, configCheckExternalChangesObsessively = False } myKeymapSet :: KeymapSet myKeymapSet = V2.mkKeymapSet $ V2.defVimConfig `override` \super this -> let eval = V2.pureEval this in super { -- Here we can add custom bindings. -- See Yi.Keymap.Vim.Common for datatypes and -- Yi.Keymap.Vim.Utils for useful functions like mkStringBindingE -- In case of conflict, that is if there exist multiple bindings -- whose prereq function returns WholeMatch, -- the first such binding is used. -- So it's important to have custom bindings first. V2.vimBindings = myBindings eval <> V2.vimBindings super } myBindings :: (V2.EventString -> EditorM ()) -> [V2.VimBinding] myBindings eval = let nmap x y = V2.mkStringBindingE V2.Normal V2.Drop (x, y, id) imap x y = V2.VimBindingE (\evs state -> case V2.vsMode state of V2.Insert _ -> fmap (const (y >> return V2.Continue)) (evs `V2.matchesString` x) _ -> V2.NoMatch) in [ nmap "" previousTabE , nmap "" nextTabE -- Press space to clear incremental search highlight , nmap " " (eval ":nohlsearch") -- for times when you don't press shift hard enough , nmap ";" (eval ":") , nmap "" (withCurrentBuffer deleteTrailingSpaceB) , nmap "" (withCurrentBuffer moveToSol) , nmap "" (withCurrentBuffer readCurrentWordB >>= printMsg . R.toText) , imap "" (withCurrentBuffer moveToSol) , imap "" (withCurrentBuffer moveToEol) ] myModes :: [AnyMode] myModes = [ AnyMode Haskell.fastMode { -- Disable beautification modePrettify = const $ return () } ] yi-0.12.6/example-configs/yi.hs0000644000000000000000000000265312533751517014464 0ustar0000000000000000import Yi -- Import the desired keymap "template": -- import Yi.Keymap.Emacs (keymap) -- import Yi.Keymap.Cua (keymap) -- import Yi.Keymap.Vim (keymapSet) -- Import the desired UI as needed. -- Some are not complied in, so we import none here. -- import Yi.UI.Vty (start) -- import Yi.UI.Pango (start) myConfig :: Config myConfig = defaultEmacsConfig -- replace with defaultVimConfig or defaultCuaConfig defaultUIConfig :: UIConfig defaultUIConfig = configUI myConfig -- Change the below to your needs, following the explanation in comments. See -- module Yi.Config for more information on configuration. Other configuration -- examples can be found in the examples directory. You can also use or copy -- another user configuration, which can be found in modules Yi.Users.* main :: IO () main = yi $ myConfig { -- Keymap Configuration defaultKm = defaultKm myConfig, -- UI Configuration -- Override the default UI as such: startFrontEnd = startFrontEnd myConfig, -- Yi.UI.Vty.start -- for Vty -- (can be overridden at the command line) -- Options: configUI = defaultUIConfig { configFontSize = Nothing, -- 'Just 10' for specifying the size. configTheme = configTheme defaultUIConfig, -- darkBlueTheme -- Change the color scheme here. configWindowFill = ' ' -- '~' -- Typical for Vim } } yi-0.12.6/LICENSE0000644000000000000000000004311012533751517011424 0ustar0000000000000000 GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such an offer, in accord with Subsection b above.) The source code for a work means the preferred form of the work for making modifications to it. For an executable work, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the executable. However, as a special exception, the source code distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. If distribution of executable or object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place counts as distribution of the source code, even though third parties are not compelled to copy the source along with the object code. 4. You may not copy, modify, sublicense, or distribute the Program except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense or distribute the Program is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 5. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Program or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Program (or any work based on the Program), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Program or works based on it. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties to this License. 7. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Program at all. For example, if a patent license would not permit royalty-free redistribution of the Program by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Program. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system, which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 8. If the distribution and/or use of the Program is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Program under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 9. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of this License, you may choose any version ever published by the Free Software Foundation. 10. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to the public, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) year name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. yi-0.12.6/Setup.hs0000644000000000000000000000012612533751517012053 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main :: IO () main = defaultMain yi-0.12.6/yi.cabal0000644000000000000000000002303712725741114012025 0ustar0000000000000000name: yi version: 0.12.6 category: Development, Editor synopsis: The Haskell-Scriptable Editor description: Yi is a text editor written in Haskell and extensible in Haskell. The goal of the Yi project is to provide a flexible, powerful, and correct editor for haskell hacking. license: GPL-2 license-file: LICENSE author: AUTHORS maintainer: yi-devel@googlegroups.com homepage: https://yi-editor.github.io bug-reports: https://github.com/yi-editor/yi/issues Cabal-Version: >= 1.20 tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1 build-type: Simple data-files: art/*.png art/*.pdf example-configs/*.hs extra-source-files: src/tests/vimtests/README.rst src/tests/vimtests/blockvisual/*.test src/tests/vimtests/change/*.test src/tests/vimtests/delete/*.test src/tests/vimtests/digraphs/*.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/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/bigWord/*.test src/tests/vimtests/movement/char/*.test 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/hl/events src/tests/vimtests/movement/char/hl/input src/tests/vimtests/movement/char/hl/output 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 location: https://github.com/yi-editor/yi.git -- Frontends flag pango Default: False Description: Build with Pango frontend flag vty Default: True Description: Build with Vty frontend flag profiling Default: False Description: Runtime binary will be compiled with profiling and RTS options enabled. flag eventlog Default: False Description: Runtime binary will be compiled with eventlog and RTS options enabled. flag testing Description: bake-in the self-checks flag hint Default: True Description: Include hint (haskell interpreter) in yi library hs-source-dirs: src/library default-language: Haskell2010 if flag(profiling) CPP-options: -DPROFILING if flag(eventlog) CPP-options: -DEVENTLOG if flag(hint) CPP-options: -DHINT exposed-modules: Yi Yi.Boot Yi.Boot.Internal Yi.Buffer Yi.Buffer.Adjusted Yi.Buffer.HighLevel Yi.Buffer.Indent Yi.Buffer.Normal Yi.Buffer.Misc Yi.Buffer.Region Yi.Buffer.TextUnit Yi.Buffer.Undo Yi.Command Yi.Command.Help Yi.Completion Yi.Config Yi.Config.Default Yi.Config.Misc Yi.Config.Lens Yi.Config.Simple Yi.Config.Simple.Types Yi.Core Yi.Debug Yi.Dired Yi.Editor Yi.Eval Yi.Event Yi.File Yi.History Yi.Hoogle Yi.Hooks Yi.IReader Yi.IncrementalParse Yi.Interact Yi.JumpList Yi.Keymap Yi.Keymap.Completion Yi.Keymap.Cua Yi.Keymap.Emacs Yi.Keymap.Emacs.KillRing Yi.Keymap.Emacs.Utils Yi.Keymap.Keys Yi.Keymap.Vim Yi.Keymap.Vim.Common Yi.Keymap.Vim.Digraph Yi.Keymap.Vim.Eval Yi.Keymap.Vim.EventUtils Yi.Keymap.Vim.Ex Yi.Keymap.Vim.Ex.Commands.Common Yi.Keymap.Vim.Ex.Commands.Buffer Yi.Keymap.Vim.Ex.Commands.Buffers Yi.Keymap.Vim.Ex.Commands.BufferDelete Yi.Keymap.Vim.Ex.Commands.Cabal Yi.Keymap.Vim.Ex.Commands.Delete 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 Yi.Keymap.Vim.Ex.Eval Yi.Keymap.Vim.ExMap Yi.Keymap.Vim.InsertMap Yi.Keymap.Vim.MatchResult Yi.Keymap.Vim.Motion Yi.Keymap.Vim.NormalMap Yi.Keymap.Vim.NormalOperatorPendingMap Yi.Keymap.Vim.Operator Yi.Keymap.Vim.ReplaceMap Yi.Keymap.Vim.ReplaceSingleCharMap Yi.Keymap.Vim.Search Yi.Keymap.Vim.SearchMotionMap Yi.Keymap.Vim.StateUtils Yi.Keymap.Vim.StyledRegion Yi.Keymap.Vim.Tag Yi.Keymap.Vim.TextObject Yi.Keymap.Vim.Utils Yi.Keymap.Vim.VisualMap Yi.KillRing Yi.Layout Yi.Main Yi.MiniBuffer Yi.Misc Yi.Mode.Abella Yi.Mode.Buffers Yi.Mode.Compilation Yi.Mode.GHCi Yi.Mode.Haskell Yi.Mode.Haskell.Dollarify Yi.Mode.IReader Yi.Mode.Interactive Yi.Mode.JavaScript Yi.Mode.Latex Yi.Modes Yi.Monad Yi.Paths Yi.PersistentState Yi.Process Yi.Rectangle Yi.Snippets Yi.Snippets.Haskell Yi.Search Yi.Search.Internal Yi.String Yi.Syntax.Driver Yi.Syntax.Haskell Yi.Syntax.JavaScript Yi.Syntax.Latex Yi.Syntax.Layout Yi.Syntax.OnlineTree Yi.Syntax.Paren Yi.Syntax.Tree Yi.Syntax.Strokes.Haskell Yi.Tab Yi.Tag Yi.TextCompletion Yi.Types Yi.UI.Common Yi.UI.Batch Yi.UI.SimpleLayout Yi.UI.TabBar Yi.UI.Utils Yi.Verifier.JavaScript Yi.Window Yi.Char.Unicode if flag(hint) build-depends: hint > 0.3.1 build-depends: Cabal >= 1.10, array, binary >= 0.7, containers, directory, process >= 1.0.1.1, old-locale, base >= 4 && < 5, bytestring >= 0.9.1 && < 0.11, dynamic-state >= 0.1.0.5, data-default, lens >= 4.7, dlist >=0.4.1, dyre >=0.8.11, filepath >= 1.1, hashable >=1.1.2.5, mtl >= 0.1.0.1, parsec >= 3.0, pointedlist >= 0.5, text-icu >= 0.7, safe >= 0.3.4 && < 0.4, split >= 0.1 && < 0.3, template-haskell >= 2.4, text >= 1.1.1.3, time >= 1.1, unix-compat >=0.1 && <0.5, unordered-containers >= 0.1.3 && < 0.3, xdg-basedir >= 0.2.1 && < 0.3, transformers-base, semigroups, word-trie >= 0.2.0.4, yi-language >= 0.1.1.0, oo-prototypes, yi-rope >= 0.7.0.0 && < 0.8, exceptions, Hclip >= 3 ghc-options: -Wall -fno-warn-orphans -ferror-spans if flag(profiling) cpp-options: -DPROFILING if flag(eventlog) CPP-options: -DEVENTLOG ghc-options: -Wall -fno-warn-orphans -eventlog default-extensions: NondecreasingIndentation if !os(windows) build-depends: unix if os(windows) build-depends: Win32 if flag(testing) cpp-options: -DTESTING build-depends: QuickCheck >= 2.7 && < 2.9, random -- Frontends if flag(pango) exposed-modules: Yi.UI.Pango Yi.UI.Pango.Control other-modules: Yi.UI.Pango.Layouts Yi.UI.Pango.Utils build-depends: gtk >= 0.13 && < 0.15, glib >= 0.13 && < 0.14, pango >= 0.13 && < 0.14 cpp-options: -DFRONTEND_PANGO if flag(vty) exposed-modules: Yi.UI.Vty Yi.UI.Vty.Conversions build-depends: vty >= 5.4, stm >= 2.2 cpp-options: -DFRONTEND_VTY other-modules: Paths_yi, -- "Internal" modules that the user better not see. Yi.Buffer.Implementation, Parser.Incremental, -- Should probably be split out to another package. Control.Exc, Data.DelayList, System.CanonicalizePath, System.FriendlyPath executable yi hs-source-dirs: src/executable default-language: Haskell2010 if flag(profiling) cpp-options: -DPROFILING main-is: Main.hs build-depends: base >=4 && <5, yi ghc-options: -threaded Test-Suite test-suite default-language: Haskell2010 hs-source-dirs: src/tests type: exitcode-stdio-1.0 main-is: TestSuite.hs other-modules: Driver Generic.TestPureBufferManipulations Generic.TestUtils Vim.EditorManipulations.BufferExCommand Vim.TestExCommandParsers Vim.TestPureBufferManipulations Vim.TestPureEditorManipulations build-depends: base, lens >= 4.7, semigroups, tasty, tasty-hunit, tasty-quickcheck, HUnit, QuickCheck, filepath, directory, text, yi-language >= 0.1.1.0, yi-rope, yi yi-0.12.6/src/tests/vimtests/README.rst0000644000000000000000000000447412533751517015727 0ustar0000000000000000Testing Vim bindings ==================== Single file test format ----------------------- Files with names like "foo.test" are treated as single file tests. :: -- Input <-- This marks beginning of initial buffer state (1,1) <-- This is initial cursor position, (row, column), both 1-based aaaaa <-- Here goes actual buffer content b b b ccccc -- Output <-- This marks beginning of expected buffer state after test (3,5) <-- This is expected cursor position aaaaa <-- Expected buffer text b bfoo b ccccc -- Events <-- This line starts event sequence that is fed to editor after loading initial state 2wifoo jj Directory test format --------------------- Directories that contain files "input", "output" and "events" and nothing else are considered directory tests. These three files have the same format as the sections of single file test described above. Test file naming note --------------------- Originally we've used names like "ddP.test" and "ddp.test". It turned out to be really inconvenient on OSX, which uses case-insensitive filesystem by default. We had to rename tests to avoid collisions: "ddP.test" became "dd_capP.test". Event notation -------------- Event parsing expects a subset of vim notation (see :help <>). Backslash escaping is not supported. So to enter left angle bracket one must write and not \<. Intentionally not supported features of Vim ------------------------------------------- * select mode * folds * 0 and ^ in insert mode * After i_ only motions are allowed Features incompatible with Vim because why not ---------------------------------------------- * Y yanks to EOL * A and I in linewise visual mode behave like in blockwise visual mode * 999rZ turns ABC into ZZZ instead of doing nothing * Operators in visual mode always leave cursor at selection start. Vim doesn't do this in some cases and I don't understand the pattern. * Paragraph text object is slightly different * Repeating insert actions with dot works differently when insertion events contain oneshot normal commands, e.g. "ifoohbar". In Vim dot would insert only "bar", but yi dot inserts "fobaro" * Scrolling motions (, PageUp, etc) are treated like linewise motions. * , remove whole region, not only entered characters. yi-0.12.6/src/tests/vimtests/blockvisual/0.test0000644000000000000000000000011312533751517017600 0ustar0000000000000000-- Input (1,1) 1234 1234 1234 -- Output (1,2) 14 14 14 -- Events lljjdyi-0.12.6/src/tests/vimtests/blockvisual/8.test0000644000000000000000000000013412533751517017613 0ustar0000000000000000-- Input (1,1) ABCD ABCD ABCD ABCD -- Output (2,2) ABCD AcD AbcD ABCD -- Events ljjlguxyi-0.12.6/src/tests/vimtests/blockvisual/9.test0000644000000000000000000000014112533751517017612 0ustar0000000000000000-- Input (1,1) abcd abcd abcd abcd -- Output (2,3) abcd abD abCD abCD -- Events jjjlllkkhgUxyi-0.12.6/src/tests/vimtests/blockvisual/block.test0000644000000000000000000000013212533751517020534 0ustar0000000000000000-- Input (1,1) ABCD ABCD ABCD ABCD -- Output (3,3) ABCD ABCD ABCD ABCD -- Events jljlyi-0.12.6/src/tests/vimtests/blockvisual/block_d.test0000644000000000000000000000012712533751517021043 0ustar0000000000000000-- Input (1,1) ABCD ABCD ABCD ABCD -- Output (2,2) ABCD AD AD ABCD -- Events jljldyi-0.12.6/src/tests/vimtests/blockvisual/block_d_1.test0000644000000000000000000000012712533751517021263 0ustar0000000000000000-- Input (1,4) ABCD ABCD ABCD ABCD -- Output (2,2) ABCD AD AD ABCD -- Events hjjhdyi-0.12.6/src/tests/vimtests/blockvisual/block_d_2.test0000644000000000000000000000012212533751517021257 0ustar0000000000000000-- Input (1,4) ABCD ABCD ABCD ABCD -- Output (1,1) A A A ABCD -- Events 2jhhdyi-0.12.6/src/tests/vimtests/blockvisual/capD_1.test0000644000000000000000000000007512533751517020537 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) f b -- Events ljDyi-0.12.6/src/tests/vimtests/blockvisual/capD_2.test0000644000000000000000000000015112533751517020533 0ustar0000000000000000-- Input (2,2) foo 44444444 bar baz xyzzy 123123 -- Output (2,1) foo 4 b b x 123123 -- Events 4jD yi-0.12.6/src/tests/vimtests/blockvisual/capI.test0000644000000000000000000000012412533751517020317 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,3) fo-o ba-r ba-z -- Events lljjI-yi-0.12.6/src/tests/vimtests/blockvisual/capU_2.test0000644000000000000000000000011212533751517020551 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) FOo BAr BAz -- Events ljjUyi-0.12.6/src/tests/vimtests/blockvisual/commentblock.test0000644000000000000000000000023412533751517022122 0ustar0000000000000000-- Input (2,3) 444 foo bar baz xyzzy abc 123 555 -- Output (2,5) 444 // foo bar // baz xyzzy // abc 123 555 -- Events 3jI// yi-0.12.6/src/tests/vimtests/blockvisual/commentblock_1.test0000644000000000000000000000017312533751517022344 0ustar0000000000000000-- Input (1,3) foo bar baz xyzzy abc 123 -- Output (1,3) @foo bar @baz xyzzy @abc 12@3 -- Events 3jI@yi-0.12.6/src/tests/vimtests/blockvisual/commentblock_2.test0000644000000000000000000000023412533751517022343 0ustar0000000000000000-- Input (2,3) 444 foo bar baz xyzzy abc 123 555 -- Output (2,5) 444 // foo bar // baz xyzzy // abc 123 555 -- Events 3jI// yi-0.12.6/src/tests/vimtests/blockvisual/d.test0000644000000000000000000000021412533751517017666 0ustar0000000000000000-- Input (1,17) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem sit amet abc de qwe rty uiop -- Events 10hjdyi-0.12.6/src/tests/vimtests/blockvisual/d_1.test0000644000000000000000000000012512533751517020107 0ustar0000000000000000-- Input (2,3) ABCD ABCD ABCD ABCD -- Output (2,2) ABCD AD AD ABCD -- Events jhdyi-0.12.6/src/tests/vimtests/blockvisual/d_2.test0000644000000000000000000000020612533751517020110 0ustar0000000000000000-- Input (2,1) 444 foo bar baz xyzzy abc 123 555 -- Output (2,1) 444 foo bar baz xyzzy abc 123 555 -- Events 3jldyi-0.12.6/src/tests/vimtests/blockvisual/d_3.test0000644000000000000000000000011112533751517020104 0ustar0000000000000000-- Input (2,1) foo bar -- Output (2,1) foo bar -- Events 3jdyi-0.12.6/src/tests/vimtests/blockvisual/d_4.test0000644000000000000000000000013212533751517020110 0ustar0000000000000000-- Input (1,6) xyzzy123 foo barbaz90 -- Output (1,6) xyzzy3 foo barba0 -- Events jjldyi-0.12.6/src/tests/vimtests/blockvisual/hl.test0000644000000000000000000000023312533751517020047 0ustar0000000000000000-- Input (1,17) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 10hjyi-0.12.6/src/tests/vimtests/blockvisual/o_1.test0000644000000000000000000000013112533751517020117 0ustar0000000000000000-- Input (2,2) abcd abcd abcd abcd -- Output (2,2) abcd abcd abcd abcd -- Events jloyi-0.12.6/src/tests/vimtests/blockvisual/o_2.test0000644000000000000000000000013212533751517020121 0ustar0000000000000000-- Input (2,2) abcd abcd abcd abcd -- Output (2,3) abcd abcd abcd abcd -- Events jloOyi-0.12.6/src/tests/vimtests/blockvisual/o_3.test0000644000000000000000000000013212533751517020122 0ustar0000000000000000-- Input (2,2) abcd abcd abcd abcd -- Output (3,3) abcd abcd abcd abcd -- Events jlooyi-0.12.6/src/tests/vimtests/blockvisual/o_4.test0000644000000000000000000000013112533751517020122 0ustar0000000000000000-- Input (2,2) abcd abcd abcd abcd -- Output (3,2) abcd abcd abcd abcd -- Events jlOyi-0.12.6/src/tests/vimtests/blockvisual/o_5.test0000644000000000000000000000020712533751517020127 0ustar0000000000000000-- Input (1,17) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,2) Ldolor sit amet a qwe rty uiop -- Events j2|Odyi-0.12.6/src/tests/vimtests/blockvisual/o_6.test0000644000000000000000000000022412533751517020127 0ustar0000000000000000-- Input (1,17) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem dolor sit amet abc de qwe rty uiop -- Events 10hjOhdyi-0.12.6/src/tests/vimtests/blockvisual/r_1.test0000644000000000000000000000016212533751517020126 0ustar0000000000000000-- Input (1,3) foo bar baz xyzzy abc 123 -- Output (1,3) xoo bar xaz xyzzy xbc 12x -- Events 3jrxyi-0.12.6/src/tests/vimtests/blockvisual/r_2.test0000644000000000000000000000010712533751517020126 0ustar0000000000000000-- Input (1,1) 1234 1234 -- Output (1,2) 1xx4 1xx4 -- Events lljrxyi-0.12.6/src/tests/vimtests/blockvisual/r_3.test0000644000000000000000000000011312533751517020124 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,2) fxx bxx baz -- Events lljrxyi-0.12.6/src/tests/vimtests/blockvisual/switchcase_2.test0000644000000000000000000000010112533751517022014 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) FOo BAr -- Events jl~yi-0.12.6/src/tests/vimtests/blockvisual/u_2.test0000644000000000000000000000011212533751517020125 0ustar0000000000000000-- Input (1,1) FOO BAR BAZ -- Output (1,1) foO baR baZ -- Events ljjuyi-0.12.6/src/tests/vimtests/blockvisual/y_10.test0000644000000000000000000000013512533751517020215 0ustar0000000000000000-- Input (2,2) 1234 abcd ABCD XYZW -- Output (2,2) 1234 abcdbcd ABCD XYZW -- Events llyPyi-0.12.6/src/tests/vimtests/blockvisual/y_11.test0000644000000000000000000000016612533751517020222 0ustar0000000000000000-- Input (2,2) abcdef abcdef abcdef abcdef -- Output (2,2) abcdef a bcdef a bcdef a bcdef -- Events jj> yi-0.12.6/src/tests/vimtests/blockvisual/y_12.test0000644000000000000000000000017212533751517020220 0ustar0000000000000000-- Input (2,2) abcdef abcdef abcdef abcdef -- Output (3,3) abcdef abcdef abbcdcdef abbcdcdef bcd -- Events lljjyjp yi-0.12.6/src/tests/vimtests/blockvisual/y_13.test0000644000000000000000000000017112533751517020220 0ustar0000000000000000-- Input (2,2) abcdef a bcdef a bcdef abcdef -- Output (2,2) abcdef a bcdef a bcdef a bcdef -- Events jj>yi-0.12.6/src/tests/vimtests/blockvisual/y_14.test0000644000000000000000000000017012533751517020220 0ustar0000000000000000-- Input (2,2) abcdef a bcdef a bcdef a bcdef -- Output (2,2) abcdef abcdef abcdef abcdef -- Events jjyi-0.12.6/src/tests/vimtests/blockvisual/y_15.test0000644000000000000000000000020412533751517020217 0ustar0000000000000000-- Input (2,2) abcdef a bcdef a bcdef a bcdef -- Output (2,2) abcdef a bcdef a bcdef a bcdef -- Events jjyi-0.12.6/src/tests/vimtests/blockvisual/y_3.test0000644000000000000000000000007712533751517020144 0ustar0000000000000000-- Input (1,1) 12 12 -- Output (1,2) 112 112 -- Events jypyi-0.12.6/src/tests/vimtests/blockvisual/y_4.test0000644000000000000000000000014012533751517020134 0ustar0000000000000000-- Input (1,1) 1234 abcd ABCD XYZW -- Output (2,3) 1234 abbccd ABBCCD XYZW -- Events ljljypyi-0.12.6/src/tests/vimtests/blockvisual/y_7.test0000644000000000000000000000014012533751517020137 0ustar0000000000000000-- Input (1,1) 1234 abcd ABCD XYZW -- Output (2,2) 1234 abcbcd ABCBCD XYZW -- Events ljljyPyi-0.12.6/src/tests/vimtests/blockvisual/y_8.test0000644000000000000000000000013612533751517020145 0ustar0000000000000000-- Input (1,1) 1234 abcd ABCD XYZW -- Output (1,5) 12344 abcdd ABCDD XYZW -- Events $jjypyi-0.12.6/src/tests/vimtests/blockvisual/y_9.test0000644000000000000000000000014312533751517020144 0ustar0000000000000000-- Input (2,2) 1234 abcd ABCD XYZW -- Output (2,2) 1234 abcdbcd ABCD XYZW -- Events llllllllyPyi-0.12.6/src/tests/vimtests/change/c3l.test0000644000000000000000000000023212533751517017033 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,11) xem ipsum xor sit amet abc def ghi qwe rty uiop -- Events c3lxww.yi-0.12.6/src/tests/vimtests/change/C_part_of_line.test0000644000000000000000000000021412533751517021255 0ustar0000000000000000-- Input (1,9) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,11) Lorem ipman abc def ghi qwe rty uiop -- Events Cmanyi-0.12.6/src/tests/vimtests/change/C_whole_line.test0000644000000000000000000000020312533751517020737 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,3) man abc def ghi qwe rty uiop -- Events Cmanyi-0.12.6/src/tests/vimtests/change/cc.test0000644000000000000000000000020512533751517016737 0ustar0000000000000000-- Input (1,11) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,3) man abc def ghi qwe rty uiop -- Events ccmanyi-0.12.6/src/tests/vimtests/change/ciw.test0000644000000000000000000000023212533751517017134 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,3) foo ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ciwfooyi-0.12.6/src/tests/vimtests/change/S.test0000644000000000000000000000020412533751517016553 0ustar0000000000000000-- Input (1,11) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,3) man abc def ghi qwe rty uiop -- Events Smanyi-0.12.6/src/tests/vimtests/change/s_eol.test0000644000000000000000000000023312717763531017457 0ustar0000000000000000-- Input (1,11) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,26) Lorem ipsum dolor sit amex abc def ghi qwe rty uiop -- Events $sxyi-0.12.6/src/tests/vimtests/change/V3jc.test0000644000000000000000000000015312533751517017161 0ustar0000000000000000-- Input (2,3) aaaaaa bbbbbb cccccc dddddd eeeeee ffffff -- Output (2,1) aaaaaa ffffff -- Events V3jcyi-0.12.6/src/tests/vimtests/delete/10dd.test0000644000000000000000000000017412533751517017124 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet -- Events 10ddyi-0.12.6/src/tests/vimtests/delete/2d3w.test0000644000000000000000000000010112533751517017141 0ustar0000000000000000-- Input (1,1) a b c d e f g h -- Output (1,1) g h -- Events 2d3wyi-0.12.6/src/tests/vimtests/delete/2d3w_1.test0000644000000000000000000000013412533751517017367 0ustar0000000000000000-- Input (1,1) a b c d e f g h a b c d e f g h -- Output (2,1) g h e f g h -- Events 2d3wj4.yi-0.12.6/src/tests/vimtests/delete/2dd.test0000644000000000000000000000015512533751517017044 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) qwe rty uiop -- Events 2ddyi-0.12.6/src/tests/vimtests/delete/C-u_1.test0000644000000000000000000000017412533751517017240 0ustar0000000000000000-- Input (2,5) Lorem ipsum dolor sit amet qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet rty uiop -- Events i yi-0.12.6/src/tests/vimtests/delete/C-u_2.test0000644000000000000000000000010712533751517017235 0ustar0000000000000000-- Input (2,1) foo bar baz -- Output (1,8) foo barbaz -- Events i yi-0.12.6/src/tests/vimtests/delete/capD.test0000644000000000000000000000011112533751517017232 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo b baz -- Events jllDyi-0.12.6/src/tests/vimtests/delete/capX.test0000644000000000000000000000024112533751517017262 0ustar0000000000000000-- Input (1,1) A very intelligent turtle Found programming UNIX a hurdle -- Output (2,11) A very intelligent turtle Found progng UNIX a hurdle -- Events 15lj3XXXyi-0.12.6/src/tests/vimtests/delete/capX_1.test0000644000000000000000000000010212533751517017476 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,1) foo ar baz -- Events 5Xyi-0.12.6/src/tests/vimtests/delete/d0.test0000644000000000000000000000016212533751517016674 0ustar0000000000000000-- Input (1,1) abc def ghi 123 456 789 lorem ipsum -- Output (1,1) bc def ghi 123 456 789 lorem ipsum -- Events dlyi-0.12.6/src/tests/vimtests/delete/d00.test0000644000000000000000000000015712533751517016760 0ustar0000000000000000-- Input (1,6) abc def ghi 123 456 789 lorem ipsum -- Output (1,1) ef ghi 123 456 789 lorem ipsum -- Events d0 yi-0.12.6/src/tests/vimtests/delete/d2G.test0000644000000000000000000000022612533751517017006 0ustar0000000000000000-- Input (3,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop aze rty uiop -- Output (2,1) Lorem ipsum dolor sit amet aze rty uiop -- Events d2G yi-0.12.6/src/tests/vimtests/delete/d2vd.test0000644000000000000000000000022512533751517017230 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,7) Lorem ipsum dolor sit amet abc qwe rty uiop -- Events d2vd yi-0.12.6/src/tests/vimtests/delete/d2vd_1.test0000644000000000000000000000023012533751517017444 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet abc qwe rty uiop -- Events d2vd yi-0.12.6/src/tests/vimtests/delete/d3G.test0000644000000000000000000000022612533751517017007 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop aze rty uiop -- Output (2,1) Lorem ipsum dolor sit amet aze rty uiop -- Events d3G yi-0.12.6/src/tests/vimtests/delete/d3vd.test0000644000000000000000000000025112533751517017230 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet abc qwe rty uiop -- Events d3vd yi-0.12.6/src/tests/vimtests/delete/d_capG.test0000644000000000000000000000015612533751517017551 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop aze rty uiop -- Output (1,1) -- Events dG yi-0.12.6/src/tests/vimtests/delete/d_capV}.test0000644000000000000000000000012112533751517017755 0ustar0000000000000000-- Input (1,5) Foo bar baz 123 234 345 -- Output (1,1) 123 234 345 -- Events dV}yi-0.12.6/src/tests/vimtests/delete/daw.test0000644000000000000000000000021612533751517017144 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) ipsum dolor sit amet abc def ghi qwe rty uiop -- Events dawyi-0.12.6/src/tests/vimtests/delete/dd.test0000644000000000000000000000021012533751517016752 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Events jddyi-0.12.6/src/tests/vimtests/delete/dd_1.test0000644000000000000000000000021112533751517017173 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Events j$ddyi-0.12.6/src/tests/vimtests/delete/dd_2.test0000644000000000000000000000015612533751517017204 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) qwe rty uiop -- Events $2ddyi-0.12.6/src/tests/vimtests/delete/dd_3.test0000644000000000000000000000020612533751517017201 0ustar0000000000000000-- Input (3,3) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi -- Events ddyi-0.12.6/src/tests/vimtests/delete/dd_4.test0000644000000000000000000000017712533751517017211 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet -- Events 2ddyi-0.12.6/src/tests/vimtests/delete/dd_5.test0000644000000000000000000000017712533751517017212 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet -- Events 2ddyi-0.12.6/src/tests/vimtests/delete/de.test0000644000000000000000000000021612533751517016761 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) ipsum dolor sit amet abc def ghi qwe rty uiop -- Events deyi-0.12.6/src/tests/vimtests/delete/diw.test0000644000000000000000000000021712533751517017155 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) ipsum dolor sit amet abc def ghi qwe rty uiop -- Events diwyi-0.12.6/src/tests/vimtests/delete/dj.test0000644000000000000000000000015412533751517016767 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) qwe rty uiop -- Events djyi-0.12.6/src/tests/vimtests/delete/dt.test0000644000000000000000000000024312533751517017000 0ustar0000000000000000-- Input (2,10) Lorem ipsum dolor sit amet [peanut butter and jelly] qwe rty uiop -- Output (2,10) Lorem ipsum dolor sit amet [peanut b] qwe rty uiop -- Events dt]yi-0.12.6/src/tests/vimtests/delete/dvd.test0000644000000000000000000000022612533751517017147 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,4) Lorem ipsum dolor sit amet def ghi qwe rty uiop -- Events dvdyi-0.12.6/src/tests/vimtests/delete/dve.test0000644000000000000000000000010212533751517017141 0ustar0000000000000000-- Input (1,1) Foo bar baz -- Output (1,1) o bar baz -- Events dveyi-0.12.6/src/tests/vimtests/delete/dVl.test0000644000000000000000000000021012533751517017110 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Events dVlyi-0.12.6/src/tests/vimtests/delete/dv}.test0000644000000000000000000000012512533751517017176 0ustar0000000000000000-- Input (1,5) Foo bar baz 123 234 345 -- Output (1,5) Foo 123 234 345 -- Events dv}yi-0.12.6/src/tests/vimtests/delete/dw_1.test0000644000000000000000000000020312533751517017217 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) sit amet abc def ghi qwe rty uiop -- Events dw..yi-0.12.6/src/tests/vimtests/delete/d}.test0000644000000000000000000000012712533751517017012 0ustar0000000000000000-- Input (1,5) Foo bar baz 123 234 345 -- Output (1,4) Foo 123 234 345 -- Events d} yi-0.12.6/src/tests/vimtests/delete/ld3w.test0000644000000000000000000000010112533751517017233 0ustar0000000000000000-- Input (1,1) 1 2 3 4 5 6 -- Output (1,1) 1 4 5 6 -- Events ld3wyi-0.12.6/src/tests/vimtests/delete/ld3w_1.test0000644000000000000000000000010012533751517017452 0ustar0000000000000000-- Input (1,1) 1 2 3 4 5 6 -- Output (1,2) 14 5 6 -- Events ld3wyi-0.12.6/src/tests/vimtests/delete/ldw.test0000644000000000000000000000010312533751517017152 0ustar0000000000000000-- Input (1,1) 1 2 3 4 5 6 -- Output (1,2) 12 3 4 5 6 -- Events ldwyi-0.12.6/src/tests/vimtests/delete/ldwdw.test0000644000000000000000000000010312533751517017505 0ustar0000000000000000-- Input (1,1) 1 2 3 4 5 6 -- Output (1,2) 13 4 5 6 -- Events ldwdwyi-0.12.6/src/tests/vimtests/delete/spec_delete.test0000644000000000000000000000010512533751517020642 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,2) foo br baz -- Events yi-0.12.6/src/tests/vimtests/delete/x.test0000644000000000000000000000023512533751517016641 0ustar0000000000000000-- Input (1,1) A very intelligent turtle Found programming UNIX a hurdle -- Output (2,4) A very intelligent turtle Foumming UNIX a hurdle -- Events 3lj5xxxxxyi-0.12.6/src/tests/vimtests/delete/x_1.test0000644000000000000000000000010112533751517017051 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,1) foo b baz -- Events 5xyi-0.12.6/src/tests/vimtests/digraphs/ae.test0000644000000000000000000000010412533751517017311 0ustar0000000000000000-- Input (1,5) abcdf -- Output (1,5) abcdæf -- Events iaeyi-0.12.6/src/tests/vimtests/digraphs/eacute.test0000644000000000000000000000010412533751517020172 0ustar0000000000000000-- Input (1,5) abcdf -- Output (1,5) abcdéf -- Events i'eyi-0.12.6/src/tests/vimtests/empty/empty.test0000644000000000000000000000006112533751517017421 0ustar0000000000000000-- Input (1,1) -- Output (1,1) -- Events yi-0.12.6/src/tests/vimtests/empty/emptytest/events0000644000000000000000000000000012533751517020640 0ustar0000000000000000yi-0.12.6/src/tests/vimtests/empty/emptytest/input0000644000000000000000000000001512533751517020501 0ustar0000000000000000(1,1) yi-0.12.6/src/tests/vimtests/empty/emptytest/output0000644000000000000000000000001512533751517020702 0ustar0000000000000000(1,1) yi-0.12.6/src/tests/vimtests/ex/empty.test0000644000000000000000000000007212533751517016701 0ustar0000000000000000-- Input (1,1) -- Output (1,1) -- Events :::yi-0.12.6/src/tests/vimtests/ex/esc.test0000644000000000000000000000011412533751517016312 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo bar baz -- Events ll:hj yi-0.12.6/src/tests/vimtests/ex/esc_1.test0000644000000000000000000000012012533751517016527 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo bar baz -- Events ll:blahhj yi-0.12.6/src/tests/vimtests/ex/fail.test0000644000000000000000000000011712533751517016456 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo bar baz -- Events ll:blahhj yi-0.12.6/src/tests/vimtests/ex/d/1.test0000644000000000000000000000010512533751517016123 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo baz -- Events j:d yi-0.12.6/src/tests/vimtests/ex/d/2.test0000644000000000000000000000011212533751517016122 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo baz -- Events j:delete yi-0.12.6/src/tests/vimtests/ex/g/1.test0000644000000000000000000000017612533751517016136 0ustar0000000000000000-- Input (2,1) a 1 bb 2 bb 3 bb 4 ba 5 bb 6 bb 3 -- Output (2,1) a 1 bb 2 bb x bb 4 ba 5 bb 6 bb x -- Events :g/bb/s/3/x/ yi-0.12.6/src/tests/vimtests/ex/g/2.test0000644000000000000000000000016412533751517016134 0ustar0000000000000000-- Input (1,1) a 1 bb 2 bb 3 bb 4 ba 5 bb 6 bb 7 -- Output (1,1) a 1 bb 2 bb 3 bb 4 bb 6 bb 7 -- Events :g/ba/d yi-0.12.6/src/tests/vimtests/ex/gotoline/1.test0000644000000000000000000000012312533751517017520 0ustar0000000000000000-- Input (1,1) foo bar baz xyzzy -- Output (3,1) foo bar baz xyzzy -- Events :3yi-0.12.6/src/tests/vimtests/ex/gotoline/2.test0000644000000000000000000000012712533751517017525 0ustar0000000000000000-- Input (1,1) foo bar baz xyzzy -- Output (3,3) foo bar baz xyzzy -- Events :3yi-0.12.6/src/tests/vimtests/ex/gotoline/3.test0000644000000000000000000000012712533751517017526 0ustar0000000000000000-- Input (1,1) foo bar baz xyzzy -- Output (1,1) foo bar baz xyzzy -- Events :0yi-0.12.6/src/tests/vimtests/ex/gotoline/4.test0000644000000000000000000000013412533751517017525 0ustar0000000000000000-- Input (1,1) foo bar baz xyzzy -- Output (4,1) foo bar baz xyzzy -- Events :100500yi-0.12.6/src/tests/vimtests/ex/s/1.test0000644000000000000000000000011612533751517016144 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo car baz -- Events j:s/b/c/ yi-0.12.6/src/tests/vimtests/ex/s/1_dollar.test0000644000000000000000000000011512533751517017500 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo car baz -- Events j:s$b$c$yi-0.12.6/src/tests/vimtests/ex/s/1_question.test0000644000000000000000000000011512533751517020072 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo car baz -- Events j:s?b?c?yi-0.12.6/src/tests/vimtests/ex/s/1_sharp.test0000644000000000000000000000011512533751517017340 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo car baz -- Events j:s#b#c#yi-0.12.6/src/tests/vimtests/ex/s/2.test0000644000000000000000000000011712533751517016146 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo car caz -- Events j:%s/b/c/ yi-0.12.6/src/tests/vimtests/ex/s/3.test0000644000000000000000000000012012533751517016141 0ustar0000000000000000-- Input (1,1) foo bbar baz -- Output (2,1) foo cbar baz -- Events j:s/b/c/ yi-0.12.6/src/tests/vimtests/ex/s/4.test0000644000000000000000000000012112533751517016143 0ustar0000000000000000-- Input (1,1) foo bbar baz -- Output (2,1) foo ccar baz -- Events j:s/b/c/g yi-0.12.6/src/tests/vimtests/ex/s/5.test0000644000000000000000000000012312533751517016146 0ustar0000000000000000-- Input (1,1) foo bbar bbaz -- Output (2,1) foo cbar cbaz -- Events j:%s/b/c/ yi-0.12.6/src/tests/vimtests/ex/s/6.test0000644000000000000000000000012412533751517016150 0ustar0000000000000000-- Input (1,1) foo bbar bbaz -- Output (2,1) foo ccar ccaz -- Events j:%s/b/c/g yi-0.12.6/src/tests/vimtests/ex/s/7.test0000644000000000000000000000014712533751517016156 0ustar0000000000000000-- Input (1,1) foo bbar bbaz bbaz quux -- Output (2,1) foo cbar cbaz cbaz quux -- Events j:%s/b/c/ yi-0.12.6/src/tests/vimtests/find/f.test0000644000000000000000000000022312533751517016272 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fiyi-0.12.6/src/tests/vimtests/find/f1.test0000644000000000000000000000022512533751517016355 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,20) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2fiyi-0.12.6/src/tests/vimtests/find/f2.test0000644000000000000000000000022512533751517016356 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,20) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fi;yi-0.12.6/src/tests/vimtests/find/f3.test0000644000000000000000000000022512533751517016357 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fi;,yi-0.12.6/src/tests/vimtests/find/f4.test0000644000000000000000000000022312533751517016356 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fhyi-0.12.6/src/tests/vimtests/find/f5.test0000644000000000000000000000022712533751517016363 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor syi-0.12.6/src/tests/vimtests/find/t.test0000644000000000000000000000022312533751517016310 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events tiyi-0.12.6/src/tests/vimtests/find/t1.test0000644000000000000000000000022512533751517016373 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,19) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2tiyi-0.12.6/src/tests/vimtests/find/t2.test0000644000000000000000000000022612533751517016375 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,19) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events til;yi-0.12.6/src/tests/vimtests/find/t3.test0000644000000000000000000000022512533751517016375 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events fi;,yi-0.12.6/src/tests/vimtests/find/t4.test0000644000000000000000000000022312533751517016374 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events thyi-0.12.6/src/tests/vimtests/find/t5.test0000644000000000000000000000022412533751517016376 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ti;yi-0.12.6/src/tests/vimtests/find/t6.test0000644000000000000000000000022612533751517016401 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events to2;yi-0.12.6/src/tests/vimtests/indent/1.test0000644000000000000000000000012512533751517016547 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (2,5) foo bar baz 123 -- Events j>j yi-0.12.6/src/tests/vimtests/indent/2.test0000644000000000000000000000012112533751517016544 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (2,5) foo bar baz 123 -- Events j>> yi-0.12.6/src/tests/vimtests/indent/3.test0000644000000000000000000000012612533751517016552 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (2,5) foo bar baz 123 -- Events j2>> yi-0.12.6/src/tests/vimtests/indent/4.test0000644000000000000000000000012512533751517016552 0ustar0000000000000000-- Input (2,5) foo bar baz 123 -- Output (2,1) foo bar baz 123 -- Events yi-0.12.6/src/tests/vimtests/indent/5.test0000644000000000000000000000014212533751517016552 0ustar0000000000000000-- Input (2,5) foo bar baz 123 -- Output (2,1) foo bar baz 123 -- Events 2yi-0.12.6/src/tests/vimtests/indent/6.test0000644000000000000000000000013712533751517016557 0ustar0000000000000000-- Input (2,6) foo bar baz 123 -- Output (2,1) foo bar baz 123 -- Events Vjyi-0.12.6/src/tests/vimtests/indent/7.test0000644000000000000000000000020012533751517016547 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (1,9) foo bar baz 123 -- Events 5>>yi-0.12.6/src/tests/vimtests/indent/8.test0000644000000000000000000000020312533751517016553 0ustar0000000000000000-- Input (1,1) foo bar baz 123 -- Output (1,5) foo bar baz 123 -- Events 4jyi-0.12.6/src/tests/vimtests/indent/setpaste.test0000644000000000000000000000022012533751517020233 0ustar0000000000000000-- Input (1,7) foo bar baz -- Output (3,3) foo quux 123 bar baz -- Events aquux:set pastea123 yi-0.12.6/src/tests/vimtests/insertion/2o.test0000644000000000000000000000012312533751517017456 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (4,3) 123 456 abc abc 789 -- Events 2oabcyi-0.12.6/src/tests/vimtests/insertion/a.test0000644000000000000000000000010212533751517017353 0ustar0000000000000000-- Input (1,1) -- Output (1,4) foOOo -- Events ifoohaOOyi-0.12.6/src/tests/vimtests/insertion/a2.test0000644000000000000000000000010212533751517017435 0ustar0000000000000000-- Input (1,1) -- Output (1,3) fOOoo -- Events ifoo0aOOyi-0.12.6/src/tests/vimtests/insertion/a3.test0000644000000000000000000000010212533751517017436 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifoo$aOOyi-0.12.6/src/tests/vimtests/insertion/a4.test0000644000000000000000000000010112533751517017436 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifooaOOyi-0.12.6/src/tests/vimtests/insertion/a_on_empty_line.test0000644000000000000000000000006712717763531022311 0ustar0000000000000000-- Input (2,1) -- Output (2,1) q -- Events aqyi-0.12.6/src/tests/vimtests/insertion/C-c_0.test0000644000000000000000000000006612533751517017765 0ustar0000000000000000-- Input (1,1) bar -- Output (1,1) ar -- Events syi-0.12.6/src/tests/vimtests/insertion/C-c_1.test0000644000000000000000000000006712533751517017767 0ustar0000000000000000-- Input (1,1) bar -- Output (1,1) br -- Events lsyi-0.12.6/src/tests/vimtests/insertion/C-c_10.test0000644000000000000000000000010012533751517020033 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,1) foo bar -- Events oyi-0.12.6/src/tests/vimtests/insertion/C-c_11.test0000644000000000000000000000010112533751517020035 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) oo bar -- Events wlIxyi-0.12.6/src/tests/vimtests/insertion/C-c_12.test0000644000000000000000000000010112533751517020036 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,5) foo ar -- Events wlixyi-0.12.6/src/tests/vimtests/insertion/C-c_13.test0000644000000000000000000000011412533751517020043 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,10) foo bhelloar -- Events wlihelloyi-0.12.6/src/tests/vimtests/insertion/C-c_2.test0000644000000000000000000000007412533751517017766 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) bar -- Events Syi-0.12.6/src/tests/vimtests/insertion/C-c_3.test0000644000000000000000000000010012533751517017755 0ustar0000000000000000-- Input (1,1) baz bar -- Output (1,6) baz ba -- Events lAxyi-0.12.6/src/tests/vimtests/insertion/C-c_4.test0000644000000000000000000000010012533751517017756 0ustar0000000000000000-- Input (1,1) baz bar -- Output (1,2) bz bar -- Events laxyi-0.12.6/src/tests/vimtests/insertion/C-c_5.test0000644000000000000000000000010412533751517017763 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) bar baz -- Events Cyi-0.12.6/src/tests/vimtests/insertion/C-c_6.test0000644000000000000000000000010212533751517017762 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) baz -- Events c2wyi-0.12.6/src/tests/vimtests/insertion/C-c_7.test0000644000000000000000000000011112533751517017763 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (3,1) foo bar baz -- Events joyi-0.12.6/src/tests/vimtests/insertion/C-c_8.test0000644000000000000000000000011112533751517017764 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo bar baz -- Events jOyi-0.12.6/src/tests/vimtests/insertion/C-c_9.test0000644000000000000000000000010012533751517017763 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) foo bar -- Events Oyi-0.12.6/src/tests/vimtests/insertion/C-d_0.test0000644000000000000000000000007312533751517017764 0ustar0000000000000000-- Input (1,1) foo -- Output (1,5) foo -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-d_1.test0000644000000000000000000000007312533751517017765 0ustar0000000000000000-- Input (1,1) foo -- Output (1,1) foo -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-d_2.test0000644000000000000000000000010412533751517017761 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) foo bar -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-d_3.test0000644000000000000000000000007312533751517017767 0ustar0000000000000000-- Input (1,6) foo -- Output (1,2) foo -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-d_4.test0000644000000000000000000000007312533751517017770 0ustar0000000000000000-- Input (1,2) foo -- Output (1,6) foo -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-d_5.test0000644000000000000000000000010512533751517017765 0ustar0000000000000000-- Input (2,1) foo bar -- Output (2,5) foo bar -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-d_6.test0000644000000000000000000000010112533751517017762 0ustar0000000000000000-- Input (2,1) foo bar -- Output (2,1) foo bar -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-e_0.test0000644000000000000000000000010512533751517017761 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) bfoo bar -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-e_1.test0000644000000000000000000000012112533751517017760 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) barfoo bar -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-e_2.test0000644000000000000000000000011312533751517017762 0ustar0000000000000000-- Input (1,1) foo b -- Output (1,1) bfoo b -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-h_0.test0000644000000000000000000000006712533751517017773 0ustar0000000000000000-- Input (1,1) foo -- Output (1,1) foo -- Events iyi-0.12.6/src/tests/vimtests/insertion/C-h_1.test0000644000000000000000000000007612533751517017774 0ustar0000000000000000-- Input (1,1) foo -- Output (1,1) foo -- Events liyi-0.12.6/src/tests/vimtests/insertion/C-h_2.test0000644000000000000000000000010412533751517017765 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) foobar -- Events jiyi-0.12.6/src/tests/vimtests/insertion/C-h_3.test0000644000000000000000000000013112533751517017766 0ustar0000000000000000-- Input (1,1) 1234567890 -- Output (1,5) 12345 -- Events Ayi-0.12.6/src/tests/vimtests/insertion/C-h_4.test0000644000000000000000000000011412533751517017770 0ustar0000000000000000-- Input (1,1) 1 2 3 -- Output (1,1) 1 -- Events GAyi-0.12.6/src/tests/vimtests/insertion/C-o_2.test0000644000000000000000000000012012533751517017772 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,4) foo baz -- Events i7lyi-0.12.6/src/tests/vimtests/insertion/C-o_3.test0000644000000000000000000000013012533751517017774 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,3) foo arbaz -- Events lijj yi-0.12.6/src/tests/vimtests/insertion/C-o_4.test0000644000000000000000000000012712533751517020003 0ustar0000000000000000-- Input (1,1) -- Output (1,3) ugougsausageosausage -- Events isausagebugo. yi-0.12.6/src/tests/vimtests/insertion/C-r_0.test0000644000000000000000000000011312533751517017775 0ustar0000000000000000-- Input (1,1) barbaz -- Output (1,3) barbarbaz -- Events "ay3liayi-0.12.6/src/tests/vimtests/insertion/C-r_1.test0000644000000000000000000000012012533751517017774 0ustar0000000000000000-- Input (1,1) bar baz -- Output (2,1) babar r baz -- Events "byyllib yi-0.12.6/src/tests/vimtests/insertion/C-w_0.test0000644000000000000000000000007112533751517020005 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) r -- Events $iyi-0.12.6/src/tests/vimtests/insertion/C-w_1.test0000644000000000000000000000007112533751517020006 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) r -- Events $iyi-0.12.6/src/tests/vimtests/insertion/C-y_0.test0000644000000000000000000000012212533751517020004 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,3) foo foobar -- Events jiyi-0.12.6/src/tests/vimtests/insertion/C-y_1.test0000644000000000000000000000010612533751517020007 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,1) foo fbar -- Events jiyi-0.12.6/src/tests/vimtests/insertion/C-y_2.test0000644000000000000000000000011412533751517020007 0ustar0000000000000000-- Input (1,1) f bar -- Output (2,1) f fbar -- Events jiyi-0.12.6/src/tests/vimtests/insertion/capA.test0000644000000000000000000000010112533751517017776 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifooAOOyi-0.12.6/src/tests/vimtests/insertion/capA2.test0000644000000000000000000000007512533751517020072 0ustar0000000000000000-- Input (2,1) -- Output (2,3) foo -- Events Afooyi-0.12.6/src/tests/vimtests/insertion/capA3.test0000644000000000000000000000010212533751517020062 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifoohAOOyi-0.12.6/src/tests/vimtests/insertion/capA4.test0000644000000000000000000000010212533751517020063 0ustar0000000000000000-- Input (1,1) -- Output (1,5) fooOO -- Events ifoo$AOOyi-0.12.6/src/tests/vimtests/insertion/capI.test0000644000000000000000000000010112533751517020006 0ustar0000000000000000-- Input (1,1) -- Output (1,2) OOfoo -- Events ifooIOOyi-0.12.6/src/tests/vimtests/insertion/capI2.test0000644000000000000000000000010512533751517020074 0ustar0000000000000000-- Input (1,7) foo -- Output (1,7) barfoo -- Events Ibaryi-0.12.6/src/tests/vimtests/insertion/capI3.test0000644000000000000000000000006712533751517020104 0ustar0000000000000000-- Input (1,7) -- Output (1,3) bar -- Events Ibaryi-0.12.6/src/tests/vimtests/insertion/capO.test0000644000000000000000000000013112533751517020017 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (3,3) abc 123 456 def ghi -- Events O123456yi-0.12.6/src/tests/vimtests/insertion/counted_a.test0000644000000000000000000000014312533751517021101 0ustar0000000000000000-- Input (1,2) aa -- Output (1,44) aaxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -- Events 42axyi-0.12.6/src/tests/vimtests/insertion/counted_capA.test0000644000000000000000000000014312533751517021525 0ustar0000000000000000-- Input (1,1) aa -- Output (1,44) aaxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx -- Events 42Axyi-0.12.6/src/tests/vimtests/insertion/counted_capI.test0000644000000000000000000000014312533751517021535 0ustar0000000000000000-- Input (1,2) aa -- Output (1,42) xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxaa -- Events 42Ixyi-0.12.6/src/tests/vimtests/insertion/counted_capO.test0000644000000000000000000000012312533751517021541 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (3,3) abc 123 123 def ghi -- Events 2O123yi-0.12.6/src/tests/vimtests/insertion/counted_i.test0000644000000000000000000000012212533751517021106 0ustar0000000000000000-- Input (1,2) aa -- Output (1,25) axyzxyzxyzxyzxyzxyzxyzxyza -- Events 8ixyzyi-0.12.6/src/tests/vimtests/insertion/counted_o.test0000644000000000000000000000012312533751517021115 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (4,3) abc def 123 123 ghi -- Events 2o123yi-0.12.6/src/tests/vimtests/insertion/i.test0000644000000000000000000000010212533751517017363 0ustar0000000000000000-- Input (1,1) -- Output (1,3) fOOoo -- Events ifoohiOOyi-0.12.6/src/tests/vimtests/insertion/i2.test0000644000000000000000000000010212533751517017445 0ustar0000000000000000-- Input (1,1) -- Output (1,2) OOfoo -- Events ifoo0iOOyi-0.12.6/src/tests/vimtests/insertion/i3.test0000644000000000000000000000010212533751517017446 0ustar0000000000000000-- Input (1,1) -- Output (1,4) foOOo -- Events ifoo$iOOyi-0.12.6/src/tests/vimtests/insertion/indent_0.test0000644000000000000000000000016412533751517020643 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (4,9) foo bar xyzzy baz -- Events joxyzzyyi-0.12.6/src/tests/vimtests/insertion/indent_1.test0000644000000000000000000000013712533751517020644 0ustar0000000000000000-- Input (1,8) foo bar baz -- Output (2,4) foo bar baz -- Events iyi-0.12.6/src/tests/vimtests/insertion/indent_2.test0000644000000000000000000000014012533751517020637 0ustar0000000000000000-- Input (1,9) foo bar baz -- Output (2,4) foo bar baz -- Events iyi-0.12.6/src/tests/vimtests/insertion/indent_3.test0000644000000000000000000000017612533751517020651 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (6,9) foo bar xyzzy baz -- Events joxyzzyyi-0.12.6/src/tests/vimtests/insertion/indent_4.test0000644000000000000000000000016012533751517020643 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (6,1) foo bar baz -- Events joyi-0.12.6/src/tests/vimtests/insertion/indent_5.test0000644000000000000000000000017712533751517020654 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (6,5) foo bar xyzzy baz -- Events joxyzzyyi-0.12.6/src/tests/vimtests/insertion/indent_6.test0000644000000000000000000000016512533751517020652 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (4,5) foo bar xyzzy baz -- Events joxyzzyyi-0.12.6/src/tests/vimtests/insertion/indent_7.test0000644000000000000000000000016512533751517020653 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (4,5) foo bar xyzzy baz -- Events joxyzzyyi-0.12.6/src/tests/vimtests/insertion/indent_8.test0000644000000000000000000000023312533751517020650 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (6,9) foo bar xyzzy baz -- Events joxyzzyyi-0.12.6/src/tests/vimtests/insertion/nl_insert.test0000644000000000000000000000007612533751517021142 0ustar0000000000000000-- Input (1,2) x -- Output (2,1) xbc d -- Events abcdyi-0.12.6/src/tests/vimtests/insertion/o.test0000644000000000000000000000013112533751517017373 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (4,3) abc def 123 456 ghi -- Events o123456yi-0.12.6/src/tests/vimtests/insertion/o1.test0000644000000000000000000000011012533751517017451 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (3,1) abc def ghi -- Events oyi-0.12.6/src/tests/vimtests/insertion/O2.test0000644000000000000000000000011012533751517017412 0ustar0000000000000000-- Input (2,1) abc def ghi -- Output (2,1) abc def ghi -- Events Oyi-0.12.6/src/tests/vimtests/insertion/o3.test0000644000000000000000000000006512533751517017464 0ustar0000000000000000-- Input (2,1) -- Output (3,1) -- Events o yi-0.12.6/src/tests/vimtests/insertion/O4.test0000644000000000000000000000006512533751517017425 0ustar0000000000000000-- Input (2,1) -- Output (2,1) -- Events O yi-0.12.6/src/tests/vimtests/insertion/onechar.test0000644000000000000000000000010712533751517020557 0ustar0000000000000000-- Input (1,4) foo bar -- Output (2,1) foo x bar -- Events ix yi-0.12.6/src/tests/vimtests/insertion/spec_delete.test0000644000000000000000000000011312533751517021411 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,1) foo br baz -- Events iyi-0.12.6/src/tests/vimtests/insertion/spec_insert.test0000644000000000000000000000011512533751517021455 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,2) foo b1ar baz -- Events 1yi-0.12.6/src/tests/vimtests/insertion/cursorkeys/down.test0000644000000000000000000000012112533751517022314 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (3,3) foo b1ar ba3z -- Events i13yi-0.12.6/src/tests/vimtests/insertion/cursorkeys/left.test0000644000000000000000000000012112533751517022277 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,2) foo b31ar baz -- Events i13yi-0.12.6/src/tests/vimtests/insertion/cursorkeys/right.test0000644000000000000000000000012212533751517022463 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,4) foo b1a3r baz -- Events i13yi-0.12.6/src/tests/vimtests/insertion/cursorkeys/up.test0000644000000000000000000000011712533751517021776 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (1,3) fo3o b1ar baz -- Events i13yi-0.12.6/src/tests/vimtests/joinlines/1.test0000644000000000000000000000007212533751517017261 0ustar0000000000000000-- Input (1,3) aaa bbb -- Output (1,4) aaa bbb -- Events Jyi-0.12.6/src/tests/vimtests/joinlines/2.test0000644000000000000000000000007212533751517017262 0ustar0000000000000000-- Input (1,1) aaa bbb -- Output (1,4) aaa bbb -- Events Jyi-0.12.6/src/tests/vimtests/joinlines/counted_1.test0000644000000000000000000000007312533751517021003 0ustar0000000000000000-- Input (1,3) aaa bbb -- Output (1,4) aaa bbb -- Events 1Jyi-0.12.6/src/tests/vimtests/joinlines/counted_2.test0000644000000000000000000000010312533751517020776 0ustar0000000000000000-- Input (1,2) aaa bbb ccc -- Output (1,8) aaa bbb ccc -- Events 3Jyi-0.12.6/src/tests/vimtests/jumplist/1.test0000644000000000000000000000041712533751517017141 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (2,7) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events w***yi-0.12.6/src/tests/vimtests/jumplist/2.test0000644000000000000000000000043112533751517017136 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (4,7) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events w***yi-0.12.6/src/tests/vimtests/macros/0.test0000644000000000000000000000012112533751517016545 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,5) qwf arfoos zxc -- Events qaafooq yi-0.12.6/src/tests/vimtests/macros/1.test0000644000000000000000000000013412533751517016552 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,11) qwf arfoofoofoos zxc -- Events qaafooq@a@a yi-0.12.6/src/tests/vimtests/macros/10.test0000644000000000000000000000022212533751517016630 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,11) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1eq2@1 yi-0.12.6/src/tests/vimtests/macros/11.test0000644000000000000000000000022212533751517016631 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,8) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1f3lq@1 yi-0.12.6/src/tests/vimtests/macros/12.test0000644000000000000000000000022212533751517016632 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,15) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1eeq@1 yi-0.12.6/src/tests/vimtests/macros/13.test0000644000000000000000000000012312533751517016633 0ustar0000000000000000-- Input (1,1) abc -- Output (2,10) abc123 A123b -- Events qqA123bqj"qp yi-0.12.6/src/tests/vimtests/macros/14.test0000644000000000000000000000012212533751517016633 0ustar0000000000000000-- Input (2,1) abc A123b -- Output (1,1) abc123 A123b -- Events "0yyk@0 yi-0.12.6/src/tests/vimtests/macros/15.test0000644000000000000000000000007212533751517016640 0ustar0000000000000000-- Input (1,1) -- Output (1,4) ^x$x -- Events qr^x$xq"rp yi-0.12.6/src/tests/vimtests/macros/16.test0000644000000000000000000000016312533751517016642 0ustar0000000000000000-- Input (1,1) ^x$x "123 123 123" "123 123 123" -- Output (3,11) ^x$x 123 123 123 123 123 123 -- Events "ry$j@rj@r yi-0.12.6/src/tests/vimtests/macros/2.test0000644000000000000000000000010512533751517016551 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,2) qwf ars zxc -- Events qaq yi-0.12.6/src/tests/vimtests/macros/3.test0000644000000000000000000000012612533751517016555 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,8) qwf arfoofoos zxc -- Events qaafooq@a yi-0.12.6/src/tests/vimtests/macros/4.test0000644000000000000000000000013312533751517016554 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,11) qwf arfoofoofoos zxc -- Events qaafooq2@a yi-0.12.6/src/tests/vimtests/macros/5.test0000644000000000000000000000013412533751517016556 0ustar0000000000000000-- Input (2,2) qwf ars zxc -- Output (2,4) qwf afoorfoofoos zxc -- Events qaafooq@a0@a yi-0.12.6/src/tests/vimtests/macros/6.test0000644000000000000000000000022112533751517016554 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,7) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events qqf3q@q yi-0.12.6/src/tests/vimtests/macros/7.test0000644000000000000000000000022312533751517016557 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,11) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events qqf3q2@q yi-0.12.6/src/tests/vimtests/macros/8.test0000644000000000000000000000022112533751517016556 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,7) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1f3q@1 yi-0.12.6/src/tests/vimtests/macros/9.test0000644000000000000000000000022012533751517016556 0ustar0000000000000000-- Input (1,1) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Output (1,7) 123 123 123 qwf 123 123 123 ars 123 123 123 zxc -- Events q1eq@1 yi-0.12.6/src/tests/vimtests/marks/unjump_backquote.test0000644000000000000000000000040712533751517021622 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (2,7) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events w**`` yi-0.12.6/src/tests/vimtests/marks/unjump_quote.test0000644000000000000000000000045012533751517020777 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (2,5) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events ww**'' yi-0.12.6/src/tests/vimtests/marks/unjump_quote_blank.test0000644000000000000000000000041512533751517022147 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Output (2,16) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet -- Events wwjG'' yi-0.12.6/src/tests/vimtests/movement/empty.test0000644000000000000000000000005712533751517020122 0ustar0000000000000000-- Input (1,1) -- Output (1,1) -- Events hjklyi-0.12.6/src/tests/vimtests/movement/empty_1.test0000644000000000000000000000006012533751517020334 0ustar0000000000000000-- Input (1,1) -- Output (1,1) -- Events ggG$0yi-0.12.6/src/tests/vimtests/movement/eol_j.test0000644000000000000000000000022712533751517020053 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (4,12) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events $jjyi-0.12.6/src/tests/vimtests/movement/eol_j2.test0000644000000000000000000000022612533751517020134 0ustar0000000000000000-- Input (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events $0jyi-0.12.6/src/tests/vimtests/movement/v_eol_j2.test0000644000000000000000000000022712533751517020462 0ustar0000000000000000-- Input (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events v$0jyi-0.12.6/src/tests/vimtests/movement/bigWord/2e.test0000644000000000000000000000010412533751517020660 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,5) aa bb cc dd -- Events 2E yi-0.12.6/src/tests/vimtests/movement/bigWord/2w.test0000644000000000000000000000010412533751517020702 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,7) aa bb cc dd -- Events 2W yi-0.12.6/src/tests/vimtests/movement/bigWord/6b.test0000644000000000000000000000012712533751517020666 0ustar0000000000000000-- Input (3,3) a b ccc 111 22 3 d e -- Output (1,3) a b ccc 111 22 3 d e -- Events 6Byi-0.12.6/src/tests/vimtests/movement/bigWord/b.test0000644000000000000000000000012612533751517020577 0ustar0000000000000000-- Input (3,3) a b ccc 111 22 3 d e -- Output (3,1) a b ccc 111 22 3 d e -- Events Byi-0.12.6/src/tests/vimtests/movement/bigWord/B_1.test0000644000000000000000000000013212533751517020754 0ustar0000000000000000-- Input (1,1) quux(foo, bar, baz); -- Output (1,11) quux(foo, ar, baz); -- Events 2W4lBBxyi-0.12.6/src/tests/vimtests/movement/bigWord/bbbb.test0000644000000000000000000000013112533751517021241 0ustar0000000000000000-- Input (3,3) a b ccc 111 22 3 d e -- Output (2,6) a b ccc 111 22 3 d e -- Events BBBByi-0.12.6/src/tests/vimtests/movement/bigWord/e.test0000644000000000000000000000010312533751517020575 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,2) aa bb cc dd -- Events E yi-0.12.6/src/tests/vimtests/movement/bigWord/ee.test0000644000000000000000000000010412533751517020743 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,5) aa bb cc dd -- Events EE yi-0.12.6/src/tests/vimtests/movement/bigWord/punctuation.test0000644000000000000000000000010212533751517022721 0ustar0000000000000000-- Input (1,1) a-b+c"d foo -- Output (1,9) a-b+c"d foo -- Events Wyi-0.12.6/src/tests/vimtests/movement/bigWord/punctuation_b.test0000644000000000000000000000010412533751517023224 0ustar0000000000000000-- Input (1,11) a-b+c"d foo -- Output (1,1) a-b+c"d foo -- Events BByi-0.12.6/src/tests/vimtests/movement/bigWord/punctuation_e.test0000644000000000000000000000010212533751517023225 0ustar0000000000000000-- Input (1,1) a-b+c"d foo -- Output (1,7) a-b+c"d foo -- Events Eyi-0.12.6/src/tests/vimtests/movement/bigWord/too_much_b.test0000644000000000000000000000016412533751517022476 0ustar0000000000000000-- Input (3,3) a b ccc 111 22 3 d e -- Output (1,1) a b ccc 111 22 3 d e -- Events BBBBBBBBBBBBBBBBBBBBBBBBBBBBBB yi-0.12.6/src/tests/vimtests/movement/bigWord/too_much_e.test0000644000000000000000000000012712533751517022500 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,11) aa bb cc dd -- Events EEEEEEEEEEEEEEEEEEEE yi-0.12.6/src/tests/vimtests/movement/bigWord/too_much_w.test0000644000000000000000000000011612533751517022520 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,11) aa bb cc dd -- Events WWWWWWWWWWW yi-0.12.6/src/tests/vimtests/movement/bigWord/w.test0000644000000000000000000000010312533751517020617 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,4) aa bb cc dd -- Events W yi-0.12.6/src/tests/vimtests/movement/bigWord/ww.test0000644000000000000000000000010412533751517021007 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,7) aa bb cc dd -- Events WW yi-0.12.6/src/tests/vimtests/movement/char/counted_hjkl.test0000644000000000000000000000031612533751517022350 0ustar0000000000000000-- Input (1,2) aaaaaaaaaaaaaa bbbbbbbbbbbbbb cccccccccccccc dddddddddddddd eeeeeeeeeeeeee -- Output (5,4) aaaaaaaaaaaaaa bbbbbbbbbbbbbb cccccccccccccc dddddddddddddd eeeeeeeeeeeeee -- Events h2j3l1k2lkk4j2hyi-0.12.6/src/tests/vimtests/movement/char/esc_resets_count.test0000644000000000000000000000011712533751517023245 0ustar0000000000000000-- Input (1,1) abc eee cd ddd -- Output (3,1) abc eee cd ddd -- Events 32jyi-0.12.6/src/tests/vimtests/movement/char/h.test0000644000000000000000000000006212533751517020124 0ustar0000000000000000-- Input (1,3) bar -- Output (1,2) br -- Events hxyi-0.12.6/src/tests/vimtests/movement/char/h_1.test0000644000000000000000000000010612533751517020343 0ustar0000000000000000-- Input (2,3) foo bar baz -- Output (2,1) foo ar baz -- Events 10l9hxyi-0.12.6/src/tests/vimtests/movement/char/h_2.test0000644000000000000000000000012112533751517020341 0ustar0000000000000000-- Input (1,1) 0123456789012345 -- Output (1,4) 012456789012345 -- Events 13l10hxyi-0.12.6/src/tests/vimtests/movement/char/hjkl.test0000644000000000000000000000007612533751517020632 0ustar0000000000000000-- Input (1,1) ab cd -- Output (2,2) ab cd -- Events jlllkjhl yi-0.12.6/src/tests/vimtests/movement/char/hjkl1.test0000644000000000000000000000010412533751517020703 0ustar0000000000000000-- Input (1,1) abc eee cd -- Output (3,2) abc eee cd -- Events lljj yi-0.12.6/src/tests/vimtests/movement/char/hjkl2.test0000644000000000000000000000011512533751517020706 0ustar0000000000000000-- Input (1,1) abc eee cd ddd -- Output (4,3) abc eee cd ddd -- Events lljjj yi-0.12.6/src/tests/vimtests/movement/char/j.test0000644000000000000000000000007212533751517020127 0ustar0000000000000000-- Input (1,1) bar bar -- Output (2,1) bar ar -- Events jxyi-0.12.6/src/tests/vimtests/movement/char/j_1.test0000644000000000000000000000007412533751517020351 0ustar0000000000000000-- Input (1,1) bar bar -- Output (2,1) bar ar -- Events 10jxyi-0.12.6/src/tests/vimtests/movement/char/j_2.test0000644000000000000000000000007712533751517020355 0ustar0000000000000000-- Input (1,1) bar bara -- Output (2,3) bar baa -- Events llljxyi-0.12.6/src/tests/vimtests/movement/char/j_3.test0000644000000000000000000000015512533751517020353 0ustar0000000000000000-- Input (1,1) 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 -- Output (14,1) 0 1 2 3 4 5 6 7 8 9 0 1 2 4 5 -- Events 13jxyi-0.12.6/src/tests/vimtests/movement/char/k.test0000644000000000000000000000015512533751517020132 0ustar0000000000000000-- Input (14,1) 0 1 2 3 4 5 6 7 8 9 0 1 2 3 4 5 -- Output (4,1) 0 1 2 4 5 6 7 8 9 0 1 2 3 4 5 -- Events 10kxyi-0.12.6/src/tests/vimtests/movement/char/l.test0000644000000000000000000000011212533751517020124 0ustar0000000000000000-- Input (1,1) abcdefghijk -- Output (1,8) abcdefghijk -- Events 2l.3l.2l.yi-0.12.6/src/tests/vimtests/movement/char/l_1.test0000644000000000000000000000006212533751517020350 0ustar0000000000000000-- Input (1,1) bar -- Output (1,2) br -- Events lxyi-0.12.6/src/tests/vimtests/movement/char/l_2.test0000644000000000000000000000006312533751517020352 0ustar0000000000000000-- Input (1,1) bar -- Output (1,2) ba -- Events 2lxyi-0.12.6/src/tests/vimtests/movement/char/l_3.test0000644000000000000000000000011712533751517020353 0ustar0000000000000000-- Input (1,1) 0123456789012345 -- Output (1,14) 012345678901245 -- Events 13lxyi-0.12.6/src/tests/vimtests/movement/char/l_4.test0000644000000000000000000000006412533751517020355 0ustar0000000000000000-- Input (1,1) bar -- Output (1,2) ba -- Events 10lxyi-0.12.6/src/tests/vimtests/movement/char/h_at_bol/events0000644000000000000000000000000412533751517021766 0ustar0000000000000000hhh yi-0.12.6/src/tests/vimtests/movement/char/h_at_bol/input0000644000000000000000000000002112533751517021620 0ustar0000000000000000(2,1) aaa bbb cccyi-0.12.6/src/tests/vimtests/movement/char/h_at_bol/output0000644000000000000000000000002112533751517022021 0ustar0000000000000000(2,1) aaa bbb cccyi-0.12.6/src/tests/vimtests/movement/char/hl/events0000644000000000000000000000001112533751517020620 0ustar0000000000000000lllhlhhl yi-0.12.6/src/tests/vimtests/movement/char/hl/input0000644000000000000000000000004312533751517020460 0ustar0000000000000000(1,1) aaaaaaaaa bbbbbbbbb cccccccccyi-0.12.6/src/tests/vimtests/movement/char/hl/output0000644000000000000000000000004312533751517020661 0ustar0000000000000000(1,3) aaaaaaaaa bbbbbbbbb cccccccccyi-0.12.6/src/tests/vimtests/movement/char/j/events0000644000000000000000000000000212533751517020446 0ustar0000000000000000j yi-0.12.6/src/tests/vimtests/movement/char/j/input0000644000000000000000000000002112533751517020302 0ustar0000000000000000(1,1) aaa bbb cccyi-0.12.6/src/tests/vimtests/movement/char/j/output0000644000000000000000000000002112533751517020503 0ustar0000000000000000(2,1) aaa bbb cccyi-0.12.6/src/tests/vimtests/movement/char/l_at_eol/events0000644000000000000000000000000612533751517021777 0ustar0000000000000000lllll yi-0.12.6/src/tests/vimtests/movement/char/l_at_eol/input0000644000000000000000000000002112533751517021627 0ustar0000000000000000(1,1) aaa bbb cccyi-0.12.6/src/tests/vimtests/movement/char/l_at_eol/output0000644000000000000000000000002112533751517022030 0ustar0000000000000000(1,3) aaa bbb cccyi-0.12.6/src/tests/vimtests/movement/cursorkeys/down.test0000644000000000000000000000010712533751517022140 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (3,2) foo bar baz -- Events yi-0.12.6/src/tests/vimtests/movement/cursorkeys/left.test0000644000000000000000000000010712533751517022123 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,1) foo bar baz -- Events yi-0.12.6/src/tests/vimtests/movement/cursorkeys/right.test0000644000000000000000000000011012533751517022300 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,3) foo bar baz -- Events yi-0.12.6/src/tests/vimtests/movement/cursorkeys/up.test0000644000000000000000000000010512533751517021613 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (1,2) foo bar baz -- Events yi-0.12.6/src/tests/vimtests/movement/file/G_no_count.test0000644000000000000000000000021312533751517021767 0ustar0000000000000000-- Input (1,4) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Output (4,1) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Events G yi-0.12.6/src/tests/vimtests/movement/file/G_with_count_1.test0000644000000000000000000000021412533751517022547 0ustar0000000000000000-- Input (3,4) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Output (1,1) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Events 1G yi-0.12.6/src/tests/vimtests/movement/file/G_with_count_2.test0000644000000000000000000000021412533751517022550 0ustar0000000000000000-- Input (3,4) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Output (2,1) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Events 2G yi-0.12.6/src/tests/vimtests/movement/file/G_with_too_much_count.test0000644000000000000000000000021712533751517024227 0ustar0000000000000000-- Input (3,4) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Output (4,1) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Events 1000G yi-0.12.6/src/tests/vimtests/movement/file/H_no_count.test0000644000000000000000000000035012533751517021772 0ustar0000000000000000--+ WindowSize 12 5 -- Input (4,3) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Output (2,1) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Events 2H yi-0.12.6/src/tests/vimtests/movement/file/H_with_count_2.test0000644000000000000000000000035012533751517022552 0ustar0000000000000000--+ WindowSize 12 5 -- Input (4,3) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Output (2,1) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Events 2H yi-0.12.6/src/tests/vimtests/movement/file/L_no_count.test0000644000000000000000000000034712533751517022004 0ustar0000000000000000--+ WindowSize 12 5 -- Input (2,3) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Output (5,1) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Events L yi-0.12.6/src/tests/vimtests/movement/file/L_with_count_2.test0000644000000000000000000000035012533751517022556 0ustar0000000000000000--+ WindowSize 12 5 -- Input (2,3) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Output (4,1) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Events 2L yi-0.12.6/src/tests/vimtests/movement/file/M.test0000644000000000000000000000034712533751517020101 0ustar0000000000000000--+ WindowSize 12 5 -- Input (2,3) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Output (3,1) aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd aa bb cc dd -- Events M yi-0.12.6/src/tests/vimtests/movement/intraline/0.test0000644000000000000000000000011112533751517021077 0ustar0000000000000000-- Input (1,3) abc eee cd ddd -- Output (1,1) abc eee cd ddd -- Events 0 yi-0.12.6/src/tests/vimtests/movement/intraline/00.test0000644000000000000000000000011212533751517021160 0ustar0000000000000000-- Input (2,2) abc eee cd ddd -- Output (2,1) abc eee cd ddd -- Events 00 yi-0.12.6/src/tests/vimtests/movement/intraline/2dollar.test0000644000000000000000000000012012533751517022277 0ustar0000000000000000-- Input (1,1) abc eeefoo cd ddd -- Output (2,6) abc eeefoo cd ddd -- Events 2$ yi-0.12.6/src/tests/vimtests/movement/intraline/caret.test0000644000000000000000000000014612533751517022046 0ustar0000000000000000-- Input (1,1) abc def ghi qwe rty uiop -- Output (2,5) abc def ghi qwe rty uiop -- Events $j^yi-0.12.6/src/tests/vimtests/movement/intraline/dollar.test0000644000000000000000000000011112533751517022215 0ustar0000000000000000-- Input (1,1) abc eee cd ddd -- Output (1,3) abc eee cd ddd -- Events $ yi-0.12.6/src/tests/vimtests/movement/intraline/dollardollar.test0000644000000000000000000000011212533751517023414 0ustar0000000000000000-- Input (1,1) abc eee cd ddd -- Output (1,3) abc eee cd ddd -- Events $$ yi-0.12.6/src/tests/vimtests/movement/intraline/dollarj.test0000644000000000000000000000022512533751517022375 0ustar0000000000000000-- Input (3,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,26) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events $kkyi-0.12.6/src/tests/vimtests/movement/intraline/end.test0000644000000000000000000000010612533751517021512 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,3) foo bar baz -- Events yi-0.12.6/src/tests/vimtests/movement/intraline/home.test0000644000000000000000000000010712533751517021675 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,1) foo bar baz -- Events yi-0.12.6/src/tests/vimtests/movement/word/2e.test0000644000000000000000000000010412533751517020236 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,5) aa bb cc dd -- Events 2e yi-0.12.6/src/tests/vimtests/movement/word/2w.test0000644000000000000000000000010412533751517020260 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,7) aa bb cc dd -- Events 2w yi-0.12.6/src/tests/vimtests/movement/word/6b.test0000644000000000000000000000012712533751517020244 0ustar0000000000000000-- Input (3,3) a b ccc 111 22 3 d e -- Output (1,3) a b ccc 111 22 3 d e -- Events 6byi-0.12.6/src/tests/vimtests/movement/word/b.test0000644000000000000000000000012612533751517020155 0ustar0000000000000000-- Input (3,3) a b ccc 111 22 3 d e -- Output (3,1) a b ccc 111 22 3 d e -- Events byi-0.12.6/src/tests/vimtests/movement/word/bbbb.test0000644000000000000000000000013112533751517020617 0ustar0000000000000000-- Input (3,3) a b ccc 111 22 3 d e -- Output (2,6) a b ccc 111 22 3 d e -- Events bbbbyi-0.12.6/src/tests/vimtests/movement/word/e.test0000644000000000000000000000010312533751517020153 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,2) aa bb cc dd -- Events e yi-0.12.6/src/tests/vimtests/movement/word/ee.test0000644000000000000000000000010412533751517020321 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,5) aa bb cc dd -- Events ee yi-0.12.6/src/tests/vimtests/movement/word/punctuation.test0000644000000000000000000000010512533751517022302 0ustar0000000000000000-- Input (1,1) a-b+c"d foo -- Output (1,5) a-b+c"d foo -- Events wwwwyi-0.12.6/src/tests/vimtests/movement/word/punctuation_b.test0000644000000000000000000000010612533751517022604 0ustar0000000000000000-- Input (1,11) a-b+c"d foo -- Output (1,5) a-b+c"d foo -- Events bbbbyi-0.12.6/src/tests/vimtests/movement/word/punctuation_e.test0000644000000000000000000000010512533751517022606 0ustar0000000000000000-- Input (1,1) a-b+c"d foo -- Output (1,5) a-b+c"d foo -- Events eeeeyi-0.12.6/src/tests/vimtests/movement/word/too_much_b.test0000644000000000000000000000016412533751517022054 0ustar0000000000000000-- Input (3,3) a b ccc 111 22 3 d e -- Output (1,1) a b ccc 111 22 3 d e -- Events bbbbbbbbbbbbbbbbbbbbbbbbbbbbbb yi-0.12.6/src/tests/vimtests/movement/word/too_much_e.test0000644000000000000000000000012712533751517022056 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,11) aa bb cc dd -- Events eeeeeeeeeeeeeeeeeeee yi-0.12.6/src/tests/vimtests/movement/word/too_much_w.test0000644000000000000000000000011612533751517022076 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,11) aa bb cc dd -- Events wwwwwwwwwww yi-0.12.6/src/tests/vimtests/movement/word/w.test0000644000000000000000000000010312533751517020175 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,4) aa bb cc dd -- Events w yi-0.12.6/src/tests/vimtests/movement/word/w_1.test0000644000000000000000000000006212533751517020421 0ustar0000000000000000-- Input (1,1) bar -- Output (1,3) bar -- Events wyi-0.12.6/src/tests/vimtests/movement/word/w_2.test0000644000000000000000000000013212533751517020420 0ustar0000000000000000-- Input (1,1) quux(foo, bar, baz); -- Output (1,15) quuxfoo ar baz; -- Events wxwxwxwx2wxyi-0.12.6/src/tests/vimtests/movement/word/ww.test0000644000000000000000000000010412533751517020365 0ustar0000000000000000-- Input (1,1) aa bb cc dd -- Output (1,7) aa bb cc dd -- Events ww yi-0.12.6/src/tests/vimtests/numbers/cursor_on_digits.test0000644000000000000000000000074212533751517022162 0ustar0000000000000000-- Input (1,1) Test increasing 109 to 110 when cursor is on 9. Test increasing 109 to 110 when cursor is on 0. Test increasing 109 to 110 when cursor is on 1. Test increasing 109 to 110 when cursor is on space before 1. -- Output (4,19) Test increasing 110 to 110 when cursor is on 9. Test increasing 110 to 110 when cursor is on 0. Test increasing 110 to 110 when cursor is on 1. Test increasing 110 to 110 when cursor is on space before 1. -- Events 3ejhj2hj3hyi-0.12.6/src/tests/vimtests/numbers/decrement.test0000644000000000000000000000066712533751517020562 0ustar0000000000000000-- Input (1,1) Test decreasing 101 to 99 Test decreasing 11 to 9 Test decreasing 9 to 1 Test decreasing 1 to 0 Test decreasing 0 to -1 Test decreasing -1 to -11 Test decreasing -99 to -101 -- Output (7,20) Test decreasing 99 to 99 Test decreasing 9 to 9 Test decreasing 1 to 1 Test decreasing 0 to 0 Test decreasing -1 to -1 Test decreasing -11 to -11 Test decreasing -101 to -101 -- Events 2j2j8jjj10j2 yi-0.12.6/src/tests/vimtests/numbers/hex_decrease.test0000644000000000000000000000053712533751517021227 0ustar0000000000000000-- Input (1,1) Test decreasing 0x1 to 0x0 Test decreasing 0xa to 0x9 Test decreasing 0x10 to 0xf Test decreasing 0x20 to 0x1f Test decreasing 0x100 to 0xff -- Output (5,20) Test decreasing 0x0 to 0x0 Test decreasing 0x9 to 0x9 Test decreasing 0xf to 0xf Test decreasing 0x1f to 0x1f Test decreasing 0xff to 0xff -- Events jjjjyi-0.12.6/src/tests/vimtests/numbers/hex_increase.test0000644000000000000000000000054312533751517021242 0ustar0000000000000000-- Input (1,1) Test increasing 0x1 to 0x2 Test increasing 0x9 to 0xa Test increasing 0xf to 0x10 Test increasing 0x1f to 0x20 Test increasing 0xff to 0x100 -- Output (5,21) Test increasing 0x2 to 0x2 Test increasing 0xa to 0xa Test increasing 0x10 to 0x10 Test increasing 0x20 to 0x20 Test increasing 0x100 to 0x100 -- Events jjjjyi-0.12.6/src/tests/vimtests/numbers/increment.test0000644000000000000000000000043112533751517020565 0ustar0000000000000000-- Input (1,1) Test increasing 0 to 11 Test increasing -11 to 11 Test increasing -101 to -99 Test increasing 99 to 101 -- Output (4,19) Test increasing 11 to 11 Test increasing 11 to 11 Test increasing -99 to -99 Test increasing 101 to 101 -- Events 11j22j2jh2 yi-0.12.6/src/tests/vimtests/numbers/no_numbers.test0000644000000000000000000000052212533751517020751 0ustar0000000000000000-- Input (1,1) Test case if numbers are not present on the line. This should not cause yi to freeze. This should not cause the cursor to move. -- Output (3,1) Test case if numbers are not present on the line. This should not cause yi to freeze. This should not cause the cursor to move. -- Events j$^11jyi-0.12.6/src/tests/vimtests/numbers/oct_decrease.test0000644000000000000000000000044312533751517021224 0ustar0000000000000000-- Input (1,1) Test decreasing 0o1 to 0o0 Test decreasing 0o10 to 0o7 Test decreasing 0o20 to 0o17 Test decreasing 0o100 to 0o77 -- Output (4,20) Test decreasing 0o0 to 0o0 Test decreasing 0o7 to 0o7 Test decreasing 0o17 to 0o17 Test decreasing 0o77 to 0o77 -- Events jjjyi-0.12.6/src/tests/vimtests/numbers/oct_hex_letters.test0000644000000000000000000000035712533751517022003 0ustar0000000000000000-- Input (1,1) Make sure aa bb cc dd ee ff 0x1 increments correctly. Make sure oo 0o1 increments correctly. -- Output (2,16) Make sure aa bb cc dd ee ff 0x2 increments correctly. Make sure oo 0o2 increments correctly. -- Events +yi-0.12.6/src/tests/vimtests/numbers/oct_increase.test0000644000000000000000000000044712533751517021246 0ustar0000000000000000-- Input (1,1) Test increasing 0o1 to 0o2 Test increasing 0o7 to 0o10 Test increasing 0o17 to 0o20 Test increasing 0o77 to 0o100 -- Output (4,21) Test increasing 0o2 to 0o2 Test increasing 0o10 to 0o10 Test increasing 0o20 to 0o20 Test increasing 0o100 to 0o100 -- Events jjjyi-0.12.6/src/tests/vimtests/numbers/sol_eol.test0000644000000000000000000000012112533751517020231 0ustar0000000000000000-- Input (1,1) 0x1 0o1 1 -- Output (3,1) 0x5 0o4 3 -- Events 4j3j2yi-0.12.6/src/tests/vimtests/paste/2dd_capP.test0000644000000000000000000000023512533751517017660 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop foo -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop foo -- Events 2ddPyi-0.12.6/src/tests/vimtests/paste/2dd_capP_1.test0000644000000000000000000000022512533751517020077 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) abc def ghi qwe rty uiop Lorem ipsum dolor sit amet -- Events 2ddPyi-0.12.6/src/tests/vimtests/paste/2ddp.test0000644000000000000000000000022512533751517017074 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) qwe rty uiop Lorem ipsum dolor sit amet abc def ghi -- Events 2ddpyi-0.12.6/src/tests/vimtests/paste/2ddp_1.test0000644000000000000000000000022512533751517017314 0ustar0000000000000000-- Input (3,3) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2ddpyi-0.12.6/src/tests/vimtests/paste/2yyp.test0000644000000000000000000000027412533751517017152 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi abc def ghi qwe rty uiop -- Events 2yypyi-0.12.6/src/tests/vimtests/paste/d2wp.test0000644000000000000000000000022612533751517017120 0ustar0000000000000000-- Input (1,9) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,19) Lorem ipssum dolor it amet abc def ghi qwe rty uiop -- Events d2wpyi-0.12.6/src/tests/vimtests/paste/dbp.test0000644000000000000000000000022412533751517017007 0ustar0000000000000000-- Input (1,9) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,9) Lorem sipum dolor sit amet abc def ghi qwe rty uiop -- Events dbpyi-0.12.6/src/tests/vimtests/paste/dd_capP.test0000644000000000000000000000022412533751517017574 0ustar0000000000000000-- Input (2,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ddPyi-0.12.6/src/tests/vimtests/paste/dd_capP_1.test0000644000000000000000000000022412533751517020014 0ustar0000000000000000-- Input (3,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop abc def ghi -- Events ddPyi-0.12.6/src/tests/vimtests/paste/ddjp.test0000644000000000000000000000022512533751517017164 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,1) abc def ghi qwe rty uiop Lorem ipsum dolor sit amet -- Events ddjpyi-0.12.6/src/tests/vimtests/paste/ddkP.test0000644000000000000000000000022512533751517017125 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) abc def ghi Lorem ipsum dolor sit amet qwe rty uiop -- Events ddkPyi-0.12.6/src/tests/vimtests/paste/ddp.test0000644000000000000000000000022412533751517017011 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) abc def ghi Lorem ipsum dolor sit amet qwe rty uiop -- Events ddpyi-0.12.6/src/tests/vimtests/paste/ddp_1.test0000644000000000000000000000022412533751517017231 0ustar0000000000000000-- Input (3,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ddpyi-0.12.6/src/tests/vimtests/paste/dep.test0000644000000000000000000000022412533751517017012 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Loremipsum dolor sit amet abc def ghi qwe rty uiop -- Events depyi-0.12.6/src/tests/vimtests/paste/dw_capP.test0000644000000000000000000000022412533751517017617 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events dwPyi-0.12.6/src/tests/vimtests/paste/dwp.test0000644000000000000000000000022412533751517017034 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) iLorem psum dolor sit amet abc def ghi qwe rty uiop -- Events dwpyi-0.12.6/src/tests/vimtests/paste/p_at_newline.test0000644000000000000000000000014512533751517020710 0ustar0000000000000000-- Input (1,1) abc def 123 456 789 xxx -- Output (3,3) abc def 789 123 456 xxx -- Events 4j4ld$2kp yi-0.12.6/src/tests/vimtests/paste/p_at_newline2.test0000644000000000000000000000014512533751517020772 0ustar0000000000000000-- Input (1,1) abc def 123 456 789 xxx -- Output (3,3) abc def 789 123 456 xxx -- Events 4j4ld$2kP yi-0.12.6/src/tests/vimtests/paste/visual.test0000644000000000000000000000024412533751517017547 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,3) Lorem ipsum dolor sit amet abbc def ghi qwec def ghi qwe rty uiop -- Events vjlypyi-0.12.6/src/tests/vimtests/paste/y_1.test0000644000000000000000000000011512533751517016731 0ustar0000000000000000-- Input (2,2) 1234 abcd xyzw -- Output (2,4) 1234 abcdbcd xyzw -- Events y$Pyi-0.12.6/src/tests/vimtests/paste/y_2.test0000644000000000000000000000011612533751517016733 0ustar0000000000000000-- Input (2,2) 1234 abcd xyzw -- Output (2,4) 1234 abcdbcd xyzw -- Events y3lPyi-0.12.6/src/tests/vimtests/paste/y_3.test0000644000000000000000000000011712533751517016735 0ustar0000000000000000-- Input (2,2) 1234 abcd xyzw -- Output (2,4) 1234 abcdbcd xyzw -- Events y20lPyi-0.12.6/src/tests/vimtests/paste/yep.test0000644000000000000000000000023112533751517017035 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) LLoremorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events yepyi-0.12.6/src/tests/vimtests/paste/yjp.test0000644000000000000000000000027312533751517017050 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi abc def ghi qwe rty uiop -- Events yjpyi-0.12.6/src/tests/vimtests/paste/Yp.test0000644000000000000000000000024712533751517016637 0ustar0000000000000000-- Input (1,10) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,27) Lorem ipsuum dolor sit ametm dolor sit amet abc def ghi qwe rty uiop -- Events Yp yi-0.12.6/src/tests/vimtests/paste/ywp.test0000644000000000000000000000023212533751517017060 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) LLorem orem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ywpyi-0.12.6/src/tests/vimtests/paste/yy_capP.test0000644000000000000000000000025712533751517017654 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events yyPyi-0.12.6/src/tests/vimtests/paste/yyp.test0000644000000000000000000000025712533751517017071 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events yypyi-0.12.6/src/tests/vimtests/repeat/2r.test0000644000000000000000000000007512533751517016735 0ustar0000000000000000-- Input (1,1) abcdef -- Output (1,6) xxcdxx -- Events 2rx3l.yi-0.12.6/src/tests/vimtests/repeat/a.test0000644000000000000000000000010612533751517016625 0ustar0000000000000000-- Input (1,1) foo -- Output (1,10) fABCABCABCoo -- Events aABC..yi-0.12.6/src/tests/vimtests/repeat/a2.test0000644000000000000000000000010612533751517016707 0ustar0000000000000000-- Input (1,1) foo -- Output (1,10) fABCABCABCoo -- Events aABC2.yi-0.12.6/src/tests/vimtests/repeat/a3.test0000644000000000000000000000013112533751517016706 0ustar0000000000000000-- Input (1,1) foo -- Output (1,28) fABCABCABCABCABCABCABCABCABCoo -- Events 3aABC..yi-0.12.6/src/tests/vimtests/repeat/a4.test0000644000000000000000000000011512533751517016711 0ustar0000000000000000-- Input (1,1) foo -- Output (1,16) fABCABCABCABCABCoo -- Events 3aABC2.yi-0.12.6/src/tests/vimtests/repeat/a5.test0000644000000000000000000000014512533751517016715 0ustar0000000000000000-- Input (1,1) foo -- Output (1,28) fABCABCABCABCABCABCABCABCABCoo -- Events 3aABCy.d.yi-0.12.6/src/tests/vimtests/repeat/capA.test0000644000000000000000000000010612533751517017251 0ustar0000000000000000-- Input (1,1) foo -- Output (1,12) fooABCABCABC -- Events AABC..yi-0.12.6/src/tests/vimtests/repeat/capA2.test0000644000000000000000000000010612533751517017333 0ustar0000000000000000-- Input (1,1) foo -- Output (1,12) fooABCABCABC -- Events AABC2.yi-0.12.6/src/tests/vimtests/repeat/capA3.test0000644000000000000000000000013112533751517017332 0ustar0000000000000000-- Input (1,1) foo -- Output (1,30) fooABCABCABCABCABCABCABCABCABC -- Events 3AABC..yi-0.12.6/src/tests/vimtests/repeat/capA4.test0000644000000000000000000000011512533751517017335 0ustar0000000000000000-- Input (1,1) foo -- Output (1,18) fooABCABCABCABCABC -- Events 3AABC2.yi-0.12.6/src/tests/vimtests/repeat/capI.test0000644000000000000000000000010512533751517017260 0ustar0000000000000000-- Input (1,1) foo -- Output (1,3) ABCABCABCfoo -- Events IABC..yi-0.12.6/src/tests/vimtests/repeat/capI2.test0000644000000000000000000000010512533751517017342 0ustar0000000000000000-- Input (1,1) foo -- Output (1,6) ABCABCABCfoo -- Events IABC2.yi-0.12.6/src/tests/vimtests/repeat/capI3.test0000644000000000000000000000011412533751517017343 0ustar0000000000000000-- Input (1,1) foo -- Output (1,6) ABCABCABCABCABCfoo -- Events 3IABC2.yi-0.12.6/src/tests/vimtests/repeat/capI4.test0000644000000000000000000000013012533751517017342 0ustar0000000000000000-- Input (1,1) foo -- Output (1,9) ABCABCABCABCABCABCABCABCABCfoo -- Events 3IABC..yi-0.12.6/src/tests/vimtests/repeat/capO.test0000644000000000000000000000014512533751517017272 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (5,3) 123 abc abc abc abc abc abc 456 789 -- Events 2Oabc..yi-0.12.6/src/tests/vimtests/repeat/capO2.test0000644000000000000000000000013012533751517017346 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (3,3) 123 abc abc abc 456 789 -- Events Oabc2.yi-0.12.6/src/tests/vimtests/repeat/capO3.test0000644000000000000000000000013012533751517017347 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (2,3) 123 abc abc abc 456 789 -- Events Oabc..yi-0.12.6/src/tests/vimtests/repeat/capX.test0000644000000000000000000000022112533751517017276 0ustar0000000000000000-- Input (2,5) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet adef ghi qwe rty uiop -- Events X..yi-0.12.6/src/tests/vimtests/repeat/capX_1.test0000644000000000000000000000021712533751517017523 0ustar0000000000000000-- Input (2,8) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet a ghi qwe rty uiop -- Events 2X..yi-0.12.6/src/tests/vimtests/repeat/counted_2r.test0000644000000000000000000000010012533751517020443 0ustar0000000000000000-- Input (1,1) abcdefg -- Output (1,7) xxxdexx -- Events 3rx3l2.yi-0.12.6/src/tests/vimtests/repeat/dw_capP.test0000644000000000000000000000024312533751517017764 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,16) LoremLoremLorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events dwP..yi-0.12.6/src/tests/vimtests/repeat/dwp.test0000644000000000000000000000024312533751517017201 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,19) iLorem Lorem Lorem psum dolor sit amet abc def ghi qwe rty uiop -- Events dwp..yi-0.12.6/src/tests/vimtests/repeat/i.test0000644000000000000000000000010512533751517016634 0ustar0000000000000000-- Input (1,1) foo -- Output (1,7) ABABABCCCfoo -- Events iABC..yi-0.12.6/src/tests/vimtests/repeat/i2.test0000644000000000000000000000010512533751517016716 0ustar0000000000000000-- Input (1,1) foo -- Output (1,8) ABABCABCCfoo -- Events iABC2.yi-0.12.6/src/tests/vimtests/repeat/i3.test0000644000000000000000000000011512533751517016720 0ustar0000000000000000-- Input (1,1) foo -- Output (1,14) ABCABCABABCABCCfoo -- Events 3iABC2.yi-0.12.6/src/tests/vimtests/repeat/i4.test0000644000000000000000000000013112533751517016717 0ustar0000000000000000-- Input (1,1) foo -- Output (1,25) ABCABCABABCABCABABCABCABCCCfoo -- Events 3iABC..yi-0.12.6/src/tests/vimtests/repeat/o.test0000644000000000000000000000014512533751517016646 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (8,3) 123 456 abc abc abc abc abc abc 789 -- Events 2oabc..yi-0.12.6/src/tests/vimtests/repeat/o1.test0000644000000000000000000000014112533751517016723 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (7,3) 123 456 abc abc abc abc abc 789 -- Events 2oabc3.yi-0.12.6/src/tests/vimtests/repeat/o2.test0000644000000000000000000000013012533751517016722 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (5,3) 123 456 abc abc abc 789 -- Events oabc2.yi-0.12.6/src/tests/vimtests/repeat/o3.test0000644000000000000000000000013012533751517016723 0ustar0000000000000000-- Input (2,1) 123 456 789 -- Output (5,3) 123 456 abc abc abc 789 -- Events oabc..yi-0.12.6/src/tests/vimtests/repeat/r.test0000644000000000000000000000007712533751517016655 0ustar0000000000000000-- Input (1,1) abcdef -- Output (1,5) xbxdxf -- Events rx2l.2l.yi-0.12.6/src/tests/vimtests/repeat/r_1.test0000644000000000000000000000007412533751517017072 0ustar0000000000000000-- Input (1,1) abcdef -- Output (1,3) xbxdef -- Events rx2l.yi-0.12.6/src/tests/vimtests/repeat/r_2.test0000644000000000000000000000011412533751517017066 0ustar0000000000000000-- Input (1,1) abcdefghijk -- Output (1,8) xbxdexgxijk -- Events rx2l.3l.2l.yi-0.12.6/src/tests/vimtests/repeat/r_3.test0000644000000000000000000000011012533751517017063 0ustar0000000000000000-- Input (1,1) abcdefghijk -- Output (1,6) xbxdefghijk -- Events rx2l.3lyi-0.12.6/src/tests/vimtests/repeat/tilde_repeat.test0000644000000000000000000000022612533751517021051 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) lOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Events 6~. yi-0.12.6/src/tests/vimtests/repeat/tilde_repeat_does_not_affect_other_lines.test0000644000000000000000000000023012533751517026641 0ustar0000000000000000-- Input (1,1) abcdefghijklmnopqrstuvwxyz abc def ghi qwe rty uiop -- Output (1,26) ABCDEFGHIJKLMNOPQRSTUVWXYz abc def ghi qwe rty uiop -- Events 13~.. yi-0.12.6/src/tests/vimtests/repeat/x.test0000644000000000000000000000022112533751517016652 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet adef ghi qwe rty uiop -- Events x..yi-0.12.6/src/tests/vimtests/repeat/x_1.test0000644000000000000000000000021712533751517017077 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet a ghi qwe rty uiop -- Events 2x..yi-0.12.6/src/tests/vimtests/repeat/x_2.test0000644000000000000000000000022312533751517017075 0ustar0000000000000000-- Input (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,6) Lemps dolor sit amet abc def ghi qwe rty uiop -- Events 2x2l.2l.yi-0.12.6/src/tests/vimtests/replace/0.test0000644000000000000000000000010312533751517016674 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,6) fooiarbaz -- Events 3lrillyi-0.12.6/src/tests/vimtests/replace/1.test0000644000000000000000000000011112533751517016674 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,7) foo123baz -- Events 3lR123lyi-0.12.6/src/tests/vimtests/replace/10.test0000644000000000000000000000022712533751517016764 0ustar0000000000000000-- Input (3,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ryi-0.12.6/src/tests/vimtests/replace/11.test0000644000000000000000000000017512533751517016767 0ustar0000000000000000-- Input (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Output (2,1) Lorem ipsum dolor sit amet qwe rty uiop -- Events rxyi-0.12.6/src/tests/vimtests/replace/2.test0000644000000000000000000000010212533751517016675 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,6) fooxxxbaz -- Events 3l3rxyi-0.12.6/src/tests/vimtests/replace/3.test0000644000000000000000000000010512533751517016701 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,3) foo bxx baz -- Events 5rx yi-0.12.6/src/tests/vimtests/replace/4.test0000644000000000000000000000022712533751517016707 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet awc def ghi qwe rty uiop -- Events ryi-0.12.6/src/tests/vimtests/replace/5.test0000644000000000000000000000022712533751517016710 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet aoc def ghi qwe rty uiop -- Events ryi-0.12.6/src/tests/vimtests/replace/6.test0000644000000000000000000000023012533751517016703 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,5) Lorem ipsum dolor sit amet awe ref ghi qwe rty uiop -- Events 4ryi-0.12.6/src/tests/vimtests/replace/7.test0000644000000000000000000000023012533751517016704 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,6) Lorem ipsum dolor sit amet aorem f ghi qwe rty uiop -- Events 5ryi-0.12.6/src/tests/vimtests/replace/8.test0000644000000000000000000000012212533751517016705 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,12) foo123456789 -- Events 3lR123456789yi-0.12.6/src/tests/vimtests/replace/9.test0000644000000000000000000000022712533751517016714 0ustar0000000000000000-- Input (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ryi-0.12.6/src/tests/vimtests/search/1.test0000644000000000000000000000023412533751517016534 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet abc def ghi qwe rty uiop -- Events /dolorxyi-0.12.6/src/tests/vimtests/search/2.test0000644000000000000000000000032312533751517016534 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,13) Lorem ipsum dolor sit amet Lorem ipsum olor sit amet abc def ghi qwe rty uiop -- Events /dolornxyi-0.12.6/src/tests/vimtests/search/3.test0000644000000000000000000000036412533751517016542 0ustar0000000000000000-- Input (2,16) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?doloryi-0.12.6/src/tests/vimtests/search/4.test0000644000000000000000000000036612533751517016545 0ustar0000000000000000-- Input (2,16) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?dolornyi-0.12.6/src/tests/vimtests/search/5.test0000644000000000000000000000036612533751517016546 0ustar0000000000000000-- Input (2,16) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?dolornNyi-0.12.6/src/tests/vimtests/search/6.test0000644000000000000000000000032412533751517016541 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolornNxyi-0.12.6/src/tests/vimtests/search/7.test0000644000000000000000000000032412533751517016542 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolornnxyi-0.12.6/src/tests/vimtests/search/8.test0000644000000000000000000000036712533751517016552 0ustar0000000000000000-- Input (2,16) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,8) Lorem ipsum dolor sit amet ipsum dolor sit amet ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?dolornnnyi-0.12.6/src/tests/vimtests/search/9.test0000644000000000000000000000006612533751517016547 0ustar0000000000000000-- Input (1,1) Foo -- Output (1,1) oo -- Events /xyi-0.12.6/src/tests/vimtests/search/counted_1.test0000644000000000000000000000032312533751517020254 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2/doloryi-0.12.6/src/tests/vimtests/search/counted_2.test0000644000000000000000000000032312533751517020255 0ustar0000000000000000-- Input (3,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2?doloryi-0.12.6/src/tests/vimtests/search/counted_3.test0000644000000000000000000000023512533751517020260 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 1/doloryi-0.12.6/src/tests/vimtests/search/counted_capN_1.test0000644000000000000000000000050012533751517021212 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolor2Nyi-0.12.6/src/tests/vimtests/search/counted_capN_2.test0000644000000000000000000000041212533751517021215 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ?dolor2Nyi-0.12.6/src/tests/vimtests/search/counted_n_1.test0000644000000000000000000000041212533751517020570 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (3,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolor2nyi-0.12.6/src/tests/vimtests/search/counted_n_2.test0000644000000000000000000000050112533751517020570 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (4,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolor2nnyi-0.12.6/src/tests/vimtests/search/counted_n_3.test0000644000000000000000000000050112533751517020571 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (4,13) Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events /dolorn2nyi-0.12.6/src/tests/vimtests/search/history1.test0000644000000000000000000000026612533751517020163 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet abc def ghi qwe rty uiop -- Events /dolor/ametgg/xyi-0.12.6/src/tests/vimtests/search/history2.test0000644000000000000000000000026512533751517020163 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,13) Lorem ipsum olor sit amet abc def ghi qwe rty uiop -- Events /dolor/ametgg/xyi-0.12.6/src/tests/vimtests/search/history3.test0000644000000000000000000000027312533751517020163 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,23) Lorem ipsum dolor sit met abc def ghi qwe rty uiop -- Events /dolor/ametgg/xyi-0.12.6/src/tests/vimtests/search/history4.test0000644000000000000000000000027212533751517020163 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,23) Lorem ipsum dolor sit met abc def ghi qwe rty uiop -- Events /dolor/ametgg/xyi-0.12.6/src/tests/vimtests/searchword/g_pound.test0000644000000000000000000000032312533751517020722 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,7) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g#yi-0.12.6/src/tests/vimtests/searchword/g_repeat_pound.test0000644000000000000000000000032712533751517022266 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (1,13) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g#nnnyi-0.12.6/src/tests/vimtests/searchword/g_repeat_pound_1.test0000644000000000000000000000032412533751517022503 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g#nyi-0.12.6/src/tests/vimtests/searchword/g_repeat_star.test0000644000000000000000000000032512533751517022110 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g*nnyi-0.12.6/src/tests/vimtests/searchword/g_star.test0000644000000000000000000000032412533751517020547 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (1,13) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events g*yi-0.12.6/src/tests/vimtests/searchword/pound.test0000644000000000000000000000032212533751517020413 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,7) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events #yi-0.12.6/src/tests/vimtests/searchword/repeat_pound.test0000644000000000000000000000032512533751517021756 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (2,16) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events #nnyi-0.12.6/src/tests/vimtests/searchword/repeat_star.test0000644000000000000000000000032412533751517021601 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (3,7) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events *nnyi-0.12.6/src/tests/vimtests/searchword/star.test0000644000000000000000000000032312533751517020240 0ustar0000000000000000-- Input (1,1) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (2,16) lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events *yi-0.12.6/src/tests/vimtests/searchword/star_2.test0000644000000000000000000000032512533751517020463 0ustar0000000000000000-- Input (1,2) (lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Output (2,16) (lorem ipsum lorem2 dolor sit amet dolor sit amet lorem ipsum lorem-lorem ipsumipsum -- Events *yi-0.12.6/src/tests/vimtests/sort/1.test0000644000000000000000000000013112533751517016252 0ustar0000000000000000-- 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 :sortyi-0.12.6/src/tests/vimtests/sort/2.test0000644000000000000000000000013312533751517016255 0ustar0000000000000000-- 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,2sortyi-0.12.6/src/tests/vimtests/sort/3.test0000644000000000000000000000013312533751517016256 0ustar0000000000000000-- 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,5sortyi-0.12.6/src/tests/vimtests/sort/4.test0000644000000000000000000000013412533751517016260 0ustar0000000000000000-- 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,9sortyi-0.12.6/src/tests/vimtests/sort/5.test0000644000000000000000000000012612533751517016262 0ustar0000000000000000-- 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 :sortyi-0.12.6/src/tests/vimtests/switchcase/g_capU.test0000644000000000000000000000022512533751517020462 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) LOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Events gU2wyi-0.12.6/src/tests/vimtests/switchcase/gtilde.test0000644000000000000000000000022512533751517020534 0ustar0000000000000000-- Input (1,1) LOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events g~2wyi-0.12.6/src/tests/vimtests/switchcase/gtilde_1.test0000644000000000000000000000022512533751517020754 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) lOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Events g~2wyi-0.12.6/src/tests/vimtests/switchcase/gu.test0000644000000000000000000000022512533751517017677 0ustar0000000000000000-- Input (1,1) LOREM IPSUM dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events gu2wyi-0.12.6/src/tests/vimtests/switchcase/tilde_does_not_cross_lines.test0000644000000000000000000000022612533751517024663 0ustar0000000000000000-- Input (1,1) abcdefghijklmnopqrstuvwxyz abc def ghi qwe rty uiop -- Output (1,26) ABCDEFGHIJKLMNOPQRSTUVWXYZ abc def ghi qwe rty uiop -- Events 30~ yi-0.12.6/src/tests/vimtests/switchcase/tilde_left_over_count_at_eol_is_ignored.test0000644000000000000000000000110412533751517027364 0ustar0000000000000000-- Input (2,1) 12345678901234567890 If tilde is given a count which is greater than the line length the case of the final character is switched exactly once. We have 18 characters in the first line, a count of 19 should switch the final 'a' to 'A', not to 'A' and then back to 'a'. -- Output (2,19) 12345678901234567890 iF TILDE IS GIVEN A count which is greater than the line length the case of the final character is switched exactly once. We have 18 characters in the first line, a count of 19 should switch the final 'a' to 'A', not to 'A' and then back to 'a'. -- Events 20~ yi-0.12.6/src/tests/vimtests/switchcase/tilde_near_eol.test0000644000000000000000000000022412533751517022230 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,26) Lorem ipsum dolor sit ameT abc def ghi qwe rty uiop -- Events $~yi-0.12.6/src/tests/vimtests/switchcase/tilde_no_count.test0000644000000000000000000000022312533751517022267 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,2) lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events ~ yi-0.12.6/src/tests/vimtests/switchcase/tilde_with_count.test0000644000000000000000000000022612533751517022631 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,11) lOREM IPSUm dolor sit amet abc def ghi qwe rty uiop -- Events 10~ yi-0.12.6/src/tests/vimtests/undo/1.test0000644000000000000000000000011412533751517016231 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,3) foo bar baz -- Events A 123uyi-0.12.6/src/tests/vimtests/undo/2.test0000644000000000000000000000012612533751517016235 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,7) foo bar 123 baz -- Events A 123u yi-0.12.6/src/tests/vimtests/undo/3.test0000644000000000000000000000010412533751517016232 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,2) foo bar baz -- Events xu yi-0.12.6/src/tests/vimtests/undo/4.test0000644000000000000000000000011212533751517016232 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,2) foo br baz -- Events jlxu yi-0.12.6/src/tests/vimtests/undo/5.test0000644000000000000000000000013412533751517016237 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,7) foo bar 123 baz -- Events jlA 123A 456uyi-0.12.6/src/tests/vimtests/undo/6.test0000644000000000000000000000013112533751517016235 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,3) foo bar baz -- Events jlA 123A 456uuyi-0.12.6/src/tests/vimtests/undo/7.test0000644000000000000000000000014212533751517016240 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,7) foo bar 123 baz -- Events jlA 123A 456uuyi-0.12.6/src/tests/vimtests/undo/8.test0000644000000000000000000000015412533751517016244 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,11) foo bar 123 456 baz -- Events jlA 123A 456uuyi-0.12.6/src/tests/vimtests/undo/9.test0000644000000000000000000000013712533751517016246 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,3) foo bar baz -- Events jlA 123A 456uuuyi-0.12.6/src/tests/vimtests/unicode/chinese-simp.test0000644000000000000000000000011212533751517021134 0ustar0000000000000000-- Input (1,1) -- Output (1,4) 中文测试 -- Events i中文测试 yi-0.12.6/src/tests/vimtests/unicode/chinese-trad.test0000644000000000000000000000011212533751517021116 0ustar0000000000000000-- Input (1,1) -- Output (1,4) 中文測試 -- Events i中文測試 yi-0.12.6/src/tests/vimtests/unicode/russian.test0000644000000000000000000000016312533751517020242 0ustar0000000000000000-- Input (1,1) -- Output (1,16) СпаÑибопожалуÑто -- Events iСпаÑибопожалуÑто yi-0.12.6/src/tests/vimtests/unsorted/2yy.test0000644000000000000000000000022412533751517017514 0ustar0000000000000000-- Input (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,1) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Events 2yyyi-0.12.6/src/tests/vimtests/unsorted/v3lcABC.test0000644000000000000000000000011512533751517020145 0ustar0000000000000000-- Input (1,1) Lorem ipsum -- Output (1,8) ABCm ABCm -- Events v3lcABCw.yi-0.12.6/src/tests/vimtests/visual/1.test0000644000000000000000000000010012533751517016562 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,2) 1345678 -- Events lv3lyxyi-0.12.6/src/tests/vimtests/visual/10.test0000644000000000000000000000010412533751517016646 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,5) 1234678 -- Events lv3lxyi-0.12.6/src/tests/vimtests/visual/11.test0000644000000000000000000000010412533751517016647 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,5) 1234678 -- Events lv3lxyi-0.12.6/src/tests/vimtests/visual/12.test0000644000000000000000000000011112533751517016646 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,5) 1234678 -- Events lv3lxv3ly yi-0.12.6/src/tests/vimtests/visual/13.test0000644000000000000000000000010512533751517016652 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,1) 2345678 -- Events yv3lyxyi-0.12.6/src/tests/vimtests/visual/14.test0000644000000000000000000000010012533751517016646 0ustar0000000000000000-- Input (1,1) ab1 cd2 -- Output (1,1) b1 cd2 -- Events jVlkgux yi-0.12.6/src/tests/vimtests/visual/15.test0000644000000000000000000000010212533751517016651 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,2) fbaz -- Events lvlkkjl2ldyi-0.12.6/src/tests/vimtests/visual/2.test0000644000000000000000000000010112533751517016564 0ustar0000000000000000-- Input (1,1) 12345678 -- Output (1,4) 1235678 -- Events $hv3hyxyi-0.12.6/src/tests/vimtests/visual/3.test0000644000000000000000000000007512533751517016577 0ustar0000000000000000-- Input (1,1) aaa bbb -- Output (1,2) aA BBb -- Events lvj~xyi-0.12.6/src/tests/vimtests/visual/4.test0000644000000000000000000000007612533751517016601 0ustar0000000000000000-- Input (1,1) 123 456 -- Output (1,2) 13 456 -- Events jlvkyxyi-0.12.6/src/tests/vimtests/visual/6.test0000644000000000000000000000007112533751517016576 0ustar0000000000000000-- Input (1,1) 12 34 -- Output (1,1) 2 34 -- Events lVjyxyi-0.12.6/src/tests/vimtests/visual/7.test0000644000000000000000000000007312533751517016601 0ustar0000000000000000-- Input (1,1) ab cd -- Output (1,1) b cd -- Events jVlkguxyi-0.12.6/src/tests/vimtests/visual/A_0.test0000644000000000000000000000020312533751517017025 0ustar0000000000000000-- Input (1,1) averyverylongline shortline shorter -- Output (1,18) averyverylonglineb shortlineb shorterb -- Events jjVkkAbyi-0.12.6/src/tests/vimtests/visual/A_1.test0000644000000000000000000000015712533751517017036 0ustar0000000000000000-- Input (1,1) averyverylongline shortline -- Output (1,18) averyverylonglineb shortlineb -- Events VjAbyi-0.12.6/src/tests/vimtests/visual/A_2.test0000644000000000000000000000016512533751517017036 0ustar0000000000000000-- Input (1,1) averyverylongline shortline -- Output (1,6) averybverylongline shortbline -- Events j4lAb yi-0.12.6/src/tests/vimtests/visual/A_3.test0000644000000000000000000000010512717763531017034 0ustar0000000000000000-- Input (1,1) 123 -- Output (1,7) 123text -- Events $Atextyi-0.12.6/src/tests/vimtests/visual/capD_0.test0000644000000000000000000000007612533751517017524 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) baz -- Events lvjlDyi-0.12.6/src/tests/vimtests/visual/capD_1.test0000644000000000000000000000007712533751517017526 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) baz -- Events lVjlD yi-0.12.6/src/tests/vimtests/visual/capD_2.test0000644000000000000000000000007112533751517017521 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) bar -- Events VjkDyi-0.12.6/src/tests/vimtests/visual/capU_0.test0000644000000000000000000000007512533751517017544 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) FOO Bar -- Events vwgUyi-0.12.6/src/tests/vimtests/visual/capU_1.test0000644000000000000000000000010512533751517017537 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) FOO BAR BAZ -- Events VjjUyi-0.12.6/src/tests/vimtests/visual/capY_0.test0000644000000000000000000000011012533751517017536 0ustar0000000000000000-- Input (1,1) foo foo bar -- Output (2,1) foo foo foo bar -- Events VYpyi-0.12.6/src/tests/vimtests/visual/CSs.test0000644000000000000000000000203412717763531017125 0ustar0000000000000000-- Input (1,1) 0; nil 20; binil 40; quadnil 1; un 21; biun 41; quadun 2; bi 22; bibi 42; quadbi 3; tri 23; bitri 43; quadtri 4; quad 24; biquad 44; quadquad 5; pent 25; bipent 45; quadpent 6; hex 26; bihex 46; quadhex 7; sept 27; bisept 47; quadsept 8; oct 28; bioct 48; quadoct 9; enn 29; bienn 49; quadenn X; dec 2X; bidec 4X; quaddec E; lev 2E; bilev 4E; quadlev -- Output (11,7) 0; nil 20; binil 40; quadnil 1; un 21; biun 41; quadun 2; two 22; bibi 42; quadbi 3; tri 23; bitri 43; quadtri 4; quad 24; biquad 44; quadquad 5; pent 25; bipent 45; quadpent 6; six 26; bihex 46; quadhex 7; sept 27; bisept 47; quadsept 8; oct 28; bioct 48; quadoct 9; nine 29; bienn 49; quadenn X; ten 2X; bidec 4X; quaddec E; lev 2E; bilev 4E; quadlev -- Events 2j3lv3lstwo 4j03lvelcsix 3j03lv4lCnine j03lvelSten yi-0.12.6/src/tests/vimtests/visual/d_0.test0000644000000000000000000000010212533751517017066 0ustar0000000000000000-- Input (1,1) foobarbaz -- Output (1,2) fbaz -- Events lvlkkjl2ldyi-0.12.6/src/tests/vimtests/visual/d_1.test0000644000000000000000000000006412533751517017076 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) -- Events v$dyi-0.12.6/src/tests/vimtests/visual/d_2.test0000644000000000000000000000010212533751517017070 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,1) foo baz -- Events jVlldyi-0.12.6/src/tests/vimtests/visual/gq_0.test0000644000000000000000000000010412533751517017254 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foo bar baz -- Events Vgqyi-0.12.6/src/tests/vimtests/visual/gq_1.test0000644000000000000000000000010512533751517017256 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foo bar baz -- Events Vjgqyi-0.12.6/src/tests/vimtests/visual/I_0.test0000644000000000000000000000011312533751517017035 0ustar0000000000000000-- Input (1,1) abc def -- Output (1,3) 123abc 123def -- Events VjI123 yi-0.12.6/src/tests/vimtests/visual/I_1.test0000644000000000000000000000011712533751517017042 0ustar0000000000000000-- Input (1,1) abc def -- Output (1,3) 123abc 123def -- Events jI123 yi-0.12.6/src/tests/vimtests/visual/indent_0.test0000644000000000000000000000010412533751517020126 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,5) foo bar -- Events vj>yi-0.12.6/src/tests/vimtests/visual/indent_1.test0000644000000000000000000000011512533751517020131 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (2,5) foo bar baz -- Events jVj>yi-0.12.6/src/tests/vimtests/visual/indent_10.test0000644000000000000000000000015012533751517020210 0ustar0000000000000000-- Input (1,1) foo bar baz xyzzy -- Output (1,1) foo bar baz xyzzy -- Events V2jyi-0.12.6/src/tests/vimtests/visual/indent_11.test0000644000000000000000000000021712533751517020215 0ustar0000000000000000-- Input (1,1) def main(): foo() bar() baz() quux() -- Output (3,5) def main(): foo() bar() baz() quux() -- Events jjV}}>yi-0.12.6/src/tests/vimtests/visual/indent_12.test0000644000000000000000000000022412533751517020214 0ustar0000000000000000-- Input (1,1) def main(): foo() bar() baz() quux() -- Output (3,1) def main(): foo() bar() baz() quux() -- Events jj}}> yi-0.12.6/src/tests/vimtests/visual/indent_13.test0000644000000000000000000000026712533751517020224 0ustar0000000000000000-- Input (1,1) def main(): foo() bar() baz() quux() -- Output (3,1) def main(): foo() bar() baz() quux() -- Events jj}} yi-0.12.6/src/tests/vimtests/visual/indent_2.test0000644000000000000000000000010212533751517020126 0ustar0000000000000000-- Input (1,1) foo -- Output (1,13) foo -- Events vl3>yi-0.12.6/src/tests/vimtests/visual/indent_3.test0000644000000000000000000000007012533751517020133 0ustar0000000000000000-- Input (1,1) foo -- Output (1,1) foo -- Events vlyi-0.12.6/src/tests/vimtests/visual/indent_4.test0000644000000000000000000000010712533751517020135 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,5) foo bar baz -- Events V>yi-0.12.6/src/tests/vimtests/visual/indent_5.test0000644000000000000000000000011412533751517020134 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,5) foo bar baz -- Events Vj>yi-0.12.6/src/tests/vimtests/visual/indent_6.test0000644000000000000000000000012112533751517020133 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,5) foo bar baz -- Events V2j>yi-0.12.6/src/tests/vimtests/visual/indent_7.test0000644000000000000000000000013112533751517020135 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,21) foo bar baz -- Events V5>yi-0.12.6/src/tests/vimtests/visual/indent_8.test0000644000000000000000000000011012533751517020133 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foo bar baz -- Events Vyi-0.12.6/src/tests/vimtests/visual/indent_9.test0000644000000000000000000000011012533751517020134 0ustar0000000000000000-- Input (1,1) foo bar baz -- Output (1,1) foo bar baz -- Events V>Vyi-0.12.6/src/tests/vimtests/visual/m_0.test0000644000000000000000000000010312533751517017100 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,2) foo br -- Events vljmavgg`axyi-0.12.6/src/tests/vimtests/visual/m_1.test0000644000000000000000000000011012533751517017077 0ustar0000000000000000-- Input (1,1) 1 2 3 4 -- Output (2,1) 1 2 3 4 -- Events Vjmajjmb'ayi-0.12.6/src/tests/vimtests/visual/o_0.test0000644000000000000000000000007612533751517017113 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,4) fooar -- Events lv2lo2ldyi-0.12.6/src/tests/vimtests/visual/r_0.test0000644000000000000000000000007212533751517017112 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) aaaaaa -- Events Vrayi-0.12.6/src/tests/vimtests/visual/r_1.test0000644000000000000000000000010012533751517017103 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) fox xxr -- Events jlvklrxyi-0.12.6/src/tests/vimtests/visual/r_2.test0000644000000000000000000000023012533751517017110 0ustar0000000000000000-- Input (1,7) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (1,7) Lorem XXXXXXXXXXXXXXXXXXXX XXXXXXX ghi qwe rty uiop -- Events vj^eerXyi-0.12.6/src/tests/vimtests/visual/switchcase_0.test0000644000000000000000000000007412533751517021010 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,2) fOOBar -- Events lv2l~yi-0.12.6/src/tests/vimtests/visual/switchcase_1.test0000644000000000000000000000007112533751517021006 0ustar0000000000000000-- Input (1,1) FooBar -- Output (1,1) fOObAR -- Events V~yi-0.12.6/src/tests/vimtests/visual/u_0.test0000644000000000000000000000006612533751517017120 0ustar0000000000000000-- Input (1,1) TEST -- Output (1,1) test -- Events Vguyi-0.12.6/src/tests/vimtests/visual/u_1.test0000644000000000000000000000006712533751517017122 0ustar0000000000000000-- Input (1,1) TeSt -- Output (1,1) teSt -- Events vlguyi-0.12.6/src/tests/vimtests/visual/Vd.test0000644000000000000000000000006712533751517017007 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,1) bar -- Events Vdyi-0.12.6/src/tests/vimtests/visual/vlllx.test0000644000000000000000000000007012533751517017571 0ustar0000000000000000-- Input (1,1) foobar -- Output (1,1) ar -- Events vlllxyi-0.12.6/src/tests/vimtests/visual/vx.test0000644000000000000000000000022212533751517017064 0ustar0000000000000000-- Input (2,2) Lorem ipsum dolor sit amet abc def ghi qwe rty uiop -- Output (2,2) Lorem ipsum dolor sit amet ac def ghi qwe rty uiop -- Events vxyi-0.12.6/src/tests/vimtests/visual/y_0.test0000644000000000000000000000011112533751517017113 0ustar0000000000000000-- Input (1,1) foobar -- Output (3,1) foobar foobar foobar -- Events Vyppyi-0.12.6/src/tests/vimtests/visual/y_1.test0000644000000000000000000000010512533751517017117 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) fooo baro bar -- Events lvjlypyi-0.12.6/src/tests/vimtests/visual/y_2.test0000644000000000000000000000010712533751517017122 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,1) foo bar -- Events Vjlllypddxxxddyi-0.12.6/src/tests/vimtests/visual/y_3.test0000644000000000000000000000011012533751517017115 0ustar0000000000000000-- Input (1,1) foo bar -- Output (2,1) foo foo bar bar -- Events Vjlllypyi-0.12.6/src/tests/vimtests/visual/y_5.test0000644000000000000000000000010412533751517017122 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,3) foo bar bar -- Events llvjypxyi-0.12.6/src/tests/vimtests/visual/y_6.test0000644000000000000000000000010412533751517017123 0ustar0000000000000000-- Input (1,1) foo bar -- Output (1,4) fooo bar bar -- Events llvjypyi-0.12.6/src/tests/vimtests/yank/yy.test0000644000000000000000000000010312533751517016525 0ustar0000000000000000-- Input (2,2) foo bar baz -- Output (2,2) foo bar baz -- Events yy