-- | Like Step4 but with Find / Replace support module Step5 (step5) where import Graphics.UI.WX import Graphics.UI.WXCore hiding (wxID_CUT, wxID_COPY, wxID_PASTE, wxID_FIND, wxID_FORWARD, wxID_BACKWARD) import Data.Bits import Data.Char (toLower) import Data.List -- | /FRFlags/ represents what the user choose in the FindReplaceDialog data FRFlags = FRFlags {frfGoingDown :: Bool, frfMatchCase :: Bool, frfWholeWord :: Bool, frfWrapSearch :: Bool} deriving (Eq, Show) data GUIContext = GUICtx { guiWin :: Frame (), guiEditor :: TextCtrl (), guiFile :: Var (Maybe FilePath), guiTimer :: TimerEx (), guiPast :: Var [String], guiFuture :: Var [String], guiSearch :: FindReplaceData () -- ^ Needed to hold the what the user is looking for } wxID_MYUNDO, wxID_MYREDO, wxID_CUT, wxID_COPY, wxID_PASTE, wxID_FIND, wxID_FORWARD, wxID_BACKWARD, wxID_REPLACE :: Id wxID_MYUNDO = 5108 wxID_MYREDO = 5109 wxID_CUT = 5031 wxID_COPY = 5032 wxID_PASTE = 5033 wxID_FIND = 5035 --HACK: They're not correctly numbered in WxcDefs or they wxID_REPLACE = 5038 -- don't even exist wxID_FORWARD = 5106 wxID_BACKWARD = 5107 step5 :: IO () step5 = do win <- frame [text := "wxhNotepad - Step 5", visible := False] editor <- textCtrl win [font := fontFixed, text := "Find / Replace functionality is supported " ++ "by wxHaskell but it's kinda hidden in " ++ "WXCore. We'll need a little digging for " ++ "this step.\n" ++ "This step involved tons of code, so I " ++ "think there must be a better way to do it." ++ "If you find it, please post it on the " ++ "wxhaskell-users mailing list :)"] filePath <- varCreate Nothing refreshTimer <- timer win [] past <- varCreate [] future <- varCreate [] -- We create a FindReplaceData that will hold the information about the -- last search search <- findReplaceDataCreate wxFR_DOWN let guiCtx = GUICtx win editor filePath refreshTimer past future search set editor [on keyboard := \_ -> restartTimer guiCtx >> propagateEvent] timerOnCommand refreshTimer $ updatePast guiCtx updatePast guiCtx -- We create a menu for the window with the same items from previous steps -- and a couple of new items in the edit menu mnuFile <- menuPane [text := "File"] mnuEdit <- menuPane [text := "Edit"] menuAppend mnuFile wxID_OPEN "&Open...\tCtrl-o" "Open Page" False menuAppend mnuFile wxID_SAVE "&Save\tCtrl-s" "Save Page" False menuAppend mnuFile wxID_SAVEAS "Save &as...\tCtrl-Shift-s" "Save Page as" False menuAppend mnuFile wxID_CLOSE "&Close\tCtrl-W" "Close Page" False menuAppend mnuEdit wxID_MYUNDO "&Undo\tCtrl-z" "Undo last action" False menuAppend mnuEdit wxID_MYREDO "&Redo\tCtrl-Shift-z" "Redo last undone action" False menuAppendSeparator mnuEdit menuAppend mnuEdit wxID_CUT "C&ut\tCtrl-x" "Cut" False menuAppend mnuEdit wxID_COPY "&Copy\tCtrl-c" "Copy" False menuAppend mnuEdit wxID_PASTE "&Paste\tCtrl-v" "Paste" False menuAppendSeparator mnuEdit menuAppend mnuEdit wxID_FIND "&Find...\tCtrl-f" "Find" False menuAppend mnuEdit wxID_FORWARD "Find &Next\tCtrl-g" "Find Next" False menuAppend mnuEdit wxID_BACKWARD "Find &Previous\tCtrl-Shift-g" "Find Previous" False menuAppend mnuEdit wxID_REPLACE "&Replace...\tCtrl-Shift-r" "Replace" False evtHandlerOnMenuCommand win wxID_OPEN $ openPage guiCtx evtHandlerOnMenuCommand win wxID_SAVE $ savePage guiCtx evtHandlerOnMenuCommand win wxID_SAVEAS $ savePageAs guiCtx evtHandlerOnMenuCommand win wxID_CLOSE $ windowClose win False >> return () evtHandlerOnMenuCommand win wxID_MYUNDO $ undo guiCtx evtHandlerOnMenuCommand win wxID_MYREDO $ redo guiCtx evtHandlerOnMenuCommand win wxID_CUT $ cut guiCtx evtHandlerOnMenuCommand win wxID_COPY $ copy guiCtx evtHandlerOnMenuCommand win wxID_PASTE $ paste guiCtx evtHandlerOnMenuCommand win wxID_FIND $ justFind guiCtx evtHandlerOnMenuCommand win wxID_FORWARD $ justFindNext guiCtx evtHandlerOnMenuCommand win wxID_BACKWARD $ justFindPrev guiCtx evtHandlerOnMenuCommand win wxID_REPLACE $ findReplace guiCtx set win [menuBar := [mnuFile, mnuEdit]] set win [layout := fill $ widget editor, clientSize := sz 640 480] focusOn editor set win [visible := True] savePageAs, savePage, openPage, undo, redo, restartTimer, killTimer, updatePast, clearPast, cut, copy, paste, justFind, justFindNext, justFindPrev, findReplace :: GUIContext -> IO () openPage guiCtx@GUICtx{guiWin = win, guiEditor = editor, guiFile = filePath} = do maybePath <- fileOpenDialog win True True "Open file..." [("Haskells (*.hs)",["*.hs"]), ("Texts (*.txt)", ["*.txt"]), ("Any file (*.*)",["*.*"])] "" "" case maybePath of Nothing -> return () Just path -> do clearPast guiCtx textCtrlLoadFile editor path updatePast guiCtx set win [text := "wxhnotepad - " ++ path] varSet filePath $ Just path savePageAs GUICtx{guiWin = win, guiEditor = editor, guiFile = filePath} = do maybePath <- fileSaveDialog win True True "Save file..." [("Haskells (*.hs)",["*.hs"]), ("Texts (*.txt)", ["*.txt"]), ("Any file (*.*)",["*.*"])] "" "" case maybePath of Nothing -> return () Just path -> do textCtrlSaveFile editor path set win [text := "wxhnotepad - " ++ path] varSet filePath $ Just path savePage guiCtx@GUICtx{guiWin = win, guiEditor = editor, guiFile = filePath} = do maybePath <- varGet filePath case maybePath of Nothing -> savePageAs guiCtx Just path -> textCtrlSaveFile editor path >> return () undo guiCtx@GUICtx{guiEditor = editor, guiPast = past, guiFuture = future} = do updatePast guiCtx history <- varGet past case history of [] -> return () [t] -> return () tnow:tlast:ts -> do varUpdate future (tnow:) varSet past $ tlast:ts set editor [text := tlast] redo guiCtx@GUICtx{guiEditor = editor, guiPast = past, guiFuture = future} = do updatePast guiCtx coming <- varGet future case coming of [] -> return () t:ts -> do varSet future ts varUpdate past (t:) set editor [text := t] updatePast guiCtx@GUICtx{guiEditor = editor, guiPast = past, guiFuture = future} = do tnow <- get editor text history <- varGet past case history of [] -> varSet past [tnow] t:_ -> if t /= tnow then do varUpdate past (tnow:) varSet future [] else return () killTimer guiCtx clearPast GUICtx{guiPast = past, guiFuture = future} = do varSet past [] varSet future [] restartTimer guiCtx@GUICtx{guiWin = win, guiTimer = refreshTimer} = do started <- timerStart refreshTimer 1000 True if started then return () else do errorDialog win "Error" "Can't start more timers" wxcAppExit killTimer GUICtx{guiTimer = refreshTimer} = timerStop refreshTimer copy GUICtx{guiEditor = editor} = textCtrlCopy editor cut guiCtx@GUICtx{guiEditor = editor} = textCtrlCut editor >> updatePast guiCtx paste guiCtx@GUICtx{guiEditor = editor} = textCtrlPaste editor >> updatePast guiCtx -- We open a FindReplaceDialog with default style to let the user choose what to do justFind guiCtx = openFindDialog guiCtx "Find..." dialogDefaultStyle justFindNext guiCtx@GUICtx{guiSearch = search} = do -- We get the current search parameters curFlags <- findReplaceDataGetFlags search -- We set the finding direction to down findReplaceDataSetFlags search $ curFlags .|. wxFR_DOWN -- and we proceed with the search findNextButton guiCtx justFindPrev guiCtx@GUICtx{guiSearch = search} = do -- We get the current search parameters curFlags <- findReplaceDataGetFlags search -- We set the finding direction to down findReplaceDataSetFlags search $ curFlags .&. complement wxFR_DOWN -- and we proceed with the search findNextButton guiCtx -- We open a FindReplaceDialog with replace style findReplace guiCtx = openFindDialog guiCtx "Find and Replace..." $ dialogDefaultStyle .|. wxFR_REPLACEDIALOG -- | Auxiliary function to build a /FRFlags/ buildFRFlags :: Bool -- ^ Wrap the Search? -> Int -- ^ BitMask for Direction, Match Case and Whole Word flags -> IO FRFlags buildFRFlags w x = return FRFlags {frfGoingDown = (x .&. wxFR_DOWN) /= 0, frfMatchCase = (x .&. wxFR_MATCHCASE) /= 0, frfWholeWord = (x .&. wxFR_WHOLEWORD) /= 0, frfWrapSearch = w} -- | Opens a FindReplace Dialog openFindDialog :: GUIContext -- ^ The current GUIContext -> String -- ^ The title of the dialog -> Int -- ^ The style of the dialog -> IO () openFindDialog guiCtx@GUICtx{guiWin = win, guiSearch = search} title dlgStyle = do -- First we must create a dialog with the search parameters that we -- already have. The dialog itself is going to modify them according -- to the user selections frdialog <- findReplaceDialogCreate win search title $ dlgStyle + wxFR_NOWHOLEWORD -- One of the weirdest functions on wxHaskell is windowOnEvent. -- I did not really understand what are the parameters for exactly, but -- if we use it this way, we manage to get a certain event with id k to -- fire the function f... :) let winSet k f = let hnd _ = f guiCtx >> propagateEvent in windowOnEvent frdialog [k] hnd hnd -- Using that magic trick, we associate our functions with the button -- pressing events in the dialog... winSet wxEVT_COMMAND_FIND findNextButton winSet wxEVT_COMMAND_FIND_NEXT findNextButton winSet wxEVT_COMMAND_FIND_REPLACE findReplaceButton winSet wxEVT_COMMAND_FIND_REPLACE_ALL findReplaceAllButton -- And... it's showtime!! set frdialog [visible := True] -- These 3 functions handle the button events in the dialog but also handle the -- menuitems when the dialog is not there findNextButton, findReplaceButton, findReplaceAllButton :: GUIContext -> IO () findNextButton guiCtx@GUICtx{guiEditor= editor, guiWin = win, guiSearch= search} = do -- We check what the user is trying to find s <- findReplaceDataGetFindString search -- We parse it, assuming that the user wants to wrap its search fs <- findReplaceDataGetFlags search >>= buildFRFlags True -- We try to find a match in the text mip <- findMatch s fs editor case mip of Nothing -> -- If there's no match, we inform that to the user infoDialog win "Find Results" $ s ++ " not found." Just ip -> -- If there's a match, we select that text do textCtrlSetInsertionPoint editor ip textCtrlSetSelection editor ip (length s + ip) findReplaceButton guiCtx@GUICtx{guiEditor = editor, guiWin = win, guiSearch = search} = do -- We check what the user is trying to find s <- findReplaceDataGetFindString search -- and what is he wanting to replace it with r <- findReplaceDataGetReplaceString search -- We parse it, assuming that the user wants to wrap its search fs <- findReplaceDataGetFlags search >>= buildFRFlags True -- We try to find a match in the text mip <- findMatch s fs editor case mip of Nothing -> -- If there's no match, we inform that to the user infoDialog win "Find Results" $ s ++ " not found." Just ip -> do -- If there's a match, we replace that text textCtrlReplace editor ip (length s + ip) r -- select the result textCtrlSetInsertionPoint editor ip textCtrlSetSelection editor ip (length r + ip) -- and finally update the history updatePast guiCtx findReplaceAllButton guiCtx@GUICtx{guiEditor = editor, guiSearch = search} = do -- We check what the user is trying to find s <- findReplaceDataGetFindString search -- and what is he wanting to replace it with r <- findReplaceDataGetReplaceString search -- We parse it, assuming that the user wants to wrap its search -- Note that we're NOT wrapping our search, to avoid infinite looping fs <- findReplaceDataGetFlags search >>= buildFRFlags False -- We start at the beginning of the text textCtrlSetInsertionPoint editor 0 -- And we go through the text replacing s by r until there's nothing -- more to replace replaceAllIn s r fs editor -- and finally update the history updatePast guiCtx where replaceAllIn s r fs editor = do mip <- findMatch s fs editor case mip of Nothing -> return () -- we're done here Just ip -> do textCtrlReplace editor ip (length s + ip) r textCtrlSetInsertionPoint editor $ length r + ip replaceAllIn s r fs editor -- we look for the next match -- | Tries to find a string in a text control findMatch :: String -- ^ The string to find -> FRFlags -- ^ The flags to know how to look for it -> TextCtrl () -- ^ The textControl -> IO (Maybe Int) -- ^ Nothing or Just the position of the first match findMatch query flags editor = do -- We get the current text txt <- get editor text -- and the insertion point (that's where the search begins) ip <- textCtrlGetInsertionPoint editor -- If we're not required to match the case we move everything to lower let (substring, string) = if frfMatchCase flags then (query, txt) else (map toLower query, map toLower txt) -- we choose what function to use depending on the direction funct = if frfGoingDown flags then nextMatch (ip + 1) else prevMatch ip (mip, wrapped) = funct substring string -- if it had to wrap around and that was 'forbbiden', then the match didn't happen -- otherwise, the result is valid return $ if (not $ frfWrapSearch flags) && wrapped then Nothing else mip -- These functions try to find a string contained in another prevMatch, nextMatch :: Int -- ^ Starting point -> String -- ^ What to find -> String -- ^ Where to find it -> (Maybe Int, Bool) -- ^ (Nothing or Just the point where it was found, It needed to wrap around?) prevMatch _ [] _ = (Nothing, True) -- When looking for nothing, that's what you get prevMatch from substring string | length string < from || from <= 0 = prevMatch (length string) substring string | otherwise = case nextMatch (fromBack from) (reverse substring) (reverse string) of (Nothing, wrapped) -> (Nothing, wrapped) (Just ri, wrapped) -> (Just $ fromBack (ri + length substring), wrapped) where fromBack x = length string - x nextMatch _ [] _ = (Nothing, True) -- When looking for nothing, that's what you get nextMatch from substring string | length substring > length string = (Nothing, True) | length string <= from = nextMatch 0 substring string | otherwise = let after = drop from string before = take (from + length substring) string aIndex = indexOf substring after bIndex = indexOf substring before in case aIndex of Just ai -> (Just $ from + ai, False) Nothing -> case bIndex of Nothing -> (Nothing, True) Just bi -> (Just bi, True) indexOf :: String -> String -> Maybe Int indexOf substring string = findIndex (isPrefixOf substring) $ tails string