Permalink
Browse files

Fuzzy open action for yi (like ctrlp or command-t for vim)

  • Loading branch information...
1 parent 3c97531 commit 2d9e4f5f4c9d9b93d01562e7400be5e3e17d33c7 @ethercrow committed Sep 13, 2012
Showing with 141 additions and 1 deletion.
  1. +129 −0 yi-contrib/src/Yi/FuzzyOpen.hs
  2. +3 −1 yi-contrib/yi-contrib.cabal
  3. +9 −0 yi/src/library/Yi/Completion.hs
@@ -0,0 +1,129 @@
+module Yi.FuzzyOpen
+ ( fuzzyOpen
+ ) where
+
+import Prelude ()
+import Yi
+import Yi.MiniBuffer
+import Yi.Completion
+
+import Control.Monad (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 ()
+
+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
+
+insertChar :: Keymap
+insertChar = textChar >>= write . insertB
+
+showFileList :: [FilePath] -> String
+showFileList = concat . intersperse "\n" . map (" " ++)
+
+updateMatchList :: BufferRef -> [FilePath] -> YiM ()
+updateMatchList bufRef fileList = do
+ needle <- withBuffer elemsB
+ let filteredFiles = filter (isJust . subsequenceMatch needle) fileList
+ withEditor $ withGivenBuffer0 bufRef $ do
+ replaceBufferContent $ showFileList filteredFiles
+ moveTo 0
+ replaceCurrentChar '*'
+ return ()
+
+replaceCurrentChar :: Char -> BufferM ()
+replaceCurrentChar c = do
+ deleteN 1
+ insertB c
+ leftB
+
+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 $ do
+ moveTo 0
+ getLine
+ withEditor $ do
+ replicateM 2 closeBufferAndWindowE
+ preOpenAction
+ discard $ editFile chosenFile
+
+getLine :: BufferM String
+getLine = do
+ moveToSol
+ p0 <- pointB
+ moveToEol
+ p1 <- pointB
+ nelemsB (fromPoint p1 - fromPoint p0) p0
+
+-- | Parse any character that can be inserted in the text.
+textChar :: KeymapM Char
+textChar = do
+ Event (KASCII c) [] <- anyEvent
+ return c
+
+moveSelectionUp :: BufferRef -> EditorM ()
+moveSelectionUp bufRef = withGivenBuffer0 bufRef $ do
+ replaceCurrentChar ' '
+ lineUp
+ replaceCurrentChar '*'
+
+moveSelectionDown :: BufferRef -> EditorM ()
+moveSelectionDown bufRef = withGivenBuffer0 bufRef $ do
+ replaceCurrentChar ' '
+ lineDown
+ replaceCurrentChar '*'
@@ -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
@@ -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 -> Maybe String
+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 [] _ = Just haystack
+ go _ [] = Nothing
+
containsMatch' :: Bool -> String -> String -> Maybe String
containsMatch' caseSensitive pattern str = fmap (const str) $ find (pattern `tstPrefix`) (tails str)
where tstPrefix = mkIsPrefixOf caseSensitive

0 comments on commit 2d9e4f5

Please sign in to comment.