diff --git a/Data/ByteRope.hs b/Data/ByteRope.hs
--- a/Data/ByteRope.hs
+++ b/Data/ByteRope.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE MultiParamTypeClasses, FlexibleInstances #-}
 -- Consider splitting off as a separate package
 -- Copyright (c) 2008 Gustav Munkby
 
@@ -55,7 +55,7 @@
 t |- b | B.null b  = t
        | otherwise = t |> b
 
-instance Measured Size ByteString where
+instance Measured (Sum Int) ByteString where
   measure = Sum . B.length
 
 toLazyByteString :: ByteRope -> LB.ByteString
diff --git a/Data/Prototype.hs b/Data/Prototype.hs
--- a/Data/Prototype.hs
+++ b/Data/Prototype.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Rank2Types #-}
 -- | Support for OO-like prototypes.
 module Data.Prototype where
 
@@ -21,6 +22,7 @@
 
 -- | Get the value of a prototype.
 -- This can return bottom in case some fields are recursively defined in terms of each other.
+extractValue :: Proto t -> t
 extractValue (Proto o) = fix o
 
 -- | Override a prototype. Fields can be defined in terms of their definition in the base prototype.
@@ -38,6 +40,7 @@
                                                   in extension super self)
 
 -- | Field access
+(.->) :: forall t a. Proto t -> (t -> a) -> a
 p .-> f = f (extractValue p)
 
 
diff --git a/Data/Trie.hs b/Data/Trie.hs
new file mode 100644
--- /dev/null
+++ b/Data/Trie.hs
@@ -0,0 +1,62 @@
+module Data.Trie where
+
+-- Trie module. Partly taken from http://www.haskell.org/haskellwiki/Haskell_Quiz/Word_Search/Solution_Sjanssen
+
+import qualified Data.Map as Map
+import Control.Monad
+
+data Trie = Trie Bool (Map.Map Char Trie) deriving (Show)
+
+-- | A blank Trie
+empty :: Trie
+empty = Trie False Map.empty
+
+-- | Insert a new string into the trie.
+insert :: String -> Trie -> Trie
+insert []     (Trie _ m) = Trie True m
+insert (x:xs) (Trie b m) = Trie b $ Map.alter (maybe (Just $ fromString xs) (Just . insert xs)) x m
+
+fromString :: String -> Trie
+fromString = foldr (\x xs -> Trie False (Map.singleton x xs)) (Trie True Map.empty)
+
+-- | Take a list of String and compress it into a Trie
+fromList :: [String] -> Trie
+fromList = foldr insert empty
+
+-- | Take a trie and expand it into the strings that it represents
+toList :: Trie -> [String]
+toList (Trie b m) =
+    if b then "":expand
+    else expand
+    where expand = [ char:word | (char, trie) <- Map.toList m,
+                                 word <- toList trie ]
+
+-- | Takes a trie and a prefix and returns the sub-trie that
+-- of words with that prefix
+lookupPrefix :: (MonadPlus m) => String -> Trie -> m Trie
+lookupPrefix [] trie = return trie
+lookupPrefix (x:xs) (Trie _ m) = liftMaybe (Map.lookup x m) >>= lookupPrefix xs
+
+liftMaybe :: MonadPlus m => Maybe a -> m a
+liftMaybe Nothing = mzero
+liftMaybe (Just x) = return x
+
+-- | Finds the longest certain path down the trie starting at a the root
+-- Invariant Assumption: All paths have at least one 'true' node below them
+forcedNext :: Trie -> String
+forcedNext (Trie _ m) =
+    if length ls == 1 then
+        let (char, trie) = head ls in
+        char:forcedNext trie
+    else []
+    where ls = Map.toList m
+
+-- | Helper function, finds all the suffixes of a given prefix
+possibleSuffixes :: String -> Trie -> [String]
+possibleSuffixes prefix fulltrie =
+    lookupPrefix prefix fulltrie >>= toList
+
+-- | Helper function, finds the longest certain path down the trie starting at a given word
+certainSuffix :: String -> Trie -> String
+certainSuffix prefix fulltrie =
+    lookupPrefix prefix fulltrie >>= forcedNext
diff --git a/HConf.hs b/HConf.hs
--- a/HConf.hs
+++ b/HConf.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 module HConf (getHConf, HConf(HConf), hconfOptions) where
 
 import Prelude hiding ( catch )
@@ -24,6 +25,7 @@
 import System.Environment
 import System.Console.GetOpt 
 import System.FilePath ((</>), takeDirectory)
+import qualified GHC.Paths
 
 {-
 
@@ -188,8 +190,9 @@
         status <- bracket (openFile err WriteMode) hClose $ \h -> do
             -- note that since we checked for recompilation ourselves,
             -- we disable ghc recompilaton checks.
-            waitForProcess =<< runProcess "ghc" ["--make", projectName ++ ".hs", "-i", "-fforce-recomp", "-v0", "-o",binn,"-threaded"] (Just dir)
+            waitForProcess =<< runProcess GHC.Paths.ghc ["--make", projectName ++ ".hs", "-i", "-fforce-recomp", "-v0", "-o",binn,"-threaded"] (Just dir)
                                     Nothing Nothing Nothing (Just h)
+            -- note that we use the ghc executable used to build Yi (through GHC.Paths).
 
         -- now, if it fails, run xmessage to let the user know:
         if status /= ExitSuccess
diff --git a/Shim/CabalInfo.hs b/Shim/CabalInfo.hs
--- a/Shim/CabalInfo.hs
+++ b/Shim/CabalInfo.hs
@@ -3,16 +3,17 @@
 import Shim.Utils
 
 import qualified Control.Exception as CE
-import System.FilePath ( takeDirectory, (</>), (<.>), dropFileName, equalFilePath )
+import System.FilePath
 import Control.Monad.State
 import Data.Maybe
 
 import Control.Applicative
-import Distribution.Simple.Utils
+import Distribution.Simple.Utils hiding (findPackageDesc)
+import Distribution.ModuleName
 import Distribution.PackageDescription 
 import qualified Distribution.PackageDescription as Library (Library(..))
 import qualified Distribution.PackageDescription as BuildInfo (BuildInfo(..))
-import System.Directory (canonicalizePath)
+import System.Directory
 
 guessCabalFile :: String -> IO (Maybe FilePath)
 guessCabalFile sourcefile = do
@@ -22,8 +23,8 @@
          logS $ "looking in: " ++ dir
          pdfile <- CE.try (findPackageDesc dir)
          case pdfile of
-           Right f -> return . Just $ dir </> f
-           Left _ -> return Nothing
+           Right (Just f) -> return . Just $ dir </> f
+           _ -> return Nothing
 
 -- | Guess what lib/exe the sourcefile belongs to.
 guessCabalStanza :: FilePath -> FilePath -> PackageDescription -> IO (Maybe String, BuildInfo)
@@ -36,8 +37,30 @@
              | Just lib <- [library pkg_descr] ]
          ++ [ (Just (exeName exe), [modulePath exe], buildInfo exe) 
              | exe <- executables pkg_descr ]
-        moduleFiles mod = [dotToSep mod <.> ext | ext <- ["hs", "lhs"] ]
+        moduleFiles mod = [toFilePath mod <.> ext | ext <- ["hs", "lhs"] ]
         allStanzas' = [(name, [projpath </> dir </> file | dir <- hsSourceDirs bi, file <- files ++ concatMap moduleFiles (BuildInfo.otherModules bi)], bi)
                        | (name, files, bi) <- allStanzas, buildable bi]
         eqPath p1 p2 = equalFilePath <$> canonicalizePath p1 <*> canonicalizePath p2
         matchingStanza (_,files,_) = or <$> mapM (eqPath sourcefile) files
+
+
+-- Taken from Cabal and modified so that nothing is printed to stdout.
+-- TODO: Perhaps export something better from Cabal
+
+-- |Find a package description file in the given directory.  Looks for
+-- @.cabal@ files.
+findPackageDesc :: FilePath            -- ^Where to look
+                -> IO (Maybe FilePath) -- ^<pkgname>.cabal
+findPackageDesc dir
+ = do files <- getDirectoryContents dir
+      -- to make sure we do not mistake a ~/.cabal/ dir for a <pkgname>.cabal
+      -- file we filter to exclude dirs and null base file names:
+      cabalFiles <- filterM doesFileExist
+                       [ dir </> file
+                       | file <- files
+                       , let (name, ext) = splitExtension file
+                       , not (null name) && ext == ".cabal" ]
+      case cabalFiles of
+        []          -> return Nothing
+        [cabalFile] -> return (Just cabalFile)
+        multiple    -> return Nothing
diff --git a/Shim/ExprSearch.hs b/Shim/ExprSearch.hs
--- a/Shim/ExprSearch.hs
+++ b/Shim/ExprSearch.hs
@@ -40,11 +40,20 @@
   | FoundModule ModuleName
   | NotFound
 
+#if __GLASGOW_HASKELL__ < 610
 findExprInCheckedModule :: Int -> Int -> CheckedModule -> FindResult
 findExprInCheckedModule line col (CheckedModule {
 					parsedSource = hsSource,
 					renamedSource = mb_rnSource,
 					typecheckedSource = mb_tcSource }) =
+#else
+findExprInCheckedModule :: Int -> Int -> TypecheckedModule -> FindResult
+findExprInCheckedModule line col mdl =
+  let hsSource = parsedSource mdl
+      mb_rnSource = renamedSource mdl
+      mb_tcSource = Just $ typecheckedSource mdl
+  in
+#endif
   case doSearch searchLBinds FoundId mb_tcSource of
     NotFound -> case doSearch searchRenamedSource FoundName mb_rnSource of
                   NotFound -> doSearchModule hsSource
@@ -131,11 +140,21 @@
 
 searchLPat (L span (VarPat id))  = checkId span id
 searchLPat (L span (LitPat lit)) = checkLiteral span lit
+#if __GLASGOW_HASKELL__ >= 610
+searchLPat (L span (NPat lit _ _)) = checkLiteral span (over_lit_lit lit)
+#else
 searchLPat (L span (NPat lit _ _ _)) = checkLiteral span (over_lit_lit lit)
+#endif
    where
      over_lit_lit :: HsOverLit id -> HsLit
-     over_lit_lit (HsIntegral i   _) = HsIntPrim   i
+#if __GLASGOW_HASKELL__ >= 610
+     over_lit_lit (OverLit (HsIntegral i) _ _ _) = HsIntPrim i
+     over_lit_lit (OverLit (HsFractional f) _ _ _) = HsFloatPrim f
+     over_lit_lit (OverLit (HsIsString s) _ _ _) = HsStringPrim s
+#else
+     over_lit_lit (HsIntegral i _) = HsIntPrim   i
      over_lit_lit (HsFractional f _) = HsFloatPrim f
+#endif
 searchLPat lpat = lsearch searchPat lpat
 
 searchPat pat = 
@@ -499,7 +518,9 @@
 -- ----------------------------------------------------------------------------
 -- DeprecDecl
 
+#if __GLASGOW_HASKELL__ < 610
 searchLDeprecDecl (L span (Deprecation id _)) = checkId span id
+#endif
 
 -- ----------------------------------------------------------------------------
 -- Group
@@ -511,7 +532,9 @@
   searchList searchLFixitySig (hs_fixds g) `orSearch`
   searchList searchLDefaultDecl (hs_defds g) `orSearch`
   searchList searchLForeignDecl (hs_fords g) `orSearch`
+#if __GLASGOW_HASKELL__ < 610
   searchList searchLDeprecDecl (hs_depds g) `orSearch`
+#endif
   searchList searchLRuleDecl (hs_ruleds g)
 
 -- ----------------------------------------------------------------------------
@@ -519,7 +542,11 @@
 
 searchLImportDecl ldecl = lsearch searchImportDecl ldecl
 
+#if __GLASGOW_HASKELL__ >= 610
+searchImportDecl (ImportDecl (L span modl) _ _ _ _ _) = inSpan span (Search $ \_ _ _ _ -> FoundModule modl)
+#else
 searchImportDecl (ImportDecl (L span modl) _ _ _ _) = inSpan span (Search $ \_ _ _ _ -> FoundModule modl)
+#endif
 
 -- ----------------------------------------------------------------------------
 -- Utils
diff --git a/Shim/GhcCompat.hs b/Shim/GhcCompat.hs
--- a/Shim/GhcCompat.hs
+++ b/Shim/GhcCompat.hs
@@ -1,17 +1,55 @@
 {-# OPTIONS_GHC -cpp #-}
-module Shim.GhcCompat where
+module Shim.GhcCompat
+  ( load
+  , getModuleGraph
+  , getSessionDynFlags
+  , getRdrNamesInScope
+  , findModule
+  , exprType
+  , getPrintUnqual
+  , compileExpr
+  , setSessionDynFlags
+  , setTargets
+  , setContext
+  , getModuleInfo
+  , lookupName
+  , newSession
+  , getContext
+  , modInfoLookupName
+  , checkModule
+  , parseDynamicFlags
+  , workingDirectoryChanged
+  , getNamesInScope
+  ) where
 
+#if __GLASGOW_HASKELL__ >= 610
+import GHC hiding ( load, getModuleGraph, getSessionDynFlags, getRdrNamesInScope,
+                    findModule, exprType, getPrintUnqual, compileExpr, setSessionDynFlags,
+                    setTargets, setContext, load, getModuleInfo, lookupName, getContext,
+                    modInfoLookupName, parseDynamicFlags, workingDirectoryChanged,
+                    getNamesInScope)
+#else
+import GHC hiding ( load, newSession, parseDynamicFlags )
+#endif
 
-import GHC hiding ( load, newSession )
-import qualified GHC
+import qualified GHC as GHC
 import StaticFlags
 import Panic
+import HscTypes
+
+-- FIX: we should check for Cabal version instead
+#if __GLASGOW_HASKELL__ >= 610
+import qualified Distribution.PackageDescription.Parse as DP
+#else
 import qualified Distribution.PackageDescription as DP
+#endif
+
 import Distribution.Verbosity
 import Control.Concurrent.MVar ( tryTakeMVar, modifyMVar_, newMVar,
                                  readMVar, putMVar )
-import Data.List ( nub )
+import Data.List ( nub, find )
 import System.IO.Unsafe ( unsafePerformIO )
+import Data.IORef
 
 
 #if __GLASGOW_HASKELL__ == 606
@@ -44,15 +82,69 @@
 {-# NOINLINE haveNewSessionBug #-}
 haveNewSessionBug = unsafePerformIO (newMVar False)
 
-#else
+#elif __GLASGOW_HASKELL__ == 608 
 -- Hack to get parseStaticFlags called only once
-initGhc = unsafePerformIO$ StaticFlags.parseStaticFlags [] 
+initGhc = unsafePerformIO$ parseStaticFlags [] 
 
 newSession :: Maybe FilePath -> IO Session
 newSession fp = initGhc `seq` GHC.newSession fp
 
+-- >= 6.10
+#else
+
+newSession :: Maybe FilePath -> IO Session
+newSession fp = runGhc fp getRealSession
+
+
+getRealSession :: Ghc Session
+getRealSession = do
+  hscEnv <- getSession
+  warns  <- getWarnings
+  ref1 <- liftIO $ newIORef hscEnv
+  ref2 <- liftIO $ newIORef warns
+  return $ Session ref1 ref2 
+
 #endif
 
 readPackageDescription = DP.readPackageDescription silent
 
+#if __GLASGOW_HASKELL__ < 610
+type TypecheckedModule = CheckedModule
+parseDynamicFlags ses a b = GHC.parseDynamicFlags a b
+#endif
+
+#if __GLASGOW_HASKELL__ >= 610
+getModuleGraph session = reflectGhc GHC.getModuleGraph session
+getSessionDynFlags session = reflectGhc GHC.getSessionDynFlags session
+setSessionDynFlags session f = reflectGhc (GHC.setSessionDynFlags f) session
+findModule session a b = reflectGhc (GHC.findModule a b) session
+getRdrNamesInScope session = reflectGhc GHC.getRdrNamesInScope session
+
+-- FIX: we should catch the exception
+exprType session e = fmap Just $ reflectGhc (GHC.exprType e) session
+
+getPrintUnqual session = reflectGhc GHC.getPrintUnqual session
+
+-- FIX: we should catch the exception
+compileExpr session e = fmap Just $ reflectGhc (GHC.compileExpr e) session
+
+setTargets session ts = reflectGhc (GHC.setTargets ts) session
+setContext session a b = reflectGhc (GHC.setContext a b) session
+load session a = reflectGhc (GHC.load a) session
+getModuleInfo session a = reflectGhc (GHC.getModuleInfo a) session
+lookupName session a = reflectGhc (GHC.lookupName a) session
+modInfoLookupName session a b = reflectGhc (GHC.modInfoLookupName a b) session
+parseDynamicFlags session a b = fmap (\(a,b,_) -> (a,b)) $ reflectGhc (GHC.parseDynamicFlags a (map noLoc b)) session
+getContext session = reflectGhc GHC.getContext session
+workingDirectoryChanged session = reflectGhc GHC.workingDirectoryChanged session
+getNamesInScope session = reflectGhc GHC.getNamesInScope session
+
+checkModule :: Session -> ModuleName -> Bool -> IO (Maybe TypecheckedModule)
+checkModule session modname _ = do
+  graph <- getModuleGraph session
+  let res = find ((modname ==) . moduleName . ms_mod) graph
+  case res of
+    Just modsum -> fmap Just $ reflectGhc (typecheckModule =<< parseModule modsum) session
+    Nothing -> return Nothing 
+#endif
 
diff --git a/Shim/Hsinfo.hs b/Shim/Hsinfo.hs
--- a/Shim/Hsinfo.hs
+++ b/Shim/Hsinfo.hs
@@ -11,7 +11,7 @@
 import Shim.Utils
 import Shim.ExprSearch
 import Shim.SessionMonad
-import Shim.GhcCompat
+import qualified Shim.GhcCompat as GhcCompat
 import Shim.CabalInfo
 
 import Control.Applicative
@@ -29,30 +29,38 @@
 import qualified Data.Digest.Pure.MD5 as MD5
 
 import qualified GHC
+
+#if __GLASGOW_HASKELL__ >= 610
+import GHC hiding ( load, getSession, getModuleGraph, getSessionDynFlags, 
+                    findModule, getRdrNamesInScope, compileExpr, exprType,
+                    getPrintUnqual, setSessionDynFlags )
+#else
 import GHC hiding ( load, newSession, (<.>) )
+#endif
+
 import Outputable
 import Panic
 import UniqFM ( eltsUFM )
 import Packages ( pkgIdMap, exposed, exposedModules )
 import Id
 import Name
+#if __GLASGOW_HASKELL__ >= 610
+import HscTypes hiding ( getSession ) 
+#else
 import HscTypes
+#endif
 import SrcLoc
 import PprTyThing
 import StringBuffer ( stringToStringBuffer, StringBuffer )
 import HeaderInfo ( getOptions )
 import DriverPhases ( Phase(..), startPhase )
 import Yi.Debug (logPutStrLn)
-import Distribution.Simple.Utils(dotToSep)
 import Distribution.Text 
 import Distribution.Simple ( pkgName )
 import Distribution.Compiler ( CompilerFlavor (..) )
-import Distribution.Simple.Compiler ( extensionsToFlags )
 import Distribution.Simple.GHC
-import Distribution.Simple.Program ( defaultProgramConfiguration )
 import Distribution.Simple.Configure
 import Distribution.Verbosity
-import Distribution.PackageDescription.Configuration (flattenPackageDescription)
 import Distribution.PackageDescription 
   ( buildDepends, PackageDescription, BuildInfo,
     library, executables, hsSourceDirs, extensions, includeDirs, extraLibs,
@@ -71,11 +79,11 @@
 ghcInit :: IO Session
 ghcInit = do
 #if __GLASGOW_HASKELL__ == 606
-  ses <- newSession JustTypecheck (Just ghclibdir)
+  ses <- GhcCompat.newSession JustTypecheck (Just ghclibdir)
 #else
-  ses <- newSession (Just ghclibdir)
+  ses <- GhcCompat.newSession (Just ghclibdir)
 #endif
-  dflags0 <- GHC.getSessionDynFlags ses
+  dflags0 <- GhcCompat.getSessionDynFlags ses
   let ignore _ _ _ _ = return ()
       dflags1 = dflags0{ hscTarget = HscNothing,
                          verbosity = 1,
@@ -83,7 +91,7 @@
                          ghcLink    = NoLink,
 #endif
                          log_action = ignore}
-  GHC.setSessionDynFlags ses dflags1
+  GhcCompat.setSessionDynFlags ses dflags1
   return ses
 
 ghclibdir = GHC.Paths.libdir
@@ -123,22 +131,22 @@
   io $ setCurrentDirectory projectroot
   newDir <- io $ getCurrentDirectory
   when (newDir /= oldDir) $
-    io $ workingDirectoryChanged ses
+    io $ GhcCompat.workingDirectoryChanged ses
 
 findModuleInFile :: Session -> FilePath -> IO Module
 findModuleInFile ses sourcefile = do
-  l <- GHC.getModuleGraph ses
+  l <- GhcCompat.getModuleGraph ses
   let modq =  ms_mod $ fromMaybe (error "findModuleInFile") $
                find (\ms -> msHsFilePath ms == sourcefile) l
   return modq
 
 idsInScope :: Session -> SHM [String]
 idsInScope ses = do
-  rdrs <- io $ GHC.getRdrNamesInScope ses
+  rdrs <- io $ GhcCompat.getRdrNamesInScope ses
   return $ map (showSDoc.ppr) rdrs
 
 getPrelude :: Session -> IO Module
-getPrelude ses = GHC.findModule ses prel_name Nothing
+getPrelude ses = GhcCompat.findModule ses prel_name Nothing
  where prel_name = GHC.mkModuleName "Prelude"
 
 pprIdent :: Id -> String
@@ -154,9 +162,13 @@
 bufferNeedsPreprocessing sourcefile source = do
   sourcebuf <- io $ stringToStringBuffer source
   ses <- getSessionFor sourcefile
-  dflags <- io $ getSessionDynFlags ses
+  dflags <- io $ GhcCompat.getSessionDynFlags ses
+#if __GLASGOW_HASKELL__ >= 610
+  let local_opts = map unLoc (getOptions dflags sourcebuf sourcefile)
+#else
   let local_opts = map unLoc (getOptions sourcebuf sourcefile)
-  (dflags', _) <- io $ parseDynamicFlags dflags local_opts
+#endif
+  (dflags', _) <- io $ GhcCompat.parseDynamicFlags ses dflags local_opts
   let src_ext = takeExtension sourcefile
       needs_preprocessing
         | Unlit _ <- startPhase src_ext = True
@@ -205,9 +217,9 @@
               id_data <- io$ getIdData ses
               m <- io $ findModuleInFile ses sourcefile
 #if __GLASGOW_HASKELL__ > 606
-              cm0 <- io $ checkModule ses (moduleName m) False
+              cm0 <- io $ GhcCompat.checkModule ses (moduleName m) False
 #else
-              cm0 <- io $ checkModule ses $ moduleName m
+              cm0 <- io $ GhcCompat.checkModule ses $ moduleName m
 #endif
               h <- io $ hashSource sourcefile source
               let cm = do {c <- cm0; return (h, c)}
@@ -217,19 +229,23 @@
 load' sourcefile source = do
   source' <- addTime source
   ses <- getSessionFor sourcefile
-  dflags0 <- io $ GHC.getSessionDynFlags ses
+  dflags0 <- io $ GhcCompat.getSessionDynFlags ses
   logAction <- getCompLogAction
   let dflags1 = dflags0{ log_action = logAction, flags = Opt_ForceRecomp : flags dflags0 }
-  io $ GHC.setSessionDynFlags ses dflags1
-  io $ GHC.setTargets ses [Target (TargetFile sourcefile Nothing) source']
-  loadResult <- io $ GHC.load ses LoadAllTargets
+  io $ GhcCompat.setSessionDynFlags ses dflags1
+#if __GLASGOW_HASKELL__ >= 610
+  io $ GhcCompat.setTargets ses [Target (TargetFile sourcefile Nothing) False source']
+#else
+  io $ GhcCompat.setTargets ses [Target (TargetFile sourcefile Nothing) source']
+#endif
+  loadResult <- io $ GhcCompat.load ses LoadAllTargets
   case loadResult of
        Succeeded -> do -- GHC takes care of setting the right context
          modq <- io $ findModuleInFile ses sourcefile
-         io $ GHC.setContext ses [modq] []
+         io $ GhcCompat.setContext ses [modq] []
          return (Succeeded,ses)
        Failed    -> do   -- We take care of getting at least the Prelude
-         io(GHC.setContext ses [] =<< liftM (:[]) (getPrelude ses))
+         io(GhcCompat.setContext ses [] =<< liftM (:[]) (getPrelude ses))
          return (Failed,ses)
 
 addTime :: Maybe String -> SHM (Maybe (StringBuffer, ClockTime))
@@ -252,7 +268,7 @@
       ghcSetDir $ dropFileName sourcefile
       return ses
 
-checkModuleCached :: FilePath -> Maybe String -> SHM (CheckedModule, Session)
+checkModuleCached :: FilePath -> Maybe String -> SHM (TypecheckedModule, Session)
 checkModuleCached sourcefile source = do
   l0 <- M.lookup sourcefile `liftM` getCompBuffer
   hash <- io $ hashSource sourcefile source
@@ -277,10 +293,10 @@
                           return ses
   logInfo $ concat ["Using options ", unSplit ',' opts,
                     " and cabal file ", cabalfile]
-  dflags0 <- io $ GHC.getSessionDynFlags ses
+  dflags0 <- io $ GhcCompat.getSessionDynFlags ses
   ghcSetDir $ dropFileName cabalfile
-  (dflags1, _) <- io $ GHC.parseDynamicFlags dflags0 opts
-  io $ GHC.setSessionDynFlags ses dflags1
+  (dflags1, _) <- io $ GhcCompat.parseDynamicFlags ses dflags0 opts
+  io $ GhcCompat.setSessionDynFlags ses dflags1
   return ses
 
 storeFileInfo :: FilePath -> CompilationResult -> Maybe CachedMod -> IdData -> SHM ()
@@ -289,7 +305,7 @@
 
 getIdData :: Session -> IO IdData
 getIdData ses = do
-  things <- getNamesInScope ses >>= mapM (lookupName ses)
+  things <- GhcCompat.getNamesInScope ses >>= mapM (GhcCompat.lookupName ses)
   return [(s $ nameOccName $ idName ident, s $ idType ident) 
               | Just(AnId ident) <- things]
       where s x = showSDocUnqual $ ppr x
@@ -301,14 +317,18 @@
 findModulesPrefix :: FilePath -> String -> SHM [String]
 findModulesPrefix sourcefile pref = do
   ses <- getSessionFor sourcefile
-  dflags <- io $ GHC.getSessionDynFlags ses
+  dflags <- io $ GhcCompat.getSessionDynFlags ses
   let pkg_mods = allExposedModules dflags
   return $ filter (pref `isPrefixOf`) (map (showSDoc.ppr) pkg_mods)
 
 allExposedModules :: DynFlags -> [ModuleName]
 allExposedModules dflags =
+#if __GLASGOW_HASKELL__ >= 610
+  concatMap Packages.exposedModules (filter exposed (eltsUFM pkg_db))
+#else
   map GHC.mkModuleName (concatMap Packages.exposedModules
                        (filter exposed (eltsUFM pkg_db)))
+#endif
  where pkg_db = pkgIdMap (pkgState dflags)
 
 findIdPrefix :: FilePath -> String -> SHM [(String, String)]
@@ -325,16 +345,16 @@
 findTypeOfName :: Session -> String -> SHM String
 findTypeOfName ses n = do
   -- prints an error to stderr for things that aren't expressions
-  maybe_tything <- io $ GHC.exprType ses n
+  maybe_tything <- io $ GhcCompat.exprType ses n
   maybe (return "") (showForUser . ppr) maybe_tything
 
  where showForUser doc = do
-         unqual <- io $ GHC.getPrintUnqual ses
+         unqual <- io $ GhcCompat.getPrintUnqual ses
          return $ showSDocForUser unqual doc
  
 evaluate :: Session -> String -> SHM String
 evaluate ses n = do
-  maybe_hvalue <- io $ GHC.compileExpr ses ("show (" ++ n ++ ")")
+  maybe_hvalue <- io $ GhcCompat.compileExpr ses ("show (" ++ n ++ ")")
   -- prints errors to stderr?
   return $ maybe "" unsafeCoerce# maybe_hvalue
 
@@ -348,19 +368,19 @@
                         "import Prelude ()",
                         "import "++modname]
   load sourcefile False (Just minSrc)
-  modl <- io $ GHC.findModule ses (GHC.mkModuleName modname) Nothing
+  modl <- io $ GhcCompat.findModule ses (GHC.mkModuleName modname) Nothing
   prel_mod <- io $ getPrelude ses
-  (as,bs) <- io (GHC.getContext ses)
-  io $ GHC.setContext ses [] [prel_mod,modl]
-  unqual <- io (GHC.getPrintUnqual ses)
-  io (GHC.setContext ses as bs)
-  mb_mod_info <- io $ GHC.getModuleInfo ses modl
+  (as,bs) <- io (GhcCompat.getContext ses)
+  io $ GhcCompat.setContext ses [] [prel_mod,modl]
+  unqual <- io (GhcCompat.getPrintUnqual ses)
+  io (GhcCompat.setContext ses as bs)
+  mb_mod_info <- io $ GhcCompat.getModuleInfo ses modl
   case mb_mod_info of
     Nothing -> error "unknown module"
     Just mod_info -> do
-      let names = GHC.modInfoExports mod_info
+      let names = modInfoExports mod_info
       things <- io $ forM names
-                       (\n -> ((,) n) `liftM` GHC.lookupName ses n)
+                       (\n -> ((,) n) `liftM` GhcCompat.lookupName ses n)
       return
         $ filterPrefix pref
         $ map (\(n,t) ->
@@ -382,18 +402,22 @@
 pprExplicitForAlls :: SHM Bool
 pprExplicitForAlls = do
   s <- getSession
-  dflags <- io $ GHC.getSessionDynFlags s
+  dflags <- io $ GhcCompat.getSessionDynFlags s
   return$ dopt Opt_PrintExplicitForalls dflags
 #endif
 
 findTypeOfPos :: FilePath -> Int -> Int -> Maybe String -> SHM String
 findTypeOfPos sourcefile line col source = do
   (cm,ses) <- checkModuleCached sourcefile source
+#if __GLASGOW_HASKELL__ >= 610
+  let modInfo = GHC.moduleInfo cm
+#else
   let Just modInfo = GHC.checkedModuleInfo cm
-  unqual <- io$ GHC.getPrintUnqual ses
+#endif
+  unqual <- io$ GhcCompat.getPrintUnqual ses
   case findExprInCheckedModule line col cm of
     FoundName name -> do
-      mb_tyThing <- io $ GHC.modInfoLookupName ses modInfo name
+      mb_tyThing <- io $ GhcCompat.modInfoLookupName ses modInfo name
       case mb_tyThing of
             Just tyThing -> return $! showSDocForUser unqual
                               (pprTyThingInContextLoc True tyThing)
diff --git a/Shim/ProjectContent.hs b/Shim/ProjectContent.hs
--- a/Shim/ProjectContent.hs
+++ b/Shim/ProjectContent.hs
@@ -1,102 +1,116 @@
---
--- Copyright (c) Krasimir Angelov 2008.
---
--- Extraction of the "Project View" from
--- already configured Cabal package.
---
-
-module Shim.ProjectContent
-         ( loadProject
-         , ProjectItem(..)
-         , FileKind(..)
-         , FolderKind(..)
-         , ModuleKind(..)
-         ) where
-
-import Control.Monad.State
-import Data.Tree
-import Data.Tree.Zipper
-import qualified Data.Set as Set
-import Data.List (partition, nub)
-import Distribution.Version
-import Distribution.Package
-import Distribution.PackageDescription
-import Distribution.Simple.LocalBuildInfo
-import Distribution.Simple.Configure
-import Distribution.Simple.Utils(dotToSep)
-import Distribution.Simple.PreProcess(knownSuffixHandlers)
-import Distribution.Simple.Setup (defaultDistPref)
-import System.FilePath
-import System.Directory
-
-data ProjectItem
-  = ProjectItem
-      { itemName   :: String
-      , itemVersion:: Version
-      }
-  | DependenciesItem 
-      { itemName   :: String
-      }
-  | FolderItem 
-      { itemName   :: String
-      , folderKind :: FolderKind
-      }
-  | FileItem
-      { itemName   :: String
-      , itemFPath  :: FilePath
-      , fileKind   :: FileKind
-      }
-  | PackageItem
-      { itemName   :: String
-      , itemVersion:: Version
-      }
-  | ModuleItem
-      { itemName   :: String
-      , itemFPath  :: FilePath
-      , moduleKind :: ModuleKind
-      }
-  deriving (Eq, Ord, Show)
-
-data FileKind
-  = HsSource ModuleKind
-  | CSource
-  | HSource
-  | TextFile
-  | SetupScript
-  | LicenseText
-  deriving (Eq, Ord, Show)
-
-data FolderKind
-  = HsSourceFolder
-  | PlainFolder
-  deriving (Eq, Ord, Show)
-
-data ModuleKind
-  = ExposedModule
-  | HiddenModule
-  deriving (Eq, Ord, Show)
-
-loadProject :: FilePath -> IO (Tree ProjectItem, Tree ProjectItem)
-loadProject projPath = do
-  Right lbi <- tryGetConfigStateFile (projPath </> localBuildInfoFile defaultDistPref)
-  let pkgDescr = localPkgDescr lbi
-
-      root  = ProjectItem (pkgName (package pkgDescr)) (pkgVersion (package pkgDescr))
-      tloc1 = execState (addDependenciesTree (packageDeps lbi)) (getTop (Node root []))
-  (mod_items,tloc2) <- case library pkgDescr of
-             Just lib -> addLibraryTree projPath (Set.empty,tloc1) lib
-             Nothing  -> return (Set.empty,tloc1)
-  (mod_items,tloc2) <- foldM (addExecutableTree projPath) (mod_items,tloc2) (executables pkgDescr)
-  tloc3 <- checkAndAddFile projPath "Setup.hs"  SetupScript tloc2
-  tloc4 <- checkAndAddFile projPath "Setup.lhs" SetupScript tloc3
-  let (hsources,extra_sources) = partition (\fpath -> takeExtension fpath == ".h") (extraSrcFiles pkgDescr)
-      tloc5 = execState (do mapM_ (addFilePath HSource  projPath)  hsources
-                            mapM_ (addFilePath TextFile projPath) extra_sources
-                            mapM_ (addFilePath TextFile projPath) (dataFiles pkgDescr)
-                            addFilePath LicenseText projPath (licenseFile pkgDescr)) tloc4
-      tloc6 = execState (mapM_ (\item -> insertDown item >> up) (Set.toList mod_items)) tloc1
-  return (tree tloc5, tree tloc6)
-                            
+--
+-- Copyright (c) Krasimir Angelov 2008.
+--
+-- Extraction of the "Project View" from
+-- already configured Cabal package.
+--
+
+module Shim.ProjectContent
+         ( loadProject
+         , itemName
+         , ProjectItem(..)
+         , FileKind(..)
+         , FolderKind(..)
+         , ModuleKind(..)
+         ) where
+
+import Control.Monad.State
+import Data.Tree
+import Data.Tree.Zipper
+import qualified Data.Set as Set
+import Data.List (partition)
+import Distribution.ModuleName
+import Distribution.Version
+import Distribution.Package
+import Distribution.PackageDescription
+import Distribution.Simple.LocalBuildInfo
+import Distribution.Simple.Configure
+import Distribution.Simple.Utils(findFileWithExtension')
+import Distribution.Simple.PreProcess(knownSuffixHandlers)
+import Distribution.Simple.Setup (defaultDistPref)
+import Distribution.Text
+import System.FilePath
+import System.Directory
+
+data ProjectItem
+  = ProjectItem
+      { projItemName :: String
+      , itemVersion :: Version
+      }
+  | DependenciesItem 
+      { depItemName   :: String
+      }
+  | FolderItem 
+      { folderItemName   :: String
+      , folderKind :: FolderKind
+      }
+  | FileItem
+      { fileItemName   :: String
+      , itemFPath  :: FilePath
+      , fileKind   :: FileKind
+      }
+  | PackageItem
+      { pkgItemName   :: PackageName
+      , itemVersion:: Version
+      }
+  | ModuleItem
+      { modItemName   :: ModuleName
+      , itemFPath  :: FilePath
+      , moduleKind :: ModuleKind
+      }
+  deriving (Eq, Ord, Show)
+
+itemName :: ProjectItem -> String
+itemName ProjectItem {projItemName = n} = n
+itemName DependenciesItem {depItemName = n} = n
+itemName FolderItem {folderItemName = n} = n
+itemName FileItem {fileItemName = n} = n
+itemName PackageItem {pkgItemName = p} = display p
+itemName ModuleItem {modItemName = m} = display m
+
+
+
+data FileKind
+  = HsSource ModuleKind
+  | CSource
+  | HSource
+  | TextFile
+  | SetupScript
+  | LicenseText
+  deriving (Eq, Ord, Show)
+
+data FolderKind
+  = HsSourceFolder
+  | PlainFolder
+  deriving (Eq, Ord, Show)
+
+data ModuleKind
+  = ExposedModule
+  | HiddenModule
+  deriving (Eq, Ord, Show)
+
+
+loadProject :: FilePath -> IO (Tree ProjectItem, Tree ProjectItem)
+loadProject projPath = do
+  Right lbi <- tryGetConfigStateFile (projPath </> localBuildInfoFile defaultDistPref)
+  let pkgDescr = localPkgDescr lbi
+
+      root  = PackageItem (pkgName (package pkgDescr)) (pkgVersion (package pkgDescr))
+      tloc1 = execState (addDependenciesTree (packageDeps lbi)) (getTop (Node root []))
+  (mod_items,tloc2) <- case library pkgDescr of
+             Just lib -> addLibraryTree projPath (Set.empty,tloc1) lib
+             Nothing  -> return (Set.empty,tloc1)
+  (mod_items,tloc2) <- foldM (addExecutableTree projPath) (mod_items,tloc2) (executables pkgDescr)
+  tloc3 <- checkAndAddFile projPath "Setup.hs"  SetupScript tloc2
+  tloc4 <- checkAndAddFile projPath "Setup.lhs" SetupScript tloc3
+  let (hsources,extra_sources) = partition (\fpath -> takeExtension fpath == ".h") (extraSrcFiles pkgDescr)
+      tloc5 = execState (do mapM_ (addFilePath HSource  projPath)  hsources
+                            mapM_ (addFilePath TextFile projPath) extra_sources
+                            mapM_ (addFilePath TextFile projPath) (dataFiles pkgDescr)
+                            addFilePath LicenseText projPath (licenseFile pkgDescr)) tloc4
+      tloc6 = execState (mapM_ (\item -> insertDown item >> up) (Set.toList mod_items)) tloc1
+  return (tree tloc5, tree tloc6)
+                            
 getTop :: Tree a -> TreeLoc a
 getTop = fromTree
 
@@ -110,18 +124,18 @@
 modify' f = modify (\x -> maybe (error "impossible movement!") id (f x))
 
 
-addLibraryTree projPath (mod_items,tloc) (Library {libBuildInfo=binfo, exposedModules=exp_mods}) = do
-  (exp_mods,hid_mods,mod_items1,tloc1) <- foldM (\st dir -> addSourceDir projPath dir st)
-                                                (exp_mods,otherModules binfo,mod_items,tloc)
-                                                (hsSourceDirs binfo)
-  return $ (mod_items1,execState (mapM_ (addFilePath CSource projPath) (cSources binfo)) tloc1)
-  
-addExecutableTree projPath (mod_items,tloc) (Executable {modulePath=mainIs, buildInfo=binfo}) = do
-  let tloc1 = execState (addFilePath (HsSource ExposedModule) projPath mainIs) tloc
-  (exp_mods,hid_mods,mod_items2,tloc2) <- foldM (\st dir -> addSourceDir projPath dir st)
-                                                ([],otherModules binfo,mod_items,tloc1)
-                                                (hsSourceDirs binfo)
-  return $ (mod_items2,execState (mapM_ (addFilePath CSource projPath) (cSources binfo)) tloc2)
+addLibraryTree projPath (mod_items,tloc) (Library {libBuildInfo=binfo, exposedModules=exp_mods}) = do
+  (exp_mods,hid_mods,mod_items1,tloc1) <- foldM (\st dir -> addSourceDir projPath dir st)
+                                                (exp_mods,otherModules binfo,mod_items,tloc)
+                                                (hsSourceDirs binfo)
+  return $ (mod_items1,execState (mapM_ (addFilePath CSource projPath) (cSources binfo)) tloc1)
+  
+addExecutableTree projPath (mod_items,tloc) (Executable {modulePath=mainIs, buildInfo=binfo}) = do
+  let tloc1 = execState (addFilePath (HsSource ExposedModule) projPath mainIs) tloc
+  (exp_mods,hid_mods,mod_items2,tloc2) <- foldM (\st dir -> addSourceDir projPath dir st)
+                                                ([],otherModules binfo,mod_items,tloc1)
+                                                (hsSourceDirs binfo)
+  return $ (mod_items2,execState (mapM_ (addFilePath CSource projPath) (cSources binfo)) tloc2)
 
 addDependenciesTree deps = do
   insertDown (DependenciesItem "Dependencies")
@@ -132,39 +146,39 @@
       insertDown (PackageItem (pkgName dep) (pkgVersion dep))
       up
 
-addSourceDir :: FilePath -- ^ project location
-             -> FilePath -- ^ source sub-directory
-             ->    ([String],[String],Set.Set ProjectItem,TreeLoc ProjectItem)
-             -> IO ([String],[String],Set.Set ProjectItem,TreeLoc ProjectItem)
-addSourceDir projPath srcDir (exp_mods,hid_mods,mod_items,tloc) = do
-  let dir = projPath </> srcDir
-  (exp_paths,exp_mods) <- findModules dir exp_mods
-  (hid_paths,hid_mods) <- findModules dir hid_mods
-  let tloc1 = execState (addFilePath' (\c -> FolderItem c HsSourceFolder) (splitPath' srcDir)
-                            (mapM_ (\(mod,loc) -> addFilePath (HsSource ExposedModule) dir loc) exp_paths >>
-                             mapM_ (\(mod,loc) -> addFilePath (HsSource HiddenModule)  dir loc) hid_paths))
-                        tloc
-      mod_items1 = foldr (\(mod,loc) -> Set.insert (ModuleItem mod (dir </> loc) ExposedModule)) mod_items  exp_paths
-      mod_items2 = foldr (\(mod,loc) -> Set.insert (ModuleItem mod (dir </> loc) HiddenModule )) mod_items1 hid_paths
-  return (exp_mods,hid_mods,mod_items2,tloc1)
-
-addFilePath :: FileKind -> FilePath -> FilePath -> State (TreeLoc ProjectItem) ()
-addFilePath kind root fpath = addFilePath' (\c -> FileItem c (root </> fpath) kind) (splitPath' fpath) (return ())
-
-addFilePath' :: (String -> ProjectItem) -> [String] 
-             -> State (TreeLoc ProjectItem) ()
-             -> State (TreeLoc ProjectItem) ()
-addFilePath' mkItem []     cont = cont
-addFilePath' mkItem (c:cs) cont
-  | c == "."  = addFilePath' mkItem cs cont
-  | otherwise = do let item | null cs   = mkItem c
-                            | otherwise = FolderItem c PlainFolder
-                   children <- gets hasChildren
-                   if children
+addSourceDir :: FilePath -- ^ project location
+             -> FilePath -- ^ source sub-directory
+             ->    ([ModuleName],[ModuleName],Set.Set ProjectItem,TreeLoc ProjectItem)
+             -> IO ([ModuleName],[ModuleName],Set.Set ProjectItem,TreeLoc ProjectItem)
+addSourceDir projPath srcDir (exp_mods,hid_mods,mod_items,tloc) = do
+  let dir = projPath </> srcDir
+  (exp_paths,exp_mods) <- findModules dir exp_mods
+  (hid_paths,hid_mods) <- findModules dir hid_mods
+  let tloc1 = execState (addFilePath' (\c -> FolderItem c HsSourceFolder) (splitPath' srcDir)
+                            (mapM_ (\(mod,loc) -> addFilePath (HsSource ExposedModule) dir loc) exp_paths >>
+                             mapM_ (\(mod,loc) -> addFilePath (HsSource HiddenModule)  dir loc) hid_paths))
+                        tloc
+      mod_items1 = foldr (\(mod,loc) -> Set.insert (ModuleItem mod (dir </> loc) ExposedModule)) mod_items  exp_paths
+      mod_items2 = foldr (\(mod,loc) -> Set.insert (ModuleItem mod (dir </> loc) HiddenModule )) mod_items1 hid_paths
+  return (exp_mods,hid_mods,mod_items2,tloc1)
+
+addFilePath :: FileKind -> FilePath -> FilePath -> State (TreeLoc ProjectItem) ()
+addFilePath kind root fpath = addFilePath' (\c -> FileItem c (root </> fpath) kind) (splitPath' fpath) (return ())
+
+addFilePath' :: (String -> ProjectItem) -> [String] 
+             -> State (TreeLoc ProjectItem) ()
+             -> State (TreeLoc ProjectItem) ()
+addFilePath' mkItem []     cont = cont
+addFilePath' mkItem (c:cs) cont
+  | c == "."  = addFilePath' mkItem cs cont
+  | otherwise = do let item | null cs   = mkItem c
+                            | otherwise = FolderItem c PlainFolder
+                   children <- gets hasChildren
+                   if children
                      then modify' firstChild >> insertItem c item
                      else insertDown item
-                   addFilePath' mkItem cs cont
-                   up >> return ()
+                   addFilePath' mkItem cs cont
+                   up >> return ()
   where
     insertItem :: Ord a => x -> a -> State (TreeLoc a) ()
     insertItem c item = do
@@ -179,54 +193,39 @@
 
 simpleNode item = Node item []
 
-splitPath' fpath = [removeSlash c | c <- splitPath fpath]
-  where
-    removeSlash c
-      | null c                   = c
-      | isPathSeparator (last c) = init c
-      | otherwise                = c
-
-checkAndAddFile projPath fpath kind tloc = do
-  let fullPath = projPath </> fpath
-  exists <- doesFileExist fullPath
-  if exists
-    then return $ execState (addFilePath kind fullPath fpath) tloc
-    else return tloc
-
--------------------------------------------------------------------------
--- Module Finder
--------------------------------------------------------------------------
-
-findModules :: FilePath                           -- ^source directory location
-            -> [String]                           -- ^module names
-            -> IO ([(String,FilePath)],[String])  -- ^found modules and unknown modules
-findModules location []         = return ([],[])
-findModules location (mod:mods) = do
-  mb_paths <- findFileWithExtension' (map fst knownSuffixHandlers ++ ["hs", "lhs"]) [location] (dotToSep mod)
-  (locs,unks) <- findModules location mods
-  case mb_paths of
-    Just (_,loc) -> return ((mod,loc) : locs,unks)
-    Nothing      -> return (locs,mod:unks)
-
-
--- FIXME: The bellow two functions are copy+paste from the latest version of
--- Cabal. Unfortunatelly they aren't exported in the current version of Cabal.
--- Fix that after the next Cabal release.
-
-findFileWithExtension' :: [String]
-                       -> [FilePath]
-                       -> FilePath
-                       -> IO (Maybe (FilePath, FilePath))
-findFileWithExtension' extensions searchPath baseName =
-  findFirstFile (uncurry (</>))
-    [ (path, baseName <.> ext)
-    | path <- nub searchPath
-    , ext <- nub extensions ]
-
-findFirstFile :: (a -> FilePath) -> [a] -> IO (Maybe a)
-findFirstFile file = findFirst
-  where findFirst []     = return Nothing
-        findFirst (x:xs) = do exists <- doesFileExist (file x)
-                              if exists
-                                then return (Just x)
-                                else findFirst xs
+splitPath' fpath = [removeSlash c | c <- splitPath fpath]
+  where
+    removeSlash c
+      | null c                   = c
+      | isPathSeparator (last c) = init c
+      | otherwise                = c
+
+checkAndAddFile projPath fpath kind tloc = do
+  let fullPath = projPath </> fpath
+  exists <- doesFileExist fullPath
+  if exists
+    then return $ execState (addFilePath kind fullPath fpath) tloc
+    else return tloc
+
+-------------------------------------------------------------------------
+-- Module Finder
+-------------------------------------------------------------------------
+
+findModules :: FilePath                           -- ^source directory location
+            -> [ModuleName]                           -- ^module names
+            -> IO ([(ModuleName,FilePath)],[ModuleName])  -- ^found modules and unknown modules
+findModules location []         = return ([],[])
+findModules location (mod:mods) = do
+  mb_paths <- findFileWithExtension' (map fst knownSuffixHandlers ++ ["hs", "lhs"]) [location] (toFilePath mod)
+  (locs,unks) <- findModules location mods
+  case mb_paths of
+    Just (_,loc) -> return ((mod,loc) : locs,unks)
+    Nothing      -> return (locs,mod:unks)
+
+findFirstFile :: (a -> FilePath) -> [a] -> IO (Maybe a)
+findFirstFile file = findFirst
+  where findFirst []     = return Nothing
+        findFirst (x:xs) = do exists <- doesFileExist (file x)
+                              if exists
+                                then return (Just x)
+                                else findFirst xs
diff --git a/Shim/SHM.hs b/Shim/SHM.hs
--- a/Shim/SHM.hs
+++ b/Shim/SHM.hs
@@ -2,8 +2,15 @@
 module Shim.SHM where
 
 import Data.Typeable
+
+#if __GLASGOW_HASKELL__ >= 610
+import GHC hiding ( load )
+#else
 import GHC hiding ( load, newSession )
+#endif
+
 import qualified GHC
+import HscTypes
 import Outputable
 import ErrUtils
 
@@ -16,6 +23,7 @@
 
 import Shim.SessionMonad
 import Shim.Utils
+import Shim.GhcCompat
 --------------------------------------------------------------
 -- SHM Monad
 --------------------------------------------------------------
@@ -39,7 +47,7 @@
 type Hash = MD5.MD5Digest
 
 
-type CachedMod = (Hash,CheckedModule)
+type CachedMod = (Hash,TypecheckedModule)
 type CompBuffer = M.Map FilePath (CompilationResult, IdData, Maybe CachedMod)
 
 type SessionMap = M.Map FilePath Session
@@ -77,7 +85,7 @@
 getCompBuffer :: SHM CompBuffer
 getCompBuffer = gets compBuffer
 
-addCompBuffer :: FilePath -> IdData -> CompilationResult -> Maybe (Hash,CheckedModule) -> SHM ()
+addCompBuffer :: FilePath -> IdData -> CompilationResult -> Maybe (Hash,TypecheckedModule) -> SHM ()
 addCompBuffer sourcefile id_data compilation_result checked_mod =
   modify (\s ->
             s{compBuffer=(M.insert sourcefile (compilation_result,id_data,checked_mod)
diff --git a/Shim/SessionMonad.hs b/Shim/SessionMonad.hs
--- a/Shim/SessionMonad.hs
+++ b/Shim/SessionMonad.hs
@@ -1,6 +1,11 @@
 module Shim.SessionMonad where
 
-import GHC(Session)
+#if __GLASGOW_HASKELL__ >= 610
+import HscTypes (Session)
+#else
+import GHC (Session)
+#endif
 
 class Monad m => SessionMonad m where
   getSession :: m Session 
+
diff --git a/Shim/Utils.hs b/Shim/Utils.hs
--- a/Shim/Utils.hs
+++ b/Shim/Utils.hs
@@ -38,7 +38,7 @@
 import Data.Maybe
 import System.FilePath ( takeDirectory )
 import Data.List ( elem )
-import qualified Control.Exception as CE
+-- import qualified Control.Exception as CE
 import System.IO.Unsafe ( unsafePerformIO )
 import Control.Concurrent.MVar
 import Yi.Debug
diff --git a/Yi.hs b/Yi.hs
--- a/Yi.hs
+++ b/Yi.hs
@@ -32,7 +32,7 @@
 import Yi.Dired
 import Yi.Eval
 import Yi.File
-import Yi.Main (defaultConfig)
+import Yi.Main (defaultConfig, availableFrontends)
 import Yi.Search
 import Yi.Style
 import Yi.Style.Library
diff --git a/Yi/Buffer/Basic.hs b/Yi/Buffer/Basic.hs
--- a/Yi/Buffer/Basic.hs
+++ b/Yi/Buffer/Basic.hs
@@ -29,18 +29,12 @@
 -- | 'direction' is in the same style of 'maybe' or 'either' functions,
 -- It takes one argument per direction (backward, then forward) and a
 -- direction to select the output.
-direction :: a -> a -> Direction -> a
-direction b _ Backward = b
-direction _ f Forward  = f
+directionElim :: Direction -> a -> a -> a
+directionElim Backward b _ = b
+directionElim Forward  _ f = f
 
 -- | A mark in a buffer
 newtype Mark = Mark {markId::Int} deriving (Eq, Ord, Show, Typeable, Binary)
-staticInsMark, staticSelMark :: Mark
-staticInsMark = Mark (-1) -- the insertion mark
-staticSelMark = Mark (-2) -- the selection mark
-dummyFromMark, dummyToMark :: Mark
-dummyFromMark = Mark 1
-dummyToMark = Mark 2
 
 -- | Reference to a buffer.
 newtype BufferRef = BufferRef Int
diff --git a/Yi/Buffer/HighLevel.hs b/Yi/Buffer/HighLevel.hs
--- a/Yi/Buffer/HighLevel.hs
+++ b/Yi/Buffer/HighLevel.hs
@@ -2,15 +2,14 @@
 -- Copyright (C) 2008 JP Bernardy
 module Yi.Buffer.HighLevel where
 
-import Prelude (FilePath)
-import Yi.Prelude 
 import Control.Applicative
 import Control.Monad.RWS.Strict (ask)
 import Control.Monad.State
 import Data.Char
 import Data.List (isPrefixOf, sort, lines, drop, filter, length, takeWhile, dropWhile)
-import Data.Maybe
-  ( fromMaybe, listToMaybe )
+import Data.Maybe (fromMaybe, listToMaybe)
+import Prelude (FilePath, map)
+import Yi.Prelude
 
 import Yi.Buffer.Basic
 import Yi.Buffer.Misc
@@ -52,11 +51,11 @@
 
 -- | Move to first char of next word forwards
 nextWordB :: BufferM ()
-nextWordB = moveB Word Forward
+nextWordB = moveB unitWord Forward
 
 -- | Move to first char of next word backwards
 prevWordB :: BufferM ()
-prevWordB = moveB Word Backward
+prevWordB = moveB unitWord Backward
 
 -- * Char-based movement actions.
 
@@ -86,7 +85,11 @@
 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 and . map (isSpace) $ prev then moveToSol else firstNonSpaceB
 
 ------------
 
@@ -139,10 +142,17 @@
 readLnB :: BufferM String
 readLnB = readUnitB Line
 
+readCharB :: BufferM (Maybe Char)
+readCharB = liftM listToMaybe (readUnitB Character)
+
 -- | Read from point to end of line
 readRestOfLnB :: BufferM String
 readRestOfLnB = readRegionB =<< regionOfPartB Line Forward
 
+-- | Read from point to beginning of line
+readPreviousOfLnB :: BufferM String
+readPreviousOfLnB = readRegionB =<< regionOfPartB Line Backward
+
 --------------------------
 -- Deletes
 
@@ -153,12 +163,12 @@
 -- | Delete forward whitespace or non-whitespace depending on
 -- the character under point.
 killWordB :: BufferM ()
-killWordB = deleteB Word Forward
+killWordB = deleteB unitWord Forward
 
 -- | Delete backward whitespace or non-whitespace depending on
 -- the character before point.
 bkillWordB :: BufferM ()
-bkillWordB = deleteB Word Backward
+bkillWordB = deleteB unitWord Backward
 
 
 ----------------------------------------
@@ -166,15 +176,15 @@
 
 -- | capitalise the word under the cursor
 uppercaseWordB :: BufferM ()
-uppercaseWordB = transformB (fmap toUpper) Word Forward
+uppercaseWordB = transformB (fmap toUpper) unitWord Forward
 
 -- | lowerise word under the cursor
 lowercaseWordB :: BufferM ()
-lowercaseWordB = transformB (fmap toLower) Word Forward
+lowercaseWordB = transformB (fmap toLower) unitWord Forward
 
 -- | capitalise the first letter of this word
 capitaliseWordB :: BufferM ()
-capitaliseWordB = transformB capitalizeFirst Word Forward
+capitaliseWordB = transformB capitalizeFirst unitWord Forward
 
 
 -- | Delete to the end of line, excluding it.
@@ -183,12 +193,12 @@
 
 -- | Delete whole line moving to the next line
 deleteLineForward :: BufferM ()
-deleteLineForward = 
+deleteLineForward =
   do moveToSol   -- Move to the start of the line
      deleteToEol -- Delete the rest of the line not including the newline char
      deleteN 1   -- Delete the newline character
-     
 
+
 -- | Transpose two characters, (the Emacs C-t action)
 swapB :: BufferM ()
 swapB = do eol <- atEol
@@ -200,11 +210,11 @@
 
 -- | Set the current buffer selection mark
 setSelectionMarkPointB :: Point -> BufferM ()
-setSelectionMarkPointB = setMarkPointB staticSelMark
+setSelectionMarkPointB p = flip setMarkPointB p =<< selMark <$> askMarks
 
 -- | Get the current buffer selection mark
 getSelectionMarkPointB :: BufferM Point
-getSelectionMarkPointB = getMarkPointB staticSelMark
+getSelectionMarkPointB = getMarkPointB =<< selMark <$> askMarks
 
 -- | Exchange point & mark.
 exchangePointAndMarkB :: BufferM ()
@@ -271,7 +281,7 @@
 upScreenB :: BufferM ()
 upScreenB = scrollScreensB (-1)
 
--- | Scroll up 1 screen
+-- | Scroll down 1 screen
 downScreenB :: BufferM ()
 downScreenB = scrollScreensB 1
 
@@ -281,10 +291,17 @@
     h <- askWindow height
     scrollB $ n * (h - 1)
 
+-- | Scroll according to function passed. The function takes the
+-- | Window height in lines, its result is passed to scrollB
+-- | (negative for up)
+scrollByB :: (Int -> Int) -> Int -> BufferM ()
+scrollByB f n = do h <- askWindow height
+                   scrollB $ n * (f h)
+
 -- | Scroll by n lines.
 scrollB :: Int -> BufferM ()
 scrollB n = do setA pointDriveA False
-               WinMarks fr _ _ _ <- askMarks
+               MarkSet fr _ _ _ <- askMarks
                savingPointB $ do
                    moveTo =<< getMarkPointB fr
                    gotoLnFrom n
@@ -303,16 +320,11 @@
   moveToSol
   replicateM_ n lineUp
 
-askMarks :: BufferM WinMarks
-askMarks = do
-    Just ms <- getMarks =<< ask
-    return ms
-
 -- | Move to middle line in screen
 middleB :: BufferM ()
 middleB = do
   w <- ask
-  Just (WinMarks f _ _ _) <- getMarks w
+  f <- fromMark <$> askMarks
   moveTo =<< getMarkPointB f
   replicateM_ (height w `div` 2) lineDown
 
@@ -323,23 +335,6 @@
 -----------------------------
 -- Region-related operations
 
--- | 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
-
-unitWiseRegion :: TextUnit -> Region -> BufferM Region
-unitWiseRegion unit = extendRegionToBoundaries unit InsideBound OutsideBound
-
-
 -- TODO: either decide this is evil and contain it to Vim, or embrace it and move it to the
 -- Buffer record.
 newtype SelectionStyle = SelectionStyle TextUnit
@@ -348,13 +343,22 @@
 instance Initializable SelectionStyle where
   initial = SelectionStyle Character
 
-getRawSelectRegionB :: BufferM Region
-getRawSelectRegionB = do
-  m <- getMarkPointB staticSelMark
+-- | Return the region between point and mark
+getRawestSelectRegionB :: BufferM Region
+getRawestSelectRegionB = do
+  m <- getSelectionMarkPointB
   p <- pointB
   return $ mkRegion p m
 
--- | Get the current region boundaries
+-- | Return the empty region if the selection is not visible.
+getRawSelectRegionB :: BufferM Region
+getRawSelectRegionB = do
+  s <- getA 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
   SelectionStyle unit <- getDynamicB
@@ -364,7 +368,7 @@
 -- and the current point at the 'regionEnd'.
 setSelectRegionB :: Region -> BufferM ()
 setSelectRegionB region = do
-  setMarkPointB staticSelMark $ regionStart region
+  setSelectionMarkPointB $ regionStart region
   moveTo $ regionEnd region
 
 -- | Extend the selection mark using the given region.
@@ -389,7 +393,7 @@
 -- in the given direction.
 lineStreamB :: Direction -> BufferM [String]
 lineStreamB dir = fmap (LazyUTF8.toString . rev) . drop 1 . LB.split newLine <$> (streamB dir =<< pointB)
-    where rev = case dir of 
+    where rev = case dir of
                   Forward -> id
                   Backward -> LB.reverse
 
@@ -437,7 +441,7 @@
 
 
 modifyExtendedSelectionB :: TextUnit -> (String -> String) -> BufferM ()
-modifyExtendedSelectionB unit transform 
+modifyExtendedSelectionB unit transform
     = modifyRegionB transform =<< unitWiseRegion unit =<< getSelectRegionB
 
 
@@ -446,7 +450,7 @@
 -- 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 :: 
+searchReplaceRegionB ::
                        String -- ^ The String to search for
                     -> String -- ^ The String to replace it with
                     -> Region -- ^ The region to perform this over
@@ -459,7 +463,7 @@
 
 
 -- | Peform a search and replace on the selection
-searchReplaceSelectionB :: 
+searchReplaceSelectionB ::
                            String -- ^ The String to search for
                         -> String
                            -- ^ The String to replace it with
@@ -467,43 +471,49 @@
 searchReplaceSelectionB from to =
   modifySelectionB $ substituteInList from to
 
+replaceString :: String -> String -> BufferM ()
+replaceString a b = do end <- sizeB
+                       let region = mkRegion 0 end
+                       searchReplaceRegionB a b region
 
 -- | Prefix each line in the selection using
 -- the given string.
-linePrefixSelectionB :: 
+linePrefixSelectionB ::
                          String -- ^ The string that starts a line comment
                       -> BufferM ()
                          -- The returned buffer action
 linePrefixSelectionB s =
   modifyExtendedSelectionB Line $ mapLines (s ++)
 
--- | Comments the region using latex line comments
-latexCommentSelectionB :: BufferM ()
-latexCommentSelectionB = linePrefixSelectionB "% "
-
 -- | 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 :: String -- ^ The string which begins a line comment
+                        -> String -- ^ A potentially shorter string that begins a comment
                         -> BufferM ()
-unLineCommentSelectionB s =
+unLineCommentSelectionB s1 s2 =
   modifyExtendedSelectionB Line $ mapLines unCommentLine
   where
   unCommentLine :: String -> String
   unCommentLine line
-    | isPrefixOf s line = drop (length s) line
+    | isPrefixOf s1 line = drop (length s1) line
+    | isPrefixOf s2 line = drop (length s2) line
     | otherwise         = line
 
--- | uncomments a region of latex line commented code
-latexUnCommentSelectionB :: BufferM ()
-latexUnCommentSelectionB = unLineCommentSelectionB "% "
-
+-- | Toggle line comments in the selection by adding or removing a prefix to each
+-- line.
+toggleCommentSelectionB :: String -> String -> BufferM ()
+toggleCommentSelectionB insPrefix delPrefix = do
+  l <- readUnitB Line
+  if (delPrefix `isPrefixOf` l)
+    then unLineCommentSelectionB insPrefix delPrefix
+    else linePrefixSelectionB insPrefix
 
--- Performs as search and replace on the given string.
+-- | Performs as search and replace on the given string.
 substituteInList :: Eq a => [ a ] -> [ a ] -> [ a ] -> [ a ]
 substituteInList _from _to []       = []
 substituteInList from to list@(h : rest)
-  | isPrefixOf from list = 
+  | isPrefixOf from list =
     to ++ (substituteInList from to $ drop (length from) list)
   | otherwise            =
     h : (substituteInList from to rest)
diff --git a/Yi/Buffer/Implementation.hs b/Yi/Buffer/Implementation.hs
--- a/Yi/Buffer/Implementation.hs
+++ b/Yi/Buffer/Implementation.hs
@@ -10,33 +10,23 @@
   , updateIsDelete
   , Point
   , Mark, MarkValue(..)
-  , dummyFromMark
-  , dummyToMark
-  , staticInsMark
-  , staticSelMark
   , Size
   , Direction (..)
   , BufferImpl
   , Overlay, OvlLayer (..)
   , mkOverlay
   , overlayUpdate
-  , moveToI
   , applyUpdateI
   , isValidUpdate
-  , applyUpdateWithMoveI
   , reverseUpdateI
-  , pointBI
   , nelemsBI
   , nelemsBI'
   , sizeBI
-  , curLnI
   , newBI
   , gotoLnRelI
---  , offsetFromSolBI
   , charsFromSolBI
-  , searchBI
   , regexRegionBI
-  , getMarkBI
+  , getMarkDefaultPosBI
   , modifyMarkBI
   , getMarkValueBI
   , newMarkBI
@@ -53,6 +43,7 @@
   , getStream
   , getIndexedStream
   , newLine
+  , lineAt
   , SearchExp
 )
 where
@@ -162,16 +153,12 @@
 --------------------------------------------------
 -- Low-level primitives.
 
+dummyHlState :: HLState syntax
 dummyHlState = (HLState noHighlighter (hlStartState noHighlighter))
 
 -- | New FBuffer filled from string.
 newBI :: LazyB.ByteString -> BufferImpl ()
-newBI s = FBufferData (F.fromLazyByteString s) mks M.empty dummyHlState Set.empty 0
-    where mks = M.fromList [ (staticInsMark, MarkValue 0 insertGravity)
-                           , (staticSelMark, MarkValue 0 selectionGravity)
-                           , (dummyFromMark, MarkValue 0 Backward)
-                           , (dummyToMark, MarkValue 0 Forward)
-                           ]
+newBI s = FBufferData (F.fromLazyByteString s) M.empty M.empty dummyHlState Set.empty 0
 
 -- | read @n@ chars from buffer @b@, starting at @i@
 readChars :: ByteRope -> Int -> Point -> String
@@ -228,11 +215,6 @@
 sizeBI :: BufferImpl syntax -> Point
 sizeBI fb = Point $ F.length $ mem fb
 
--- | Extract the current point
-pointBI :: BufferImpl syntax -> Point
-pointBI fb = markPoint ((marks fb) M.! staticInsMark)
-{-# INLINE pointBI #-}
-
 -- | Return @n@ Chars starting at @i@ of the buffer as a list
 nelemsBI :: Int -> Point -> BufferImpl syntax -> String
 nelemsBI n i fb = readChars (mem fb) n i
@@ -276,8 +258,8 @@
 --   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 :: Maybe SearchExp -> Region -> BufferImpl syntax -> [[Stroke]]
-strokesRangesBI regex rgn fb@(FBufferData {hlCache = HLState hl cache}) = result
+strokesRangesBI :: Maybe SearchExp -> Region -> Point -> BufferImpl syntax -> [[Stroke]]
+strokesRangesBI regex rgn  point fb@(FBufferData {hlCache = HLState hl cache}) = result
   where
     i = regionStart rgn
     j = regionEnd rgn
@@ -292,19 +274,12 @@
                Nothing -> []
     result = map (map clampStroke . takeIn . dropBefore) (layer3 : layers2 ++ [syntaxHlLayer, groundLayer])
     overlayStroke (Overlay _ sm  em a) = (markPoint sm, a, markPoint em)
-    point = pointBI fb
     clampStroke (l,x,r) = (max i l, x, min j r)
     hintStroke r = (regionStart r,if point `nearRegion` r then strongHintStyle else hintStyle,regionEnd r)
 
 ------------------------------------------------------------------------
 -- Point based editing
 
--- | Move point in buffer to the given index
-moveToI :: Point -> BufferImpl syntax -> BufferImpl syntax
-moveToI i fb = fb {marks = M.insert staticInsMark (MarkValue (inBounds i (Point end)) insertGravity) $ marks fb}
-    where end = F.length (mem fb)
-{-# INLINE moveToI #-}
-
 findNextChar :: Int -> Point -> BufferImpl syntax -> Point
 findNextChar m p fb 
     | m < 0 = case drop (0 - 1 - m) (getIndexedStream Backward p fb) of
@@ -337,14 +312,6 @@
           p = mem fb
           -- FIXME: remove collapsed overlays
    
--- | 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 = moveToI (updatePoint u)
-          apply = applyUpdateI u
-
 -- | Reverse the given update
 reverseUpdateI :: Update -> Update
 reverseUpdateI (Delete p dir cs) = Insert p (reverseDir dir) cs
@@ -360,23 +327,21 @@
 newLine :: Word8
 newLine = ord' '\n'
 
-curLnI :: BufferImpl syntax -> Int
-curLnI fb = 1 + F.count newLine (F.take (fromPoint $ pointBI fb) (mem fb))
+lineAt :: Point -> BufferImpl syntax -> Int
+lineAt point fb = 1 + F.count newLine (F.take (fromPoint point) (mem fb))
 
 
--- | Go to line number @n@, relatively from this line. @0@ will go to
+-- | Get the point at line number @n@, relatively from @point@. @0@ will go to
 -- the start of this line. Returns the actual line difference we went
 -- to (which may be not be the requested one, if it was out of range)
 -- Note that the line-difference returned will be negative if we are
 -- going backwards to previous lines (that is if @n@ was negative).
-gotoLnRelI :: Int -> BufferImpl syntax -> (BufferImpl syntax, Int)
-gotoLnRelI n fb = 
-  (moveToI (Point newPoint) fb, difference)
+gotoLnRelI :: Int -> Point -> BufferImpl syntax -> (Point, Int)
+gotoLnRelI n (Point point) fb = (Point newPoint, difference)
   where
   -- The text of the buffer
   s     = mem fb
   -- The current point that we are at in the buffer.
-  Point point = pointBI fb
   (difference, newPoint)
     -- Important that we go up if it is 0 since findDownLine
     -- fails for zero.
@@ -416,31 +381,9 @@
   findDownLine acc 1 (x:_)  = (acc, x)
   findDownLine acc l (_:xs) = findDownLine (acc + 1) (l - 1) xs
 
--- | Return index of next string in buffer that matches argument
-searchBI :: Direction -> String -> BufferImpl syntax -> Maybe Point
-searchBI dir s fb = fmap Point $ case dir of
-      Forward -> fmap (pnt +) $ F.findSubstring (UTF8.fromString s) $ F.drop pnt ptr
-      Backward -> listToMaybe $ reverse $ F.findSubstrings (UTF8.fromString s) $ F.take (pnt + length s) ptr
-    -- FIXME: backward search is inefficient.
-    where Point pnt = pointBI fb -- pnt == current point
-          ptr = mem fb
-
-offsetToEolBI fb = Size $ case (F.elemIndices newLine) (F.drop point s) of
-                     [] -> F.length s - point
-                     (x:_) -> x
-    where s = mem fb
-          Point point = pointBI fb
-                   
-
-offsetFromSolBI :: BufferImpl syntax -> Size
-offsetFromSolBI fb = Size (pnt - maybe 0 (1 +) (F.elemIndexEnd newLine (F.take pnt ptr)))
-    where Point pnt = pointBI fb
-          ptr = mem fb
-
-charsFromSolBI :: BufferImpl syntax -> String
-charsFromSolBI fb = LazyUTF8.toString $ F.toLazyByteString $ readChunk ptr (Size (pnt - sol)) (Point sol)
+charsFromSolBI :: Point -> BufferImpl syntax -> String
+charsFromSolBI (Point pnt) fb = LazyUTF8.toString $ F.toLazyByteString $ readChunk ptr (Size (pnt - sol)) (Point sol)
   where sol = maybe 0 (1 +) (F.elemIndexEnd newLine (F.take pnt ptr))
-        Point pnt = pointBI fb
         ptr = mem fb
 
 
@@ -456,15 +399,13 @@
 
 newMarkBI :: MarkValue -> BufferImpl syntax -> (BufferImpl syntax, Mark)
 newMarkBI initialValue fb =
-    let (Mark maxId, _) = M.findMax (marks fb)
+    let maxId = maybe 0 id $ 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 -> MarkValue
-getMarkValueBI m (FBufferData { marks = marksMap } ) = M.findWithDefault (marksMap M.! staticInsMark) m marksMap
-                 -- We look up mark m in the marks, the default value to return
-                 -- if mark m is not set, is the staticInsMark
+getMarkValueBI :: Mark -> BufferImpl syntax -> Maybe MarkValue
+getMarkValueBI m (FBufferData { marks = marksMap } ) = M.lookup m marksMap
 
 -- | Modify a mark value.
 modifyMarkBI :: Mark -> (MarkValue -> MarkValue) -> (forall syntax. BufferImpl syntax -> BufferImpl syntax)
@@ -514,15 +455,7 @@
     | otherwise           = x : decodeBack xs    -- continue
 
 
-insertGravity, selectionGravity :: Direction
-insertGravity = Forward
-selectionGravity = Backward
-
 ------------------------------------------------------------------------
-
--- | Returns the requested mark, creating a new mark with that name (at point) if needed
-getMarkBI :: Maybe String -> BufferImpl syntax -> (BufferImpl syntax, Mark)
-getMarkBI name b = getMarkDefaultPosBI name (pointBI b) b
 
 -- | 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)
diff --git a/Yi/Buffer/Indent.hs b/Yi/Buffer/Indent.hs
--- a/Yi/Buffer/Indent.hs
+++ b/Yi/Buffer/Indent.hs
@@ -20,9 +20,8 @@
 import Data.List (span, length, sort, nub, break, reverse, filter, takeWhile)
 import Yi.String
 
-
 {- |
-  Inserts either a \t or the number of spaces specified by tabSize in the
+  Insert 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'@.
 -}
@@ -37,7 +36,7 @@
   Retrieve the current indentation settings for the buffer.
 -}
 indentSettingsB :: BufferM IndentSettings
-indentSettingsB = withModeB (\Mode {modeIndentSettings = x} -> x)
+indentSettingsB = withModeB (\Mode {modeIndentSettings = x} -> return x)
 
 
 {-|
@@ -46,7 +45,7 @@
   specialise 'autoIndentHelperB' on their own.
 -}
 autoIndentB :: IndentBehaviour -> BufferM ()
-autoIndentB indentBehave =
+autoIndentB indentBehave = do
   autoIndentHelperB fetchPreviousIndentsB indentsOfString indentBehave
   where
   -- Returns the indentation hints considering the given
@@ -55,11 +54,12 @@
   --     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 :: String -> BufferM [ Int ]
+  indentsOfString :: String -> BufferM [Int]
   indentsOfString input = 
     do indent       <- indentOfB input
        bracketHints <- lastOpenBracketHint input
-       return $ indent : (indent + 2) : bracketHints
+       indentSettings <- indentSettingsB
+       return $ indent : (indent + shiftWidth indentSettings) : bracketHints
 
 {-|
   This takes two arguments the first is a function to
@@ -84,7 +84,7 @@
                  -- ^ Action to calculate hints from previous line
                  -> IndentBehaviour
                  -- ^ Sets the indent behaviour, 
-                 ---  see 'Yi.Buffer.IndentBehaviour' for a description
+                 -- see 'Yi.Buffer.IndentBehaviour' for a description
                  -> BufferM ()
 autoIndentHelperB getUpwards getPrevious indentBehave =
   do upwardHints   <- savingExcursionB getUpwards
@@ -377,33 +377,9 @@
     of the line then we wish to remain pointing to the same character.
 -}
 indentToB :: Int -> BufferM ()
-indentToB level = 
-     -- Grab the current line
-  do line          <- readLnB
-     -- grab the current offset (in characters) from the start of the line
-     currentOffset <- curCol
-     -- move to the start of the line
-     moveToSol
-     -- delete the whole of the line.
-     deleteToEol
-         -- Separate the white space of the current line from the rest of it.
-     let (curIndent, restOfLine) = span isSpace line
-         -- The original offset (in characters) from the start of the rest
-         -- the line, this will be greater than zero if the current point
-         -- was somewhere after the indentation of the current line.
-         origOffsetFromIndent    = currentOffset - (length curIndent)
-         -- This calculates how far we should be from the end of the line.
-         -- if we are within the line then we wish to remain at the same
-         -- character, however if we were anywhere within the indentation
-         -- we wish to go to the start of the 'non' indentation, that is
-         -- to the end of the (new) indentation.
-         newFromEol = if origOffsetFromIndent <= 0
-                      then length restOfLine
-                      else (length restOfLine - origOffsetFromIndent)
-     -- Insert the new line
-     insertN (replicate level ' ' ++ restOfLine)
-     -- Then move to the place we have calculated
-     leftN newFromEol
+indentToB level = do
+    indentSettings <- indentSettingsB
+    modifyRegionClever (rePadString indentSettings level) =<< regionOfB Line
 
 -- | Indent as much as the previous line
 indentAsPreviousB :: BufferM ()
@@ -413,20 +389,27 @@
      indentToB previousIndent
 
 
--- | 
--- shifts right (or left if num is negative) num times, filling in tabs if
+
+-- | Set the padding of the string to newCount, filling in tabs if
 -- expandTabs is set in the buffers IndentSettings
-indentString :: IndentSettings -> Int -> String -> String
-indentString indentSettings numOfShifts input 
+rePadString :: IndentSettings -> Int -> String -> String
+rePadString indentSettings newCount input 
     | newCount <= 0 = rest
     | expandTabs indentSettings = replicate newCount ' ' ++ rest
     | otherwise = tabs ++ spaces ++ rest
-    where (indents,rest) = span isSpace input
+    where (_indents,rest) = span isSpace input
+          tabs   = replicate (newCount `div` (tabSize indentSettings)) '\t'
+          spaces = replicate (newCount `mod` (tabSize indentSettings)) ' '
+
+
+-- | shifts right (or left if num is negative) num times, filling in tabs if
+-- expandTabs is set in the buffers IndentSettings
+indentString :: IndentSettings -> Int -> String -> String
+indentString indentSettings numOfShifts input = rePadString indentSettings newCount input 
+    where (indents,_) = span isSpace input
           countSpace '\t' = tabSize indentSettings
           countSpace _ = 1 -- we'll assume nothing but tabs and spaces
           newCount = sum (fmap countSpace indents) + ((shiftWidth indentSettings) * numOfShifts)
-          tabs   = replicate (newCount `div` (tabSize indentSettings)) '\t'
-          spaces = replicate (newCount `mod` (tabSize indentSettings)) ' '
          
 
 shiftIndentOfSelection :: Int -> BufferM ()
@@ -450,4 +433,4 @@
 -- | Decreases the indentation on the region by the given amount
 decreaseIndentSelectionB :: Int -> BufferM ()
 decreaseIndentSelectionB i =
-  unLineCommentSelectionB $ replicate i ' '
+  let pre = replicate i ' ' in unLineCommentSelectionB pre pre
diff --git a/Yi/Buffer/Misc.hs b/Yi/Buffer/Misc.hs
--- a/Yi/Buffer/Misc.hs
+++ b/Yi/Buffer/Misc.hs
@@ -9,7 +9,7 @@
 module Yi.Buffer.Misc
   ( FBuffer (..)
   , BufferM (..)
-  , WinMarks (..)
+  , WinMarks, MarkSet (..)
   , getMarks
   , runBuffer
   , runBufferFull
@@ -63,7 +63,6 @@
   , modifyMode
   , regexRegionB
   , regexB
-  , searchB
   , readAtB
   , getModeLine
   , getPercent
@@ -78,6 +77,7 @@
   , savingPointB
   , pendingUpdatesA
   , highlightSelectionA
+  , rectangleSelectionA
   , revertPendingUpdatesB
   , askWindow
   , clearSyntax
@@ -87,6 +87,7 @@
   , IndentSettings (..)
   , emptyMode
   , withModeB
+  , withMode0
   , onMode
   , withSyntax0
   , withSyntaxB
@@ -95,15 +96,21 @@
   , streamB
   , indexedStreamB
   , getMarkPointB
+  , askMarks
   , pointAt
   , fileA
   , nameA
   , pointDriveA
   , SearchExp
+  , charIndexB
+  , byteIndexB
+  , charRegionB
+  , byteRegionB
+  , indexStreamRegionB
   )
 where
 
-import Prelude (ceiling)
+import Prelude (ceiling, span, unzip, take, drop)
 import Yi.Prelude
 import Yi.Region
 import System.FilePath
@@ -113,10 +120,11 @@
 import Yi.Buffer.Undo
 import Yi.Dynamic
 import Yi.Window
-import Control.Monad.RWS.Strict hiding (mapM_, mapM, get, put)
+import Control.Monad.RWS.Strict hiding (mapM_, mapM, get, put, forM)
 import Data.Binary
 import Data.List (scanl, takeWhile, zip, length)
 import qualified Data.Map as M
+import Data.Maybe
 import Data.Typeable
 import {-# source #-} Yi.Keymap
 import Yi.Monad
@@ -147,12 +155,21 @@
 --  * Log of updates mades
 --  * Undo
 
-data WinMarks = WinMarks { fromMark, insMark, selMark, toMark :: !Mark }
+type WinMarks = MarkSet Mark
 
-instance Binary WinMarks where
-    put (WinMarks f i s t) = put f >> put i >> put s >> put t
-    get = WinMarks <$> get <*> get <*> get <*> get
+data MarkSet a = MarkSet { fromMark, insMark, selMark, toMark :: !a }
 
+instance Traversable MarkSet where
+    traverse f (MarkSet a b c d) = MarkSet <$> f a <*> f b <*> f c <*> f d
+instance Foldable MarkSet where
+    foldMap = foldMapDefault
+instance Functor MarkSet where
+    fmap = fmapDefault
+
+instance Binary a => Binary (MarkSet a) where
+    put (MarkSet f i s t) = put f >> put i >> put s >> put t
+    get = MarkSet <$> get <*> get <*> get <*> get
+
 data FBuffer = forall syntax.
         FBuffer { name   :: !String               -- ^ immutable buffer name
                 , bkey   :: !BufferRef            -- ^ immutable unique key
@@ -165,93 +182,119 @@
                 , bufferDynamic :: !DynamicValues -- ^ dynamic components
                 , preferCol :: !(Maybe Int)       -- ^ prefered column to arrive at when we do a lineDown / lineUp
                 , pendingUpdates :: ![UIUpdate]    -- ^ updates that haven't been synched in the UI yet
-                , highlightSelection :: !Bool
+                , selectionStyle :: !SelectionStyle
                 , process :: !KeymapProcess
                 , winMarks :: !(M.Map WindowRef WinMarks)
+                , lastActiveWindow :: !Window
                 }
         deriving Typeable
 
 -- unfortunately the dynamic stuff can't be read.
 instance Binary FBuffer where
-    put (FBuffer n b f u r bmode pd _bd pc pu hs _proc wm)  =
+    put (FBuffer n b f u r bmode pd _bd pc pu hs _proc wm law)  =
       let strippedRaw :: BufferImpl ()
           strippedRaw = (setSyntaxBI (modeHL emptyMode) r) 
       in do
           put (modeName bmode)
           put n >> put b >> put f >> put u >> put strippedRaw
           put pd >> put pc >> put pu >> put hs >> put wm
-    
+          put law
     get = do
         mnm <- get
         FBuffer <$> get <*> get <*> get <*> get <*> getStripped <*>
-          pure (emptyMode {modeName = mnm}) <*> get <*> pure emptyDV <*> get <*> get <*> get <*> pure I.End <*> get
+          pure (emptyMode {modeName = mnm}) <*> get <*> pure emptyDV <*> get <*> get <*> get <*> pure I.End <*> get <*> get
         where getStripped :: Get (BufferImpl ())
               getStripped = get
 
+data SelectionStyle = SelectionStyle
+  { highlightSelection :: !Bool
+  , rectangleSelection :: !Bool
+  }
+  deriving Typeable
+
+instance Binary SelectionStyle where
+  put (SelectionStyle h r) = put h >> put r
+  get = SelectionStyle <$> get <*> get
+
 -- | udpate the syntax information (clear the dirty "flag")
 clearSyntax :: FBuffer -> FBuffer
 clearSyntax = modifyRawbuf updateSyntax
 
 modifyRawbuf :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> FBuffer -> FBuffer
-modifyRawbuf f (FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) = 
-    (FBuffer f1 f2 f3 f4 (f f5) f6 f7 f8 f9 f10 f11 f12 f13)
+modifyRawbuf f (FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14) = 
+    (FBuffer f1 f2 f3 f4 (f f5) f6 f7 f8 f9 f10 f11 f12 f13 f14)
 
 queryAndModifyRawbuf :: (forall syntax. BufferImpl syntax -> (BufferImpl syntax,x)) ->
                      FBuffer -> (FBuffer, x)
-queryAndModifyRawbuf f (FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13) = 
+queryAndModifyRawbuf f (FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14) = 
     let (f5', x) = f f5
-    in (FBuffer f1 f2 f3 f4 f5' f6 f7 f8 f9 f10 f11 f12 f13, x)
+    in (FBuffer f1 f2 f3 f4 f5' f6 f7 f8 f9 f10 f11 f12 f13 f14, x)
 
+lastActiveWindowA :: Accessor FBuffer Window
+lastActiveWindowA = Accessor lastActiveWindow (\f e -> case e of 
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 (f f14))
+
 pointDriveA :: Accessor FBuffer Bool
 pointDriveA = Accessor pointDrive (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer f1 f2 f3 f4 f5 f6 (f f7) f8 f9 f10 f11 f12 f13)
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 f3 f4 f5 f6 (f f7) f8 f9 f10 f11 f12 f13 f14)
 
 
 undosA :: Accessor (FBuffer) (URList)
 undosA = Accessor undos (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer f1 f2 f3 (f f4) f5 f6 f7 f8 f9 f10 f11 f12 f13)
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 f3 (f f4) f5 f6 f7 f8 f9 f10 f11 f12 f13 f14)
 
 fileA :: Accessor (FBuffer) (Maybe FilePath)
 fileA = Accessor file (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer f1 f2 (f f3) f4 f5 f6 f7 f8 f9 f10 f11 f12 f13)
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 (f f3) f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14)
 
 preferColA :: Accessor (FBuffer) (Maybe Int)
 preferColA = Accessor preferCol (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 (f f9) f10 f11 f12 f13)
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 (f f9) f10 f11 f12 f13 f14)
 
 bufferDynamicA :: Accessor (FBuffer) (DynamicValues)
 bufferDynamicA = Accessor bufferDynamic (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer f1 f2 f3 f4 f5 f6 f7 (f f8) f9 f10 f11 f12 f13)
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 f3 f4 f5 f6 f7 (f f8) f9 f10 f11 f12 f13 f14)
 
 pendingUpdatesA :: Accessor (FBuffer) ([UIUpdate])
 pendingUpdatesA = Accessor pendingUpdates (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 (f f10) f11 f12 f13)
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 (f f10) f11 f12 f13 f14)
 
+selectionStyleA :: Accessor FBuffer SelectionStyle
+selectionStyleA = Accessor selectionStyle (\f e -> case e of 
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 (f f11) f12 f13 f14)
+
 highlightSelectionA :: Accessor FBuffer Bool
-highlightSelectionA = Accessor highlightSelection (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 (f f11) f12 f13)
+highlightSelectionA = 
+  Accessor highlightSelection (\f e -> e { highlightSelection = f (highlightSelection e) })
+  .> selectionStyleA
 
+rectangleSelectionA :: Accessor FBuffer Bool
+rectangleSelectionA = 
+  Accessor rectangleSelection (\f e -> e { rectangleSelection = f (rectangleSelection e) })
+  .> selectionStyleA
+
 nameA :: Accessor FBuffer String
 nameA = Accessor name (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer (f f1) f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13)
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer (f f1) f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14)
 
 keymapProcessA :: Accessor FBuffer KeymapProcess
 keymapProcessA = Accessor process (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 (f f12) f13)
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 (f f12) f13 f14)
 
 winMarksA :: Accessor FBuffer (M.Map Int WinMarks)
 winMarksA = Accessor winMarks (\f e -> case e of 
-                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 -> 
-                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 (f f13))
+                                   FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 f13 f14 -> 
+                                    FBuffer f1 f2 f3 f4 f5 f6 f7 f8 f9 f10 f11 f12 (f f13) f14)
 
 
 
@@ -272,15 +315,16 @@
 
 data Mode syntax = Mode
     {
-     modeName :: String, -- ^ so this could be serialized, debugged.
+     modeName :: String,              -- ^ so this can be serialized, debugged.
      modeApplies :: FilePath -> Bool, -- ^ What type of files does this mode apply to?
-     modeHL :: ExtHL syntax,
-     modePrettify :: syntax -> BufferM (),
+     modeHL :: ExtHL syntax,          -- ^ Syntax highlighter
+     modePrettify :: syntax -> BufferM (), -- ^ Prettify current "paragraph"
      modeKeymap :: KeymapEndo, -- ^ Buffer-local keymap modification
-     modeIndent :: syntax -> IndentBehaviour -> BufferM (),
-     modeAdjustBlock :: syntax -> Int -> BufferM (),
-     modeFollow :: syntax -> Action,
-     modeIndentSettings :: IndentSettings
+     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 :: BufferM ()
     }
 
 instance Binary (Mode syntax) where
@@ -306,7 +350,11 @@
 
 -- | The BufferM monad writes the updates performed.
 newtype BufferM a = BufferM { fromBufferM :: RWS Window [Update] FBuffer a }
+#if __GLASGOW_HASKELL__ >= 610
+    deriving (Monad, Functor, MonadWriter [Update], MonadState FBuffer, MonadReader Window, Typeable)
+#else
     deriving (Monad, Functor, MonadWriter [Update], MonadState FBuffer, MonadReader Window, Typeable1)
+#endif
 
 deriving instance Typeable4 RWS
 
@@ -332,7 +380,7 @@
     ln <- curLn
     p <- pointB
     s <- sizeB
-    modeNm <- withModeB modeName
+    modeNm <- gets (withMode0 modeName)
     unchanged <- isUnchangedB
     let pct = if pos == 1 then "Top" else getPercent p s
         chg = if unchanged then "-" else "*"
@@ -352,7 +400,7 @@
     where p = ceiling ((fromIntegral a) / (fromIntegral b) * 100 :: Double) :: Int
 
 queryBuffer :: (forall syntax. BufferImpl syntax -> x) -> (BufferM x)
-queryBuffer f = gets (\(FBuffer _ _ _ _ fb _ _ _ _ _ _ _ _) -> f fb)
+queryBuffer f = gets (\(FBuffer _ _ _ _ fb _ _ _ _ _ _ _ _ _) -> f fb)
 
 modifyBuffer :: (forall syntax. BufferImpl syntax -> BufferImpl syntax) -> BufferM ()
 modifyBuffer f = modify (modifyRawbuf f)
@@ -386,34 +434,33 @@
 getMarks :: Window -> BufferM (Maybe WinMarks)
 getMarks w = do
     getsA winMarksA (M.lookup $ wkey w) 
-    
+ 
+
 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
-            (i,s) <- case ms of
-               Just (WinMarks _ i s _) -> do
-                   copyMark i staticInsMark
-                   copyMark s staticSelMark
-                   return (i,s)
-               Nothing -> do
-                   -- copy marks from random window.
-                   (_, WinMarks fr i s t) <- M.findMax <$> getA winMarksA
-                   markValues <- mapM getMarkValueB [fr, i, s, t]
-                   [newFrom, newIns, newSel, newTo] <- mapM newMarkB markValues
-                   modifyA winMarksA (M.insert (wkey w) (WinMarks newFrom newIns newSel newTo))
-                   return (newIns,newSel)
-            f <* copyMark staticInsMark i <* copyMark staticSelMark s
+            when (isNothing ms) $ do
+                -- this window has no marks for this buffer yet; have to create them.
+                newMarkValues <- if wkey (lastActiveWindow b) == dummyWindowKey
+                    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
+                                   toMark = MarkValue 0 Forward } -- to
+                    else do
+                        Just mrks  <- getsA winMarksA (M.lookup $ wkey (lastActiveWindow b))
+                        forM mrks getMarkValueB
+                newMrks <- forM newMarkValues newMarkB
+                modifyA winMarksA (M.insert (wkey w) newMrks)
+            setA lastActiveWindowA w
+            f
     in (a, updates, modifier pendingUpdatesA (++ fmap TextUpdate updates) b')
 
-copyMark :: Mark -> Mark -> BufferM ()
-copyMark src dst = do
-  p <- getMarkValueB src
-  setMarkPointB dst (markPoint p)
-
 getMarkValueB :: Mark -> BufferM MarkValue
-getMarkValueB m = queryBuffer (getMarkValueBI m)
+getMarkValueB m = maybe (MarkValue 0 Forward) id <$> queryBuffer (getMarkValueBI m)
 
 newMarkB :: MarkValue -> BufferM Mark
 newMarkB v = queryAndModify $ newMarkBI v
@@ -438,10 +485,11 @@
 isUnchangedBuffer = isAtSavedFilePointU . undos
 
 
-undoRedo :: (forall syntax. URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update])) ) -> BufferM ()
+undoRedo :: (forall syntax. Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update])) ) -> BufferM ()
 undoRedo f = do
+  m <- getInsMark
   ur <- gets undos
-  (ur', updates) <- queryAndModify (f ur)
+  (ur', updates) <- queryAndModify (f m ur)
   setA undosA ur'
   tell updates
 
@@ -466,7 +514,8 @@
    { expandTabs = True
    , tabSize = 8
    , shiftWidth = 4
-   }
+   },
+   modeToggleCommentSelection = fail "'comment selection' not defined for this mode"
   }
 
 -- | Create buffer named @nm@ with contents @s@
@@ -483,9 +532,10 @@
             , preferCol = Nothing
             , bufferDynamic = emptyDV 
             , pendingUpdates = []
-            , highlightSelection = False
+            , selectionStyle = SelectionStyle False False
             , process = I.End
-            , winMarks = M.singleton dummyWindowKey (WinMarks dummyFromMark staticInsMark staticSelMark dummyToMark)
+            , winMarks = M.empty
+            , lastActiveWindow = dummyWindow unique
             }
 
 -- | Point of eof
@@ -494,8 +544,9 @@
 
 -- | Extract the current point
 pointB :: BufferM Point
-pointB = queryBuffer pointBI
+pointB = getMarkPointB =<< getInsMark
 
+
 -- | Return @n@ elems starting at @i@ of the buffer as a list
 nelemsB :: Int -> Point -> BufferM [Char]
 nelemsB n i = queryBuffer $ nelemsBI n i
@@ -511,7 +562,9 @@
 indexedStreamB dir i = queryBuffer (getIndexedStream dir i)
 
 strokesRangesB :: Maybe SearchExp -> Region -> BufferM [[Stroke]]
-strokesRangesB regex r = queryBuffer $ strokesRangesBI regex r
+strokesRangesB regex r = do
+    p <- pointB
+    queryBuffer $ strokesRangesBI regex r p
 
 ------------------------------------------------------------------------
 -- Point based operations
@@ -520,7 +573,7 @@
 moveTo :: Point -> BufferM ()
 moveTo x = do
   forgetPreferCol
-  modifyBuffer $ moveToI x
+  flip setMarkPointB x =<< getInsMark
 
 ------------------------------------------------------------------------
 
@@ -589,7 +642,9 @@
 
 -- | Return the current line number
 curLn :: BufferM Int
-curLn = queryBuffer curLnI
+curLn = do 
+    p <- pointB
+    queryBuffer (lineAt p)
 
 -- | 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,
@@ -600,18 +655,14 @@
 
 ---------------------------------------------------------------------
 
--- | Return index of next (or previous) string in buffer that matches argument
-searchB :: Direction -> [Char] -> BufferM (Maybe Point)
-searchB dir s = queryBuffer (searchBI dir s)
-
 setMode0 :: forall syntax. Mode syntax -> FBuffer -> FBuffer
-setMode0 m (FBuffer f1 f2 f3 f4 rb _ f7 f8 f9 f10 f11 f12 f13) =
-    (FBuffer f1 f2 f3 f4 (setSyntaxBI (modeHL m) rb) m f7 f8 f9 f10 f11 f12 f13)
+setMode0 m (FBuffer f1 f2 f3 f4 rb _ f7 f8 f9 f10 f11 f12 f13 f14) =
+    (FBuffer f1 f2 f3 f4 (setSyntaxBI (modeHL m) rb) m f7 f8 f9 f10 f11 f12 f13 f14)
 
 modifyMode0 :: (forall syntax. Mode syntax -> Mode syntax) -> FBuffer -> FBuffer
-modifyMode0 f (FBuffer f1 f2 f3 f4 rb m f7 f8 f9 f10 f11 f12 f13) =
+modifyMode0 f (FBuffer f1 f2 f3 f4 rb m f7 f8 f9 f10 f11 f12 f13 f14) =
     let m' = f m
-    in (FBuffer f1 f2 f3 f4 (setSyntaxBI (modeHL m') rb) m' f7 f8 f9 f10 f11 f12 f13)
+    in (FBuffer f1 f2 f3 f4 (setSyntaxBI (modeHL m') rb) m' f7 f8 f9 f10 f11 f12 f13 f14)
 
 
 -- | Set the mode
@@ -639,8 +690,10 @@
 withMode0 f FBuffer {bmode = m} = f m 
 
 
-withModeB :: (forall syntax. Mode syntax -> a) -> BufferM a
-withModeB f = gets (withMode0 f)
+withModeB :: (forall syntax. Mode syntax -> BufferM a) -> BufferM a
+withModeB f = do
+    act <- gets (withMode0 f)
+    act
            
 withSyntax0 :: (forall syntax. Mode syntax -> syntax -> a) -> FBuffer -> a
 withSyntax0 f FBuffer {bmode = m, rawbuf = rb} = f m (getAst rb)
@@ -676,9 +729,21 @@
 setVisibleSelection :: Bool -> BufferM ()
 setVisibleSelection = setA 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 = queryAndModify (getMarkBI m)
+getMarkB m = do
+  p <- pointB
+  queryAndModify (getMarkDefaultPosBI m p) 
+  
 
+
 -- | Move point by the given number of characters.
 -- A negative offset moves backwards a positive one forward.
 moveN :: Int -> BufferM ()
@@ -775,7 +840,8 @@
 -- (This takes into account tabs, unicode chars, etc.)
 curCol :: BufferM Int
 curCol = do 
-  chars <- queryBuffer charsFromSolBI
+  p <- pointB
+  chars <- queryBuffer (charsFromSolBI p)
   return (foldl colMove 0 chars)
 
 colMove :: Int -> Char -> Int
@@ -787,7 +853,11 @@
 -- Returns the actual moved difference which of course
 -- may be negative if the requested difference was negative.
 gotoLnFrom :: Int -> BufferM Int
-gotoLnFrom x = queryAndModify $ gotoLnRelI x
+gotoLnFrom x = do
+    p <- pointB
+    (p',lineDiff) <- queryBuffer $ gotoLnRelI x p 
+    moveTo p'
+    return lineDiff
 
 bufferDynamicValueA :: Initializable a => Accessor FBuffer a
 bufferDynamicValueA = dynamicValueA .> bufferDynamicA
@@ -827,4 +897,37 @@
 
 askWindow :: (Window -> a) -> BufferM a
 askWindow = asks
+
+-------------
+-- Character-positions
+
+-- | Convert a buffer position to a character position
+charIndexB :: Point -> BufferM Point
+charIndexB p =
+  fromIntegral <$> length <$> takeWhile (< p) <$> fst <$> unzip <$> indexedStreamB Forward 0
+
+-- | Convert a character position to a buffer position
+byteIndexB :: Point -> BufferM Point
+byteIndexB p =
+  fromIntegral <$> head <$> drop (fromIntegral p) <$> fst <$> unzip <$> indexedStreamB Forward 0
+
+-- | Convert a character position region to a buffer position region
+charRegionB :: Region -> BufferM Region
+charRegionB r = do
+  (xs,ys) <- span (< regionStart r) <$> fst <$> unzip <$> indexedStreamB Forward 0
+  return (mkSizeRegion (fromIntegral (length xs)) (fromIntegral (length (takeWhile (< regionEnd r) ys))))
+
+-- | Convert a buffer position region to  position region
+byteRegionB :: Region -> BufferM Region
+byteRegionB r = do
+  xs <- indexStreamRegionB r
+  return $ mkRegion (head xs) (1 + last xs)
+
+-- | Obtain an indexStreamRegion for the specified buff
+indexStreamRegionB :: Region -> BufferM [Point]
+indexStreamRegionB r =
+  take (fromIntegral (regionSize r)) <$>
+  drop (fromIntegral (regionStart r)) <$>
+  fst <$> unzip <$> indexedStreamB Forward 0
+
 
diff --git a/Yi/Buffer/Normal.hs b/Yi/Buffer/Normal.hs
--- a/Yi/Buffer/Normal.hs
+++ b/Yi/Buffer/Normal.hs
@@ -9,8 +9,12 @@
 --  * the textual units they work on
 --  * the direction towards which they operate (if applicable)
 
-module Yi.Buffer.Normal (TextUnit(Character, Word, Line, ViWord, ViWORD, VLine,
-                                  Delimited, Document),
+module Yi.Buffer.Normal (TextUnit(Character, Line, VLine, Document),
+                         leftBoundaryUnit,                         
+                         unitWord,
+                         unitViWord,
+                         unitViWORD,
+                         unitDelimited,
                          unitSentence, unitEmacsParagraph, unitParagraph,
                          -- TextUnit is exported abstract intentionally:
                          -- we'd like to move more units to the GenUnit format.
@@ -25,24 +29,29 @@
                          deleteB, genMaybeMoveB,
                          genMoveB, BoundarySide(..), genAtBoundaryB,
                          checkPeekB
+                         , RegionStyle(..)
+                         , mkRegionOfStyleB
+                         , unitWiseRegion
+                         , extendRegionToBoundaries
                          ) where
 
 import Yi.Buffer.Basic
 import Yi.Buffer.Misc
 import Yi.Buffer.Region
 import Data.Char
+import Data.List (sort)
 import Control.Applicative
 import Control.Monad
 import Data.Typeable
 
 -- | Designate a given "unit" of text.
 data TextUnit = Character -- ^ a single character
-              | Word -- ^ a word as in use in Emacs (funamental mode)
+              | Word -- ^ a word as in use in Emacs (fundamental mode)
               | ViWord -- ^ a word as in use in Vim
               | ViWORD -- ^ a WORD as in use in Vim
               | Line  -- ^ a line of text (between newlines)
               | VLine -- ^ a "vertical" line of text (area of text between two characters at the same column number)
-              | Delimited Char Char -- ^ delimited on the left and right by given characters
+              | Delimited Char Char Bool -- ^ delimited on the left and right by given characters, boolean argument tells if whether those are included.
               | Document -- ^ the whole document
               | GenUnit {genEnclosingUnit :: TextUnit,
                          genUnitBoundary :: Direction -> BufferM Bool}
@@ -50,6 +59,11 @@
       -- idea to use GenUnit though.
                 deriving Typeable
 
+unitWord = Word
+unitViWord = ViWord
+unitViWORD = ViWORD
+unitDelimited = Delimited
+
 isWordChar :: Char -> Bool
 isWordChar x = isAlphaNum x || x == '_'
 
@@ -104,8 +118,10 @@
                          | otherwise    = 3
       _ -> True
 atBoundary Line direction = checkPeekB 0 [isNl] direction
-atBoundary (Delimited c _) Backward = checkPeekB 0 [(== c)] Backward
-atBoundary (Delimited _ c) Forward  = (== c) <$> readB
+atBoundary (Delimited c _ False) Backward = checkPeekB 0 [(== c)] Backward
+atBoundary (Delimited _ c False) Forward  = (== c) <$> readB
+atBoundary (Delimited c _ True) Backward = checkPeekB (-1) [(== c)] Backward
+atBoundary (Delimited _ c True) Forward  = checkPeekB (0) [(== c)] Backward
 atBoundary (GenUnit _ atBound) dir = atBound dir
 
 enclosingUnit :: TextUnit -> TextUnit
@@ -127,15 +143,19 @@
 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,Outside)
--- 2: (Backward,Inside)
--- 3: (Forward,Inside)
--- 4: (Forward,Outside)
+-- 1: (Backward,OutsideBound)
+-- 2: (Backward,InsideBound)
+-- 3: (Forward,InsideBound)
+-- 4: (Forward,OutsideBound)
 --
 -- rules:
 -- genAtBoundaryB u Backward InsideBound  = atBoundaryB u Backward
@@ -283,4 +303,35 @@
 readUnitB :: TextUnit -> BufferM String
 readUnitB = readRegionB <=< regionOfB
 
+-- Region styles are relative to the buffer contents.
+-- They likely should be considered a TextUnit.
+data RegionStyle = LineWise
+                 | Inclusive
+                 | Exclusive
+  deriving (Eq, Typeable, Show)
+
+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
+
+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
 
diff --git a/Yi/Buffer/Region.hs b/Yi/Buffer/Region.hs
--- a/Yi/Buffer/Region.hs
+++ b/Yi/Buffer/Region.hs
@@ -9,6 +9,7 @@
   , swapRegionsB
   , deleteRegionB
   , replaceRegionB
+  , replaceRegionClever
   , readRegionB
   , mapRegionB
   , modifyRegionB
@@ -29,9 +30,9 @@
 winRegionB :: BufferM Region
 winRegionB = do
     w <- ask
-    Just (WinMarks f _ _ t) <- getMarks w
-    tospnt <- getMarkPointB f
-    bospnt <- getMarkPointB t
+    Just ms <- getMarks w
+    tospnt <- getMarkPointB (fromMark ms)
+    bospnt <- getMarkPointB (toMark ms)
     return $ mkRegion tospnt bospnt
 
 -- | Delete an arbitrary part of the buffer
@@ -43,11 +44,25 @@
 readRegionB r = nelemsB' (regionEnd r ~- i) i
     where i = regionStart r
 
+-- | Replace a region with a given string.
 replaceRegionB :: Region -> String -> BufferM ()
 replaceRegionB r s = do
   deleteRegionB r
   insertNAt s (regionStart r)
 
+-- | As 'replaceRegionB', but do a minimal edition instead of deleting the whole
+-- region and inserting it back.
+replaceRegionClever :: Region -> String -> BufferM ()
+replaceRegionClever region text' = savingExcursionB $ do
+    text <- readRegionB region
+    let diffs = getGroupedDiff text text'
+    moveTo (regionStart region)
+    forM_ diffs $ \(d,str) -> do
+        case d of
+            F -> deleteN $ length str
+            B -> rightN $ length str
+            S -> insertN str
+
 mapRegionB :: Region -> (Char -> Char) -> BufferM ()
 mapRegionB r f = do
   text <- readRegionB r
@@ -62,6 +77,9 @@
                      replaceRegionB r' w0
                      replaceRegionB r  w1
 
+-- Transform a replace into a modify.
+replToMod replace = \transform region -> replace region =<< transform <$> readRegionB region
+
 -- | Modifies the given region according to the given
 -- string transformation function
 modifyRegionB :: (String -> String)
@@ -69,21 +87,13 @@
               -> Region
                  -- ^ The region to modify
               -> BufferM ()
-modifyRegionB transform region = replaceRegionB region =<< transform <$> readRegionB region
+modifyRegionB = replToMod replaceRegionB
 
+    
 -- | As 'modifyRegionB', but do a minimal edition instead of deleting the whole
 -- region and inserting it back.
 modifyRegionClever :: (String -> [Char]) -> Region -> BufferM ()
-modifyRegionClever transform region = savingExcursionB $ do
-    text <- readRegionB region
-    let text' = transform text
-        diffs = getGroupedDiff text text'
-    moveTo (regionStart region)
-    forM_ diffs $ \(d,str) -> do
-        case d of
-            F -> deleteN $ length str
-            B -> rightN $ length str
-            S -> insertN str
+modifyRegionClever =  replToMod replaceRegionClever
 
 -- | Extend the right bound of a region to include it.
 inclusiveRegionB :: Region -> BufferM Region
@@ -94,4 +104,3 @@
     where pointAfter p = pointAt $ do 
                            moveTo p
                            rightB
-
diff --git a/Yi/Buffer/Undo.hs b/Yi/Buffer/Undo.hs
--- a/Yi/Buffer/Undo.hs
+++ b/Yi/Buffer/Undo.hs
@@ -99,12 +99,12 @@
   isNotSavedFilePoint _              = True
 
 -- | This undoes one interaction step.
-undoU :: URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update]))
-undoU ur b = undoUntilInteractive [] (undoInteractive ur) b
+undoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update]))
+undoU m ur b = undoUntilInteractive m [] (undoInteractive ur) b
 
 -- | This redoes one iteraction step.
-redoU :: URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update]))
-redoU = asRedo undoU
+redoU :: Mark -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update]))
+redoU m = asRedo (undoU m)
 
 -- | Prepare undo by moving one interaction point from undoes to redoes.
 undoInteractive :: URList -> URList
@@ -122,18 +122,26 @@
     
 -- | Repeatedly undo actions, storing away the inverse operations in the
 --   redo list.
-undoUntilInteractive :: [Update] -> URList -> BufferImpl syntax -> (BufferImpl syntax, (URList, [Update]))
-undoUntilInteractive 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 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 xs ur' b'
-    in (b'', (ur'', u:xs''))
+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.
diff --git a/Yi/Completion.hs b/Yi/Completion.hs
--- a/Yi/Completion.hs
+++ b/Yi/Completion.hs
@@ -16,6 +16,7 @@
 -- General completion
 
 -- | Return the longest common prefix of a set of strings.
+--
 -- > P(xs) === all (isPrefixOf (commonPrefix xs)) xs
 -- > length s > length (commonPrefix xs) --> not (all (isPrefixOf s) xs)
 commonPrefix :: [String] -> String
diff --git a/Yi/Core.hs b/Yi/Core.hs
--- a/Yi/Core.hs
+++ b/Yi/Core.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternSignatures, RecursiveDo, Rank2Types #-}
+{-# LANGUAGE ScopedTypeVariables, RecursiveDo, Rank2Types #-}
 
 -- Copyright (c) Tuomo Valkonen 2004.
 -- Copyright (c) Don Stewart 2004-5. http://www.cse.unsw.edu.au/~dons
@@ -40,7 +40,6 @@
 
   -- * Misc
   , runAction
-  , withMode
   , withSyntax
   ) 
 where
@@ -57,6 +56,7 @@
 import Yi.Keymap
 import Yi.Keymap.Keys
 import Yi.KillRing (krEndCmd)
+import Yi.Style (errorStyle)
 import qualified Yi.Interact as I
 import Yi.Monad
 import qualified Yi.WindowSet as WS
@@ -146,7 +146,7 @@
        entryEvs <- withEditor $ getA pendingEventsA
        logPutStrLn $ "pending events: " ++ showEvs entryEvs
        (userActions,_p') <- withBuffer $ do
-         keymap <- withModeB modeKeymap
+         keymap <- gets (withMode0 modeKeymap)
          p0 <- getA keymapProcessA
          let defKm = defaultKm $ yiConfig $ yi
          let freshP = I.mkAutomaton $ forever $ keymap $ defKm
@@ -203,11 +203,15 @@
             e2 = modifier buffersA (fmap clearUpdates)  e1
         UI.refresh (yiUi yi) e1
         return var {yiEditor = e2}
-    where clearHighlight fb@FBuffer {pendingUpdates = us, highlightSelection = h} 
-              = modifier highlightSelectionA (const (h && null us)) fb
-          -- if there were updates, then hide the selection.
-          clearUpdates fb = modifier pendingUpdatesA (const []) fb
+  where 
+    clearUpdates fb = modifier pendingUpdatesA (const []) fb
+    clearHighlight fb =
+      -- if there were updates, then hide the selection.
+      let h = getter highlightSelectionA fb
+          us = getter pendingUpdatesA fb
+      in modifier highlightSelectionA (const (h && null us)) fb
           
+          
 
 -- | Suspend the program
 suspendEditor :: YiM ()
@@ -251,7 +255,7 @@
 
 -- | Show an error on the status line and log it.
 errorEditor :: String -> YiM ()
-errorEditor s = do msgEditor ("error: " ++ s)
+errorEditor s = do withEditor $ printStatus ("error: " ++ s, errorStyle)
                    logPutStrLn $ "errorEditor: " ++ s
 
 -- | Close the current window.
@@ -334,12 +338,6 @@
       case mec of
           Nothing -> threadDelay (500*1000) >> waitForExit ph
           Just ec -> return (Right ec)
-
-withMode :: (Show x, YiAction a x) => (forall syntax. Mode syntax -> a) -> YiM ()
-withMode f = do
-            b <- withEditor Editor.getBuffer
-            act <- withBufferMode b f
-            runAction $ makeAction $ act
 
 withSyntax :: (Show x, YiAction a x) => (forall syntax. Mode syntax -> syntax -> a) -> YiM ()
 withSyntax f = do
diff --git a/Yi/Editor.hs b/Yi/Editor.hs
--- a/Yi/Editor.hs
+++ b/Yi/Editor.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, StandaloneDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, FlexibleContexts, StandaloneDeriving #-}
 
 -- Copyright (c) 2004-5, Don Stewart - http://www.cse.unsw.edu.au/~dons
 -- Copyright (c) 2007-8, JP Bernardy
@@ -12,11 +12,13 @@
 import Yi.Monad
 import Yi.Dynamic
 import Yi.KillRing
+import Yi.Tag
 import Yi.Window
+import Yi.Window
 import Yi.WindowSet (WindowSet)
 import qualified Yi.WindowSet as WS
 import Yi.Event (Event)
-
+import Yi.Style (StyleName, defaultStyle)
 
 import Prelude (map, filter, (!!), takeWhile, length, reverse, zip)
 import Yi.Prelude
@@ -27,9 +29,13 @@
 import qualified Data.DelayList as DelayList
 import qualified Data.Map as M
 import Data.Typeable
+import System.FilePath (FilePath)
 import Control.Monad.RWS hiding (get, put)
 import qualified Data.ByteString.Lazy.UTF8 as LazyUTF8
 
+type Status = (String,StyleName)
+type Statuses = DelayList.DelayList Status
+
 -- | The Editor state
 data Editor = Editor {
         bufferStack   :: ![BufferRef]               -- ^ Stack of all the buffers. Never empty;
@@ -41,17 +47,32 @@
 
        ,dynamic       :: !(DynamicValues)              -- ^ dynamic components
 
-       ,statusLines   :: !(DelayList.DelayList String)
+       ,statusLines   :: !Statuses
        ,killring      :: !Killring
        ,regex         :: !(Maybe SearchExp) -- ^ most recent regex
+       ,tagsFileList  :: ![FilePath]        -- ^ file path list for  ctags
+       ,tags          :: !(Maybe TagTable)  -- ^ table for ctags
        ,searchDirection :: !Direction
        ,pendingEvents :: ![Event]                   -- ^ Processed events that didn't yield any action yet.
     }
     deriving Typeable
 
 instance Binary Editor where
-    put (Editor bss bs supply ts _dv sl kr _re _dir _ev) = put bss >> put bs >> put supply >> put ts >> put sl >> put kr 
-    get = Editor <$> get <*> get <*> get <*> get <*> pure emptyDV <*> get <*> get <*> pure Nothing <*> pure Forward <*> pure []
+    put (Editor bss bs supply ts _dv _sl kr _re tfl _tt _dir _ev) = put bss >> put bs >> put supply >> put ts >> put kr >> put tfl
+    get = do
+        bss <- get
+        bs <- get
+        supply <- get
+        ts <- get
+        kr <- get
+        tfl <- get
+        return $ emptyEditor {bufferStack = bss,
+                              buffers = bs,
+                              refSupply = supply,
+                              tabs = ts,
+                              killring = kr,
+                              tagsFileList = tfl
+                             }
 
 windows :: Editor -> WindowSet Window
 windows editor =
@@ -79,7 +100,7 @@
 pendingEventsA :: Accessor Editor [Event]
 pendingEventsA = Accessor pendingEvents (\f e -> e {pendingEvents = f (pendingEvents e)})
 
-statusLinesA :: Accessor Editor (DelayList.DelayList String)
+statusLinesA :: Accessor Editor Statuses
 statusLinesA = Accessor statusLines (\f e -> e {statusLines = f (statusLines e)})
 
 
@@ -107,6 +128,12 @@
 regexA :: Accessor Editor (Maybe SearchExp)
 regexA = Accessor regex (\f e -> e{regex = f (regex e)})
 
+tagsA :: Accessor Editor (Maybe TagTable)
+tagsA = Accessor tags (\f e -> e {tags = f (tags e)})
+
+tagsFileListA :: Accessor Editor [FilePath]
+tagsFileListA = Accessor tagsFileList (\f e -> e {tagsFileList = f (tagsFileList e)})
+
 searchDirectionA :: Accessor Editor Direction
 searchDirectionA = Accessor searchDirection (\f e -> e{searchDirection = f (searchDirection e)})
 
@@ -117,11 +144,13 @@
         buffers      = M.singleton (bkey buf) buf
        ,tabs         = WS.new (WS.new win)
        ,bufferStack  = [bkey buf]
-       ,refSupply = 2
+       ,refSupply    = 2
        ,regex        = Nothing
+       ,tags         = Nothing
+       ,tagsFileList = ["tags"]
        ,searchDirection = Forward
        ,dynamic      = M.empty
-       ,statusLines  = DelayList.insert (maxBound, "") []
+       ,statusLines  = DelayList.insert (maxBound, ("", defaultStyle)) []
        ,killring     = krEmpty
        ,pendingEvents = []
        }
@@ -233,9 +262,11 @@
 
 ------------------------------------------------------------------------
 
--- | Perform action with any given buffer
+-- | Perform action with any given buffer, using the last window that was used for that buffer.
 withGivenBuffer0 :: BufferRef -> BufferM a -> EditorM a
-withGivenBuffer0 k f = withGivenBufferAndWindow0 (dummyWindow k) k f
+withGivenBuffer0 k f = do
+    b <- gets (findBufferWith k)
+    withGivenBufferAndWindow0 (lastActiveWindow b) k f
 
 -- | Perform action with any given buffer
 withGivenBufferAndWindow0 :: Window -> BufferRef -> BufferM a -> EditorM a
@@ -273,27 +304,35 @@
   b <- gets $ findBufferWith k
   insertBuffer b -- a bit of a hack.
 
---------------
+-----------------------
+-- Handling of status
 
 -- | Display a transient message
 printMsg :: String -> EditorM ()
-printMsg = setTmpStatus 1
+printMsg s = printStatus (s, defaultStyle)
 
+printStatus :: Status -> EditorM ()
+printStatus = setTmpStatus 1
+
 -- | Set the "background" status line 
-setStatus :: String -> EditorM ()
+setStatus :: Status -> EditorM ()
 setStatus = setTmpStatus maxBound
 
 -- | Clear the status line
-msgClr :: EditorM ()
-msgClr = setStatus ""
+clrStatus :: EditorM ()
+clrStatus = setStatus ("", defaultStyle)
 
 statusLine :: Editor -> String
-statusLine = snd . head . statusLines
+statusLine = fst . statusLineInfo
 
-setTmpStatus :: Int -> String -> EditorM ()
-setTmpStatus delay s = do
+statusLineInfo :: Editor -> Status
+statusLineInfo = snd . head . statusLines
+
+
+setTmpStatus :: Int -> Status -> EditorM ()
+setTmpStatus delay (s,sty) = do
   modifyA statusLinesA $ DelayList.insert (delay, 
-                                           takeWhile (/= '\n') s)
+                                           (takeWhile (/= '\n') s,sty))
   -- also show in the messages buffer, so we don't loose any message
   bs <- gets $ findBufferWithName "*messages*"
   b <- case bs of
@@ -303,7 +342,7 @@
 
 
 -- ---------------------------------------------------------------------
--- Register interface to killring.
+-- kill-register (vim-style) interface to killring.
 
 -- | Put string into yank register
 setRegE :: String -> EditorM ()
@@ -314,6 +353,23 @@
 getRegE = getsA killringA krGet
 
 -- ---------------------------------------------------------------------
+-- Direct access interface to TagTable.
+
+-- | Set a new TagTable
+setTags :: TagTable -> EditorM ()
+setTags = setA tagsA . Just
+
+-- | Reset the TagTable
+resetTags :: EditorM ()
+resetTags = setA tagsA Nothing
+
+-- | Get the currently registered tag table
+getTags :: EditorM (Maybe TagTable)
+getTags = getA tagsA
+
+
+
+-- ---------------------------------------------------------------------
 -- | Dynamically-extensible state components.
 --
 -- These hooks are used by keymaps to store values that result from
@@ -421,6 +477,11 @@
 findWindowWith k e =
     head $ concatMap (\win -> if (wkey win == k) then [win] else []) $ windows e
 
+windowsOnBufferE :: BufferRef -> EditorM [Window]
+windowsOnBufferE k = do
+  e <- gets id
+  return $ concatMap (concatMap (\win -> if (bufkey win == k) then [win] else [])) (tabs e)
+
 -- | Split the current window, opening a second window onto current buffer.
 -- TODO: unfold newWindowE here?
 splitE :: EditorM ()
@@ -478,9 +539,10 @@
 -- | 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 () -> m ()
+withOtherWindow :: MonadEditor m => m a -> m a
 withOtherWindow f = do
   shiftOtherWindow
-  f
+  x <- f
   liftEditor prevWinE
+  return x
 
diff --git a/Yi/Eval.hs b/Yi/Eval.hs
--- a/Yi/Eval.hs
+++ b/Yi/Eval.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternSignatures #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 module Yi.Eval (
         -- * Eval\/Interpretation
@@ -83,6 +83,7 @@
         mkAct = [
                  toDyn (makeAction :: BufferM () -> Action),
                  toDyn (makeAction :: BufferM Bool -> Action),
+                 toDyn (makeAction :: BufferM Char -> Action),
                  toDyn (makeAction :: BufferM Int -> Action),
                  toDyn (makeAction :: BufferM String -> Action),
                  toDyn (makeAction :: BufferM Region -> Action),
@@ -98,6 +99,9 @@
                  toDyn (makeAction :: YiM BufferRef -> Action),
 
                  toDyn (makeAction :: (String -> YiM ()) -> Action),
+
+                 toDyn (makeAction :: (String -> String -> BufferM ()) -> Action),
+                 toDyn (makeAction :: (Char -> BufferM ()) -> Action),
 
                  toDyn (makeAction :: (BufferRef -> EditorM ()) -> Action)
 
diff --git a/Yi/Event.hs b/Yi/Event.hs
--- a/Yi/Event.hs
+++ b/Yi/Event.hs
@@ -12,7 +12,7 @@
 import Data.Monoid
 import Yi.Debug
 
-data Modifier = MShift | MCtrl | MMeta
+data Modifier = MShift | MCtrl | MMeta | MSuper
                 deriving (Show,Eq,Ord)
 
 data Key = KEsc | KFun Int | KPrtScr | KPause | KASCII Char | KBS | KIns
diff --git a/Yi/File.hs b/Yi/File.hs
--- a/Yi/File.hs
+++ b/Yi/File.hs
@@ -1,6 +1,7 @@
 module Yi.File 
  (
   -- * File-based actions
+  viWrite, viWriteTo,
   fwriteE,        -- :: YiM ()
   fwriteBufferE,  -- :: BufferM ()
   fwriteAllE,     -- :: YiM ()
@@ -37,6 +38,27 @@
                                 msgEditor "Can't revert, no file associated with buffer."
                                 return ()
 
+-- | Try to write a file in the manner of vi\/vim
+-- Need to catch any exception to avoid losing bindings
+viWrite :: YiM ()
+viWrite = do
+    mf <- withBuffer $ getA fileA
+    case mf of
+        Nothing -> errorEditor "no file name associate with buffer"
+        Just f  -> do
+            bufInfo <- withBuffer bufInfoB
+            let s   = bufInfoFileName bufInfo
+            fwriteE
+            msgEditor $ show f ++ " " ++ show s ++ " written"
+
+-- | Try to write to a named file in the manner of vi\/vim
+viWriteTo :: String -> YiM ()
+viWriteTo f = do
+    bufInfo <- withBuffer bufInfoB
+    let s   = bufInfoFileName bufInfo
+    fwriteToE f
+    msgEditor $ show f++" "++show s ++ " written"
+
 -- | Write current buffer to disk, if this buffer is associated with a file
 fwriteE :: YiM ()
 fwriteE = fwriteBufferE =<< withEditor getBuffer
@@ -66,8 +88,8 @@
 -- | Write all open buffers
 fwriteAllE :: YiM ()
 fwriteAllE = 
-  do buffers <- withEditor getBuffers
-     let modifiedBuffers = filter (not . isUnchangedBuffer) buffers
+  do allBuffs <- withEditor getBuffers
+     let modifiedBuffers = filter (not . isUnchangedBuffer) allBuffs
      mapM_ fwriteBufferE (fmap bkey modifiedBuffers)
 
 -- | Make a backup copy of file
diff --git a/Yi/History.hs b/Yi/History.hs
--- a/Yi/History.hs
+++ b/Yi/History.hs
@@ -1,4 +1,4 @@
-{-# LANGUAGE PatternSignatures, DeriveDataTypeable #-}
+{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable #-}
 
 -- Copyright (c) 2005,2007,2008 Jean-Philippe Bernardy
 
diff --git a/Yi/IReader.hs b/Yi/IReader.hs
new file mode 100644
--- /dev/null
+++ b/Yi/IReader.hs
@@ -0,0 +1,100 @@
+module Yi.IReader where
+
+import Control.Monad.State
+import Data.List
+import System.Directory (getHomeDirectory)
+
+import Yi.Keymap
+import Yi.Prelude
+import Yi.Buffer.Misc
+import Yi.Buffer.Region
+import Yi.Buffer.Normal
+import Yi.Buffer.HighLevel
+import qualified System.IO as IO
+
+
+type Article = String
+type ArticleDB = [String]
+
+-- | Get the first article in the list. We use the list to express relative priority;
+-- the first is the most, the last least. We then just cycle through - everybody gets equal time.
+getLatestArticle :: ArticleDB -> Article
+getLatestArticle [] = ""
+getLatestArticle adb = head adb
+
+-- | We remove the old first article, and we stick it on the end of the
+-- list using the presumably modified version.
+updateSetLast :: ArticleDB -> Article -> ArticleDB
+updateSetLast [] a = [a]
+updateSetLast (_:bs) a = bs ++ [a]
+
+-- | Insert a new article with top priority (that is, at the front of the list).
+insertArticle :: ArticleDB -> Article -> ArticleDB
+insertArticle = flip (:)
+
+-- | Delete the first
+deleteArticle :: ArticleDB -> Article -> ArticleDB
+deleteArticle = flip delete
+
+writeDB :: ArticleDB -> YiM ()
+writeDB adb = io $ join $ liftM (flip writeFile $ show adb) $ dbLocation
+
+readDB :: YiM ArticleDB
+readDB = io $ rddb `catch` (\_ -> return (return []))
+         where rddb = do db <- liftM readfile $ dbLocation
+                         liftM read db
+               -- We need these for strict IO
+               readfile :: FilePath -> IO String
+               readfile f =  IO.openFile f IO.ReadMode >>= hGetContents
+               hGetContents :: IO.Handle -> IO.IO String
+               hGetContents h  = IO.hGetContents h >>= \s -> length s `seq` return s
+
+dbLocation :: IO FilePath
+dbLocation = getHomeDirectory >>= \home -> return (home ++ "/.yi/articles.db")
+
+-- | Returns the database as it exists on the disk, and the current Yi buffer contents.
+oldDbNewArticle :: YiM (ArticleDB, Article)
+oldDbNewArticle = do olddb <- readDB
+                     newarticle <- withBuffer getBufferContents
+                     return (olddb, newarticle)
+
+getBufferContents :: BufferM String
+getBufferContents = readRegionB =<< regionOfB Document
+
+-- | Given an 'ArticleDB', dump the scheduled article into the buffer (replacing previous contents).
+setDisplayedArticle :: ArticleDB -> YiM ()
+setDisplayedArticle newdb = do let nextarticle = getLatestArticle newdb
+                               withBuffer (replaceBufferContent nextarticle)
+                               withBuffer topB -- replaceBufferContents moves us
+                                               -- to bottom?
+
+-- | Go to next one. This ignores the buffer, but it doesn't remove anything from the database.
+-- The ordering does change, however.
+nextArticle :: YiM ()
+nextArticle = do (oldb,_) <- oldDbNewArticle
+                 -- Ignore buffer, just set the first article last
+                 let newdb = updateSetLast oldb (getLatestArticle oldb)
+                 setDisplayedArticle newdb
+                 writeDB newdb
+
+-- | Delete current article (the article as in the database), and go to next one.
+deleteAndNextArticle :: YiM ()
+deleteAndNextArticle = do ((_:ndb),_) <- oldDbNewArticle -- throw away changes, drop head
+                          setDisplayedArticle ndb
+                          writeDB 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 :: YiM ()
+saveAndNextArticle = do (oldb,newa) <- oldDbNewArticle
+                        let newdb = updateSetLast oldb newa
+                        setDisplayedArticle newdb
+                        writeDB 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,newa) <- oldDbNewArticle
+                      let newdb = insertArticle oldb newa
+                      writeDB newdb
diff --git a/Yi/IncrementalParse.hs b/Yi/IncrementalParse.hs
--- a/Yi/IncrementalParse.hs
+++ b/Yi/IncrementalParse.hs
@@ -1,293 +1,237 @@
-{-# LANGUAGE EmptyDataDecls, ScopedTypeVariables #-}
 -- Copyright (c) JP Bernardy 2008
-module Yi.IncrementalParse (Process, Void, 
-                            recoverWith, symbol, eof, runPolish,
+{-# OPTIONS -fglasgow-exts #-}
+module Yi.IncrementalParse (Process, 
+                            recoverWith, symbol, eof, lookNext, testNext, runPolish, 
+                            runP, profile, pushSyms, pushEof, evalR,
                             P, AlexState (..), scanner) where
 import Yi.Lexer.Alex (AlexState (..))
 import Yi.Prelude
-import Prelude ()
+import Prelude (Ordering(..))
 import Yi.Syntax
-import Data.List hiding (map)
+import Data.List hiding (map, minimumBy)
 
-{- ----------------------------------------
+data a :< b
 
-- Based on a mix between "Polish Parsers, Step by Step (Hughes and Swierstra)", 
-  and "Parallel Parsing Processes (Claessen)"
-  
-  It's strongly advised to read the papers! :)
 
-- The parser has "online" behaviour.
-
-  This is a big advantage because we don't have to parse the whole file to
-  begin syntax highlight the beginning of it.
-
-- Basic error correction
+type P s a = Parser s a
 
-- Based on Applicative functors.
+-- | Parser specification
+data Parser s a where
+    Pure :: a -> Parser s a
+    Appl :: Parser s (b -> a) -> Parser s b -> Parser s a
 
-  This is not as powerful as Monadic parsers, but easier to work with. This is
-  needed if we want to build the result lazily.
+    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
+    
 
--------------------------------------------}
+-- | 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
+    Fail  ::                                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
 
 
+-- profile !! s = number of Dislikes found to do s Shifts
+data Profile = PSusp | PFail | PRes Int | !Int :> Profile
+    deriving Show
 
-data Void
+mapSucc :: Profile -> Profile
+mapSucc PSusp = PSusp
+mapSucc PFail = PFail
+mapSucc (PRes x) = PRes (succ x) 
+mapSucc (x :> xs) = succ x :> mapSucc xs
 
-type Process s a = Steps s a (Steps s Void Void)
+-- 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.
 
--- | Our parsing processes.
--- To understand the design of this data type it is important to consider the
--- basic design goal: Our parser should return a (partial) result as soon as
--- possible, that is, as soon as only one of all possible parses of an input
--- can succeed.  This also means we want to be able to return partial results.
--- We therefore have to transform our parse tree into a linearized form that
--- allows us to return parts of it as we parse them.  Consider the following
--- data type:
---
--- > data BinTree = Node BinTree BinTree | Leaf Int
--- > ex1 = Node (Leaf 1) (Node (Leaf 2) (Leaf 3))
---
--- Provided we know the arity of each constructor, we can unambiguously
--- represent @ex1@ (without using parentheses to resolve ambiguity) as:
---
--- > Node Leaf 1 Node Leaf 2 Leaf 3
---
--- This is simply a pre-order printing of the tree type and, in this case, is
--- exactly how we defined @ex1@ without all the parentheses.  It would,
--- however, be unnecessarily complicated to keep track of the arity of each
--- constructor, so we use a well-known trick: currying.  Note, that the
--- original definition of @ex1@ is actually a shorter notation for
---
--- > ((Node $ (Leaf $ 1)) $ ((Node $ (Leaf $ 2)) $ (Leaf $ 3)))
---
--- or as a tree
--- 
--- >                      $
--- >        .-------------'----------------------.
--- >        $                                    $
--- >     .--'-------.              .-------------'-------.
--- >   Node         $              $                     $
--- >             .--'-.         .--'-------.          .--'-.
--- >           Leaf   1       Node         $        Leaf   3
--- >                                    .--'-.
--- >                                  Leaf   2
---
--- where @$@ represents function application.  We can print this tree in
--- prefix-order:
---
--- > ($) ($) Node ($) Leaf 1 ($) ($) Node ($) Leaf 2 ($) Leaf 3
---
--- This consists of only two types of nodes -- values and applications -- but
--- we can construct values of any (non-strict) Haskell data type with it.
---
--- Unfortunately, it is a bit tricky to type those kinds of expressions in
--- Haskell.  [XXX: example; develop solution step by step; continuations]
---
--- The parameter @r@ represents the type of the remainder of our expression.
+-- | 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 = rec -- 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 = rec
+    where threshold = dislikeThreshold lk
+          rec = min x y +> better (lk + 1) xs ys
 
--- TODO: Replace 'Doc:' by ^ when haddock supports GADTs
-data Steps s a r where
-    -- These constructors describe the tree of values, as above
-    Val   :: a -> Steps s b r               -> Steps s a (Steps s b r)
-    -- Doc: The process that returns the value of type @a@ which is followed by a parser returning a value of type @b@.
-    App   :: Steps s (b -> a) (Steps s b r) -> Steps s a r
-    -- Doc: Takes a process that returns a function @f@ of type @b -> a@ and is
-    -- followed by a process returning a value @x@ of type @b@.  The resulting
-    -- process will return the result of applying the function @f@ to @x@.
-    Stop  ::                                   Steps s Void Void
- 
-    -- These constructors describe the parser state
-    Shift ::             Steps s a r        -> Steps s a r
-    Done  ::             Steps s a r        -> Steps s a r
-    -- Doc: The parser that signals success.  The argument is the continuation.
-    Fails ::                                   Steps s a r
-    -- Doc: The parser that signals failure.
-    Dislike :: Steps s a r ->                                   Steps s a r
+(+>) :: Int -> (t, Profile) -> (t, Profile)
+x +> ~(ordering, xs) = (ordering, x :> xs)
 
-    Suspend :: ([s] -> Steps s a r) -> Steps s a r
-    -- Doc: A suspension of the parser (this is the part borrowed from
-    -- Parallel Parsing Processes) The parameter to suspend's
-    -- continuation is a whole chunk of text; [] represents the
-    -- end of the input
-   
+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 (Sus _ _) = PSusp
+profile (Best _ pr _ _) = pr
+profile (Sh' _) = error "Sh' should be hidden by Sus"
 
-instance Show (Steps s a r) where
+instance Show (Steps s r) where
     show (Val _ p) = "v" ++ show p
     show (App p) = "*" ++ show p
-    show (Stop) = "1"
+    show (Done) = "1"
     show (Shift p) = ">" ++ show p
-    show (Done p) = "!" ++ show p
+    show (Sh' p) = "'" ++ show p
     show (Dislike p) = "?" ++ show p
-    show (Fails) = "0"
-    show (Suspend _) = "..."
-
--- data F a b where
---     Snoc :: F a b -> (b -> c) -> F a c
---     Nil  :: F a b
--- 
--- data S s a r where
---     S :: F a b -> Steps s a r -> S s a r
+    show (Fail) = "0"
+    show (Sus _ _) = "..."
+    show (Best _ _ p q) = "(" ++ show p ++ ")" ++ show q
 
 
--- | Right-eval a fully defined process (ie. one that has no Suspend)
+-- | Right-eval a fully defined process (ie. one that has no Sus)
 -- Returns value and continuation.
-evalR :: Steps s a r -> (a, r)
+evalR :: Steps s (a :< r) -> (a, Steps s r)
 evalR (Val a r) = (a,r)
 evalR (App s) = let (f, s') = evalR s
                     (x, s'') = evalR s'
                 in (f x, s'')
-evalR Stop = error "evalR: Can't create values of type Void"
 evalR (Shift v) = evalR v
-evalR (Done v)  = evalR v
-evalR (Dislike v) = -- trace "Yuck!" $ 
-                    evalR v
-evalR (Fails) = error "evalR: No parse!"
-evalR (Suspend _) = error "evalR: Not fully evaluated!"
-
+evalR (Dislike v) = 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
 
 -- | Pre-compute a left-prefix of some steps (as far as possible)
-evalL :: Steps s a r -> Steps s a r
+evalL :: Steps s r -> Steps s r
 evalL (Shift p) = evalL p
 evalL (Dislike p) = evalL p
 evalL (Val x r) = Val x (evalL r)
 evalL (App f) = case evalL f of
                   (Val a (Val b r)) -> Val (a b) r
-                  (Val f1 (App (Val f2 r))) -> App (Val (f1 . f2) r)
                   r -> App r
+evalL x@(Best choice _ p q) = case choice of
+    LT -> evalL p
+    GT -> evalL q
+    EQ -> x -- don't know where to go: don't speculate on evaluating either branch.
 evalL x = x
 
-
--- | Push a chunk of symbols or eof in the process. This forces some suspensions.
-push :: Maybe [s] -> Steps s a r -> Steps s a r
-push (Just []) p = p  -- nothing more left to push
-push ss p = case p of
-                  (Suspend f) -> case ss of
-                      Nothing -> f []
-                      Just ss' -> f ss'
-                  (Dislike p') -> Dislike (push ss p')
-                  (Shift p') -> Shift (push ss p')
-                  (Done p') -> Done (push ss p')
-                  (Val x p') -> Val x (push ss p')
-                  (App p') -> App (push ss p')
-                  Stop -> Stop
-                  Fails -> Fails
-
--- | Push some symbols.
-pushSyms :: [s] -> Steps s a r -> Steps s a r
-pushSyms x = push (Just x)
-
--- | Push eof
-pushEof :: Steps s a r -> Steps s a r
-pushEof = push Nothing
-
--- | A parser. (This is actually a parsing process segment)
-newtype P s a = P (forall b r. Steps s b r -> Steps s a (Steps s b r))
-
-instance Functor (P s) where
-    fmap f x = pure f <*> x
-
-instance Applicative (P s) where
-    P f <*> P x = P (App . f . x)
-    pure x = P (Val x)
-
-instance Alternative (P s) where
-    empty = P $ \_fut -> Fails
-    P a <|> P b = P $ \fut -> best (a fut) (b fut)
-
-
-
--- | Advance in the result steps, pushing results in the continuation.
--- (Must return one of: Done, Shift, Fail)
-getProgress :: (Steps s a r -> Steps s b t) -> Steps s a r -> Steps s b t
-getProgress f (Val a s) = getProgress (f . Val a) s
-getProgress f (App s)   = getProgress (f . App) s
--- getProgress f Stop   = f Stop
-getProgress f (Done p)  = Done (f p)
-getProgress f (Shift p) = Shift (f p)
-getProgress f (Dislike p) = Dislike (f p)
-getProgress _ (Fails) = Fails
-getProgress _ Stop = error "getProgress: try to enter void"
-getProgress f (Suspend p) = Suspend (\input -> f (p input))
-
-
-
-best :: Steps x a s -> Steps x a s ->  Steps x a s
---l `best` r | trace ("best: "++show (l,r)) False = undefined
-Suspend f `best` Suspend g = Suspend (\input -> f input `best` g input)
-
-Fails   `best` p       = p
-p `best` Fails         = p
-
-Dislike a `best` b = bestD a b
-a `best` Dislike b = bestD b a
-
-Done a  `best` Done _  = Done a -- error "ambiguous grammar"
-                                -- There are sometimes many ways to fix an error. Pick the 1st one.
-Done a  `best` _       = Done a
-_       `best` Done a  = Done a
-
-Shift v `best` Shift w = Shift (v `best` w)
-
-p       `best` q       = getProgress id p `best` getProgress id q
+instance Functor (Parser s) where
+    fmap f = (pure f <*>)
 
+instance Applicative (Parser s) where
+    (<*>) = Appl
+    pure = Pure
 
--- as best, but lhs is disliked.
-bestD :: Steps x a s -> Steps x a s ->  Steps x a s
+instance Alternative (Parser s) where
+    (<|>) = Disj
+    empty = Empt
 
-Suspend f `bestD` Suspend g = Suspend (\input -> f input `bestD` g input)
+instance Monad (Parser s) where
+    (>>=) = Bind
+    return = pure
 
-Fails   `bestD` p       = p
-p `bestD` Fails         = Dislike p
+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 (Shif p) = \k h -> Sh' $ toQ p k h
 
-a `bestD` Dislike b = Dislike (best a b)  -- back to equilibrium (prefer to do this, hence 1st case)
-Dislike _ `bestD` b = b -- disliked twice: forget it.
+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 = \_fut -> 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 (Shif p) = Sh' . toP p
 
-Done _  `bestD` Done a  = Done a -- we prefer rhs in this case
-Done a  `bestD` _       = Dislike (Done a)
-_       `bestD` Done a  = Done a
+-- | 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
 
-Shift v `bestD` Shift w = Shift (v `bestD` w)
-_       `bestD` Shift w = Shift w -- prefer shifting than keeping a disliked possibility forever
+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)
 
-p       `bestD` q       = getProgress id p `bestD` getProgress id q
+-- | 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')
+                  (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.
 
+-- | Push some symbols.
+pushSyms :: [s] -> Steps s r -> Steps s r
+pushSyms x = feed (Just x)
 
+-- | Push eof
+pushEof :: Steps s r -> Steps s r
+pushEof = feed Nothing
 
-runP :: forall t t1.
-                                    P t t1 -> Steps t t1 (Steps t Void Void)
-runP (P p) = p (Done Stop)
+runP :: forall s a. P s a -> Process s a
+runP p = toP p Done
 
 -- | Run a parser.
 runPolish :: forall s a. P s a -> [s] -> a
 runPolish p input = fst $ evalR $ pushEof $ pushSyms input $ runP p
 
--- | Parse a symbol
-symbol :: (s -> Bool) -> P s s
-symbol f = P $ \fut -> Suspend $ \input ->
-              case input of
-                [] -> Fails -- This is the eof!
-                (s:ss) -> if f s then push (Just ss) (Shift (Val s (fut)))
-                                 else Fails
+testNext :: (Maybe s -> Bool) -> P s ()
+testNext f = Look (if f Nothing then ok else empty) (\s -> 
+   if (f $ Just s) then ok else empty)
+    where ok = pure ()
 
--- | Parse the eof
-eof :: P s ()
-eof = P $ \fut -> Suspend $ \input ->
-              case input of
-                [] -> Val () fut
-                _ -> Fails
+lookNext :: P s (Maybe s)
+lookNext = Look (pure Nothing) (\s -> pure (Just s))
 
+        
+
 -- | 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 :: forall s a. P s a -> P s a
-recoverWith (P p) = P (Dislike . p)
+recoverWith = Yuck
 
 
 ----------------------------------------------------
-
+type Process token result = Steps token (result :< ())
 type State st token result = (st, Process token result)
 
 scanner :: forall st token result. P token result -> Scanner st token -> Scanner (State st token result) result
@@ -307,5 +251,4 @@
         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
-
 
diff --git a/Yi/Interpreter.hs b/Yi/Interpreter.hs
--- a/Yi/Interpreter.hs
+++ b/Yi/Interpreter.hs
@@ -12,7 +12,7 @@
 import Control.Applicative
 import Text.ParserCombinators.Parsec.Token
 import qualified Text.ParserCombinators.Parsec as Parsec
-import Text.ParserCombinators.Parsec (GenParser, chainl1)
+import Text.ParserCombinators.Parsec (chainl1)
 import qualified Data.Map as M
 import Data.Traversable
 import Prelude hiding (mapM)
@@ -72,8 +72,9 @@
 rename env = mapM renameOne
     where
       renameOne (AVar v) = do
-        val <- M.lookup v env
-        return val
+        case M.lookup v env of
+          Just x -> Right x
+          Nothing -> Left $ v ++ " not found in the environment"
       renameOne (AChar x) = box x
       renameOne (AString x) = box x
       renameOne (AInt x) = box x
diff --git a/Yi/Keymap.hs b/Yi/Keymap.hs
--- a/Yi/Keymap.hs
+++ b/Yi/Keymap.hs
@@ -88,9 +88,6 @@
 write :: (I.MonadInteract m Action ev, YiAction a x, Show x) => a -> m ()
 write x = I.write (makeAction x)
 
-withBufferMode :: BufferRef -> (forall syntax. Mode syntax -> a) -> YiM a
-withBufferMode b f = withGivenBuffer b $ withModeB f
-
 --------------------------------
 -- Uninteresting glue code
 
diff --git a/Yi/Keymap/Cua.hs b/Yi/Keymap/Cua.hs
--- a/Yi/Keymap/Cua.hs
+++ b/Yi/Keymap/Cua.hs
@@ -1,24 +1,32 @@
 -- Copyright (c) 2008 Jean-Philippe Bernardy
 
-module Yi.Keymap.Cua (keymap) where
+module Yi.Keymap.Cua (keymap, portableKeymap) where
 
 import Prelude hiding (error)
 import Yi.Core
 import Yi.File
 import Yi.Keymap.Emacs.Utils
 import Yi.Misc
+import Yi.Rectangle
+import Yi.String
 
 keymap :: Keymap
-keymap = selfInsertKeymap <|> move <|> select <|> other
+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) -> Keymap
+portableKeymap cmd = selfInsertKeymap <|> move <|> select <|> rect <|> other cmd
+
 selfInsertKeymap :: Keymap
 selfInsertKeymap = do
   c <- printableChar
   write (withBuffer0 $ replaceSel [c])
 
-setMark :: BufferM ()
-setMark = do
+setMark :: Bool -> BufferM ()
+setMark b = do
   isSet <- getA highlightSelectionA
+  setA rectangleSelectionA b
   when (not isSet) $ do
        setA highlightSelectionA True
        pointB >>= setSelectionMarkPointB
@@ -35,20 +43,46 @@
       when (length s == 1) (adjBlock 1)
       insertN s
 
+deleteSel :: BufferM () -> YiM ()
+deleteSel act = do
+  haveSelection <- withBuffer $ getA highlightSelectionA
+  if haveSelection
+    then withEditor del
+    else withBuffer (adjBlock (-1) >> act)
+
 cut, del, copy, paste :: EditorM ()
 cut = copy >> del
-del = withBuffer0 (deleteRegionB =<< getSelectRegionB)
-copy = setRegE =<< withBuffer0 (readRegionB =<< getSelectRegionB)
-paste = withBuffer0 . replaceSel =<< getRegE
+del = do
+  asRect <- withBuffer0 $ getA rectangleSelectionA
+  if asRect
+    then killRectangle
+    else withBuffer0 $ deleteRegionB =<< getSelectRegionB
+copy = do
+  (setRegE =<<) $ withBuffer0 $ do
+    asRect <- getA rectangleSelectionA
+    if not asRect
+      then readRegionB =<< getSelectRegionB
+      else do
+        (reg, l, r) <- getRectangle
+        unlines' <$> fmap (take (r-l) . drop l) <$> lines' <$> readRegionB reg
+paste = do
+  asRect <- withBuffer0 (getA rectangleSelectionA)
+  if asRect
+    then yankRectangle
+    else withBuffer0 . 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),
- (ctrl (spec KRight)  , moveB Word Forward),
- (ctrl (spec KLeft )  , moveB Word Backward),
+ (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),
@@ -56,28 +90,29 @@
  ]
 
 
-move, select, other :: Keymap
+move, select, rect :: Keymap
+other :: (Event -> Event) -> Keymap
 
-move   = choice [      k ?>>! unsetMark >> a | (k,a) <- moveKeys]
-select = choice [shift k ?>>!   setMark >> a | (k,a) <- moveKeys]
-other = choice [
- spec KBS         ?>>! adjBlock (-1) >> bdeleteB,
- spec KDel        ?>>! do
-   haveSelection <- withBuffer $ getA highlightSelectionA
-   if haveSelection
-       then withEditor del
-       else withBuffer (adjBlock (-1) >> deleteN 1),
- spec KEnter      ?>>! insertB '\n',
- ctrl (char 'q')  ?>>! askQuitEditor,
- ctrl (char 'f')  ?>>  isearchKeymap Forward,
- ctrl (char 'x')  ?>>! cut,
- ctrl (char 'c')  ?>>! copy,
- ctrl (char 'v')  ?>>! paste,
- ctrl (spec KIns) ?>>! copy,
+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 "\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,
- ctrl (char 'z')  ?>>! undoB,
- ctrl (char 'y')  ?>>! redoB,
- ctrl (char 's')  ?>>! fwriteE,
- ctrl (char 'o')  ?>>! findFile
+ cmd (char 'z')   ?>>! undoB,
+ cmd (char 'y')   ?>>! redoB,
+ cmd (char 's')   ?>>! fwriteE,
+ cmd (char 'o')   ?>>! findFile,
+ cmd (char '/')   ?>>! withModeB modeToggleCommentSelection,
+ cmd (char ']')   ?>>! autoIndentB IncreaseOnly,
+ cmd (char '[')   ?>>! autoIndentB DecreaseOnly
  ]
 
diff --git a/Yi/Keymap/Emacs.hs b/Yi/Keymap/Emacs.hs
--- a/Yi/Keymap/Emacs.hs
+++ b/Yi/Keymap/Emacs.hs
@@ -20,6 +20,7 @@
   , evalRegionE
   , executeExtendedCommandE
   , findFile
+  , promptFile
   , insertNextC
   , isearchKeymap
   , killBufferE
@@ -29,9 +30,9 @@
   , scrollUpE
   , cabalConfigureE
   , switchBufferE
-  , withMinibuffer
   , askSaveEditor
   , argToInt
+  , promptTag
   )
 import Data.Maybe
 import Data.Char
@@ -131,6 +132,8 @@
 
          -- 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 'v'           ?>>! scrollUpE univArg
@@ -150,10 +153,11 @@
          , metaCh 'l'           ?>>! (repeatingArg lowercaseWordB)
          , metaCh 'q'           ?>>! (withSyntax modePrettify)
          , metaCh 'u'           ?>>! (repeatingArg uppercaseWordB)
-         , metaCh 't'           ?>>! (repeatingArg $ transposeB Word Forward)
+         , metaCh 't'           ?>>! (repeatingArg $ transposeB unitWord Forward)
          , metaCh 'w'           ?>>! killRingSaveE
          , metaCh 'x'           ?>>! executeExtendedCommandE
          , metaCh 'y'           ?>>! yankPopE
+         , metaCh '.'           ?>>! promptTag
 
          -- Other meta key-bindings
          , meta (spec KBS)      ?>>! (repeatingArg bkillWordB)
@@ -170,6 +174,7 @@
   withIntArg :: YiAction (m ()) () => (Int -> m ()) -> YiM ()
   withIntArg cmd = withUnivArg $ \arg -> cmd (fromMaybe 1 arg)
 
+  ctrlC = choice [ ctrlCh 'c' ?>>! withModeB modeToggleCommentSelection ]
 
 
   rectangleFuntions = choice [char 'o' ?>>! openRectangle,
@@ -188,10 +193,7 @@
                  , ctrlCh 'c'    ?>>! askQuitEditor
                  , ctrlCh 'f'    ?>>! findFile
                  , ctrlCh 's'    ?>>! fwriteE
-                 , ctrlCh 'w'    ?>>! (withMinibuffer "Write file:"
-                                           (matchingFileNames Nothing)
-                                           fwriteToE
-                                      )
+                 , ctrlCh 'w'    ?>>! promptFile "Write file:" fwriteToE
                  , ctrlCh 'x'    ?>>! (exchangePointAndMarkB >> 
                                        setA highlightSelectionA True)
                  , char 'b'      ?>>! switchBufferE
diff --git a/Yi/Keymap/Emacs/KillRing.hs b/Yi/Keymap/Emacs/KillRing.hs
--- a/Yi/Keymap/Emacs/KillRing.hs
+++ b/Yi/Keymap/Emacs/KillRing.hs
@@ -43,9 +43,9 @@
 -- | M-w
 killRingSaveE :: EditorM ()
 killRingSaveE = do (r, text) <- withBuffer0 $ do
-                            setA highlightSelectionA False
                             r <- getSelectRegionB
                             text <- readRegionB r
+                            setA highlightSelectionA False
                             return (r,text)
                    killringPut (regionDirection r) text
 -- | M-y
@@ -54,7 +54,7 @@
 yankPopE :: EditorM ()
 yankPopE = do 
   kr <- getA killringA
-  withBuffer0 (deleteRegionB =<< getSelectRegionB)
+  withBuffer0 (deleteRegionB =<< getRawestSelectRegionB)
   setA killringA $ let ring = krContents kr
                    in kr {krContents = tail ring ++ [head ring]}
   yankE
diff --git a/Yi/Keymap/Emacs/Utils.hs b/Yi/Keymap/Emacs/Utils.hs
--- a/Yi/Keymap/Emacs/Utils.hs
+++ b/Yi/Keymap/Emacs/Utils.hs
@@ -29,15 +29,18 @@
   , killBufferE
   , insertNextC
   , findFile
+  , promptFile
+  , promptTag
   )
 where
 
 {- Standard Library Module Imports -}
 
-import Prelude ()
+import Prelude (take)
 import Data.List ((\\))
+import Data.Maybe (maybe)
 import System.FriendlyPath
-import System.FilePath (addTrailingPathSeparator)
+import System.FilePath (addTrailingPathSeparator, takeDirectory, takeFileName, (</>))
 import System.Directory
   ( doesDirectoryExist
   )
@@ -54,6 +57,7 @@
 import Yi.MiniBuffer
 import Yi.Misc
 import Yi.Regex
+import Yi.Tag
 import Yi.Search
 import Yi.Window
 {- End of Module Imports -}
@@ -162,8 +166,8 @@
                ]
 
 isearchKeymap :: Direction -> Keymap
-isearchKeymap direction = 
-  do write $ isearchInitE direction
+isearchKeymap dir = 
+  do write $ isearchInitE dir
      many searchKeymap
      choice [ ctrl (char 'g') ?>>! isearchCancelE
             , oneOf [ctrl (char 'm'), spec KEnter] >>! isearchFinishE
@@ -183,7 +187,7 @@
                             oneOf [char 'y', char ' '] >>! qrReplaceOne win b re replaceWith,
                             oneOf [char 'q', ctrl (char 'g')] >>! qrFinish
                            ]
-        Just re = makeSearchOptsM [] replaceWhat
+        Right re = makeSearchOptsM [] replaceWhat
     withEditor $ do
        setRegexE re
        spawnMinibufferE
@@ -235,15 +239,20 @@
            Just <$> ((ctrlCh 'u' ?>> (read <$> some (digit id) <|> pure 4))
            <|> (read <$> (some tt)))
            <|> pure Nothing
-           
 
+-- | Generic emacs prompt file action. Takes a @prompt and a continuation @act
+--   and prompts the user with file hints
+promptFile :: String -> (String -> YiM ()) -> YiM ()
+promptFile prompt act = do maybePath <- withBuffer $ getA fileA
+                           startPath <- addTrailingPathSeparator <$> (liftIO $ canonicalizePath' =<< getFolder maybePath)
+                           -- TODO: Just call withMinibuffer
+                           withMinibufferGen startPath (findFileHint startPath) prompt (simpleComplete $ matchingFileNames (Just startPath)) act
+
+
 -- | Open a file using the minibuffer. We have to set up some stuff to allow hints
 --   and auto-completion.
 findFile :: YiM ()
-findFile = do maybePath <- withBuffer $ getA fileA
-              startPath <- addTrailingPathSeparator <$> (liftIO $ canonicalizePath' =<< getFolder maybePath)
-              -- TODO: Just call withMinibuffer
-              withMinibufferGen startPath (findFileHint startPath) "find file:" (simpleComplete $ matchingFileNames (Just startPath)) $ \filename -> do
+findFile = promptFile "find file:" $ \filename -> do
                 msgEditor $ "loading " ++ filename
                 fnewE filename
 
@@ -286,3 +295,59 @@
 
 killBufferE :: YiM ()
 killBufferE = withMinibuffer "kill buffer:" matchingBufferNames $ askCloseBuffer
+
+-- | 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
+
+--------------------------------------------------
+-- 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 <- withBuffer $ readUnitB unitWord
+  -- if we have tags use them to generate hints
+  tagTable <- withEditor getTags
+  -- Hints are expensive - only lazily generate 10
+  let hinter =  return . show . take 10 . maybe fail hintTags tagTable
+  -- Completions are super-cheap. Go wild
+  let completer =  return . maybe id completeTag tagTable
+  withMinibufferGen "" hinter ("Find tag: (default " ++ defaultTag ++ ")") completer  $
+                 -- if the string is "" use the defaultTag
+                 gotoTag . maybeList 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
+          Nothing -> fail $ "No tags containing " ++ tag
+          Just (filename, line) -> do
+            fnewE $ filename
+            withBuffer $ gotoLn line
+            return ()
+
+-- | 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 filename = maybeList "tags" $ takeFileName path
+                       tagTable <- io $ importTagTable $
+                                           takeDirectory path </> filename
+                       withEditor $ setTags tagTable
+                       act tagTable
+
+resetTagTable :: YiM ()
+resetTagTable = withEditor resetTags
diff --git a/Yi/Keymap/Keys.hs b/Yi/Keymap/Keys.hs
--- a/Yi/Keymap/Keys.hs
+++ b/Yi/Keymap/Keys.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 -- Copyright (c) 2008 Jean-Philippe Bernardy
 
 -- | Combinators for building keymaps.
@@ -6,7 +7,7 @@
     (
      module Yi.Event,
      module Yi.Interact,
-     printableChar, charOf, shift, meta, ctrl, spec, char, (>>!), (?>>), (?>>!),
+     printableChar, charOf, shift, meta, ctrl, super, spec, char, (>>!), (?>>), (?>>!),
      ctrlCh, metaCh,
      pString
     ) where
@@ -35,7 +36,7 @@
     do Event (KASCII c) [] <- eventBetween (modifier $ char l) (modifier $ char h)
        return c
 
-shift,ctrl,meta :: Event -> Event
+shift,ctrl,meta,super :: 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)
@@ -43,6 +44,8 @@
 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)
 
 char :: Char -> Event
 char '\t' = Event KTab []
diff --git a/Yi/Keymap/Vim.hs b/Yi/Keymap/Vim.hs
--- a/Yi/Keymap/Vim.hs
+++ b/Yi/Keymap/Vim.hs
@@ -8,17 +8,18 @@
                       viWrite, 
                       defKeymap, 
                       ModeMap(..),
-                      mkKeymap) where
+                      mkKeymap,
+                      beginIns) where
 
 import Prelude (maybe, length, filter, map, drop, break, uncurry)
 
 import Data.Char
-import Data.List (sort, nub, take)
+import Data.List (nub, take, words)
 import Data.Prototype
 import Numeric (showHex, showOct)
 import System.IO (readFile)
+import System.Posix.Files (fileExist)
 
-import Control.Exception    ( ioErrors, try, evaluate )
 import Control.Monad.State hiding (mapM_, mapM)
 
 import {-# source #-} Yi.Boot
@@ -27,29 +28,38 @@
 import Yi.Eval (execEditorAction)
 import Yi.File
 import Yi.History
-import Yi.Misc (matchingFileNames,adjBlock,adjIndent)
-import Yi.String (dropSpace)
+import Yi.Misc (matchingFileNames,adjBlock,adjIndent,cabalRun)
+import Yi.String (dropSpace,split)
 import Yi.MiniBuffer
 import Yi.Search
+import Yi.Style
 import Yi.TextCompletion
+import Yi.Tag (Tag,TagTable,lookupTag,importTagTable)
+import Yi.Window (bufkey)
 
 
 --
 -- What's missing?
---   fancier :s//
+--   ESC should leave from the visual mode
+--   fancier :s// ==> missing /c, ...
 --   '.'
+--   @:
+--   g8
+--   8g8
+--   :sh[ell]
+--   :!!
 --   movement parameterised \> \<
+--   motion operators [motion.txt]: !, =, >, <
+--   C-y in input mode
+--   C-v: visual block mode
+--   Support for marks
+--   C-o and C-i
 --
 
 -- ---------------------------------------------------------------------
 
 type VimMode = Keymap
 
-data RegionStyle = LineWise
-                 | Inclusive
-                 | Exclusive
-  deriving (Eq, Typeable, Show)
-
 data ViMove = Move TextUnit Direction
             | MaybeMove TextUnit Direction
             | GenMove TextUnit (Direction, BoundarySide) Direction
@@ -89,22 +99,15 @@
      -- | Top level consists of simple commands that take a count arg,
      -- the replace cmd, which consumes one char of input, and commands
      -- that switch modes.
-     def_top_level = choice [cmd_eval,cmd_move,cmd2other,cmd_op]
-
-     -- | Leave a mode. This always has priority over catch-all actions inside the mode.
-     leave :: VimMode
-     leave = oneOf [spec KEsc, ctrl $ char 'c'] >> adjustPriority (-1) >> (write msgClr)
-
-     -- | Insert mode is either insertion actions, or the meta (\ESC) action
-     ins_mode :: VimMode
-     ins_mode = write (setStatus "-- INSERT --") >> many (ins_char <|> kwd_mode) >> leave
-
-     beginIns :: (Show x, YiAction a x) => a -> I Event Action ()
-     beginIns a = write a >> ins_mode
+     def_top_level = do write clrStatus
+                        -- if the keymap "crashed" we restart here
+                        -- so we clear the status line to indicate whatever mode we were in
+                        -- has been left
+                        choice [cmd_eval,cmd_move,cmd2other,cmd_op]
 
      -- | Replace mode is like insert, except it performs writes, not inserts
      rep_mode :: VimMode
-     rep_mode = write (setStatus "-- REPLACE --") >> many rep_char >> leave
+     rep_mode = write (setStatus ("-- REPLACE --", defaultStyle)) >> many rep_char >> leave
 
      -- | Reset the selection style to a character-wise mode 'SelectionStyle Character'.
      resetSelectStyle :: BufferM ()
@@ -115,12 +118,12 @@
      vis_mode selectionStyle = do
        write (setVisibleSelection True >> pointB >>= setSelectionMarkPointB)
        core_vis_mode selectionStyle
-       write (msgClr >> withBuffer0 (setVisibleSelection False) >> withBuffer0 resetSelectStyle)
+       write (clrStatus >> withBuffer0 (setVisibleSelection False) >> withBuffer0 resetSelectStyle)
 
      core_vis_mode :: SelectionStyle -> VimMode
      core_vis_mode selectionStyle = do
        write $ do withBuffer0 $ setDynamicB $ selectionStyle
-                  setStatus $ msg selectionStyle
+                  setStatus $ (msg selectionStyle, defaultStyle)
        many (cmd_move <|>
              select_any_unit (withBuffer0 . (\r -> resetSelectStyle >> extendSelectRegionB r >> leftB)))
        (vis_single selectionStyle <|| vis_multi)
@@ -207,10 +210,10 @@
          ,(char '|',        \i -> SeqMove viMoveToSol (Replicate (CharMove Forward) (i-1)))
 
           -- words
-         ,(char 'w',       Replicate $ GenMove ViWord (Backward,InsideBound) Forward)
-         ,(char 'W',       Replicate $ GenMove ViWORD (Backward,InsideBound) Forward)
-         ,(char 'b',       Replicate $ Move ViWord Backward)
-         ,(char 'B',       Replicate $ Move ViWORD Backward)
+         ,(char 'w',       Replicate $ GenMove unitViWord (Backward,InsideBound) Forward)
+         ,(char 'W',       Replicate $ GenMove unitViWORD (Backward,InsideBound) Forward)
+         ,(char 'b',       Replicate $ Move unitViWord Backward)
+         ,(char 'B',       Replicate $ Move unitViWORD Backward)
           -- text
          ,(char '{',       Replicate $ Move unitEmacsParagraph Backward)
          ,(char '}',       Replicate $ Move unitEmacsParagraph Forward)
@@ -238,23 +241,23 @@
          [(char '$',  eol)
          ,(spec KEnd, eol)
           -- words
-         ,(char 'e',     Replicate $ GenMove ViWord (Forward, InsideBound) Forward)
-         ,(char 'E',     Replicate $ GenMove ViWORD (Forward, InsideBound) Forward)]
+         ,(char 'e',     Replicate $ GenMove unitViWord (Forward, InsideBound) Forward)
+         ,(char 'E',     Replicate $ GenMove unitViWORD (Forward, InsideBound) Forward)]
          where
              eol   = Replicate $ viMoveToEol
 
      -- | movement *multi-chars* commands (with inclusive cut/yank semantics)
      moveCmdS_inclusive :: [(String, (Int -> ViMove))]
      moveCmdS_inclusive =
-         [("ge", Replicate $ GenMove ViWord (Forward, InsideBound) Backward)
-         ,("gE", Replicate $ GenMove ViWORD (Forward, InsideBound) Backward)
+         [("ge", Replicate $ GenMove unitViWord (Forward, InsideBound) Backward)
+         ,("gE", Replicate $ GenMove unitViWORD (Forward, InsideBound) Backward)
          ,("g_", const $ ArbMove lastNonSpaceB)]
 
      regionOfViMove :: ViMove -> RegionStyle -> BufferM Region
      regionOfViMove move regionStyle =
-       join $ regionFromTo <$> pointB
-                           <*> (savingPointB (viMove move >> pointB))
-                           <*> pure regionStyle
+       join $ mkRegionOfStyleB <$> pointB
+                               <*> (savingPointB (viMove move >> pointB))
+                               <*> pure regionStyle
 
      viMove :: ViMove -> BufferM ()
      viMove NoMove                        = return ()
@@ -317,18 +320,48 @@
         choice $
           [c ?>>! action i | (c,action) <- singleCmdFM ] ++
           [events evs >>! action i | (evs, action) <- multiCmdFM ] ++
-          [char 'r' ?>> textChar >>= write . writeN . replicate i
+          [char 'r' ?>> textChar >>= write . savingPointB . writeN . replicate i
           ,pString "gt" >>! nextTabE
           ,pString "gT" >>! previousTabE]
 
 
-     -- TODO: escape the current word
-     --       at word bounds: search for \<word\>
+     -- TODO: add word bounds: search for \<word\>
      searchCurrentWord :: Direction -> EditorM ()
      searchCurrentWord dir = do
-       w <- withBuffer0 $ readRegionB =<< regionOfNonEmptyB ViWord
-       viSearch w [] dir
+       w <- withBuffer0 $ readRegionB =<< regionOfNonEmptyB unitViWord
+       viSearch w [QuoteRegex] dir
 
+     gotoTag :: Tag -> YiM ()
+     gotoTag tag =
+       visitTagTable $ \tagTable ->
+         case lookupTag tag tagTable of
+           Nothing -> fail $ "No tags containing " ++ tag
+           Just (filename, line) -> do
+             fnewE $ filename
+             withBuffer $ gotoLn line
+             return ()
+
+     -- | 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 -> do fps <- withEditor $ getA tagsFileListA -- withBuffer0 $ tagsFileList <$> getDynamicB
+                       efps <- io $ filterM fileExist fps
+                       when (null efps) $ fail ("No existing tags file among: " ++ show fps)
+                       tagTable <- io $ importTagTable (head efps)
+                       withEditor $ setTags tagTable
+                       act tagTable
+
+     gotoTagCurrentWord :: YiM ()
+     gotoTagCurrentWord = gotoTag =<< withEditor (withBuffer0 (readRegionB =<< regionOfNonEmptyB unitViWord))
+
+     setTagsFileList :: String -> EditorM ()
+     setTagsFileList fps = resetTags >> setA tagsFileListA (split "," fps)
+
      -- | Parse any character that can be inserted in the text.
      textChar :: KeymapM Char
      textChar = do
@@ -339,7 +372,7 @@
      continueSearching fdir = do
        m <- getRegexE
        dir <- fdir <$> getA searchDirectionA 
-       printMsg $ direction '?' '/' dir : maybe "" fst m
+       printMsg $ directionElim dir '?' '/' : maybe "" fst m
        viSearch "" [] dir
 
      -- | cmd mode commands
@@ -349,15 +382,18 @@
      singleCmdFM =
          [(ctrl $ char 'b',    withBuffer . upScreensB)             -- vim does (firstNonSpaceB;moveXorSol)
          ,(ctrl $ char 'f',    withBuffer . downScreensB)
+         ,(ctrl $ char 'u',    withBuffer . scrollByB (negate . (`div` 2)))
+         ,(ctrl $ char 'd',    withBuffer . scrollByB (`div` 2))
          ,(ctrl $ char 'g',    const viFileInfo)
          ,(ctrl $ char 'l',    const refreshEditor)
          ,(ctrl $ char 'r',    withBuffer . flip replicateM_ redoB)
          ,(ctrl $ char 'z',    const suspendEditor)
+         ,(ctrl $ char ']',    const gotoTagCurrentWord)
          ,(char 'D',      withEditor . cut Exclusive . (Replicate $ Move Line Forward))
          ,(char 'J',      const (withBuffer (moveToEol >> deleteN 1)))    -- the "\n"
          ,(char 'Y',      \n -> withEditor $ do
                                     let move = Replicate (Move Line Forward) n
-                                    region <- withBuffer0 $ regionOfViMove move Inclusive
+                                    region <- withBuffer0 $ regionOfViMove move LineWise
                                     yankRegion LineWise region
           )
          ,(char 'U',      withBuffer . flip replicateM_ undoB)    -- NB not correct
@@ -463,60 +499,42 @@
                         , (('g':), 'w', const $ withBuffer0 . savingPointB . fillRegion)
                         ]
 
-     char2unit :: [(Char, TextUnit)]
+     -- Argument of the 2nd component is whether the unit is outer.
+     toOuter u True = leftBoundaryUnit u
+     toOuter u False = u
+
+     char2unit :: [(Char, Bool -> TextUnit)]
      char2unit =
-       [('w',  ViWord)
-       ,('W',  ViWORD)
-       ,('p',  unitEmacsParagraph)
-       ,('s',  unitSentence)
-       ,('"',  Delimited '"' '"')
-       ,('`',  Delimited '`' '`')
-       ,('\'', Delimited '\'' '\'')
-       ,('(',  Delimited '(' ')')
-       ,(')',  Delimited '(' ')')
-       ,('b',  Delimited '(' ')')
-       ,('{',  Delimited '{' '}')
-       ,('}',  Delimited '{' '}')
-       ,('B',  Delimited '{' '}')
-       ,('<',  Delimited '<' '>')
-       ,('>',  Delimited '<' '>')
+       [('w',  toOuter unitViWord)
+       ,('W',  toOuter unitViWORD)
+       ,('p',  toOuter unitEmacsParagraph)
+       ,('s',  toOuter unitSentence)
+       ,('"',  unitDelimited '"' '"')
+       ,('`',  unitDelimited '`' '`')
+       ,('\'', unitDelimited '\'' '\'')
+       ,('(',  unitDelimited '(' ')')
+       ,(')',  unitDelimited '(' ')')
+       ,('b',  unitDelimited '(' ')')
+       ,('{',  unitDelimited '{' '}')
+       ,('}',  unitDelimited '{' '}')
+       ,('B',  unitDelimited '{' '}')
+       ,('<',  unitDelimited '<' '>')
+       ,('>',  unitDelimited '<' '>')
        ]
 
-     -- NOTE,TODO: Form some units (like words) one should
-     -- not select more than the current line
-     select_a_unit :: TextUnit -> BufferM Region
-     select_a_unit (Delimited cStart cStop) = savingPointB $ do
-         start <- untilB ((==cStart) <$> readB) leftB >> pointB
-         rightB
-         stop  <- untilB ((==cStop) <$> readB) rightB >> rightB >> pointB
-         return $ mkRegion start stop
-     select_a_unit unit = savingPointB $ do
-         start <- genMaybeMoveB unit (Backward,InsideBound) Backward >> pointB
-         stop  <- genMoveB unit (Backward,InsideBound) Forward >> pointB
-         return $ mkRegion start stop
-
      select_any_unit :: (MonadInteract m Action Event) => (Region -> EditorM ()) -> m ()
-     select_any_unit f =
-       choice [ x
-              | (c, unit) <- char2unit,
-                x <- [ char 'i' ?>> (char c ?>> write (f =<< withBuffer0 (regionOfNonEmptyB unit))), -- inner unit
-                       char 'a' ?>> (char c ?>> write (f =<< withBuffer0 (select_a_unit unit))) ] ]
-
-     regionFromTo :: Point -> Point -> RegionStyle -> BufferM Region
-     regionFromTo 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
+     select_any_unit f = do 
+       outer <- (char 'a' ?>> pure True) <|> (char 'i' ?>> pure False)
+       choice [ char c ?>> write (f =<< withBuffer0 (regionOfNonEmptyB $ unit outer))
+                | (c, unit) <- char2unit]
+               
 
      regionOfSelection :: BufferM (RegionStyle, Region)
      regionOfSelection = do
        regionStyle <- selection2regionStyle <$> getDynamicB
-       region <- join $ regionFromTo <$> getSelectionMarkPointB
-                                     <*> pointB
-                                     <*> pure regionStyle
+       region <- join $ mkRegionOfStyleB <$> getSelectionMarkPointB
+                                         <*> pointB
+                                         <*> pure regionStyle
        return (regionStyle, region)
 
      yankRegion :: RegionStyle -> Region -> EditorM ()
@@ -559,7 +577,7 @@
          selectionStyle <- getDynamicB
          start <- getSelectionMarkPointB
          stop <- pointB
-         region <- regionFromTo start stop $ selection2regionStyle $ selectionStyle
+         region <- mkRegionOfStyleB start stop $ selection2regionStyle $ selectionStyle
          moveTo $ regionStart region
          deleteRegionB region
          insertN txt
@@ -611,7 +629,7 @@
                  char 'x'  ?>>! cutSelection,
                  char 'd'  ?>>! cutSelection,
                  char 'p'  ?>>! pasteOverSelection,
-                 char 'c'  ?>> beginIns (cutSelection >> withBuffer0 (setVisibleSelection False))]
+                 char 'c'  ?>> beginIns self (cutSelection >> withBuffer0 (setVisibleSelection False))]
 
 
      -- | These also switch mode, as all visual commands do, but these are
@@ -650,29 +668,29 @@
                  char 'v'     ?>> vis_mode (SelectionStyle Character),
                  char 'V'     ?>> vis_mode (SelectionStyle Line),
                  char 'R'     ?>> rep_mode,
-                 char 'i'     ?>> ins_mode,
-                 char 'I'     ?>> beginIns moveToSol,
-                 char 'a'     ?>> beginIns $ moveXorEol 1,
-                 char 'A'     ?>> beginIns moveToEol,
-                 char 'o'     ?>> beginIns $ moveToEol >> insertB '\n',
-                 char 'O'     ?>> beginIns $ moveToSol >> insertB '\n' >> lineUp,
+                 char 'i'     ?>> ins_mode self,
+                 char 'I'     ?>> beginIns self firstNonSpaceB,
+                 char 'a'     ?>> beginIns self $ moveXorEol 1,
+                 char 'A'     ?>> beginIns self moveToEol,
+                 char 'o'     ?>> beginIns self $ moveToEol >> insertB '\n',
+                 char 'O'     ?>> beginIns self $ moveToSol >> insertB '\n' >> lineUp,
                  char 'c'     ?>> changeCmds,
-                 char 'C'     ?>> beginIns $ cut Exclusive viMoveToEol, -- alias of "c$"
-                 char 'S'     ?>> beginIns $ withBuffer0 moveToSol >> cut Exclusive viMoveToEol, -- non-linewise alias of "cc"
-                 char 's'     ?>> beginIns $ cut Exclusive (CharMove Forward), -- non-linewise alias of "cl"
+                 char 'C'     ?>> beginIns self $ cut Exclusive viMoveToEol, -- alias of "c$"
+                 char 'S'     ?>> beginIns self $ withBuffer0 moveToSol >> cut Exclusive viMoveToEol, -- non-linewise alias of "cc"
+                 char 's'     ?>> beginIns self $ cut Exclusive (CharMove Forward), -- non-linewise alias of "cl"
                  char '/'     ?>>! ex_mode "/",
                  char '?'     ?>>! ex_mode "?",
                  leave,
-                 spec KIns    ?>> ins_mode]
+                 spec KIns    ?>> ins_mode self]
 
      changeCmds :: I Event Action ()
      changeCmds =
        adjustPriority (-1) >>
-         ((char 'w' ?>> change NoMove Exclusive (GenMove ViWord (Forward, OutsideBound) Forward)) <|>
-          (char 'W' ?>> change NoMove Exclusive (GenMove ViWORD (Forward, OutsideBound) Forward))) <|>
+         ((char 'w' ?>> change NoMove Exclusive (GenMove unitViWord (Forward, OutsideBound) Forward)) <|>
+          (char 'W' ?>> change NoMove Exclusive (GenMove unitViWORD (Forward, OutsideBound) Forward))) <|>
        (char 'c' ?>> change viMoveToSol LineWise viMoveToEol) <|>
        (uncurry (change NoMove) =<< gen_cmd_move) <|>
-       (select_any_unit (cutRegion Exclusive) >> ins_mode) -- this correct while the RegionStyle is not LineWise
+       (select_any_unit (cutRegion Exclusive) >> ins_mode self) -- this correct while the RegionStyle is not LineWise
 
      change :: ViMove -> RegionStyle -> ViMove -> I Event Action ()
      change preMove regionStyle move = do
@@ -680,7 +698,7 @@
          withBuffer0 $ viMove preMove
          cut regionStyle move
          when (regionStyle == LineWise) $ withBuffer0 (insertB '\n' >> leftB)
-       ins_mode
+       ins_mode self
 
      ins_rep_char :: VimMode
      ins_rep_char = choice [spec KPageUp       ?>>! upScreenB,
@@ -694,7 +712,7 @@
                             spec KDel          ?>>! (adjBlock (-1) >> deleteB Character Forward),
                             spec KEnter        ?>>! insertB '\n',
                             spec KTab          ?>>! insertTabB,
-                            (ctrl $ char 'w')  ?>>! cut Exclusive (GenMove ViWord (Backward,InsideBound) Backward)]
+                            (ctrl $ char 'w')  ?>>! cut Exclusive (GenMove unitViWord (Backward,InsideBound) Backward)]
 
      --
      -- Some ideas for a better insert mode are contained in:
@@ -705,18 +723,9 @@
      -- which suggest that movement commands be added to insert mode, along
      -- with delete.
      --
-     ins_char :: VimMode
-     ins_char = v_ins_char self
      def_ins_char = (spec KBS ?>>! adjBlock (-1) >> deleteB Character Backward)
-                <|> ins_rep_char
-                <|| (textChar >>= write . (adjBlock 1 >>) . insertB)
-
-     -- --------------------
-     -- | Keyword
-     kwd_mode :: VimMode
-     kwd_mode = some ((ctrl $ char 'n') ?>> (write wordComplete)) >> deprioritize >> (write resetComplete)
-                -- 'adjustPriority' is there to lift the ambiguity between "continuing" completion
-                -- and resetting it (restarting at the 1st completion).
+            <|> ins_rep_char
+            <|| (textChar >>= write . (adjBlock 1 >>) . insertB)
 
      -- ---------------------------------------------------------------------
      -- | vim replace mode
@@ -770,9 +779,16 @@
            ex_complete ('b':'d':'!':' ':f)                     = b_complete f
            ex_complete ('b':'d':'e':'l':'e':'t':'e':' ':f)     = b_complete f
            ex_complete ('b':'d':'e':'l':'e':'t':'e':'!':' ':f) = b_complete f
+           ex_complete ('c':'a':'b':'a':'l':' ':s)             = cabalComplete s
            ex_complete ('y':'i':' ':s)                         = exSimpleComplete (\_->getAllNamesInScope) s
-           ex_complete _                                       = return ""
+           ex_complete s                                       = catchAllComplete s
 
+           catchAllComplete = exSimpleComplete $ const $ return $ map (++ " ") $ words
+                                "e edit r read tabe b buffer bd bd! bdelete bdelete! yi cabal"
+           cabalComplete = exSimpleComplete $ const $ return $ cabalCmds
+           cabalCmds = words "configure install list update upgrade fetch upload check sdist" ++
+                       words "report build copy haddock clean hscolour register test help"
+
        historyStart
        spawnMinibufferE prompt (const $ ex_process)
        return ()
@@ -808,46 +824,80 @@
                [] -> return ()
 
          where
-           isWorthlessB = gets (\b -> isUnchangedBuffer b || file b == Nothing)
+           {- safeQuitWindow implements the commands in vim equivalent to :q.
+            - Closes the current window unless the current window is the last window on a 
+            - modified buffer that is not considered "worthless".
+            -}
+           safeQuitWindow = do
+               nw <- withBuffer needsAWindowB
+               ws <- withEditor $ getA currentWindowA >>= windowsOnBufferE . bufkey
+               if 1 == length ws && nw 
+                 then errorEditor "No write since last change (add ! to override)"
+                 else closeWindow
+           
+           needsAWindowB = do
+             isWorthless <- gets (\b -> file b == Nothing)
+             canClose <- isUnchangedB
+             if isWorthless || canClose then return False else return True
+           
+           {- quitWindow implements the commands in vim equivalent to :q!
+            - Closes the current window regardless of whether the window is on a modified
+            - buffer or not. 
+            - TODO: Does not quit the editor if there are modified hidden buffers.
+            - 
+            - Corey - Vim appears to abandon any changes to the current buffer if the window being 
+            - closed is the last window on the buffer. The, now unmodified, buffer is still around 
+            - and can be switched to using :b. I think this is odd and prefer the modified buffer
+            - sticking around. 
+            -}
+           quitWindow = closeWindow
+           
+           {- safeQuitAllWindows implements the commands in vim equivalent to :qa!
+            - Exits the editor unless there is a modified buffer that is not worthless.
+            -}
+           safeQuitAllWindows = do
+             bs <- mapM (\b -> withEditor (withGivenBuffer0 b needsAWindowB) >>= return . (,) b) =<< readEditor bufferStack
+             -- Vim only shows the first modified buffer in the error.
+             case find snd bs of
+               Nothing -> quitEditor
+               Just (b, _) -> do
+                 bufferName <- withEditor $ withGivenBuffer0 b $ gets name
+                 errorEditor $ "No write since last change for buffer " 
+                               ++ show bufferName
+                               ++ " (add ! to override)"
+           
            whenUnchanged mu f = do u <- mu
                                    if u then f
                                         else errorEditor "No write since last change (add ! to override)"
-           quitB = whenUnchanged (withBuffer isWorthlessB) closeWindow
 
 
-           quitNoW = do bufs <- withEditor $ do closeBufferE ""
-                                                bufs <- gets bufferStack
-                                                mapM (\x -> withGivenBuffer0 x isWorthlessB) bufs
-                        whenUnchanged (return $ all id bufs) quitEditor
-
-           quitall  = withAllBuffers quitB
            wquitall = withAllBuffers viWrite >> quitEditor
            bdelete  = whenUnchanged (withBuffer isUnchangedB) . withEditor . closeBufferE
            bdeleteNoW = withEditor . closeBufferE
 
-           fn ""           = withEditor msgClr
+           -- fn maps from the text entered on the command line to a YiM () implementing the 
+           -- command.
+           fn ""           = withEditor clrStatus
 
-           fn s@(c:_) | isDigit c = do
-             e <- liftIO $ try $ evaluate $ read s
-             case e of Left _ -> errorEditor $ "The " ++show s++ " command is unknown."
-                       Right lineNum -> withBuffer (gotoLn lineNum) >> return ()
+           fn s | all isDigit s = do let lineNum = read s
+                                     withBuffer (gotoLn lineNum) >> return ()
 
            fn "w"          = viWrite
            fn ('w':' ':f)  = viWriteTo $ dropSpace f
-           fn "qa"         = quitall
-           fn "qal"        = quitall
-           fn "qall"       = quitall
-           fn "quita"      = quitall
-           fn "quital"     = quitall
-           fn "quitall"    = quitall
-           fn "q"          = quitB
-           fn "qu"         = quitB
-           fn "qui"        = quitB
-           fn "quit"       = quitB
-           fn "q!"         = quitNoW
-           fn "qu!"        = quitNoW
-           fn "qui!"       = quitNoW
-           fn "quit!"      = quitNoW
+           fn "qa"         = safeQuitAllWindows
+           fn "qal"        = safeQuitAllWindows
+           fn "qall"       = safeQuitAllWindows
+           fn "quita"      = safeQuitAllWindows
+           fn "quital"     = safeQuitAllWindows
+           fn "quitall"    = safeQuitAllWindows
+           fn "q"          = safeQuitWindow
+           fn "qu"         = safeQuitWindow
+           fn "qui"        = safeQuitWindow
+           fn "quit"       = safeQuitWindow
+           fn "q!"         = quitWindow
+           fn "qu!"        = quitWindow
+           fn "qui!"       = quitWindow
+           fn "quit!"      = quitWindow
            fn "qa!"        = quitEditor
            fn "quita!"     = quitEditor
            fn "quital!"    = quitEditor
@@ -874,6 +924,7 @@
            fn ('r':' ':f)  = withBuffer . insertN =<< io (readFile f)
            fn ('r':'e':'a':'d':' ':f) = withBuffer . insertN =<< io (readFile f)
            -- fn ('s':'e':'t':' ':'f':'t':'=':ft)  = withBuffer $ setSyntaxB $ highlighters M.! ft
+           fn ('s':'e':'t':' ':'t':'a':'g':'s':'=':fps)  = withEditor $ setTagsFileList fps
            fn ('n':'e':'w':' ':f) = withEditor splitE >> fnewE f
            fn ('s':'/':cs) = withEditor $ viSub cs Line
            fn ('%':'s':'/':cs) = withEditor $ viSub cs Document
@@ -890,6 +941,8 @@
            fn ('b':'d':'e':'l':'e':'t':'e':'!':' ':f) = bdeleteNoW f
            -- TODO: bd[!] [N]
 
+           fn ('t':'a':'g':' ':t) = gotoTag t
+
            -- send just this line through external command /fn/
            fn ('.':'!':f) = do
                  ln  <- withBuffer readLnB
@@ -917,6 +970,7 @@
            fn "st"         = suspendEditor
            fn "stop"       = suspendEditor
 
+           fn ('c':'a':'b':'a':'l':' ':s) = cabalRun s1 (const $ return ()) (drop 1 s2) where (s1, s2) = break (==' ') s
            fn ('y':'i':' ':s) = execEditorAction s
            fn "tabnew"     = withEditor newTabE
            fn ('t':'a':'b':'e':' ':f) = do withEditor newTabE
@@ -967,27 +1021,7 @@
     PatternNotFound -> printMsg "Pattern not found"
     SearchWrapped   -> printMsg "Search wrapped"
 
--- | Try to write a file in the manner of vi\/vim
--- Need to catch any exception to avoid losing bindings
-viWrite :: YiM ()
-viWrite = do
-    mf <- withBuffer $ getA fileA
-    case mf of
-        Nothing -> errorEditor "no file name associate with buffer"
-        Just f  -> do
-            bufInfo <- withBuffer bufInfoB
-            let s   = bufInfoFileName bufInfo
-            let msg = msgEditor $ show f ++ " " ++ show s ++ " written"
-            catchJustE ioErrors (fwriteE >> msg) (msgEditor . show)
 
--- | Try to write to a named file in the manner of vi\/vim
-viWriteTo :: String -> YiM ()
-viWriteTo f = do
-    bufInfo <- withBuffer bufInfoB
-    let s   = bufInfoFileName bufInfo
-    let msg = msgEditor $ show f++" "++show s ++ " written"
-    catchJustE ioErrors (fwriteToE f >> msg) (msgEditor . show)
-
 -- | Try to do a substitution
 viSub :: String -> TextUnit -> EditorM ()
 viSub cs unit = do
@@ -1004,5 +1038,24 @@
 
     where do_single p r g = do
                 s <- searchAndRepUnit p r g unit
-                if not s then fail ("Pattern not found: "++p) else msgClr
+                if not s then fail ("Pattern not found: "++p) else clrStatus
+
+-- | Leave a mode. This always has priority over catch-all actions inside the mode.
+leave :: VimMode
+leave = oneOf [spec KEsc, ctrl $ char 'c'] >> adjustPriority (-1) >> (write clrStatus)
+
+-- | Insert mode is either insertion actions, or the meta (\ESC) action
+ins_mode :: ModeMap -> VimMode
+ins_mode self = write (setStatus ("-- INSERT --", defaultStyle)) >> many (v_ins_char self <|> kwd_mode) >> leave
+
+beginIns :: (Show x, YiAction a x) => ModeMap -> a -> I Event Action ()
+beginIns self a = write a >> ins_mode self
+
+-- --------------------
+-- | Keyword
+kwd_mode :: VimMode
+kwd_mode = some ((ctrl $ char 'n') ?>> (write wordComplete)) >> deprioritize >> (write resetComplete)
+-- 'adjustPriority' is there to lift the ambiguity between "continuing" completion
+-- and resetting it (restarting at the 1st completion).
+
 
diff --git a/Yi/Lexer/Alex.hs b/Yi/Lexer/Alex.hs
--- a/Yi/Lexer/Alex.hs
+++ b/Yi/Lexer/Alex.hs
@@ -1,4 +1,4 @@
-
+{-# LANGUAGE Rank2Types #-}
 module Yi.Lexer.Alex (
                        alexGetChar, alexInputPrevChar, unfoldLexer, lexScanner,
                        alexCollectChar,
@@ -116,6 +116,7 @@
                          ofs -> case scanRun src (ofs - 1) of 
                              -- FIXME: if this is a non-ascii char the ofs. will be wrong.
                              -- However, since the only thing that matters (for now) is 'is the previous char a new line', we don't really care.
+                             -- (this is to support ^,$ in regexes)
                              [] -> []
                              ((_,ch):rest) -> unfoldLexer l (st, (ch, rest))
                  }
diff --git a/Yi/Lexer/GNUMake.x b/Yi/Lexer/GNUMake.x
new file mode 100644
--- /dev/null
+++ b/Yi/Lexer/GNUMake.x
@@ -0,0 +1,63 @@
+-- -*- haskell -*- 
+-- Lexer for Makefiles with consideration of GNU extensions 
+-- This is based off the syntax as described in the GNU Make manual:
+-- http://www.gnu.org/software/make/manual/make.html
+--
+{
+{-# OPTIONS -w  #-}
+module Yi.Lexer.GNUMake
+  ( initState, alexScanToken ) 
+where
+import Yi.Lexer.Alex
+import Yi.Style
+  ( Style             ( .. )
+  , StyleName
+  )
+import qualified Yi.Style as Style
+}
+
+make :-
+
+<0>
+{
+    -- All lines that start with a \t are passed to the shell.
+    -- This includes # characters that might be in the shell code! Those indicate comments *only* if
+    -- the shell interpretting the code would consider it a comment. Wack huh?
+    -- See 3.1
+    ^\t.*
+        { c Style.makeFileAction }
+    \#
+        { m (\_ -> InComment) Style.commentStyle }
+    \n
+        { c Style.defaultStyle }
+    .
+        { c Style.defaultStyle }
+}
+
+<comment>
+{
+    -- Comments can be continued to the next line with a trailing slash.
+    -- See 3.1
+    \\[.\n]
+        { c Style.commentStyle }
+    \n
+        { m (\_ -> TopLevel) Style.defaultStyle }
+    .
+        { c Style.commentStyle }
+}
+
+{
+data HlState = 
+      TopLevel 
+    | InComment
+
+stateToInit TopLevel = 0
+stateToInit InComment = comment
+
+initState :: HlState
+initState = TopLevel
+
+type Token = StyleName
+#include "alex.hsinc"
+}
+
diff --git a/Yi/Lexer/Haskell.x b/Yi/Lexer/Haskell.x
--- a/Yi/Lexer/Haskell.x
+++ b/Yi/Lexer/Haskell.x
@@ -1,4 +1,4 @@
--- -*- haskell -*- 
+-- -*- haskell -*-
 --
 -- Lexical syntax for illiterate Haskell 98.
 --
@@ -38,7 +38,7 @@
 $symchar   = [$symbol \:]
 $nl        = [\n\r]
 
-@reservedid = 
+@reservedid =
         as|case|class|data|default|else|hiding|if|
         import|in|infix|infixl|infixr|instance|newtype|
         qualified|then|type|family|forall|foreign|export|dynamic|
@@ -99,38 +99,38 @@
 -- it's also possible that we have just finishing a line,
 -- people sometimes do this for example  when breaking up paragraphs
 -- in a long comment.
- "--"$nl                                       { c $ Comment Line }
+  "--"$nl                                       { c $ Comment Line }
 
- "{-"                                           { m (subtract 1) $ Comment Open }
+  "{-"                                          { m (subtract 1) $ Comment Open }
 
- ^"#".*                                         { c $ CppDirective }
- $special                                       { cs $ \(c:_) -> Special c }
- "deriving"                                     { c (Reserved Deriving) }
- @reservedid                                    { c (Reserved Other) }
- "module"                                       { c (Reserved Module) }
- "where"                                        { c (Reserved Where) }
- @layoutReservedId                              { c (Reserved OtherLayout) }
- `@qual @varid`                                       { c Operator }
- `@qual @conid`                                       { c ConsOperator }
- @qual @varid                                         { c VarIdent }
- @qual @conid                                         { c ConsIdent }
+  ^"#".*                                        { c $ CppDirective }
+  $special                                      { cs $ \(c:_) -> Special c }
+  "deriving"                                    { c (Reserved Deriving) }
+  @reservedid                                   { c (Reserved Other) }
+  "module"                                      { c (Reserved Module) }
+  "where"                                       { c (Reserved Where) }
+  @layoutReservedId                             { c (Reserved OtherLayout) }
+  `@qual @varid`                                { c Operator }
+  `@qual @conid`                                { c ConsOperator }
+  @qual @varid                                  { c VarIdent }
+  @qual @conid                                  { c ConsIdent }
 
- "|"                                            { c (ReservedOp Pipe) }
- "="                                            { c (ReservedOp Equal) }
- @reservedop                                    { c (ReservedOp OtherOp) }
- @qual @varsym                                        { c Operator }
- @qual @consym                                        { c ConsOperator }
+  "|"                                           { c (ReservedOp Pipe) }
+  "="                                           { c (ReservedOp Equal) }
+  @reservedop                                   { c (ReservedOp OtherOp) }
+  @qual @varsym                                 { c Operator }
+  @qual @consym                                 { c ConsOperator }
 
- @decimal 
-  | 0[oO] @octal
-  | 0[xX] @hexadecimal                          { c Number }
+  @decimal
+    | 0[oO] @octal
+    | 0[xX] @hexadecimal                        { c Number }
 
- @decimal \. @decimal @exponent?
-  | @decimal @exponent                          { c Number }
+  @decimal \. @decimal @exponent?
+    | @decimal @exponent                        { c Number }
 
- \' ($graphic # [\'\\] | " " | @escape) \'      { c CharTok }
- \" @string* \"                                 { c StringTok }
- .                                              { c Unrecognized }
+  \' ($graphic # [\'\\] | " " | @escape) \'     { c CharTok }
+  \" @string* \"                                { c StringTok }
+  .                                             { c Unrecognized }
 }
 
 {
diff --git a/Yi/Lexer/LiterateHaskell.x b/Yi/Lexer/LiterateHaskell.x
--- a/Yi/Lexer/LiterateHaskell.x
+++ b/Yi/Lexer/LiterateHaskell.x
@@ -12,6 +12,7 @@
 {-# OPTIONS -w  #-}
 module Yi.Lexer.LiterateHaskell ( initState, alexScanToken ) where
 import Yi.Lexer.Alex
+import Yi.Lexer.Haskell hiding (initState, alexScanToken)
 import Yi.Style
 }
 
@@ -39,16 +40,21 @@
 $nl        = [\n\r]
 
 @reservedid =
-        as|case|class|data|default|deriving|do|else|hiding|if|
-        import|in|infix|infixl|infixr|instance|let|module|newtype|
-        of|qualified|then|type|where|family|forall|mdo|foreign|export|dynamic|
+        as|case|class|data|default|else|hiding|if|
+        import|in|infix|infixl|infixr|instance|newtype|
+        qualified|then|type|family|forall|foreign|export|dynamic|
         safe|threadsafe|unsafe|stdcall|ccall|dotnet
 
+@layoutReservedId =
+    of|let|do|mdo
+
+
 @reservedop =
         ".." | ":" | "::" | "=" | \\ | "|" | "<-" | "->" | "@" | "~" | "=>"
 
 @varid  = $small $idchar*
 @conid  = $large $idchar*
+@qual   = (@conid ".")*
 @varsym = $symbol $symchar*
 @consym = \: $symchar*
 
@@ -69,118 +75,132 @@
 
 haskell :-
 
-<0> $white+                                     { c defaultStyle } -- whitespace
+<0> $white+                                     ;
 
 <nestcomm> {
-  "{-"                                          { m Comment commentStyle }
-  "-}"                                          { m unComment commentStyle }
-  $white+                                       { c defaultStyle } -- whitespace
-  .                                             { c commentStyle }
+  "{-"                                          { m CommentBlock (Comment Open) }
+  "-}"                                          { m unComment (Comment Close) }
+  $white+                                       ; -- whitespace
+  [^\-\{]+                                      { c $ Comment Text } -- rule to generate comments larger than 1 char
+  .                                             { c $ Comment Text }
 }
 
 <0> {
-  ^ "\begin{code}"                              { m (const CodeBlock) keywordStyle }
-  ^ ">"                                         { m (const CodeLine) operatorStyle }
-  $white+                                       { c defaultStyle } -- whitespace
-  .                                             { c latexStyle }
+  ^ "\begin{code}"                              { m (const CodeBlock) $ Reserved Other }
+  ^ ">"                                         { m (const CodeLine) Operator }
+  $white+                                       ; -- whitespace
+  .                                             { c $ Comment Text {-LaTeX-} }
 }
 
 <codeBlock> {
-  "\end{code}"                                  { m (const LaTeX) keywordStyle }
+  "\end{code}"                                  { m (const LaTeXBlock) $ Reserved Other }
 
-  $white+                                       { c defaultStyle } -- whitespace
+  $white+                                       ; -- whitespace
 
 -- The first rule matches operators that begin with --, eg --++-- is a valid
--- operator and *not* a comment. 
+-- operator and *not* a comment.
 -- Note that we have to dissallow '-' as a symbol char for the first one
--- of these because we may have -------- which would stilljust be the 
+-- of these because we may have -------- which would stilljust be the
 -- start of a comment.
-  "--"\-* [$symbol # \-] $symchar*              { c defaultStyle }
+  "--"\-* [$symbol # \-] $symchar*              { c Operator }
 -- The next rule allows for the start of a comment basically
 -- it is -- followed by anything which isn't a symbol character
 -- (OR more '-'s). So for example "-----:" is still the start of a comment.
-  "--"~[$symbol # \-][^$nl]*                    { c commentStyle }
--- Finally because the above rule had to add in a non symbol character 
+  "--"~[$symbol # \-][^$nl]*                    { c $ Comment Line }
+-- Finally because the above rule had to add in a non symbol character
 -- it's also possible that we have just finishing a line,
 -- people sometimes do this for example  when breaking up paragraphs
 -- in a long comment.
-  "--"$nl                                       { c commentStyle }
-
-  "{-"                                          { m Comment blockCommentStyle }
+  "--"$nl                                       { c $ Comment Line }
 
-  $special                                      { c defaultStyle }
+  "{-"                                          { m CommentBlock $ Comment Open }
 
-  @reservedid                                   { c keywordStyle }
-  @varid                                        { c defaultStyle }
-  @conid                                        { c typeStyle }
+  ^"#".*                                        { c $ CppDirective }
+  $special                                      { cs $ \(c:_) -> Special c }
+  "deriving"                                    { c (Reserved Deriving) }
+  @reservedid                                   { c (Reserved Other) }
+  "module"                                      { c (Reserved Module) }
+  "where"                                       { c (Reserved Where) }
+  @layoutReservedId                             { c (Reserved OtherLayout) }
+  `@qual @varid`                                { c Operator }
+  `@qual @conid`                                { c ConsOperator }
+  @qual @varid                                  { c VarIdent }
+  @qual @conid                                  { c ConsIdent }
 
-  @reservedop                                   { c operatorStyle }
-  @varsym                                       { c operatorStyle }
-  @consym                                       { c typeStyle }
+  "|"                                           { c (ReservedOp Pipe) }
+  "="                                           { c (ReservedOp Equal) }
+  @reservedop                                   { c (ReservedOp OtherOp) }
+  @qual @varsym                                 { c Operator }
+  @qual @consym                                 { c ConsOperator }
 
   @decimal
-   | 0[oO] @octal
-   | 0[xX] @hexadecimal                         { c defaultStyle }
+    | 0[oO] @octal
+    | 0[xX] @hexadecimal                        { c Number }
 
   @decimal \. @decimal @exponent?
-   | @decimal @exponent                         { c defaultStyle }
+    | @decimal @exponent                        { c Number }
 
-  \' ($graphic # [\'\\] | " " | @escape) \'     { c stringStyle }
-  \" @string* \"                                { c stringStyle }
-  .                                             { c operatorStyle }
+  \' ($graphic # [\'\\] | " " | @escape) \'     { c CharTok }
+  \" @string* \"                                { c StringTok }
+  .                                             { c Unrecognized }
 }
 
 <codeLine> {
-  [\t\n\r\f\v]+                                 { m (const LaTeX) keywordStyle }
+  [\t\n\r\f\v]+                                 { m (const LaTeXBlock) $ Reserved Other }
 
-  [\ \t]+                                       { c defaultStyle } -- whitespace
+  [\ \t]+                                       ; -- whitespace
 
 -- Same three rules for line comments as above (see above for explanation).
-  "--"\-* [$symbol # \-] $symchar*              { c defaultStyle }
-  "--"~[$symbol # \-][^$nl]*                    { c commentStyle }
-  "--"$nl                                       { c commentStyle }
-
-  "{-"                                          { m Comment blockCommentStyle }
+  "--"\-* [$symbol # \-] $symchar*              { c Operator }
+  "--"~[$symbol # \-][^$nl]*                    { c $ Comment Line }
+  "--"$nl                                       { c $ Comment Line }
 
-  $special                                      { c defaultStyle }
+  "{-"                                          { m CommentBlock $ Comment Open }
 
-  @reservedid                                   { c keywordStyle }
-  @varid                                        { c defaultStyle }
-  @conid                                        { c typeStyle }
+  ^"#".*                                        { c $ CppDirective }
+  $special                                      { cs $ \(c:_) -> Special c }
+  "deriving"                                    { c (Reserved Deriving) }
+  @reservedid                                   { c (Reserved Other) }
+  "module"                                      { c (Reserved Module) }
+  "where"                                       { c (Reserved Where) }
+  @layoutReservedId                             { c (Reserved OtherLayout) }
+  `@qual @varid`                                { c Operator }
+  `@qual @conid`                                { c ConsOperator }
+  @qual @varid                                  { c VarIdent }
+  @qual @conid                                  { c ConsIdent }
 
-  @reservedop                                   { c operatorStyle }
-  @varsym                                       { c operatorStyle }
-  @consym                                       { c typeStyle }
+  "|"                                           { c (ReservedOp Pipe) }
+  "="                                           { c (ReservedOp Equal) }
+  @reservedop                                   { c (ReservedOp OtherOp) }
+  @qual @varsym                                 { c Operator }
+  @qual @consym                                 { c ConsOperator }
 
   @decimal
-   | 0[oO] @octal
-   | 0[xX] @hexadecimal                         { c defaultStyle }
+    | 0[oO] @octal
+    | 0[xX] @hexadecimal                        { c Number }
 
   @decimal \. @decimal @exponent?
-   | @decimal @exponent                         { c defaultStyle }
+    | @decimal @exponent                        { c Number }
 
-  \' ($graphic # [\'\\] | " " | @escape) \'     { c stringStyle }
-  \" @string* \"                                { c stringStyle }
-  .                                             { c operatorStyle }
+  \' ($graphic # [\'\\] | " " | @escape) \'     { c CharTok }
+  \" @string* \"                                { c StringTok }
+  .                                             { c Unrecognized }
 }
 
 {
-type Token = StyleName
+
 data HlState = CodeBlock
              | CodeLine
-             | Comment { unComment :: HlState }
-             | LaTeX
+             | CommentBlock { unComment :: HlState }
+             | LaTeXBlock
   deriving (Eq)
 
-stateToInit (Comment _) = nestcomm
-stateToInit CodeBlock   = codeBlock
-stateToInit CodeLine    = codeLine
-stateToInit LaTeX       = 0
-
-initState = LaTeX
+stateToInit (CommentBlock _) = nestcomm
+stateToInit CodeBlock        = codeBlock
+stateToInit CodeLine         = codeLine
+stateToInit LaTeXBlock       = 0
 
-latexStyle = commentStyle
+initState = LaTeXBlock
 
 #include "alex.hsinc"
-
 }
diff --git a/Yi/Lexer/Ott.x b/Yi/Lexer/Ott.x
new file mode 100644
--- /dev/null
+++ b/Yi/Lexer/Ott.x
@@ -0,0 +1,112 @@
+-- -*- haskell -*-
+
+{
+{- The Ott website: http://www.cl.cam.ac.uk/~pes20/ott -}
+
+{-# OPTIONS -w  #-}
+module Yi.Lexer.Ott
+  ( initState, alexScanToken )
+where
+import Yi.Lexer.Alex
+import Yi.Style
+  ( Style             ( .. )
+  , StyleName
+  )
+import Yi.Style
+}
+
+@reservedid = metavar
+            | indexvar
+            | grammar
+            | embed
+            | subrules
+            | contextrules
+            | substitutions
+            | single
+            | multiple
+            | freevars
+            | defns
+            | defn
+            | by
+            | homs
+            | funs
+            | fun
+
+@reservedop = "::"
+            | "::="
+            | "_::"
+            | "<::"
+            | "/>"
+            | "//"
+            | "</"
+            | IN
+            | ".."
+            | "..."
+            | "...."
+            | "----" "-"*
+
+@homid = tex | com | coq | hol | isa | ocaml | icho | ich | "coq-equality"
+       | isasyn | isaprec | lex | texvar | isavar | holvar | ocamlvar
+
+main :-
+
+<0> $white+                                     ;
+
+<0>
+{
+    $white+                                        ; -- whitespace
+    "%"[^\n]*                                      { c commentStyle }
+    ">>"                                           { m (subtract 1) commentStyle }
+    @reservedid                                    { c keywordStyle }
+    @reservedop                                    { c operatorStyle }
+    "|" $white+                                    { c operatorStyle }
+    "(+"                                           { m (const bindspec) numberStyle  }
+    "{{"                                           { m (const beginHom) stringStyle }
+    .                                              { c defaultStyle }
+}
+
+<nestcomm> {                                                
+  ">>"                                          { m (subtract 1) commentStyle }
+  "<<"                                          { m (+1) commentStyle }
+  $white+                                       ; -- whitespace
+  .                                             { c commentStyle }
+}
+
+<bindspec> {
+  "bind" | "in" | "union" | "{" | "}"           { c numberStyle }
+  $white+                                       ; -- whitespace
+  "+)"                                          { m (const 0) numberStyle }
+  .                                             { c defaultStyle }
+}
+
+<beginHom> {
+  $white* @homid                                { m (const hom) typeStyle }
+  ""                                            { m (const hom) defaultStyle }
+}
+
+<hom> {
+  "[["                                          { m (const splice) stringStyle }
+  $white+                                       ; -- whitespace
+  "}}"                                          { m (const 0) stringStyle }
+  .                                             { c defaultStyle }
+}
+
+<splice> {
+  "]]"                                          { m (const hom) stringStyle }
+  $white+                                       ; -- whitespace
+  .                                             { c defaultStyle }
+}
+
+{
+type HlState = Int
+
+stateToInit x | x < 0     = nestcomm
+              | otherwise = x
+
+initState :: HlState
+initState = 0
+
+type Token = StyleName
+#include "alex.hsinc"
+}
+
diff --git a/Yi/Lexer/Python.x b/Yi/Lexer/Python.x
--- a/Yi/Lexer/Python.x
+++ b/Yi/Lexer/Python.x
@@ -116,10 +116,10 @@
 @escape  = \\ ($charesc | @ascii | @number)
 @gap     = \\ $whitechar+ \\
 
-@shortstring = $graphic # [\"\\] | " " | @escape | @gap
+@shortstring = $graphic # [\"\'\\] | " " | @escape | @gap
 @longstring  = @shortstring | $nl
 
-haskell :-
+main :-
 
 <0> {
  $white+                                        { c defaultStyle }
diff --git a/Yi/Main.hs b/Yi/Main.hs
--- a/Yi/Main.hs
+++ b/Yi/Main.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 -- Copyright (c) Tuomo Valkonen 2004.
 -- Copyright (c) Don Stewart 2004-5.
 -- Copyright (c) Jean-Philippe Bernardy 2006,2007.
@@ -5,7 +6,7 @@
 -- | This is the main module of Yi, called with configuration from the user.
 -- Here we mainly process command line arguments.
 
-module Yi.Main (main, defaultConfig, projectName) where
+module Yi.Main (main, defaultConfig, availableFrontends, projectName) where
 
 import Prelude ()
 import qualified Yi.Keymap.Emacs  as Emacs
@@ -13,6 +14,9 @@
 import qualified Yi.Keymap.Cua  as Cua
 import Yi.Modes
 import qualified Yi.Mode.Haskell as Haskell
+import Yi.Mode.IReader (ireaderMode, ireadMode)
+import Yi.IReader (nextArticle, saveAsNewArticle)
+import qualified Yi.Mode.Latex as Latex
 import {-# source #-} Yi.Boot
 import Yi.Config
 import Yi.Core hiding (file)
@@ -56,8 +60,8 @@
 #include "ghcconfig.h"
 
 
-frontends :: [(String,UIBoot)]
-frontends =
+availableFrontends :: [(String,UIBoot)]
+availableFrontends =
 #ifdef FRONTEND_COCOA
    ("cocoa", Yi.UI.Cocoa.start) :
 #endif
@@ -73,7 +77,7 @@
    []
 
 frontendNames :: [String]
-frontendNames = fmap fst' frontends
+frontendNames = fmap fst' availableFrontends
   where fst' :: (a,UIBoot) -> a
         fst' (x,_) = x
 
@@ -162,7 +166,7 @@
 
 defaultConfig :: Config
 defaultConfig = 
-  Config { startFrontEnd    = snd (head frontends)
+  Config { startFrontEnd    = snd (head availableFrontends)
          , configUI         =  UIConfig 
            { configFontSize = Nothing
            , configFontName = Nothing
@@ -176,14 +180,18 @@
          , startActions     = [makeAction openScratchBuffer] -- emacs-style behaviour
          , publishedActions = defaultPublishedActions
          , modeTable = [AnyMode Haskell.cleverMode,
-                        AnyMode latexMode2,
+                        AnyMode Latex.latexMode2,
+                        AnyMode Latex.latexMode, -- available but the other one is preferred
                         AnyMode cppMode,
-                        AnyMode literateHaskellMode,
+                        AnyMode Haskell.literateMode,
                         AnyMode cabalMode,
+                        AnyMode gnuMakeMode,
                         AnyMode srmcMode,
                         AnyMode ocamlMode,
+                        AnyMode ottMode,
                         AnyMode perlMode,
                         AnyMode pythonMode,
+                        AnyMode ireaderMode,
                         AnyMode fundamentalMode]
          , debugMode = False
          , configKillringAccumulate = False
@@ -203,7 +211,7 @@
     , ("Document"               , box Document)
     , ("Forward"                , box Forward)
     , ("Line"                   , box Line)
-    , ("Word"                   , box Word)
+    , ("unitWord"               , box unitWord)
     , ("Point"                  , box Point)
     , ("atBoundaryB"            , box atBoundaryB)
     , ("cabalBuildE"            , box cabalBuildE)
@@ -214,7 +222,9 @@
     , ("getSelectRegionB"       , box getSelectRegionB)
     , ("grepFind"               , box grepFind)
     , ("insertB"                , box insertB)
-    , ("leftB"                  , box leftB) 
+    , ("ireadMode"              , box (withBuffer ireadMode >> nextArticle))
+    , ("ireadSaveAsArticle"     , box saveAsNewArticle)
+    , ("leftB"                  , box leftB)
     , ("linePrefixSelectionB"   , box linePrefixSelectionB)
     , ("mkRegion"               , box mkRegion)
     , ("moveB"                  , box moveB)
@@ -225,13 +235,16 @@
     , ("regionOfPartNonEmptyB"  , box regionOfPartNonEmptyB)
     , ("reloadEditor"           , box reloadEditor)
     , ("reloadProjectE"         , box reloadProjectE)
+    , ("replaceString"          , box replaceString)
     , ("revertE"                , box revertE)
     , ("shell"                  , box shell)
     , ("setAnyMode"             , box setAnyMode)
     , ("sortLines"              , box sortLines)
     , ("unLineCommentSelectionB", box unLineCommentSelectionB)
     , ("unitParagraph"          , box unitParagraph)
+    , ("unitViWord"          , box unitViWord)
     , ("writeB"                 , box writeB)
+    , ("ghci"                   , box Haskell.ghciGet)
     ]
 
   where box x = [Data.Dynamic.toDyn x]
@@ -256,7 +269,7 @@
 getConfig :: Config -> Opts -> Either Err Config
 getConfig cfg opt =
     case opt of
-      Frontend f -> case lookup f frontends of
+      Frontend f -> case lookup f availableFrontends of
                       Just frontEnd -> return cfg { startFrontEnd = frontEnd }
                       Nothing       -> fail "Panic: frontend not found"
       Help          -> throwError $ Err usage ExitSuccess
diff --git a/Yi/MiniBuffer.hs b/Yi/MiniBuffer.hs
--- a/Yi/MiniBuffer.hs
+++ b/Yi/MiniBuffer.hs
@@ -8,7 +8,7 @@
   matchingBufferNames
  ) where
 
-import Prelude (filter)
+import Prelude (filter, length)
 import Data.List (isInfixOf)
 import Data.Maybe
 import Yi.Config
@@ -87,10 +87,11 @@
                            oneOf [spec KDown,  meta $ char 'n'] >>! down,
                            oneOf [spec KTab,   ctrl $ char 'i'] >>! completionFunction completer >>! showMatchings,
                            ctrl (char 'g')                     ?>>! closeMinibuffer]
-  withEditor $ historyStartGen prompt
   msgEditor =<< getHint ""
-  b <- withEditor $ spawnMinibufferE (prompt ++ " ") (\bindings -> rebindings <|| (bindings >> write showMatchings))
-  withGivenBuffer b $ replaceBufferContent proposal
+  withEditor $ do 
+      historyStartGen prompt
+      spawnMinibufferE (prompt ++ " ") (\bindings -> rebindings <|| (bindings >> write showMatchings))
+      withBuffer0 $ replaceBufferContent proposal
 
 
 -- | Open a minibuffer, given a finite number of suggestions.
@@ -142,6 +143,11 @@
 instance Promptable String where
     getPromptedValue = return
     getPrompt _ = "String"
+
+instance Promptable Char where
+    getPromptedValue x = if length x == 0 then error "Please supply a character." 
+                         else return $ head x
+    getPrompt _ = "Char"
 
 instance Promptable Int where
     getPromptedValue = return . read
diff --git a/Yi/Misc.hs b/Yi/Misc.hs
--- a/Yi/Misc.hs
+++ b/Yi/Misc.hs
@@ -68,10 +68,6 @@
 
 ----------------------------
 -- Cabal-related commands
-
-setupScript :: String
-setupScript = "Setup"
-
 newtype CabalBuffer = CabalBuffer {cabalBuffer :: Maybe BufferRef}
     deriving (Initializable, Typeable, Binary)
 
@@ -91,7 +87,7 @@
 
 cabalRun :: String -> (Either Exception ExitCode -> YiM x) -> String -> YiM ()
 cabalRun cmd onExit args = withOtherWindow $ do
-   b <- startSubprocess "runhaskell" (setupScript:cmd:words args) onExit
+   b <- startSubprocess "cabal" (cmd:words args) onExit
    withEditor $ do
        maybeM deleteBuffer =<< cabalBuffer <$> getDynamic
        setDynamic $ CabalBuffer $ Just b
diff --git a/Yi/MkTemp.hs b/Yi/MkTemp.hs
--- a/Yi/MkTemp.hs
+++ b/Yi/MkTemp.hs
@@ -46,8 +46,8 @@
 import System.IO.Error          ( isAlreadyExistsError )
 
 import GHC.IOBase               ( IOException(IOError),
-                                  Exception(IOException),
                                   IOErrorType(AlreadyExists) )
+import Control.Exception        ( Exception(IOException) )
 
 #ifndef __MINGW32__
 import qualified System.Posix.Internals ( c_getpid )
diff --git a/Yi/Mode/Haskell.hs b/Yi/Mode/Haskell.hs
--- a/Yi/Mode/Haskell.hs
+++ b/Yi/Mode/Haskell.hs
@@ -6,19 +6,16 @@
    plainMode,
    cleverMode, 
    preciseMode,
+   literateMode,
+   testMode,
    
-   -- * Buffer-level operations
-   haskellUnCommentSelectionB,
-   haskellCommentSelectionB,
-   haskellToggleCommentSelectionB,
-
    -- * IO-level operations
    ghciGet,
    ghciLoadBuffer
   ) where
 
 import Data.Binary
-import Data.List (isPrefixOf, dropWhile, takeWhile, filter, drop)
+import Data.List (dropWhile, takeWhile, filter, drop)
 import Data.Maybe (maybe, listToMaybe, isJust)
 import Prelude (unwords)
 import Yi.Core
@@ -32,17 +29,18 @@
 import Yi.Syntax.Haskell as Hask
 import Yi.Syntax.Paren as Paren
 import Yi.Syntax.Tree
+import Yi.Syntax.OnlineTree as OnlineTree
 import qualified Yi.IncrementalParse as IncrParser
 import qualified Yi.Lexer.Alex as Alex
+import qualified Yi.Lexer.LiterateHaskell as LiterateHaskell
 import Yi.Lexer.Haskell as Haskell
 import qualified Yi.Syntax.Linear as Linear
 import qualified Yi.Mode.Interactive as Interactive
 import Yi.Modes (anyExtension)
 
--- | Plain haskell mode, providing only list of stuff.
-plainMode :: Mode (Linear.Result (Tok Token))
-plainMode = emptyMode 
-   {
+haskellAbstract :: Mode syntax
+haskellAbstract = emptyMode 
+  {
      {-    
      Some of these are a little questionably haskell
      related. For example ".x" is an alex lexer specification
@@ -51,30 +49,58 @@
      For now though this is probably okay given the users of
      'yi' are mostly haskell hackers, as of yet. -}
      modeApplies = anyExtension ["hs", "x", "hsc", "hsinc"],
+     modeName = "haskell",
+     modeToggleCommentSelection = toggleCommentSelectionB "-- " "--"
+  }
+
+-- | Plain haskell mode, providing only list of keywords.
+plainMode :: Mode (Linear.Result (Tok Token))
+plainMode = haskellAbstract
+   {
      modeName = "plain haskell",
      modeHL = ExtHL $
      mkHighlighter (Linear.incrScanner . haskellLexer) (\begin end pos -> Linear.getStrokes begin end pos . fmap Paren.tokenToStroke)
    , modeIndent = \_ast -> autoIndentHaskellB
    }
 
--- | "Clever" hasell mode, using the 
+-- | "Clever" haskell mode, using the paren-matching syntax.
 cleverMode :: Mode (Expr (Tok Haskell.Token))
-cleverMode = emptyMode 
+cleverMode = haskellAbstract
   {
-    modeName = "haskell",
     modeApplies = modeApplies plainMode,
     modeIndent = cleverAutoIndentHaskellB,
     modeHL = ExtHL $
-    mkHighlighter (IncrParser.scanner Paren.parse . Paren.indentScanner . haskellLexer)
+    mkHighlighter (skipScanner 50 . IncrParser.scanner Paren.parse . Paren.indentScanner . haskellLexer)
       (\point begin end t -> Paren.getStrokes point begin end t)
 
   , modeAdjustBlock = adjustBlock
   , modePrettify = cleverPrettify
  }
 
--- | "Clever" hasell mode, using the 
+testMode :: Mode (OnlineTree.Tree TT)
+testMode = haskellAbstract
+  {
+    modeApplies = modeApplies plainMode,
+    modeHL = ExtHL $
+    mkHighlighter (IncrParser.scanner OnlineTree.parse . haskellLexer)
+      (\_point begin _end t -> fmap Hask.tokenToStroke $ dropToIndex begin t)
+
+ }
+
+literateMode :: Mode [Paren.Tree TT]
+literateMode = haskellAbstract
+  { modeName = "literate haskell"
+  , modeApplies = anyExtension ["lhs"]
+  , modeHL = ExtHL $
+    mkHighlighter (IncrParser.scanner Paren.parse . Paren.indentScanner . literateHaskellLexer)
+      (\point begin end t -> Paren.getStrokes point begin end t)
+  , modeAdjustBlock = adjustBlock
+  , modeIndent = cleverAutoIndentHaskellB
+  , modePrettify = cleverPrettify }
+
+-- | Experimental Haskell mode, using a rather precise parser for the syntax.
 preciseMode :: Mode (Hask.Tree TT)
-preciseMode = emptyMode 
+preciseMode = haskellAbstract
   {
     modeName = "precise haskell",
     modeApplies = modeApplies plainMode,
@@ -90,6 +116,8 @@
 
 haskellLexer = Alex.lexScanner Haskell.alexScanToken Haskell.initState 
 
+literateHaskellLexer = Alex.lexScanner LiterateHaskell.alexScanToken LiterateHaskell.initState
+
 adjustBlock :: Expr (Tok Token) -> Int -> BufferM ()
 adjustBlock e len = do
   p <- pointB
@@ -233,24 +261,6 @@
                           , "--"
                           ]
 
-
--- | Comments the region using haskell line comments
-haskellCommentSelectionB :: BufferM ()
-haskellCommentSelectionB = linePrefixSelectionB "-- "
-
--- | uncomments a region of haskell line commented code
-haskellUnCommentSelectionB :: BufferM ()
-haskellUnCommentSelectionB = unLineCommentSelectionB "-- "
-
-haskellToggleCommentSelectionB :: BufferM ()
-haskellToggleCommentSelectionB = do
-  l <- readUnitB Yi.Core.Line
-  if ("--" `isPrefixOf` l)
-    then haskellUnCommentSelectionB
-    else haskellCommentSelectionB
-
-
-
 ---------------------------
 -- * Interaction with GHCi
 
@@ -265,22 +275,25 @@
     withEditor $ setDynamic $ GhciBuffer $ Just b
     return b
 
--- | Return GHCi's buffer; create it if necessary
+-- | Return GHCi's buffer; create it if necessary.
+-- Show it in another window.
 ghciGet :: YiM BufferRef
-ghciGet = do
+ghciGet = withOtherWindow $ do
     GhciBuffer mb <- withEditor $ getDynamic
     case mb of
         Nothing -> ghci
         Just b -> do
             stillExists <- withEditor $ isJust <$> findBuffer b
             if stillExists 
-                then return b
+                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
diff --git a/Yi/Mode/IReader.hs b/Yi/Mode/IReader.hs
new file mode 100644
--- /dev/null
+++ b/Yi/Mode/IReader.hs
@@ -0,0 +1,26 @@
+{-# LANGUAGE Rank2Types #-}
+-- | 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 Yi.Buffer.Misc
+import Yi.IReader
+import Yi.Keymap.Keys
+import Yi.Modes (anyExtension, fundamentalMode)
+import Yi.Syntax (Stroke)
+import qualified Yi.Syntax.Linear as Linear (Result)
+
+abstract :: forall syntax. Mode syntax
+abstract = fundamentalMode { modeApplies = anyExtension ["irtxt"],
+                             modeKeymap = ikeys }
+    where -- Default bindings.
+          -- ikeys :: (MonadInteract f Yi.Keymap.Action Event) => f () -> f ()
+          ikeys = (choice  [metaCh '1' ?>>! saveAndNextArticle,
+                            metaCh '2' ?>>! saveAsNewArticle,
+                            metaCh '3' ?>>! deleteAndNextArticle] <||)
+
+ireaderMode :: Mode (Linear.Result Stroke)
+ireaderMode = abstract { modeName = "interactive reading of text" }
+
+ireadMode ::  BufferM ()
+ireadMode = setAnyMode (AnyMode ireaderMode)
diff --git a/Yi/Mode/Interactive.hs b/Yi/Mode/Interactive.hs
--- a/Yi/Mode/Interactive.hs
+++ b/Yi/Mode/Interactive.hs
@@ -1,12 +1,13 @@
 module Yi.Mode.Interactive where
 
+import Data.List (elemIndex)
 import Prelude ()
 import Yi.Core
-import Yi.Region
-import Yi.Lexer.Alex (Tok(..))
 import Yi.History
-import qualified Yi.Lexer.Compilation         as Compilation
-import qualified Yi.Mode.Compilation         as Compilation
+import Yi.Lexer.Alex (Tok(..))
+import Yi.Region
+import qualified Yi.Lexer.Compilation as Compilation
+import qualified Yi.Mode.Compilation as Compilation
 import qualified Yi.Syntax.Linear as Linear
 
 atLastLine :: BufferM Bool
@@ -16,21 +17,31 @@
 
 mode :: Mode (Linear.Result (Tok Compilation.Token))
 mode = Compilation.mode
-  { 
-       modeApplies = const False,
-       modeName = "interactive",
-       modeKeymap = (<||) 
-        (choice 
-         [spec KEnter ?>>! do
-             eof <- withBuffer $ atLastLine
-             if eof
-               then feedCommand
-               else withSyntax modeFollow,
-          meta (char 'p') ?>>! interactHistoryMove 1,
-          meta (char 'n') ?>>! interactHistoryMove (-1) 
-         ])
-  }
+  { modeApplies = const False,
+    modeName = "interactive",
+    modeKeymap = (<||)
+     (choice
+      [spec KHome ?>>! ghciHome,
+       spec KEnter ?>>! do
+          eof <- withBuffer $ atLastLine
+          if eof
+            then feedCommand
+            else withSyntax modeFollow,
+       meta (char 'p') ?>>! interactHistoryMove 1,
+       meta (char 'n') ?>>! interactHistoryMove (-1)
+      ]) }
 
+-- | 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.)
+ghciHome :: BufferM ()
+ghciHome = do l <- readLnB
+              let epos = elemIndex '>' l
+              case epos of
+                  Nothing -> moveToSol
+                  Just pos -> do (_,mypos) <- getLineAndCol
+                                 if mypos == (pos+2) then moveToSol
+                                  else moveToSol >> moveXorEol (pos+2)
+
 interactId :: String
 interactId = "Interact"
 
@@ -44,11 +55,10 @@
 interactHistoryStart = historyStartGen interactId
 
 getInputRegion :: BufferM Region
-getInputRegion = do
-    mo <- getMarkB (Just "StdOUT")
-    p <- pointAt botB
-    q <- getMarkPointB mo
-    return $ mkRegion p q
+getInputRegion = do mo <- getMarkB (Just "StdOUT")
+                    p <- pointAt botB
+                    q <- getMarkPointB mo
+                    return $ mkRegion p q
 
 getInput :: BufferM String
 getInput = readRegionB =<< getInputRegion
@@ -68,14 +78,12 @@
                     setMode mode
     return b
 
-
-
 -- | Send the type command to the process
 feedCommand :: YiM ()
 feedCommand = do
     b <- withEditor $ getBuffer
     withEditor interactHistoryFinish
-    cmd <- withBuffer $ do 
+    cmd <- withBuffer $ do
         botB
         insertN "\n"
         me <- getMarkB (Just "StdERR")
@@ -85,7 +93,6 @@
         cmd <- readRegionB $ mkRegion p q
         setMarkPointB me p
         setMarkPointB mo p
-        return $ cmd 
+        return $ cmd
     withEditor interactHistoryStart
     sendToProcess b cmd
-
diff --git a/Yi/Mode/Latex.hs b/Yi/Mode/Latex.hs
new file mode 100644
--- /dev/null
+++ b/Yi/Mode/Latex.hs
@@ -0,0 +1,41 @@
+module Yi.Mode.Latex (latexMode, latexMode2) where
+
+import Prelude ()
+import Yi.Buffer
+import Yi.Prelude
+import Yi.Syntax
+import qualified Yi.IncrementalParse as IncrParser
+import qualified Yi.Lexer.Alex as Alex
+import qualified Yi.Syntax.Linear as Linear
+import qualified Yi.Syntax.Latex as Latex
+import qualified Yi.Lexer.Latex               as Latex
+import Yi.Modes (anyExtension, mkHighlighter', fundamentalMode)
+
+
+abstract :: forall syntax. Mode syntax
+abstract = fundamentalMode
+ {
+   modeApplies = anyExtension ["tex", "sty", "ltx"],
+   modeToggleCommentSelection = toggleCommentSelectionB "% " "%"
+ }
+
+-- | token-based latex mode 
+latexMode :: Mode (Linear.Result Stroke)
+latexMode = abstract
+  {
+    modeName = "plain latex",
+    modeHL = ExtHL $ mkHighlighter' Latex.initState Latex.alexScanToken (Latex.tokenToStyle)    
+  }
+
+-- | syntax-based latex mode
+latexMode2 :: Mode [Latex.Tree Latex.TT]
+latexMode2 = abstract
+  {
+    modeApplies = modeApplies latexMode,
+    modeName = "latex",
+    modeHL = ExtHL $ 
+       mkHighlighter (IncrParser.scanner Latex.parse . latexLexer)
+      (\point begin end t -> Latex.getStrokes point begin end t)
+  }
+    where latexLexer = Alex.lexScanner Latex.alexScanToken Latex.initState
+
diff --git a/Yi/Modes.hs b/Yi/Modes.hs
--- a/Yi/Modes.hs
+++ b/Yi/Modes.hs
@@ -1,7 +1,9 @@
+{-# LANGUAGE Rank2Types #-}
 module Yi.Modes (fundamentalMode,
-                 latexMode, cppMode, literateHaskellMode, cabalMode, srmcMode, ocamlMode,
-                 perlMode, pythonMode, latexMode2,
-                 anyExtension
+                 cppMode, cabalMode, srmcMode, ocamlMode,
+                 ottMode, gnuMakeMode,
+                 perlMode, pythonMode, 
+                 anyExtension, mkHighlighter'
                 ) where
 
 import Control.Arrow (first)
@@ -12,22 +14,19 @@
 import Yi.Prelude
 import Yi.Style
 import Yi.Syntax
-import qualified Yi.IncrementalParse as IncrParser
 import qualified Yi.Lexer.Alex as Alex
 import qualified Yi.Lexer.Cabal               as Cabal
 import qualified Yi.Lexer.Cplusplus           as Cplusplus
-import qualified Yi.Lexer.Latex               as Latex
-import qualified Yi.Lexer.LiterateHaskell     as LiterateHaskell
+import qualified Yi.Lexer.GNUMake             as GNUMake
 import qualified Yi.Lexer.OCaml               as OCaml
+import qualified Yi.Lexer.Ott                 as Ott
 import qualified Yi.Lexer.Perl                as Perl
 import qualified Yi.Lexer.Python              as Python
 import qualified Yi.Lexer.Srmc                as Srmc
 import qualified Yi.Syntax.Linear as Linear
-import qualified Yi.Syntax.Latex as Latex
 
-
 fundamentalMode :: Mode syntax
-latexMode, cppMode, literateHaskellMode, cabalMode, srmcMode, ocamlMode, perlMode, pythonMode :: Mode (Linear.Result Stroke)
+cppMode, cabalMode, srmcMode, ocamlMode, ottMode, gnuMakeMode, perlMode, pythonMode :: Mode (Linear.Result Stroke)
 
 fundamentalMode = emptyMode
   { 
@@ -59,13 +58,6 @@
     modeHL = ExtHL $ mkHighlighter' Cplusplus.initState Cplusplus.alexScanToken id
   }
 
-literateHaskellMode = fundamentalMode
-  {
-    modeName = "literate haskell",
-    modeApplies = anyExtension ["lhs"],
-    modeHL = ExtHL $ mkHighlighter' LiterateHaskell.initState LiterateHaskell.alexScanToken id
-  }
-
 cabalMode = fundamentalMode
   {
     modeName = "cabal",
@@ -73,25 +65,7 @@
     modeHL = ExtHL $ mkHighlighter' Cabal.initState Cabal.alexScanToken id
   }
 
-latexLexer = Alex.lexScanner Latex.alexScanToken Latex.initState
 
-latexMode = fundamentalMode
-  {
-    modeName = "plain latex",
-    modeApplies = anyExtension ["tex", "sty", "ltx"],
-    modeHL = ExtHL $ mkHighlighter' Latex.initState Latex.alexScanToken (Latex.tokenToStyle)
-  }
-
-latexMode2 :: Mode [Latex.Tree Latex.TT]
-latexMode2 = fundamentalMode
-  {
-    modeApplies = modeApplies latexMode,
-    modeName = "latex",
-    modeHL = ExtHL $ 
-       mkHighlighter (IncrParser.scanner Latex.parse . latexLexer)
-      (\point begin end t -> Latex.getStrokes point begin end t)
-  }
-
 srmcMode = fundamentalMode
   {
     modeName = "srmc",
@@ -121,5 +95,33 @@
     modeHL = ExtHL $ mkHighlighter' Python.initState Python.alexScanToken id
   }
 
+isMakefile :: String -> Bool
+isMakefile = matches . takeBaseName
+    where matches "Makefile"    = True
+          matches "makefile"    = True
+          matches "GNUmakefile" = True
+          matches filename      = anyExtension ["mk"] filename
+          -- TODO: .mk is fairly standard but are there others?
+
+gnuMakeMode = fundamentalMode
+  {
+    modeName = "Makefile",
+    modeApplies = isMakefile,
+    modeHL = ExtHL $ mkHighlighter' GNUMake.initState GNUMake.alexScanToken id,
+    modeIndentSettings = (modeIndentSettings fundamentalMode)
+      {
+        expandTabs = False,
+        shiftWidth = 8
+      }
+  }
+
+ottMode = fundamentalMode
+  {
+    modeName = "ott",
+    modeApplies = anyExtension ["ott"],
+    modeHL = ExtHL $ mkHighlighter' Ott.initState Ott.alexScanToken id
+  }
+
 anyExtension :: [String] -> FilePath -> Bool
 anyExtension list fileName = or [takeExtension fileName == ('.' : ext) | ext <- list] 
+
diff --git a/Yi/Rectangle.hs b/Yi/Rectangle.hs
--- a/Yi/Rectangle.hs
+++ b/Yi/Rectangle.hs
@@ -1,4 +1,5 @@
 -- Copyright (C) 2008 JP Bernardy
+-- | emacs-style rectangle manipulation functions.
 module Yi.Rectangle where
 
 import Yi.Prelude
@@ -21,6 +22,7 @@
     [lowCol,highCol] <- sort <$> mapM colOf [regionStart r, regionEnd r]
     return (extR, lowCol, highCol)
 
+-- | Split a list at the boundaries given
 multiSplit :: [Int] -> [a] -> [[a]]
 multiSplit [] l = [l]
 multiSplit (x:xs) l = left : multiSplit (fmap (subtract x) xs) right
diff --git a/Yi/Regex.hs b/Yi/Regex.hs
--- a/Yi/Regex.hs
+++ b/Yi/Regex.hs
@@ -10,7 +10,12 @@
 where
 
 import Text.Regex.TDFA
+import Text.Regex.TDFA.Pattern
+import Text.Regex.TDFA.Common
 import Control.Monad
+import Control.Applicative
+import Text.Regex.TDFA.ReadRegex(parseRegex)
+import Text.Regex.TDFA.TDFA(patternToDFA)
 
 type SearchExp = (String, Regex)
 
@@ -29,19 +34,44 @@
 
 data SearchF = IgnoreCase   -- ^ Compile for matching that ignores char case
              | NoNewLine    -- ^ Compile for newline-insensitive matching
+             | QuoteRegex   -- ^ Treat the input not as a regex but as a literal string to search for.
     deriving Eq
 
 searchOpt :: SearchF -> CompOption -> CompOption
 searchOpt IgnoreCase = \o->o{caseSensitive = False}
 searchOpt NoNewLine = \o->o{multiline = False}
+searchOpt QuoteRegex = id
 
+makeSearchOptsM' :: (Functor m, Monad m, RegexMaker Regex CompOption ExecOption source) => [SearchF] -> source -> m (source, Regex)
+makeSearchOptsM' opts re = (\r->(re,r)) <$> makeRegexOptsM (searchOpts opts defaultCompOpt) defaultExecOpt re
+    where searchOpts = foldr (.) id . map searchOpt
 
-makeSearchOptsM :: (Monad m, RegexMaker Regex CompOption ExecOption source) => [SearchF] -> source -> m (source, Regex)
-makeSearchOptsM opts re = liftM (\r->(re,r)) $ makeRegexOptsM (searchOpts opts defaultCompOpt) defaultExecOpt re
-    where searchOpts =  foldr (.) id . map searchOpt
+makeSearchOptsM :: [SearchF] -> String -> Either String (String, Regex)
+makeSearchOptsM opts re = (\r->(re,r)) <$> compilePattern (searchOpts opts defaultCompOpt) defaultExecOpt <$> pattern
+    where searchOpts = foldr (.) id . map searchOpt
+          pattern = if QuoteRegex `elem` opts 
+                          then Right (literalPattern re) 
+                          else mapLeft show (parseRegex re)
 
+
+mapLeft f (Right a) = Right a
+mapLeft f (Left a) = Left (f a)
+
+-- | Return a pattern that matches its argument.
+literalPattern source = (PConcat $ map (PChar (DoPa 0)) $ source, (0,DoPa 0))
+
+compilePattern  :: CompOption -- ^ Flags (summed together)
+         -> ExecOption -- ^ Flags (summed together)
+         -> (Pattern, (GroupIndex, DoPa))    -- ^ The pattern to compile
+         -> Regex -- ^ Returns: the compiled regular expression
+compilePattern compOpt execOpt source =
+      let (dfa,i,tags,groups) = patternToDFA compOpt source
+      in Regex dfa i tags groups compOpt execOpt
+
+
 emptySearch :: SearchExp
 emptySearch = ("", emptyRegex)
+
 
 -- | The regular expression that matches nothing.
 emptyRegex :: Regex
diff --git a/Yi/Region.hs b/Yi/Region.hs
--- a/Yi/Region.hs
+++ b/Yi/Region.hs
@@ -17,6 +17,7 @@
   , fmapRegion
   , intersectRegion
   , unionRegion
+  , regionFirst, regionLast
   )
 where
 import Yi.Buffer.Basic
@@ -38,6 +39,15 @@
                Backward -> " <- " 
              ) ++ 
              show (regionEnd r)
+
+regionFirst :: Region -> Point
+regionFirst (Region Forward p _) = p
+regionFirst (Region Backward _ p) = p
+
+regionLast :: Region -> Point
+regionLast (Region Forward _ p) = p
+regionLast (Region Backward p _) = p
+
 
 fmapRegion :: (Point -> Point) -> Region -> Region
 fmapRegion f (Region d x y) = Region d (f x) (f y)
diff --git a/Yi/Search.hs b/Yi/Search.hs
--- a/Yi/Search.hs
+++ b/Yi/Search.hs
@@ -12,7 +12,7 @@
         SearchMatch,
         SearchResult(..),
         SearchF(..),
-        searchAndRepRegion,  -- :: String -> String -> Bool -> Region -> EditorM Bool
+        searchAndRepRegion,
         searchAndRepUnit, -- :: String -> String -> Bool -> TextUnit -> EditorM Bool
         doSearch,            -- :: (Maybe String) -> [SearchF]
                             -- -> Direction -> YiM ()
@@ -48,7 +48,7 @@
 import Data.Char
 import Data.Maybe
 import Data.Either
-import Data.List (span, takeWhile, take, filter)
+import Data.List (span, takeWhile, take, filter, length)
 
 import Yi.Core
 import Yi.Core as Editor
@@ -103,7 +103,7 @@
 -- | Set up a search.
 searchInit :: String -> Direction -> [SearchF] -> EditorM (SearchExp, Direction)
 searchInit re d fs = do
-    let Just c_re = makeSearchOptsM fs re
+    let Right c_re = makeSearchOptsM fs re
     setRegexE c_re
     setA searchDirectionA d
     return (c_re,d)
@@ -133,25 +133,28 @@
 
 ------------------------------------------------------------------------
 -- | Search and replace in the given region.
--- If the input boolean is True, then the replace is done globally.
+-- If the input boolean is True, then the replace is done globally, otherwise only the first match is replaced
 -- Returns Bool indicating success or failure.
-searchAndRepRegion :: String -> String -> Bool -> Region -> EditorM Bool
-searchAndRepRegion [] _ _ _ = return False   -- hmm...
-searchAndRepRegion re str globally region = do
-    let Just c_re = makeSearchOptsM [] re
-    setRegexE c_re     -- store away for later use
-    setA searchDirectionA Forward
-    mp <- withBuffer0 $
-            (if globally then id else take 1) <$>
+searchAndRepRegion0 :: SearchExp -> String -> Bool -> Region -> BufferM Bool
+searchAndRepRegion0 c_re str globally region = do
+    mp <- (if globally then id else take 1) <$>
                filter (`includedRegion` region) <$>
                   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
-    withBuffer0 $ mapM_ (`replaceRegionB` str) mp'
+    mapM_ (`replaceRegionB` str) mp'
     return (not $ null mp)
 
+searchAndRepRegion :: String -> String -> Bool -> Region -> EditorM Bool
+searchAndRepRegion [] _ _ _ = return False   -- hmm...
+searchAndRepRegion s str globally region = do
+    let c_re = makeSimpleSearch s
+    setRegexE c_re     -- store away for later use
+    setA searchDirectionA Forward
+    withBuffer0 $ searchAndRepRegion0 c_re str globally region
+
 ------------------------------------------------------------------------
 -- | Search and replace in the region defined by the given unit.
 -- The rest is as in 'searchAndRepRegion'.
@@ -188,24 +191,30 @@
 isearchAddE :: String -> EditorM ()
 isearchAddE increment = isearchFunE (++ increment)
 
-makeISearch :: String -> (String, Regex)
+makeSimpleSearch :: String -> SearchExp
+makeSimpleSearch s = se
+    where Right se = makeSearchOptsM [QuoteRegex] s
+
+makeISearch :: String -> SearchExp
 makeISearch s = case makeSearchOptsM opts s of
-                  Nothing -> (s, emptyRegex)
-                  Just search -> search
-   where opts = if any isUpper s then [] else [IgnoreCase]
+                  Left _ -> (s, emptyRegex)
+                  Right search -> search
+   where opts = QuoteRegex : if any isUpper s then [] else [IgnoreCase]
 
 isearchFunE :: (String -> String) -> EditorM ()
 isearchFunE fun = do
   Isearch s <- getDynamic
   let (previous,p0,direction) = head s
-  let current = fun previous
+      current = fun previous
+      srch = makeISearch current
   printMsg $ "I-search: " ++ current
-  prevPoint <- withBuffer0 pointB
-  withBuffer0 $ do
-    moveTo $ regionStart p0
-  let srch = makeISearch current
   setRegexE srch
-  mp <- withBuffer0 $ regexB direction srch
+  prevPoint <- withBuffer0 pointB
+  mp <- withBuffer0 $ do
+      moveTo $ regionStart p0
+      when (direction == Backward) $
+         moveN $ length current
+      regexB direction srch
   case mp of
     [] -> do withBuffer0 $ moveTo prevPoint -- go back to where we were
              setDynamic $ Isearch ((current,p0,direction):s)
@@ -305,9 +314,8 @@
 -----------------
 -- Query-Replace
 
-{-
-  Find the next match and highlight it.
--}
+-- | Find the next match and select it.
+-- Point is end, mark is beginning.
 qrNext :: Window -> BufferRef -> SearchExp -> EditorM ()
 qrNext win b what = do
   mp <- withGivenBufferAndWindow0 win b $ regexB Forward what
@@ -324,24 +332,14 @@
    length as the pattern being replaced.
 -}
 qrReplaceAll :: Window -> BufferRef -> SearchExp -> String -> EditorM ()
-qrReplaceAll win b what replacement =
-  do -- We must first replace the current match
-     qrReplaceCurrent win b replacement
-     qrAllRemaining 
-  where
-  qrAllRemaining =
-    do mp <- withGivenBufferAndWindow0 win b $ regexB Forward what
-       case mp of
-         []    -> do printMsg "Replaced all occurrences"
-                     qrFinish
-         (r:_) -> do replaceAction r
-                     qrAllRemaining
-  replaceAction r = withGivenBufferAndWindow0 win b $ 
-                    replaceRegionB r replacement
+qrReplaceAll win b what replacement = do
+     withGivenBufferAndWindow0 win b $ do 
+         exchangePointAndMarkB -- so we replace the current occurence too
+         searchAndRepRegion0 what replacement True =<< regionOfPartB Document Forward
+     printMsg "Replaced all occurrences"
+     qrFinish
 
-{-
-  Exit from query/replace.
--}
+-- |  Exit from query/replace.
 qrFinish :: EditorM ()
 qrFinish = do
   setA regexA Nothing
@@ -362,4 +360,6 @@
 -}
 qrReplaceCurrent :: Window -> BufferRef -> String -> EditorM ()
 qrReplaceCurrent win b replacement = 
-  withGivenBufferAndWindow0 win b $ modifySelectionB (const replacement)
+  withGivenBufferAndWindow0 win b $ do
+   flip replaceRegionB replacement =<< getRawestSelectRegionB
+
diff --git a/Yi/Style.hs b/Yi/Style.hs
--- a/Yi/Style.hs
+++ b/Yi/Style.hs
@@ -13,8 +13,14 @@
 data Attributes = Attributes
   { foreground :: !Color
   , background :: !Color
+  , reverseAttr :: !Bool 
+    -- ^ The text should be show as "active" or "selected".
+    -- This can be implemented by reverse video on the terminal.
   } deriving (Eq, Ord, Show)
 
+emptyAttributes :: Attributes
+emptyAttributes = Attributes { foreground = Default, background = Default, reverseAttr = False }
+
 -- | The style is used to transform attributes by modifying
 --   one or more of the visual text attributes.
 type Style = Endo Attributes
@@ -23,6 +29,10 @@
 data UIStyle = UIStyle
   { modelineAttributes :: Attributes -- ^ ground attributes for the modeline
   , modelineFocusStyle :: Style      -- ^ transformation of modeline in focus
+  
+  , tabBarAttributes   :: Attributes -- ^ ground attributes for the tabbar
+  , tabInFocusStyle    :: Style      -- ^ a tab that currently holds the focus
+  , tabNotFocusedStyle :: Style      -- ^ a tab that does not have the current focus
 
   , baseAttributes     :: Attributes -- ^ ground attributes for the main text views
 
@@ -31,10 +41,10 @@
   , eofStyle           :: Style      -- ^ empty file marker colours
 
   , errorStyle         :: Style      -- ^ indicates errors in text
-  , hintStyle          :: Style      -- ^ search matches
-  , strongHintStyle    :: Style      -- ^ TODO: what is this?
+  , hintStyle          :: Style      -- ^ search matches/paren matches/other hints
+  , strongHintStyle    :: Style      -- ^ current search match
 
-  -- Syntaxt highlighting styles
+  -- Syntax highlighting styles
   , commentStyle       :: Style      -- ^ all comments
   , blockCommentStyle  :: Style      -- ^ additional only for block comments
   , keywordStyle       :: Style      -- ^ applied to language keywords
@@ -45,8 +55,10 @@
   , typeStyle          :: Style      -- ^ type name (such as class in an OO language)
   , variableStyle      :: Style      -- ^ any standard variable (identifier)
   , operatorStyle      :: Style      -- ^ infix operators
+
+  , makeFileAction     :: Style      -- ^ stuff that's passed to the shell in a Makefile
+  , makeFileRuleHead   :: Style      -- ^ makefile rule headers
   }
---    deriving (Eq, Show)
 
 type StyleName = UIStyle -> Style
 
@@ -62,14 +74,15 @@
 
 data Color
     = RGB {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8 {-# UNPACK #-} !Word8
-    | Default
-    | Reverse
+    | Default 
+    -- ^ The system-default color of the engine used.
+    -- e.g. in Gtk this should pick whatever the user has chosen as default color 
+    -- (background or forground depending on usage) for the text.
     deriving (Eq,Ord,Show)
 
 -- | Convert a color to its text specification, as to be accepted by XParseColor
 colorToText :: Color -> String
 colorToText Default = "default"
-colorToText Reverse = "reverse"
 colorToText (RGB r g b) = ('#':) . showsHex r . showsHex g . showsHex b $ []
     where showsHex x s = showHex1 (x `div` 16) : showHex1 (x `mod` 16) : s
           showHex1 x | x < 10 = chr (ord '0' + fromIntegral x)
@@ -98,4 +111,3 @@
 cyan        = RGB 0 255 255
 white       = RGB 165 165 165
 brightwhite = RGB 255 255 255
-
diff --git a/Yi/Style/Library.hs b/Yi/Style/Library.hs
--- a/Yi/Style/Library.hs
+++ b/Yi/Style/Library.hs
@@ -9,12 +9,16 @@
 -- | Abstract theme that provides useful defaults.
 defaultTheme :: Theme
 defaultTheme = Proto $ const $ UIStyle
-  { modelineAttributes = error "modeline must be redefined!"
+  { modelineAttributes = error "modeline attributes must be redefined!"
   , modelineFocusStyle = withFg brightwhite
 
-  , baseAttributes     = error "window must be redefined!"
+  , tabBarAttributes   = error "tabbar attributes must be redefined!"
+  , tabInFocusStyle    = withFg grey `mappend` withBg white
+  , tabNotFocusedStyle = withFg lightGrey `mappend` withBg white
 
-  , selectedStyle      = withFg Reverse `mappend` withBg Reverse
+  , baseAttributes     = error "base attributes must be redefined!"
+
+  , selectedStyle      = Endo $ \a -> a {reverseAttr = True}
   , eofStyle           = withFg blue
   , errorStyle         = withBg red
   , hintStyle          = withBg cyan
@@ -30,23 +34,30 @@
   , typeStyle          = withFg darkgreen
   , variableStyle      = mempty
   , operatorStyle      = withFg brown
+  , makeFileRuleHead   = withFg blue
+  , makeFileAction     = withFg grey
   }
 
 
 -- | The default UIStyle
 defaultLightTheme :: Theme
 defaultLightTheme = defaultTheme `override` \super _ -> super
-  { modelineAttributes = Attributes { foreground = black,    background = darkcyan }
-  , baseAttributes     = Attributes { foreground = Default,  background = Default }
+  { modelineAttributes = emptyAttributes { foreground = black,    background = darkcyan }
+  , tabBarAttributes   = emptyAttributes { foreground = white,    background = black }
+  , baseAttributes     = emptyAttributes
   }
 
 -- | A UIStyle inspired by the darkblue colorscheme of Vim.
 darkBlueTheme :: Theme
 darkBlueTheme = defaultTheme `override` \super _ -> super
-  { modelineAttributes = Attributes { foreground = darkblue, background = white }
+  { modelineAttributes = emptyAttributes { foreground = darkblue, background = white }
   , modelineFocusStyle = withBg brightwhite
 
-  , baseAttributes     = Attributes { foreground = white,    background = black }
+  , tabBarAttributes   = emptyAttributes { foreground = darkblue, background = brightwhite }
+  , tabInFocusStyle    = withFg grey `mappend` withBg white
+  , tabNotFocusedStyle = withFg lightGrey `mappend` withBg white
+
+  , baseAttributes     = emptyAttributes { foreground = white,    background = black }
 
   , selectedStyle      = withFg white `mappend` withBg blue
   , eofStyle           = withFg red
diff --git a/Yi/Syntax.hs b/Yi/Syntax.hs
--- a/Yi/Syntax.hs
+++ b/Yi/Syntax.hs
@@ -11,7 +11,7 @@
   , Cache
   , Scanner (..)
   , ExtHL        ( .. )
-  , noHighlighter, mkHighlighter
+  , noHighlighter, mkHighlighter, skipScanner
   , Point(..), Size(..), Length, Stroke
   ) 
 where
@@ -46,12 +46,22 @@
 data ExtHL syntax = forall a. ExtHL (Highlighter a syntax) 
 
 data Scanner st a = Scanner {
---                             scanStart :: st -> Int,
                              scanInit :: st, -- ^ Initial state
-                             scanLooked :: st -> Point,
+                             scanLooked :: st -> Point, 
+                             -- ^ How far did the scanner look to produce this intermediate state?
+                             -- The state can be reused as long as nothing changes before that point.
                              scanEmpty :: a,      --  hack :/
-                             scanRun  :: st -> [(st,a)]  -- ^ Running function returns a list of returns and intermediate states.
+                             scanRun  :: st -> [(st,a)]  
+                             -- ^ Running function returns a list of results and intermediate states.
+                             -- Note: the state is the state /before/ producing the result in the second component.
                             }
+
+skipScanner :: Int -> Scanner st a -> Scanner st a
+skipScanner n (Scanner i l e r) = Scanner i l e (other 0 . r)
+    where other _ [] = []
+          other _ [x] = [x] -- we must return the final result (because if the list is empty mkHighlighter thinks it can reuse the previous result)
+          other 0 (x:xs) = x : other n xs
+          other m (_:xs) = other (m-1) xs
 
 instance Functor (Scanner st) where
     fmap f (Scanner i l e r) = Scanner i l (f e) (\st -> fmap (second f) (r st))
diff --git a/Yi/Syntax/Haskell.hs b/Yi/Syntax/Haskell.hs
--- a/Yi/Syntax/Haskell.hs
+++ b/Yi/Syntax/Haskell.hs
@@ -116,10 +116,11 @@
 -- 
 -- isBefore' l (Tok {tokPosn = Posn {posnLn = l'}}) = 
 
+isEmpty :: Tree t -> Bool
 isEmpty Empty = True
 isEmpty _ = False
 
--- parse :: P TT [Tree TT0
+parse :: P TT (Tree TT)
 parse = parse' tokT tokFromT
 
 parse' :: (TT -> Token) -> (Token -> TT) -> P TT (Tree TT)
diff --git a/Yi/Syntax/Latex.hs b/Yi/Syntax/Latex.hs
--- a/Yi/Syntax/Latex.hs
+++ b/Yi/Syntax/Latex.hs
@@ -53,14 +53,17 @@
     where 
       -- | Create a special character symbol
       newT c = tokFromT (Special c)
-      errT = newT '!'
-
+      -- 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 (pure $ errT) <|> sym c
-      pleaseSym' c = recoverWith (pure $ errT) <|> sym' c
+      pleaseSym c = recoverWith errT <|> sym c
+      pleaseSym' c = recoverWith errT <|> sym' c
 
       -- pExpr :: P TT [Expr TT]
       pExpr = many . pTree
@@ -68,7 +71,7 @@
       parens = [(Special x, Special y) | (x,y) <- zip "({[" ")}]"]
       openParens = fmap fst parens
 
-      pBlock = Paren <$> sym' isBegin <*> pExpr True <*> pleaseSym' isEnd
+      pBlock = sym' isBegin >>= \beg@Tok {tokT = Begin env} -> Paren <$> pure beg <*> pExpr True <*> pleaseSym (End env)
 
       pTree :: Bool -> P TT (Tree TT)
       pTree outsideMath = 
@@ -78,7 +81,6 @@
           <|> (Atom <$> sym' isNoise)
           <|> (Error <$> recoverWith (sym' (not . ((||) <$> isNoise <*> (`elem` openParens)))))
 
--- 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 = result 
     where getStrokes' (Atom t) = ts id t
@@ -111,6 +113,7 @@
               | otherwise = (f (tokenToStroke t) :)
           list = foldr (.) id
           result = getStrokesL t0 []
+
 
 modStroke :: StyleName -> Stroke -> Stroke
 modStroke f (l,s,r) = (l,f `mappend` s,r) 
diff --git a/Yi/Syntax/Linear.hs b/Yi/Syntax/Linear.hs
--- a/Yi/Syntax/Linear.hs
+++ b/Yi/Syntax/Linear.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE Rank2Types #-}
 -- Copyright (C) 2008 JP Bernardy
 
 module Yi.Syntax.Linear
diff --git a/Yi/Syntax/OnlineTree.hs b/Yi/Syntax/OnlineTree.hs
new file mode 100644
--- /dev/null
+++ b/Yi/Syntax/OnlineTree.hs
@@ -0,0 +1,70 @@
+module Yi.Syntax.OnlineTree (Tree(..), parse, dropToIndex) where
+import Prelude ()
+import Yi.Prelude
+import Yi.IncrementalParse
+import Control.Applicative
+import Data.Traversable
+import Data.Foldable
+import Yi.Lexer.Alex
+import Yi.Buffer.Basic (Point)
+
+
+data Tree a = Node a (Tree a) (Tree a)
+            | Leaf
+              deriving Show
+
+instance Traversable Tree where
+    traverse f (Node x l r) = Node <$> f x <*> traverse f l <*> traverse f r
+    traverse _ Leaf = pure Leaf
+
+instance Foldable Tree where
+    foldMap = foldMapDefault
+
+instance Functor Tree where
+    fmap = fmapDefault
+
+case_ :: (Maybe s -> Bool) -> P s a -> P s a -> P s a
+case_ f true false = (testNext f *> true) <|> (testNext (not . f) *> false)
+
+symbolBefore :: Point -> Maybe (Tok t) -> Bool
+symbolBefore _ Nothing = False
+symbolBefore p (Just x) = tokBegin x <= p
+
+factor :: Int
+factor = 2  
+
+initialLeftSize :: Size
+initialLeftSize = 2 
+
+parse = parse' initialLeftSize 0 maxBound
+
+-- Invariant: all symbols are after the l
+-- | Parse all the symbols starting in the interval [lb, rb[
+parse' :: Size -> Point -> Point -> P (Tok t) (Tree (Tok t))
+parse' leftSize lB rB
+   | rB <= lB = pure Leaf
+   | otherwise = case_ (symbolBefore rB)
+       (Node <$> symbol (const True)
+             <*> parse' initialLeftSize      lB   midB
+             <*> parse' (leftSize * fromIntegral factor)  midB rB)
+       (pure Leaf) 
+  where midB = min rB (lB +~ leftSize)
+    -- NOTE: eof here is important for performance (otherwise the
+    -- parser would have to keep this case until the very end of input
+    -- is reached.
+
+toEndo Leaf = id
+toEndo (Node x l r) = (x :) . toEndo l . toEndo r
+
+dropToIndex :: Point -> Tree t -> [t]
+dropToIndex index t = dropHelp initialLeftSize t index []
+
+dropHelp :: Size -> Tree a -> Point -> [a] -> [a]
+dropHelp _leftsize Leaf _n = id
+dropHelp leftsize (Node x l r) index
+    | fromIntegral index <  leftsize = (x :) . dropHelp initialLeftSize     l index . toEndo  r
+    -- the head is speculatively put in the result; but it does not matter, since we
+    -- add only O(log n) elements this way.
+    | otherwise         = (x :) . dropHelp (leftsize * fromIntegral factor) r  (index -~ leftsize)
+
+
diff --git a/Yi/Syntax/Paren.hs b/Yi/Syntax/Paren.hs
--- a/Yi/Syntax/Paren.hs
+++ b/Yi/Syntax/Paren.hs
@@ -1,5 +1,5 @@
 -- Copyright (c) JP Bernardy 2008
-
+-- | Parser for haskell that takes in account only parenthesis and layout
 module Yi.Syntax.Paren where
 
 import Yi.IncrementalParse
diff --git a/Yi/Tag.hs b/Yi/Tag.hs
new file mode 100644
--- /dev/null
+++ b/Yi/Tag.hs
@@ -0,0 +1,76 @@
+
+-- | A module for CTags integration
+
+module Yi.Tag
+  (
+   lookupTag,
+   importTagTable,
+   hintTags,
+   completeTag,
+   Tag,
+   TagTable(..)
+  )
+where
+
+{- Standard Library Module Imports -}
+
+import Data.Maybe (mapMaybe)
+import Data.List (isPrefixOf)
+import System.FilePath (takeFileName, takeDirectory, FilePath, (</>))
+import System.FriendlyPath
+import Data.Map (Map, fromList, lookup, keys)
+
+import qualified Data.Trie as Trie
+
+
+type Tag = String
+
+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
+                         }
+
+-- | Find the location of a tag using the tag table.
+-- Returns a full path and line number
+lookupTag :: Tag -> TagTable -> Maybe (FilePath, Int)
+lookupTag tag tagTable = do
+  (file, line) <- 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 :: String -> Map Tag (FilePath, Int)
+readCTags =
+    fromList . mapMaybe (parseTagLine . words) . lines
+    where parseTagLine [tag, tagfile, lineno] =
+              -- remove ctag control lines
+              if "!_TAG_" `isPrefixOf` tag then Nothing
+              else Just (tag, (tagfile, read lineno))
+          parseTagLine _ = Nothing
+
+-- | Read in a tag file from the system
+importTagTable :: FilePath -> IO TagTable
+importTagTable filename = do
+  friendlyName <-  expandTilda filename
+  tagStr <- readFile friendlyName
+  let ctags = readCTags tagStr
+  return $ TagTable { tagFileName = takeFileName filename,
+                      tagBaseDir  = takeDirectory filename,
+                      tagFileMap  = ctags,
+                      tagTrie     = Trie.fromList $ keys ctags
+                    }
+
+-- | Gives all the possible expanded tags that could match a given @prefix@
+hintTags :: TagTable -> String -> [String]
+hintTags tags prefix = map (prefix ++) $ Trie.possibleSuffixes prefix $ tagTrie tags
+
+-- | Extends the string to the longest certain length
+completeTag :: TagTable -> String -> String
+completeTag tags prefix = prefix ++ (Trie.certainSuffix prefix $ tagTrie tags)
diff --git a/Yi/TextCompletion.hs b/Yi/TextCompletion.hs
--- a/Yi/TextCompletion.hs
+++ b/Yi/TextCompletion.hs
@@ -45,11 +45,11 @@
   Completion list <- getDynamic
   case list of 
     (x:xs) -> do -- more alternatives, use them.
-       withBuffer0 $ do reg <- regionOfPartB Word Backward       
+       withBuffer0 $ do reg <- regionOfPartB unitWord Backward       
                         replaceRegionB reg x
        setDynamic (Completion xs)
     [] -> do -- no alternatives, build them.
-      w <- withBuffer0 $ do readRegionB =<< regionOfPartB Word Backward
+      w <- withBuffer0 $ do readRegionB =<< regionOfPartB unitWord Backward
       ws <- wordsForCompletion
       setDynamic (Completion $ (nubSet $ filter (matches w) ws) ++ [w])
       -- We put 'w' back at the end so we go back to it after seeing
@@ -104,7 +104,7 @@
 wordsAndCurrentWord :: BufferM (String, [String])
 wordsAndCurrentWord =
   do curText          <- readRegionB =<< regionOfB Document
-     curWord          <- readRegionB =<< regionOfPartB Word Backward
+     curWord          <- readRegionB =<< regionOfPartB unitWord Backward
      return (curWord, words' curText)
 
 wordsForCompletionInBuffer :: BufferM [String]
diff --git a/Yi/UI/Cocoa.hs b/Yi/UI/Cocoa.hs
--- a/Yi/UI/Cocoa.hs
+++ b/Yi/UI/Cocoa.hs
@@ -21,6 +21,8 @@
 import Yi.Keymap
 import Yi.Monad
 import Yi.Config
+import Yi.Rectangle
+import Yi.String
 import qualified Yi.UI.Common as Common
 import qualified Yi.WindowSet as WS
 import qualified Yi.Style as Style
@@ -34,11 +36,42 @@
 import Data.Maybe
 import Data.Monoid
 import Data.Unique
-import qualified Data.Map as M
 
-import Foundation hiding (name, new, parent, error, self, null)
+-- Specify Cocoa imports explicitly, to avoid name-clashes.
+-- Since the number of functions recognized by HOC varies
+-- between revisions, this seems like the safest choice.
+import HOC
+import Foundation (
+  NSPoint(..),NSRect(..),NSRange(..),NSSize(..),nsHeight,nsWidth,
+  _NSThread,detachNewThreadSelectorToTargetWithObject,alloc,init,
+  NSObject,toNSString,respondsToSelector,_NSMutableArray,array,
+  _NSValue,valueWithRange,addObject,NSMutableArray)
+import AppKit (
+  frame,bounds,setFrame,NSView,_NSView,NSTextField,_NSTextField,
+  NSCell,_NSSplitView,_NSImage,NSApplication,sharedApplication,
+  terminate_,run,setApplicationIconImage,NSWindow,_NSWindow,_NSMenu,
+  activateIgnoringOtherApps,makeKeyAndOrderFront,setMainMenu,
+  addSubview,removeFromSuperview,Has_setBackgroundColor,
+  Has_setTextColor,NSSplitView,_NSFont,addSubviewPositionedRelativeTo,
+  fontWithNameSize,setUserFixedPitchFont,userFixedPitchFontOfSize,
+  adjustSubviews,cell,center,containerSize,nsWindowBelow,
+  initWithContentRectStyleMaskBackingDefer,initWithContentsOfFile,
+  initWithFrame,layoutManager,makeFirstResponder,
+  nsBackingStoreBuffered,nsClosableWindowMask,nsLeftTextAlignment,
+  nsLineBreakByTruncatingMiddle,nsMiniaturizableWindowMask,
+  nsResizableWindowMask,nsTitledWindowMask,nsViewHeightSizable,
+  nsViewMaxYMargin,nsViewNotSizable,nsViewWidthSizable,
+  performMiniaturize,replaceTextStorage,scrollRangeToVisible,
+  setAlignment,setAutodisplay,setAutohidesScrollers,
+  setAutoresizingMask,setBackgroundColor,setBezeled,setBordered,
+  setContainerSize,setDelegate,setDocumentView,setEditable,
+  setFrameAutosaveName,setHasHorizontalScroller,setHasVerticalScroller,
+  setHorizontallyResizable,setInsertionPointColor,setLineBreakMode,
+  setRichText,setSelectable,setSelectedRanges,NSLayoutManager,
+  setSelectedTextAttributes,setStringValue,setTextColor,setTitle,
+  setVerticallyResizable,setWidthTracksTextView,setWindowsMenu,
+  setWraps,sizeToFit,textColor,textContainer)
 
-import AppKit hiding (windows, start, rect, width, content, prompt, dictionary, icon, concat, remove, insert, update, convertAttributes)
 import qualified AppKit.NSWindow
 import qualified AppKit.NSView
 
@@ -49,23 +82,32 @@
 foreign import ccall "Processes.h SetFrontProcess" setFrontProcess :: Ptr (CInt) -> IO (CInt)
 foreign import ccall "Processes.h GetCurrentProcess" getCurrentProcess :: Ptr (CInt) -> IO (CInt)
 
+-- Don't import this, since it is only available in Leopard...
+$(declareRenamedSelector "setAllowsNonContiguousLayout:" "setAllowsNonContiguousLayout" [t| Bool -> IO () |])
+instance Has_setAllowsNonContiguousLayout (NSLayoutManager a)
+_silenceWarning :: ImpType_setAllowsNonContiguousLayout a b
+_silenceWarning = undefined
+
 ------------------------------------------------------------------------
 
 data UI = UI {uiWindow :: NSWindow ()
              ,uiBox :: NSSplitView ()
              ,uiCmdLine :: NSTextField ()
-             ,uiBuffers :: IORef (M.Map BufferRef TextStorage)
              ,windowCache :: IORef [WinInfo]
              ,uiActionCh :: Action -> IO ()
-             ,uiConfig :: UIConfig
+             ,uiFullConfig :: Config
              }
 
+uiConfig :: UI -> UIConfig
+uiConfig = configUI . uiFullConfig
+
 data WinInfo = WinInfo
   { wikey    :: !Unique        -- ^ Uniquely identify each window
   , window   :: Window         -- ^ The editor window that we reflect
   , textview :: YiTextView ()
   , modeline :: NSTextField ()
   , widget   :: NSView ()      -- ^ Top-level widget for this window.
+  , storage  :: TextStorage
   }
 
 mkUI :: UI -> Common.UI
@@ -76,8 +118,8 @@
   , Common.refresh = refresh ui
   }
 
-rect :: Float -> Float -> Float -> Float -> NSRect
-rect x y w h = NSRect (NSPoint x y) (NSSize w h)
+mkRect :: Float -> Float -> Float -> Float -> NSRect
+mkRect x y w h = NSRect (NSPoint x y) (NSSize w h)
 
 allSizable, normalWindowMask :: CUInt
 allSizable = nsViewWidthSizable .|. nsViewHeightSizable
@@ -111,8 +153,8 @@
   cl # setLineBreakMode nsLineBreakByTruncatingMiddle
   return tl
 
-addSubviewWithTextLine :: forall t1 t2. NSView t1 -> NSView t2 -> IO (NSTextField (), NSView ())
-addSubviewWithTextLine view parent = do
+addSubviewWithTextLine :: Maybe (NSView t0) -> NSView t1 -> NSView t2 -> IO (NSTextField (), NSView ())
+addSubviewWithTextLine sibling view parent = do
   container <- new _NSView
   parent # bounds >>= flip setFrame container
   container # setAutoresizingMask allSizable
@@ -121,12 +163,15 @@
 
   text <- newTextLine
   container # addSubview text
-  parent # addSubview container
+  case sibling of
+    Nothing -> parent # addSubview container
+    Just v -> parent # addSubviewPositionedRelativeTo container nsWindowBelow v
+
   -- Adjust frame sizes, as superb cocoa cannot do this itself...
   txtbox <- text # frame
   winbox <- container # bounds
-  view # setFrame (rect 0 (nsHeight txtbox) (nsWidth winbox) (nsHeight winbox - nsHeight txtbox))
-  text # setFrame (rect 0 0 (nsWidth winbox) (nsHeight txtbox))
+  view # setFrame (mkRect 0 (nsHeight txtbox) (nsWidth winbox) (nsHeight winbox - nsHeight txtbox))
+  text # setFrame (mkRect 0 0 (nsWidth winbox) (nsHeight txtbox))
 
   return (text, container)
 
@@ -148,6 +193,7 @@
 
   app <- _YiApplication # sharedApplication >>= return . toYiApplication
   app # setIVar _eventChannel (Just ch)
+  app # setIVar _runAction (Just $ outCh . singleton . makeAction)
 
   -- Multithreading in Cocoa is initialized by spawning a new thread
   -- This spawns a thread that immediately exits, but that's okay
@@ -174,7 +220,7 @@
 
 
   -- Create main cocoa window...
-  win <- _NSWindow # alloc >>= initWithContentRect (rect 0 0 480 340)
+  win <- _NSWindow # alloc >>= initWithContentRect (mkRect 0 0 480 340)
   win # setTitle (toNSString "Yi")
   content <- win # AppKit.NSWindow.contentView >>= return . toNSView
   content # setAutoresizingMask allSizable
@@ -186,7 +232,7 @@
 
   -- Create yi window container
   winContainer <- new _NSSplitView
-  (cmd,_) <- content # addSubviewWithTextLine winContainer
+  (cmd,_) <- content # addSubviewWithTextLine Nothing winContainer
 
   -- Activate application window
   win # center
@@ -194,10 +240,9 @@
   win # makeKeyAndOrderFront nil
   app # activateIgnoringOtherApps False
 
-  bufs <- newIORef M.empty
   wc <- newIORef []
 
-  let ui = UI win winContainer cmd bufs wc (outCh . singleton) (configUI cfg)
+  let ui = UI win winContainer cmd wc (outCh . singleton) cfg
 
   cmd # setColors (Style.baseAttributes $ configStyle $ uiConfig ui)
 
@@ -214,19 +259,19 @@
 syncWindows :: Editor -> UI -> [(Window, Bool)] -> [WinInfo] -> IO [WinInfo]
 syncWindows e ui = sync
   where 
-    sync ws [] = mapM insert ws
+    sync ws [] = mapM (insert Nothing) ws
     sync [] cs = mapM_ remove cs >> return []
     sync (w:ws) (c:cs)
       | match w c          = (:) <$> update w c <*> sync ws cs
       | L.any (match w) cs = remove c >> sync (w:ws) cs
-      | otherwise          = (:) <$> insert w <*> sync ws (c:cs)
+      | otherwise          = (:) <$> insert (Just $ widget c) w <*> sync ws (c:cs)
 
     match w c = winkey (fst w) == winkey (window c)
 
     winbuf = flip findBufferWith e . bufkey
 
     remove = removeFromSuperview . widget
-    insert (w,f) = update (w,f) =<< newWindow ui w (winbuf w)
+    insert before (w,f) = update (w,f) =<< newWindow before ui w (winbuf w)
     update (w, False) i = return (i{window = w})
     update (w, True) i = do
       (textview i) # AppKit.NSView.window >>= makeFirstResponder (textview i)
@@ -238,9 +283,9 @@
   getColor False (Style.background s) >>= flip setBackgroundColor slf
 
 -- | Make A new window
-newWindow :: UI -> Window -> FBuffer -> IO WinInfo
-newWindow ui win b = do
-  v <- alloc _YiTextView >>= initWithFrame (rect 0 0 100 100)
+newWindow :: Maybe (NSView t) -> UI -> Window -> FBuffer -> IO WinInfo
+newWindow before ui win b = do
+  v <- alloc _YiTextView >>= initWithFrame (mkRect 0 0 100 100)
   v # setRichText False
   v # setSelectable True
   v # setAlignment nsLeftTextAlignment
@@ -266,15 +311,15 @@
     prect <- prompt # frame
     vrect <- v # frame
 
-    hb <- _NSView # alloc >>= initWithFrame (rect 0 0 (nsWidth prect + nsWidth vrect) (nsHeight prect))
-    v # setFrame (rect (nsWidth prect) 0 (nsWidth vrect) (nsHeight prect))
+    hb <- _NSView # alloc >>= initWithFrame (mkRect 0 0 (nsWidth prect + nsWidth vrect) (nsHeight prect))
+    v # setFrame (mkRect (nsWidth prect) 0 (nsWidth vrect) (nsHeight prect))
     v # setAutoresizingMask nsViewWidthSizable
     hb # addSubview prompt
     hb # addSubview v
     hb # setAutoresizingMask nsViewWidthSizable
 
     brect <- (uiBox ui) # bounds
-    hb # setFrame (rect 0 0 (nsWidth brect) (nsHeight prect))
+    hb # setFrame (mkRect 0 0 (nsWidth brect) (nsHeight prect))
 
     (uiBox ui) # addSubview hb
     dummy <- _NSTextField # alloc >>= init
@@ -298,13 +343,16 @@
     scroll # setHasHorizontalScroller False
     scroll # setAutohidesScrollers (configAutoHideScrollBar $ uiConfig ui)
     scroll # setIVar _leftScroller (configLeftSideScrollBar $ uiConfig ui)
-    addSubviewWithTextLine scroll (uiBox ui)
+    addSubviewWithTextLine before scroll (uiBox ui)
 
   -- TODO: Support focused modeline...
   ml # setColors (Style.modelineAttributes sty)
-  storage <- getTextStorage ui b
-  layoutManager v >>= replaceTextStorage storage
+  s <- newTextStorage (configStyle $ uiConfig ui) (snd $ runBuffer win b revertPendingUpdatesB) win
+  layoutManager v >>= replaceTextStorage s
 
+  responds <- layoutManager v >>= respondsToSelector (getSelectorForName "setAllowsNonContiguousLayout:")
+  when responds $ layoutManager v >>= setAllowsNonContiguousLayout True
+
   k <- newUnique
   flip (setIVar _runBuffer) v $ \act -> do
     wCache <- readIORef (windowCache ui)
@@ -318,18 +366,35 @@
     , textview = v
     , modeline = ml
     , widget   = view
+    , storage  = s
     }
 
+getSelectedRegions :: BufferM [Region]
+getSelectedRegions = do
+  rect <- getA rectangleSelectionA
+  if (not rect)
+    then singleton <$> (getSelectRegionB >>= charRegionB)
+    else do
+      (reg, x1, x2) <- getRectangle
+      ls <- map (fromIntegral . L.length) <$> lines' <$> readRegionB reg
+      mapM charRegionB $ catMaybes $ snd $ L.mapAccumL
+        (lineRegions (fromIntegral x1) (fromIntegral x2)) (regionStart reg) ls
+  where
+    lineRegions :: Size -> Size -> Point -> Size -> (Point, Maybe Region)
+    lineRegions x1 x2 p l 
+      | l <= x1   = (p +~ succ l, Nothing)
+      | l <= x2   = (p +~ succ l, Just $ mkRegion (p+~x1) (p +~ l))
+      | otherwise = (p +~ succ l, Just $ mkRegion (p+~x1) (p +~ x2))
+
+
 refresh :: UI -> Editor -> IO ()
-refresh ui e = logNSException "refresh" $ do
+refresh ui e = withAutoreleasePool $ logNSException "refresh" $ do
+    _YiApplication # sharedApplication >>=
+      pushClipboard (snd $ runEditor (uiFullConfig ui) getRegE e) . toYiApplication
+  
     (uiCmdLine ui) # setStringValue (toNSString $ statusLine e)
 
     cache <- readRef $ windowCache ui
-    forM_ (buffers e) $ \buf -> do
-      storage <- getTextStorage ui buf
-      storage # setMonospaceFont -- FIXME: Why is this needed for mini buffers?
-      storage # setTextStorageBuffer buf
-
     (uiWindow ui) # setAutodisplay False -- avoid redrawing while window syncing
     cache' <- syncWindows e ui (toList $ WS.withFocus $ windows e) cache
     writeRef (windowCache ui) cache'
@@ -338,20 +403,14 @@
 
     forM_ cache' $ \w ->
         do let buf = findBufferWith (bufkey (window w)) e
-           let ((p0,p1,showSel,txt),_) = runBuffer (window w) buf $
-                 (,,,) <$> pointB <*> getMarkPointB staticSelMark <*>
-                           getA highlightSelectionA <*> getModeLine
-           let (p,l) = if showSel then (min p0 p1, abs $ p1~-p0) else (p0,0)
-           (textview w) # setSelectedRange (NSRange (fromIntegral p) (fromIntegral l))
+           (storage w) # setMonospaceFont -- FIXME: Why is this needed for mini buffers?
+           (storage w) # setTextStorageBuffer e buf
+
+           let ((p0,txt,rs),_) = runBuffer (window w) buf $
+                 (,,) <$> (pointB >>= charIndexB) <*> getModeLine <*> getSelectedRegions
+           a <- castObject <$> _NSMutableArray # array :: IO (NSMutableArray ())
+           mapM_ ((flip addObject a =<<) . flip valueWithRange _NSValue . mkRegionRange) rs
+           (textview w) # setSelectedRanges (castObject a)
            (textview w) # scrollRangeToVisible (NSRange (fromIntegral p0) 0)
            (modeline w) # setStringValue (toNSString txt)
-
-getTextStorage :: UI -> FBuffer -> IO TextStorage
-getTextStorage ui b = do
-    let bufsRef = uiBuffers ui
-    bufs <- readRef bufsRef
-    storage <- case M.lookup (bkey b) bufs of
-      Just storage -> return storage
-      Nothing -> newTextStorage (configStyle $ uiConfig ui) b
-    modifyRef bufsRef (M.insert (bkey b) storage)
-    return storage
+           (textview w) # visibleRange >>= flip visibleRangeChanged (storage w)
diff --git a/Yi/UI/Cocoa/Application.hs b/Yi/UI/Cocoa/Application.hs
--- a/Yi/UI/Cocoa/Application.hs
+++ b/Yi/UI/Cocoa/Application.hs
@@ -25,25 +25,42 @@
   , _YiController
   , initializeClass_Application
   , _eventChannel
+  , _runAction
   , setAppleMenu
   , ImpType_setAppleMenu
+  , pushClipboard
   ) where
 
+import Prelude ()
+import Yi.Prelude
+
 import Control.Concurrent
 import Control.Monad
 
 import Data.Bits
 
-import Yi.Debug
+import Yi.Editor
 import Yi.Event
 import Yi.UI.Cocoa.Utils
 
 import Foreign.C
  
-import HOC ()
-
-import Foundation hiding (name, new, parent, error, self, null)
-import AppKit hiding (windows, start, rect, width, content, prompt, dictionary, icon, concat)
+-- Specify Cocoa imports explicitly, to avoid name-clashes.
+-- Since the number of functions recognized by HOC varies
+-- between revisions, this seems like the safest choice.
+import HOC
+import Foundation (
+  NSObject,NSObjectClass,NSNotification,synchronize,_NSUserDefaults,
+  standardUserDefaults,_NSArray,arrayWithObject,haskellString,
+  _NSTimer,scheduledTimerWithTimeIntervalTargetSelectorUserInfoRepeats,
+  toNSString)
+import AppKit (
+  NSEvent,NSMenu,NSApplication,NSApplicationClass,run,sendEvent,
+  applicationShouldTerminateAfterLastWindowClosed,_NSPasteboard,
+  applicationWillTerminate,generalPasteboard,availableTypeFromArray,
+  charactersIgnoringModifiers,declareTypesOwner,modifierFlags,
+  nsKeyDown,nsStringPboardType,setStringForType,changeCount,
+  stringForType,nsFlagsChanged)
 
 foreign import ccall "RtsAPI.h shutdownHaskellAndExit" shutdownHaskellAndExit :: CInt -> IO ()
 
@@ -96,14 +113,45 @@
 instance Has_setAppleMenu (NSApplication a)
 $(exportClass "YiApplication" "ya_" [
     InstanceVariable "eventChannel" [t| Maybe (Yi.Event.Event -> IO ()) |] [| Nothing |]
+  , InstanceVariable "runAction" [t| Maybe (EditorM () -> IO ()) |] [| Nothing |]
+  , InstanceVariable "lastPaste" [t| String |] [| "" |]
+  , InstanceVariable "lastChangeCount" [t| CInt |] [| 0 |]
   , InstanceMethod 'run -- '
   , InstanceMethod 'doTick -- '
   , InstanceMethod 'sendEvent -- '
   ])
 
 ya_doTick :: YiApplication () -> IO ()
-ya_doTick _ = replicateM_ 4 yield
+ya_doTick slf = do
+  pb <- _NSPasteboard # generalPasteboard
+  cc <- pb # changeCount
+  oc <- slf #. _lastChangeCount
+  when (cc /= oc) $ do
+    slf # setIVar _lastChangeCount cc
+    ar <- _NSArray # arrayWithObject nsStringPboardType
+    ty <- pb # availableTypeFromArray (castObject ar)
+    when (ty /= nil) $ do
+      news <- pb # stringForType ty >>= haskellString
+      olds <- slf #. _lastPaste
+      when (news /= olds) $ do
+        slf # setIVar _lastPaste news
+        Just runAct <- slf #. _runAction
+        runAct (setRegE news)
+  
+  replicateM_ 4 yield
 
+pushClipboard :: String -> YiApplication () -> IO ()
+pushClipboard news slf = do
+  olds <- slf #. _lastPaste
+  when (news /= olds) $ do
+    slf # setIVar _lastPaste news
+    ar <- _NSArray # arrayWithObject nsStringPboardType
+    pb <- _NSPasteboard # generalPasteboard
+    cc <- pb # declareTypesOwner (castObject ar) nil
+    pb # setStringForType (toNSString news) nsStringPboardType
+    slf # setIVar _lastChangeCount cc
+    return ()
+
 ya_run :: YiApplication () -> IO ()
 ya_run self = do
   -- Schedule a timer that repeatedly invokes ya_doTick in order to have
@@ -118,7 +166,10 @@
   t <- event # (rawType :: ImpType_rawType (NSEvent t) inst)
   if t == fromCEnum nsKeyDown
     then self #. _eventChannel >>= handleKeyEvent event
-    else super self # sendEvent event
+    else if t == fromCEnum nsFlagsChanged
+      then do
+        logPutStrLn $ "Flags changed"
+      else super self # sendEvent event
 
 handleKeyEvent :: forall t. NSEvent t -> Maybe (Yi.Event.Event -> IO ()) -> IO ()
 handleKeyEvent event mch = do
@@ -134,6 +185,7 @@
                 "\63233" -> (Just KDown, True)
                 "\63234" -> (Just KLeft, True)
                 "\63235" -> (Just KRight, True)
+                "\63272" -> (Just KDel, True)
                 "\63273" -> (Just KHome, True)
                 "\63275" -> (Just KEnd, True)
                 "\63276" -> (Just KPageUp, True)
@@ -145,7 +197,7 @@
     _                 -> return ()
 
 modifierTable :: Bool -> [(CUInt, Modifier)]
-modifierTable False = [(bit 18,MCtrl), (bit 19,MMeta)]
+modifierTable False = [(bit 18,MCtrl), (bit 19,MMeta), (bit 20,MSuper)]
 modifierTable True  = (bit 17,MShift) : modifierTable False
 
 modifiers :: Bool -> CUInt -> [Modifier]
diff --git a/Yi/UI/Cocoa/TextStorage.hs b/Yi/UI/Cocoa/TextStorage.hs
--- a/Yi/UI/Cocoa/TextStorage.hs
+++ b/Yi/UI/Cocoa/TextStorage.hs
@@ -14,24 +14,42 @@
   , visibleRangeChanged
   ) where
 
-import Prelude (take, dropWhile)
+import Prelude (takeWhile, take, dropWhile, drop, span, unzip)
+import Yi.Editor (regex, emptyEditor, Editor)
 import Yi.Prelude
 import Yi.Buffer
 import Yi.Style
 import Yi.Syntax
 import Yi.UI.Cocoa.Utils
 import Yi.UI.Utils
+import Yi.Window
 
 import Data.Maybe
 import qualified Data.Map as M
+import qualified Data.List as L
 
 import Foreign hiding (new)
 import Foreign.C
 
-import qualified Data.ByteString.Lazy as LB
+import qualified Data.ByteString.Lazy.UTF8 as LB
 
-import Foundation hiding (minimum, new, init, null, error)
-import AppKit hiding (concat, dictionary, convertAttributes)
+-- Specify Cocoa imports explicitly, to avoid name-clashes.
+-- Since the number of functions recognized by HOC varies
+-- between revisions, this seems like the safest choice.
+import HOC
+import Foundation (
+  Unichar,NSString,NSStringClass,NSDictionary,NSRange(..),NSRangePointer,
+  length,attributeAtIndexEffectiveRange,attributesAtIndexEffectiveRange,
+  attributesAtIndexLongestEffectiveRangeInRange,nsMaxRange,
+  beginEditing,endEditing,setAttributesRange,haskellString,
+  substringWithRange,initWithStringAttributes,alloc,
+  addAttributeValueRange,addAttributesRange)
+import AppKit (
+  NSTextStorage,NSTextStorageClass,string,fixesAttributesLazily,
+  _NSCursor,_NSFont,replaceCharactersInRangeWithString,
+  _NSParagraphStyle,defaultParagraphStyle,ibeamCursor,_NSTextStorage,
+  editedRangeChangeInLength,nsTextStorageEditedAttributes,
+  nsTextStorageEditedCharacters,userFixedPitchFontOfSize)
 
 -- Unfortunately, my version of hoc does not handle typedefs correctly,
 -- and thus misses every selector that uses the "unichar" type, even
@@ -52,7 +70,7 @@
 
 $(declareClass "YiLBString" "NSString")
 $(exportClass "YiLBString" "yls_" [
-    InstanceVariable "str" [t| LB.ByteString |] [| LB.empty |]
+    InstanceVariable "str" [t| LB.ByteString |] [| LB.fromString "" |]
   , InstanceMethod 'length -- '
   , InstanceMethod 'characterAtIndex -- '
   , InstanceMethod 'getCharactersRange -- '
@@ -63,24 +81,29 @@
   -- logPutStrLn $ "Calling yls_length (gah...)"
   slf #. _str >>= return . fromIntegral . LB.length
 
--- TODO: The result type should be UTF16...
 yls_characterAtIndex :: CUInt -> YiLBString () -> IO Unichar
 yls_characterAtIndex i slf = do
   -- logPutStrLn $ "Calling yls_characterAtIndex " ++ show i
-  slf #. _str >>= return . fromIntegral . flip LB.index (fromIntegral i)
+  slf #. _str >>= return . last . encodeUTF16 . fromEnum . fst . fromJust . LB.decode . LB.drop (fromIntegral i)
 
--- TODO: Should get an array of characters in UTF16...
 yls_getCharactersRange :: Ptr Unichar -> NSRange -> YiLBString () -> IO ()
 yls_getCharactersRange p _r@(NSRange i l) slf = do
   -- logPutStrLn $ "Calling yls_getCharactersRange " ++ show r
   slf #. _str >>=
     pokeArray p .
-    take (fromIntegral l) . -- TODO: Is l given in bytes or characters?
-    fmap fromIntegral . -- TODO: UTF16 recode
-    LB.unpack .
+    concatMap (encodeUTF16 . fromEnum) .
+    LB.toString .
+    LB.take (fromIntegral l) . -- TODO: Is l given in bytes or characters?
     LB.drop (fromIntegral i)
 
+encodeUTF16 :: Int -> [Unichar]
+encodeUTF16 c
+  | c < 0x10000 = [fromIntegral c]
+  | otherwise   = let c' = c - 0x10000
+                  in [0xd800 .|. (fromIntegral $ c' `shiftR` 10),
+                      0xdc00 .|. (fromIntegral $ c' .&. 0x3ff)]
 
+
 -- An implementation of NSTextStorage that uses Yi's FBuffer as
 -- the backing store. An implementation must at least implement
 -- a O(1) string method and attributesAtIndexEffectiveRange.
@@ -93,87 +116,163 @@
 -- queried for the same location multiple times, and thus caching
 -- them as well also seems fruitful.
 
--- Unfortunately HOC does not export Instance Variables, and thus
--- we cannot provide a type signature for withCache
--- withCache :: (InstanceVariables st iv) => st -> IVar iv (Maybe vt) -> (vt -> Bool) -> IO vt -> IO vt
-
--- | Obtain the result of the action and cache that as the
---   instance variable ivar in self. Use existing cache if
---   a result is stored, and cond says it is still valid.
-withCache slf ivar cond act = do
-  cache <- slf #. ivar
-  case cache of
-    Just val | cond val -> return val
-    _ -> do
-      val <- act
-      slf # setIVar ivar (Just val)
-      return val
-
 -- | Use this as the base length of computed stroke ranges
 strokeRangeExtent :: Num t => t
-strokeRangeExtent = 2000
+strokeRangeExtent = 4000
 
-type Picture = [(Point, Attributes)]
+type PicStroke = (Point, Attributes)
+data Picture = Picture
+  { picRegion :: Region
+  , picStrokes :: [PicStroke]
+  }
 
+instance Show Picture where
+  show (Picture r ss) = "{{"++show r ++": "++show (take 1 ss)++"@"++show (L.length ss)++"}}"
+
+emptyPicture :: (Picture, NSRange)
+emptyPicture = (Picture emptyRegion [], NSRange 0 0)
+
+nullPicture :: Picture -> Bool
+nullPicture = null . picStrokes -- Or empty region??
+
+regionEnds :: Region -> (Point, Point)
+regionEnds r = (regionStart r, regionEnd r)
+
+dropStrokesWhile :: (PicStroke -> Bool) -> Picture -> Picture
+dropStrokesWhile f pic = pic { picRegion = mkRegion nb pe, picStrokes = strokes }
+  where 
+    (pb, pe) = regionEnds $ picRegion pic
+    (nb, strokes) = helper pb (picStrokes pic)
+    helper :: Point -> [PicStroke] -> (Point, [PicStroke])
+    helper p [] = (p,[])
+    helper p ~(x:xs)
+      | f x       = helper (fst x) xs
+      | otherwise = (p, x:xs)
+
+-- | Extend the currently cached picture, so that it at least
+--   covers the desired region. The resulting picture starts
+--   at the location of the desired region, but might extend
+--   further...
+extendPicture :: Region -> (Region -> IO Picture) -> Picture -> IO Picture
+extendPicture desired ext cache = do
+  -- All possible overlappings of desired and cache regions:
+  -- dd   dd  ddd  ddd dddd dd  dd ddd  dd   dd  dd  ddd   dd <- desired
+  --   cc  cc  ccc  cc  cc  ccc cc cc  cccc ccc cc  ccc  cc   <- cache
+  --  A    B    E   B    A   N  N   E   N    N   A   E    A   <- Get All/Begin/End/None
+  -- logPutStrLn $ "extendPicture " ++ show ((db `inRegion` (picRegion cache)), ((de `compare` cb) /= (de `compare` ce)))
+  case (
+    db `inRegion` (picRegion cache), -- Have start
+    de `compare` cb /= de `compare` ce     -- Have end
+    ) of 
+    ( True,  True) -> return $ dropJunk cache
+    ( True, False) -> append (dropJunk cache) <$> ext (mkExtentRegion ce de)
+    (False,  True) -> flip append cache       <$> ext (mkRegion db cb)
+    (False, False) -> ext (mkExtentRegion db de)
+  -- ext (mkExtentRegion db de)
+  where
+    (db, de) = regionEnds desired
+    (cb, ce) = regionEnds $ picRegion cache
+    mkExtentRegion b e = mkSizeRegion b (max (b ~- e) strokeRangeExtent)
+    dropJunk p = Picture -- Like dropStrokesWhile but always use db as starting point
+      { picRegion = mkRegion db (regionEnd $ picRegion p) 
+      , picStrokes = dropWhile ((db >=) . fst) (picStrokes p) 
+      }
+    append p1 p2 = Picture
+      { picRegion = mkRegion (regionStart $ picRegion p1) (regionEnd $ picRegion p2)
+      , picStrokes = picStrokes p1 ++ picStrokes p2
+      }
+
 $(declareClass "YiTextStorage" "NSTextStorage")
 $(exportClass "YiTextStorage" "yts_" [
     InstanceVariable "buffer" [t| Maybe FBuffer |] [| Nothing |]
+  , InstanceVariable "editor" [t| Editor |] [| emptyEditor |]
+  , InstanceVariable "window" [t| Maybe Window |] [| Nothing |]
   , InstanceVariable "uiStyle" [t| Maybe UIStyle |] [| Nothing |]
   , InstanceVariable "dictionaryCache" [t| M.Map Attributes (NSDictionary ()) |] [| M.empty |]
-  , InstanceVariable "pictureCacheStart" [t| Point |] [| 0 |]
-  , InstanceVariable "pictureCache" [t| Picture |] [| [] |]
-  , InstanceVariable "stringCache" [t| Maybe (NSString ()) |] [| Nothing |]
+  , InstanceVariable "pictureCache" [t| (Picture, NSRange) |] [| emptyPicture |]
+  , InstanceVariable "stringCache" [t| Maybe (YiLBString ()) |] [| Nothing |]
   , InstanceMethod 'string -- '
   , InstanceMethod 'fixesAttributesLazily -- '
   , InstanceMethod 'attributeAtIndexEffectiveRange -- '
   , InstanceMethod 'attributesAtIndexEffectiveRange -- '
+  , InstanceMethod 'attributesAtIndexLongestEffectiveRangeInRange
   , InstanceMethod 'replaceCharactersInRangeWithString -- '
-  , InstanceMethod 'setAttributesRange -- '
+  , InstanceMethod 'setAttributesRange     -- Disallow changing attributes
+  , InstanceMethod 'addAttributesRange     -- optimized to avoid needless work
+  , InstanceMethod 'addAttributeValueRange -- ...
   , InstanceMethod 'length -- '
   ])
 
 yts_length :: YiTextStorage () -> IO CUInt
 yts_length slf = do
   -- logPutStrLn "Calling yts_length "
-  (fromIntegral . flip runBufferDummyWindow sizeB . fromJust) <$> slf #. _buffer
+  slf #. _stringCache >>= length . fromJust
 
 yts_string :: YiTextStorage () -> IO (NSString ())
-yts_string slf = do
-  withCache slf _stringCache (const True) $ do
-    s <- new _YiLBString
-    Just b <- slf #. _buffer
-    s # setIVar _str (runBufferDummyWindow b (streamB Forward 0))
-    castObject <$> return s
+yts_string slf = castObject <$> fromJust <$> slf #. _stringCache
 
 yts_fixesAttributesLazily :: YiTextStorage () -> IO Bool
 yts_fixesAttributesLazily _ = return True
 
 yts_attributesAtIndexEffectiveRange :: CUInt -> NSRangePointer -> YiTextStorage () -> IO (NSDictionary ())
 yts_attributesAtIndexEffectiveRange i er slf = do
-  picStart <- slf #. _pictureCacheStart
-  pic <- dropJunk <$> slf #. _pictureCache
-  case pic of
-    (q,_):_ | pos >= picStart && pos < q -> returnRange pic
-    _ -> returnRange =<< filterSame <$> slf # storagePicture i
-  where
-    dropJunk = dropWhile ((pos >=) . fst)
-    pos = fromIntegral i
-    returnRange [] = error "Empty picture?"
-    returnRange pic@((end,s):_) = do
-      slf # setIVar _pictureCacheStart pos
-      slf # setIVar _pictureCache pic
-      logPutStrLn $ "yts_attributesAtIndexEffectiveRange " ++ show i ++ " => " ++ show (NSRange i (fromIntegral end)) ++ " " ++ show (take 1 pic)
-      safePoke er (NSRange i (fromIntegral end - i))
-      dicts <- slf #. _dictionaryCache
+  (cache, _) <- slf #. _pictureCache
+  if (fromIntegral i `inRegion` picRegion cache)
+    then returnEffectiveRange cache i er (mkRegionRange $ picRegion cache) slf
+    else yts_attributesAtIndexLongestEffectiveRangeInRange i er (NSRange i 1) slf
+
+yts_attributesAtIndexLongestEffectiveRangeInRange :: CUInt -> NSRangePointer -> NSRange -> YiTextStorage () -> IO (NSDictionary ())
+yts_attributesAtIndexLongestEffectiveRangeInRange i er rl slf = do
+  (cache, prev_rl) <- slf #. _pictureCache
+  -- Since we only cache the remaining part of the rl window, we must
+  -- check to ensure that we do not re-read the window all the time...
+  let use_rl = if prev_rl == rl then NSRange i (nsMaxRange rl) else rl
+  -- logPutStrLn $ "yts_attributesAtIndexLongestEffectiveRangeInRange " ++ show i ++ " " ++ show rl
+  ed <- slf #. _editor
+  full <- extendPicture (mkRangeRegion use_rl) (flip (storagePicture ed) slf) cache
+  -- TODO: Only merge identical strokes when "needed"?
+  returnEffectiveRange full i er rl slf
+
+returnEffectiveRange :: Picture -> CUInt -> NSRangePointer -> NSRange -> YiTextStorage () -> IO (NSDictionary ())
+returnEffectiveRange full i er rl slf = do
+  pic <- return $ dropStrokesWhile ((fromIntegral i >=) . fst) full
+  -- logPutStrLn $ "returnEffectiveRange " ++ show pic
+  slf # setIVar _pictureCache (pic, rl)
+  if nullPicture pic
+    then error "Empty picture?"
+    else do
+      let begin = fromIntegral $ regionStart $ picRegion pic
+      let (next,s) = head $ picStrokes pic
+      let end = min (fromIntegral next) (nsMaxRange rl)
+      len <- yts_length slf
+      safePoke er (NSRange begin ((min end len) - begin))
       -- Keep a cache of seen styles... usually, there should not be to many
       -- TODO: Have one centralized cache instead of one per text storage...
-      case M.lookup s dicts of
-        Just dict -> return dict
-        _ -> do
-          dict <- convertAttributes s
-          slf # setIVar _dictionaryCache (M.insert s dict dicts)
-          return dict
+      dict <- slf # cachedDictionaryFor s
+      -- TODO: Introduce some sort of cache for this...
+      -- Create a new NSTextStorage to enforce Cocoa font-substitution
+      str <- yts_string slf >>= substringWithRange (NSRange begin ((min end len) - begin))
+      store <- _NSTextStorage # alloc >>= initWithStringAttributes str dict
+      -- Extract the dictionary with adjusted fonts, and new (smaller) range
+      dict2 <- store # attributesAtIndexEffectiveRange (i - begin) er
+      when (er /= nullPtr) $ do
+        -- If we got a range, we should offset it Offset the effective range accordingly
+        NSRange b2 l2 <- peek er
+        poke er (NSRange (begin + b2) l2)
+      return dict2
 
+cachedDictionaryFor :: Attributes -> YiTextStorage () -> IO (NSDictionary ())
+cachedDictionaryFor s slf = do
+  dicts <- slf #. _dictionaryCache
+  case M.lookup s dicts of
+    Just dict -> return dict
+    _ -> do
+      dict <- convertAttributes s
+      slf # setIVar _dictionaryCache (M.insert s dict dicts)
+      return dict
+
+  
+
 yts_attributeAtIndexEffectiveRange :: forall t. NSString t -> CUInt -> NSRangePointer -> YiTextStorage () -> IO (ID ())
 yts_attributeAtIndexEffectiveRange attr i er slf = do
   attr' <- haskellString attr
@@ -190,16 +289,21 @@
       safePokeFullRange >> return nil
     "NSLanguage" -> do
       safePokeFullRange >> return nil
+    "NSLink" -> do
+      safePokeFullRange >> return nil
     "NSParagraphStyle" -> do
       -- TODO: Adjust line break property...
       safePokeFullRange >> castObject <$> defaultParagraphStyle _NSParagraphStyle
     "NSBackgroundColor" -> do
-      ~((s,a):_) <- onlyBg <$> slf # storagePicture i
-      safePoke er (NSRange i (fromIntegral s - i))
+      -- safePokeFullRange >> castObject <$> blackColor _NSColor
+      len <- yts_length slf
+      ed <- slf #. _editor
+      ~((s,a):_) <- onlyBg <$> picStrokes <$> slf # storagePicture ed (mkSizeRegion (fromIntegral i) strokeRangeExtent)
+      safePoke er (NSRange i ((min len (fromIntegral s)) - i))
       castObject <$> getColor False (background a)
     _ -> do
       -- TODO: Optimize the other queries as well (if needed)
-      logPutStrLn $ "Unoptimized yts_attributeAtIndexEffectiveRange " ++ attr' ++ " at " ++ show i
+      -- logPutStrLn $ "Unoptimized yts_attributeAtIndexEffectiveRange " ++ attr' ++ " at " ++ show i
       super slf # attributeAtIndexEffectiveRange attr i er
   where
     safePokeFullRange = do
@@ -212,6 +316,10 @@
 yts_replaceCharactersInRangeWithString _ _ _ = return ()
 yts_setAttributesRange :: forall t. NSDictionary t -> NSRange -> YiTextStorage () -> IO ()
 yts_setAttributesRange _ _ _ = return ()
+yts_addAttributesRange :: NSDictionary t -> NSRange -> YiTextStorage () -> IO ()
+yts_addAttributesRange _ _ _ = return ()
+yts_addAttributeValueRange :: NSString t -> ID () -> NSRange -> YiTextStorage () -> IO ()
+yts_addAttributeValueRange _ _ _ _ = return ()
 
 -- | Remove element x_i if f(x_i,x_(i+1)) is true
 filter2 :: (a -> a -> Bool) -> [a] -> [a]
@@ -220,17 +328,13 @@
 filter2 f (x1:x2:xs) =
   (if f x1 x2 then id else (x1:)) $ filter2 f (x2:xs)
 
--- | Merge needless style-span breaks
-filterSame :: Picture -> Picture
-filterSame = filter2 ((==) `on` snd)
-
 -- | Keep only the background information
-onlyBg :: Picture -> Picture
+onlyBg :: [PicStroke] -> [PicStroke]
 onlyBg = filter2 ((==) `on` (background . snd))
 
 -- | Get a picture where each component (p,style) means apply the style
 --   up until the given point p.
-paintCocoaPicture :: UIStyle -> Point -> Picture -> Picture
+paintCocoaPicture :: UIStyle -> Point -> [PicStroke] -> [PicStroke]
 paintCocoaPicture sty end = tail . stylesift (baseAttributes sty)
   where
     -- Turn a picture of use style from p into a picture of use style until p
@@ -239,58 +343,80 @@
 
 -- | A version of poke that does nothing if p is null.
 safePoke :: (Storable a) => Ptr a -> a -> IO ()
-safePoke p x = if p == nullPtr then return () else poke p x
+safePoke p x = when (p /= nullPtr) (poke p x)
 
 -- | Execute strokeRangesB on the buffer, and update the buffer
 --   so that we keep around cached syntax information...
-storagePicture :: CUInt -> YiTextStorage () -> IO Picture
-storagePicture i slf = do
+--   We assume that the incoming region provide character-indices,
+--   and we need to find out the corresponding byte-indices
+storagePicture :: Editor -> Region -> YiTextStorage () -> IO Picture
+storagePicture ed r slf = do
   Just sty <- slf #. _uiStyle
   Just buf <- slf #. _buffer
-  logPutStrLn $ "storagePicture " ++ show i
-  return $ bufferPicture sty buf (fromIntegral i)
+  Just win <- slf #. _window
+  -- logPutStrLn $ "storagePicture " ++ show i
+  return $ bufferPicture ed sty buf win r
 
-bufferPicture :: UIStyle -> FBuffer -> Point -> Picture
-bufferPicture sty buf p =
-  let r = mkSizeRegion p strokeRangeExtent in
-  paintCocoaPicture sty (regionEnd r) $
-    runBufferDummyWindow buf (attributesPictureB sty Nothing r [])
+byteToCharPicture :: Point -> [Point] -> [PicStroke] -> [PicStroke]
+byteToCharPicture o [] xs = [(o,a) | (_,a) <- take 1 xs]
+byteToCharPicture _ _ [] = []
+byteToCharPicture o (p:ps) ((i,a):xs)
+  | p < i = byteToCharPicture (succ o) ps ((i,a):xs)
+  | otherwise = (o,a) : byteToCharPicture o (p:ps) xs 
 
+bufferPicture :: Editor -> UIStyle -> FBuffer -> Window -> Region -> Picture
+bufferPicture ed sty buf win r =
+  let (r',is) = fst $ runBuffer win buf ((,) <$> byteRegionB r <*> indexStreamRegionB r)
+  in Picture
+  { picRegion = r
+  , picStrokes =
+      paintCocoaPicture sty (regionEnd r) $
+        byteToCharPicture (regionStart r) is $
+          (fst $ runBuffer win buf (attributesPictureB sty (regex ed) r' []))
+  }
+
 type TextStorage = YiTextStorage ()
 initializeClass_TextStorage :: IO ()
 initializeClass_TextStorage = do
   initializeClass_YiLBString
   initializeClass_YiTextStorage
 
-applyUpdate :: YiTextStorage () -> Update -> IO ()
-applyUpdate buf (Insert p _ s) =
+applyUpdate :: YiTextStorage () -> FBuffer -> Update -> IO ()
+applyUpdate buf b (Insert p _ s) =
+  let p' = runBufferDummyWindow b (charIndexB p) in
   buf # editedRangeChangeInLength nsTextStorageEditedCharacters
-          (NSRange (fromIntegral p) 0) (fromIntegral $ LB.length s)
+          (NSRange (fromIntegral p') 0) (fromIntegral $ LB.length s)
 
-applyUpdate buf (Delete p _ s) =
-  let len = LB.length s in
+applyUpdate buf b (Delete p _ s) =
+  let (p', len) = (runBufferDummyWindow b (charIndexB p), LB.length s) in
   buf # editedRangeChangeInLength nsTextStorageEditedCharacters
-          (NSRange (fromIntegral p) (fromIntegral len)) (fromIntegral (negate len))
+          (NSRange (fromIntegral p') (fromIntegral len)) (fromIntegral (negate len))
 
-newTextStorage :: UIStyle -> FBuffer -> IO TextStorage
-newTextStorage sty b = do
+newTextStorage :: UIStyle -> FBuffer -> Window -> IO TextStorage
+newTextStorage sty b w = do
   buf <- new _YiTextStorage
   buf # setIVar _buffer (Just b)
+  buf # setIVar _window (Just w)
   buf # setIVar _uiStyle (Just sty)
+  s <- new _YiLBString
+  s # setIVar _str (runBufferDummyWindow b (streamB Forward 0))
+  buf # setIVar _stringCache (Just s)
   buf # setMonospaceFont
   return buf
 
-setTextStorageBuffer :: FBuffer -> TextStorage -> IO ()
-setTextStorageBuffer buf storage = do
+setTextStorageBuffer :: Editor -> FBuffer -> TextStorage -> IO ()
+setTextStorageBuffer ed buf storage = do
   storage # beginEditing
-  when (not $ null $ pendingUpdates buf) $ do
-    mapM_ (applyUpdate storage) [u | TextUpdate u <- pendingUpdates buf]
-    storage # setIVar _pictureCache []
+  Just s <- storage #. _stringCache
+  s # setIVar _str (runBufferDummyWindow buf (streamB Forward 0))
   storage # setIVar _buffer (Just buf)
-  storage # setIVar _stringCache Nothing
+  storage # setIVar _editor ed
+  when (not $ null $ pendingUpdates buf) $ do
+    mapM_ (applyUpdate storage buf) [u | TextUpdate u <- pendingUpdates buf]
+    storage # setIVar _pictureCache emptyPicture
   storage # endEditing
 
 visibleRangeChanged :: NSRange -> TextStorage -> IO ()
 visibleRangeChanged range storage = do
+  storage # setIVar _pictureCache emptyPicture
   storage # editedRangeChangeInLength nsTextStorageEditedAttributes range 0
-  storage # setIVar _pictureCache []
diff --git a/Yi/UI/Cocoa/TextView.hs b/Yi/UI/Cocoa/TextView.hs
--- a/Yi/UI/Cocoa/TextView.hs
+++ b/Yi/UI/Cocoa/TextView.hs
@@ -19,45 +19,148 @@
   , visibleRange
   )where
 
+import Prelude ()
+import Yi.Prelude
+import Yi.String
 import Yi.Buffer hiding (runBuffer)
+import Yi.UI.Cocoa.Utils
 
-import Foundation
-import AppKit
+-- Specify Cocoa imports explicitly, to avoid name-clashes.
+-- Since the number of functions recognized by HOC varies
+-- between revisions, this seems like the safest choice.
+import HOC
+import Foundation (
+  NSPoint(..),NSRange(..),nsMinY,nsWidth,nsOffsetRect,NSArray,
+  addObject,haskellString,NSMutableArray,NSValue,
+  _NSMutableArray,array,addObjectsFromArray,rangeValue)
+import AppKit (
+  NSSelectionAffinity,characterRangeForGlyphRangeActualGlyphRange,
+  glyphRangeForBoundingRectInTextContainer,layoutManager,textContainer,
+  textContainerOrigin,visibleRect,frame,verticalScroller,NSTextView,
+  NSTextViewClass,setSelectedRangesAffinityStillSelecting,NSScrollView,
+  NSScrollViewClass,tile,setFrameOrigin,performDragOperation,
+  acceptableDragTypes,nsStringPboardType,stringForType,NSPasteboard,
+  convertPointFromView,availableTypeFromArray,_NSPasteboard,
+  typesFilterableTo,nsFilenamesPboardType,propertyListForType,
+  glyphIndexForPointInTextContainerFractionOfDistanceThroughGlyph)
 
 import qualified AppKit.NSScrollView (contentView)
 
 import Foreign
 import Foreign.C
 
+-- TODO: The correct way of doing this would be to add the
+--       protocol constraints on the performDragOperation
+--       parameter, but for whatever reason, HOC doesn't
+--       do this, so we use this hack to work around it...
+$(declareRenamedSelector "draggingLocation" "draggingLocation" [t| IO NSPoint |])
+$(declareRenamedSelector "draggingSource" "draggingSource" [t| IO (ID ()) |])
+$(declareRenamedSelector "draggingPasteboard" "draggingPasteboard" [t| IO (NSPasteboard ()) |])
+instance Has_draggingPasteboard (ID t)
+instance Has_draggingSource (ID t)
+instance Has_draggingLocation (ID t)
+_silenceWarning :: (
+  ImpType_draggingPasteboard a b,
+  ImpType_draggingSource c d,
+  ImpType_draggingLocation e f)
+_silenceWarning = undefined
+
+
 $(declareClass "YiTextView" "NSTextView")
 $(exportClass "YiTextView" "ytv_" [
     InstanceVariable "runBuffer" [t| BufferM () -> IO () |] [| \_ -> return () |]
-  , InstanceVariable "selectingPosition" [t| Maybe CUInt |] [| Nothing |]
-  , InstanceMethod 'setSelectedRangeAffinityStillSelecting -- '
+  , InstanceVariable "selectingPosition" [t| Maybe Point |] [| Nothing |]
+  , InstanceMethod 'setSelectedRangesAffinityStillSelecting -- '
+  , InstanceMethod 'acceptableDragTypes
+  , InstanceMethod 'performDragOperation
   ])
 
 -- | Intercept mouse selection so that we can update Yi's selection
 --   according to how Cocoa wants it.
-ytv_setSelectedRangeAffinityStillSelecting :: NSRange -> NSSelectionAffinity -> Bool -> YiTextView () -> IO ()
-ytv_setSelectedRangeAffinityStillSelecting r@(NSRange p1 l) a b v = do
+ytv_setSelectedRangesAffinityStillSelecting :: NSArray () -> NSSelectionAffinity -> Bool -> YiTextView () -> IO ()
+ytv_setSelectedRangesAffinityStillSelecting rs a b v = do
+  hrs <- fmap castObject <$> haskellList rs :: IO [NSValue ()]
+  r <- foldl1 unionRegion <$> fmap mkRangeRegion <$> mapM rangeValue hrs :: IO Region
   p <- v #. _selectingPosition
   case (b, p) of
     (True, Nothing) -> do
       -- Assume that the initial indication gives starting position
-      v # setIVar _selectingPosition (Just p1)
+      v # setIVar _selectingPosition (Just $ regionStart r)
     (False, Just p0) -> do
       v # setIVar _selectingPosition Nothing
       runbuf <- v #. _runBuffer
       runbuf $ do
-        setVisibleSelection (l /= 0)
-        setSelectionMarkPointB (fromIntegral p0)
-        moveTo (fromIntegral $ if p1 == p0 then p1 + l else p1)
+        setVisibleSelection (regionSize r /= 0)
+        byteIndexB p0 >>= setSelectionMarkPointB
+        byteIndexB (if regionStart r == p0 then regionEnd r else regionStart r) >>= moveTo
     _ -> do
       -- Ignore intermediate updates (Cocoa buffers events until selection finishes)
       -- Ignore direct updates (to avoid having to detect "our" updates)
       return ()
 
-  super v # setSelectedRangeAffinityStillSelecting r a b
+  super v # setSelectedRangesAffinityStillSelecting rs a b
+
+ytv_acceptableDragTypes :: YiTextView () -> IO (NSArray ())
+ytv_acceptableDragTypes _ = do
+  ar <- castObject <$> _NSMutableArray # array :: IO (NSMutableArray ())
+  _NSPasteboard # typesFilterableTo nsStringPboardType >>=
+    flip addObjectsFromArray ar
+  ar # addObject nsFilenamesPboardType
+  return (castObject ar)
+
+-- Implement support for drag and drop...
+ytv_performDragOperation :: ID t -> YiTextView () -> IO Bool
+ytv_performDragOperation dragInfo slf = do
+  pb <- dragInfo # draggingPasteboard
+
+  ty <- slf # ytv_acceptableDragTypes >>= flip availableTypeFromArray pb
+  
+  when (ty /= nil) $ do
+    str <-
+      if ty == nsFilenamesPboardType
+        then unlines' <$> 
+          (pb # propertyListForType ty >>= (haskellList.castObject) >>= mapM (haskellString.castObject))
+        else pb # stringForType ty >>= haskellString
+
+    src <- dragInfo # draggingSource
+    -- Apparently, the selection only looks as if it was updated...
+    -- we would have to use draggingLocation to figure out where
+    -- the new text should go. Which means that we need to get back
+    -- our old trick for translating a mouse-position to a text-position.
+
+    -- TODO: Convert ip from a character index to a buffer position (utf8)
+    pIns' <- dragInfo # draggingLocation >>= flip charAtMouse slf
+
+    runbuf <- slf #. _runBuffer
+    runbuf $ do
+      hasSel <- getA highlightSelectionA
+      rSel <- if hasSel && src == (castObject slf) then getSelectRegionB else return emptyRegion
+      pIns <- byteIndexB (fromIntegral pIns')
+
+      moveTo $ fromIntegral pIns
+      -- To not affect positions we make the "latter" modification first
+      -- Note that there will be no drag operation if they overlap...
+      if regionStart rSel < fromIntegral pIns
+        then insertN str >> deleteRegionB rSel
+        else deleteRegionB rSel >> insertN str
+  
+  return (ty /= nil)
+
+-- | Compute the character index of the specified mouse position
+charAtMouse :: NSPoint -> YiTextView () -> IO CUInt
+charAtMouse p slf = do
+  -- Determine the text-relative coordinate
+  container <- slf # textContainer
+  NSPoint ex ey <- slf # convertPointFromView p nil
+  NSPoint ox oy <- slf # textContainerOrigin
+  let mouse = NSPoint (ex - ox) (ey - oy)
+  -- Determine the index
+  layout <- slf # layoutManager
+  pf <- malloc -- I miss stack variables from C... =P
+  index <- layout # glyphIndexForPointInTextContainerFractionOfDistanceThroughGlyph mouse container pf
+  fract <- peek pf
+  free pf
+  return $ if (fract > 0.5) then index + 1 else index  
 
 -- | Compute the currently visible text range in the view
 visibleRange :: YiTextView () -> IO NSRange
diff --git a/Yi/UI/Cocoa/Utils.hs b/Yi/UI/Cocoa/Utils.hs
--- a/Yi/UI/Cocoa/Utils.hs
+++ b/Yi/UI/Cocoa/Utils.hs
@@ -8,12 +8,25 @@
 
 import Prelude hiding (init)
 import Yi.Debug
+import Yi.Region
 import Yi.Style
 
 import Control.Applicative
 
-import Foundation hiding (new)
-import AppKit hiding (dictionary)
+-- Specify Cocoa imports explicitly, to avoid name-clashes.
+-- Since the number of functions recognized by HOC varies
+-- between revisions, this seems like the safest choice.
+import HOC
+import Foundation (
+  NSDictionary,NSMutableDictionary,NSObject,NSObject_,
+  _NSMutableDictionary,alloc,autorelease,catchNS,description,
+  haskellString,retain,setValueForKey,dictionary,init,
+  objectEnumerator,nextObject,NSArray,NSRange(..))
+import AppKit (
+  Has_setFont,NSColor,_NSColor,_NSFont,blackColor,
+  colorWithDeviceRedGreenBlueAlpha,nsBackgroundColorAttributeName,
+  nsFontAttributeName,nsForegroundColorAttributeName,setFont,
+  userFixedPitchFontOfSize,whiteColor)
 
 logNSException :: String -> IO () -> IO ()
 logNSException str act =
@@ -58,18 +71,10 @@
 -- | Convert a Yi color into a Cocoa color
 getColor :: Bool -> Color -> IO (NSColor ())
 getColor fg Default = if fg then _NSColor # blackColor else _NSColor # whiteColor
-getColor fg Reverse = if fg then _NSColor # whiteColor else _NSColor # blackColor
 getColor _g (RGB r g b) =
   let conv = (/255) . fromIntegral in
   _NSColor # colorWithDeviceRedGreenBlueAlpha (conv r) (conv g) (conv b) 1.0
 
--- Debugging helpers
-
-{-
-
-data Hierarchy = View String NSRect [Hierarchy]
-  deriving Show
-
 haskellList :: forall t1. NSArray t1 -> IO [ID ()]
 haskellList a = a # objectEnumerator >>= helper
   where
@@ -78,6 +83,20 @@
       if e == nil
         then return []
         else helper enum >>= return . (e :)
+
+mkRangeRegion :: NSRange -> Region
+mkRangeRegion (NSRange i l) = mkSizeRegion (fromIntegral i) (fromIntegral l)
+
+mkRegionRange :: Region -> NSRange
+mkRegionRange r = NSRange (fromIntegral $ regionStart r) (fromIntegral $ regionSize r)
+
+{-
+
+-- Debugging helpers
+
+data Hierarchy = View String NSRect [Hierarchy]
+  deriving Show
+
 
 mkHierarchy :: forall t. NSView t -> IO Hierarchy
 mkHierarchy v = do
diff --git a/Yi/UI/Gtk.hs b/Yi/UI/Gtk.hs
--- a/Yi/UI/Gtk.hs
+++ b/Yi/UI/Gtk.hs
@@ -275,7 +275,8 @@
             p0 <- withGivenBuffer0 b $ pointB
             if p1 == p0
               then withGivenBuffer0 b $ setVisibleSelection False
-              else do txt <- withGivenBuffer0 b $ do setMarkPointB staticSelMark p1
+              else do txt <- withGivenBuffer0 b $ do m <- selMark <$> askMarks
+                                                     setMarkPointB m p1
                                                      let [i,j] = sort [p1,p0]
                                                      nelemsB' (j~-i) i
                       setRegE txt
@@ -406,7 +407,7 @@
            gtkBuf <- getGtkBuffer ui buf
 
            let (Point p0) = fst $ runBuffer win buf pointB
-           let (Point p1) = fst $ runBuffer win buf (getMarkPointB staticSelMark)
+           let (Point p1) = fst $ runBuffer win buf (getMarkPointB =<< selMark <$> askMarks)
            let (showSel) = fst $ runBuffer win buf (getA highlightSelectionA)
            i <- textBufferGetIterAtOffset gtkBuf p0
            if showSel 
@@ -445,7 +446,7 @@
 
 styleToTag :: UI -> Attributes -> IO [TextTag]
 styleToTag ui a = case a of
-    (Attributes f b) -> sequence [tagOf textTagForeground f, tagOf textTagBackground b]
+    (Attributes f b _reverse) -> sequence [tagOf textTagForeground f, tagOf textTagBackground b]
 
  where tagOf attr col = do
          let fgText = colorToText col
@@ -513,7 +514,8 @@
   replaceTagsIn ui (mkRegion 0 sz) b buf
   return buf
 
-toColor :: Bool -> Style.Color -> Gtk.Color
-toColor fg Default = let c = if fg then 0xff else 0 in Color c c c
-toColor fg Reverse = let c = if fg then 0 else 0xff in Color c c c
-toColor _g (RGB r g b) = Color (fromIntegral r * 0xff) (fromIntegral g * 0xff) (fromIntegral b * 0xff)
+-- | Convert a color to Gtk counterpart. 
+toColor :: Bool -> -- ^ is the color intended to be used as Foreground?
+           Style.Color -> Gtk.Color
+toColor fg Default = let c = if fg then 0xffff else 0 in Color c c c
+toColor _fg (RGB r g b) = Color (fromIntegral r * 0xff) (fromIntegral g * 0xff) (fromIntegral b * 0xff)
diff --git a/Yi/UI/Gtk/ProjectTree.hs b/Yi/UI/Gtk/ProjectTree.hs
--- a/Yi/UI/Gtk/ProjectTree.hs
+++ b/Yi/UI/Gtk/ProjectTree.hs
@@ -66,7 +66,7 @@
                    icoSetupScript
 
   MView.cellLayoutSetAttributes col1 renderer1 projectStore $ \row -> [MView.cellPixbuf := itemIcon icos row]
-  MView.cellLayoutSetAttributes col2 renderer2 projectStore $ \row -> [MView.cellText   := itemDisplayName row]
+  MView.cellLayoutSetAttributes col2 renderer2 projectStore $ \row -> [MView.cellText   := itemName row]
 
   MView.treeViewAppendColumn projectTree col1
   MView.treeViewAppendColumn projectTree col2
@@ -123,11 +123,3 @@
 moduleIcon icos ExposedModule icoE _    = icoE icos
 moduleIcon icos HiddenModule  _    icoH = icoH icos
 
-itemDisplayName item =
-  let pkg_id = PackageIdentifier (itemName item) (itemVersion item)
-
-      disp_name = case item of
-                    ProjectItem{} -> display pkg_id
-                    PackageItem{} -> display pkg_id
-                    item          -> itemName item
-  in disp_name
diff --git a/Yi/UI/Gtk/Utils.hs b/Yi/UI/Gtk/Utils.hs
--- a/Yi/UI/Gtk/Utils.hs
+++ b/Yi/UI/Gtk/Utils.hs
@@ -1,17 +1,17 @@
---
--- Copyright (c) Krasimir Angelov 2008.
---
--- Random GTK utils
---
-
-module Yi.UI.Gtk.Utils where
-
-import Paths_yi
-import System.FilePath
-import Graphics.UI.Gtk
-
-loadIcon :: FilePath -> IO Pixbuf
-loadIcon fpath = do
-  datadir <- getDataDir
-  icoProject <- pixbufNewFromFile (datadir </> "art" </> fpath)
-  pixbufAddAlpha icoProject (Just (0,255,0))
+--
+-- Copyright (c) Krasimir Angelov 2008.
+--
+-- Random GTK utils
+--
+
+module Yi.UI.Gtk.Utils where
+
+import Paths_yi
+import System.FilePath
+import Graphics.UI.Gtk
+
+loadIcon :: FilePath -> IO Pixbuf
+loadIcon fpath = do
+  datadir <- getDataDir
+  icoProject <- pixbufNewFromFile (datadir </> "art" </> fpath)
+  pixbufAddAlpha icoProject (Just (0,255,0))
diff --git a/Yi/UI/Pango.hs b/Yi/UI/Pango.hs
--- a/Yi/UI/Pango.hs
+++ b/Yi/UI/Pango.hs
@@ -7,7 +7,7 @@
 
 module Yi.UI.Pango (start) where
 
-import Prelude (filter, map, round, length, take, FilePath, (/), subtract, zipWith)
+import Prelude (filter, map, round, length, take, FilePath, (/), zipWith)
 import Yi.Prelude 
 import Yi.Buffer
 import qualified Yi.Editor as Editor
@@ -27,10 +27,11 @@
 import Control.Monad.Reader (liftIO, when, MonadIO)
 import Control.Monad.State (gets)
 
+import Data.Prototype
 import Data.Function
 import Data.Foldable
 import Data.IORef
-import Data.List (nub, findIndex)
+import Data.List (nub, findIndex, zip, drop)
 import Data.Maybe
 import Data.Traversable
 import qualified Data.Map as M
@@ -87,6 +88,8 @@
     Nothing -> return ()
   return f
 
+askBuffer w b f = fst $ runBuffer w b f
+
 -- | Initialise the ui
 start :: UIBoot
 start cfg ch outCh _ed = do
@@ -219,7 +222,7 @@
 syncWin :: Editor -> Window -> WinInfo -> IO WinInfo
 syncWin e w wi = do
   let b = findBufferWith (bufkey w) e
-      reg = runBufferDummyWindow b winRegionB
+      reg = askBuffer w b winRegionB
   logPutStrLn $ "Updated one: " ++ show w ++ " to " ++ show reg
   writeRef (shownRegion wi) reg
   return (wi {coreWin = w})
@@ -269,11 +272,11 @@
         case (eventClick event, eventButton event) of
           (SingleClick, LeftButton) -> do
               focusWindow
-              withGivenBuffer0 b $ moveTo p1
+              withGivenBufferAndWindow0 (coreWin w) b $ moveTo p1
           (SingleClick, _) -> focusWindow
           (ReleaseClick, MiddleButton) -> do
             txt <- getRegE
-            withGivenBuffer0 b $ do
+            withGivenBufferAndWindow0 (coreWin w) b $ do
               pointB >>= setSelectionMarkPointB
               moveTo p1
               insertN txt
@@ -297,7 +300,8 @@
         txt <- withBuffer0 $ do
            if p0 /= p1 
             then Just <$> do
-              setMarkPointB staticSelMark p0
+              m <- selMark <$> askMarks
+              setMarkPointB m p0
               moveTo p1
               setVisibleSelection True
               readRegionB =<< getSelectRegionB
@@ -345,7 +349,7 @@
       return (castToBox vb)
      
     sig <- newIORef =<< (v `onExpose` render e ui b win)
-    rRef <- newIORef (runBufferDummyWindow b winRegionB)
+    rRef <- newIORef (askBuffer w b winRegionB)
     context <- widgetCreatePangoContext v
     layout <- layoutEmpty context
     layoutSetWrap layout WrapAnywhere
@@ -416,12 +420,13 @@
   reg <- readRef (shownRegion w)
   drawWindow <- widgetGetDrawWindow $ textview w
   (width, height) <- widgetGetSize $ textview w
+  let win = coreWin w
   let [width', height'] = map fromIntegral [width, height]
   let metrics = winMetrics w
       layout = winLayout w
       winh = round (height' / (ascent metrics + descent metrics))
 
-  let (point, text) = runBufferDummyWindow b $ do
+  let (point, text) = askBuffer win b $ do
                       numChars <- winEls (regionStart reg) winh
                       (,) 
                        <$> pointB
@@ -440,9 +445,9 @@
     then return r'
     else do
       logPutStrLn $ "out!"
-      let newTos = runBufferDummyWindow b $ do
+      let newTos = askBuffer win b $ do
                          indexOfSolAbove (winh `div` 2)
-          text' = runBufferDummyWindow b $ do
+          text' = askBuffer win b $ do
                          numChars <- winEls newTos winh
                          nelemsB' numChars newTos
       layoutSetText layout text'
@@ -454,16 +459,15 @@
   logPutStrLn $ "updated: " ++ show r''
 
   -- add color attributes.
-  let (strokes,selectReg,selVisible) = runBufferDummyWindow b $ (,,)
-                       <$> strokesRangesB (regex e) r''
-                       <*> getSelectRegionB
-                       <*> getA highlightSelectionA
-                         
-      regInWin = fmapRegion (subtract (regionStart r'')) (intersectRegion selectReg r'')
-      allAttrs = (if selVisible 
-                   then (AttrBackground (fromPoint (regionStart regInWin)) (fromPoint (regionEnd regInWin - 1))
-                           (Color 50000 50000 maxBound) :)
-                   else id) []
+  let picture = askBuffer win b $ attributesPictureAndSelB sty (regex e) r''
+      sty = extractValue $ configTheme (uiConfig ui)
+      strokes = [(start,s,end) | ((start, s), end) <- zip picture (drop 1 (map fst picture) ++ [regionEnd r'']),
+                  s /= emptyAttributes]
+      rel p = fromIntegral (p - regionStart r'')
+      allAttrs = [gen (rel p1) (rel p2) (mkCol col) 
+                  | (p1,Attributes fg bg _rv,p2) <- strokes, 
+                  (gen,col) <- zip [AttrForeground, AttrBackground] [fg,bg],
+                  col /= Default]
 
   layoutSetAttributes layout allAttrs
 
@@ -487,7 +491,7 @@
     return $ do
       let updWin w r = do
              withGivenBufferAndWindow0 w (bufkey w) $ do
-                 Just (WinMarks f _ _ t) <- getMarks w
+                 Just (MarkSet f _ _ t) <- getMarks w
                  setMarkPointB f (regionStart r)
                  setMarkPointB t (regionEnd   r)
       -- TODO: also update height and bos.
@@ -499,7 +503,6 @@
 
 mkCol :: Yi.Style.Color -> Gtk.Color
 mkCol Default = Color 0 0 0
-mkCol Reverse = Color maxBound maxBound maxBound
 mkCol (RGB x y z) = Color (fromIntegral x * 256)
                           (fromIntegral y * 256)
                           (fromIntegral z * 256)
diff --git a/Yi/UI/TabBar.hs b/Yi/UI/TabBar.hs
--- a/Yi/UI/TabBar.hs
+++ b/Yi/UI/TabBar.hs
@@ -4,30 +4,18 @@
 import Yi.WindowSet
 import Yi.Editor (Editor(..)
                  ,findBufferWith)
-import Yi.Style
 
 data TabDescr = TabDescr
     {
         tabText :: String,
-        tabAttributes :: Attributes,
         tabInFocus :: Bool
     }
 
 type TabBarDescr = WindowSet TabDescr
 
-tabBarDescr :: Editor -> Int -> UIStyle -> TabBarDescr
-tabBarDescr editor maxWidth uiStyle = 
-    -- TODO: Use different styles for oofTabStyle and ifTabStyle. 
-    -- I tried using modeline and modelineFocused but this had an undesired 
-    -- effect on the mode line. - CROC
-    let oofTabStyle = modelineAttributes uiStyle
-        ifTabStyle = modelineAttributes uiStyle
-        hintForTab tab = hint
-            where currentBufferName = name $ findBufferWith (bufkey $ current tab) editor
-                  hint = if length currentBufferName > maxWidth
-                            then take (maxWidth - 3) currentBufferName ++ "..."
-                            else currentBufferName
-        tabDescr (tab,True) = TabDescr (hintForTab tab) ifTabStyle True
-        tabDescr (tab,False) = TabDescr (hintForTab tab) oofTabStyle False
+tabBarDescr :: Editor -> TabBarDescr
+tabBarDescr editor = 
+    let hintForTab tab = name $ findBufferWith (bufkey $ current tab) editor
+        tabDescr (tab,True) = TabDescr (hintForTab tab) True
+        tabDescr (tab,False) = TabDescr (hintForTab tab) False
     in fmap tabDescr (withFocus $ tabs editor)
-    
diff --git a/Yi/UI/Utils.hs b/Yi/UI/Utils.hs
--- a/Yi/UI/Utils.hs
+++ b/Yi/UI/Utils.hs
@@ -10,7 +10,7 @@
 import Control.Arrow (second)
 import Data.Monoid
 import Yi.Style
-import Yi.Syntax (Stroke)
+import Control.Monad.State (gets)
 -- | return index of Sol on line @n@ above current line
 indexOfSolAbove :: Int -> BufferM Point
 indexOfSolAbove n = savingPointB $ do
@@ -64,3 +64,9 @@
     (extraLayers ++) <$>
     strokesRangesB mexp region
 
+attributesPictureAndSelB :: UIStyle -> Maybe SearchExp -> Region -> BufferM [(Point,Attributes)]
+attributesPictureAndSelB sty mexp region = do
+    selReg <- getSelectRegionB
+    showSel <- getA highlightSelectionA
+    let extraLayers = if showSel then [[(regionStart selReg, selectedStyle, regionEnd selReg)]] else []
+    attributesPictureB sty mexp region extraLayers
diff --git a/Yi/UI/Vty.hs b/Yi/UI/Vty.hs
--- a/Yi/UI/Vty.hs
+++ b/Yi/UI/Vty.hs
@@ -24,7 +24,7 @@
 import Data.Monoid
 import Data.Traversable
 import System.Exit
-import System.Posix.Signals         ( raiseSignal, sigTSTP )
+import System.Posix.Signals (raiseSignal, sigTSTP)
 import Yi.Buffer
 import Yi.Config
 import Yi.Editor
@@ -44,24 +44,17 @@
 import Yi.UI.Utils
 import Yi.UI.TabBar
 
-------------------------------------------------------------------------
-
 data Rendered = 
-    Rendered {
-              picture :: !Image           -- ^ the picture currently displayed.
-             ,cursor  :: !(Maybe (Int,Int)) -- ^ cursor point on the above
+    Rendered { picture :: !Image             -- ^ the picture currently displayed.
+             , cursor  :: !(Maybe (Int,Int)) -- ^ cursor point on the above
              }
 
-
-
-
-data UI = UI { 
-              vty       :: Vty              -- ^ Vty
-             ,scrsize   :: IORef (Int,Int)  -- ^ screen size
-             ,uiThread  :: ThreadId
-             ,uiRefresh :: MVar ()
-             ,uiEditor  :: IORef Editor     -- ^ Copy of the editor state, local to the UI
-             ,config  :: Config
+data UI = UI {  vty       :: Vty             -- ^ Vty
+             , scrsize    :: IORef (Int,Int) -- ^ screen size
+             , uiThread   :: ThreadId
+             , uiRefresh  :: MVar ()
+             , uiEditor   :: IORef Editor    -- ^ Copy of the editor state, local to the UI
+             , config     :: Config
              }
 
 mkUI :: UI -> Common.UI
@@ -187,75 +180,55 @@
   logPutStrLn "refreshing screen."
   (yss,xss) <- readRef (scrsize ui)
   let ws' = computeHeights (yss - tabBarHeight) ws
-      cmd = statusLine e
+      (cmd, cmdSty) = statusLineInfo e
       renderSeq = fmap (scrollAndRenderWindow (configUI $ config ui) xss) (WS.withFocus ws')
       (e', renders) = runEditor (config ui) (sequence renderSeq) e
 
   let startXs = scanrT (+) windowStartY (fmap height ws')
       wImages = fmap picture renders
-      statusBarStyle = baseAttributes $ configStyle $ configUI $ config $ ui
+      statusBarStyle = ((appEndo <$> cmdSty) <*> baseAttributes) $ configStyle $ configUI $ config $ ui
       tabBarImages = renderTabBar e' ui xss
   WS.debug "Drawing: " ws'
   logPutStrLn $ "startXs: " ++ show startXs
   Vty.update (vty $ ui) 
-      pic {pImage = vertcat tabBarImages 
-                    <->
-                    vertcat (toList wImages) 
-                    <-> 
-                    withAttributes statusBarStyle (take xss $ cmd ++ repeat ' '),
-           pCursor = case cursor (WS.current renders) of
-                       Just (y,x) -> Cursor x (y + WS.current startXs) 
-                       -- Add the position of the window to the position of the cursor
-                       Nothing -> NoCursor
-                       -- This case can occur if the user resizes the window. 
-                       -- Not really nice, but upon the next refresh the cursor will show.
-                       }
+      pic { pImage  = vertcat tabBarImages
+                      <->
+                      vertcat (toList wImages) 
+                      <-> 
+                      withAttributes statusBarStyle (take xss $ cmd ++ repeat ' ')
+          , pCursor = case cursor (WS.current renders) of
+                        Just (y,x) -> Cursor x (y + WS.current startXs) 
+                        -- Add the position of the window to the position of the cursor
+                        Nothing -> NoCursor
+                        -- This case can occur if the user resizes the window. 
+                        -- Not really nice, but upon the next refresh the cursor will show.
+          }
 
   return e'
 
-{- Produces a possible empty list of images that represent the tab bar.
- - The current tab bar image is basic: A single horizontal line divided into a number of segments
- - equal to the number of tabs. Plus maybe a bit extra to make up for a screen width that is not a
- - multiple of the number of tabs.
- - The tab current in focus is indicated by a segment of spaces. 
- - While the out of focus tabs are all segments filled with # characters.
- - 
- - TODO: Provide a hint as to what the tabs contain.
- - TODO: If there are too many tabs to be contained on a single line spill over onto the next line.
- -}
+-- | Construct images for the tabbar if at least one tab exists.
 renderTabBar :: Editor -> UI -> Int -> [Image]
-renderTabBar e ui xss = 
-    let tabCount = WS.size $ tabs e
-    in if tabCount > 1
-        then 
-            let tabWidth = xss `div` tabCount
-                descr = tabBarDescr e (tabWidth - 5) (configStyle $ configUI $ config $ ui)
-                tabImages = fmap (tabToVtyImage tabWidth) descr
-                -- If the screen width is not a multiple of the tab width then characters have to be
-                -- added to make them the same. Otherwise Vty will error out when trying to
-                -- vertically concat two images with different widths.
-                extraCount = xss - (tabWidth * WS.size tabImages)
-                extraStyle = modelineAttributes $ configStyle $ configUI $ config $ ui
-                extraImage = withAttributes extraStyle $ replicate extraCount '#'
-                finalImage = if extraCount /= 0
-                    then foldr (<|>) extraImage tabImages
-                    else foldr1 (<|>) tabImages
-            in [finalImage]
-        else []
-    where 
-        -- From an abstract description of a tab to a VTY image of the tab.
-        tabToVtyImage width (TabDescr txt sty inFocus) = 
-            let pad = replicate (width - length txt - 5) ' '
-                spacers = if inFocus then (">>", "<<") else ("  ", "  ")
-            in withAttributes sty $ (fst spacers) ++ txt ++ (snd spacers) ++ pad ++ "|"
+renderTabBar e ui xss =
+  if tabCount > 1
+    then [tabImages <|> extraImage]
+    else []
+  where tabCount        = WS.size $ tabs e
 
+        tabImages       = foldr1 (<|>) $ fmap tabToVtyImage $ tabBarDescr e
+        extraImage      = withAttributes (tabBarAttributes uiStyle) (replicate (xss-totalTabWidth) ' ')
+
+        totalTabWidth   = imgWidth tabImages
+        uiStyle         = configStyle $ configUI $ config $ ui
+        tabTitle text   = " " ++ text ++ " "
+        tabAttributes f = appEndo ((if f then tabInFocusStyle else tabNotFocusedStyle) uiStyle) (tabBarAttributes uiStyle)
+        tabToVtyImage (TabDescr text inFocus) = withAttributes (tabAttributes inFocus) (tabTitle text)
+
 scanrT :: (Int -> Int -> Int) -> Int -> WindowSet Int -> WindowSet Int
 scanrT (+*+) k t = fst $ runState (mapM f t) k
     where f x = do s <- get
                    let s' = s +*+ x
                    put s'
                    return s
-           
 
 -- | Scrolls the window to show the point if needed, and return a rendered wiew of the window.
 scrollAndRenderWindow :: UIConfig -> Int -> (Window, Bool) -> EditorM Rendered
@@ -291,21 +264,19 @@
         ground = baseAttributes sty
         wsty = attributesToAttr ground attr
         eofsty = appEndo (eofStyle sty) ground
-        (selReg, _) = runBuffer win b getSelectRegionB
         (point, _) = runBuffer win b pointB
         (eofPoint, _) = runBuffer win b sizeB
         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 (WinMarks fromM _ _ toM), _) = runBuffer win b (getMarks win)
+        (Just (MarkSet fromM _ _ toM), _) = runBuffer win b (getMarks win)
         fromMarkPoint = if notMini
                             then fst $ runBuffer win b (getMarkPointB fromM)
                             else Point 0
         (text, _)    = runBuffer win b (indexedStreamB Forward fromMarkPoint) -- read chars from the buffer, lazily
-        (showSel, _) = runBuffer win b (gets highlightSelection)
-        extraLayers = if showSel then [[(regionStart selReg, selectedStyle, regionEnd selReg)]] else []
-        (picture, _) = runBuffer win b (attributesPictureB sty mre region extraLayers)
-        colors = map (second (($ attr) . attributesToAttr)) picture
+        
+        (attributes, _) = runBuffer win b $ attributesPictureAndSelB sty mre region 
+        colors = map (second (($ attr) . attributesToAttr)) attributes
         bufData = -- trace (unlines (map show text) ++ unlines (map show $ concat strokes)) $ 
                   paintChars attr colors text
         tabWidth = tabSize . fst $ runBuffer win b indentSettingsB
@@ -352,14 +323,14 @@
 
   -- fill lines with blanks, so the selection looks ok.
   rendered_lines = map fillColorLine lns0
-  colorChar (c, (a, aPoint)) = renderChar a c
+  colorChar (c, (a, _aPoint)) = renderChar a c
 
   fillColorLine :: [(Char, (Vty.Attr, Point))] -> Image
   fillColorLine [] = renderHFill attr ' ' w
   fillColorLine l = horzcat (map colorChar l) 
                     <|>
                     renderHFill a ' ' (w - length l)
-                    where (_,(a,x)) = last l
+                    where (_,(a,_x)) = last l
 
   -- | Cut a string in lines separated by a '\n' char. Note
   -- that we add a blank character where the \n was, so the
@@ -385,7 +356,6 @@
 withAttributes :: Attributes -> String -> Image
 withAttributes sty str = renderBS (attributesToAttr sty attr) (B.pack str)
 
-
 ------------------------------------------------------------------------
 
 userForceRefresh :: UI -> IO ()
@@ -427,44 +397,34 @@
 
 ------------------------------------------------------------------------
 
---
--- Combine attribute with another attribute
---
-boldA, reverseA, nullA :: Vty.Attr -> Vty.Attr
-boldA       = setBold
-reverseA    = setRV
-nullA       = id
-
-------------------------------------------------------------------------
-
 -- | Convert a Yi Attr into a Vty attribute change.
 colorToAttr :: (Vty.Attr -> Vty.Attr) -> (Vty.Color -> Vty.Attr -> Vty.Attr) -> Vty.Color -> Style.Color -> (Vty.Attr -> Vty.Attr)
 colorToAttr bold set unknown c =
   case c of 
-    RGB 0 0 0         -> nullA    . set Vty.black
+    RGB 0 0 0         -> id       . set Vty.black
     RGB 128 128 128   -> bold     . set Vty.black
-    RGB 139 0 0       -> nullA    . set Vty.red
+    RGB 139 0 0       -> id       . set Vty.red
     RGB 255 0 0       -> bold     . set Vty.red
-    RGB 0 100 0       -> nullA    . set Vty.green
+    RGB 0 100 0       -> id       . set Vty.green
     RGB 0 128 0       -> bold     . set Vty.green
-    RGB 165 42 42     -> nullA    . set Vty.yellow
+    RGB 165 42 42     -> id       . set Vty.yellow
     RGB 255 255 0     -> bold     . set Vty.yellow
-    RGB 0 0 139       -> nullA    . set Vty.blue
+    RGB 0 0 139       -> id       . set Vty.blue
     RGB 0 0 255       -> bold     . set Vty.blue
-    RGB 128 0 128     -> nullA    . set Vty.magenta
+    RGB 128 0 128     -> id       . set Vty.magenta
     RGB 255 0 255     -> bold     . set Vty.magenta
-    RGB 0 139 139     -> nullA    . set Vty.cyan
+    RGB 0 139 139     -> id       . set Vty.cyan
     RGB 0 255 255     -> bold     . set Vty.cyan
-    RGB 165 165 165   -> nullA    . set Vty.white
+    RGB 165 165 165   -> id       . set Vty.white
     RGB 255 255 255   -> bold     . set Vty.white
-    Default           -> nullA    . set Vty.def
-    Reverse           -> reverseA . set Vty.def
-    _                 -> nullA    . set unknown -- NB
+    Default           -> id       . set Vty.def
+    _                 -> id       . set unknown -- NB
 
 attributesToAttr :: Attributes -> (Vty.Attr -> Vty.Attr)
-attributesToAttr (Attributes fg bg) =
-  colorToAttr boldA setFG Vty.black fg .
-  colorToAttr nullA setBG Vty.white bg
+attributesToAttr (Attributes fg bg reverse) =
+  (if reverse then setRV else id) .
+  colorToAttr setBold setFG Vty.black fg .
+  colorToAttr id      setBG Vty.white bg
 
 
 ---------------------------------
diff --git a/tests/TestSuite.hs b/tests/TestSuite.hs
--- a/tests/TestSuite.hs
+++ b/tests/TestSuite.hs
@@ -5,7 +5,7 @@
 
 import Data.Traversable
 import Control.Monad.Identity
-import Text.Show.Functions
+import Text.Show.Functions ()
 
 main :: IO ()
 main = Driver.main tests
@@ -25,5 +25,4 @@
      ("WindowSet prop_traversable" , mytest (prop_traversable :: WindowSet Int -> (Int -> Int) -> Bool))
     ]
 
--- instance Show (a -> b) where
---    show f = "<func>"
+
diff --git a/yi.cabal b/yi.cabal
--- a/yi.cabal
+++ b/yi.cabal
@@ -1,5 +1,5 @@
 name:           yi
-version:        0.5.0.1
+version:        0.5.2
 category:       Development, Editor
 synopsis:       The Haskell-Scriptable Editor
 description:
@@ -11,7 +11,7 @@
 maintainer:     yi-devel@googlegroups.com
 homepage:       http://haskell.org/haskellwiki/Yi
 
-Cabal-Version:  >= 1.4
+Cabal-Version:  >= 1.6
 tested-with:    GHC==6.8.3
 build-type:     Simple
 data-files:
@@ -84,6 +84,7 @@
         Yi.Event
         Yi.File
         Yi.History
+        Yi.IReader
         Yi.IncrementalParse
         Yi.Interact
         Yi.Interpreter
@@ -103,7 +104,9 @@
         Yi.Lexer.Haskell
         Yi.Lexer.Latex 
         Yi.Lexer.LiterateHaskell
+        Yi.Lexer.GNUMake
         Yi.Lexer.OCaml
+        Yi.Lexer.Ott
         Yi.Lexer.Perl
         Yi.Lexer.Python
         Yi.Lexer.Srmc
@@ -113,7 +116,9 @@
         Yi.MkTemp
         Yi.Mode.Compilation
         Yi.Mode.Haskell
+        Yi.Mode.IReader
         Yi.Mode.Interactive
+        Yi.Mode.Latex
         Yi.Modes
         Yi.Monad
         Yi.Prelude
@@ -131,8 +136,10 @@
         Yi.Syntax.Latex
         Yi.Syntax.Layout
         Yi.Syntax.Linear
+        Yi.Syntax.OnlineTree
         Yi.Syntax.Paren
         Yi.Syntax.Tree
+        Yi.Tag
         Yi.Templates
         Yi.TextCompletion,
         Yi.UI.Common
@@ -188,6 +195,7 @@
         -- Should probably be split out to another package.
         Data.ByteRope
         Data.DelayList
+        Data.Trie
         Shim.CabalInfo
         Shim.Utils 
         Shim.ProjectContent
@@ -201,22 +209,16 @@
 --                Yi.Keymap.Nano,
 --                Yi.Keymap.Vi,
 
---  extensions:   CPP, DeriveDataTypeable, FlexibleContexts, FlexibleInstances,
---                ForeignFunctionInterface, FunctionalDependencies, GADTs,
---                GeneralizedNewtypeDeriving, MagicHash, MultiParamTypeClasses,
---                ParallelListComp, PatternGuards, PatternSignatures, Rank2Types,
---                ScopedTypeVariables TypeSynonymInstances, UndecidableInstances
 
-
-
 executable yi
         build-tools:   alex >= 2.0.1 && < 3
         -- haddock >= 2.2,
         -- it seems harsh to require haddock 2.2 to even configure Yi
 
-        build-depends: Cabal >= 1.4 && < 1.5
+        build-depends: Cabal >= 1.6 && < 1.7
         build-depends: Diff >=0.1 && <0.2
-        build-depends: array,  base,  containers,  directory, mtl, process, old-locale, old-time, random
+        build-depends: array, containers,  directory, mtl, process, old-locale, old-time, random
+        build-depends: base == 3.*
         build-depends: binary >=0.4.2 && <0.5
         build-depends: bytestring >=0.9.1 && <0.9.2
         -- build-depends: derive >=0.1 && <0.2 
@@ -224,11 +226,12 @@
         -- --> can't use.
         build-depends: filepath>=1.1 && <1.2
         build-depends: fingertree >= 0 && <0.1
+        build-depends: ghc-paths ==0.1.*
         build-depends: parsec >= 3 && <= 3.0.2
         build-depends: unix-compat >=0.1 && <0.2
         build-depends: pureMD5 >= 0.2.3
-        build-depends: regex-base ==0.93.1
-        build-depends: regex-tdfa ==0.94        
+        build-depends: regex-base ==0.93.*
+        build-depends: regex-tdfa >=0.95.2
         build-depends: rosezipper >= 0.1 && < 0.2
         build-depends: utf8-string >= 0.3.1
 
@@ -259,16 +262,15 @@
           cpp-options: -DFRONTEND_COCOA
 
         if flag (ghcAPI)
-          build-depends: ghc==6.8.3
+          build-depends: ghc == 6.8.3 || == 6.10.1
           build-depends: haskell98
-          build-depends: ghc-paths >=0.1.0.5 && < 0.1.2
           cpp-options: -DGHC_API
 
         if !(flag(vty) || flag (gtk) || flag(cocoa))
          buildable: False
 
         main-is:        Main.hs
- 
+
         other-modules:
            Yi
            Yi.Prelude
@@ -299,12 +301,15 @@
            Yi.Lexer.Latex 
            Yi.Lexer.Srmc
            Yi.Lexer.Cabal
+           Yi.Lexer.GNUMake
            Yi.Lexer.OCaml
+           Yi.Lexer.Ott
            Yi.Lexer.Perl
            Yi.Lexer.Python
 
            Yi.Syntax
            Yi.Syntax.Layout
+           Yi.Syntax.OnlineTree
            Yi.Syntax.Paren
            Yi.Syntax.Fractal
            Yi.Syntax.Latex
@@ -313,7 +318,7 @@
 
            Yi.Mode.Interactive
 
-           Yi.Accessor, Yi.Interpreter,
+           Yi.Interpreter,
            Yi.Buffer.Indent
            Yi.Buffer.HighLevel, Yi.Buffer.Implementation,
            Yi.Buffer.Normal, Yi.Buffer.Region, Yi.Completion, Yi.Core,