Merge branch 'master' into bootstrap-dev

src/library/Shim/CabalInfo.hs

@@ -2,10 +2,10 @@ module Shim.CabalInfo where
 
 import Shim.Utils
 
-import qualified Control.OldException as CE
 import System.FilePath
 import Control.Monad.State
 
+import Control.Exc
 import Control.Applicative
 import Distribution.ModuleName
 import Distribution.PackageDescription
@@ -20,10 +20,10 @@ guessCabalFile sourcefile = do
   recurseDir findCabalFile dir  -- "/bar/foo/s.hs" -> "/bar/foo"
  where findCabalFile dir = do
          logS $ "looking in: " ++ dir
-         pdfile <- CE.try (findPackageDesc dir) :: IO (Either CE.Exception (Maybe FilePath))
+         pdfile <- ignoringException (findPackageDesc dir)
          case pdfile of
-           Right (Just f) -> return . Just $ dir </> f
-           _ -> return Nothing
+           Just f  -> return . Just $ dir </> f
+           Nothing -> return Nothing
 
 -- | Guess what lib\/exe the sourcefile belongs to.
 guessCabalStanza :: FilePath -> FilePath -> PackageDescription -> IO (Maybe String, BuildInfo)

src/library/System/CanonicalizePath.hs

@@ -13,9 +13,10 @@ import qualified System.Win32 as Win32
 import Control.Applicative
 import Control.Monad
 import Data.List.Split     (splitOn)
-import System.FilePath     ((</>), isAbsolute, takeDirectory, pathSeparator)
+import System.FilePath     ((</>), isDrive, isAbsolute, takeDirectory, pathSeparator, normalise)
 import System.Directory    (getCurrentDirectory)
-import System.Posix.Files  (readSymbolicLink)
+import System.PosixCompat.Files  (readSymbolicLink)
+import Control.Exc          (ignoringException)
 
 
 -- | Removes `/./` `//` and `/../` sequences from path,
@@ -33,7 +34,7 @@ canonicalizePath path = do
   absPath <- makeAbsolute path
   foldM (\x y -> expandSym $ combinePath x y) "/" $ splitPath absPath
 #else
-  Win32.getFullPathName . normalise
+  Win32.getFullPathName . normalise $ path
 #endif
 
 -- | Dereferences symbolic links until regular
@@ -42,12 +43,11 @@ expandSym :: FilePath -> IO FilePath
 expandSym fpath = do
   -- System.Posix.Files.getFileStatus dereferences symlink before
   -- checking its status, so it's useless here
-  deref <- catch (Just <$> readSymbolicLink fpath) (\_ -> return Nothing)
+  deref <- ignoringException (Just <$> readSymbolicLink fpath)
   case deref of
     Just slink -> if isAbsolute slink then expandSym slink
                   else expandSym $ foldl combinePath (takeDirectory fpath) $ splitPath slink
-    Nothing -> return fpath
-
+    Nothing -> return fpath 
 
 -- | Make a path absolute.
 makeAbsolute :: FilePath -> IO FilePath
@@ -59,7 +59,9 @@ makeAbsolute f
 combinePath :: FilePath -> String -> FilePath
 combinePath x "."  = x
 combinePath x ".." = takeDirectory x
-combinePath x y = x </> y
+combinePath x y
+    | isDrive x = (x ++ [pathSeparator]) </> y -- "C:" </> "bin" = "C:bin"
+    | otherwise = x </> y
 
 -- | Splits path into parts by path separator
 splitPath :: FilePath -> [String]

src/library/System/FriendlyPath.hs

@@ -6,7 +6,7 @@ module System.FriendlyPath
 
 import Control.Applicative
 import System.FilePath
-import System.Posix.User (getUserEntryForName, homeDirectory)
+import System.PosixCompat.User (getUserEntryForName, homeDirectory)
 import System.CanonicalizePath
 import System.Directory hiding (canonicalizePath)
 

src/library/Yi/Buffer/HighLevel.hs

@@ -41,7 +41,9 @@ botB = moveTo =<< sizeB
 
 -- | Move left if on eol, but not on blank line
 leftOnEol :: BufferM ()
-leftOnEol = do
+-- @savingPrefCol@ is needed, because deep down @leftB@ contains @forgetPrefCol@
+-- which messes up vertical cursor motion in Vim normal mode
+leftOnEol = savingPrefCol $ do
         eol <- atEol
         sol <- atSol
         when (eol && not sol) leftB

src/library/Yi/Buffer/Misc.hs

@@ -75,8 +75,10 @@ module Yi.Buffer.Misc
   , getModeLine
   , getPercent
   , setInserting
+  , savingPrefCol
   , forgetPreferCol
   , movingToPrefCol
+  , getPrefCol
   , setPrefCol
   , markSavedB
   , addOverlayB
@@ -338,6 +340,12 @@ file b = case b ^. identA of
 preferColA :: Accessor FBuffer (Maybe Int)
 preferColA = preferColAA . attrsA
 
+setPrefCol :: Maybe Int -> BufferM ()
+setPrefCol = putA preferColA
+
+getPrefCol :: BufferM (Maybe Int)
+getPrefCol = getA preferColA
+
 bufferDynamicA :: Accessor FBuffer DynamicValues
 bufferDynamicA = bufferDynamicAA . attrsA
 
@@ -450,7 +458,6 @@ getModeLine prefix = withModeB (\m -> (modeModeLine m) prefix)
 
 defaultModeLine :: [String] -> BufferM String
 defaultModeLine prefix = do
-    col <- curCol
     col <- curCol
     pos <- pointB
     ln <- curLn
@@ -460,7 +467,9 @@ defaultModeLine prefix = do
     ro <-getA readOnlyA
     modeNm <- gets (withMode0 modeName)
     unchanged <- gets isUnchangedBuffer
-    let pct = if pos == 1 then "Top" else getPercent p s
+    let pct = if (pos == 1) || (s == 0)
+                then "Top"
+                else getPercent p s
         chg = if unchanged then "-" else "*"
         roStr = if ro  then "%" else chg
         hexChar = "0x" ++ Numeric.showHex (Data.Char.ord curChar) ""
@@ -479,7 +488,9 @@ defaultModeLine prefix = do
 -- | Given a point, and the file size, gives us a percent string
 getPercent :: Point -> Point -> String
 getPercent a b = show p ++ "%"
-    where p = ceiling (fromIntegral a / fromIntegral b * 100 :: Double) :: Int
+    where p = ceiling (aa / bb * 100.0 :: Double) :: Int
+          aa = fromIntegral a :: Double 
+          bb = fromIntegral b :: Double
 
 queryBuffer :: (forall syntax. BufferImpl syntax -> x) -> BufferM x
 queryBuffer f = gets (\(FBuffer _ fb _) -> f fb)
@@ -892,9 +903,6 @@ rightN = moveN
 -- ---------------------------------------------------------------------
 -- Line based movement and friends
 
-setPrefCol :: Maybe Int -> BufferM ()
-setPrefCol = putA preferColA
-
 -- | Move point down by @n@ lines. @n@ can be negative.
 -- Returns the actual difference in lines which we moved which
 -- may be negative if the requested line difference is negative.
@@ -903,7 +911,7 @@ lineMoveRel = movingToPrefCol . gotoLnFrom
 
 movingToPrefCol :: BufferM a -> BufferM a
 movingToPrefCol f = do
-  prefCol <- getA preferColA
+  prefCol <- getPrefCol
   targetCol <- maybe curCol return prefCol
   r <- f
   moveToColB targetCol
@@ -929,7 +937,7 @@ forgetPreferCol = setPrefCol Nothing
 
 savingPrefCol :: BufferM a -> BufferM a
 savingPrefCol f = do
-  pc <- getA preferColA
+  pc <- getPrefCol
   result <- f
   setPrefCol pc
   return result

src/library/Yi/Command.hs

@@ -7,7 +7,7 @@ module Yi.Command where
 import Data.Binary
 import System.Exit
   ( ExitCode( ExitSuccess,ExitFailure ) )
-import Control.OldException
+import Control.Exception(SomeException)
 import Control.Monad.Trans (MonadIO (..))
 {- External Library Module Imports -}
 {- Local (yi) module imports -}
@@ -61,7 +61,7 @@ instance YiVariable CabalBuffer
 cabalConfigureE :: CommandArguments -> YiM ()
 cabalConfigureE = cabalRun "configure" configureExit
 
-configureExit :: Either Exception ExitCode -> YiM ()
+configureExit :: Either SomeException ExitCode -> YiM ()
 configureExit (Right ExitSuccess) = reloadProjectE "."
 configureExit _ = return ()
 
@@ -71,7 +71,7 @@ reloadProjectE s = withUI $ \ui -> reloadProject ui s
 
 -- | Run the given commands with args and pipe the ouput into the build buffer,
 -- which is shown in an other window.
-buildRun :: String -> [String] -> (Either Exception ExitCode -> YiM x) -> YiM ()
+buildRun :: String -> [String] -> (Either SomeException ExitCode -> YiM x) -> YiM ()
 buildRun cmd args onExit = withOtherWindow $ do
    b <- startSubprocess cmd args onExit
    withEditor $ do
@@ -83,7 +83,7 @@ buildRun cmd args onExit = withOtherWindow $ do
 makeBuild :: CommandArguments -> YiM ()
 makeBuild (CommandArguments args) = buildRun "make" args (const $ return ())
 
-cabalRun :: String -> (Either Exception ExitCode -> YiM x) -> CommandArguments -> YiM ()
+cabalRun :: String -> (Either SomeException ExitCode -> YiM x) -> CommandArguments -> YiM ()
 cabalRun cmd onExit (CommandArguments args) = buildRun "cabal" (cmd:args) onExit
 
 -----------------------

src/library/Yi/Completion.hs

@@ -3,6 +3,7 @@
 
 module Yi.Completion 
   ( completeInList, completeInList'
+  , completeInListCustomShow
   , commonPrefix
   , prefixMatch, infixMatch
   , containsMatch', containsMatch, containsMatchCaseInsensitive
@@ -49,16 +50,20 @@ containsMatchCaseInsensitive = containsMatch' False
 -- and a list of possibilites.  Matching function should return the
 -- part of the string that matches the user string.
 completeInList :: String -> (String -> Maybe String) -> [String] -> EditorM String
-completeInList s match l
+completeInList = completeInListCustomShow id
+
+-- | Same as 'completeInList', but maps @showFunction@ on possible matches when printing
+completeInListCustomShow :: (String -> String) -> String -> (String -> Maybe String) ->
+                            [String] -> EditorM String
+completeInListCustomShow showFunction s match possibilities
     | null filtered = printMsg "No match" >> return s
     | prefix /= s = return prefix
     | isSingleton filtered = printMsg "Sole completion" >> return s
     | prefix `elem` filtered = printMsg ("Complete, but not unique: " ++ show filtered) >> return s
-    | otherwise = printMsgs filtered >> return s
+    | otherwise = printMsgs (map showFunction filtered) >> return s
     where
-    prefix   = commonPrefix filtered
-    -- filtered = nub $ catMaybes $ fmap match l
-    filtered = filterMatches match l
+      prefix   = commonPrefix filtered
+      filtered = filterMatches match possibilities
 
 completeInList' :: String -> (String -> Maybe String) -> [String] -> EditorM String
 completeInList' s match l

src/library/Yi/Config/Default.hs

@@ -236,18 +236,33 @@ nilKeymap = choice [
                           "You should however create your own ~/.yi/yi.hs file: ",
                           "You can type 'c', 'e' or 'v' now to create and edit it using a temporary cua, emacs or vim keymap."]
           openCfg km kmName = write $ do
-            dataDir <- io $ getDataDir
+            dataDir <- io getDataDir
             let exampleCfg = dataDir </> "example-configs" </> kmName
-            homeDir <- io $ getHomeDirectory
-            let cfgDir = homeDir </> ".yi"
-                cfgFile = cfgDir </> "yi.hs"
-            cfgExists <- io $ doesFileExist cfgFile
-            -- io $ print cfgExists
-            io $ createDirectoryIfMissing True cfgDir -- so that the file can be saved.
+            homeDir <- io getHomeDirectory
+            cfgDir <- io $ getAppUserDataDirectory "yi"
+            let cfgFile = cfgDir </> "yi.hs"
+            cfgExists <- io $ doesFileExist cfgDir
+            io $ createDirectoryIfMissing True cfgDir -- so that the file can be saved
             discard $ editFile cfgFile -- load config file
             -- locally override the keymap to the user choice
-            withBuffer $ modifyMode (\m -> m {modeKeymap = const km})
+            withBuffer $ modifyMode (\m -> m { modeKeymap = const km })
             when (not cfgExists) $ do
-                 -- file did not exist, load a reasonable default
-                 defCfg <- io $ readFile exampleCfg
-                 withBuffer $ insertN defCfg
+                -- file did not exist, load a reasonable default
+                defCfg <- io $ readFile exampleCfg
+                withBuffer $ insertN defCfg
+--          openCfg km kmName = write $ do
+--            dataDir <- io $ getDataDir
+--            let exampleCfg = dataDir </> "example-configs" </> kmName
+--            homeDir <- io $ getHomeDirectory
+--            let cfgDir = homeDir </> ".yi"
+--                cfgFile = cfgDir </> "yi.hs"
+--            cfgExists <- io $ doesFileExist cfgFile
+--            -- io $ print cfgExists
+--            io $ createDirectoryIfMissing True cfgDir -- so that the file can be saved.
+--            discard $ editFile cfgFile -- load config file
+--            -- locally override the keymap to the user choice
+--            withBuffer $ modifyMode (\m -> m {modeKeymap = const km})
+--            when (not cfgExists) $ do
+--                 -- file did not exist, load a reasonable default
+--                 defCfg <- io $ readFile exampleCfg
+--                 withBuffer $ insertN defCfg

src/library/Yi/Core.hs

@@ -52,7 +52,8 @@ import Control.Monad (forever)
 import Control.Monad.Error ()
 import Control.Monad.Reader (ask)
 import Control.Monad.Trans
-import Control.OldException
+import Control.Exception
+import Control.Exc
 import qualified Data.DelayList as DelayList
 import Data.List (intercalate, partition)
 import Data.List.Split (splitOn)
@@ -113,7 +114,7 @@ startEditor cfg st = do
     -- Setting up the 1st window is a bit tricky because most functions assume there exists a "current window"
     newSt <- newMVar $ YiVar editor [] 1 M.empty
     (ui, runYi) <-
-      do rec let handler exception = runYi $ errorEditor (show exception) >> refreshEditor
+      do rec let handler (exception :: SomeException) = runYi $ errorEditor (show exception) >> refreshEditor
                  inF ev    = handle handler $ runYi $ dispatch ev
                  outF acts = handle handler $ runYi $ interactive acts
                  runYi f   = runReaderT (runYiM f) yi
@@ -361,7 +362,7 @@ terminateSubprocesses shouldTerminate _yi var = do
         return (var {yiSubprocesses = M.fromList toKeep}, ())
 
 -- | Start a subprocess with the given command and arguments.
-startSubprocess :: FilePath -> [String] -> (Either Exception ExitCode -> YiM x) -> YiM BufferRef
+startSubprocess :: FilePath -> [String] -> (Either SomeException ExitCode -> YiM x) -> YiM BufferRef
 startSubprocess cmd args onExit = onYiVar $ \yi var -> do
         let (e', bufref) = runEditor 
                               (yiConfig yi) 
@@ -376,7 +377,7 @@ startSubprocess cmd args onExit = onYiVar $ \yi var -> do
                     }, bufref)
   where bufferName = "output from " ++ cmd ++ " " ++ show args
 
-startSubprocessWatchers :: SubprocessId -> SubprocessInfo -> Yi -> (Either Exception ExitCode -> YiM x) -> IO ()
+startSubprocessWatchers :: SubprocessId -> SubprocessInfo -> Yi -> (Either SomeException ExitCode -> YiM x) -> IO ()
 startSubprocessWatchers procid procinfo yi onExit = do
     mapM_ forkOS ([pipeToBuffer (hErr procinfo) (send . append True) | separateStdErr procinfo] ++
                   [pipeToBuffer (hOut procinfo) (send . append False),
@@ -411,12 +412,17 @@ sendToProcess bufref s = do
 
 pipeToBuffer :: Handle -> (String -> IO ()) -> IO ()
 pipeToBuffer h append = 
-  handle (const $ return ()) $ forever $ (hWaitForInput h (-1) >> readAvailable h >>= append)
+  do _ <- ignoringException $ forever $ (do _ <- hWaitForInput h (-1) 
+                                            r <- readAvailable h 
+                                            _ <- append r
+                                            return ())
+     return ()
+
 
 
-waitForExit :: ProcessHandle -> IO (Either Exception ExitCode)
+waitForExit :: ProcessHandle -> IO (Either SomeException ExitCode)
 waitForExit ph = 
-    handle (\e -> return (Left e)) $ do 
+    handle (\e -> return (Left (e :: SomeException))) $ do 
       mec <- getProcessExitCode ph
       case mec of
           Nothing -> threadDelay (500*1000) >> waitForExit ph