diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,31 @@ +Copyright Fernando Brujo Benavides 2009 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Fernando Brujo Benavides nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/README b/README new file mode 100644 --- /dev/null +++ b/README @@ -0,0 +1,1 @@ +An example of how to implement a basic notepad with wxHaskell diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,72 @@ +{-# LANGUAGE CPP #-} + +import Control.Monad (foldM_, forM_) +import System.Cmd +import System.Exit +import System.Info (os) +import System.FilePath +import System.Directory ( doesFileExist, copyFile, removeFile, createDirectoryIfMissing ) + +import Distribution.PackageDescription +import Distribution.Simple.Setup +import Distribution.Simple +import Distribution.Simple.LocalBuildInfo + +main :: IO () +main = do + putStrLn $ "Setting up wxhnotepad for " ++ os + defaultMainWithHooks $ addMacHook simpleUserHooks + where + addMacHook h = + case os of + "darwin" -> h { postInst = appBundleHook } + _ -> h + +appBundleHook :: Args -> InstallFlags -> PackageDescription -> LocalBuildInfo -> IO () +appBundleHook _ _ pkg localb = + forM_ exes $ \app -> + do createAppBundle theBindir (buildDir localb app app) + removeFile (theBindir app) + createAppBundleWrapper theBindir app + return () + where + theBindir = bindir $ absoluteInstallDirs pkg localb NoCopyDest + exes = map exeName $ executables pkg + +-- ---------------------------------------------------------------------- +-- helper code for application bundles +-- ---------------------------------------------------------------------- + +-- | 'createAppBundle' @d p@ - creates an application bundle in @d@ +-- for program @p@, assuming that @d@ already exists and is a directory. +-- Note that only the filename part of @p@ is used. +createAppBundle :: FilePath -> FilePath -> IO () +createAppBundle dir p = + do createDirectoryIfMissing False $ bundle + createDirectoryIfMissing True $ bundleBin + createDirectoryIfMissing True $ bundleRsrc + copyFile p (bundleBin takeFileName p) + where + bundle = appBundlePath dir p + bundleBin = bundle "Contents/MacOS" + bundleRsrc = bundle "Contents/Resources" + +-- | 'createAppBundleWrapper' @d p@ - creates a script in @d@ that calls +-- @p@ from the application bundle @d takeFileName p <.> "app"@ +createAppBundleWrapper :: FilePath -> FilePath -> IO ExitCode +createAppBundleWrapper bindir p = + do writeFile scriptFile scriptTxt + makeExecutable scriptFile + where + scriptFile = bindir takeFileName p + scriptTxt = "`dirname $0`" appBundlePath "." p "Contents/MacOS" takeFileName p ++ " \"$@\"" + +appBundlePath :: FilePath -> FilePath -> FilePath +appBundlePath dir p = dir takeFileName p <.> "app" + +-- ---------------------------------------------------------------------- +-- utilities +-- ---------------------------------------------------------------------- + +makeExecutable :: FilePath -> IO ExitCode +makeExecutable f = system $ "chmod a+x " ++ f diff --git a/res/images/close.png b/res/images/close.png new file mode 100644 Binary files /dev/null and b/res/images/close.png differ diff --git a/res/images/copy.png b/res/images/copy.png new file mode 100644 Binary files /dev/null and b/res/images/copy.png differ diff --git a/res/images/cut.png b/res/images/cut.png new file mode 100644 Binary files /dev/null and b/res/images/cut.png differ diff --git a/res/images/find.png b/res/images/find.png new file mode 100644 Binary files /dev/null and b/res/images/find.png differ diff --git a/res/images/open.png b/res/images/open.png new file mode 100644 Binary files /dev/null and b/res/images/open.png differ diff --git a/res/images/paste.png b/res/images/paste.png new file mode 100644 Binary files /dev/null and b/res/images/paste.png differ diff --git a/res/images/save.png b/res/images/save.png new file mode 100644 Binary files /dev/null and b/res/images/save.png differ diff --git a/res/images/saveas.png b/res/images/saveas.png new file mode 100644 Binary files /dev/null and b/res/images/saveas.png differ diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,50 @@ +-- | This module provides the application main "window" which is no real window +-- at all. It just holds the menus so you can open each step of the tutorial +-- or close it all at the same time. +module Main where + +import Graphics.UI.WX +import Graphics.UI.WXCore + +import Step1 +import Step2 +import Step3 +import Step4 +import Step5 +import Step6 + +-- | The application entry point +main :: IO () +main = start gui + +gui :: IO () +gui = + do + -- We create a hidden window + win <- frame [text := "wxhNotepad", visible := False] + + -- If this window is closed, the application ends + set win [on closing := wxcAppExit] + + let say title desc = infoDialog win title desc + + -- The only thing that this window will have is its menu bar to open all + -- the other windows + mnuSteps <- menuPane [text := "Steps"] + menuItem mnuSteps [on command := step1, text := "Step &1 - Just a Text Field\tCtrl-1"] + menuItem mnuSteps [on command := step2, text := "Step &2 - Open / Save / Save As...\tCtrl-2"] + menuItem mnuSteps [on command := step3, text := "Step &3 - Undo / Redo...\tCtrl-3"] + menuItem mnuSteps [on command := step4, text := "Step &4 - Cut / Copy / Paste...\tCtrl-4"] + menuItem mnuSteps [on command := step5, text := "Step &5 - Find / Replace...\tCtrl-5"] + menuItem mnuSteps [on command := step6, text := "Step &6 - Toolbar / Statusbar / Context Menus\tCtrl-6"] + menuQuit mnuSteps [on command := wxcAppExit] + + -- the simplest about page... + mnuHelp <- menuHelp [] + menuAbout mnuHelp [on command := say "About wxHNotepad" "Author: Fernando Brujo Benavides\nWebsite: http://github.com/elbrujohalcon/wxhnotepad"] + + -- and... RUN, FORREST!! + set win [menuBar := [mnuSteps, mnuHelp], + visible := True, clientSize := sz 0 0] + --HACK: Linux and Windows do not support invisible windows with menuBars on them + -- Then, we need to "show" a really small window instead. diff --git a/src/Step1.hs b/src/Step1.hs new file mode 100644 --- /dev/null +++ b/src/Step1.hs @@ -0,0 +1,33 @@ +-- | This module provides the simplest version of our text editor: just a big +-- textbox :) +module Step1 (step1) where + +import Graphics.UI.WX +import Graphics.UI.WXCore + +step1 :: IO () +step1 = + do + -- First, we create a hidden window. We'll make it visible on the + -- last step + win <- frame [text := "wxhNotepad - Step 1", visible := False] + + -- We create the editor + editor <- textCtrl win [font := fontFixed, -- not really needed, but I like it :) + text := "This is our first step in the " ++ + "developing of our text editor.\n" ++ + "Just a big text area where " ++ + "the user can read and write text :)\n" ++ + "That's not much, but it's just the " ++ + "beginning..."] + + -- A simple layout: The whole window filled with the textbox + -- with a starting size of 640x480 + set win [layout := fill $ widget editor, + clientSize := sz 640 480] + + -- Finally we set the focus on the editor + focusOn editor + + -- HEY, HO... LET'S GO!! + set win [visible := True] diff --git a/src/Step2.hs b/src/Step2.hs new file mode 100644 --- /dev/null +++ b/src/Step2.hs @@ -0,0 +1,103 @@ +-- | Like Step1 but with Open / Save / Save As... support +module Step2 (step2) where + +import Graphics.UI.WX +import Graphics.UI.WXCore + +-- | We create a record for the context to simplify parameter passing in al event +-- handlers. It seems pretty useless now, but you'll see this purpose later +data GUIContext = GUICtx { guiWin :: Frame (), + guiEditor :: TextCtrl (), + guiFile :: Var (Maybe FilePath) -- ^ The path of the current file + } + +step2 :: IO () +step2 = + do + win <- frame [text := "wxhNotepad - Step 2", visible := False] + + editor <- textCtrl win [font := fontFixed, + text := "Now the user can open a file, save it" ++ + "or save it with another name.\n" ++ + "Our program is smart enough to remember" ++ + "the path of the last opened/saved file\n" ++ + "Note that we're *not* catching any " ++ + "filesystem errors here. That's left " ++ + "as a homework for you :P"] + + filePath <- varCreate Nothing + + -- We define the context to use it on every event handling function + let guiCtx = GUICtx win editor filePath + + -- We create a menu for the window with the three items we want to add + mnuFile <- menuPane [text := "File"] + -- Just for fun, we use WXCore methods instead of WX ones + 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 + -- We associate the corresponding action to each menuItem + -- the actions are defined below in this module + 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 () + -- And finally we add the bar to the window + set win [menuBar := [mnuFile]] + + set win [layout := fill $ widget editor, + clientSize := sz 640 480] + focusOn editor + set win [visible := True] + +savePageAs, savePage, openPage :: GUIContext -> IO () +openPage GUICtx{guiWin = win, guiEditor = editor, guiFile = filePath} = + do + -- WXCore provides a couple of useful dialog methods, like this one. + -- see: http://hackage.haskell.org/packages/archive/wxcore/latest/doc/html/Graphics-UI-WXCore-Dialogs.html#3 + maybePath <- fileOpenDialog win True True "Open file..." [("Haskells (*.hs)",["*.hs"]), + ("Texts (*.txt)", ["*.txt"]), + ("Any file (*.*)",["*.*"])] "" "" + case maybePath of + Nothing -> + -- The user cancelled... nothing to do + return () + Just path -> + do + -- We put the text on the box + textCtrlLoadFile editor path + -- Usually, you want to see the name of the file in the window title + set win [text := "wxhnotepad - " ++ path] + -- and set the path in our variable + varSet filePath $ Just path + +savePageAs GUICtx{guiWin = win, guiEditor = editor, guiFile = filePath} = + do + -- WXCore provides a couple of useful dialog methods, like this one. + -- see: http://hackage.haskell.org/packages/archive/wxcore/latest/doc/html/Graphics-UI-WXCore-Dialogs.html#v%3AfileSaveDialog + maybePath <- fileSaveDialog win True True "Save file..." [("Haskells (*.hs)",["*.hs"]), + ("Texts (*.txt)", ["*.txt"]), + ("Any file (*.*)",["*.*"])] "" "" + case maybePath of + Nothing -> + -- The user cancelled... nothing to do + return () + Just path -> + do + -- We send the text to the file... + textCtrlSaveFile editor path + -- Usually, you want to see the name of the file in the window title + set win [text := "wxhnotepad - " ++ path] + -- and set the path in our variable + 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 -> + -- We just send the text to the file... + textCtrlSaveFile editor path >> return () diff --git a/src/Step3.hs b/src/Step3.hs new file mode 100644 --- /dev/null +++ b/src/Step3.hs @@ -0,0 +1,211 @@ +-- | Like Step2 but with Undo / Redo... support +module Step3 (step3) where + +import Graphics.UI.WX +import Graphics.UI.WXCore + +data GUIContext = GUICtx { guiWin :: Frame (), + guiEditor :: TextCtrl (), + guiFile :: Var (Maybe FilePath), + guiTimer :: Var (TimerEx ()), -- ^ A timer to detect user actions + guiPast :: Var [String], -- ^ For Undo history + guiFuture :: Var [String] -- ^ For Redo history + } + +wxID_MYUNDO, wxID_MYREDO :: Id --HACK: because we're using them in a different way +wxID_MYUNDO = 5107 +wxID_MYREDO = 5108 + +step3 :: IO () +step3 = + do + win <- frame [text := "wxhNotepad - Step 3", visible := False] + editor <- textCtrl win [font := fontFixed, + text := "Undo / Redo support is ready by default " ++ + "on text controls, but we want to have " ++ + "a menu item for it too.\n" ++ + "Another important thing to notice is " ++ + "that you don't want to let the user 'undo' " ++ + "anything when he opens a new file. That's " ++ + "why we'll not use the default textCtrl " ++ + "functions and we'll develop our own ones.\n" ++ + "That means a lot of code for a seemingly " ++ + "small functionallity, but it will let " ++ + "you learn about timers and history too :)\n" ++ + "What we do here fails to exactly emulate " ++ + "what we're used to see in text editors " ++ + "as undo/redo behaviour because it's " ++ + "not considering insertion-point changes. " ++ + "As you might be guessing now, that's not " ++ + "difficult to implement, so it's left as " ++ + "a homework :)"] + filePath <- varCreate Nothing + + -- We create a timer to detect user actions. This way we'll not undo/redo + -- every character + refreshTimer <- timer win [interval := 1000000, -- 1000 secs. means a *lot* of time + on command := return ()] -- just start over + varTimer <- varCreate refreshTimer + + -- We define the context to use it on every event handling function + past <- varCreate [] + future <- varCreate [] + let guiCtx = GUICtx win editor filePath varTimer past future + + -- We associate the events on the editor with commands that populate undo/redo history + set editor [on keyboard := \_ -> restartTimer guiCtx >> propagateEvent] + -- and we start populating the history because there's text on the editor... + updatePast guiCtx + + -- We create a menu for the window with the same items from step 2 + -- and a new one for the edition controls + 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 + 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 + 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 :: 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 + -- We clear the undo history + clearPast guiCtx + textCtrlLoadFile editor path + -- Now we set the first action in undo history with the current text + 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 + -- Now we try to detect if there's something new and kill the timer + updatePast guiCtx + history <- varGet past + case history of + [] -> + return () -- Nothing to be undone + [t] -> + return () -- Just the initial state, nothing to be undone + tnow:tlast:ts -> + do + -- We add an action to be done on redo + varUpdate future (tnow:) + -- we remove it from the history + varSet past $ tlast:ts + -- and set the editor accordingly + set editor [text := tlast] + +redo guiCtx@GUICtx{guiEditor = editor, guiPast = past, guiFuture = future} = + do + -- First of all, we try to detect if there's something new + updatePast guiCtx + coming <- varGet future + case coming of + [] -> + return () -- Nothing to be redone + t:ts -> + do + -- remove it from the coming actions + varSet future ts + -- move it to the history actions + varUpdate past (t:) + -- and set the editor accordingly + set editor [text := t] + +updatePast guiCtx@GUICtx{guiEditor = editor, guiPast = past, guiFuture = future} = + do + -- We take the current history and add a new first event + tnow <- get editor text + history <- varGet past + case history of + [] -> + varSet past [tnow] + t:_ -> + if t /= tnow -- if there was a real change, we recorded it + then do + varUpdate past (tnow:) + varSet future [] -- we clean the future because the user is writing a new one + else -- otherwise we ignore it + return () + -- Now that history is up to date, we let the timer rest until new activity + -- is detected + killTimer guiCtx + +clearPast GUICtx{guiPast = past, guiFuture = future} = + do + -- We start all over again... + varSet past [] + varSet future [] + +restartTimer guiCtx@GUICtx{guiWin = win, guiTimer = varTimer} = + do + -- The user did something, we start a 1sec timer that will modify history + -- if the user doesn't do anything in that sec. If the user does another + -- thing, then the timer will be restarted again and so on so far until + -- the first sec of inactivity + -- Note by FernandoBenavides: + -- I really don't know if this can't be done with just one timer + -- I didn't find something like "timerRestart ..." + newRefreshTimer <- timer win [interval := 1000, + on command := updatePast guiCtx] + refreshTimer <- varSwap varTimer newRefreshTimer + timerOnCommand refreshTimer $ return () + +killTimer GUICtx{guiWin = win, guiTimer = varTimer} = + do + -- We kill the timer till there's new notices + -- Note by FernandoBenavides: + -- I really don't know if this can't be done with just one timer + -- I didn't find something like "timerRestart ..." + newRefreshTimer <- timer win [interval := 1000000, + on command := return ()] + refreshTimer <- varSwap varTimer newRefreshTimer + timerOnCommand refreshTimer $ return () diff --git a/src/Step4.hs b/src/Step4.hs new file mode 100644 --- /dev/null +++ b/src/Step4.hs @@ -0,0 +1,187 @@ +-- | Like Step3 but with Cut / Copy / Paste support +module Step4 (step4) where + +import Graphics.UI.WX +import Graphics.UI.WXCore hiding (wxID_CUT, wxID_COPY, wxID_PASTE) + +data GUIContext = GUICtx { guiWin :: Frame (), + guiEditor :: TextCtrl (), + guiFile :: Var (Maybe FilePath), + guiTimer :: Var (TimerEx ()), + guiPast :: Var [String], + guiFuture :: Var [String] + } + +wxID_MYUNDO, wxID_MYREDO, wxID_CUT, wxID_COPY, wxID_PASTE :: Id +wxID_MYUNDO = 5107 +wxID_MYREDO = 5108 +wxID_CUT = 5031 --HACK: They're not correctly numbered in WxcDefs +wxID_COPY = 5032 +wxID_PASTE = 5033 + +step4 :: IO () +step4 = + do + win <- frame [text := "wxhNotepad - Step 4", visible := False] + editor <- textCtrl win [font := fontFixed, + text := "Again, Cut/Copy/Past support comes with " ++ + "text controls, but we want to have " ++ + "a menu item for it too.\n" ++ + "Besides, we need to adapt our Undo/Redo " ++ + "implementation to these functions.\n"] + filePath <- varCreate Nothing + refreshTimer <- timer win [interval := 1000000, + on command := return ()] + varTimer <- varCreate refreshTimer + past <- varCreate [] + future <- varCreate [] + let guiCtx = GUICtx win editor filePath varTimer past future + + set editor [on keyboard := \_ -> restartTimer guiCtx >> propagateEvent] + updatePast guiCtx + + -- We create a menu for the window with the same items from steps 2 & 3 + -- and a 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 + + 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 + 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 :: 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 = varTimer} = + do + newRefreshTimer <- timer win [interval := 1000, + on command := updatePast guiCtx] + refreshTimer <- varSwap varTimer newRefreshTimer + timerOnCommand refreshTimer $ return () + +killTimer GUICtx{guiWin = win, guiTimer = varTimer} = + do + newRefreshTimer <- timer win [interval := 1000000, + on command := return ()] + refreshTimer <- varSwap varTimer newRefreshTimer + timerOnCommand refreshTimer $ return () + +-- We just copy the selected text +copy GUICtx{guiEditor = editor} = textCtrlCopy editor + +-- We cut the selected text and, as the editor is modified, we update the history +cut guiCtx@GUICtx{guiEditor = editor} = textCtrlCut editor >> updatePast guiCtx + +-- We paste the clipboard contents on the editor and, as it's modified, we update the history +paste guiCtx@GUICtx{guiEditor = editor} = textCtrlPaste editor >> updatePast guiCtx diff --git a/src/Step5.hs b/src/Step5.hs new file mode 100644 --- /dev/null +++ b/src/Step5.hs @@ -0,0 +1,410 @@ +-- | 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 :: Var (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 [interval := 1000000, + on command := return ()] + varTimer <- varCreate refreshTimer + 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 varTimer past future search + + set editor [on keyboard := \_ -> restartTimer guiCtx >> propagateEvent] + 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 = varTimer} = + do + newRefreshTimer <- timer win [interval := 1000, + on command := updatePast guiCtx] + refreshTimer <- varSwap varTimer newRefreshTimer + timerOnCommand refreshTimer $ return () + +killTimer GUICtx{guiWin = win, guiTimer = varTimer} = + do + newRefreshTimer <- timer win [interval := 1000000, + on command := return ()] + refreshTimer <- varSwap varTimer newRefreshTimer + timerOnCommand refreshTimer $ return () + +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 diff --git a/src/Step6.hs b/src/Step6.hs new file mode 100644 --- /dev/null +++ b/src/Step6.hs @@ -0,0 +1,456 @@ +-- | Like Step5 but with Toolbar, Statusbar and Context Menus +module Step6 (step6) 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 +import Paths_wxhnotepad -- That's the cabal way of finding the image paths + +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 :: Var (TimerEx ()), + guiPast :: Var [String], + guiFuture :: Var [String], + guiSearch :: FindReplaceData (), + guiStatus :: StatusField -- ^ We'll use just one status field for now + } + +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 +wxID_REPLACE = 5038 +wxID_FORWARD = 5106 +wxID_BACKWARD = 5107 + +step6 :: IO () +step6 = + do + win <- frame [text := "wxhNotepad - Step 6", visible := False] + editor <- textCtrl win [font := fontFixed, + text := "Now we have a fully functional text " ++ + "editor, so let's decorate it a bit." ++ + "In this step we add toolbar, statusbar " ++ + "and context menues to our application.\n" ++ + "For the toolbar, we choose a particular " ++ + "set of images from SphericalIcons Set by " ++ + "Ahmad Hania (http://www.iconfinder.net/search/?q=iconset:sphericalcons) " ++ + "and we put those in the cabal package " ++ + "description. We mention that because " ++ + "it's one thing to do besides this module.\n" ++ + "In this tutorial we'll use the statusbar " ++ + "just to show a couple of dummy messages, " ++ + "your homework is to add smart things to " ++ + "it, like a Line/Coulmn position marker."] + filePath <- varCreate Nothing + refreshTimer <- timer win [interval := 1000000, + on command := return ()] + varTimer <- varCreate refreshTimer + past <- varCreate [] + future <- varCreate [] + search <- findReplaceDataCreate wxFR_DOWN + + -- We create a status field where we'll put just text messages + status <- statusField [text := "hello, this is wxhNotepad... happy editing :)"] + -- The window statusbar is a list of status fields, we use just one + set win [statusBar := [status]] + + let guiCtx = GUICtx win editor filePath varTimer past future search status + + set editor [on keyboard := \_ -> restartTimer guiCtx >> propagateEvent, + -- We associate the right click on the editor to a context menu launcher + on mouse := \e -> case e of + MouseRightDown _ _ -> contextMenu guiCtx + _ -> propagateEvent] + + updatePast guiCtx + + 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]] + + -- Once all menues are created, we create the window toolbar + tbMain <- toolBarEx win True True [] + -- As we've created them using WXCore technics we have to find the items + -- we want on the toolbar to have them in variables + mitOpen <- menuFindItem mnuFile wxID_OPEN + mitSave <- menuFindItem mnuFile wxID_SAVE + mitSaveAs <- menuFindItem mnuFile wxID_SAVEAS + mitClose <- menuFindItem mnuFile wxID_CLOSE + mitCut <- menuFindItem mnuEdit wxID_CUT + mitCopy <- menuFindItem mnuEdit wxID_COPY + mitPaste <- menuFindItem mnuEdit wxID_PASTE + mitFind <- menuFindItem mnuEdit wxID_FIND + -- We get the paths of the images too + openPath <- imageFile "open.png" + savePath <- imageFile "save.png" + saveAsPath <- imageFile "saveas.png" + closePath <- imageFile "close.png" + cutPath <- imageFile "cut.png" + copyPath <- imageFile "copy.png" + pastePath <- imageFile "paste.png" + findPath <- imageFile "find.png" + -- And finally we build our toolbar + toolMenu tbMain mitOpen "Open" openPath [tooltip := "Open Document"] + toolMenu tbMain mitSave "Save" savePath [tooltip := "Save Document"] + toolMenu tbMain mitSaveAs "Save As..." saveAsPath [tooltip := "Save Document As..."] + toolMenu tbMain mitClose "Close" closePath [tooltip := "Close Document"] + toolBarAddSeparator tbMain + toolMenu tbMain mitCut "Cut" cutPath [tooltip := "Cut"] + toolMenu tbMain mitCopy "Copy" copyPath [tooltip := "Copy"] + toolMenu tbMain mitPaste "Paste" pastePath [tooltip := "Paste"] + toolBarAddSeparator tbMain + toolMenu tbMain mitFind "Find..." findPath [tooltip := "Open Find Dialog"] + toolBarSetToolBitmapSize tbMain $ sz 32 32 + + 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, + contextMenu :: GUIContext -> IO () +openPage guiCtx@GUICtx{guiWin = win, + guiEditor = editor, + guiFile = filePath, + guiStatus = status} = + 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 + fileLoaded <- textCtrlLoadFile editor path + case fileLoaded of + True -> + set status [text := path ++ " loaded succesfully"] + False -> + set status [text := "Couldn't load " ++ path] + updatePast guiCtx + set win [text := "wxhnotepad - " ++ path] + varSet filePath $ Just path + +savePageAs GUICtx{guiWin = win, + guiEditor = editor, + guiFile = filePath, + guiStatus = status} = + do + maybePath <- fileSaveDialog win True True "Save file..." [("Haskells (*.hs)",["*.hs"]), + ("Texts (*.txt)", ["*.txt"]), + ("Any file (*.*)",["*.*"])] "" "" + case maybePath of + Nothing -> + return () + Just path -> + do + fileSaved <- textCtrlSaveFile editor path + case fileSaved of + True -> + set status [text := path ++ " saved succesfully"] + False -> + set status [text := "Couldn't save " ++ path] + set win [text := "wxhnotepad - " ++ path] + varSet filePath $ Just path + +savePage guiCtx@GUICtx{guiWin = win, + guiEditor= editor, + guiFile = filePath, + guiStatus= status} = + do + maybePath <- varGet filePath + case maybePath of + Nothing -> + savePageAs guiCtx + Just path -> + do + fileSaved <- textCtrlSaveFile editor path + case fileSaved of + True -> + set status [text := path ++ " saved succesfully"] + False -> + set status [text := "Couldn't save " ++ path] + +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 = varTimer, guiStatus = status} = + do + newRefreshTimer <- timer win [interval := 1000, + on command := updatePast guiCtx] + refreshTimer <- varSwap varTimer newRefreshTimer + timerOnCommand refreshTimer $ return () + set status [text := ""] + +killTimer GUICtx{guiWin = win, guiTimer = varTimer} = + do + newRefreshTimer <- timer win [interval := 1000000, + on command := return ()] + refreshTimer <- varSwap varTimer newRefreshTimer + timerOnCommand refreshTimer $ return () + +copy GUICtx{guiEditor = editor} = textCtrlCopy editor + +cut guiCtx@GUICtx{guiEditor = editor} = textCtrlCut editor >> updatePast guiCtx + +paste guiCtx@GUICtx{guiEditor = editor} = textCtrlPaste editor >> updatePast guiCtx + +justFind guiCtx = openFindDialog guiCtx "Find..." dialogDefaultStyle + +justFindNext guiCtx@GUICtx{guiSearch = search} = + do + curFlags <- findReplaceDataGetFlags search + findReplaceDataSetFlags search $ curFlags .|. wxFR_DOWN + findNextButton guiCtx + +justFindPrev guiCtx@GUICtx{guiSearch = search} = + do + curFlags <- findReplaceDataGetFlags search + findReplaceDataSetFlags search $ curFlags .&. complement wxFR_DOWN + findNextButton guiCtx + +findReplace guiCtx = openFindDialog guiCtx "Find and Replace..." $ dialogDefaultStyle .|. wxFR_REPLACEDIALOG + +buildFRFlags :: Bool -> Int -> IO FRFlags +buildFRFlags w x = return FRFlags {frfGoingDown = (x .&. wxFR_DOWN) /= 0, + frfMatchCase = (x .&. wxFR_MATCHCASE) /= 0, + frfWholeWord = (x .&. wxFR_WHOLEWORD) /= 0, + frfWrapSearch = w} + +openFindDialog :: GUIContext -> String -> Int -> IO () +openFindDialog guiCtx@GUICtx{guiWin = win, + guiSearch = search} title dlgStyle = + do + frdialog <- findReplaceDialogCreate win search title $ dlgStyle + wxFR_NOWHOLEWORD + let winSet k f = let hnd _ = f guiCtx >> propagateEvent + in windowOnEvent frdialog [k] hnd hnd + winSet wxEVT_COMMAND_FIND findNextButton + winSet wxEVT_COMMAND_FIND_NEXT findNextButton + winSet wxEVT_COMMAND_FIND_REPLACE findReplaceButton + winSet wxEVT_COMMAND_FIND_REPLACE_ALL findReplaceAllButton + set frdialog [visible := True] + +findNextButton, findReplaceButton, findReplaceAllButton :: GUIContext -> IO () +findNextButton guiCtx@GUICtx{guiEditor= editor, + guiWin = win, + guiSearch= search} = + do + s <- findReplaceDataGetFindString search + fs <- findReplaceDataGetFlags search >>= buildFRFlags True + mip <- findMatch s fs editor + case mip of + Nothing -> + infoDialog win "Find Results" $ s ++ " not found." + Just ip -> + do + textCtrlSetInsertionPoint editor ip + textCtrlSetSelection editor ip (length s + ip) + + +findReplaceButton guiCtx@GUICtx{guiEditor = editor, + guiWin = win, + guiSearch = search} = + do + s <- findReplaceDataGetFindString search + r <- findReplaceDataGetReplaceString search + fs <- findReplaceDataGetFlags search >>= buildFRFlags True + mip <- findMatch s fs editor + case mip of + Nothing -> + infoDialog win "Find Results" $ s ++ " not found." + Just ip -> + do + textCtrlReplace editor ip (length s + ip) r + textCtrlSetInsertionPoint editor ip + textCtrlSetSelection editor ip (length r + ip) + updatePast guiCtx + +findReplaceAllButton guiCtx@GUICtx{guiEditor = editor, + guiSearch = search} = + do + s <- findReplaceDataGetFindString search + r <- findReplaceDataGetReplaceString search + fs <- findReplaceDataGetFlags search >>= buildFRFlags False + textCtrlSetInsertionPoint editor 0 + replaceAllIn s r fs editor + updatePast guiCtx + where replaceAllIn s r fs editor = + do + mip <- findMatch s fs editor + case mip of + Nothing -> + return () + Just ip -> + do + textCtrlReplace editor ip (length s + ip) r + textCtrlSetInsertionPoint editor $ length r + ip + replaceAllIn s r fs editor + +findMatch :: String -> FRFlags -> TextCtrl () -> IO (Maybe Int) +findMatch query flags editor = + do + txt <- get editor text + ip <- textCtrlGetInsertionPoint editor + let (substring, string) = if frfMatchCase flags + then (query, txt) + else (map toLower query, map toLower txt) + funct = if frfGoingDown flags + then nextMatch (ip + 1) + else prevMatch ip + (mip, wrapped) = funct substring string + return $ if (not $ frfWrapSearch flags) && wrapped + then Nothing + else mip + +prevMatch, nextMatch :: Int -> String -> String -> (Maybe Int, Bool) +prevMatch _ [] _ = (Nothing, True) +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) +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 + +contextMenu guiCtx@GUICtx{guiWin = win, guiEditor = editor} = + do + -- We create the context menu, which is just a menuPane + contextMenu <- menuPane [] + -- We'll present cut/copy items only if there's some text selected + sel <- textCtrlGetStringSelection editor + case sel of + "" -> -- If nothing is selected we let the event propagate + return () + _ -> + do + menuAppend contextMenu wxID_CUT "C&ut\tCtrl-x" "Cut" False + menuAppend contextMenu wxID_COPY "&Copy\tCtrl-c" "Copy" False + -- We always add the paste item + menuAppend contextMenu wxID_PASTE "&Paste\tCtrl-v" "Paste" False + -- We propagate the event so the menu presentation is the last thing to happen + propagateEvent + -- We detect the position in the screen where the mouse is pointing + pointWithinWindow <- windowGetMousePosition win + -- And we make the menu pop up + menuPopup contextMenu pointWithinWindow win + -- Finally, we delete the menu + objectDelete contextMenu + +-- | This function takes a name and, with a little knowlegde and the help of +-- cabal, returns the path of that image +imageFile :: String -> IO FilePath +imageFile img = getDataFileName $ "res/images/" ++ img diff --git a/wxhnotepad.cabal b/wxhnotepad.cabal new file mode 100644 --- /dev/null +++ b/wxhnotepad.cabal @@ -0,0 +1,38 @@ +name: wxhnotepad +version: 1.0.0 +cabal-version: >=1.6 +build-type: Custom +license: BSD3 +license-file: LICENSE +copyright: 2010 Fernando "Brujo" Benavides +maintainer: greenmellon@gmail.com +stability: educational +homepage: http://github.com/elbrujohalcon/wxhnotepad +package-url: http://code.haskell.org/wxhnotepad +bug-reports: http://github.com/elbrujohalcon/wxhnotepad/issues +synopsis: An example of how to implement a basic notepad with wxHaskell +description: A program to learn how to implement basic text editing functionality with wxHaskell. + It's not useful itself, the point is to read the code and learn from it ;) + The program is divided in 6 steps, each one corresponding to a window and a haskell module. Each step includes what was learnt in the previous one, so Step6 is an almost complete basic text editor. +category: Development, Education, IDE, Editor +author: Fernando "Brujo" Benavides +tested-with: GHC ==6.10.3, GHC ==6.10.4 +data-files: LICENSE README + res/images/*.png +data-dir: "" +extra-source-files: Setup.hs +extra-tmp-files: + +source-repository head + type: git + location: git://github.com/elbrujohalcon/wxhnotepad.git + +Executable wxhnotepad + build-depends: base >= 4, base < 5, + wxcore >=0.11.1, wxcore < 0.13, + wx >=0.11.1, wx < 0.13 + main-is: Main.hs + buildable: True + hs-source-dirs: src + other-modules: Step1, Step2, Step3, Step4, Step5, Step6 + ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns