leksah 0.10.0.1 → 0.10.0.3
raw patch · 32 files changed
+406/−336 lines, 32 filesdep ~leksah
Dependency ranges changed: leksah
Files
- data/current.lkshs +7/−5
- data/leksah.menu +23/−21
- data/module.lksht +2/−3
- data/prefs.lkshp +5/−3
- data/welcome.txt +7/−49
- leksah.cabal +6/−6
- src/IDE/BufferMode.hs +1/−1
- src/IDE/Build.hs +55/−36
- src/IDE/Command.hs +29/−27
- src/IDE/Completion.hs +2/−2
- src/IDE/Core/Types.hs +4/−7
- src/IDE/Find.hs +3/−17
- src/IDE/ImportTool.hs +1/−1
- src/IDE/Leksah.hs +1/−1
- src/IDE/NotebookFlipper.hs +1/−1
- src/IDE/Package.hs +33/−22
- src/IDE/Pane/Breakpoints.hs +1/−1
- src/IDE/Pane/Errors.hs +1/−1
- src/IDE/Pane/Grep.hs +111/−41
- src/IDE/Pane/Modules.hs +2/−2
- src/IDE/Pane/PackageEditor.hs +18/−18
- src/IDE/Pane/Preferences.hs +21/−18
- src/IDE/Pane/SourceBuffer.hs +2/−1
- src/IDE/Pane/Trace.hs +1/−1
- src/IDE/Pane/Variables.hs +1/−1
- src/IDE/Pane/Workspace.hs +7/−1
- src/IDE/PaneGroups.hs +1/−1
- src/IDE/Statusbar.hs +1/−1
- src/IDE/TextEditor.hs +10/−2
- src/IDE/Utils/GUIUtils.hs +10/−10
- src/IDE/Utils/ServerConnection.hs +1/−1
- src/IDE/Workspaces.hs +38/−34
data/current.lkshs view
@@ -1,15 +1,17 @@ Version of session file format: 1 Time of storage:- "Fri Feb 26 17:11:46 CET 2010"-Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 329)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 658) 886-Population: [(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 401 (SystemScope,True) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([[6,13],[6]],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP BottomP])]-Window size: (1643,1030)+ "Sun Apr 17 22:14:23 CEST 2011"+Layout: VerticalP (TerminalP {paneGroups = fromList [], paneTabs = Just TopP, currentPage = -1, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [("Browser",HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (HorizontalP (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 198) 137)], paneTabs = Just BottomP, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) (TerminalP {paneGroups = fromList [], paneTabs = Nothing, currentPage = 0, detachedId = Nothing, detachedSize = Nothing}) 494) 540+Population: [(Just (InfoSt (InfoState Nothing)),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP BottomP]),(Just (LogSt LogState),[SplitP RightP,SplitP BottomP]),(Just (ModulesSt (ModulesState 286 (SystemScope,False) (Nothing,Nothing) (ExpanderState {packageExp = ([],[]), packageExpNoBlack = ([],[]), packageDExp = ([],[]), packageDExpNoBlack = ([],[]), workspaceExp = ([],[]), workspaceExpNoBlack = ([],[]), workspaceDExp = ([],[]), workspaceDExpNoBlack = ([],[]), systemExp = ([],[]), systemExpNoBlack = ([],[])}))),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP BottomP,SplitP TopP]),(Just (WorkspaceSt WorkspaceState),[SplitP RightP,SplitP TopP,GroupP "Browser",SplitP TopP])]+Window size: (1076,728)+Completion size:+ (750,400) Workspace: Nothing Active pane: Nothing Toolbar visible: True-FindbarState: (True,FindState {entryStr = "", entryHist = [], replaceStr = "", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1})+FindbarState: (True,FindState {entryStr = "", entryHist = [""], replaceStr = "", replaceHist = [], caseSensitive = False, entireWord = False, wrapAround = False, regex = False, lineNr = 1}) Recently opened files: [] Recently opened workspaces:
@@ -1,12 +1,12 @@ <ui> <menubar> <menu name="_File" action="File">- <menuitem name="_New Module" action="FileNew" />+ <menuitem name="_New Module..." action="FileNew" /> <menuitem name="New _Text File" action="FileNewTextFile" />- <menuitem name="_Open" action="FileOpen" />- <menuitem name="_Recent Files" action="RecentFiles"/>+ <menuitem name="_Open..." action="FileOpen" />+ <menuitem name="Open _Recent" action="RecentFiles"/> <menuitem name="_Save" action="FileSave" />- <menuitem name="Save _As" action="FileSaveAs" />+ <menuitem name="Save _As..." action="FileSaveAs" /> <menuitem name="Save _All" action="FileSaveAll" /> <menuitem name="_Revert" action="FileRevert" /> <menuitem name="_Close" action="FileClose" />@@ -43,33 +43,34 @@ <menuitem name="Align ::" action="EditAlignTypeSig" /> </menu> <menu name="_Workspace" action="Workspace">- <menuitem name="_New Workspace" action="NewWorkspace" />- <menuitem name="_Open Workspace" action="OpenWorkspace" />- <menuitem name="_Recent Workspaces" action="RecentWorkspaces"/>- <menuitem name="_Close Workspace" action="CloseWorkspace" />+ <menuitem name="_New..." action="NewWorkspace" />+ <menuitem name="_Open..." action="OpenWorkspace" />+ <menuitem name="Open _Recent" action="RecentWorkspaces"/>+ <menuitem name="_Close" action="CloseWorkspace" /> <separator/>- <menuitem name="_Clean Workspace" action="CleanWorkspace" />- <menuitem name="_Make Workspace" action="MakeWorkspace" />+ <menuitem name="_Clean" action="CleanWorkspace" />+ <menuitem name="_Make" action="MakeWorkspace" /> <separator/> <menuitem name="_Next Error" action="NextError" /> <menuitem name="_Previous Error" action="PreviousError" /> <menuitem name="Resol_ve Errors" action="ResolveErrors" /> </menu> <menu name="_Package" action="Package">- <menuitem name="_New Package" action="NewPackage" />- <menuitem name="_Edit Package" action="EditPackage" />+ <menuitem name="_New..." action="NewPackage" />+ <menuitem name="_Add..." action="AddPackage" />+ <menuitem name="_Edit" action="EditPackage" /> <menuitem name="Edit _Flags" action="PackageFlags" /> <separator/>- <menuitem name="Clea_n Package" action="CleanPackage" />- <menuitem name="_Configure Package" action="ConfigPackage" />- <menuitem name="_Build Package" action="BuildPackage" />+ <menuitem name="Clea_n" action="CleanPackage" />+ <menuitem name="_Configure" action="ConfigPackage" />+ <menuitem name="_Build" action="BuildPackage" /> <menuitem name="_Run" action="RunPackage" /> <separator/>- <menuitem name="C_opy Package" action="CopyPackage" />- <menuitem name="_Install Package" action="InstallPackage" />- <menuitem name="Re_gister Package" action="RegisterPackage" />- <menuitem name="Test Package" action="TestPackage" />- <menuitem name="SDist Package" action="SdistPackage" />+ <menuitem name="C_opy" action="CopyPackage" />+ <menuitem name="_Install" action="InstallPackage" />+ <menuitem name="Re_gister" action="RegisterPackage" />+ <menuitem name="Test" action="TestPackage" />+ <menuitem name="SDist" action="SdistPackage" /> <menuitem name="_Build Documentation" action="DocPackage" /> <separator/> <menuitem name="Open Documentation" action="OpenDocPackage" />@@ -96,6 +97,7 @@ <menuitem name="_Grep" action="ShowGrep" /> <menuitem name="_Log" action="ShowLog" /> <menuitem name="_Search" action="ShowSearch" />+ <menuitem name="_Workspace" action="ShowWorkspace" /> </menu> <menu name="_View" action="View"> <menuitem name="Split H_orizontal" action="ViewSplitHorizontal" />@@ -168,7 +170,7 @@ <toolitem name="Forward" action="ViewHistoryForth"/> <separator/> <toolitem name="BackgroundBuild" action="BackgroundBuildToggled"/>- <toolitem name="BackgroundLink" action="BackgroundLinkToggled"/>+ <toolitem name="MakeMode" action="MakeModeToggled"/> <separator/> <toolitem name="Update Project" action="UpdateMetadataCurrent" /> <separator/>
data/module.lksht view
@@ -13,9 +13,8 @@ ----------------------------------------------------------------------------- module @ModuleName@ (--+@ModuleExports@ ) where -+@ModuleBody@
data/prefs.lkshp view
@@ -64,10 +64,12 @@ True Background build: True-Include linking in background builds:+Make mode: True-Auto install packages:- InstallLibs+Single build without linking:+ False+Don't install last package:+ False Enable usage of Show instances in :print: True Break on any exception thrown:
data/welcome.txt view
@@ -1,48 +1,5 @@- - $=,:Z D7,,,,,,:7$Z - $......,= +.....,+$ - =...,~:..,+D D:~~::~=$ - O~.=????????..O 8III?II$Z - :.I??????????~:N 77I??778 - ??7777777II????+?8 877??I$O - O:$$$ZDNDZ$77I??I:= I7I?I$D - Z?$D $77I?II7 87II77O - $$ 77III:$ DIIII7$ - $N O7II7=D ?7II7Z - $D $77I77 87II7$ - Z$II7Z 8I7I7$N - $777?D IIII$N - $777+ O7777Z - D$77$O I7I77 - Z$III?Z Z777$D - $7III7? DI777D - $7777777Z I77$$ - O?77$8$77I 8777$N - ?777D D77$$ O?77$N - Z77$7 $$7IO I777$ - N+77$8 N$77? Z777$ - $777O D$7$$ I777$ - 7?77$ $77+.777O - N=77$O D$7I=I7$ - 8+77$8 $7III$O - ?I777 N$7I7$ - Z7I778 N7777$ - N~II7$ $777$ - 8I7I7$D $7I7:Z - I~I77O N7II=,N Z - $III7$ $7II7,N $ - $:II7$8 $7II~~Z O7N - O~7II78 D$7I?:.=8 ~$$ - ~III7$ O77??=..? N?,,$ - O~I??7$D $7I???:.........,7 - N,~I?I77 O7I???=,.....,+$N - $,II?I7$D $7I????????I7$8 - O,:???I7D 77II?????I7$N - $.II??I7$ N77IIII77Z - DI?I77777$O Z7777$O - "The Miracle comes quietly into the mind that stops an instant and is still"- + # # ###### # #### #### # # ###### ##### #### # # # # # # # # ## ## # # # # # # ##### # # # # # ## # ##### # # #@@ -56,9 +13,10 @@ # ##### #### #### # # ###### # # # # # ###### # # # # # # # # # # # #- ###### ###### # # #### # # # # V.0.8+ ###### ###### # # #### # # # # - - - - ++ "The Miracle comes quietly into the mind that stops an instant and is still"+++
leksah.cabal view
@@ -1,10 +1,10 @@ name: leksah-version: 0.10.0.1+version: 0.10.0.3 cabal-version: >=1.8 build-type: Simple license: GPL license-file: LICENSE-copyright: 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+copyright: 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie maintainer: maintainer@leksah.org stability: provisional homepage: http://www.leksah.org@@ -14,7 +14,7 @@ description: An Integrated Development Environment for Haskell written in Haskell. category: Development, IDE, Editor author: Juergen Nicklisch-Franken, Hamish Mackenzie-tested-with: GHC ==6.10 || ==6.12+tested-with: GHC ==6.10 || ==6.12 || ==7.0 data-files: LICENSE Readme @@ -127,7 +127,7 @@ ghc-prof-options: -auto-all -prof ghc-shared-options: -auto-all -prof- ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans+ ghc-options: -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans Executable leksah if os(windows)@@ -167,14 +167,14 @@ ghc >=6.10.1 && <7.1, strict >= 0.3.2 && <0.4 else hs-source-dirs: main- build-depends: leksah ==0.10.0.0, base >=4.0.0.0 && <= 5+ build-depends: leksah ==0.10.0.3, base >=4.0.0.0 && <= 5 main-is: Main.hs buildable: True extensions: CPP ghc-prof-options: -auto-all -prof ghc-shared-options: -auto-all -prof- ghc-options: -fwarn-unused-imports -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans+ ghc-options: -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans
src/IDE/BufferMode.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.BufferMode--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL Nothing -- -- Maintainer : maintainer@leksah.org
src/IDE/Build.hs view
@@ -21,6 +21,7 @@ makePackages, MakeSettings(..), MakeOp(..),+ defaultMakeSettings ) where import Data.Map (Map)@@ -33,12 +34,13 @@ (edges, topSort, graphFromEdges, Vertex, Graph, transposeG) import Distribution.Package (pkgVersion, pkgName, Dependency(..))-import Data.List ((\\), nub, find)+import Data.List (delete, nub, (\\), find) import Distribution.Version (withinRange) import Data.Maybe (mapMaybe) import IDE.Package (packageClean', packageInstall', buildPackage, packageConfig')-import IDE.Core.Types (InstallFlag, IDE(..), WorkspaceAction)+import IDE.Core.Types+ (Prefs(..), IDE(..), WorkspaceAction) import Control.Monad.Reader import Distribution.Text (Text(..)) @@ -61,7 +63,7 @@ | MoDocu | MoOther String | MoComposed [MakeOp]- deriving Show+ deriving (Eq,Ord,Show) data Chain alpha beta = Chain {@@ -73,12 +75,20 @@ deriving Show data MakeSettings = MakeSettings {- msInstallMode :: InstallFlag,- msIsSingleMake :: Bool,- msSaveAllBeforeBuild :: Bool,- msBackgroundBuild :: Bool,- msLinkingInBB :: Bool}+ msMakeMode :: Bool,+ msSingleBuildWithoutLinking :: Bool,+ msSaveAllBeforeBuild :: Bool,+ msBackgroundBuild :: Bool,+ msDontInstallLast :: Bool} +defaultMakeSettings :: Prefs -> MakeSettings+defaultMakeSettings prefs = MakeSettings {+ msMakeMode = makeMode prefs,+ msSingleBuildWithoutLinking = singleBuildWithoutLinking prefs,+ msSaveAllBeforeBuild = saveAllBeforeBuild prefs,+ msBackgroundBuild = backgroundBuild prefs,+ msDontInstallLast = dontInstallLast prefs}+ -- ** Functions -- | Construct a dependency graph for a package@@ -87,7 +97,7 @@ constrParentGraph targets = trace ("parentGraph : " ++ showGraph parGraph) parGraph where parGraph = Map.fromList- $ map (\ p -> (p,nub $ p : mapMaybe (depToTarget targets)(ipdDepends p))) targets+ $ map (\ p -> (p,nub $ mapMaybe (depToTarget targets)(ipdDepends p))) targets -- | Construct a dependency graph for a package -- pointing to the packages which depend on the subject package@@ -108,32 +118,40 @@ -- | Construct a make chain for a package, -- which is a plan of the build to perform. -- Consumes settings, the workspace and a list of targets.-constrMakeChain :: MakeSettings -> Workspace -> [IDEPackage] -> MakeOp -> Chain MakeOp IDEPackage-constrMakeChain _ _ [] _ = EmptyChain-constrMakeChain ms@MakeSettings{msIsSingleMake = isSingle}- Workspace{wsPackages = packages, wsNobuildPack = noBuilds} targets@(headTarget:restTargets) op- | isSingle = chainFor headTarget ms op EmptyChain Nothing- | otherwise = trace ("topsorted: " ++ showTopSorted topsorted) constrElem targets topsorted+constrMakeChain :: MakeSettings -> Workspace -> [IDEPackage] -> MakeOp -> MakeOp -> Chain MakeOp IDEPackage+constrMakeChain _ _ [] _ _ = EmptyChain+constrMakeChain ms@MakeSettings{msMakeMode = makeMode}+ Workspace{wsPackages = packages, wsNobuildPack = noBuilds}+ targets@(headTarget:restTargets) op1 op2+ | not makeMode = chainFor headTarget ms op1 EmptyChain Nothing+ | otherwise = trace ("topsorted: " ++ showTopSorted topsorted)+ constrElem targets topsorted depGraph ms noBuilds op1 op2 where depGraph = constrDepGraph packages- topsorted = topSortGraph depGraph- constrElem :: [IDEPackage] -> [IDEPackage] -> Chain MakeOp IDEPackage- constrElem _ [] = trace ("constrElem: 1") EmptyChain- constrElem [] _ = trace ("constrElem: 2")EmptyChain- constrElem currentTargets (current:rest)- | elem current currentTargets && not (elem headTarget noBuilds) =- let dependends = case Map.lookup current depGraph of- Nothing -> trace ("Build>>constrMakeChain: unknown package"- ++ show current) []- Just deps -> deps- in trace ("constrElem: 3 " ++ show currentTargets ++ " "- ++ show current ++ " " ++ show rest ++- " " ++ show dependends) $ chainFor current ms op- (constrElem (nub $ currentTargets ++ dependends) rest) (Just EmptyChain)- | otherwise = trace ("constrElem: 4 " ++ show currentTargets ++ " "- ++ show current ++ " " ++ show rest)- $ constrElem currentTargets rest+ topsorted = reverse $ topSortGraph $ constrParentGraph packages +constrElem :: [IDEPackage] -> [IDEPackage] -> MakeGraph -> MakeSettings -> [IDEPackage]+ -> MakeOp -> MakeOp -> Chain MakeOp IDEPackage+constrElem _ [] _ _ _ _ _ = trace ("constrElem: 1") EmptyChain+constrElem [] _ _ _ _ _ _ = trace ("constrElem: 2") EmptyChain+constrElem currentTargets (current:rest) depGraph ms noBuilds op1 op2+ | elem current currentTargets && not (elem current noBuilds) =+ let dependends = case Map.lookup current depGraph of+ Nothing -> trace ("Build>>constrMakeChain: unknown package"+ ++ show current) []+ Just deps -> deps+ withoutInstall = msDontInstallLast ms && null (delete current dependends)+ filteredOps = case op1 of+ MoComposed l -> MoComposed (filter (\e -> e /= MoInstall) l)+ MoInstall -> MoComposed []+ other -> other+ in trace ("constrElem1 deps: " ++ show dependends ++ " withoutInstall: " ++ show withoutInstall)+ $+ chainFor current ms (if withoutInstall then filteredOps else op1)+ (constrElem (nub $ currentTargets ++ dependends) rest depGraph ms noBuilds op2 op2)+ (Just EmptyChain)+ | otherwise = trace ("constrElem2 " ++ show op2) $ constrElem currentTargets rest depGraph ms noBuilds op1 op2+ chainFor :: IDEPackage -> MakeSettings -> MakeOp -> Chain MakeOp IDEPackage -> Maybe (Chain MakeOp IDEPackage) -> Chain MakeOp IDEPackage@@ -153,7 +171,8 @@ doBuildChain ms chain@Chain{mcAction = MoConfigure} = do packageConfig' (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain)) doBuildChain ms chain@Chain{mcAction = MoBuild} = do- buildPackage (msBackgroundBuild ms) (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain))+ buildPackage (msBackgroundBuild ms) (not (msMakeMode ms) && msSingleBuildWithoutLinking ms)+ (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain)) doBuildChain ms chain@Chain{mcAction = MoInstall} = do packageInstall' (mcEle chain) (constrCont ms (mcPos chain) (mcNeg chain)) doBuildChain ms chain@Chain{mcAction = MoClean} = do@@ -163,12 +182,12 @@ constrCont ms pos (Just neg) False = doBuildChain ms neg constrCont ms pos _ _ = doBuildChain ms pos -makePackages :: MakeSettings -> [IDEPackage] -> MakeOp -> WorkspaceAction-makePackages ms targets op = do+makePackages :: MakeSettings -> [IDEPackage] -> MakeOp -> MakeOp -> WorkspaceAction+makePackages ms targets op1 op2 = trace ("makePackages : " ++ show op1 ++ " " ++ show op2) $ do ws <- ask lift $ do prefs' <- readIDE prefs- let plan = constrMakeChain ms ws targets op+ let plan = constrMakeChain ms ws targets op1 op2 trace ("makeChain : " ++ show plan) $ doBuildChain ms plan
src/IDE/Command.hs view
@@ -109,18 +109,18 @@ mkActions :: [ActionDescr IDERef] mkActions = [AD "File" "_File" Nothing Nothing (return ()) [] False- ,AD "FileNew" "_New Module" Nothing (Just "gtk-new")+ ,AD "FileNew" "_New Module..." Nothing (Just "gtk-new") (packageTry_ $ addModule []) [] False ,AD "FileNewTextFile" "_New Text File" Nothing Nothing fileNew [] False- ,AD "FileOpen" "_Open" Nothing (Just "gtk-open")+ ,AD "FileOpen" "_Open..." Nothing (Just "gtk-open") fileOpen [] False- ,AD "RecentFiles" "_Recent Files" Nothing Nothing (return ()) [] False+ ,AD "RecentFiles" "Open _Recent" Nothing Nothing (return ()) [] False ,AD "FileRevert" "_Revert" Nothing Nothing fileRevert [] False ,AD "FileSave" "_Save" Nothing (Just "gtk-save") (do fileSave False; return ()) [] False- ,AD "FileSaveAs" "Save _As" Nothing (Just "gtk-save-as")+ ,AD "FileSaveAs" "Save _As..." Nothing (Just "gtk-save-as") (do fileSave True; return ()) [] False ,AD "FileSaveAll" "Save A_ll" Nothing Nothing (do fileSaveAll (\ b -> return (bufferName b /= "_Eval.hs")); return ()) [] False@@ -179,17 +179,17 @@ (align ':') [] False ,AD "Workspace" "_Workspace" Nothing Nothing (return ()) [] False- ,AD "NewWorkspace" "_New Workspace" Nothing Nothing- workspaceNew [] False- ,AD "OpenWorkspace" "_Open Workspace" Nothing Nothing- workspaceOpen [] False- ,AD "RecentWorkspaces" "_Recent Workspaces" Nothing Nothing (return ()) [] False- ,AD "CloseWorkspace" "_Close Workspace" Nothing Nothing+ ,AD "NewWorkspace" "_New..." Nothing Nothing+ (workspaceNew >> showWorkspace) [] False+ ,AD "OpenWorkspace" "_Open..." Nothing Nothing+ (workspaceOpen >> showWorkspace) [] False+ ,AD "RecentWorkspaces" "Open _Recent" Nothing Nothing (return ()) [] False+ ,AD "CloseWorkspace" "_Close" Nothing Nothing workspaceClose [] False - ,AD "CleanWorkspace" "Cl_ean Workspace" (Just "Cleans all packages") (Just "ide_clean")+ ,AD "CleanWorkspace" "Cl_ean" (Just "Cleans all packages") (Just "ide_clean") (workspaceTry_ workspaceClean) [] False- ,AD "MakeWorkspace" "_Make Workspace" (Just "Makes all of this workspace") (Just "ide_configure")+ ,AD "MakeWorkspace" "_Make" (Just "Makes all of this workspace") (Just "ide_configure") (workspaceTry_ workspaceMake) [] False ,AD "NextError" "_Next Error" (Just "Go to the next error") (Just "ide_error_next") nextError [] False@@ -197,36 +197,38 @@ previousError [] False ,AD "Package" "_Package" Nothing Nothing (return ()) [] False- ,AD "NewPackage" "_New Package" Nothing Nothing- (workspaceTry_ workspacePackageNew) [] False+ ,AD "NewPackage" "_New..." Nothing Nothing+ (showWorkspace >> workspaceTry_ workspacePackageNew) [] False+ ,AD "AddPackage" "_Add..." Nothing Nothing+ (showWorkspace >> workspaceTry_ workspaceAddPackage) [] False -- ,AD "RecentPackages" "_Recent Packages" Nothing Nothing (return ()) [] False- ,AD "EditPackage" "_Edit Package" Nothing Nothing+ ,AD "EditPackage" "_Edit" Nothing Nothing (packageTry_ packageEdit) [] False -- ,AD "RemovePackage" "_Close Package" Nothing Nothing -- removePackage [] False ,AD "PackageFlags" "Edit Flags" (Just "Edit the package flags") Nothing (getFlags Nothing >>= \ p -> displayPane p False) [] False- ,AD "CleanPackage" "Cl_ean Package" (Just "Cleans the package") (Just "ide_clean")+ ,AD "CleanPackage" "Cl_ean" (Just "Cleans the package") (Just "ide_clean") (packageTry_ packageClean) [] False- ,AD "ConfigPackage" "_Configure Package" (Just "Configures the package") (Just "ide_configure")+ ,AD "ConfigPackage" "_Configure" (Just "Configures the package") (Just "ide_configure") (packageTry_ packageConfig) [] False- ,AD "BuildPackage" "_Build Package" (Just "Builds the package") (Just "ide_make")+ ,AD "BuildPackage" "_Build" (Just "Builds the package") (Just "ide_make") (packageTry_ makePackage) [] False ,AD "DocPackage" "_Build Documentation" (Just "Builds the documentation") Nothing (packageTry_ packageDoc) [] False- ,AD "CopyPackage" "_Copy Package" (Just "Copies the package") Nothing+ ,AD "CopyPackage" "_Copy" (Just "Copies the package") Nothing (packageTry_ packageCopy) [] False ,AD "RunPackage" "_Run" (Just "Runs the package") (Just "ide_run") (packageTry_ packageRun) [] False ,AD "ResolveErrors" "Resol_ve Errors" (Just "Resolve 'Hidden package' and 'Not in scope' errors by adding the necessary dependancies or imports") Nothing resolveErrors [] False - ,AD "InstallPackage" "_Install Package" Nothing Nothing+ ,AD "InstallPackage" "_Install" Nothing Nothing (packageTry_ packageInstall) [] False- ,AD "RegisterPackage" "_Register Package" Nothing Nothing+ ,AD "RegisterPackage" "_Register" Nothing Nothing (packageTry_ packageRegister) [] False- ,AD "TestPackage" "Test Package" Nothing Nothing+ ,AD "TestPackage" "Test" Nothing Nothing (packageTry_ packageTest) [] False ,AD "SdistPackage" "Source Dist" Nothing Nothing (packageTry_ packageSdist) [] False@@ -336,7 +338,7 @@ ,AD "ShowLog" "Log" Nothing Nothing showLog [] False ,AD "ShowWorkspace" "Workspace" Nothing Nothing- (getWorkspace Nothing >>= \ p -> displayPane p False) [] False+ showWorkspace [] False ,AD "View" "_View" Nothing Nothing (return ()) [] False ,AD "ViewMoveLeft" "Move _Left" Nothing Nothing@@ -407,8 +409,8 @@ ,AD "BackgroundBuildToggled" "_BackgroundBuild" (Just "Build in the background and report errors") (Just "ide_build") backgroundBuildToggled [] True- ,AD "BackgroundLinkToggled" "_BackgroundLink" (Just "Link in the background") (Just "ide_link")- backgroundLinkToggled [] True+ ,AD "MakeModeToggled" "_MakeMode" (Just "Make dependend packages") (Just "ide_make")+ makeModeToggled [] True ,AD "DebugToggled" "_Debug" (Just "Use GHCi debugger to build and run") (Just "ide_debug") debugToggled [] True ,AD "OpenDocu" "_OpenDocu" (Just "Opens a browser for a search of the selected data") Nothing@@ -450,7 +452,7 @@ fe <- doesFileExist s when fe $ do mi <- menuItemNewWithLabel s- mi `onActivateLeaf` (reflectIDE (workspaceOpenThis True (Just s) >> return ()) ideR)+ mi `onActivateLeaf` (reflectIDE (workspaceOpenThis True (Just s) >> showWorkspace) ideR) menuShellAppend recentWorkspacesMenu mi) recentWorkspaces' oldSubmenu <- menuItemGetSubmenu recentWorkspacesItem when (isJust oldSubmenu) $ do@@ -692,7 +694,7 @@ reflectIDE (do setCandyState (fst (sourceCandy prefs)) setBackgroundBuildToggled (backgroundBuild prefs)- setBackgroundLinkToggled (backgroundLink prefs)) ideR+ setMakeModeToggled (makeMode prefs)) ideR instrumentSecWindow :: Window -> IDEAction instrumentSecWindow win = do
src/IDE/Completion.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Completion--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : <maintainer@leksah.org>@@ -260,7 +260,7 @@ drawWindow False [PointerMotionMask, ButtonReleaseMask]- (Nothing::Maybe DrawWindow)+ (Nothing:: Maybe DrawWindow) Nothing time when (status == GrabSuccess) $ liftIO $ do
src/IDE/Core/Types.hs view
@@ -54,7 +54,6 @@ , KeyString , Prefs(..)-, InstallFlag(..) , LogRefType(..) , LogRef(..)@@ -307,7 +306,7 @@ , ipdModules :: Set ModuleName , ipdMain :: [FilePath] , ipdExtraSrcs :: Set FilePath-, ipdSrcDirs :: [FilePath] +, ipdSrcDirs :: [FilePath] , ipdExtensions :: [Extension] , ipdConfigFlags :: [String] , ipdBuildFlags :: [String]@@ -395,9 +394,10 @@ , completeRestricted :: Bool , saveAllBeforeBuild :: Bool , backgroundBuild :: Bool- , backgroundLink :: Bool+ , makeMode :: Bool+ , singleBuildWithoutLinking :: Bool+ , dontInstallLast :: Bool , printEvldWithShow :: Bool- , autoInstall :: InstallFlag , breakOnException :: Bool , breakOnError :: Bool , printBindResult :: Bool@@ -413,9 +413,6 @@ data SearchHint = Forward | Backward | Insert | Delete | Initial deriving (Eq)--data InstallFlag = InstallAlways | InstallLibs | InstallNo- deriving(Eq,Show, Read, Enum, Bounded) instance Ord Modifier where compare a b = compare (fromEnum a) (fromEnum b)
src/IDE/Find.hs view
@@ -68,12 +68,8 @@ import Text.Regex.TDFA.String (compile) import Data.List (find, isPrefixOf) import Data.Array (bounds, (!), inRange)-import IDE.Utils.Tool (runTool)-import Control.Concurrent (forkIO)-import IDE.Pane.Grep-import IDE.Package (getPackageDescriptionAndPath)-import IDE.Workspaces (packageTry_)-import System.FilePath (dropFileName)+import IDE.Pane.Grep (grepWorkspace)+import IDE.Workspaces (workspaceTry_, packageTry_) data FindState = FindState { entryStr :: String@@ -401,17 +397,7 @@ wrapAround <- liftIO $ getWrapAround fb regex <- liftIO $ getRegex fb let (regexString, _) = regexStringAndMatchIndex entireWord regex search- mbPD <- lift getPackageDescriptionAndPath- lift $ case mbPD of- Nothing -> ideMessage Normal "No package description"- Just (pd,cabalPath) -> do- let srcPaths = ipdSrcDirs package- let dir = dropFileName (cabalPath)- liftIO $ forkIO $ do- (output, pid) <- runTool "grep" ((if caseSensitive then [] else ["-i"])- ++ ["-r", "-E", "-n", "--exclude=*~", regexString] ++ srcPaths) (Just dir)- reflectIDE (setGrepResults output) ideR- return ()+ lift $ workspaceTry_ $ grepWorkspace regexString caseSensitive matchFunc :: ListStore String -> String -> TreeIter -> IO Bool matchFunc model str iter = do
src/IDE/ImportTool.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.ImportTool--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : Jutaro <jutaro@leksah.org>
src/IDE/Leksah.hs view
@@ -292,7 +292,7 @@ reflectIDE (do setCandyState (fst (sourceCandy startupPrefs)) setBackgroundBuildToggled (backgroundBuild startupPrefs)- setBackgroundLinkToggled (backgroundLink startupPrefs)) ideR+ setMakeModeToggled (makeMode startupPrefs)) ideR let (x,y) = defaultSize startupPrefs windowSetDefaultSize win x y (tbv,fbv) <- reflectIDE (do
src/IDE/NotebookFlipper.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.NotebookFlipper--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : <maintainer@leksah.org>
src/IDE/Package.hs view
@@ -37,12 +37,13 @@ , packageOpenDoc , getPackageDescriptionAndPath+, getEmptyModuleTemplate , getModuleTemplate , addModuleToPackageDescr , delModuleFromPackageDescr , backgroundBuildToggled-, backgroundLinkToggled+, makeModeToggled , debugStart , printBindResultFlag@@ -198,14 +199,14 @@ exchange p | ipdCabalFile p == file = ideP | otherwise = p -runCabalBuild :: Bool -> IDEPackage -> Bool -> (Bool -> IDEAction) -> IDEAction-runCabalBuild backgroundBuild package shallConfigure continuation = do+runCabalBuild :: Bool -> Bool -> IDEPackage -> Bool -> (Bool -> IDEAction) -> IDEAction+runCabalBuild backgroundBuild withoutLinking package shallConfigure continuation = do prefs <- readIDE prefs let dir = dropFileName (ipdCabalFile package) let args = (["build"] ++- if ((not backgroundBuild) || (backgroundLink prefs))- then []- else ["--ghc-options=-c", "--with-ar=true", "--with-ld=true"]+ if backgroundBuild && withoutLinking+ then ["--with-ld=false"]+ else [] ++ ipdBuildFlags package) runExternalTool "Building" "cabal" args (Just dir) $ \output -> do logOutputForBuild package backgroundBuild output@@ -213,7 +214,7 @@ if shallConfigure && isConfigError output then packageConfig' package (\ b ->- when b $ runCabalBuild backgroundBuild package False continuation)+ when b $ runCabalBuild backgroundBuild withoutLinking package False continuation) else do continuation (last output == ToolExit ExitSuccess) return ()@@ -226,8 +227,8 @@ str1 = "Run the 'configure' command first" str2 = "please re-configure" -buildPackage :: Bool -> IDEPackage -> (Bool -> IDEAction) -> IDEAction-buildPackage backgroundBuild package continuation = catchIDE (do+buildPackage :: Bool -> Bool -> IDEPackage -> (Bool -> IDEAction) -> IDEAction+buildPackage backgroundBuild withoutLinking package continuation = catchIDE (do ideR <- ask prefs <- readIDE prefs maybeDebug <- readIDE debugState@@ -239,10 +240,13 @@ interruptBuild when (not backgroundBuild) $ liftIO $ do timeoutAddFull (do- reflectIDE (do buildPackage backgroundBuild package continuation; return False) ideR+ reflectIDE (do+ buildPackage backgroundBuild withoutLinking+ package continuation+ return False) ideR return False) priorityDefaultIdle 1000 return ()- else runCabalBuild backgroundBuild package True continuation+ else runCabalBuild backgroundBuild withoutLinking package True continuation Just debug@(_, ghci) -> do -- TODO check debug package matches active package ready <- liftIO $ isEmptyMVar (currentToolCommand ghci)@@ -427,18 +431,25 @@ reflectIDE (ideMessage Normal ("Can't load package " ++(show e))) ideR return Nothing)) -getModuleTemplate :: PackageDescription -> String -> IO String-getModuleTemplate pd modName = catch (do+getEmptyModuleTemplate :: PackageDescription -> String -> IO String+getEmptyModuleTemplate pd modName = getModuleTemplate pd modName "" ""++getModuleTemplate :: PackageDescription -> String -> String -> String -> IO String+getModuleTemplate pd modName exports body = catch (do dataDir <- getDataDir filePath <- getConfigFilePathForLoad standardModuleTemplateFilename Nothing dataDir template <- UTF8.readFile filePath return (foldl' (\ a (from, to) -> replace from to a) template- [("@License@", (show . license) pd), ("@Maintainer@", maintainer pd),- ("@Stability@",stability pd), ("@Portability@",""),- ("@Copyright@", copyright pd),("@ModuleName@", modName)]))+ [ ("@License@" , (show . license) pd)+ , ("@Maintainer@" , maintainer pd)+ , ("@Stability@" , stability pd)+ , ("@Portability@" , "")+ , ("@Copyright@" , copyright pd)+ , ("@ModuleName@" , modName)+ , ("@ModuleExports@", exports)+ , ("@ModuleBody@" , body)])) (\ (e :: SomeException) -> sysMessage Normal ("Couldn't read template file: " ++ show e) >> return "") - addModuleToPackageDescr :: ModuleName -> Bool -> PackageAction addModuleToPackageDescr moduleName isExposed = do p <- ask@@ -514,10 +525,10 @@ toggled <- getBackgroundBuildToggled modifyIDE_ (\ide -> ide{prefs = (prefs ide){backgroundBuild= toggled}}) -backgroundLinkToggled :: IDEAction-backgroundLinkToggled = do- toggled <- getBackgroundLinkToggled- modifyIDE_ (\ide -> ide{prefs = (prefs ide){backgroundLink= toggled}})+makeModeToggled :: IDEAction+makeModeToggled = do+ toggled <- getMakeModeToggled+ modifyIDE_ (\ide -> ide{prefs = (prefs ide){makeMode= toggled}}) -- --------------------------------------------------------------------- -- | * Debug code that needs to use the package@@ -576,7 +587,7 @@ -- Lets build to make sure the binaries are up to date mbPackage <- readIDE activePack case mbPackage of- Just package -> runCabalBuild True package True (\ _ -> return ())+ Just package -> runCabalBuild True True package True (\ _ -> return ()) Nothing -> return ()) ideRef return () _ -> do
src/IDE/Pane/Breakpoints.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Breakpoints--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org
src/IDE/Pane/Errors.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Errors--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org
src/IDE/Pane/Grep.hs view
@@ -16,7 +16,7 @@ module IDE.Pane.Grep ( IDEGrep(..)-, setGrepResults+, grepWorkspace , GrepState(..) , getGrep ) where@@ -29,25 +29,35 @@ import Control.Monad.Reader import Data.Typeable import IDE.Core.State-import IDE.Utils.Tool (ToolOutput(..))-import Control.Concurrent (forkIO)+import IDE.Utils.Tool (runTool, ToolOutput(..))+import Control.Concurrent+ (newEmptyMVar, isEmptyMVar, takeMVar, putMVar, MVar, forkIO) import IDE.LogRef (logOutput) import IDE.Pane.SourceBuffer (goToSourceDefinition)+import Control.Applicative ((<$>))+import System.FilePath ((</>), dropFileName)+import System.Exit (ExitCode(..)) data GrepRecord = GrepRecord {- file :: FilePath-, line :: Int-, context :: String-}+ file :: FilePath+ , line :: Int+ , context :: String+ , parDir :: Maybe FilePath+ } +isDir GrepRecord{parDir = Nothing} = True+isDir otherwies = False+ -- | A grep pane description -- data IDEGrep = IDEGrep { scrolledView :: ScrolledWindow , treeView :: TreeView-, grepStore :: ListStore GrepRecord+, grepStore :: TreeStore GrepRecord+, waitingGrep :: MVar Bool+, activeGrep :: MVar Bool } deriving Typeable data GrepState = GrepState@@ -67,9 +77,9 @@ nb <- getNotebook pp buildPane pp nb builder builder pp nb windows = reifyIDE $ \ ideR -> do- listStore <- listStoreNew []+ grepStore <- treeStoreNew [] treeView <- treeViewNew- treeViewSetModel treeView listStore+ treeViewSetModel treeView grepStore renderer1 <- cellRendererTextNew renderer10 <- cellRendererPixbufNew@@ -81,7 +91,7 @@ treeViewAppendColumn treeView col1 cellLayoutPackStart col1 renderer10 False cellLayoutPackStart col1 renderer1 True- cellLayoutSetAttributes col1 renderer1 listStore+ cellLayoutSetAttributes col1 renderer1 grepStore $ \row -> [ cellText := file row] renderer2 <- cellRendererTextNew@@ -92,7 +102,7 @@ treeViewColumnSetReorderable col2 True treeViewAppendColumn treeView col2 cellLayoutPackStart col2 renderer2 True- cellLayoutSetAttributes col2 renderer2 listStore+ cellLayoutSetAttributes col2 renderer2 grepStore $ \row -> [ cellText := show $ line row] renderer3 <- cellRendererTextNew@@ -105,7 +115,7 @@ treeViewAppendColumn treeView col3 cellLayoutPackStart col3 renderer30 False cellLayoutPackStart col3 renderer3 True- cellLayoutSetAttributes col3 renderer3 listStore+ cellLayoutSetAttributes col3 renderer3 grepStore $ \row -> [ cellText := context row] @@ -113,20 +123,24 @@ sel <- treeViewGetSelection treeView treeSelectionSetMode sel SelectionSingle - sw <- scrolledWindowNew Nothing Nothing- containerAdd sw treeView- scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic+ scrolledView <- scrolledWindowNew Nothing Nothing+ containerAdd scrolledView treeView+ scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic - let grep = IDEGrep sw treeView listStore+ waitingGrep <- newEmptyMVar+ activeGrep <- newEmptyMVar+ let grep = IDEGrep {..} cid1 <- treeView `afterFocusIn` (\_ -> do reflectIDE (makeActive grep) ideR ; return True) sel `onSelectionChanged` do- sel <- getSelectionGrepRecord treeView listStore+ sel <- getSelectionGrepRecord treeView grepStore case sel of Just record -> reflectIDE (do- goToSourceDefinition (file record)- $ Just $ Location (line record) 0 (line record) 0) ideR+ case record of+ GrepRecord {file=f, line=l, parDir=Just pp} ->+ goToSourceDefinition (pp </> f) $ Just $ Location l 0 l 0+ _ -> return ()) ideR Nothing -> return () return (Just grep,[ConnectC cid1])@@ -142,6 +156,7 @@ line <- int char ':' context <- many anyChar+ let parDir = Nothing return $ GrepRecord {..} <?> "grepLineParser") @@ -155,43 +170,98 @@ int = fmap fromInteger $ P.integer lexer getSelectionGrepRecord :: TreeView- -> ListStore GrepRecord+ -> TreeStore GrepRecord -> IO (Maybe GrepRecord)-getSelectionGrepRecord treeView listStore = do+getSelectionGrepRecord treeView grepStore = do treeSelection <- treeViewGetSelection treeView paths <- treeSelectionGetSelectedRows treeSelection case paths of- [a]:r -> do- size <- listStoreGetSize listStore- if a < size- then fmap Just $ listStoreGetValue listStore a- else return Nothing- _ -> return Nothing+ p:_ -> Just <$> treeStoreGetValue grepStore p+ _ -> return Nothing -setGrepResults :: [ToolOutput] -> IDEAction-setGrepResults output = do+grepWorkspace :: String -> Bool -> WorkspaceAction+grepWorkspace "" caseSensitive = return ()+grepWorkspace regexString caseSensitive = do+ ws <- ask+ maybeActive <- lift $ readIDE activePack+ let packages = case maybeActive of+ Just active -> active : (filter (/= active) $ wsPackages ws)+ Nothing -> wsPackages ws+ lift $ grepDirectories regexString caseSensitive $+ map (\p -> (dropFileName (ipdCabalFile p), ipdSrcDirs p)) $ packages++grepDirectories :: String -> Bool -> [(FilePath, [FilePath])] -> IDEAction+grepDirectories regexString caseSensitive dirs = do grep <- getGrep Nothing+ let store = grepStore grep ideRef <- ask liftIO $ do- let (displayed, dropped) = splitAt 10000 output bringPaneToFront grep forkIO $ do- let errors = filter (isNothing . process) output+ putMVar (waitingGrep grep) True+ putMVar (activeGrep grep) True+ takeMVar (waitingGrep grep)++ postGUIAsync $ treeStoreClear store++ totalFound <- foldM (\a (dir, subDirs) -> do+ nooneWaiting <- isEmptyMVar (waitingGrep grep)+ found <- if nooneWaiting+ then do+ (output, pid) <- runTool "grep" ((if caseSensitive then [] else ["-i"])+ ++ ["-r", "-E", "-n", "--exclude=*~", regexString] ++ subDirs) (Just dir)+ reflectIDE (setGrepResults dir output) ideRef+ else return 0+ return $ a + found) 0 dirs++ nooneWaiting <- isEmptyMVar (waitingGrep grep)+ when nooneWaiting $ do+ nDir <- postGUISync $ treeModelIterNChildren store Nothing+ postGUIAsync $ treeStoreInsert store [] nDir $+ GrepRecord "Search Complete" totalFound "" Nothing++ takeMVar (activeGrep grep) >> return ()+ return ()++setGrepResults :: FilePath -> [ToolOutput] -> IDEM Int+setGrepResults dir output = do+ grep <- getGrep Nothing+ let store = grepStore grep+ view = treeView grep+ ideRef <- ask+ liftIO $ do+ let (displayed, dropped) = splitAt 5000 output+ forkIO $ do+ let errors = filter isError output ++ if null dropped then [] else [ToolError $ "Dropped " ++ show (length dropped) ++ " search results"]- unless (null errors) $ reflectIDE (logOutput errors) ideRef+ unless (null errors) $ postGUISync $ reflectIDE (logOutput errors) ideRef return ()- postGUIAsync $ listStoreClear (grepStore grep)- forM_ (catMaybes (map process displayed)) $ \record -> do- postGUIAsync $ do- listStoreAppend (grepStore grep) record- return ()+ case catMaybes (map (process dir) displayed) of+ [] -> return 0+ results -> do+ nDir <- postGUISync $ treeModelIterNChildren store Nothing+ postGUIAsync $ treeStoreInsert store [] nDir $ GrepRecord dir 0 "" Nothing+ forM_ (zip results [0..]) $ \(record, n) -> do+ nooneWaiting <- isEmptyMVar (waitingGrep grep)+ when nooneWaiting $ postGUIAsync $ do+ treeStoreInsert store [nDir] n record+ treeStoreChange store [nDir] (\r -> r{ line = n+1 }) >> return ()+ when (nDir == 0 && n == 0) $+ treeViewExpandAll view+ return $ length results where- process (ToolOutput line) =+ process pp (ToolOutput line) = case parse grepLineParser "" line of- Right record -> Just record+ Right record -> Just record{parDir = Just pp} _ -> Nothing- process _ = Nothing+ process _ _ = Nothing++ isError (ToolExit ExitSuccess) = False+ isError (ToolExit (ExitFailure 1)) = False+ isError o = isNothing (process "" o)++
src/IDE/Pane/Modules.hs view
@@ -46,7 +46,7 @@ import Distribution.Text (simpleParse,display) import Data.Typeable (Typeable(..)) import Control.Exception (SomeException(..),catch)-import IDE.Package (packageConfig,addModuleToPackageDescr,delModuleFromPackageDescr,getModuleTemplate,getPackageDescriptionAndPath)+import IDE.Package (packageConfig,addModuleToPackageDescr,delModuleFromPackageDescr,getEmptyModuleTemplate,getPackageDescriptionAndPath) import Distribution.PackageDescription (allBuildInfo,hsSourceDirs) import System.FilePath (takeBaseName, (</>),dropFileName) import System.Directory (doesFileExist,createDirectoryIfMissing, removeFile)@@ -1096,7 +1096,7 @@ addModuleToPackageDescr moduleName isExposed packageConfig else do- template <- liftIO $ getModuleTemplate pd modPath+ template <- liftIO $ getEmptyModuleTemplate pd modPath liftIO $ UTF8.writeFile target template addModuleToPackageDescr moduleName isExposed packageConfig
src/IDE/Pane/PackageEditor.hs view
@@ -139,29 +139,29 @@ in libConds || exeConds -packageNew' :: Maybe FilePath -> (FilePath -> IDEAction) -> IDEAction+packageNew' :: Maybe FilePath -> (Bool -> FilePath -> IDEAction) -> IDEAction packageNew' mbDir activateAction = do windows <- getWindows mbDirName <- liftIO $ choosePackageDir (head windows) mbDir case mbDirName of Nothing -> return () Just dirName -> do- cfn <- liftIO $ cabalFileName dirName- continue <- do- if isJust cfn- then do- window <- getMainWindow- liftIO $ do- md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel- $ "There is already a .cabal file in this directory."- dialogAddButton md "_Continue Anyway" (ResponseUser 1)- dialogSetDefaultResponse md (ResponseUser 1)- set md [ windowWindowPosition := WinPosCenterOnParent ]- rid <- dialogRun md- widgetDestroy md- return $ rid == ResponseUser 1- else return True- when continue $ do+ mbCabalFile <- liftIO $ cabalFileName dirName+ case mbCabalFile of+ Just cfn -> do+ window <- getMainWindow+ add <- liftIO $ do+ md <- messageDialogNew (Just window) [] MessageQuestion ButtonsCancel+ $ "There is already file " ++ takeFileName cfn ++ " in this directory. "+ ++ "Would you like to add this package to the workspace?"+ dialogAddButton md "_Add Package" (ResponseUser 1)+ dialogSetDefaultResponse md (ResponseUser 1)+ set md [ windowWindowPosition := WinPosCenterOnParent ]+ rid <- dialogRun md+ widgetDestroy md+ return $ rid == ResponseUser 1+ when add $ activateAction False cfn+ Nothing -> do modules <- liftIO $ do b1 <- doesFileExist (dirName </> "Setup.hs") b2 <- doesFileExist (dirName </> "Setup.lhs")@@ -181,7 +181,7 @@ exeName = (takeBaseName dirName), modulePath = "Main.hs", buildInfo = emptyBuildInfo {hsSourceDirs = ["src"]}}]- } dirName modules activateAction+ } dirName modules (activateAction True) return () standardSetup = "#!/usr/bin/runhaskell \n"
src/IDE/Pane/Preferences.hs view
@@ -603,24 +603,31 @@ boolEditor (\i -> return ()) , mkFieldPP- (paraName <<<- ParaName "Include linking in background builds" $ emptyParams)+ (paraName <<<- ParaName "Make mode" $ emptyParams) (PP.text . show) boolParser- backgroundLink- (\b a -> a{backgroundLink = b})+ makeMode+ (\b a -> a{makeMode = b})+ (boolEditor2 "Single mode")+ (\i -> return ())++ , mkFieldPP+ (paraName <<<- ParaName "Single build without linking" $ emptyParams)+ (PP.text . show)+ boolParser+ singleBuildWithoutLinking+ (\b a -> a{singleBuildWithoutLinking = b}) boolEditor (\i -> return ()) , mkFieldPP- (paraName <<<- ParaName "Auto install packages" $- paraShadow <<<- ParaShadow ShadowIn $emptyParams)+ (paraName <<<- ParaName "Don't install last package" $ emptyParams) (PP.text . show)- readParser- autoInstall- (\b a -> a{autoInstall = b})- (enumEditor ["Install always after a successful build",- "Install if it's a library with dependent packages in the workspace",- "Never install"])+ boolParser+ dontInstallLast+ (\b a -> a{dontInstallLast = b})+ boolEditor (\i -> return ())+ ]), ("Debug", VFDPP emptyParams [ mkFieldPP@@ -735,13 +742,9 @@ , completeRestricted = False , saveAllBeforeBuild = True , backgroundBuild = True- , backgroundLink =-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)- False-#else- True-#endif- , autoInstall = InstallLibs+ , makeMode = True+ , singleBuildWithoutLinking = False+ , dontInstallLast = False , printEvldWithShow = True , breakOnException = True , breakOnError = True
src/IDE/Pane/SourceBuffer.hs view
@@ -423,7 +423,8 @@ (False,_) -> Nothing (True,v) -> Just v setIndentWidth sv $ tabWidth prefs- setTabWidth sv $ tabWidth prefs+ setTabWidth sv $ 8 -- GHC treats tabs as 8 we should display them that way+ drawTabs sv setStyle buffer $ case sourceStyle prefs of (False,_) -> Nothing (True,v) -> Just v
src/IDE/Pane/Trace.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Trace--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org
src/IDE/Pane/Variables.hs view
@@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Variables--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org
src/IDE/Pane/Workspace.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Pane.Workspace--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org@@ -18,6 +18,7 @@ , IDEWorkspace , updateWorkspace , getWorkspace+, showWorkspace ) where import Graphics.UI.Gtk hiding (get)@@ -122,6 +123,11 @@ getWorkspace :: Maybe PanePath -> IDEM IDEWorkspace getWorkspace Nothing = forceGetPane (Right "*Workspace") getWorkspace (Just pp) = forceGetPane (Left pp)++showWorkspace :: IDEAction+showWorkspace = do+ l <- getWorkspace Nothing+ displayPane l False getSelectionTree :: TreeView -> ListStore (Bool, IDEPackage)
src/IDE/PaneGroups.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.PaneGroups--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org
src/IDE/Statusbar.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Statusbar--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org
src/IDE/TextEditor.hs view
@@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.TextEditor--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org@@ -67,6 +67,7 @@ -- View , bufferToWindowCoords+, drawTabs , getBuffer , getDrawWindow , getIterLocation@@ -570,6 +571,12 @@ bufferToWindowCoords (YiEditorView v) point = return point -- TODO #endif +drawTabs :: EditorView -> IDEM ()+drawTabs (GtkEditorView sv) = liftIO $ Gtk.sourceViewSetDrawSpaces sv Gtk.SourceDrawSpacesTab+#ifdef LEKSAH_WITH_YI+drawTabs (YiEditorView _) = return () -- TODO+#endif+ getBuffer :: EditorView -> IDEM EditorBuffer getBuffer (GtkEditorView sv) = liftIO $ fmap (GtkEditorBuffer . Gtk.castToSourceBuffer) $ sv `Gtk.get` Gtk.textViewBuffer #ifdef LEKSAH_WITH_YI@@ -1089,7 +1096,8 @@ id2 <- sv `Gtk.onMoveCursor` \_ _ _ -> reflectIDE cancel ideR #endif id3 <- sv `Gtk.onButtonPress` \_ -> reflectIDE cancel ideR >> return False- return [ConnectC id1]+ id4 <- sv `Gtk.onFocusOut` \_ -> reflectIDE cancel ideR >> return False+ return [ConnectC id1, ConnectC id2, ConnectC id3, ConnectC id4] #ifdef LEKSAH_WITH_YI onCompletion (YiEditorView v) start cancel = return [] -- TODO #endif
src/IDE/Utils/GUIUtils.hs view
@@ -23,8 +23,8 @@ , getBackgroundBuildToggled , setBackgroundBuildToggled-, getBackgroundLinkToggled-, setBackgroundLinkToggled+, getMakeModeToggled+, setMakeModeToggled , getDebugToggled , setDebugToggled @@ -170,14 +170,14 @@ ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundBuild" castToToggleAction liftIO $ toggleActionSetActive ui b -getBackgroundLinkToggled :: PaneMonad alpha => alpha (Bool)-getBackgroundLinkToggled = do- ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundLink" castToToggleAction+getMakeModeToggled :: PaneMonad alpha => alpha (Bool)+getMakeModeToggled = do+ ui <- getUIAction "ui/toolbar/BuildToolItems/MakeMode" castToToggleAction liftIO $ toggleActionGetActive ui -setBackgroundLinkToggled :: PaneMonad alpha => Bool -> alpha ()-setBackgroundLinkToggled b = do- ui <- getUIAction "ui/toolbar/BuildToolItems/BackgroundLink" castToToggleAction+setMakeModeToggled :: PaneMonad alpha => Bool -> alpha ()+setMakeModeToggled b = do+ ui <- getUIAction "ui/toolbar/BuildToolItems/MakeMode" castToToggleAction liftIO $ toggleActionSetActive ui b getDebugToggled :: PaneMonad alpha => alpha (Bool)@@ -191,8 +191,8 @@ liftIO $ toggleActionSetActive ui b getRecentFiles , getRecentWorkspaces :: IDEM MenuItem-getRecentFiles = getMenuItem "ui/menubar/_File/_Recent Files"-getRecentWorkspaces = getMenuItem "ui/menubar/_Workspace/_Recent Workspaces"+getRecentFiles = getMenuItem "ui/menubar/_File/Open _Recent"+getRecentWorkspaces = getMenuItem "ui/menubar/_Workspace/Open _Recent" -- (toolbar)
src/IDE/Utils/ServerConnection.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Utils.ServerConnection--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org
src/IDE/Workspaces.hs view
@@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- -- Module : IDE.Workspace--- Copyright : 2007-2010 Juergen Nicklisch-Franken, Hamish Mackenzie+-- Copyright : 2007-2011 Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GPL -- -- Maintainer : maintainer@leksah.org@@ -278,11 +278,12 @@ workspacePackageNew = do ws <- ask let path = dropFileName (wsFile ws)- lift $ packageNew' (Just path) (\fp -> do+ lift $ packageNew' (Just path) (\isNew fp -> do window <- getMainWindow workspaceTry_ $ workspaceAddPackage' fp >> return ()- mbPack <- idePackageFromPath fp- constructAndOpenMainModule mbPack+ when isNew $ do+ mbPack <- idePackageFromPath fp+ constructAndOpenMainModule mbPack triggerEventIDE UpdateWorkspaceInfo >> return ()) constructAndOpenMainModule :: Maybe IDEPackage -> IDEAction@@ -296,15 +297,17 @@ liftIO $ createDirectoryIfMissing True path alreadyExists <- liftIO $ doesFileExist (path </> target) if alreadyExists- then ideMessage Normal "Main file already exists"+ then do+ ideMessage Normal "Main file already exists"+ fileOpenThis (path </> target) else do template <- liftIO $ getModuleTemplate pd (dropExtension target)+ " main" "main = putStrLn \"Hello World!\"" liftIO $ UTF8.writeFile (path </> target) template fileOpenThis (path </> target) Nothing -> ideMessage Normal "No package description" _ -> return () - workspaceAddPackage :: WorkspaceAction workspaceAddPackage = do ws <- ask@@ -313,7 +316,9 @@ mbFilePath <- liftIO $ choosePackageFile window (Just path) case mbFilePath of Nothing -> return ()- Just fp -> workspaceAddPackage' fp >> return ()+ Just fp -> do+ workspaceAddPackage' fp >> return ()+ lift $ triggerEventIDE UpdateWorkspaceInfo >> return () workspaceAddPackage' :: FilePath -> WorkspaceM (Maybe IDEPackage) workspaceAddPackage' fp = do@@ -509,26 +514,21 @@ workspaceClean :: WorkspaceAction workspaceClean = do ws <- ask- let settings = MakeSettings {- msInstallMode = InstallNo,- msIsSingleMake = False,- msSaveAllBeforeBuild = False,- msBackgroundBuild = False,- msLinkingInBB = False}- makePackages settings (wsPackages ws) MoClean+ settings <- lift $ do+ prefs' <- readIDE prefs+ return (defaultMakeSettings prefs')+ makePackages settings (wsPackages ws) MoClean MoClean workspaceMake :: WorkspaceAction workspaceMake = do ws <- ask settings <- lift $ do prefs' <- readIDE prefs- return (MakeSettings {- msInstallMode = autoInstall prefs',- msIsSingleMake = False,- msSaveAllBeforeBuild = saveAllBeforeBuild prefs',- msBackgroundBuild = False,- msLinkingInBB = False})+ return ((defaultMakeSettings prefs'){+ msMakeMode = True,+ msBackgroundBuild = False}) makePackages settings (wsPackages ws) (MoComposed [MoConfigure,MoBuild,MoInstall])+ (MoComposed [MoConfigure,MoBuild,MoInstall]) backgroundMake :: IDEAction backgroundMake = catchIDE (do@@ -543,13 +543,13 @@ else return [] let isModified = not (null modifiedPacks) when isModified $ do- let settings = MakeSettings {- msInstallMode = autoInstall prefs,- msIsSingleMake = False,- msSaveAllBeforeBuild = saveAllBeforeBuild prefs,- msBackgroundBuild = True,- msLinkingInBB = True}- workspaceTryQuiet_ $ makePackages settings modifiedPacks (MoComposed [MoBuild,MoInstall])+ let settings = defaultMakeSettings prefs+ if msSingleBuildWithoutLinking settings && not (msMakeMode settings)+ then workspaceTryQuiet_ $+ makePackages settings modifiedPacks MoBuild (MoComposed [])+ else workspaceTryQuiet_ $+ makePackages settings modifiedPacks (MoComposed [MoBuild,MoInstall])+ (MoComposed [MoConfigure,MoBuild,MoInstall]) ) (\(e :: SomeException) -> sysMessage Normal (show e)) @@ -559,12 +559,16 @@ (mbWs,settings) <- lift $ do prefs' <- readIDE prefs ws <- readIDE workspace- return (ws,MakeSettings {- msInstallMode = autoInstall prefs',- msIsSingleMake = False,- msSaveAllBeforeBuild = saveAllBeforeBuild prefs',- msBackgroundBuild = False,- msLinkingInBB = False})+ let settings = (defaultMakeSettings prefs'){msBackgroundBuild = False}+ return (ws,settings) case mbWs of Nothing -> sysMessage Normal "No workspace for build."- Just ws -> lift $ runWorkspace (makePackages settings [p] (MoComposed [MoBuild,MoInstall])) ws+ Just ws -> lift $+ if msSingleBuildWithoutLinking settings && not (msMakeMode settings)+ then runWorkspace+ (makePackages settings [p] MoBuild (MoComposed [])) ws+ else runWorkspace+ (makePackages settings [p]+ (MoComposed [MoBuild,MoInstall])+ (MoComposed [MoConfigure,MoBuild,MoInstall])) ws+