module IDE.Find (
toggleFindbar
, constructFindReplace
, hideFindbar
, showFindbar
, focusFindEntry
, editFindInc
, editGotoLine
, FindState(..)
, getFindState
, setFindState
, editFind
, showToolbar
, hideToolbar
, toggleToolbar
) where
import Graphics.UI.Gtk
(toToolbar, ToolbarClass, toggleToolButtonSetActive,
castToToggleToolButton, toggleToolButtonGetActive, castToBin,
binGetChild, widgetGetName, containerGetChildren,
listStoreGetValue, treeModelGetPath, TreeIter, ListStore,
widgetModifyText, widgetModifyBase, toolbarChildHomogeneous, after,
entryActivate, spinButtonSetRange, focusInEvent, keyPressEvent,
deleteText, insertText, treeModelGetValue, matchSelected,
entryCompletionSetMatchFunc, cellText, cellLayoutSetAttributes,
cellLayoutPackStart, cellRendererTextNew, entryCompletionModel,
entrySetCompletion, entryCompletionNew, makeColumnIdString,
customStoreSetColumn, listStoreNew, toolItemSetExpand,
toolButtonSetLabel, toggleToolButtonNew, entryNew,
onToolButtonClicked, Widget, toolButtonNew, separatorToolItemNew,
labelNew, containerAdd, widgetSetName, spinButtonNewWithRange,
toolItemNew, toolbarInsert, toolButtonNewFromStock,
toolbarSetStyle, toolbarNew, Toolbar, widgetGrabFocus,
widgetShowAll, widgetHide, listStoreAppend, listStoreClear,
entrySetText, spinButtonSetValue, listStoreToList, castToEntry,
entryGetText, castToSpinButton, spinButtonGetValueAsInt,
StateType(..), ToolbarStyle(..), IconSize(..), AttrOp(..), set, on,
Color(..), widgetTooltipText)
import Graphics.UI.Gtk.Gdk.EventM
import qualified Graphics.UI.Gtk as Gtk
import Graphics.UI.Gtk.Buttons.ToggleButton
import Graphics.UI.Gtk.Buttons.CheckButton
import IDE.Core.State
import IDE.Utils.GUIUtils
import IDE.TextEditor hiding(afterFocusIn)
import IDE.Pane.SourceBuffer
import Data.Char (digitToInt, isDigit, toLower, isAlphaNum)
import Text.Regex.TDFA hiding (caseSensitive, after)
import qualified Text.Regex.TDFA as Regex
import Text.Regex.TDFA.Text (compile)
import Data.List (find, isPrefixOf)
import Data.Array (bounds, (!), inRange)
import IDE.Pane.Grep (grepWorkspace)
import IDE.Workspaces (workspaceTry, packageTry)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Trans.Reader (ask)
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Monad (liftM, filterM, when, unless)
import Foreign.C.Types (CInt(..))
import Foreign.Ptr (Ptr(..))
import Foreign.ForeignPtr (withForeignPtr)
import Graphics.UI.GtkInternals (unToolbar)
import Data.Text (Text)
import qualified Data.Text as T
(pack, unpack, singleton, isPrefixOf, length, null, toLower)
import Data.Monoid ((<>))
foreign import ccall safe "gtk_toolbar_set_icon_size"
gtk_toolbar_set_icon_size :: Ptr Toolbar -> CInt -> IO ()
toolbarSetIconSize :: ToolbarClass self => self -> IconSize -> IO ()
toolbarSetIconSize self iconSize =
withForeignPtr (unToolbar $ toToolbar self) $
\selfPtr ->gtk_toolbar_set_icon_size selfPtr (fromIntegral $ fromEnum iconSize)
data FindState = FindState {
entryStr :: Text
, entryHist :: [Text]
, replaceStr :: Text
, replaceHist :: [Text]
, caseSensitive :: Bool
, entireWord :: Bool
, wrapAround :: Bool
, regex :: Bool
, lineNr :: Int}
deriving(Eq,Ord,Show,Read)
getFindState :: IDEM FindState
getFindState = do
(fb,ls) <- needFindbar
liftIO $ do
lineNr <- getLineEntry fb >>= (spinButtonGetValueAsInt . castToSpinButton)
replaceStr <- getReplaceEntry fb >>= (entryGetText . castToEntry)
entryStr <- getFindEntry fb >>= (entryGetText . castToEntry)
entryHist <- listStoreToList ls
entireWord <- getEntireWord fb
wrapAround <- getWrapAround fb
caseSensitive <- getCaseSensitive fb
regex <- getRegex fb
return FindState{
entryStr = entryStr
, entryHist = entryHist
, replaceStr = replaceStr
, replaceHist = []
, caseSensitive = caseSensitive
, entireWord = entireWord
, wrapAround = wrapAround
, regex = regex
, lineNr = lineNr}
setFindState :: FindState -> IDEAction
setFindState fs = do
(fb,ls) <- needFindbar
liftIO $ do
getLineEntry fb >>= (\e -> spinButtonSetValue (castToSpinButton e) (fromIntegral (lineNr fs)))
getReplaceEntry fb >>= (\e -> entrySetText (castToEntry e) (replaceStr fs))
getFindEntry fb >>= (\e -> entrySetText (castToEntry e) (entryStr fs))
listStoreClear ls
mapM_ (listStoreAppend ls) (entryHist fs)
setEntireWord fb (entireWord fs)
setWrapAround fb (wrapAround fs)
setCaseSensitive fb (caseSensitive fs)
setRegex fb (regex fs)
hideToolbar :: IDEAction
hideToolbar = do
(_,mbtb) <- readIDE toolbar
case mbtb of
Nothing -> return ()
Just tb -> do
modifyIDE_ (\ide -> ide{toolbar = (False,snd (toolbar ide))})
liftIO $ widgetHide tb
showToolbar :: IDEAction
showToolbar = do
(_,mbtb) <- readIDE toolbar
case mbtb of
Nothing -> return ()
Just tb -> do
modifyIDE_ (\ide -> ide{toolbar = (True,snd (toolbar ide))})
liftIO $ widgetShowAll tb
toggleToolbar :: IDEAction
toggleToolbar = do
toolbar' <- readIDE toolbar
if fst toolbar'
then hideToolbar
else showToolbar
hideFindbar :: IDEAction
hideFindbar = do
(_,mbfb) <- readIDE findbar
modifyIDE_ (\ide -> ide{findbar = (False,mbfb)})
case mbfb of
Nothing -> return ()
Just (fb,_) -> liftIO $ widgetHide fb
showFindbar :: IDEAction
showFindbar = do
(_,mbfb) <- readIDE findbar
modifyIDE_ (\ide -> ide{findbar = (True,mbfb)})
case mbfb of
Nothing -> return ()
Just (fb,_) -> liftIO $ widgetShowAll fb
focusFindEntry :: IDEAction
focusFindEntry = do
(fb,_) <- needFindbar
liftIO $ do
entry <- getFindEntry fb
widgetGrabFocus entry
toggleFindbar :: IDEAction
toggleFindbar = do
findbar <- readIDE findbar
if fst findbar
then hideFindbar
else showFindbar
constructFindReplace :: IDEM Toolbar
constructFindReplace = reifyIDE $ \ ideR -> do
toolbar <- toolbarNew
toolbarSetStyle toolbar ToolbarIcons
toolbarSetIconSize toolbar IconSizeSmallToolbar
closeButton <- toolButtonNewFromStock "gtk-close"
toolbarInsert toolbar closeButton 0
spinTool <- toolItemNew
spinL <- spinButtonNewWithRange 1.0 1000.0 10.0
widgetSetName spinL ("gotoLineEntry" :: Text)
containerAdd spinTool spinL
widgetSetName spinTool ("gotoLineEntryTool" :: Text)
toolbarInsert toolbar spinTool 0
labelTool3 <- toolItemNew
label3 <- labelNew (Just (__"Goto Line :"))
containerAdd labelTool3 label3
toolbarInsert toolbar labelTool3 0
sep1 <- separatorToolItemNew
toolbarInsert toolbar sep1 0
let performGrep = reflectIDE (packageTry $ doGrep toolbar) ideR
grepButton <- toolButtonNew (Nothing :: Maybe Widget) (Just (__"Grep"))
toolbarInsert toolbar grepButton 0
grepButton `onToolButtonClicked` performGrep
set grepButton [widgetTooltipText := Just (__"Search in multiple files")]
sep1 <- separatorToolItemNew
toolbarInsert toolbar sep1 0
replaceAllButton <- toolButtonNew (Nothing :: Maybe Widget) (Just (__"Replace All"))
toolbarInsert toolbar replaceAllButton 0
replaceButton <- toolButtonNewFromStock "gtk-find-and-replace"
toolbarInsert toolbar replaceButton 0
replaceTool <- toolItemNew
rentry <- entryNew
widgetSetName rentry ("replaceEntry" :: Text)
containerAdd replaceTool rentry
widgetSetName replaceTool ("replaceTool" :: Text)
toolbarInsert toolbar replaceTool 0
labelTool2 <- toolItemNew
label2 <- labelNew (Just (__"Replace: "))
containerAdd labelTool2 label2
toolbarInsert toolbar labelTool2 0
sep2 <- separatorToolItemNew
toolbarInsert toolbar sep2 0
nextButton <- toolButtonNewFromStock "gtk-go-forward"
toolbarInsert toolbar nextButton 0
set nextButton [widgetTooltipText := Just (__"Search for the next match in the current file")]
nextButton `onToolButtonClicked` doSearch toolbar Forward ideR
wrapAroundButton <- toggleToolButtonNew
toolButtonSetLabel wrapAroundButton (Just (__"Wrap"))
widgetSetName wrapAroundButton ("wrapAroundButton" :: Text)
toolbarInsert toolbar wrapAroundButton 0
set wrapAroundButton [widgetTooltipText := Just (__"When selected searching will continue from the top when no more matches are found")]
previousButton <- toolButtonNewFromStock "gtk-go-back"
toolbarInsert toolbar previousButton 0
set previousButton [widgetTooltipText := Just (__"Search for the previous match in the current file")]
previousButton `onToolButtonClicked` doSearch toolbar Backward ideR
entryTool <- toolItemNew
entry <- entryNew
widgetSetName entry ("searchEntry" :: Text)
containerAdd entryTool entry
widgetSetName entryTool ("searchEntryTool" :: Text)
toolItemSetExpand entryTool True
toolbarInsert toolbar entryTool 0
let column0 = makeColumnIdString 0
store <- listStoreNew []
customStoreSetColumn store column0 id
completion <- entryCompletionNew
entrySetCompletion entry completion
set completion [entryCompletionModel := Just store]
cell <- cellRendererTextNew
cellLayoutPackStart completion cell True
cellLayoutSetAttributes completion cell store
(\ cd -> [cellText := cd])
entryCompletionSetMatchFunc completion (matchFunc store)
on completion matchSelected $ \ model iter -> do
txt <- treeModelGetValue model iter column0
entrySetText entry txt
doSearch toolbar Forward ideR
return True
regexButton <- toggleToolButtonNew
toolButtonSetLabel regexButton (Just (__"Regex"))
widgetSetName regexButton ("regexButton" :: Text)
toolbarInsert toolbar regexButton 0
regexButton `onToolButtonClicked` doSearch toolbar Insert ideR
set regexButton [widgetTooltipText := Just (__"When selected the search string is used as a regular expression")]
entireWordButton <- toggleToolButtonNew
toolButtonSetLabel entireWordButton (Just (__"Words"))
widgetSetName entireWordButton ("entireWordButton" :: Text)
toolbarInsert toolbar entireWordButton 0
entireWordButton `onToolButtonClicked` doSearch toolbar Insert ideR
set entireWordButton [widgetTooltipText := Just (__"When selected only entire words are matched")]
caseSensitiveButton <- toggleToolButtonNew
toolButtonSetLabel caseSensitiveButton (Just (__"Case"))
widgetSetName caseSensitiveButton ("caseSensitiveButton" :: Text)
toolbarInsert toolbar caseSensitiveButton 0
caseSensitiveButton `onToolButtonClicked`
doSearch toolbar Insert ideR
set caseSensitiveButton [widgetTooltipText := Just (__"When selected the search is case sensitive")]
labelTool <- toolItemNew
label <- labelNew (Just (__"Find: "))
containerAdd labelTool label
toolbarInsert toolbar labelTool 0
after entry insertText (\ (t::Text) i -> do
doSearch toolbar Insert ideR
return i)
after entry deleteText (\ _ _ -> doSearch toolbar Delete ideR)
on entry entryActivate $ doSearch toolbar Forward ideR
on entry focusInEvent $ do
liftIO $ reflectIDE (triggerEventIDE (Sensitivity [(SensitivityEditor, False)])) ideR
return False
replaceButton `onToolButtonClicked` replace toolbar Forward ideR
let performReplaceAll = replaceAll toolbar Forward ideR
replaceAllButton `onToolButtonClicked` performReplaceAll
let ctrl "c" = toggleToolButton caseSensitiveButton >> return True
ctrl "e" = toggleToolButton regexButton >> return True
ctrl "w" = toggleToolButton entireWordButton >> return True
ctrl "p" = toggleToolButton wrapAroundButton >> return True
ctrl "r" = performReplaceAll >> return True
ctrl "g" = performGrep >> return True
ctrl _ = return False
toggleToolButton btn = do
old <- toggleToolButtonGetActive btn
toggleToolButtonSetActive btn $ not old
entry `on` keyPressEvent $ do
name <- eventKeyName
mods <- eventModifier
case name of
"Down" -> liftIO $ doSearch toolbar Forward ideR >> return True
"Up" -> liftIO $ doSearch toolbar Backward ideR >> return True
"Escape" -> liftIO $ getOut ideR >> return True
"Tab" -> liftIO $ do
re <- getReplaceEntry toolbar
widgetGrabFocus re
return True
_ | mapControlCommand Control `elem` mods -> liftIO . ctrl $ T.toLower name
_ -> return False
rentry `on` keyPressEvent $ do
name <- eventKeyName
mods <- eventModifier
case () of
_ | name == "Tab" || name == "ISO_Left_Tab" -> liftIO $ do
fe <- getFindEntry toolbar
widgetGrabFocus fe
return True
| mapControlCommand Control `elem` mods ->
liftIO . ctrl $ T.toLower name
| otherwise -> return False
after spinL focusInEvent . liftIO $ reflectIDE (inActiveBufContext True $ \ _ _ ebuf _ _ -> do
max <- getLineCount ebuf
liftIO $ spinButtonSetRange spinL 1.0 (fromIntegral max)
return True) ideR
spinL `on` keyPressEvent $ do
name <- eventKeyName
mods <- eventModifier
case name of
"Escape" -> liftIO $ getOut ideR >> return True
"Tab" -> liftIO $ do
re <- getFindEntry toolbar
widgetGrabFocus re
return True
_ | mapControlCommand Control `elem` mods -> liftIO . ctrl $ T.toLower name
_ -> return False
after spinL entryActivate $ reflectIDE (inActiveBufContext () $ \ _ sv ebuf _ _ -> do
line <- liftIO $ spinButtonGetValueAsInt spinL
iter <- getIterAtLine ebuf (line 1)
placeCursor ebuf iter
scrollToIter sv iter 0.2 Nothing
liftIO $ getOut ideR
return ()) ideR
closeButton `onToolButtonClicked` reflectIDE hideFindbar ideR
set toolbar [toolbarChildHomogeneous spinTool := False]
set toolbar [toolbarChildHomogeneous wrapAroundButton := False]
set toolbar [toolbarChildHomogeneous entireWordButton := False]
set toolbar [toolbarChildHomogeneous caseSensitiveButton := False]
set toolbar [toolbarChildHomogeneous regexButton := False]
set toolbar [toolbarChildHomogeneous replaceAllButton := False]
set toolbar [toolbarChildHomogeneous labelTool := False]
set toolbar [toolbarChildHomogeneous labelTool2 := False]
set toolbar [toolbarChildHomogeneous labelTool3 := False]
reflectIDE (modifyIDE_ (\ ide -> ide{findbar = (False, Just (toolbar, store))})) ideR
return toolbar
where
getOut = reflectIDE $ do
hideFindbar
maybeActiveBuf ?>>= makeActive
doSearch :: Toolbar -> SearchHint -> IDERef -> IO ()
doSearch fb hint ideR = do
entry <- getFindEntry fb
search <- entryGetText (castToEntry entry)
entireWord <- getEntireWord fb
caseSensitive <- getCaseSensitive fb
wrapAround <- getWrapAround fb
regex <- getRegex fb
mbExpAndMatchIndex <- liftIO $ regexAndMatchIndex caseSensitive entireWord regex search
case mbExpAndMatchIndex of
Just (exp, matchIndex) -> do
res <- reflectIDE (editFind entireWord caseSensitive wrapAround regex search "" hint) ideR
if res || T.null search
then do
widgetModifyBase entry StateNormal white
widgetModifyText entry StateNormal black
else do
widgetModifyBase entry StateNormal red
widgetModifyText entry StateNormal white
Nothing ->
if T.null search
then do
widgetModifyBase entry StateNormal white
widgetModifyText entry StateNormal black
else do
widgetModifyBase entry StateNormal orange
widgetModifyText entry StateNormal black
reflectIDE (addToHist search) ideR
return ()
doGrep :: Toolbar -> PackageAction
doGrep fb = do
package <- ask
ideR <- lift ask
entry <- liftIO $ getFindEntry fb
search <- liftIO $ entryGetText (castToEntry entry)
entireWord <- liftIO $ getEntireWord fb
caseSensitive <- liftIO $ getCaseSensitive fb
wrapAround <- liftIO $ getWrapAround fb
regex <- liftIO $ getRegex fb
let (regexString, _) = regexStringAndMatchIndex entireWord regex search
liftIDE $ workspaceTry $ grepWorkspace regexString caseSensitive
matchFunc :: ListStore Text -> Text -> TreeIter -> IO Bool
matchFunc model str iter = do
tp <- treeModelGetPath model iter
case tp of
(i:_) -> do row <- listStoreGetValue model i
return (T.isPrefixOf (T.toLower str) (T.toLower row) && T.length str < T.length row)
otherwise -> return False
addToHist :: Text -> IDEAction
addToHist str =
unless (T.null str) $
do (_, ls) <- needFindbar
liftIO $
do entryHist <- listStoreToList ls
unless (any (str `T.isPrefixOf`) entryHist) $
do let newList
= take 12
(str : filter (\ e -> not (e `T.isPrefixOf` str)) entryHist)
listStoreClear ls
mapM_ (listStoreAppend ls) newList
replace :: Toolbar -> SearchHint -> IDERef -> IO ()
replace fb hint ideR = do
entry <- getFindEntry fb
search <- entryGetText (castToEntry entry)
rentry <- getReplaceEntry fb
replace <- entryGetText (castToEntry rentry)
entireWord <- getEntireWord fb
caseSensitive <- getCaseSensitive fb
wrapAround <- getWrapAround fb
regex <- getRegex fb
found <- reflectIDE (editReplace entireWord caseSensitive wrapAround regex search replace hint)
ideR
return ()
replaceAll :: Toolbar -> SearchHint -> IDERef -> IO ()
replaceAll fb hint ideR = do
entry <- getFindEntry fb
search <- entryGetText (castToEntry entry)
rentry <- getReplaceEntry fb
replace <- entryGetText (castToEntry rentry)
entireWord <- getEntireWord fb
caseSensitive <- getCaseSensitive fb
wrapAround <- getWrapAround fb
regex <- getRegex fb
found <- reflectIDE (editReplaceAll entireWord caseSensitive wrapAround regex search replace hint)
ideR
return ()
editFind :: Bool -> Bool -> Bool -> Bool -> Text -> Text -> SearchHint -> IDEM Bool
editFind entireWord caseSensitive wrapAround regex search dummy hint = do
mbExpAndMatchIndex <- liftIO $ regexAndMatchIndex caseSensitive entireWord regex search
case mbExpAndMatchIndex of
Nothing -> return False
Just (exp, matchIndex) -> editFind' exp matchIndex wrapAround dummy hint
editFind' :: Regex -> Int -> Bool -> Text -> SearchHint -> IDEM Bool
editFind' exp matchIndex wrapAround dummy hint =
inActiveBufContext False $ \_ sv ebuf _ _ -> do
i1 <- getStartIter ebuf
i2 <- getEndIter ebuf
text <- getText ebuf i1 i2 True
removeTagByName ebuf "found"
startMark <- getInsertMark ebuf
st1 <- getIterAtMark ebuf startMark
mbsr2 <-
if hint == Backward
then do
st2 <- backwardCharC st1
st3 <- backwardCharC st2
mbsr <- backSearch exp matchIndex ebuf text st3
case mbsr of
Nothing ->
if wrapAround
then backSearch exp matchIndex ebuf text i2
else return Nothing
m -> return m
else do
st2 <- if hint == Forward
then forwardCharC st1
else return st1
mbsr <- forwardSearch exp matchIndex ebuf text st2
case mbsr of
Nothing ->
if wrapAround
then forwardSearch exp matchIndex ebuf text i1
else return Nothing
m -> return m
case mbsr2 of
Just (start,end,_) -> do --found
scrollToIter sv start 0.2 Nothing
applyTagByName ebuf "found" start end
placeCursor ebuf start
return True
Nothing -> return False
where
backSearch exp matchIndex ebuf text iter = do
offset <- getOffset iter
findMatch exp matchIndex ebuf text (<= offset) True
forwardSearch exp matchIndex ebuf text iter = do
offset <- getOffset iter
findMatch exp matchIndex ebuf text (>= offset) False
regexAndMatchIndex :: Bool -> Bool -> Bool -> Text -> IO (Maybe (Regex, Int))
regexAndMatchIndex caseSensitive entireWord regex string =
if T.null string
then return Nothing
else do
let (regexString, index) = regexStringAndMatchIndex entireWord regex string
case compileRegex caseSensitive regexString of
Left err -> do
sysMessage Normal $ T.pack err
return Nothing
Right regex -> return $ Just (regex, index)
regexStringAndMatchIndex :: Bool -> Bool -> Text -> (Text, Int)
regexStringAndMatchIndex entireWord regex string =
let regexString = if regex
then string
else foldl (\s c -> s <> if isAlphaNum c then T.singleton c else "\\"<>T.singleton c) "" $ T.unpack string in
if entireWord
then ("(^|[^a-zA-Z0-9])(" <> regexString <> ")($|[^a-zA-Z0-9])", 2)
else (regexString, 0)
findMatch :: TextEditor editor => Regex -> Int -> EditorBuffer editor -> Text -> (Int -> Bool) -> Bool -> IDEM (Maybe (EditorIter editor, EditorIter editor, MatchArray))
findMatch exp matchIndex gtkbuf text offsetPred findLast = do
let matches = (if findLast then reverse else id) (matchAll exp text)
case find (offsetPred . fst . (!matchIndex)) matches of
Just matches -> do
iterStart <- getStartIter gtkbuf
iter1 <- forwardCharsC iterStart (fst (matches!matchIndex))
iter2 <- forwardCharsC iter1 (snd (matches!matchIndex))
return $ Just (iter1, iter2, matches)
Nothing -> return Nothing
editReplace :: Bool -> Bool -> Bool -> Bool -> Text -> Text -> SearchHint -> IDEM Bool
editReplace entireWord caseSensitive wrapAround regex search replace hint =
editReplace' entireWord caseSensitive wrapAround regex search replace hint True
editReplace' :: Bool -> Bool -> Bool -> Bool -> Text -> Text -> SearchHint -> Bool -> IDEM Bool
editReplace' entireWord caseSensitive wrapAround regex search replace hint mayRepeat =
inActiveBufContext False $ \_ _ ebuf _ _ -> do
insertMark <- getInsertMark ebuf
iter <- getIterAtMark ebuf insertMark
offset <- getOffset iter
mbExpAndMatchIndex <- liftIO $ regexAndMatchIndex caseSensitive entireWord regex search
case mbExpAndMatchIndex of
Just (exp, matchIndex) -> do
iStart <- getStartIter ebuf
iEnd <- getEndIter ebuf
text <- getText ebuf iStart iEnd True
match <- findMatch exp matchIndex ebuf text (== offset) False
case match of
Just (iterStart, iterEnd, matches) -> do
mbText <- liftIO $ replacementText regex text matchIndex matches $ T.unpack replace
case mbText of
Just text -> do
delete ebuf iterStart iterEnd
insert ebuf iterStart (T.pack text)
Nothing -> do
sysMessage Normal
"Should never happen. findMatch worked but repleacementText failed"
return ()
editFind entireWord caseSensitive wrapAround regex search "" hint
Nothing -> do
r <- editFind entireWord caseSensitive wrapAround regex search "" hint
if r
then editReplace' entireWord caseSensitive wrapAround regex search
replace hint False
else return False
Nothing -> return False
where
replacementText False _ _ _ replace = return $ Just replace
replacementText True text matchIndex matches replace =
case compileRegex caseSensitive search of
Left err -> do
sysMessage Normal $ T.pack err
return Nothing
Right exp -> return $ Just $ regexReplacement text matchIndex matches replace
regexReplacement :: Text -> Int -> MatchArray -> String -> String
regexReplacement _ _ _ [] = []
regexReplacement text matchIndex matches ('\\' : '\\' : xs) = '\\' : regexReplacement text matchIndex matches xs
regexReplacement text matchIndex matches ('\\' : n : xs) | isDigit n =
let subIndex = matchIndex + digitToInt n
value = if inRange (bounds matches) subIndex
then
let subExp = matches!(matchIndex + digitToInt n) in
take (snd subExp) $ drop (fst subExp) $ T.unpack text
else ['\\', n] in
value ++ regexReplacement text matchIndex matches xs
regexReplacement text matchIndex matches (x : xs) = x : regexReplacement text matchIndex matches xs
editReplaceAll :: Bool -> Bool -> Bool -> Bool -> Text -> Text -> SearchHint -> IDEM Bool
editReplaceAll entireWord caseSensitive wrapAround regex search replace hint = do
res <- editReplace' entireWord caseSensitive False regex search replace hint True
if res
then editReplaceAll entireWord caseSensitive False regex search replace hint
else return False
compileRegex :: Bool -> Text -> Either String Regex
compileRegex caseSense searchString =
let compOption = defaultCompOpt {
Regex.caseSensitive = caseSense
, multiline = True } in
compile compOption defaultExecOpt searchString
red = Color 64000 10000 10000
orange = Color 64000 48000 0
white = Color 64000 64000 64000
black = Color 0 0 0
needFindbar :: IDEM (Toolbar,ListStore Text)
needFindbar = do
(_,mbfb) <- readIDE findbar
case mbfb of
Nothing -> throwIDE "Find>>needFindbar: Findbar not initialized"
Just p -> return p
editFindInc :: SearchHint -> IDEAction
editFindInc hint = do
ideR <- ask
(fb,_) <- needFindbar
case hint of
Initial -> inActiveBufContext () $ \_ _ ebuf _ _ -> do
hasSelection <- hasSelection ebuf
when hasSelection $ do
(i1,i2) <- getSelectionBounds ebuf
text <- getText ebuf i1 i2 False
findEntry <- liftIO $ getFindEntry fb
liftIO $ entrySetText (castToEntry findEntry) text
return ()
_ -> return ()
showFindbar
reifyIDE $ \ideR -> do
entry <- getFindEntry fb
widgetGrabFocus entry
case hint of
Forward -> doSearch fb Forward ideR
Backward -> doSearch fb Backward ideR
_ -> return ()
editGotoLine :: IDEAction
editGotoLine = do
showFindbar
(fb,_) <- needFindbar
entry <- liftIO $ getLineEntry fb
liftIO $ widgetGrabFocus entry
getLineEntry, getReplaceEntry, getFindEntry :: Toolbar -> IO Widget
getLineEntry = getWidget "gotoLineEntryTool"
getReplaceEntry = getWidget "replaceTool"
getFindEntry = getWidget "searchEntryTool"
getWidget :: Text -> Toolbar -> IO Widget
getWidget str tb = do
widgets <- containerGetChildren tb
entryL <- filterM (liftM (== str) . widgetGetName) widgets
case entryL of
[w] -> do
mbw <- binGetChild (castToBin w)
case mbw of
Nothing -> throwIDE "Find>>getWidget not found(1)"
Just w -> return w
_ -> throwIDE "Find>>getWidget not found(2)"
getEntireWord, getWrapAround, getCaseSensitive, getRegex :: Toolbar -> IO Bool
getEntireWord = getSelection "entireWordButton"
getWrapAround = getSelection "wrapAroundButton"
getCaseSensitive = getSelection "caseSensitiveButton"
getRegex = getSelection "regexButton"
getSelection :: Text -> Toolbar -> IO Bool
getSelection str tb = do
widgets <- containerGetChildren tb
entryL <- filterM (liftM (== str) . widgetGetName) widgets
case entryL of
[w] -> toggleToolButtonGetActive (castToToggleToolButton w)
_ -> throwIDE "Find>>getIt widget not found"
setEntireWord, setWrapAround, setCaseSensitive, setRegex :: Toolbar -> Bool -> IO ()
setEntireWord = setSelection "entireWordButton"
setWrapAround = setSelection "wrapAroundButton"
setCaseSensitive = setSelection "caseSensitiveButton"
setRegex = setSelection "regexButton"
setSelection :: Text -> Toolbar -> Bool -> IO ()
setSelection str tb bool = do
widgets <- containerGetChildren tb
entryL <- filterM (liftM (== str) . widgetGetName ) widgets
case entryL of
[w] -> toggleToolButtonSetActive (castToToggleToolButton w) bool
_ -> throwIDE "Find>>getIt widget not found"