Permalink
Browse files

Merge pull request #42 from ethercrow/ctrlp

Fuzzy open file in yi-contrib.
  • Loading branch information...
2 parents 3c97531 + b45909b commit 2567c866347c7ab319dff9a6552c56f6ec68fbd3 @mgajda mgajda committed Oct 8, 2012
View
146 yi-contrib/src/Yi/FuzzyOpen.hs
@@ -0,0 +1,146 @@
+
+{- This file aims to provide (the essential subset of) the same functionality
+ that vim plugins ctrlp and command-t provide.
+
+ Setup:
+
+ Add something like this to your config:
+
+ (ctrlCh 'p' ?>>! fuzzyOpen)
+
+ Usage:
+
+ <C-p> (or whatever mapping user chooses) starts fuzzy open dialog.
+
+ Typing something filters filelist.
+
+ <Enter> opens currently selected file
+ in current (the one that fuzzyOpen was initited from) window.
+
+ <C-t> opens currently selected file in a new tab.
+ <C-s> opens currently selected file in a split.
+
+ <KUp> and <C-p> moves selection up
+ <KDown> and <C-n> moves selection down
+
+ Readline shortcuts <C-a> , <C-e>, <C-u> and <C-k> work as usual.
+-}
+
+module Yi.FuzzyOpen
+ ( fuzzyOpen
+ ) where
+
+import Prelude ()
+import Yi
+import Yi.MiniBuffer
+import Yi.Completion
+
+import Control.Monad (replicateM, replicateM_)
+import Control.Monad.Trans (liftIO)
+import System.Directory (doesDirectoryExist, getDirectoryContents)
+import System.FilePath (FilePath, (</>))
+import Data.List (filter, map, intersperse, drop)
+import Data.Maybe (isJust)
+
+fuzzyOpen :: YiM ()
+fuzzyOpen = do
+ withEditor splitE
+ bufRef <- withEditor newTempBufferE
+ fileList <- liftIO $ getRecursiveContents "."
+ updateMatchList bufRef fileList
+ withEditor $ spawnMinibufferE "" $ const $ localKeymap bufRef fileList
+ return ()
+
+-- shamelessly stolen from Chapter 9 of Real World Haskell
+-- takes about 3 seconds to traverse linux kernel, which is not too outrageous
+-- TODO: check if it works at all with cyclic links
+-- TODO: perform in background, limit file count or directory depth
+getRecursiveContents :: FilePath -> IO [FilePath]
+getRecursiveContents topdir = do
+ names <- getDirectoryContents topdir
+ let properNames = filter (`notElem` [".", "..", ".git", ".svn"]) names
+ paths <- forM properNames $ \name -> do
+ let path = topdir </> name
+ isDirectory <- doesDirectoryExist path
+ if isDirectory
+ then getRecursiveContents path
+ else return [path]
+ return (concat paths)
+
+localKeymap :: BufferRef -> [FilePath] -> Keymap
+localKeymap bufRef fileList =
+ choice [spec KEnter ?>>! openInThisWindow bufRef
+ , ctrlCh 't' ?>>! openInNewTab bufRef
+ , ctrlCh 's' ?>>! openInSplit bufRef
+ , spec KEsc ?>>! replicateM 2 closeBufferAndWindowE
+ , ctrlCh 'h' ?>>! updatingB (deleteB Character Backward)
+ , spec KBS ?>>! updatingB (deleteB Character Backward)
+ , spec KDel ?>>! updatingB (deleteB Character Backward)
+ , ctrlCh 'a' ?>>! moveToSol
+ , ctrlCh 'e' ?>>! moveToEol
+ , spec KLeft ?>>! moveXorSol 1
+ , spec KRight ?>>! moveXorEol 1
+ , ctrlCh 'p' ?>>! moveSelectionUp bufRef
+ , spec KUp ?>>! moveSelectionUp bufRef
+ , ctrlCh 'n' ?>>! moveSelectionDown bufRef
+ , spec KDown ?>>! moveSelectionDown bufRef
+ , ctrlCh 'w' ?>>! updatingB (deleteB unitWord Backward)
+ , ctrlCh 'u' ?>>! updatingB (moveToSol >> deleteToEol)
+ , ctrlCh 'k' ?>>! updatingB deleteToEol
+ ]
+ <|| (insertChar >>! update)
+ where update = updateMatchList bufRef fileList
+ updatingB bufAction = withBuffer bufAction >> update
+ updatingE editorAction = withEditor editorAction >> update
+
+showFileList :: [FilePath] -> String
+showFileList = concat . intersperse "\n" . map (" " ++)
+
+{- Implementation detail:
+ The index of selected file is stored as vertical cursor position.
+ Asterisk position is always synchronized with cursor position.
+
+ TODO: store index of selected file explicitly to make things more obvious.
+-}
+
+updateMatchList :: BufferRef -> [FilePath] -> YiM ()
+updateMatchList bufRef fileList = do
+ needle <- withBuffer elemsB
+ let filteredFiles = filter (subsequenceMatch needle) fileList
+ withEditor $ withGivenBuffer0 bufRef $ do
+ replaceBufferContent $ showFileList filteredFiles
+ moveTo 0
+ replaceCharB '*'
+ return ()
+
+openInThisWindow :: BufferRef -> YiM ()
+openInThisWindow = openRoutine (return ())
+
+openInSplit :: BufferRef -> YiM ()
+openInSplit = openRoutine splitE
+
+openInNewTab :: BufferRef -> YiM ()
+openInNewTab = openRoutine newTabE
+
+openRoutine :: EditorM () -> BufferRef -> YiM ()
+openRoutine preOpenAction bufRef = do
+ chosenFile <- fmap (drop 2) $ withEditor $ withGivenBuffer0 bufRef readLnB
+ withEditor $ do
+ replicateM_ 2 closeBufferAndWindowE
+ preOpenAction
+ discard $ editFile chosenFile
+
+insertChar :: Keymap
+insertChar = textChar >>= write . insertB
+
+moveSelectionUp :: BufferRef -> EditorM ()
+moveSelectionUp bufRef = withGivenBuffer0 bufRef $ do
+ replaceCharB ' '
+ lineUp
+ replaceCharB '*'
+
+moveSelectionDown :: BufferRef -> EditorM ()
+moveSelectionDown bufRef = withGivenBuffer0 bufRef $ do
+ replaceCharB ' '
+ lineDown
+ replaceCharB '*'
View
4 yi-contrib/yi-contrib.cabal
@@ -28,6 +28,7 @@ library
Yi.Config.Users.Reiner
Yi.Style.Misc
Yi.Templates
+ Yi.FuzzyOpen
build-depends:
base >=4.0 && <5,
@@ -36,4 +37,5 @@ library
directory < 1.2,
filepath < 1.4,
split ==0.1.*,
- yi == 0.6.6.0
+ mtl >= 0.1.0.1,
+ yi == 0.6.6.1
View
7 yi/src/library/Yi/Buffer/Misc.hs
@@ -140,6 +140,7 @@ module Yi.Buffer.Misc
, BufferId
, file
, lastSyncTimeA
+ , replaceCharB
)
where
@@ -972,6 +973,12 @@ readAtB i = do
[c] -> c
_ -> '\0'
+replaceCharB :: Char -> BufferM ()
+replaceCharB c = do
+ deleteN 1
+ insertB c
+ leftB
+
-- | Delete @n@ characters forward from the current point
deleteN :: Int -> BufferM ()
deleteN n = pointB >>= deleteNAt Forward n
View
9 yi/src/library/Yi/Completion.hs
@@ -6,6 +6,7 @@ module Yi.Completion
, completeInListCustomShow
, commonPrefix
, prefixMatch, infixMatch
+ , subsequenceMatch
, containsMatch', containsMatch, containsMatchCaseInsensitive
, mkIsPrefixOf
)
@@ -35,6 +36,14 @@ prefixMatch prefix s = if prefix `isPrefixOf` s then Just s else Nothing
infixMatch :: String -> String -> Maybe String
infixMatch needle haystack = fmap (\n -> drop n haystack) $ findIndex (needle `isPrefixOf`) (tails haystack)
+-- | Example: "abc" matches "a1b2c"
+subsequenceMatch :: String -> String -> Bool
+subsequenceMatch needle haystack = go needle haystack
+ where go (n:ns) (h:hs) | n == h = go ns hs
+ go (n:ns) (h:hs) | n /= h = go (n:ns) hs
+ go [] _ = True
+ go _ [] = False
+
containsMatch' :: Bool -> String -> String -> Maybe String
containsMatch' caseSensitive pattern str = fmap (const str) $ find (pattern `tstPrefix`) (tails str)
where tstPrefix = mkIsPrefixOf caseSensitive
View
10 yi/src/library/Yi/Keymap/Keys.hs
@@ -7,7 +7,8 @@ module Yi.Keymap.Keys
(
module Yi.Event,
module Yi.Interact,
- printableChar, charOf, shift, meta, ctrl, super, hyper, spec, char,
+ printableChar, textChar,
+ charOf, shift, meta, ctrl, super, hyper, spec, char,
(>>!), (>>=!), (?>>), (?>>!), (?*>>), (?*>>!),
ctrlCh, metaCh, hyperCh,
optMod,
@@ -30,6 +31,13 @@ printableChar = do
fail "unprintable character"
return c
+-- | Parse any character that can be inserted in the text.
+textChar :: KeymapM Char
+textChar = do
+ -- Why only ASCII?
+ Event (KASCII c) [] <- anyEvent
+ return c
+
pString :: (MonadInteract m w Event) => String -> m [Event]
pString = events . map char
View
6 yi/src/library/Yi/Keymap/Vim.hs
@@ -1764,12 +1764,6 @@ gotoTag opts tag =
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 ()

0 comments on commit 2567c86

Please sign in to comment.