wxhnotepad (empty) → 1.0.0
raw patch · 19 files changed
+1592/−0 lines, 19 filesdep +basedep +wxdep +wxcorebuild-type:Customsetup-changedbinary-added
Dependencies added: base, wx, wxcore
Files
- LICENSE +31/−0
- README +1/−0
- Setup.hs +72/−0
- res/images/close.png binary
- res/images/copy.png binary
- res/images/cut.png binary
- res/images/find.png binary
- res/images/open.png binary
- res/images/paste.png binary
- res/images/save.png binary
- res/images/saveas.png binary
- src/Main.hs +50/−0
- src/Step1.hs +33/−0
- src/Step2.hs +103/−0
- src/Step3.hs +211/−0
- src/Step4.hs +187/−0
- src/Step5.hs +410/−0
- src/Step6.hs +456/−0
- wxhnotepad.cabal +38/−0
+ LICENSE view
@@ -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.+
+ README view
@@ -0,0 +1,1 @@+An example of how to implement a basic notepad with wxHaskell
+ Setup.hs view
@@ -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
+ res/images/close.png view
binary file changed (absent → 18261 bytes)
+ res/images/copy.png view
binary file changed (absent → 15541 bytes)
+ res/images/cut.png view
binary file changed (absent → 19396 bytes)
+ res/images/find.png view
binary file changed (absent → 18547 bytes)
+ res/images/open.png view
binary file changed (absent → 15564 bytes)
+ res/images/paste.png view
binary file changed (absent → 16679 bytes)
+ res/images/save.png view
binary file changed (absent → 17393 bytes)
+ res/images/saveas.png view
binary file changed (absent → 19537 bytes)
+ src/Main.hs view
@@ -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.
+ src/Step1.hs view
@@ -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]
+ src/Step2.hs view
@@ -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 ()
+ src/Step3.hs view
@@ -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 ()
+ src/Step4.hs view
@@ -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
+ src/Step5.hs view
@@ -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
+ src/Step6.hs view
@@ -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
+ wxhnotepad.cabal view
@@ -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