hpage 0.3.2 → 0.3.3
raw patch · 19 files changed
+172/−136 lines, 19 filesbinary-added
Files
- hpage.cabal +4/−6
- res/images/about.png binary
- res/images/copy.png binary
- res/images/cut.png binary
- res/images/icon/hpage.gif binary
- res/images/icon/hpage.jpg binary
- res/images/icon/hpage.png binary
- res/images/icon/hpage.tif binary
- res/images/load.png binary
- res/images/new.png binary
- res/images/open.png binary
- res/images/paste.png binary
- res/images/reload.png binary
- res/images/run.png binary
- res/images/save.png binary
- src/HPage/Control.hs +45/−59
- src/HPage/GUI/Dialogs.hs +3/−15
- src/HPage/GUI/FreeTextWindow.hs +116/−54
- src/HPage/GUI/IDs.hs +4/−2
hpage.cabal view
@@ -1,5 +1,5 @@ name: hpage-version: 0.3.2+version: 0.3.3 cabal-version: >=1.6 build-type: Custom license: BSD3@@ -7,7 +7,7 @@ copyright: 2009 Fernando "Brujo" Benavides maintainer: greenmellon@gmail.com stability: provisional-homepage: http://elbrujohalcon.github.com/hPage/+homepage: http://haskell.hpage.com package-url: http://code.haskell.org/hpage bug-reports: http://github.com/elbrujohalcon/hPage/issues synopsis: A scrapbook for Haskell developers@@ -17,10 +17,7 @@ tested-with: GHC ==6.10.3, GHC ==6.10.4 data-files: LICENSE README res/images/*.png- res/images/icon/hpage.gif res/images/icon/hPage.icns- res/images/icon/hpage.jpg- res/images/icon/hpage.png res/images/icon/hpage.tif res/help/helpPage.hs data-dir: ""@@ -60,7 +57,8 @@ extensions: CPP install-includes: hs-source-dirs: src- other-modules: HPage.GUI.IDs,+ other-modules: + HPage.GUI.IDs, HPage.GUI.FreeTextWindow, HPage.GUI.Dialogs, HPage.Control,
res/images/about.png view
binary file changed (4898 → 1901 bytes)
res/images/copy.png view
binary file changed (4317 → 723 bytes)
res/images/cut.png view
binary file changed (3376 → 1476 bytes)
− res/images/icon/hpage.gif
binary file changed (28283 → absent bytes)
− res/images/icon/hpage.jpg
binary file changed (67410 → absent bytes)
− res/images/icon/hpage.png
binary file changed (455333 → absent bytes)
res/images/icon/hpage.tif view
binary file changed (1052782 → 191802 bytes)
+ res/images/load.png view
binary file changed (absent → 1263 bytes)
res/images/new.png view
binary file changed (3710 → 1008 bytes)
res/images/open.png view
binary file changed (4900 → 1550 bytes)
res/images/paste.png view
binary file changed (4253 → 1027 bytes)
res/images/reload.png view
binary file changed (4449 → 2024 bytes)
res/images/run.png view
binary file changed (4141 → 1028 bytes)
res/images/save.png view
binary file changed (4005 → 1971 bytes)
src/HPage/Control.hs view
@@ -30,19 +30,21 @@ undo, redo, -- HINT CONTROLS -- valueOf, valueOfNth, kindOf, kindOfNth, typeOf, typeOfNth,- loadModules, reloadModules, getLoadedModules, importModules, getImportedModules,+ loadModules,+ reloadModules, getLoadedModules,+ importModules, getImportedModules,+ getPackageModules, getModuleExports, getLanguageExtensions, setLanguageExtensions, getSourceDirs, setSourceDirs, getGhcOpts, setGhcOpts,- loadPrefsFromCabal,+ loadPackage, valueOf', valueOfNth', kindOf', kindOfNth', typeOf', typeOfNth', loadModules', reloadModules', getLoadedModules', importModules', getImportedModules', getModuleExports', getLanguageExtensions', setLanguageExtensions', getSourceDirs', setSourceDirs', getGhcOpts', setGhcOpts',- loadPrefsFromCabal', reset, reset', cancel, Hint.InterpreterError, prettyPrintError,@@ -76,6 +78,7 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Package import Distribution.PackageDescription+import Distribution.ModuleName import Distribution.Compiler data ModuleElemDesc = MEFun {funName :: String,@@ -114,9 +117,6 @@ SetGhcOpts { settingGhcOpts :: String, runningAction :: Hint.InterpreterT IO () } |- LoadingCabal { settingSrcDirs :: [FilePath],- settingGhcOpts :: String,- runningAction :: Hint.InterpreterT IO () } | Reset data Page = Page { -- Display --@@ -134,7 +134,10 @@ "\nFile: " ++ show (filePath p) where showExpressions pg = showWithCurrent (expressions pg) (currentExpr pg) "\n\n" $ ("["++) . (++"]") -data Context = Context { -- Pages --+data Context = Context { -- Package --+ activePackage :: Maybe PackageIdentifier,+ pkgModules :: [Hint.ModuleName],+ -- Pages -- pages :: [Page], currentPage :: Int, -- Hint --@@ -175,7 +178,7 @@ evalHPage hpt = do hs <- liftIO $ HS.start let nop = return ()- let emptyContext = Context [emptyPage] 0 empty (fromList ["Prelude"]) [] "" hs Nothing nop+ let emptyContext = Context Nothing [] [emptyPage] 0 empty (fromList ["Prelude"]) [] "" hs Nothing nop (state hpt) `evalStateT` emptyContext @@ -457,6 +460,9 @@ getImportedModules :: HPage [Hint.ModuleName] getImportedModules = confirmRunning >>= return . toList . importedModules +getPackageModules :: HPage [Hint.ModuleName]+getPackageModules = confirmRunning >>= return . pkgModules+ getModuleExports :: Hint.ModuleName -> HPage (Either Hint.InterpreterError [ModuleElemDesc]) getModuleExports mn = do confirmRunning@@ -507,33 +513,37 @@ liftErrorIO $ ("Error setting ghc opts dirs", opts, e) return res -loadPrefsFromCabal :: FilePath -> HPage (Either Hint.InterpreterError PackageIdentifier)-loadPrefsFromCabal file = do- let dir = dropFileName file- lbinfo <- liftIO $ getPersistBuildConfig dir- let pkgdesc = localPkgDescr lbinfo- pkgname = package pkgdesc- bldinfos= allBuildInfo pkgdesc- dirs = uniq $ concatMap hsSourceDirs bldinfos- exts = uniq . map (read . show) $ concatMap extensions bldinfos- opts = uniq $ concatMap (hcOptions GHC) bldinfos- action = do- liftTraceIO $ "loading package: " ++ show pkgname- Hint.unsafeSetGhcOption "-i"- Hint.unsafeSetGhcOption "-i."- forM_ dirs $ Hint.unsafeSetGhcOption . ("-i" ++)- Hint.set [Hint.languageExtensions := exts]- forM_ opts $ \opt -> Hint.unsafeSetGhcOption opt `catchError` (\_ -> return ())- return pkgname- res <- syncRun action- case res of- Right _ ->- modify (\ctx -> ctx{extraSrcDirs = dirs,- ghcOptions = (ghcOptions ctx) ++ " " ++ (joinWith " " opts),- recoveryLog = recoveryLog ctx >> action >> return ()})- Left e ->- liftErrorIO $ ("Error loading package", pkgname, e)- return res+loadPackage :: FilePath -> HPage (Either Hint.InterpreterError PackageIdentifier)+loadPackage file = do+ let dir = dropFileName file+ lbinfo <- liftIO $ getPersistBuildConfig dir+ let pkgdesc = localPkgDescr lbinfo+ pkgname = package pkgdesc+ bldinfos= allBuildInfo pkgdesc+ dirs = uniq $ concatMap hsSourceDirs bldinfos+ exts = uniq . map (read . show) $ concatMap extensions bldinfos+ opts = uniq $ concatMap (hcOptions GHC) bldinfos+ mods = uniq . map (joinWith "." . components) $ exeModules pkgdesc ++ (libModules pkgdesc)+ action = do+ liftTraceIO $ "loading package: " ++ show pkgname+ Hint.unsafeSetGhcOption "-i"+ Hint.unsafeSetGhcOption "-i."+ forM_ dirs $ Hint.unsafeSetGhcOption . ("-i" ++)+ Hint.set [Hint.languageExtensions := exts]+ forM_ opts $ \opt -> Hint.unsafeSetGhcOption opt `catchError` (\_ -> return ())+ return pkgname+ liftDebugIO mods+ res <- syncRun action+ case res of+ Right _ ->+ modify (\ctx -> ctx{activePackage = Just pkgname,+ pkgModules = mods,+ extraSrcDirs = dirs,+ ghcOptions = (ghcOptions ctx) ++ " " ++ (joinWith " " opts),+ recoveryLog = recoveryLog ctx >> action >> return ()})+ Left e ->+ liftErrorIO $ ("Error loading package", pkgname, e)+ return res reset :: HPage (Either Hint.InterpreterError ()) reset = do@@ -635,28 +645,6 @@ res <- asyncRun action modify $ \ctx -> ctx{running = Just $ SetGhcOpts opts action} return res--loadPrefsFromCabal' :: FilePath -> HPage (MVar (Either Hint.InterpreterError PackageIdentifier))-loadPrefsFromCabal' file = do- let dir = dropFileName file- lbinfo <- liftIO $ getPersistBuildConfig dir- let pkgdesc = localPkgDescr lbinfo- pkgname = package pkgdesc- bldinfos= allBuildInfo pkgdesc- dirs = uniq $ concatMap hsSourceDirs bldinfos- exts = uniq . map (read . show) $ concatMap extensions bldinfos- opts = joinWith " " . uniq $ concatMap (hcOptions GHC) bldinfos- action = do- liftTraceIO $ "loading package: " ++ show pkgname- Hint.unsafeSetGhcOption "-i"- Hint.unsafeSetGhcOption "-i."- forM_ dirs $ Hint.unsafeSetGhcOption . ("-i" ++)- Hint.set [Hint.languageExtensions := exts]- Hint.unsafeSetGhcOption opts- return pkgname- res <- asyncRun action- modify $ \ctx -> ctx{running = Just $ LoadingCabal dirs opts $ action >> return ()}- return res reset' :: HPage (MVar (Either Hint.InterpreterError ())) reset' = do@@ -789,8 +777,6 @@ c{extraSrcDirs = ssds, recoveryLog = (recoveryLog c) >> ra} apply (Just SetGhcOpts{settingGhcOpts = opts, runningAction = ra}) c = c{ghcOptions = (ghcOptions c) ++ " " ++ opts, recoveryLog = (recoveryLog c) >> ra}-apply (Just LoadingCabal{settingSrcDirs = ssds, settingGhcOpts = opts, runningAction = ra}) c =- c{extraSrcDirs = ssds, ghcOptions = (ghcOptions c) ++ " " ++ opts, recoveryLog = (recoveryLog c) >> ra} fromString :: String -> [Expression] fromString s = map Exp $ splitOn "\n\n" s
src/HPage/GUI/Dialogs.hs view
@@ -15,16 +15,13 @@ ghcOptions :: String} deriving (Eq, Show) -data Result = SetPrefs Preferences | LoadPrefs FilePath--preferencesDialog :: Window a -> String -> Preferences -> IO (Maybe Result)+preferencesDialog :: Window a -> String -> Preferences -> IO (Maybe Preferences) preferencesDialog win caption currentPrefs = do let availExts = sort HP.availableExtensions dlg <- dialog win [text := caption] btnok <- button dlg [text := "Ok", identity := wxId_OK] buttonSetDefault btnok- btnimport <- button dlg [text := "Import", identity := wxId_OPEN, tooltip := "Import settings from a setup-config file"] btnnok <- button dlg [text := "Cancel", identity := wxId_CANCEL] lstExts <- multiListBox dlg [items := map show availExts]@@ -46,13 +43,12 @@ column 5 [widget btnadd, expand $ widget btndel]] gosL = fill $ boxed "Ghc Options" $ fill $ grid 5 5 [[label "Applied", fill $ widget txtGhcOld], [label "New", fill $ widget txtGhcNew]]- btnsL = margin 5 $ floatRight $ row 5 [widget btnimport, widget btnnok, widget btnok] + btnsL = margin 5 $ floatRight $ row 5 [widget btnnok, widget btnok] set dlg [layout := fill $ column 5 [lesL, sdsL, gosL, btnsL], clientSize := sz 500 300] showModal dlg $ \stopFun -> do focusOn lstExts- buttonOnCommand btnimport $ openSetupFile dlg >>= stopFun - buttonOnCommand btnok $ getCurrentPrefs lstExts lstDirs txtGhcNew >>= stopFun . Just . SetPrefs+ buttonOnCommand btnok $ getCurrentPrefs lstExts lstDirs txtGhcNew >>= stopFun . Just buttonOnCommand btnnok $ stopFun Nothing where getCurrentPrefs e d g = do let availExts = sort HP.availableExtensions@@ -61,14 +57,6 @@ sds <- get d items gos <- get g text return $ Prefs les sds gos- openSetupFile dlg = do- res <- fileOpenDialog dlg True True "Select the setup-config file for your project..."- [("setup-config",["setup-config"])] "dist" "setup-config"- case res of- Nothing ->- return Nothing- Just setupConfig ->- return . Just $ LoadPrefs setupConfig addDir w lstDirs = do res <- dirOpenDialog w False "Choose directory to add" "" case res of
src/HPage/GUI/FreeTextWindow.hs view
@@ -10,6 +10,7 @@ import Control.Concurrent.Process import Control.Concurrent.MVar import System.FilePath+import System.Directory import System.IO.Error hiding (try) import Data.List import Data.Bits@@ -47,7 +48,8 @@ data GUIContext = GUICtx { guiWin :: Frame (), guiPages :: SingleListBox (),- guiModules :: SingleListBox (),+ guiPkgModules :: SingleListBox (),+ guiLoadedModules :: SingleListBox (), guiCode :: TextCtrl (), guiResults :: GUIResults, guiStatus :: StatusField,@@ -60,39 +62,40 @@ -- Server context model <- HPS.start - win <- frame [text := "hPage"]+ win <- frame [text := "λPage"] imageFile "icon/hpage.tif" >>= topLevelWindowSetIconFromFile win set win [on closing := HPS.stop model >> propagateEvent] -- Containers- pnl <- panel win []- splLR <- splitterWindow pnl []- pnlL <- panel splLR [clientSize := sz 200 600]- pnlR <- panel splLR []+ ntbkL <- notebook win []+ pnlPs <- panel ntbkL []+ pnlPMs <- panel ntbkL []+ pnlLMs <- panel ntbkL [] -- Text page... -- txtCode <- styledTextCtrl win []- txtCode <- textCtrl pnlR [font := fontFixed, text := ""]+ txtCode <- textCtrl win [font := fontFixed, text := ""] -- Document Selector- lstModules <- singleListBox pnlL [style := wxLB_NEEDED_SB]- lstPages <- singleListBox pnlL [style := wxLB_NEEDED_SB]+ lstPkgModules <- singleListBox pnlPMs [style := wxLB_NEEDED_SB]+ lstLoadedModules <- singleListBox pnlLMs [style := wxLB_NEEDED_SB]+ lstPages <- singleListBox pnlPs [style := wxLB_NEEDED_SB, outerSize := sz 400 600] -- Results list- txtValue <- textEntry pnlR [style := wxTE_READONLY]- txtType <- textEntry pnlR [style := wxTE_READONLY]- txtKind <- textEntry pnlR [style := wxTE_READONLY]+ txtValue <- textEntry win [style := wxTE_READONLY]+ txtType <- textEntry win [style := wxTE_READONLY]+ txtKind <- textEntry win [style := wxTE_READONLY] -- Status bar...- status <- statusField [text := "hello... this is hPage! type in your instructions :)"]+ status <- statusField [text := "hello... this is λPage! type in your instructions :)"] refreshTimer <- timer win [interval := 1000000, on command := debugIO "Inactivity detected"] varTimer <- varCreate refreshTimer set win [statusBar := [status]] - btnGetValue <- button pnlR [text := "Value"]- btnGetType <- button pnlR [text := "Type"]- btnGetKind <- button pnlR [text := "Kind"]+ btnGetValue <- button win [text := "Value"]+ btnGetType <- button win [text := "Type"]+ btnGetKind <- button win [text := "Kind"] search <- findReplaceDataCreate wxFR_DOWN @@ -100,7 +103,7 @@ let grrType = GUIRRow btnGetType txtType let grrKind = GUIRRow btnGetKind txtKind let guiRes = GUIRes grrValue grrType grrKind- let guiCtx = GUICtx win lstPages lstModules txtCode guiRes status varTimer search + let guiCtx = GUICtx win lstPages lstPkgModules lstLoadedModules txtCode guiRes status varTimer search let onCmd name acc = traceIO ("onCmd", name) >> acc model guiCtx set btnGetValue [on command := onCmd "getValue" getValue]@@ -115,7 +118,12 @@ MouseLeftDClick _ _ -> onCmd "mouseEvent" restartTimer >> propagateEvent MouseRightDown _ _ -> onCmd "textContextMenu" textContextMenu _ -> propagateEvent]- set lstModules [on select := onCmd "browseModule" browseModule >> propagateEvent]+ set lstLoadedModules [on mouse := \e -> case e of+ MouseLeftUp _ _ -> onCmd "browseModule" browseModule >> propagateEvent+ _ -> propagateEvent]+ set lstPkgModules [on mouse := \e -> case e of+ MouseRightUp _ _ -> onCmd "pkgModuleContextMenu" pkgModuleContextMenu >> propagateEvent+ _ -> propagateEvent] -- Menu bar... -- menuBar win []@@ -128,7 +136,7 @@ menuAppend mnuPage wxId_SAVE "&Save\tCtrl-s" "Save Page" False menuAppend mnuPage wxId_SAVEAS "&Save as...\tCtrl-Shift-s" "Save Page as" False menuAppendSeparator mnuPage- menuQuit mnuPage []+ menuQuit mnuPage [on command := close win] mnuEdit <- menuPane [text := "Edit"] menuAppend mnuEdit wxId_UNDO "&Undo\tCtrl-z" "Undo" False@@ -146,9 +154,11 @@ menuAppend mnuEdit wxId_PREFERENCES "&Preferences...\tCtrl-," "Preferences" False mnuHask <- menuPane [text := "Haskell"]+ menuAppend mnuHask wxId_HASK_LOAD_PKG "Load &package...\tCtrl-Shift-l" "Load Cabal Package" False+ menuAppendSeparator mnuHask menuAppend mnuHask wxId_HASK_LOAD "&Load modules...\tCtrl-l" "Load Modules" False menuAppend mnuHask wxId_HASK_LOADNAME "Load modules by &name...\tCtrl-Shift-l" "Load Modules by Name" False- menuAppend mnuHask wxId_HASK_ADD "Import modules...\tCtrl-Shift-l" "Import Packaged Modules by Name" False+ menuAppend mnuHask wxId_HASK_ADD "Import modules...\tCtrl-Shift-i" "Import Packaged Modules by Name" False menuAppend mnuHask wxId_HASK_RELOAD "&Reload\tCtrl-r" "Reload Modules" False menuAppendSeparator mnuHask menuAppend mnuHask wxId_HASK_VALUE "&Value\tCtrl-e" "Get the Value of the Current Expression" False@@ -157,7 +167,7 @@ mnuHelp <- menuHelp [] menuAppend mnuHelp wxId_HELP "&Help page\tCtrl-h" "Open the Help Page" False- menuAbout mnuHelp [on command := infoDialog win "About hPage" "Author: Fernando Brujo Benavides"]+ menuAbout mnuHelp [on command := infoDialog win "About λPage" "Author: Fernando Brujo Benavides"] set win [menuBar := [mnuPage, mnuEdit, mnuHask, mnuHelp]] evtHandlerOnMenuCommand win wxId_NEW $ onCmd "runHP' addPage" $ runHP' HP.addPage@@ -175,9 +185,11 @@ evtHandlerOnMenuCommand win wxId_FORWARD $ onCmd "findNext" justFindNext evtHandlerOnMenuCommand win wxId_BACKWARD $ onCmd "findPrev" justFindPrev evtHandlerOnMenuCommand win wxId_REPLACE $ onCmd "findReplace" findReplace+ evtHandlerOnMenuCommand win wxId_HASK_LOAD_PKG $ onCmd "loadPackage" loadPackage evtHandlerOnMenuCommand win wxId_HASK_LOAD $ onCmd "loadModules" loadModules evtHandlerOnMenuCommand win wxId_HASK_ADD $ onCmd "importModules" importModules evtHandlerOnMenuCommand win wxId_HASK_LOADNAME $ onCmd "loadModulesByName" loadModulesByName+ evtHandlerOnMenuCommand win wxId_HASK_LOAD_FAST $ onCmd "loadModulesByNameFast" loadModulesByNameFast evtHandlerOnMenuCommand win wxId_HASK_RELOAD $ onCmd "reloadModules" reloadModules evtHandlerOnMenuCommand win wxId_PREFERENCES $ onCmd "preferences" configure evtHandlerOnMenuCommand win wxId_HASK_VALUE $ onCmd "getValue" getValue@@ -187,6 +199,7 @@ -- Tool bar... tbMain <- toolBarEx win True True []+ mitLoadPkg <- menuFindItem mnuHask wxId_HASK_LOAD_PKG mitNew <- menuFindItem mnuPage wxId_NEW mitOpen <- menuFindItem mnuPage wxId_OPEN mitSave <- menuFindItem mnuPage wxId_SAVE@@ -194,6 +207,7 @@ mitCopy <- menuFindItem mnuEdit wxId_COPY mitPaste <- menuFindItem mnuEdit wxId_PASTE mitReload <- menuFindItem mnuHask wxId_HASK_RELOAD+ loadPath <- imageFile "load.png" newPath <- imageFile "new.png" openPath <- imageFile "open.png" savePath <- imageFile "save.png"@@ -201,10 +215,12 @@ copyPath <- imageFile "copy.png" pastePath <- imageFile "paste.png" reloadPath <- imageFile "reload.png"- toolMenu tbMain mitNew "New" newPath [tooltip := "New"]- toolMenu tbMain mitOpen "Open" openPath [tooltip := "Open"]- toolMenu tbMain mitSave "Save" savePath [tooltip := "Save"]+ toolMenu tbMain mitLoadPkg "Load Package" loadPath [tooltip := "Load Cabal Package"] toolBarAddSeparator tbMain+ toolMenu tbMain mitNew "New" newPath [tooltip := "New Page"]+ toolMenu tbMain mitOpen "Open" openPath [tooltip := "Open Page"]+ toolMenu tbMain mitSave "Save" savePath [tooltip := "Save Page"]+ toolBarAddSeparator tbMain toolMenu tbMain mitCut "Cut" cutPath [tooltip := "Cut"] toolMenu tbMain mitCopy "Copy" copyPath [tooltip := "Copy"] toolMenu tbMain mitPaste "Paste" pastePath [tooltip := "Paste"]@@ -214,15 +230,16 @@ -- Layout settings let txtCodeL = fill $ widget txtCode- lstPagesL = fill $ boxed "Pages" $ fill $ widget lstPages- lstModulesL = fill $ boxed "Modules" $ fill $ widget lstModules+ pagesTabL = tab "Pages" $ container pnlPs $ fill $ widget lstPages+ pkgModsTabL = tab "Package" $ container pnlPMs $ fill $ widget lstPkgModules+ lddModsTabL = tab "Modules" $ container pnlLMs $ fill $ widget lstLoadedModules valueRowL = [widget btnGetValue, hfill $ widget txtValue] typeRowL = [widget btnGetType, hfill $ widget txtType] kindRowL = [widget btnGetKind, hfill $ widget txtKind] resultsGridL= hfill $ boxed "Expression" $ grid 5 0 [valueRowL, typeRowL, kindRowL]- leftL = container pnlL $ hfill $ column 5 [lstPagesL, lstModulesL]- rightL = container pnlR $ column 5 [txtCodeL, resultsGridL]- set win [layout := container pnl $ fill $ vsplit splLR 7 400 leftL rightL,+ leftL = tabs ntbkL [lddModsTabL, pkgModsTabL, pagesTabL]+ rightL = minsize (sz 485 100) $ column 5 [txtCodeL, resultsGridL]+ set win [layout := fill $ row 10 [leftL, rightL], clientSize := sz 800 600] -- ...and RUN!@@ -234,20 +251,20 @@ refreshPage, savePageAs, savePage, openPage, pageChange, copy, cut, paste, justFind, justFindNext, justFindPrev, findReplace,- textContextMenu, browseModule,+ textContextMenu, pkgModuleContextMenu, browseModule, restartTimer, killTimer, getValue, getType, getKind,- loadModules, importModules, loadModulesByName, reloadModules,+ loadPackage, loadModules, importModules, loadModulesByName, loadModulesByNameFast, reloadModules, configure, openHelpPage :: HPS.ServerHandle -> GUIContext -> IO () -browseModule model guiCtx@GUICtx{guiWin = win, guiModules = lstModules, guiCode = txtCode} =+browseModule model guiCtx@GUICtx{guiWin = win, guiLoadedModules = lstLoadedModules, guiCode = txtCode} = do contextMenu <- menuPane []- i <- get lstModules selection+ i <- get lstLoadedModules selection case i of (-1) -> propagateEvent _ -> do- mnText <- listBoxGetString lstModules i+ mnText <- listBoxGetString lstLoadedModules i let mn = case mnText of '*':rest -> rest fullname -> fullname@@ -302,6 +319,21 @@ menuPopup contextMenu pointWithinWindow win objectDelete contextMenu +pkgModuleContextMenu model guiCtx@GUICtx{guiWin = win, guiPkgModules = lstPkgModules} =+ do+ contextMenu <- menuPane []+ i <- get lstPkgModules selection+ case i of+ (-1) -> return ()+ i ->+ do+ mnText <- listBoxGetString lstPkgModules i+ menuAppend contextMenu wxId_HASK_LOAD_FAST "&Load" "Load Module" False+ propagateEvent+ pointWithinWindow <- windowGetMousePosition win+ menuPopup contextMenu pointWithinWindow win+ objectDelete contextMenu+ getValue model guiCtx@GUICtx{guiResults = GUIRes{resValue = grrValue}} = runTxtHP HP.valueOf' model guiCtx grrValue @@ -380,6 +412,32 @@ reloadModules = runHP HP.reloadModules +loadPackage model guiCtx@GUICtx{guiWin = win} =+ do+ distExists <- doesDirectoryExist "dist"+ let startDir = if distExists then "dist" else ""+ res <- fileOpenDialog win True True "Select the setup-config file for your project..."+ [("setup-config",["setup-config"])] startDir "setup-config"+ case res of+ Nothing ->+ return ()+ Just setupConfig ->+ do+ loadres <- tryIn model (HP.loadPackage setupConfig)+ case loadres of+ Left err ->+ warningDialog win "Error" err+ Right pkg ->+ do+ absPath <- canonicalizePath setupConfig+ let dir = joinPath . reverse . drop 2 . reverse $ splitDirectories absPath+ setCurrentDirectory dir+ frameSetTitle win $ "λPage - " ++ prettyShow pkg+ refreshPage model guiCtx+ where prettyShow PackageIdentifier{pkgName = PackageName pkgname,+ pkgVersion = pkgvsn} = pkgname ++ "-" ++ showVersion pkgvsn++ loadModules model guiCtx@GUICtx{guiWin = win, guiStatus = status} = do fileNames <- filesOpenDialog win True True "Load Module..." [("Haskell Modules",["*.hs"])] "" ""@@ -402,6 +460,18 @@ set status [text := "loading..."] runHP (HP.loadModules $ words mns) model guiCtx +loadModulesByNameFast model guiCtx@GUICtx{guiWin = win, guiPkgModules = lstPkgModules, guiStatus = status} =+ do+ i <- get lstPkgModules selection+ case i of+ (-1) -> return ()+ i ->+ do+ mnText <- listBoxGetString lstPkgModules i+ let mns = [mnText]+ set status [text := "loading..."]+ runHP (HP.loadModules mns) model guiCtx+ importModules model guiCtx@GUICtx{guiWin = win, guiStatus = status} = do moduleNames <- textDialog win "Enter the module names, separated by spaces" "Import Packaged Modules..." ""@@ -431,17 +501,7 @@ case res of Nothing -> return ()- Just (LoadPrefs file) ->- do- set status [text := "setting..."]- loadres <- tryIn model (HP.loadPrefsFromCabal file)- case loadres of- Left err ->- warningDialog win "Error" err- Right pkg ->- infoDialog win "hPage" $ "Settings from package " ++ prettyShow pkg ++ " succesfully loaded"- refreshPage model guiCtx- Just (SetPrefs newps) ->+ Just newps -> do set status [text := "setting..."] runHP (do@@ -451,8 +511,6 @@ "" -> return $ Right () newopts -> HP.setGhcOpts newopts ) model guiCtx- where prettyShow PackageIdentifier{pkgName = PackageName pkgname,- pkgVersion = pkgvsn} = pkgname ++ "-" ++ showVersion pkgvsn openHelpPage model guiCtx@GUICtx{guiCode = txtCode} = do@@ -464,7 +522,8 @@ refreshPage model guiCtx@GUICtx{guiWin = win, guiPages = lstPages,- guiModules = lstModules,+ guiPkgModules = lstPkgModules,+ guiLoadedModules = lstLoadedModules, guiCode = txtCode, guiStatus = status} = do@@ -475,14 +534,15 @@ txt <- HP.getPageText lmsRes <- HP.getLoadedModules ims <- HP.getImportedModules+ pms <- HP.getPackageModules let lms = case lmsRes of Left _ -> [] Right x -> x- return (ims, lms, pages, ind, txt)+ return (pms, ims, lms, pages, ind, txt) case res of Left err -> warningDialog win "Error" err- Right (ims, ms, ps, i, t) ->+ Right (pms, ims, ms, ps, i, t) -> do -- Refresh the pages list itemsDelete lstPages@@ -495,10 +555,12 @@ Just fn -> takeFileName $ dropExtension fn in itemAppend lstPages $ prefix ++ name set lstPages [selection := i]- -- Refresh the modules list- itemsDelete lstModules- (flip mapM) ims $ itemAppend lstModules . ('*':)- (flip mapM) ms $ itemAppend lstModules+ -- Refresh the modules lists+ itemsDelete lstLoadedModules+ (flip mapM) ims $ itemAppend lstLoadedModules+ (flip mapM) ms $ itemAppend lstLoadedModules . ('*':)+ itemsDelete lstPkgModules+ (flip mapM) pms $ \pm -> itemAppend lstPkgModules (if pm `elem` ms then ('*':pm) else pm) -- Refresh the current text set txtCode [text := t] set status [text := ""]
src/HPage/GUI/IDs.hs view
@@ -31,9 +31,9 @@ wxId_PREFERENCES = 5022 wxId_CLOSE_ALL = 5018 -wxId_HASK_LOAD, wxId_HASK_LOADNAME, wxId_HASK_RELOAD,+wxId_HASK_LOAD, wxId_HASK_LOADNAME, wxId_HASK_LOAD_FAST, wxId_HASK_RELOAD, wxId_HASK_VALUE, wxId_HASK_TYPE, wxId_HASK_KIND,- wxId_HASK_ADD, wxId_HASK_MENUELEM :: Int+ wxId_HASK_ADD, wxId_HASK_LOAD_PKG, wxId_HASK_MENUELEM :: Int wxId_HASK_LOAD = 5300 wxId_HASK_LOADNAME = 5301 wxId_HASK_RELOAD = 5302@@ -41,4 +41,6 @@ wxId_HASK_TYPE = 5305 wxId_HASK_KIND = 5306 wxId_HASK_ADD = 5307+wxId_HASK_LOAD_PKG = 5308+wxId_HASK_LOAD_FAST = 5309 wxId_HASK_MENUELEM = 5310