yi-0.3: Yi/Search.hs
{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-- Copyright (c) Tuomo Valkonen 2004.
-- Copyright (c) 2005, 2008 Don Stewart - http://www.cse.unsw.edu.au/~dons
-- Copyright (c) 2007 Jean-Philippe Bernardy
-- | Search/Replace functions
module Yi.Search (
setRegexE, -- :: SearchExp -> EditorM ()
getRegexE, -- :: EditorM (Maybe SearchExp)
SearchMatch,
SearchExp,
SearchF(..),
searchAndRepLocal, -- :: String -> String -> IO Bool
doSearch, -- :: (Maybe String) -> [SearchF]
-- -> Direction -> YiM ()
searchInit, -- :: String
-- -> [SearchF]
-- -> IO SearchExp
continueSearch, -- :: SearchExp
-- -> Direction
-- -> IO SearchResult
-- * Incremental Search
isearchInitE,
isearchIsEmpty,
isearchAddE,
isearchPrevE,
isearchNextE,
isearchWordE,
isearchDelE,
isearchCancelE,
isearchFinishE,
-- * Replace
qrNext,
qrReplaceOne
) where
import Yi.Buffer
import Yi.Buffer.HighLevel
import Text.Regex.Posix.String ( Regex, compExtended, compIgnoreCase, compNewline, compile, execBlank )
import Yi.Editor
import qualified Yi.Editor as Editor
import Data.Bits ( (.|.) )
import Data.Char
import Data.Maybe
import Data.List
import Data.Typeable
import Control.Monad.State
import Yi.Core
-- ---------------------------------------------------------------------
-- Searching and substitutions with regular expressions
--
-- The most recent regex is held by the editor. You can get at it with
-- getRegeE. This is useful to determine if there was a previous
-- pattern.
--
-- | Put regex into regex 'register'
setRegexE :: SearchExp -> EditorM ()
setRegexE re = modify $ \e -> e { regex = Just re }
-- Return contents of regex register
getRegexE :: EditorM (Maybe SearchExp)
getRegexE = gets regex
-- ---------------------------------------------------------------------
--
-- | Global searching. Search for regex and move point to that position.
-- @Nothing@ means reuse the last regular expression. @Just s@ means use
-- @s@ as the new regular expression. Direction of search can be
-- specified as either @Backward@ or @Forward@ (forwards in the buffer).
-- Arguments to modify the compiled regular expression can be supplied
-- as well.
--
--
-- What would be interesting would be to implement our own general
-- mechanism to allow users to supply a regex function of any kind, and
-- search with that. This removes the restriction on strings be valid
-- under regex(3).
--
data SearchF = Basic -- ^ Use non-modern (i.e. basic) regexes
| IgnoreCase -- ^ Compile for matching that ignores char case
| NoNewLine -- ^ Compile for newline-insensitive matching
deriving Eq
type SearchMatch = (Int, Int)
type SearchResult = Maybe (Either SearchMatch SearchMatch)
type SearchExp = (String, Regex)
doSearch :: (Maybe String) -- ^ @Nothing@ means used previous
-- pattern, if any. Complain otherwise.
-- Use getRegexE to check for previous patterns
-> [SearchF] -- ^ Flags to modify the compiled regex
-> Direction -- ^ @Backward@ or @Forward@
-> YiM ()
doSearch s fs d =
case s of
Just re -> searchInit re fs >>= (flip continueSearch) d >>= f
Nothing -> do
mre <- withEditor getRegexE
case mre of
Nothing -> errorEditor "No previous search pattern" -- NB
Just r -> continueSearch r d >>= f
where
f mp = case mp of
Just (Right _) -> return ()
Just (Left _) -> msgEditor "Search wrapped"
Nothing -> errorEditor "Pattern not found"
continueSearch :: SearchExp
-> Direction
-> YiM SearchResult
continueSearch _ Backward = do
errorEditor "Backward searching is unimplemented"
return Nothing
continueSearch (s, re) _ = searchF s re
--
-- Set up a search.
--
searchInit :: String -> [SearchF] -> YiM SearchExp
searchInit re fs = do
Right c_re <- lift $ compile (extended .|. igcase .|. newline) execBlank re
let p = (re,c_re)
withEditor $ setRegexE p
return p
where
extended | Basic `elem` fs = 0
| otherwise = compExtended -- extended regex dflt
igcase | IgnoreCase `elem` fs = compIgnoreCase
| otherwise = 0 -- case insensitive dflt
newline | NoNewLine `elem` fs = 0
| otherwise = compNewline -- newline is special
-- ---------------------------------------------------------------------
-- Internal
--
-- Do a forward search, placing cursor at first char of pattern, if found.
-- Keymaps may implement their own regex language. How do we provide for this?
-- Also, what's happening with ^ not matching sol?
--
searchF :: String -> Regex -> YiM SearchResult
searchF _ c_re = withBuffer $ do
mp <- do
p <- pointB
rightB -- start immed. after cursor
mp <- regexB c_re
case fmap Right mp of
x@(Just _) -> return x
_ -> do moveTo 0
np <- regexB c_re
moveTo p
return (fmap Left np)
case mp of
Just (Right (p,_)) -> moveTo p
Just (Left (p,_)) -> moveTo p
_ -> return ()
return mp
------------------------------------------------------------------------
-- Global search and replace
--
------------------------------------------------------------------------
-- | Search and replace /on current line/. Returns Bool indicating
-- success or failure
--
-- TODO too complex.
--
searchAndRepLocal :: String -> String -> YiM Bool
searchAndRepLocal [] _ = return False -- hmm...
searchAndRepLocal re str = do
Right c_re <- lift $ compile compExtended execBlank re
withEditor $ setRegexE (re,c_re) -- store away for later use
mp <- withBuffer $ do -- find the regex
mp <- regexB c_re
return mp
case mp of
Just (i,j) -> withBuffer $ do
p <- pointB -- all buffer-level atm
moveToEol
ep <- pointB -- eol point of current line
moveTo i
moveToEol
eq <- pointB -- eol of matched line
moveTo p -- go home. sub doesn't move
if (ep /= eq) -- then match isn't on current line
then return False
else do -- do the replacement
moveTo i
deleteN (j - i)
insertN str
moveTo p -- and back to where we were!
return True -- signal success
Nothing -> return False
--------------------------
-- Incremental search
newtype Isearch = Isearch [(String, Int, Direction)] deriving Typeable
-- Maybe this should not be saved in a Dynamic component!
-- it could be embedded in the Keymap state.
instance Initializable Isearch where
initial = (Isearch [])
isearchInitE :: Direction -> EditorM ()
isearchInitE dir = do
p <- withBuffer0 pointB
setDynamic (Isearch [("",p,dir)])
printMsg "I-search: "
isearchIsEmpty :: EditorM Bool
isearchIsEmpty = do
Isearch s <- getDynamic
return $ not $ null $ fst3 $ head $ s
where fst3 (x,_,_) = x
isearchAddE :: String -> EditorM ()
isearchAddE increment = do
Isearch s <- getDynamic
let (previous,p0,direction) = head s
let current = previous ++ increment
printMsg $ "I-search: " ++ current
prevPoint <- withBuffer0 pointB
withBuffer0 $ moveTo p0
mp <- withBuffer0 $ searchB direction current
case mp of
Nothing -> do withBuffer0 $ moveTo prevPoint -- go back to where we were
setDynamic $ Isearch ((current,p0,direction):s)
printMsg $ "Failing I-search: " ++ current
Just p -> do setDynamic $ Isearch ((current,p,direction):s)
withBuffer0 $ moveTo (p+length current)
isearchDelE :: EditorM ()
isearchDelE = do
Isearch s <- getDynamic
case s of
(_:(text,p,dir):rest) -> do
withBuffer0 $ moveTo (p+length text)
setDynamic $ Isearch ((text,p,dir):rest)
printMsg $ "I-search: " ++ text
_ -> return () -- if the searched string is empty, don't try to remove chars from it.
-- TODO: merge isearchPrevE and isearchNextE
isearchPrevE :: EditorM ()
isearchPrevE = do
Isearch ((current,p0,_dir):rest) <- getDynamic
withBuffer0 $ moveTo (p0 - 1)
mp <- withBuffer0 $ searchB Backward current
case mp of
Nothing -> return ()
Just p -> do setDynamic $ Isearch ((current,p,Backward):rest)
withBuffer0 $ moveTo (p+length current)
isearchNextE :: EditorM ()
isearchNextE = do
Isearch ((current,p0,_dir):rest) <- getDynamic
withBuffer0 $ moveTo (p0 + 1)
mp <- withBuffer0 $ searchB Forward current
case mp of
Nothing -> return ()
Just p -> do setDynamic $ Isearch ((current,p,Forward):rest)
withBuffer0 $ moveTo (p+length current)
isearchWordE :: EditorM ()
isearchWordE = do
text <- withBuffer0 (pointB >>= nelemsB 32) -- add maximum 32 chars at a time.
let (prefix, rest) = span (not . isAlpha) text
word = takeWhile isAlpha rest
isearchAddE (prefix ++ word)
isearchFinishE :: EditorM ()
isearchFinishE = do
Isearch s <- getDynamic
let (_,p0,_) = last s
withBuffer0 $ setSelectionMarkPointB p0
printMsg "mark saved where search started"
isearchCancelE :: EditorM ()
isearchCancelE = do
Isearch s <- getDynamic
let (_,p0,_) = last s
withBuffer0 $ moveTo p0
printMsg "Quit"
-----------------
-- Query-Replace
qrNext :: BufferRef -> String -> YiM ()
qrNext b what = do
mp <- withGivenBuffer b $ searchB Forward what
case mp of
Nothing -> do
withEditor $ printMsg "String to search not found"
closeWindow
Just p -> withGivenBuffer b $ do
moveTo p
m <- getSelectionMarkB
setMarkPointB m (p+length what)
qrReplaceOne :: BufferRef -> String -> String -> YiM ()
qrReplaceOne b what replacement = do
withGivenBuffer b $ do
deleteN (length what)
insertN replacement
qrNext b what