Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Merge branch 'master' into bootstrap-dev

  • Loading branch information...
commit 1814e00d385b0848df3b50411e963dc1158382dd 2 parents b150576 + 641f238
Corey O'Connor coreyoconnor authored
8 src/library/Shim/CabalInfo.hs
View
@@ -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)
16 src/library/System/CanonicalizePath.hs
View
@@ -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]
2  src/library/System/FriendlyPath.hs
View
@@ -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)
4 src/library/Yi/Buffer/HighLevel.hs
View
@@ -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
24 src/library/Yi/Buffer/Misc.hs
View
@@ -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
@@ -451,7 +459,6 @@ getModeLine prefix = withModeB (\m -> (modeModeLine m) prefix)
defaultModeLine :: [String] -> BufferM String
defaultModeLine prefix = do
col <- curCol
- col <- curCol
pos <- pointB
ln <- curLn
p <- pointB
@@ -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
8 src/library/Yi/Command.hs
View
@@ -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
-----------------------
15 src/library/Yi/Completion.hs
View
@@ -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
37 src/library/Yi/Config/Default.hs
View
@@ -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
20 src/library/Yi/Core.hs
View
@@ -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
36 src/library/Yi/Dired.hs
View
@@ -26,7 +26,7 @@ module Yi.Dired
, diredDirBuffer
) where
-import Prelude (catch, realToFrac)
+import Prelude (realToFrac)
import qualified Codec.Binary.UTF8.String as UTF8
import Control.Monad.Reader hiding (mapM)
@@ -46,6 +46,7 @@ import System.Locale
import System.PosixCompat.Files
import System.PosixCompat.Types
import System.PosixCompat.User
+import Control.Exc
import Text.Printf
import Yi.Core hiding (sequence, forM, notElem)
@@ -125,43 +126,36 @@ modDiredOpState f = withBuffer $ modA bufferDynamicValueA f
-- Pass the list of remaining operations down, insert new ops at the head if needed
procDiredOp :: Bool -> [DiredOp] -> YiM ()
procDiredOp counting ((DORemoveFile f):ops) = do
- io $ catch (removeLink f) handler
+ io $ printingException ("Remove file " ++ f) (removeLink f)
when counting postproc
procDiredOp counting ops
- where handler err = fail $ concat ["Remove file ", f,
- " failed: ", show err]
- postproc = do incDiredOpSucCnt
+ where postproc = do incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName f)
procDiredOp counting ((DORemoveDir f):ops) = do
- io $ catch (removeDirectoryRecursive f) handler
+ io $ printingException ("Remove directory " ++ f) (removeDirectoryRecursive f)
-- document suggests removeDirectoryRecursive will follow
-- symlinks in f, but it seems not the case, at least on OS X.
when counting postproc
procDiredOp counting ops
- where handler err = fail $ concat ["Remove directory ", f,
- " failed: ", show err]
- postproc = do
+ where postproc = do
incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName f)
procDiredOp _counting ((DORemoveBuffer _):_) = undefined -- TODO
procDiredOp counting ((DOCopyFile o n):ops) = do
- io $ catch (copyFile o n) handler
+ io $ printingException ("Copy file " ++ o) (copyFile o n)
when counting postproc
procDiredOp counting ops
- where handler err = fail $ concat ["Copy file ", o,
- " to ", n, " failed: ", show err]
- postproc = do
+ where postproc = do
incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName o)
-- TODO: mark copied files with "C" if the target dir's dired buffer exists
procDiredOp counting ((DOCopyDir o n):ops) = do
- contents <- io $ catch doCopy handler
+ contents <- io $ printingException (concat ["Copy directory ", o, " to ", n]) doCopy
subops <- io $ mapM builder $ filter (`notElem` [".", ".."]) contents
procDiredOp False subops
when counting postproc
procDiredOp counting ops
- where handler err = fail $ concat ["Copy directory ", o, " to ", n, " failed: ", show err]
- postproc = do
+ where postproc = do
incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName o)
-- perform dir copy: create new dir and create other copy ops
@@ -182,12 +176,10 @@ procDiredOp counting ((DOCopyDir o n):ops) = do
procDiredOp counting ((DORename o n):ops) = do
- io $ catch (rename o n) handler
+ io $ printingException (concat ["Rename ", o, " to ", n]) (rename o n)
when counting postproc
procDiredOp counting ops
- where handler err = fail $ concat ["Rename ", o,
- " to ", n, " failed: ", show err]
- postproc = do
+ where postproc = do
incDiredOpSucCnt
withBuffer $ diredUnmarkPath (takeFileName o)
procDiredOp counting r@((DOConfirm prompt eops enops):ops) = do
@@ -468,8 +460,8 @@ diredScanDir dir = do
_filenm <- if (isSymbolicLink fileStatus) then
return . ((++) (takeFileName fp ++ " -> ")) =<< readSymbolicLink fp else
return $ takeFileName fp
- ownerEntry <- catch (getUserEntryForID uid) (const $ getAllUserEntries >>= return . scanForUid uid)
- groupEntry <- catch (getGroupEntryForID gid) (const $ getAllGroupEntries >>= return . scanForGid gid)
+ ownerEntry <- orException (getUserEntryForID uid) (getAllUserEntries >>= return . scanForUid uid)
+ groupEntry <- orException (getGroupEntryForID gid) (getAllGroupEntries >>= return . scanForGid gid)
let fmodeStr = (modeString . fileMode) fileStatus
sz = toInteger $ fileSize fileStatus
ownerStr = userName ownerEntry
7 src/library/Yi/IReader.hs
View
@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, DeriveDataTypeable, ScopedTypeVariables #-}
-- | This module defines a list type and operations on it; it further
-- provides functions which write in and out the list.
-- The goal is to make it easy for the user to store a large number of text buffers
@@ -7,6 +7,8 @@
module Yi.IReader where
import Control.Monad.State (join)
+import Control.Exception
+import Prelude hiding (catch)
import Data.Binary (Binary, decode, encodeFile)
import Data.Sequence as S
import Data.Typeable (Typeable)
@@ -66,11 +68,12 @@ writeDB adb = discard $ io . join . fmap (flip encodeFile adb) $ dbLocation
-- | Read in database from 'dbLocation' and then parse it into an 'ArticleDB'.
readDB :: YiM ArticleDB
-readDB = io $ (dbLocation >>= r) `catch` (\_ -> return initial)
+readDB = io $ (dbLocation >>= r) `catch` returnDefault
where r = fmap (decode . BL.fromChunks . return) . B.readFile
-- We read in with strict bytestrings to guarantee the file is closed,
-- and then we convert it to the lazy bytestring data.binary expects.
-- This is inefficient, but alas...
+ returnDefault (_ :: SomeException) = return initial
-- | The canonical location. We assume \~\/.yi has been set up already.
dbLocation :: IO FilePath
14 src/library/Yi/Keymap.hs
View
@@ -8,9 +8,9 @@ import Control.Applicative
import Control.Concurrent
import Control.Monad.Reader
import Control.Monad.State
-import Control.OldException
+import Control.Exception
import Data.Typeable
-import Prelude hiding (error)
+import Prelude hiding (error, catch)
import Yi.Buffer
import Yi.Config
import Yi.Editor (EditorM, Editor, runEditor, MonadEditor(..))
@@ -120,17 +120,17 @@ withBuffer f = withEditor (Editor.withBuffer0 f)
readEditor :: (Editor -> a) -> YiM a
readEditor f = withEditor (gets f)
-catchDynE :: Typeable exception => YiM a -> (exception -> YiM a) -> YiM a
+catchDynE :: Exception exception => YiM a -> (exception -> YiM a) -> YiM a
catchDynE (YiM inner) handler
- = YiM $ ReaderT (\r -> catchDyn (runReaderT inner r) (\e -> runReaderT (runYiM $ handler e) r))
+ = YiM $ ReaderT (\r -> catch (runReaderT inner r) (\e -> runReaderT (runYiM $ handler e) r))
-catchJustE :: (Exception -> Maybe b) -- ^ Predicate to select exceptions
+catchJustE :: (Exception e) => (e -> Maybe b) -- ^ Predicate to select exceptions
-> YiM a -- ^ Computation to run
-> (b -> YiM a) -- ^ Handler
-> YiM a
catchJustE p (YiM c) h = YiM $ ReaderT (\r -> catchJust p (runReaderT c r) (\b -> runReaderT (runYiM $ h b) r))
-handleJustE :: (Exception -> Maybe b) -> (b -> YiM a) -> YiM a -> YiM a
+handleJustE :: (Exception e) => (e -> Maybe b) -> (b -> YiM a) -> YiM a -> YiM a
handleJustE p h c = catchJustE p c h
-- | Shut down all of our threads. Should free buffers etc.
@@ -185,4 +185,4 @@ modelessKeymapSet k = KeymapSet
, startInsertKeymap = return ()
, topKeymap = k
, startTopKeymap = return ()
- }
+ }
856 src/library/Yi/Keymap/Vim.hs
View
@@ -36,7 +36,9 @@ module Yi.Keymap.Vim (keymapSet,
listTagStack,
pushTagStack,
popTagStack,
- peekTagStack
+ peekTagStack,
+ exMode,
+ exEval
) where
import Prelude (maybe, length, filter, map, drop, break, uncurry, reads)
@@ -44,7 +46,7 @@ import Yi.Prelude
import Data.Binary
import Data.Char
-import Data.List (nub, take, words, dropWhile, takeWhile, intersperse, reverse)
+import Data.List (nub, take, words, dropWhile, takeWhile, intersperse, reverse, isSuffixOf)
import Data.Maybe (fromMaybe, isJust)
import Data.Either (either)
import Data.Prototype
@@ -57,7 +59,7 @@ import System.PosixCompat.Files (fileExist)
#else
import System.Posix (fileExist)
#endif
-import System.FilePath (FilePath)
+import System.FilePath (FilePath, takeFileName)
import System.Directory (getCurrentDirectory, setCurrentDirectory)
import Control.Monad.State hiding (mapM_, mapM, sequence)
@@ -76,7 +78,7 @@ import Yi.Regex (seInput, regexEscapeString)
import Yi.Search
import Yi.Style
import Yi.TextCompletion
-import Yi.Completion (containsMatch', mkIsPrefixOf)
+import Yi.Completion (containsMatch', mkIsPrefixOf, prefixMatch, completeInListCustomShow)
import Yi.Tag
import Yi.Window (bufkey)
import Yi.Hoogle (hoogle, hoogleSearch)
@@ -434,6 +436,21 @@ exInfixComplete' caseSensitive compl s' = do
exInfixComplete :: (String -> YiM [String]) -> String -> YiM ()
exInfixComplete = exInfixComplete' True
+exFileNameComplete :: String -> YiM ()
+exFileNameComplete s' = mkCompleteFn (completeInListCustomShow basename)
+ prefixMatch (matchingFileNames Nothing) s >>=
+ withBuffer . insertN . drop (length s)
+ where s = dropWhile isSpace s'
+
+ -- this tries to resemble 'basename' utility:
+ -- basename "foo/bar.baz" = "bar.baz"
+ -- basename "foo/bar/" = "bar"
+ -- but
+ -- System.FilePath.takeBaseName "foo/bar.baz" = "bar"
+ -- System.FilePath.takeFileName "foo/bar/" = ""
+ basename f = takeFileName $ if "/" `isSuffixOf` f then init f
+ else f
+
mkExHistComplete :: (String -> String -> Bool) -> (String -> YiM [String]) -> String -> YiM ()
mkExHistComplete matchFn compl s =
mkWordComplete (return s) compl (withEditor . printMsgs . tail) matchFn >>=
@@ -696,23 +713,6 @@ defKeymap = Proto template
where
boundedPattern x = "\\<" ++ (regexEscapeString x) ++ "\\>"
- gotoTag :: Tag -> YiM ()
- gotoTag tag =
- visitTagTable $ \tagTable ->
- case lookupTag tag tagTable of
- Nothing -> fail $ "No tags containing " ++ tag
- Just (filename, line) -> do
- when (enableTagStack $ v_opts self)
- viTagStackPushPos
- viFnewE filename
- discard $ withBuffer' $ gotoLn line
- return ()
-
- viTagStackPushPos :: YiM ()
- viTagStackPushPos = withEditor $ do bn <- withBuffer0 $ gets identString
- p <- withBuffer0 pointB
- pushTagStack bn p
-
gotoPrevTagMark :: Int -> YiM ()
gotoPrevTagMark cnt = do
lastP <- withEditor $ popTagStack cnt
@@ -721,29 +721,8 @@ defKeymap = Proto template
Just (fp, p) -> do viFnewE fp
withBuffer' $ moveTo p
- -- | 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 getTagsFileList -- 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))
-
- -- | Parse any character that can be inserted in the text.
- textChar :: KeymapM Char
- textChar = do
- Event (KASCII c) [] <- anyEvent
- return c
+ gotoTagCurrentWord = gotoTag (v_opts self) =<< withEditor (withBuffer0' (readRegionB =<< regionOfNonEmptyB unitViWord))
continueSearching :: (Direction -> Direction) -> EditorM ()
continueSearching fdir = do
@@ -961,6 +940,8 @@ defKeymap = Proto template
,('(', unitDelimited '(' ')')
,(')', unitDelimited '(' ')')
,('b', unitDelimited '(' ')')
+ ,('[', unitDelimited '[' ']')
+ ,(']', unitDelimited '[' ']')
,('{', unitDelimited '{' '}')
,('}', unitDelimited '{' '}')
,('B', unitDelimited '{' '}')
@@ -1090,7 +1071,7 @@ defKeymap = Proto template
,char 'V' ?>> change_vis_mode selStyle LineWise
,char 'v' ?>> change_vis_mode selStyle Inclusive
,ctrlCh 'v'?>> change_vis_mode selStyle Block
- ,char ':' ?>>! ex_mode ":'<,'>"
+ ,char ':' ?>>! (exMode self) ":'<,'>"
,char 'p' ?>>! pasteOverSelection -- TODO repeat
,char 'x' ?>>! (cutSelection >> withBuffer0 leftOnEol) -- TODO repeat
,char 's' ?>> beginIns self (cutSelection >> withBuffer0 (setVisibleSelection False)) -- TODO repeat
@@ -1110,7 +1091,7 @@ defKeymap = Proto template
--
cmd2other :: VimMode
cmd2other =
- choice [char ':' ?>>! ex_mode ":",
+ choice [char ':' ?>>! (exMode self) ":",
char 'v' ?>> vis_mode Inclusive,
char 'V' ?>> vis_mode LineWise,
ctrlCh 'v' ?>> vis_mode Block, -- one use VLine for block mode
@@ -1129,8 +1110,8 @@ defKeymap = Proto template
char 'C' ?>> change NoMove Exclusive viMoveToEol, -- alias of "c$"
char 'S' ?>> change viMoveToSol LineWise viMoveToEol, -- alias of "cc" TODO update
char 's' ?>> change NoMove Exclusive (CharMove Forward), -- non-linewise alias of "cl"
- char '/' ?>>! ex_mode "/",
- char '?' ?>>! ex_mode "?",
+ char '/' ?>>! (exMode self) "/",
+ char '?' ?>>! (exMode self) "?",
leave,
spec KIns ?>> ins_mode self]
@@ -1259,363 +1240,386 @@ TODO: use or remove
<|| do c <- textChar; write $ replaceB c
where replaceB c = do e <- atEol; if e then insertB c else writeB c -- savingInsertCharB ?
- -- ---------------------------------------------------------------------
- -- Ex mode. We also process regex searching mode here.
- --
- findUserCmd :: String -> Maybe VimExCmd
- findUserCmd cmdLine = find ((name `elem`) . cmdNames) $ v_ex_cmds self
- where name = takeWhile (not . isSpace) $ dropWhile isSpace cmdLine
-
- ex_mode :: String -> EditorM ()
- ex_mode prompt = do
- -- The above ensures that the action is performed on the buffer that originated the minibuffer.
- let ex_buffer_finish = do
- withEditor historyFinish
- lineString <- withBuffer' elemsB
- withEditor closeBufferAndWindowE
- ex_eval (head prompt : lineString)
- ex_process :: VimMode
- ex_process = (some (spec KTab ?>>! completeMinibuffer) >> deprioritize >>! resetComplete)
- <|| choice [spec KEnter ?>>! ex_buffer_finish
- ,spec KEsc ?>>! closeBufferAndWindowE
- ,ctrlCh 'h' ?>>! actionAndHistoryPrefix $ deleteB Character Backward
- ,spec KBS ?>>! deleteBkdOrClose
- ,spec KDel ?>>! actionAndHistoryPrefix $ deleteB Character Forward
- ,ctrlCh 'p' ?>>! historyUp
- ,spec KUp ?>>! historyUp
- ,ctrlCh 'n' ?>>! historyDown
- ,spec KDown ?>>! historyDown
- ,spec KLeft ?>>! moveXorSol 1
- ,spec KRight ?>>! moveXorEol 1
- ,ctrlCh 'w' ?>>! actionAndHistoryPrefix $ deleteB unitWord Backward
- ,ctrlCh 'u' ?>>! moveToSol >> deleteToEol]
- <|| (insertChar >>! setHistoryPrefix)
- actionAndHistoryPrefix act = do
- discard $ withBuffer0 $ act
- setHistoryPrefix
- setHistoryPrefix = do
- ls <- withEditor . withBuffer0 $ elemsB
- historyPrefixSet ls
- insertChar = textChar >>= write . insertB
- deleteBkdOrClose = do
- ls <- withBuffer0 elemsB
- if null ls then closeBufferAndWindowE
- else actionAndHistoryPrefix $ deleteB Character Backward
-
- findUserComplFn s | Just ex_cmd <- findUserCmd s = completeFn ex_cmd
- | otherwise = Nothing
-
- completeMinibuffer = do s <- withBuffer elemsB
- case findUserComplFn s of
- Just cmplFn -> cmplFn $ ignoreExCmd s
- Nothing -> ex_complete s
-
- f_complete = exSimpleComplete (matchingFileNames Nothing)
- b_complete = exSimpleComplete matchingBufferNames
- ex_complete ('c':'d':' ':f) = f_complete f
- ex_complete ('e':' ':f) = f_complete f
- ex_complete ('e':'d':'i':'t':' ':f) = f_complete f
- ex_complete ('w':' ':f) = f_complete f
- ex_complete ('w':'r':'i':'t':'e':' ':f) = f_complete f
- ex_complete ('r':' ':f) = f_complete f
- ex_complete ('r':'e':'a':'d':' ':f) = f_complete f
- ex_complete ('t':'a':'b':'e':' ':f) = f_complete f
- ex_complete ('s':'a':'v':'e':'a':'s':' ':f) = f_complete f
- ex_complete ('s':'a':'v':'e':'a':'s':'!':' ':f) = f_complete f
- ex_complete ('b':' ':f) = b_complete f
- ex_complete ('b':'u':'f':'f':'e':'r':' ':f) = b_complete f
- ex_complete ('b':'d':' ':f) = b_complete f
- 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 ('s':'e':'t':' ':'f':'t':'=':f) = completeModes f
- ex_complete ('y':'i':' ':s) = exSimpleComplete (const getAllNamesInScope) s
- ex_complete s = catchAllComplete s
-
- userExCmds = concatMap (map (++ " ") . cmdNames) $ v_ex_cmds self
-
- catchAllComplete = exSimpleComplete $ const $ return $
- (userExCmds ++) $
- ("hoogle-word" :) $ ("hoogle-search" : )$ ("set ft=" :) $ ("set tags=" :) $ map (++ " ") $ words $
- "e edit r read saveas saveas! tabe tabnew tabm b buffer bd bd! bdelete bdelete! " ++
- "yi cabal nohlsearch cd pwd suspend stop undo redo redraw reload tag .! quit quitall " ++
- "qall quit! quitall! qall! write wq wqall ascii xit exit next prev" ++
- "$ split new ball h help"
- 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"
- completeModes = exSimpleComplete $ const getAllModeNames
-
- historyStart
- historyPrefixSet ""
- discard $ spawnMinibufferE prompt $ const ex_process
- return ()
-
- -- | eval an ex command to an YiM (), also appends to the ex history
- ex_eval :: String -> YiM ()
- ex_eval cmd =
- case cmd of
- -- regex searching
- ('/':pat) -> withEditor $ viSearch pat [] Forward
- ('?':pat) -> withEditor $ viSearch pat [] Backward
-
- -- TODO: Remapping could be done using the <|| operator somehow.
- -- The remapped stuff could be saved in a keymap-local state, (using StateT monad transformer).
-
- -- add mapping to command mode
- (_:'m':'a':'p':' ':_cs) -> error "Not yet implemented."
-
- -- add mapping to insert mode
- (_:'m':'a':'p':'!':' ':_cs) -> error "Not yet implemented."
-
- -- unmap a binding from command mode
- (_:'u':'n':'m':'a':'p':' ':_cs) -> error "Not yet implemented."
-
- -- unmap a binding from insert mode
- (_:'u':'n':'m':'a':'p':'!':' ':_cs) -> error "Not yet implemented."
-
-
- -- just a normal ex command
- (_:src) -> evalCmd $ dropSpace src
-
- -- can't happen, but deal with it
- [] -> return ()
-
- where
- {- 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 (either (const True) (const False) . (^. identA))
- canClose <- gets isUnchangedBuffer
- 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 -> (,) b <$> withEditor (withGivenBuffer0 b needsAWindowB)) =<< 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 file
- 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)"
-
-
- wquitall = forAllBuffers fwriteBufferE >> quitEditor
- bdelete = whenUnchanged (withBuffer' $ gets isUnchangedBuffer) . withEditor . closeBufferE . dropSpace
- bdeleteNoW = withEditor . closeBufferE . dropSpace
-
- -- the help feature currently try to show available key bindings
- help = withEditor (printMsg . show =<< acceptedInputs)
-
-
- evalCmd cmdLine = case findUserCmd cmdLine of
- Just ex_cmd -> cmdFn ex_cmd $ ignoreExCmd cmdLine
- Nothing -> fn cmdLine
-
- -- fn maps from the text entered on the command line to a YiM () implementing the
- -- command.
- fn "" = withEditor clrStatus
-
- fn s | all isDigit s = withBuffer' (setMarkHere '\'' >> gotoLn (read s) >> firstNonSpaceB)
-
- fn "w" = viWrite
- fn ('w':' ':f) = viSafeWriteTo $ dropSpace f
- fn ('w':'r':'i':'t':'e':' ':f) = viSafeWriteTo $ dropSpace f
- fn ('w':'!':' ':f) = viWriteTo $ dropSpace f
- fn ('w':'r':'i':'t':'e':'!':' ':f) = viWriteTo $ dropSpace f
- 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 "qal!" = quitEditor
- fn "qall!" = quitEditor
- fn "quita!" = quitEditor
- fn "quital!" = quitEditor
- fn "quitall!" = quitEditor
- fn "wq" = viWrite >> closeWindow
- fn "wqa" = wquitall
- fn "wqal" = wquitall
- fn "wqall" = wquitall
- fn "as" = withEditor viCharInfo
- fn "ascii" = withEditor viCharInfo
- fn "x" = viWriteModified >> closeWindow
- fn "xi" = viWriteModified >> closeWindow
- fn "xit" = viWriteModified >> closeWindow
- fn "exi" = viWriteModified >> closeWindow
- fn "exit" = viWriteModified >> closeWindow
- fn "n" = withEditor nextBufW
- fn "next" = withEditor nextBufW
- fn "$" = withBuffer' botB
- fn "p" = withEditor prevBufW
- fn "prev" = withEditor prevBufW
- fn ('s':'p':_) = withEditor splitE
- fn "e" = revertE
- fn "edit" = revertE
- fn ('e':' ':f) = viFnewE f
- fn ('e':'d':'i':'t':' ':f) = viFnewE f
- fn ('s':'a':'v':'e':'a':'s':' ':f) = let f' = dropSpace f in discard $ viSafeWriteTo f' >> editFile f'
- fn ('s':'a':'v':'e':'a':'s':'!':' ':f) = let f' = dropSpace f in discard $ viWriteTo f' >> editFile f'
- fn ('r':' ':f) = withBuffer' . insertN =<< io (readFile $ dropSpace f)
- fn ('r':'e':'a':'d':' ':f) = withBuffer' . insertN =<< io (readFile $ dropSpace f)
- fn ('s':'e':'t':' ':'f':'t':'=':ft) = do (AnyMode m) <- anyModeByName (dropSpace ft) ; withBuffer $ setMode m
- fn ('s':'e':'t':' ':'t':'a':'g':'s':'=':fps) = withEditor $ setTagsFileList fps
- fn ('n':'e':'w':' ':f) = withEditor splitE >> viFnewE f
- fn ('s':'/':cs) = withEditor $ viSub cs Line
- fn ('%':'s':'/':cs) = withEditor $ viSub cs Document
-
- fn ('b':' ':"m") = withEditor $ switchToBufferWithNameE "*messages*"
- fn ('b':' ':f) = withEditor $ switchToBufferWithNameE $ dropSpace f
- fn "bd" = bdelete ""
- fn "bdelete" = bdelete ""
- fn ('b':'d':' ':f) = bdelete f
- fn ('b':'d':'e':'l':'e':'t':'e':' ':f) = bdelete f
- fn "bd!" = bdeleteNoW ""
- fn "bdelete!" = bdeleteNoW ""
- fn ('b':'d':'!':' ':f) = bdeleteNoW f
- 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
- ln' <- runProcessWithInput f ln
- withBuffer' $ do moveToSol
- deleteToEol
- insertN ln'
- moveToSol
-
- -- Needs to occur in another buffer
- -- fn ('!':f) = runProcessWithInput f []
-
- fn "reload" = reload >> return () -- not in vim
-
- fn "redr" = userForceRefresh
- fn "redraw" = userForceRefresh
-
- fn "u" = withBuffer' undoB
- fn "undo" = withBuffer' undoB
- fn "only" = withEditor closeOtherE
- fn "red" = withBuffer' redoB
- fn "redo" = withBuffer' redoB
-
- fn ('c':'d':' ':f) = io . setCurrentDirectory . dropSpace $ f
- fn "pwd" = (io $ getCurrentDirectory) >>= withEditor . printMsg
-
- fn "sus" = suspendEditor
- fn "suspend" = suspendEditor
- fn "st" = suspendEditor
- fn "stop" = suspendEditor
-
- fn ('c':'a':'b':'a':'l':' ':s) = cabalRun s1 (const $ return ()) (CommandArguments $ words $ drop 1 s2) where (s1, s2) = break (==' ') s
- fn "make" = makeBuild $ CommandArguments []
- fn ('m':'a':'k':'e':' ':s) = makeBuild (CommandArguments $ words s)
- fn ('!':s) = shellCommandV s
- fn ('y':'i':' ':s) = execEditorAction $ dropSpace s
-
- fn "hoogle-word" = hoogle >> return ()
- fn "hoogle-search" = hoogleSearch
- fn "h" = help
- fn "help" = help
- fn "tabm" = withEditor (moveTab Nothing)
- fn ('t':'a':'b':'m':' ':n) = withEditor (moveTab $ Just (read n))
- fn "tabnew" = withEditor $ do
- newTabE
- discard newTempBufferE
- return ()
- fn ('t':'a':'b':'e':' ':f) = withEditor newTabE >> viFnewE f
-
- fn "ball" = withEditor openAllBuffersE
-
- fn "noh" = withEditor resetRegexE
- fn "nohlsearch" = withEditor resetRegexE
- fn s = errorEditor $ "The "++show s++ " command is unknown."
-
-
- ------------------------------------------------------------------------
-
- --not_implemented :: Char -> YiM ()
- --not_implemented c = errorEditor $ "Not implemented: " ++ show c
-
- -- ---------------------------------------------------------------------
- -- Misc functions
-
- forAllBuffers :: (BufferRef -> YiM ()) -> YiM ()
- forAllBuffers f = mapM_ f =<< readEditor bufferStack
-
- viCharInfo :: EditorM ()
- viCharInfo = do c <- withBuffer0' readB
- printMsg $ showCharInfo c ""
- where showCharInfo :: Char -> ShowS
- showCharInfo c = shows c . showChar ' ' . shows d
- . showString ", Hex " . showHex d
- . showString ", Octal " . showOct d
- where d = ord c
-
- viChar8Info :: EditorM ()
- viChar8Info = do c <- withBuffer0' readB
- let w8 = UTF8.encode [c]
- printMsg $ shows c . showChar ' ' . showSeq shows w8
- . showString ", Hex " . showSeq showHex w8
- . showString ", Octal " . showSeq showOct w8 $ ""
- where showSeq showX xs s = foldr ($) s $ intersperse (showChar ' ') $ map showX xs
-
- viFileInfo :: EditorM ()
- viFileInfo =
- do bufInfo <- withBuffer0' bufInfoB
- printMsg $ showBufInfo bufInfo
- where
- showBufInfo :: BufferFileInfo -> String
- showBufInfo bufInfo = concat [ show $ bufInfoFileName bufInfo
- , " Line "
- , show $ bufInfoLineNo bufInfo
- , " ["
- , bufInfoPercent bufInfo
- , "]"
- ]
+-- ---------------------------------------------------------------------
+-- Ex mode. We also process regex searching mode here.
+--
+findUserCmd :: [VimExCmd] -> String -> Maybe VimExCmd
+findUserCmd cmds cmdLine = find ((name `elem`) . cmdNames) cmds
+ where name = takeWhile (not . isSpace) $ dropWhile isSpace cmdLine
+
+exMode :: ModeMap -> String -> EditorM ()
+exMode self prompt = do
+ -- The above ensures that the action is performed on the buffer that originated the minibuffer.
+ let ex_buffer_finish = do
+ withEditor historyFinish
+ lineString <- withBuffer' elemsB
+ withEditor closeBufferAndWindowE
+ exEval self (head prompt : lineString)
+ ex_process :: VimMode
+ ex_process = (some (spec KTab ?>>! completeMinibuffer) >> deprioritize >>! resetComplete)
+ <|| choice [spec KEnter ?>>! ex_buffer_finish
+ ,spec KEsc ?>>! closeBufferAndWindowE
+ ,ctrlCh 'h' ?>>! actionAndHistoryPrefix $ deleteB Character Backward
+ ,spec KBS ?>>! deleteBkdOrClose
+ ,spec KDel ?>>! actionAndHistoryPrefix $ deleteB Character Forward
+ ,ctrlCh 'p' ?>>! historyUp
+ ,spec KUp ?>>! historyUp
+ ,ctrlCh 'n' ?>>! historyDown
+ ,spec KDown ?>>! historyDown
+ ,spec KLeft ?>>! moveXorSol 1
+ ,spec KRight ?>>! moveXorEol 1
+ ,ctrlCh 'w' ?>>! actionAndHistoryPrefix $ deleteB unitWord Backward
+ ,ctrlCh 'u' ?>>! moveToSol >> deleteToEol]
+ <|| (insertChar >>! setHistoryPrefix)
+ actionAndHistoryPrefix act = do
+ discard $ withBuffer0 $ act
+ setHistoryPrefix
+ setHistoryPrefix = do
+ ls <- withEditor . withBuffer0 $ elemsB
+ historyPrefixSet ls
+ insertChar = textChar >>= write . insertB
+ deleteBkdOrClose = do
+ ls <- withBuffer0 elemsB
+ if null ls then closeBufferAndWindowE
+ else actionAndHistoryPrefix $ deleteB Character Backward
+
+ findUserComplFn s | Just ex_cmd <- findUserCmd (v_ex_cmds self) s = completeFn ex_cmd
+ | otherwise = Nothing
+
+ completeMinibuffer = do s <- withBuffer elemsB
+ case findUserComplFn s of
+ Just cmplFn -> cmplFn $ ignoreExCmd s
+ Nothing -> ex_complete s
+
+ f_complete f | f == "%" = do
+ -- current buffer is minibuffer
+ -- actual file is in the second buffer in bufferStack
+ bufferRef <- withEditor $ gets (head . drop 1 . bufferStack)
+ maybeCurrentFileName <- withGivenBuffer bufferRef (gets file)
+
+ case maybeCurrentFileName of
+ Just fn -> withBuffer $ do
+ -- now modifying minibuffer
+ point <- pointB
+ deleteNAt Forward 1 (point-1)
+ insertN fn
+
+ Nothing -> return ()
+ | otherwise = exFileNameComplete f
+
+ b_complete = exSimpleComplete matchingBufferNames
+ ex_complete ('c':'d':' ':f) = f_complete f
+ ex_complete ('e':' ':f) = f_complete f
+ ex_complete ('e':'d':'i':'t':' ':f) = f_complete f
+ ex_complete ('w':' ':f) = f_complete f
+ ex_complete ('w':'r':'i':'t':'e':' ':f) = f_complete f
+ ex_complete ('r':' ':f) = f_complete f
+ ex_complete ('r':'e':'a':'d':' ':f) = f_complete f
+ ex_complete ('t':'a':'b':'e':' ':f) = f_complete f
+ ex_complete ('t':'a':'b':'e':'d':'i':'t':' ':f) = f_complete f
+ ex_complete ('t':'a':'b':'n':'e':'w':' ':f) = f_complete f
+ ex_complete ('s':'a':'v':'e':'a':'s':' ':f) = f_complete f
+ ex_complete ('s':'a':'v':'e':'a':'s':'!':' ':f) = f_complete f
+ ex_complete ('b':' ':f) = b_complete f
+ ex_complete ('b':'u':'f':'f':'e':'r':' ':f) = b_complete f
+ ex_complete ('b':'d':' ':f) = b_complete f
+ 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 ('s':'e':'t':' ':'f':'t':'=':f) = completeModes f
+ ex_complete ('y':'i':' ':s) = exSimpleComplete (const getAllNamesInScope) s
+ ex_complete s = catchAllComplete s
+
+ userExCmds = concatMap (map (++ " ") . cmdNames) $ v_ex_cmds self
+
+ catchAllComplete = exSimpleComplete $ const $ return $
+ (userExCmds ++) $
+ ("hoogle-word" :) $ ("hoogle-search" : )$ ("set ft=" :) $ ("set tags=" :) $ map (++ " ") $ words $
+ "e edit r read saveas saveas! tabe tabedit tabnew tabm " ++
+ "b buffer bd bd! bdelete bdelete! " ++
+ "yi cabal nohlsearch cd pwd suspend stop undo redo redraw reload tag .! quit quitall " ++
+ "qall quit! quitall! qall! write wq wqall ascii xit exit next prev" ++
+ "$ split new ball h help"
+ 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"
+ completeModes = exSimpleComplete $ const getAllModeNames
+
+ historyStart
+ historyPrefixSet ""
+ discard $ spawnMinibufferE prompt $ const ex_process
+ return ()
+
+-- | eval an ex command to an YiM (), also appends to the ex history
+exEval :: ModeMap -> String -> YiM ()
+exEval self cmd =
+ case cmd of
+ -- regex searching
+ ('/':pat) -> withEditor $ viSearch pat [] Forward
+ ('?':pat) -> withEditor $ viSearch pat [] Backward
+
+ -- TODO: Remapping could be done using the <|| operator somehow.
+ -- The remapped stuff could be saved in a keymap-local state, (using StateT monad transformer).
+
+ -- add mapping to command mode
+ (_:'m':'a':'p':' ':_cs) -> error "Not yet implemented."
+
+ -- add mapping to insert mode
+ (_:'m':'a':'p':'!':' ':_cs) -> error "Not yet implemented."
+
+ -- unmap a binding from command mode
+ (_:'u':'n':'m':'a':'p':' ':_cs) -> error "Not yet implemented."
+
+ -- unmap a binding from insert mode
+ (_:'u':'n':'m':'a':'p':'!':' ':_cs) -> error "Not yet implemented."
+
+
+ -- just a normal ex command
+ (_:src) -> evalCmd $ dropSpace src
+
+ -- can't happen, but deal with it
+ [] -> return ()
+
+ where
+ {- 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 (either (const True) (const False) . (^. identA))
+ canClose <- gets isUnchangedBuffer
+ 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 -> (,) b <$> withEditor (withGivenBuffer0 b needsAWindowB)) =<< 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 file
+ 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)"
+
+
+ wquitall = forAllBuffers fwriteBufferE >> quitEditor
+ bdelete = whenUnchanged (withBuffer' $ gets isUnchangedBuffer) . withEditor . closeBufferE . dropSpace
+ bdeleteNoW = withEditor . closeBufferE . dropSpace
+
+ -- the help feature currently try to show available key bindings
+ help = withEditor (printMsg . show =<< acceptedInputs)
+
+
+ evalCmd cmdLine = case findUserCmd (v_ex_cmds self) cmdLine of
+ Just ex_cmd -> cmdFn ex_cmd $ ignoreExCmd cmdLine
+ Nothing -> fn cmdLine
+
+ -- fn maps from the text entered on the command line to a YiM () implementing the
+ -- command.
+ fn "" = withEditor clrStatus
+
+ fn s | all isDigit s = withBuffer' (setMarkHere '\'' >> gotoLn (read s) >> firstNonSpaceB)
+
+ fn "w" = viWrite
+ fn ('w':' ':f) = viSafeWriteTo $ dropSpace f
+ fn ('w':'r':'i':'t':'e':' ':f) = viSafeWriteTo $ dropSpace f
+ fn ('w':'!':' ':f) = viWriteTo $ dropSpace f
+ fn ('w':'r':'i':'t':'e':'!':' ':f) = viWriteTo $ dropSpace f
+ 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 "qal!" = quitEditor
+ fn "qall!" = quitEditor
+ fn "quita!" = quitEditor
+ fn "quital!" = quitEditor
+ fn "quitall!" = quitEditor
+ fn "wq" = viWrite >> closeWindow
+ fn "wqa" = wquitall
+ fn "wqal" = wquitall
+ fn "wqall" = wquitall
+ fn "as" = withEditor viCharInfo
+ fn "ascii" = withEditor viCharInfo
+ fn "x" = viWriteModified >> closeWindow
+ fn "xi" = viWriteModified >> closeWindow
+ fn "xit" = viWriteModified >> closeWindow
+ fn "exi" = viWriteModified >> closeWindow
+ fn "exit" = viWriteModified >> closeWindow
+ fn "n" = withEditor nextBufW
+ fn "next" = withEditor nextBufW
+ fn "$" = withBuffer' botB
+ fn "p" = withEditor prevBufW
+ fn "prev" = withEditor prevBufW
+ fn ('s':'p':_) = withEditor splitE
+ fn "e" = revertE
+ fn "edit" = revertE
+ fn ('e':' ':f) = viFnewE f
+ fn ('e':'d':'i':'t':' ':f) = viFnewE f
+ fn ('s':'a':'v':'e':'a':'s':' ':f) = let f' = dropSpace f in discard $ viSafeWriteTo f' >> editFile f'
+ fn ('s':'a':'v':'e':'a':'s':'!':' ':f) = let f' = dropSpace f in discard $ viWriteTo f' >> editFile f'
+ fn ('r':' ':f) = withBuffer' . insertN =<< io (readFile $ dropSpace f)
+ fn ('r':'e':'a':'d':' ':f) = withBuffer' . insertN =<< io (readFile $ dropSpace f)
+ fn ('s':'e':'t':' ':'f':'t':'=':ft) = do (AnyMode m) <- anyModeByName (dropSpace ft) ; withBuffer $ setMode m
+ fn ('s':'e':'t':' ':'t':'a':'g':'s':'=':fps) = withEditor $ setTagsFileList fps
+ fn ('n':'e':'w':' ':f) = withEditor splitE >> viFnewE f
+ fn ('s':'/':cs) = withEditor $ viSub cs Line
+ fn ('%':'s':'/':cs) = withEditor $ viSub cs Document
+
+ fn ('b':' ':"m") = withEditor $ switchToBufferWithNameE "*messages*"
+ fn ('b':' ':f) = withEditor $ switchToBufferWithNameE $ dropSpace f
+ fn "bd" = bdelete ""
+ fn "bdelete" = bdelete ""
+ fn ('b':'d':' ':f) = bdelete f
+ fn ('b':'d':'e':'l':'e':'t':'e':' ':f) = bdelete f
+ fn "bd!" = bdeleteNoW ""
+ fn "bdelete!" = bdeleteNoW ""
+ fn ('b':'d':'!':' ':f) = bdeleteNoW f
+ fn ('b':'d':'e':'l':'e':'t':'e':'!':' ':f) = bdeleteNoW f
+ -- TODO: bd[!] [N]
+
+ fn ('t':'a':'g':' ':t) = gotoTag (v_opts self) t
+
+ -- send just this line through external command /fn/
+ fn ('.':'!':f) = do
+ ln <- withBuffer' readLnB
+ ln' <- runProcessWithInput f ln
+ withBuffer' $ do moveToSol
+ deleteToEol
+ insertN ln'
+ moveToSol
+
+-- Needs to occur in another buffer
+-- fn ('!':f) = runProcessWithInput f []
+
+ fn "reload" = reload >> return () -- not in vim
+
+ fn "redr" = userForceRefresh
+ fn "redraw" = userForceRefresh
+
+ fn "u" = withBuffer' undoB
+ fn "undo" = withBuffer' undoB
+ fn "only" = withEditor closeOtherE
+ fn "red" = withBuffer' redoB
+ fn "redo" = withBuffer' redoB
+
+ fn ('c':'d':' ':f) = io . setCurrentDirectory . dropSpace $ f
+ fn "pwd" = (io $ getCurrentDirectory) >>= withEditor . printMsg
+
+ fn "sus" = suspendEditor
+ fn "suspend" = suspendEditor
+ fn "st" = suspendEditor
+ fn "stop" = suspendEditor
+
+ fn ('c':'a':'b':'a':'l':' ':s) = cabalRun s1 (const $ return ()) (CommandArguments $ words $ drop 1 s2) where (s1, s2) = break (==' ') s
+ fn "make" = makeBuild $ CommandArguments []
+ fn ('m':'a':'k':'e':' ':s) = makeBuild (CommandArguments $ words s)
+ fn ('!':s) = shellCommandV s
+ fn ('y':'i':' ':s) = execEditorAction $ dropSpace s
+
+ fn "hoogle-word" = hoogle >> return ()
+ fn "hoogle-search" = hoogleSearch
+ fn "h" = help
+ fn "help" = help
+ fn "tabm" = withEditor (moveTab Nothing)
+ fn ('t':'a':'b':'m':' ':n) = withEditor (moveTab $ Just (read n))
+
+ fn "tabe" = withEditor $ do
+ newTabE
+ discard newTempBufferE
+ return ()
+ fn "tabedit" = fn "tabe"
+ fn "tabnew" = fn "tabe"
+
+ fn ('t':'a':'b':'e':' ':f) = withEditor newTabE >> viFnewE f
+ fn ('t':'a':'b':'e':'d':'i':'t':' ':f) = fn $ "tabe " ++ f
+ fn ('t':'a':'b':'n':'e':'w':' ':f) = fn $ "tabe " ++ f
+
+ fn "ball" = withEditor openAllBuffersE
+
+ fn "noh" = withEditor resetRegexE
+ fn "nohlsearch" = withEditor resetRegexE
+ fn s = errorEditor $ "The "++show s++ " command is unknown."
+
+
+------------------------------------------------------------------------
+
+--not_implemented :: Char -> YiM ()
+--not_implemented c = errorEditor $ "Not implemented: " ++ show c
+-- ---------------------------------------------------------------------
+-- Misc functions
+
+forAllBuffers :: (BufferRef -> YiM ()) -> YiM ()
+forAllBuffers f = mapM_ f =<< readEditor bufferStack
+
+viCharInfo :: EditorM ()
+viCharInfo = do c <- withBuffer0' readB
+ printMsg $ showCharInfo c ""
+ where showCharInfo :: Char -> ShowS
+ showCharInfo c = shows c . showChar ' ' . shows d
+ . showString ", Hex " . showHex d
+ . showString ", Octal " . showOct d
+ where d = ord c
+
+viChar8Info :: EditorM ()
+viChar8Info = do c <- withBuffer0' readB
+ let w8 = UTF8.encode [c]
+ printMsg $ shows c . showChar ' ' . showSeq shows w8
+ . showString ", Hex " . showSeq showHex w8
+ . showString ", Octal " . showSeq showOct w8 $ ""
+ where showSeq showX xs s = foldr ($) s $ intersperse (showChar ' ') $ map showX xs
+
+viFileInfo :: EditorM ()
+viFileInfo =
+ do bufInfo <- withBuffer0' bufInfoB
+ printMsg $ showBufInfo bufInfo
+ where
+ showBufInfo :: BufferFileInfo -> String
+ showBufInfo bufInfo = concat [ show $ bufInfoFileName bufInfo
+ , " Line "
+ , show $ bufInfoLineNo bufInfo
+ , " ["
+ , bufInfoPercent bufInfo
+ , "]"
+ ]
-- | write the current buffer, but only if modified (cf. :help :x)
viWriteModified :: YiM ()
@@ -1628,8 +1632,12 @@ viFnewE f = discard (editFile $ dropSpace f)
-- | viSearch is a doSearch wrapper that print the search outcome.
-- TODO: consider merging with doSearch
viSearch :: String -> [SearchOption] -> Direction -> EditorM ()
-viSearch x y z = do
- r <- doSearch (if null x then Nothing else Just x) y z
+viSearch needle searchOptions dir = do
+ r <- doSearch (if null needle then Nothing else Just needle) searchOptions dir
+ when (dir == Backward) $ do
+ -- move cursor so that it stands on the last character of search term
+ -- enabling user to continue searching with # or * after #
+ withBuffer0' $ viMove (CharMove Backward)
case r of
PatternFound -> return ()
PatternNotFound -> printMsg "Pattern not found"
@@ -1773,3 +1781,41 @@ kwd_mode opts = some (ctrlCh 'n' ?>> write . viWordComplete $ completeCaseSensit
where viWordComplete caseSensitive =
withEditor . withBuffer0 . (savingDeleteWordB Backward >>) .
savingInsertStringB =<< wordCompleteString' caseSensitive
+
+gotoTag :: VimOpts -> Tag -> YiM ()
+gotoTag opts tag =
+ visitTagTable $ \tagTable ->
+ case lookupTag tag tagTable of
+ Nothing -> fail $ "No tags containing " ++ tag
+ Just (filename, line) -> do
+ when (enableTagStack opts)
+ viTagStackPushPos
+ viFnewE filename
+ discard $ withBuffer' $ gotoLn line
+ return ()
+
+-- | Parse any character that can be inserted in the text.
+textChar :: KeymapM Char
+textChar = do
+ Event (KASCII c) [] <- anyEvent
+ return c
+
+-- | 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 getTagsFileList -- 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
+
+viTagStackPushPos :: YiM ()
+viTagStackPushPos = withEditor $ do bn <- withBuffer0 $ gets identString
+ p <- withBuffer0 pointB
+ pushTagStack bn p
5 src/library/Yi/Lexer/ObjectiveC.x
View
@@ -83,10 +83,15 @@ $nl = [\n\r]
| "@finally"
| "@end"
| "@protocol"
+ | "@optional"
+ | "@required"
| "@selector"
| "@synchronized"
| "@defs"
| "@encode"
+ | "@property"
+ | "@synthesize"
+ | "@dynamic"
| nil
| Nil
| id
29 src/library/Yi/Main.hs
View
@@ -19,7 +19,7 @@ import Prelude ()
import Control.Monad.Error
import Data.Char
-import Data.List (intercalate)
+import Data.List (intercalate, length)
import Distribution.Text (display)
import System.Console.GetOpt
import System.Exit
@@ -77,6 +77,7 @@ data Opts = Help
| SelfCheck
| GhcOption String
| Debug
+ | OpenInTabs
-- | List of editors for which we provide an emulation.
editors :: [(String,Config -> Config)]
@@ -95,11 +96,18 @@ options =
, Option ['l'] ["line"] (ReqArg LineNo "NUM") "Start on line number"
, Option [] ["as"] (ReqArg EditorNm "EDITOR") editorHelp
, Option [] ["ghc-option"] (ReqArg GhcOption "OPTION") "Specify option to pass to ghc when compiling configuration file"
+ , Option [openInTabsShort] [openInTabsLong] (NoArg OpenInTabs) "Open files in tabs"
] where frontendHelp = ("Select frontend, which can be one of:\n"
++ intercalate ", " frontendNames)
editorHelp = ("Start with editor keymap, where editor is one of:\n"
++ (intercalate ", " . fmap fst) editors)
+openInTabsShort :: Char
+openInTabsShort = 'p'
+
+openInTabsLong :: String
+openInTabsLong = "open-in-tabs"
+
-- | usage string.
usage, versinfo :: String
usage = usageInfo ("Usage: yi [option...] [file]") options
@@ -110,12 +118,15 @@ versinfo = "yi " ++ display version
do_args :: Config -> [String] -> Either Err (Config, ConsoleConfig)
do_args cfg args =
case (getOpt (ReturnInOrder File) options args) of
- (o, [], []) -> foldM getConfig (cfg, defaultConsoleConfig) o
+ (os, [], []) -> foldM (getConfig shouldOpenInTabs) (cfg, defaultConsoleConfig) os
(_, _, errs) -> fail (concat errs)
+ where
+ shouldOpenInTabs = ("--" ++ openInTabsLong) `elem` args
+ || ('-':[openInTabsShort]) `elem` args
-- | Update the default configuration based on a command-line option.
-getConfig :: (Config, ConsoleConfig) -> Opts -> Either Err (Config, ConsoleConfig)
-getConfig (cfg,cfgcon) opt =
+getConfig :: Bool -> (Config, ConsoleConfig) -> Opts -> Either Err (Config, ConsoleConfig)
+getConfig shouldOpenInTabs (cfg, cfgcon) opt =
case opt of
Frontend f -> case lookup f availableFrontends of
Just frontEnd -> return (cfg { startFrontEnd = frontEnd }, cfgcon)
@@ -126,13 +137,19 @@ getConfig (cfg,cfgcon) opt =
LineNo l -> case startActions cfg of
x : xs -> return (cfg { startActions = x:makeAction (gotoLn (read l)):xs }, cfgcon)
[] -> fail "The `-l' option must come after a file argument"
- File filename -> prependAction (editFile filename)
+
+ File filename -> if shouldOpenInTabs && (length (startActions cfg) > 0) then
+ prependActions [YiA (editFile filename), EditorA newTabE]
+ else
+ prependAction (editFile filename)
+
EditorNm emul -> case lookup (fmap toLower emul) editors of
Just modifyCfg -> return $ (modifyCfg cfg, cfgcon)
Nothing -> fail $ "Unknown emulation: " ++ show emul
GhcOption ghcOpt -> return (cfg, cfgcon { ghcOptions = ghcOptions cfgcon ++ [ghcOpt] })
_ -> return (cfg, cfgcon)
- where
+ where
+ prependActions as = return $ (cfg { startActions = (fmap makeAction as) ++ startActions cfg }, cfgcon)
prependAction a = return $ (cfg { startActions = makeAction a : startActions cfg}, cfgcon)
-- ---------------------------------------------------------------------
19 src/library/Yi/Misc.hs
View
@@ -39,6 +39,7 @@ import Yi.MiniBuffer
, withMinibufferGen
)
import System.CanonicalizePath (canonicalizePath)
+import Data.Maybe (isNothing)
-- | Given a possible starting path (which if not given defaults to
-- the current directory) and a fragment of a path we find all
@@ -62,7 +63,9 @@ getAppropriateFiles start s = do
let fixTrailingPathSeparator f = do
isDir <- doesDirectoryExist (searchDir' </> f)
return $ if isDir then addTrailingPathSeparator f else f
+
files <- liftIO $ getDirectoryContents searchDir'
+
-- Remove the two standard current-dir and parent-dir as we do not
-- need to complete or hint about these as they are known by users.
let files' = files \\ [ ".", ".." ]
@@ -84,7 +87,21 @@ getFolder (Just path) = do
matchingFileNames :: Maybe String -> String -> YiM [String]
matchingFileNames start s = do
(sDir, files) <- getAppropriateFiles start s
- return $ fmap (sDir </>) files
+
+ -- There is one common case when we don't need to prepend @sDir@ to @files@:
+ --
+ -- Suppose user just wants to edit a file "foobar" in current directory
+ -- and inputs ":e foo<Tab>"
+ --
+ -- @sDir@ in this case equals to "." and "foo" would not be
+ -- a prefix of ("." </> "foobar"), resulting in a failed completion
+ --
+ -- However, if user inputs ":e ./foo<Tab>", we need to prepend @sDir@ to @files@
+ let results = if (isNothing start && sDir == "." && not ("./" `isPrefixOf` s))
+ then files
+ else fmap (sDir </>) files
+
+ return results
adjBlock :: Int -> BufferM ()
adjBlock x = withSyntaxB' (\m s -> modeAdjustBlock m s x)
2  src/library/Yi/Modes.hs
View
@@ -88,7 +88,7 @@ cMode = (linearSyntaxMode C.initState C.alexScanToken id)
objectiveCMode = (linearSyntaxMode ObjectiveC.initState ObjectiveC.alexScanToken id)
{
- modeApplies = anyExtension ["m"],
+ modeApplies = anyExtension ["m", "mm"],
modeName = "objective-c"
}
12 src/library/Yi/Process.hs
View
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
module Yi.Process (popen, runProgCommand, runShellCommand, shellFileName,
createSubprocess, readAvailable, SubprocessInfo(..), SubprocessId) where
@@ -10,12 +10,13 @@ import System.Process
import System.Environment ( getEnv )
import Control.Concurrent (forkIO)
-import qualified Control.OldException as Control.Exception
+import qualified Control.Exception (evaluate, handle, SomeException)
import Foreign.Marshal.Alloc(allocaBytes)
import Foreign.C.String
-import Prelude(length, catch)
+import Prelude(length)
+import Control.Exc(orException)
import Yi.Prelude
import Yi.Buffer (BufferRef)
@@ -29,7 +30,7 @@ import System.Posix.IO
-- TODO: this will probably be called readProcess in the new process package (2.0)
popen :: FilePath -> [String] -> Maybe String -> IO (String,String,ExitCode)
popen file args minput =
- Control.Exception.handle (\e -> return ([],show e,error (show e))) $ do
+ Control.Exception.handle handler $ do
(inp,out,err,pid) <- runInteractiveProcess file args Nothing Nothing
hSetBuffering out LineBuffering
@@ -54,6 +55,7 @@ popen file args minput =
exitCode <- waitForProcess pid -- blocks without -threaded, you're warned.
return (output,errput,exitCode)
+ where handler (e :: Control.Exception.SomeException) = return ([], show e, error (show e))
-- | Run a command. This looks up a program name in \$PATH, but then calls it
-- directly with the argument.
@@ -67,7 +69,7 @@ runProgCommand prog args = do loc <- findExecutable prog
-- | Run a command using the system shell, returning stdout, stderr and exit code
shellFileName :: IO String
-shellFileName = catch (getEnv "SHELL") (const $ return "/bin/sh")
+shellFileName = orException (getEnv "SHELL") (return "/bin/sh")
shellCommandSwitch :: String
shellCommandSwitch = "-c"
8 src/library/Yi/Search.hs
View
@@ -93,6 +93,7 @@ type SearchMatch = Region
data SearchResult = PatternFound
| PatternNotFound
| SearchWrapped
+ deriving Eq
doSearch :: Maybe String -- ^ @Nothing@ means used previous
-- pattern, if any. Complain otherwise.
@@ -336,13 +337,12 @@ isearchEnd accept = do
let (lastSearched,_,_) = head s
let (_,p0,_) = last s
historyFinishGen iSearch (return lastSearched)
- resetRegexE
if accept
then do withBuffer0 $ setSelectionMarkPointB $ regionStart p0
printMsg "Quit"
- else withBuffer0 $ moveTo $ regionStart p0
-
-
+ else do resetRegexE
+ withBuffer0 $ moveTo $ regionStart p0
+
-----------------
-- Query-Replace
22 yi/src/library/Control/Exc.hs
View
@@ -0,0 +1,22 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+-- | Utilities for working with new Control.Exception
+module Control.Exc(ignoringException, printingException, orException)
+where
+
+import Prelude hiding(catch)
+import Control.Exception(catch, SomeException)
+
+-- | Execute IO (Maybe a) action replacing all exceptions with return value of Nothing.
+ignoringException :: IO (Maybe a) -> IO (Maybe a)
+ignoringException f = f `catch` ignore
+ where ignore (_ :: SomeException) = return Nothing
+
+-- | Execute IO () action, replacing all exceptions with messages
+printingException :: [Char] -> IO a -> IO a
+printingException desc f = f `catch` handler
+ where handler (err :: SomeException) = fail $ concat [desc, " failed: ", show err]
+
+-- | Execute IO () action, replacing all exceptions with messages
+orException :: IO a -> IO a -> IO a
+orException f g = f `catch` handler
+ where handler (_ :: SomeException) = g
16 yi/yi.cabal
View
@@ -12,16 +12,18 @@ maintainer: yi-devel@googlegroups.com
homepage: http://haskell.org/haskellwiki/Yi
bug-reports: http://code.google.com/p/yi-editor/issues/list
Cabal-Version: >= 1.10
-tested-with: GHC==7.0.2
+tested-with: GHC==7.0.2, GHC==7.4.1
build-type: Simple
-
data-files:
art/*.png
art/*.pdf
example-configs/*.hs
-
extra-source-files: src/library/Yi/Lexer/common.hsinc
+source-repository head
+ type: git
+ location: https://github.com/yi-editor/yi.git
+
-- Frontends
flag cocoa
Default: False
@@ -236,13 +238,14 @@ library
if impl(ghc >=7.2)
default-extensions: NondecreasingIndentation
- if impl(ghc >=7.2)
- default-extensions: NondecreasingIndentation
-
if !os(windows)
build-depends:
unix
+ if os(windows)
+ build-depends:
+ Win32
+
include-dirs: src/library/Yi/Lexer
if flag(testing)
@@ -329,6 +332,7 @@ library
Shim.ProjectContent
System.CanonicalizePath
System.FriendlyPath
+ Control.Exc
-- Broken.
-- Yi.Keymap.Ee,
Please sign in to comment.
Something went wrong with that request. Please try again.