leksah 0.15.0.6 → 0.15.1.0
raw patch · 22 files changed
+1084/−1022 lines, 22 filesdep +stmdep ~gtk3dep ~leksahPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependencies added: stm
Dependency ranges changed: gtk3, leksah
API changes (from Hackage documentation)
- IDE.Core.Types: [breakpointBackground] :: Prefs -> Color
- IDE.Core.Types: [contextBackground] :: Prefs -> Color
- IDE.Core.Types: [foundBackground] :: Prefs -> Color
- IDE.Core.Types: [matchBackground] :: Prefs -> Color
- IDE.Pane.HLint: IDEHLint :: ScrolledWindow -> TreeView -> TreeStore HLintRecord -> IDEHLint
- IDE.Pane.HLint: [hlintStore] :: IDEHLint -> TreeStore HLintRecord
- IDE.Pane.HLint: [scrolledView] :: IDEHLint -> ScrolledWindow
- IDE.Pane.HLint: [treeView] :: IDEHLint -> TreeView
- IDE.Pane.HLint: data IDEHLint
- IDE.Pane.HLint: getHLint :: Maybe PanePath -> IDEM IDEHLint
- IDE.Pane.HLint: instance GHC.Classes.Eq IDE.Pane.HLint.HLintRecord
- IDE.Pane.HLint: refreshHLint :: WorkspaceAction
- IDE.Pane.SourceBuffer: hlintBuffer :: IDEBuffer -> IDEAction
- IDE.Pane.SourceBuffer: hlintSettings :: IDEPackage -> IDEM (ParseFlags, [Classify], Hint)
- IDE.Pane.SourceBuffer: replaceHLintSource :: (Bool, Int) -> (Text, Idea) -> IDEM (Bool, Int)
- IDE.Pane.SourceBuffer: resolveActiveHLint :: IDEM Bool
+ IDE.Core.State: triggerEventIDE_ :: MonadIDE m => IDEEvent -> m ()
+ IDE.Core.Types: SavedFile :: FilePath -> IDEEvent
+ IDE.Core.Types: SelectSrcSpan :: (Maybe SrcSpan) -> IDEEvent
+ IDE.Core.Types: [breakpointBackgroundDark] :: Prefs -> Color
+ IDE.Core.Types: [breakpointBackgroundLight] :: Prefs -> Color
+ IDE.Core.Types: [contextBackgroundDark] :: Prefs -> Color
+ IDE.Core.Types: [contextBackgroundLight] :: Prefs -> Color
+ IDE.Core.Types: [foundBG] :: EditorStyle -> (Color, Color)
+ IDE.Core.Types: [foundBackgroundDark] :: Prefs -> Color
+ IDE.Core.Types: [foundBackgroundLight] :: Prefs -> Color
+ IDE.Core.Types: [hlintQueue] :: IDE -> Maybe (TVar [Either FilePath FilePath])
+ IDE.Core.Types: [lintBG] :: EditorStyle -> (Color, Color)
+ IDE.Core.Types: [lintBackgroundDark] :: Prefs -> Color
+ IDE.Core.Types: [lintBackgroundLight] :: Prefs -> Color
+ IDE.Core.Types: [matchBG] :: EditorStyle -> (Color, Color)
+ IDE.Core.Types: [matchBackgroundDark] :: Prefs -> Color
+ IDE.Core.Types: [matchBackgroundLight] :: Prefs -> Color
+ IDE.Core.Types: instance GHC.Classes.Ord IDE.Core.Types.LogRefType
+ IDE.HLint: hlintSettings :: IDEPackage -> IDEM (ParseFlags, [Classify], Hint)
+ IDE.HLint: packageHLint :: PackageAction
+ IDE.HLint: resolveActiveHLint :: IDEM Bool
+ IDE.HLint: scheduleHLint :: Either FilePath FilePath -> IDEAction
+ IDE.Pane.Errors: selectMatchingErrors :: Maybe SrcSpan -> IDEM ()
+ IDE.Pane.SourceBuffer: belongsToPackage :: FilePath -> IDEPackage -> Bool
+ IDE.Pane.SourceBuffer: removeLogRefs :: [LogRefType] -> FilePath -> FilePath -> IDEAction
+ IDE.Pane.SourceBuffer: useCandyFor :: MonadIDE m => IDEBuffer -> m Bool
+ IDE.TextEditor: onSelectionChanged :: TextEditor editor => EditorBuffer editor -> IDEM () -> IDEM [Connection]
+ IDE.TextEditor.Class: [foundBG] :: EditorStyle -> (Color, Color)
+ IDE.TextEditor.Class: [lintBG] :: EditorStyle -> (Color, Color)
+ IDE.TextEditor.Class: [matchBG] :: EditorStyle -> (Color, Color)
+ IDE.TextEditor.Class: onSelectionChanged :: TextEditor editor => EditorBuffer editor -> IDEM () -> IDEM [Connection]
+ IDE.TextEditor.CodeMirror: onSelectionChanged :: TextEditor editor => EditorBuffer editor -> IDEM () -> IDEM [Connection]
+ IDE.TextEditor.GtkSourceView: onSelectionChanged :: TextEditor editor => EditorBuffer editor -> IDEM () -> IDEM [Connection]
- IDE.Core.Types: EditorStyle :: Maybe Text -> Bool -> Color -> Color -> EditorStyle
+ IDE.Core.Types: EditorStyle :: Maybe Text -> Bool -> (Color, Color) -> (Color, Color) -> (Color, Color) -> (Color, Color) -> (Color, Color) -> EditorStyle
- IDE.Core.Types: IDE :: FrameState IDEM -> [PaneName] -> SpecialKeyTable IDERef -> SpecialKeyCons IDERef -> CandyTable -> Prefs -> Maybe Workspace -> Maybe IDEPackage -> Maybe Text -> Map FilePath [IDEPackage] -> [LogRef] -> (Maybe LogRef, Maybe LogRef, Maybe LogRef) -> Int -> Maybe GenScope -> Maybe (GenScope, GenScope) -> Maybe (GenScope, GenScope) -> PackageDescrCache -> Map Text [(Unique, IDEEvent -> IDEM IDEEvent)] -> IDEState -> (Bool, [GUIHistory], Int) -> (Bool, Maybe (Toolbar, ListStore Text)) -> (Bool, Maybe Toolbar) -> [FilePath] -> [FilePath] -> Maybe ProcessHandle -> Maybe (IDEPackage, ToolState) -> ((Int, Int), Maybe CompletionWindow) -> Control -> Maybe (MVar (ServerCommand, ServerAnswer -> IDEM ())) -> Maybe Handle -> (Map FilePath MenuItem, Maybe (Maybe Text)) -> Map Text LogLaunchData -> IDEAction -> Maybe Text -> IDE
+ IDE.Core.Types: IDE :: FrameState IDEM -> [PaneName] -> SpecialKeyTable IDERef -> SpecialKeyCons IDERef -> CandyTable -> Prefs -> Maybe Workspace -> Maybe IDEPackage -> Maybe Text -> Map FilePath [IDEPackage] -> [LogRef] -> (Maybe LogRef, Maybe LogRef, Maybe LogRef) -> Int -> Maybe GenScope -> Maybe (GenScope, GenScope) -> Maybe (GenScope, GenScope) -> PackageDescrCache -> Map Text [(Unique, IDEEvent -> IDEM IDEEvent)] -> IDEState -> (Bool, [GUIHistory], Int) -> (Bool, Maybe (Toolbar, ListStore Text)) -> (Bool, Maybe Toolbar) -> [FilePath] -> [FilePath] -> Maybe ProcessHandle -> Maybe (IDEPackage, ToolState) -> ((Int, Int), Maybe CompletionWindow) -> Control -> Maybe (MVar (ServerCommand, ServerAnswer -> IDEM ())) -> Maybe Handle -> Maybe (TVar [Either FilePath FilePath]) -> (Map FilePath MenuItem, Maybe (Maybe Text)) -> Map Text LogLaunchData -> IDEAction -> Maybe Text -> IDE
- IDE.Core.Types: LogRef :: SrcSpan -> IDEPackage -> Text -> Maybe (Text, Idea) -> (Int, Int) -> LogRefType -> LogRef
+ IDE.Core.Types: LogRef :: SrcSpan -> IDEPackage -> Text -> Maybe (Text, Idea) -> Maybe (Int, Int) -> LogRefType -> LogRef
- IDE.Core.Types: Prefs :: Int -> Text -> Bool -> (Bool, Int) -> Int -> Bool -> (Bool, Text) -> Text -> Bool -> Bool -> Maybe Text -> (Bool, Text) -> Color -> Color -> Color -> Color -> Bool -> Text -> Maybe Text -> (Int, Int) -> Text -> [(Text, PanePath)] -> PanePath -> [(Text, Text)] -> [Dependency] -> Bool -> Bool -> Text -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Text -> Bool -> Int -> [FilePath] -> Maybe FilePath -> Text -> RetrieveStrategy -> Bool -> Prefs
+ IDE.Core.Types: Prefs :: Int -> Text -> Bool -> (Bool, Int) -> Int -> Bool -> (Bool, Text) -> Text -> Bool -> Bool -> Maybe Text -> (Bool, Text) -> Color -> Color -> Color -> Color -> Color -> Color -> Color -> Color -> Color -> Color -> Bool -> Text -> Maybe Text -> (Int, Int) -> Text -> [(Text, PanePath)] -> PanePath -> [(Text, Text)] -> [Dependency] -> Bool -> Bool -> Text -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Bool -> Text -> Bool -> Int -> [FilePath] -> Maybe FilePath -> Text -> RetrieveStrategy -> Bool -> Prefs
- IDE.Core.Types: [breakpointBG] :: EditorStyle -> Color
+ IDE.Core.Types: [breakpointBG] :: EditorStyle -> (Color, Color)
- IDE.Core.Types: [contextBG] :: EditorStyle -> Color
+ IDE.Core.Types: [contextBG] :: EditorStyle -> (Color, Color)
- IDE.Core.Types: [logLines] :: LogRef -> (Int, Int)
+ IDE.Core.Types: [logLines] :: LogRef -> Maybe (Int, Int)
- IDE.Pane.SourceBuffer: selectSourceBuf :: FilePath -> IDEM (Maybe IDEBuffer)
+ IDE.Pane.SourceBuffer: selectSourceBuf :: FilePath -> ReaderT IDERef IO (Maybe IDEBuffer)
- IDE.Pane.SourceBuffer: startComplete :: IDEAction
+ IDE.Pane.SourceBuffer: startComplete :: ReaderT IDERef IO ()
- IDE.TextEditor.Class: EditorStyle :: Maybe Text -> Bool -> Color -> Color -> EditorStyle
+ IDE.TextEditor.Class: EditorStyle :: Maybe Text -> Bool -> (Color, Color) -> (Color, Color) -> (Color, Color) -> (Color, Color) -> (Color, Color) -> EditorStyle
- IDE.TextEditor.Class: [breakpointBG] :: EditorStyle -> Color
+ IDE.TextEditor.Class: [breakpointBG] :: EditorStyle -> (Color, Color)
- IDE.TextEditor.Class: [contextBG] :: EditorStyle -> Color
+ IDE.TextEditor.Class: [contextBG] :: EditorStyle -> (Color, Color)
Files
- data/leksah.menu +1/−1
- data/prefs.lkshp +16/−4
- leksah.cabal +370/−281
- src/IDE/BufferMode.hs +4/−1
- src/IDE/Command.hs +7/−3
- src/IDE/Core/State.hs +2/−1
- src/IDE/Core/Types.hs +30/−10
- src/IDE/HLint.hs +306/−0
- src/IDE/ImportTool.hs +1/−0
- src/IDE/Leksah.hs +4/−2
- src/IDE/LogRef.hs +44/−116
- src/IDE/Pane/Errors.hs +96/−60
- src/IDE/Pane/HLint.hs +14/−288
- src/IDE/Pane/Log.hs +10/−10
- src/IDE/Pane/Preferences.hs +82/−36
- src/IDE/Pane/SourceBuffer.hs +63/−190
- src/IDE/Pane/Workspace.hs +0/−2
- src/IDE/Session.hs +2/−1
- src/IDE/SymbolNavigation.hs +2/−1
- src/IDE/TextEditor/Class.hs +1/−0
- src/IDE/TextEditor/CodeMirror.hs +1/−0
- src/IDE/TextEditor/GtkSourceView.hs +28/−15
@@ -82,6 +82,7 @@ <menuitem name="_Install Dependencies" action="InstallDependenciesPackage" /> <menuitem name="C_opy" action="CopyPackage" /> <menuitem name="Re_gister" action="RegisterPackage" />+ <menuitem name="_HLint" action="HLintPackage" /> <menuitem name="Test" action="TestPackage" /> <menuitem name="SDist" action="SdistPackage" /> <menuitem name="_Build Documentation" action="DocPackage" />@@ -119,7 +120,6 @@ <menuitem name="_Errors" action="ShowErrors" /> <menuitem name="_Files" action="ShowFiles" /> <menuitem name="_Grep" action="ShowGrep" />- <menuitem name="_HLint" action="ShowHLint" /> <menuitem name="_Documentation" action="ShowDocumentation" /> <menuitem name="_Log" action="ShowLog" /> <menuitem name="_Search" action="ShowSearch" />
data/prefs.lkshp view
@@ -18,13 +18,25 @@ --Pair with True or False for use and name of a candy file in a config dir Editor Style: "leksah" Found Text Background:- Color 50372 41120 0+ Color 65535 65535 32768 Selection Match Text Background:- Color 32768 32768 32768+ Color 42064 55923 28520 Execution Context Text Background:- Color 31675 10875 10875+ Color 65535 46529 46529 Breakpoint Text Background:- Color 20752 15778 6640+ Color 64879 51921 28114+Lint Text Background:+ Color 60000 65535 60000+Found Text Dark Background:+ Color 30364 29149 0+Selection Match Text Dark Background:+ Color 18021 29927 6384+Execution Context Text Dark Background:+ Color 20000 16000 16000+Breakpoint Text Dark Background:+ Color 15000 5000 5000+Lint Text Dark Background:+ Color 0 15000 0 Text Editor: "GtkSourceView" LogView Font: "Sans 12" Window default size:
leksah.cabal view
@@ -1,5 +1,5 @@ name: leksah-version: 0.15.0.6+version: 0.15.1.0 cabal-version: >=1.18 build-type: Simple license: GPL@@ -11,346 +11,435 @@ package-url: http://code.haskell.org/leksah bug-reports: http://code.google.com/p/leksah/issues/list synopsis: Haskell IDE written in Haskell-description: An Integrated Development Environment for Haskell written in Haskell.+description:+ An Integrated Development Environment for Haskell written in Haskell. category: Development, IDE, Editor author: Juergen Nicklisch-Franken, Hamish Mackenzie-tested-with: GHC == 7.2.2-data-files: LICENSE- Readme.md-- data/current.lkshs- data/candy.lkshc- data/candy-hasklig.lkshc- data/keymap.lkshk- data/leksah.menu- data/svn.menu- data/git.menu- data/prefs.lkshp- data/prefscoll.lkshp- data/emacs.lkshk- data/LICENSE- data/main.lksht- data/testmain.lksht- data/module.lksht- data/welcome.txt- data/leksah-welcome/Setup.lhs- data/leksah-welcome/leksah-welcome.cabal- data/leksah-welcome/LICENSE- data/leksah-welcome/src/Main.hs- data/leksah-welcome/test/Main.hs- data/empty.lkshs- data/.gtkrc-2.0- data/styles/leksah.xml- data/styles/leksah-dark.xml-- language-specs/cabal.lang- language-specs/haskell.lang- language-specs/haskell-literate.lang- language-specs/hamlet.lang- language-specs/cassius.lang- language-specs/lucius.lang- language-specs/julius.lang- language-specs/jmacro.lang-- pics/ide_class.png- pics/ide_configure.png- pics/ide_data.png- pics/ide_error_next.png- pics/ide_error_prev.png- pics/ide_function.png- pics/ide_instance.png- pics/ide_konstructor.png- pics/ide_make.png- pics/ide_method.png- pics/ide_newtype.png- pics/ide_other.png- pics/ide_reexported.png- pics/ide_rule.png- pics/ide_run.png- pics/ide_slot.png- pics/ide_source.png- pics/ide_source_local.png- pics/ide_type.png- pics/leksah.png- pics/ide_step.png- pics/ide_local.png- pics/ide_module.png- pics/ide_continue.png- pics/ide_debug.png- pics/ide_clean.png- pics/ide_build.png- pics/ide_link.png- pics/ide_rebuild_meta.png- pics/ide_empty.png- pics/ide_js.png-- doc/Keybindings.svg- doc/leksah_manual.lyx- doc/screenshots2/screenshot_buffer_menu.png- doc/screenshots2/screenshot_completion.png- doc/screenshots2/screenshot_config_menu.png- doc/screenshots2/screenshot_construct_module.png- doc/screenshots2/screenshot_debug_menu.png- doc/screenshots2/screenshot_debug_pane.png- doc/screenshots2/screenshot_edit_menu.png- doc/screenshots2/screenshot_error_pane.png- doc/screenshots2/screenshot_file_menu.png- doc/screenshots2/screenshot_findbar.png- doc/screenshots2/screenshot_first_start.png- doc/screenshots2/screenshot_grep.png- doc/screenshots2/screenshot_help_menu.png- doc/screenshots2/screenshot_metadata_prefs.png- doc/screenshots2/screenshot_module_browser.png- doc/screenshots2/screenshot_package_editor_1.png- doc/screenshots2/screenshot_package_flags.png- doc/screenshots2/screenshot_package_menu.png- doc/screenshots2/screenshot_panes_menu.png- doc/screenshots2/screenshot_prefs_editor.png- doc/screenshots2/screenshot_serach_pane.png- doc/screenshots2/screenshot_source_candy.png- doc/screenshots2/screenshot_view_menu.png- doc/screenshots2/screenshot_welcome.png- doc/screenshots2/screenshot_workspace_menu.png-- scripts/clean.sh- scripts/stage.sh- osx/bundle.sh- osx/gtk2.sh- osx/gtk.sh- osx/Info.plist- osx/launcher.sh- osx/leksah.bundle- osx/leksah.icns- osx/makedmg.sh- osx/makedmgs.sh- osx/osxkeymap.lkshk- osx/settings.ini- win32/gtk2hsall.sh- win32/gtkrc- win32/leksah.bat- win32/leksah.ico- win32/leksah.nsi- win32/leksah-rebuild-metadata.bat- win32/leksah-server.bat- win32/makeinstaller.sh- win32/makeinstallers.sh- win32/recache.sh- linux/applications/leksah.desktop- linux/applications/leksah.xml- linux/icons/hicolor/48x48/apps/leksah_48x48.png- linux/specfiles/fedora/12/ghc-binary-shared.spec- linux/specfiles/fedora/12/ghc-deepseq.spec- linux/specfiles/fedora/12/ghc-hslogger.spec- linux/specfiles/fedora/12/ghc-ltk.spec- linux/specfiles/fedora/12/ghc-process-leksah.spec- linux/specfiles/fedora/12/ghc-regex-base.spec- linux/specfiles/fedora/12/ghc-regex-tdfa.spec- linux/specfiles/fedora/12/leksah_server.spec- linux/specfiles/fedora/12/leksah.spec- linux/specfiles/fedora/13/ghc-binary-shared.spec- linux/specfiles/fedora/13/ghc-hslogger.spec- linux/specfiles/fedora/13/ghc-ltk.spec- linux/specfiles/fedora/13/ghc-process-leksah.spec- linux/specfiles/fedora/13/ghc-regex-tdfa.spec- linux/specfiles/fedora/13/haddock.spec- linux/specfiles/fedora/13/leksah-server.spec- linux/specfiles/fedora/13/leksah.spec- linux/specfiles/fedora/14/ghc-binary-shared.spec- linux/specfiles/fedora/14/ghc-haddock.spec- linux/specfiles/fedora/14/ghc-ltk.spec- linux/specfiles/fedora/14/ghc-process-leksah.spec- linux/specfiles/fedora/14/ghc-regex-tdfa.spec- linux/specfiles/fedora/14/leksah-server.spec- linux/specfiles/fedora/14/leksah.spec- linux/specfiles/fedora/14/leksah.spec-darcs-backup0- linux/specfiles/fedora/14/leksah.spec-darcs-backup1--data-dir: ""-extra-source-files: Setup.lhs SetupLocale.lhs po/*.pot po/*.po--x-gettext-po-files: po/*.po-x-gettext-domain-name: leksah--extra-tmp-files:+tested-with: GHC ==7.2.2+data-files:+ LICENSE+ Readme.md+ data/current.lkshs+ data/candy.lkshc+ data/candy-hasklig.lkshc+ data/keymap.lkshk+ data/leksah.menu+ data/svn.menu+ data/git.menu+ data/prefs.lkshp+ data/prefscoll.lkshp+ data/emacs.lkshk+ data/LICENSE+ data/main.lksht+ data/testmain.lksht+ data/module.lksht+ data/welcome.txt+ data/leksah-welcome/Setup.lhs+ data/leksah-welcome/leksah-welcome.cabal+ data/leksah-welcome/LICENSE+ data/leksah-welcome/src/Main.hs+ data/leksah-welcome/test/Main.hs+ data/empty.lkshs+ data/.gtkrc-2.0+ data/styles/leksah.xml+ data/styles/leksah-dark.xml+ language-specs/cabal.lang+ language-specs/haskell.lang+ language-specs/haskell-literate.lang+ language-specs/hamlet.lang+ language-specs/cassius.lang+ language-specs/lucius.lang+ language-specs/julius.lang+ language-specs/jmacro.lang+ pics/ide_class.png+ pics/ide_configure.png+ pics/ide_data.png+ pics/ide_error_next.png+ pics/ide_error_prev.png+ pics/ide_function.png+ pics/ide_instance.png+ pics/ide_konstructor.png+ pics/ide_make.png+ pics/ide_method.png+ pics/ide_newtype.png+ pics/ide_other.png+ pics/ide_reexported.png+ pics/ide_rule.png+ pics/ide_run.png+ pics/ide_slot.png+ pics/ide_source.png+ pics/ide_source_local.png+ pics/ide_type.png+ pics/leksah.png+ pics/ide_step.png+ pics/ide_local.png+ pics/ide_module.png+ pics/ide_continue.png+ pics/ide_debug.png+ pics/ide_clean.png+ pics/ide_build.png+ pics/ide_link.png+ pics/ide_rebuild_meta.png+ pics/ide_empty.png+ pics/ide_js.png+ doc/Keybindings.svg+ doc/leksah_manual.lyx+ doc/screenshots2/screenshot_buffer_menu.png+ doc/screenshots2/screenshot_completion.png+ doc/screenshots2/screenshot_config_menu.png+ doc/screenshots2/screenshot_construct_module.png+ doc/screenshots2/screenshot_debug_menu.png+ doc/screenshots2/screenshot_debug_pane.png+ doc/screenshots2/screenshot_edit_menu.png+ doc/screenshots2/screenshot_error_pane.png+ doc/screenshots2/screenshot_file_menu.png+ doc/screenshots2/screenshot_findbar.png+ doc/screenshots2/screenshot_first_start.png+ doc/screenshots2/screenshot_grep.png+ doc/screenshots2/screenshot_help_menu.png+ doc/screenshots2/screenshot_metadata_prefs.png+ doc/screenshots2/screenshot_module_browser.png+ doc/screenshots2/screenshot_package_editor_1.png+ doc/screenshots2/screenshot_package_flags.png+ doc/screenshots2/screenshot_package_menu.png+ doc/screenshots2/screenshot_panes_menu.png+ doc/screenshots2/screenshot_prefs_editor.png+ doc/screenshots2/screenshot_serach_pane.png+ doc/screenshots2/screenshot_source_candy.png+ doc/screenshots2/screenshot_view_menu.png+ doc/screenshots2/screenshot_welcome.png+ doc/screenshots2/screenshot_workspace_menu.png+ scripts/clean.sh+ scripts/stage.sh+ osx/bundle.sh+ osx/gtk2.sh+ osx/gtk.sh+ osx/Info.plist+ osx/launcher.sh+ osx/leksah.bundle+ osx/leksah.icns+ osx/makedmg.sh+ osx/makedmgs.sh+ osx/osxkeymap.lkshk+ osx/settings.ini+ win32/gtk2hsall.sh+ win32/gtkrc+ win32/leksah.bat+ win32/leksah.ico+ win32/leksah.nsi+ win32/leksah-rebuild-metadata.bat+ win32/leksah-server.bat+ win32/makeinstaller.sh+ win32/makeinstallers.sh+ win32/recache.sh+ linux/applications/leksah.desktop+ linux/applications/leksah.xml+ linux/icons/hicolor/48x48/apps/leksah_48x48.png+ linux/specfiles/fedora/12/ghc-binary-shared.spec+ linux/specfiles/fedora/12/ghc-deepseq.spec+ linux/specfiles/fedora/12/ghc-hslogger.spec+ linux/specfiles/fedora/12/ghc-ltk.spec+ linux/specfiles/fedora/12/ghc-process-leksah.spec+ linux/specfiles/fedora/12/ghc-regex-base.spec+ linux/specfiles/fedora/12/ghc-regex-tdfa.spec+ linux/specfiles/fedora/12/leksah_server.spec+ linux/specfiles/fedora/12/leksah.spec+ linux/specfiles/fedora/13/ghc-binary-shared.spec+ linux/specfiles/fedora/13/ghc-hslogger.spec+ linux/specfiles/fedora/13/ghc-ltk.spec+ linux/specfiles/fedora/13/ghc-process-leksah.spec+ linux/specfiles/fedora/13/ghc-regex-tdfa.spec+ linux/specfiles/fedora/13/haddock.spec+ linux/specfiles/fedora/13/leksah-server.spec+ linux/specfiles/fedora/13/leksah.spec+ linux/specfiles/fedora/14/ghc-binary-shared.spec+ linux/specfiles/fedora/14/ghc-haddock.spec+ linux/specfiles/fedora/14/ghc-ltk.spec+ linux/specfiles/fedora/14/ghc-process-leksah.spec+ linux/specfiles/fedora/14/ghc-regex-tdfa.spec+ linux/specfiles/fedora/14/leksah-server.spec+ linux/specfiles/fedora/14/leksah.spec+ linux/specfiles/fedora/14/leksah.spec-darcs-backup0+ linux/specfiles/fedora/14/leksah.spec-darcs-backup1+extra-source-files:+ Setup.lhs+ SetupLocale.lhs+ po/*.pot+ po/*.po+x-gettext-po-files: po/*.po+x-gettext-domain-name: leksah source-repository head- type: git- location: https://github.com/leksah/leksah+ type: git+ location: https://github.com/leksah/leksah flag yi- Description: Experimental Yi support- Default: False+ description:+ Experimental Yi support+ default: False flag dyre- Description: Experimental Yi support- Default: True+ description:+ Experimental Yi support flag threaded- description: Build with support for multithreaded execution- default: False+ description:+ Build with support for multithreaded execution flag loc- Description: Experimental localization support- Default: False+ description:+ Experimental localization support+ default: False flag network-uri- description: Get Network.URI from the network-uri package- default: True+ description:+ Get Network.URI from the network-uri package library+ if os(windows)- build-depends: Win32 >=2.2.0.0 && <2.4- extra-libraries: kernel32+ build-depends:+ Win32 >=2.2.0.0 && <2.4+ extra-libraries:+ kernel32 else- build-depends: unix >=2.3.1.0 && <2.8+ build-depends:+ unix >=2.3.1.0 && <2.8 if os(osx)- build-depends: gtk3-mac-integration >= 0.3.0.0 && <0.4+ build-depends:+ gtk3-mac-integration >=0.3.0.0 && <0.4 if flag(yi)- build-depends: yi >=0.11.2 && <0.12,- yi-language >=0.1.0.8 && <0.2,- yi-rope >=0.7.0.0 && <0.8+ build-depends:+ yi >=0.11.2 && <0.12,+ yi-language >=0.1.0.8 && <0.2,+ yi-rope >=0.7.0.0 && <0.8 cpp-options: -DLEKSAH_WITH_YI - if flag(yi) && flag(dyre)- build-depends: dyre >= 0.8.3 && <0.9+ if (flag(yi) && flag(dyre))+ build-depends:+ dyre >=0.8.3 && <0.9 cpp-options: -DLEKSAH_WITH_YI_DYRE - build-depends: gtk3 >=0.13.8 && <0.14,- gtksourceview3 >=0.13.1.5 && <0.14,- webkitgtk3 >=0.13 && <0.14,- webkitgtk3-javascriptcore -any- cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3-- build-depends: jsaddle -any, ghcjs-codemirror -any, hamlet -any, blaze-html -any,- lens -any, pretty-show >=1.6.3 && <1.7- cpp-options: -DWEBKITGTK -DLEKSAH_WITH_CODE_MIRROR-- if flag(loc) && os(linux)+ if (flag(loc) && os(linux))+ build-depends:+ hgettext -any,+ setlocale -any cpp-options: -DLOCALIZATION- build-depends: hgettext, setlocale if flag(network-uri)- build-depends: network-uri >=2.6 && <2.7, network >= 2.6 && <2.7+ build-depends:+ network-uri >=2.6 && <2.7,+ network >=2.6 && <2.7 else- build-depends: network >=2.2 && <2.6+ build-depends:+ network >=2.2 && <2.6 - hs-source-dirs: src+ if impl(ghc >=7.2)+ build-depends:+ binary-shared >=0.8.2+ exposed-modules:+ IDE.HLint+ IDE.Leksah+ IDE.Completion+ IDE.ImportTool+ IDE.Find+ IDE.Sandbox+ IDE.Session+ IDE.Command+ IDE.Keymap+ IDE.Utils.GUIUtils+ IDE.SymbolNavigation+ IDE.Package+ IDE.YiConfig+ IDE.OSX+ IDE.GUIHistory+ IDE.SourceCandy+ IDE.NotebookFlipper+ IDE.Core.Types+ IDE.Core.State+ IDE.Metainfo.Provider+ IDE.Pane.Preferences+ IDE.Pane.PackageEditor+ IDE.Pane.HLint+ IDE.Pane.Info+ IDE.Pane.Log+ IDE.Pane.SourceBuffer+ IDE.Pane.Modules+ IDE.Pane.Search+ IDE.Pane.PackageFlags+ IDE.LogRef+ IDE.Debug+ IDE.Pane.Grep+ IDE.Pane.Files+ IDE.Pane.Breakpoints+ IDE.Pane.Trace+ IDE.Pane.Variables+ IDE.Pane.Errors+ IDE.TextEditor+ IDE.Workspaces+ IDE.Workspaces.Writer+ IDE.Statusbar+ IDE.Pane.Workspace+ IDE.PaneGroups+ IDE.Utils.ServerConnection+ IDE.BufferMode+ IDE.Build+ IDE.Command.VCS+ IDE.Command.VCS.Common+ IDE.Command.VCS.SVN+ IDE.Command.VCS.GIT+ IDE.Command.VCS.Mercurial+ IDE.Command.VCS.Common.Workspaces+ IDE.Command.VCS.Common.GUI+ IDE.Command.VCS.Common.Helper+ IDE.Command.VCS.Types+ IDE.Command.Print+ IDE.Pane.WebKit.Documentation+ IDE.Pane.WebKit.Inspect+ IDE.Pane.WebKit.Output+ IDE.TextEditor.Class+ IDE.TextEditor.CodeMirror+ IDE.TextEditor.Yi+ IDE.TextEditor.GtkSourceView+ IDE.Utils.ExternalTool+ build-depends:+ gtk3 >=0.13.9 && <0.14,+ gtksourceview3 >=0.13.1.5 && <0.14,+ webkitgtk3 >=0.13 && <0.14,+ webkitgtk3-javascriptcore -any,+ jsaddle -any,+ ghcjs-codemirror -any,+ hamlet -any,+ blaze-html -any,+ lens -any,+ pretty-show >=1.6.3 && <1.7,+ Cabal >=1.10.2.0 && <1.23,+ base >=4.0.0.0 && <4.9,+ binary >=0.5.0.0 && <0.8,+ bytestring >=0.9.0.1 && <0.11,+ containers >=0.2.0.0 && <0.6,+ directory >=1.0.0.2 && <3.1,+ filepath >=1.1.0.1 && <1.5,+ glib >=0.13.0.0 && <0.14,+ mtl >=1.1.0.2 && <2.3,+ old-time >=1.0.0.1 && <1.2,+ parsec >=2.1.0.1 && <3.2,+ pretty >=1.0.1.0 && <1.2,+ regex-tdfa >=1.1 && <1.3,+ regex-tdfa-text -any,+ regex-base ==0.93.*,+ utf8-string >=0.3.1.1 && <1.1,+ array >=0.2.0.0 && <0.6,+ time >=0.1 && <1.6,+ ltk >=0.15.0.1 && <0.16,+ binary-shared >=0.8 && <0.9,+ deepseq >=1.1.0.0 && <1.5,+ hslogger >=1.0.7 && <1.3,+ leksah-server >=0.15.0.4 && <0.16,+ ghc >=6.10.1 && <7.11,+ strict >=0.3.2 && <0.4,+ conduit >=1.0.8 && <1.3,+ text >=0.11.1.5 && <1.3,+ gio >=0.13.0.0 && <0.14,+ transformers >=0.2.2.0 && <0.5,+ executable-path >=0.0.3 && <0.1,+ vcsgui >=0.1.0 && <0.2,+ vcswrapper >=0.1.0 && <0.2,+ QuickCheck >=2.4.2 && <2.9,+ haskell-src-exts >=1.13.5 && <1.17,+ hlint >=1.9.21 && <1.10,+ vado >=0.0.1 && <0.1,+ shakespeare >=2.0.0.1 && <2.1,+ cpphs >=1.19 && <1.20,+ stm >=2.4.4 && <2.5+ cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3 -DWEBKITGTK+ -DLEKSAH_WITH_CODE_MIRROR default-language: Haskell98-- build-depends: Cabal >=1.10.2.0 && <1.23, base >=4.0.0.0 && <4.9, binary >=0.5.0.0 && <0.8,- bytestring >=0.9.0.1 && <0.11, containers >=0.2.0.0 && <0.6, directory >=1.0.0.2 && <3.1,- filepath >=1.1.0.1 && <1.5, glib >=0.13.0.0 && <0.14,- mtl >=1.1.0.2 && <2.3, old-time >=1.0.0.1 && <1.2,- parsec >=2.1.0.1 && <3.2, pretty >=1.0.1.0 && <1.2,- regex-tdfa >=1.1 && <1.3, regex-tdfa-text, regex-base ==0.93.*, utf8-string >=0.3.1.1 && <1.1, array >=0.2.0.0 && <0.6,- time >=0.1 && <1.6, ltk >= 0.15.0.1 && <0.16, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.5,- hslogger >= 1.0.7 && <1.3, leksah-server >=0.15.0.4 && <0.16,- ghc >=6.10.1 && <7.11, strict >= 0.3.2 && <0.4, conduit >= 1.0.8 && <1.3, text >= 0.11.1.5 && < 1.3,- gio >=0.13.0.0 && <0.14, transformers >=0.2.2.0 && <0.5,- executable-path >=0.0.3 && <0.1,- vcsgui >=0.1.0 && < 0.2, vcswrapper >=0.1.0 && < 0.2,- QuickCheck >=2.4.2 && <2.9, haskell-src-exts >=1.13.5 && <1.17,- hlint >=1.9.21 && <1.10, vado >=0.0.1 && <0.1, shakespeare >=2.0.0.1 && <2.1,- cpphs >=1.19 && <1.20- exposed-modules: IDE.Leksah IDE.Completion IDE.ImportTool IDE.Find- IDE.Sandbox IDE.Session IDE.Command IDE.Keymap IDE.Utils.GUIUtils- IDE.SymbolNavigation IDE.Package IDE.YiConfig IDE.OSX- IDE.GUIHistory IDE.SourceCandy IDE.NotebookFlipper IDE.Core.Types- IDE.Core.State IDE.Metainfo.Provider IDE.Pane.Preferences- IDE.Pane.PackageEditor IDE.Pane.Info IDE.Pane.Log- IDE.Pane.SourceBuffer IDE.Pane.Modules IDE.Pane.Search- IDE.Pane.PackageFlags IDE.LogRef IDE.Debug IDE.Pane.Grep- IDE.Pane.Files IDE.Pane.HLint IDE.Pane.Breakpoints IDE.Pane.Trace- IDE.Pane.Variables IDE.Pane.Errors IDE.TextEditor IDE.Workspaces- IDE.Workspaces.Writer IDE.Statusbar IDE.Pane.Workspace- IDE.PaneGroups IDE.Utils.ServerConnection IDE.BufferMode IDE.Build- IDE.Command.VCS IDE.Command.VCS.Common IDE.Command.VCS.SVN- IDE.Command.VCS.GIT IDE.Command.VCS.Mercurial- IDE.Command.VCS.Common.Workspaces IDE.Command.VCS.Common.GUI- IDE.Command.VCS.Common.Helper IDE.Command.VCS.Types- IDE.Command.Print IDE.Pane.WebKit.Documentation- IDE.Pane.WebKit.Inspect- IDE.Pane.WebKit.Output IDE.TextEditor.Class- IDE.TextEditor.CodeMirror IDE.TextEditor.Yi- IDE.TextEditor.GtkSourceView IDE.Utils.ExternalTool-- if (impl(ghc >= 7.2))- build-depends: binary-shared >=0.8.2-- other-modules: Paths_leksah+ hs-source-dirs: src+ other-modules:+ Paths_leksah ghc-options: -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans -Executable leksah+executable leksah+ if os(windows)- build-depends: Win32 >=2.2.0.0 && <2.4- extra-libraries: kernel32+ build-depends:+ Win32 >=2.2.0.0 && <2.4+ extra-libraries:+ kernel32 if flag(yi) cpp-options: -DLEKSAH_WITH_YI - if flag(yi) && flag(dyre)+ if (flag(yi) && flag(dyre)) cpp-options: -DLEKSAH_WITH_DYRE if flag(threaded) ghc-options: -threaded - hs-source-dirs: main- build-depends: leksah == 0.15.0.6,- base >= 4.0.0.0 && <=4.9,- gtk3 >=0.13.2 && <0.14- if os(linux) && flag(loc)+ if (os(linux) && flag(loc))+ build-depends:+ hgettext -any,+ setlocale -any cpp-options: -DLOCALIZATION- build-depends: hgettext, setlocale if os(osx) ghc-options: -optl-headerpad_max_install_names-- default-language: Haskell98 main-is: Main.hs- buildable: True+ build-depends:+ leksah ==0.15.1.0,+ base >=4.0.0.0 && <=4.9,+ gtk3 >=0.13.9 && <0.14,+ stm >=2.4.4 && <2.5+ default-language: Haskell98+ hs-source-dirs: main ghc-options: -rtsopts -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans executable bewleksah- build-depends: leksah ==0.15.0.6,- base >=4.0.0.0 && <=4.9,- jsaddle -any,- ghcjs-dom -any,- gtk3 >=0.13.8 && <0.14,- gtksourceview3 >=0.13.1.5 && <0.14,- webkitgtk3 >=0.13 && <0.14,- webkitgtk3-javascriptcore -any- cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3- main-is: Main.hs- buildable: True+ build-depends:+ leksah ==0.15.1.0,+ base >=4.0.0.0 && <=4.9,+ jsaddle -any,+ ghcjs-dom -any,+ gtk3 >=0.13.9 && <0.14,+ gtksourceview3 >=0.13.1.5 && <0.14,+ webkitgtk3 >=0.13 && <0.14,+ webkitgtk3-javascriptcore -any,+ stm >=2.4.4 && <2.5+ cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3 default-language: Haskell2010 hs-source-dirs: bew test-suite tests- build-depends: base >=4.0.0.0 && <4.9,- Cabal >=1.10.2.0 && <1.23,- QuickCheck >=2.4.2 && <2.9,- leksah ==0.15.0.6,- containers,- ltk,- leksah-server,- hslogger,- transformers,- glib,- monad-loops,- text,- gtk3 >=0.13.8 && <0.14,- gtksourceview3 >=0.13.1.5 && <0.14,- webkitgtk3 -any- cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3+ if flag(yi)- build-depends: yi+ build-depends:+ yi -any type: exitcode-stdio-1.0 main-is: Tests.hs- other-modules: IDE.TextEditor.Tests- buildable: True+ build-depends:+ base >=4.0.0.0 && <4.9,+ Cabal >=1.10.2.0 && <1.23,+ QuickCheck >=2.4.2 && <2.9,+ leksah ==0.15.1.0,+ containers -any,+ ltk -any,+ leksah-server -any,+ hslogger -any,+ transformers -any,+ glib -any,+ monad-loops -any,+ text -any,+ gtk3 >=0.13.9 && <0.14,+ gtksourceview3 >=0.13.1.5 && <0.14,+ webkitgtk3 -any,+ stm >=2.4.4 && <2.5+ cpp-options: -DMIN_VERSION_gtk=MIN_VERSION_gtk3 default-language: Haskell2010 hs-source-dirs: tests+ other-modules:+ IDE.TextEditor.Tests ghc-options: -threaded
src/IDE/BufferMode.hs view
@@ -138,7 +138,10 @@ doForSelectedLines :: [a] -> (forall editor. TextEditor editor => EditorBuffer editor -> Int -> IDEM a) -> IDEM [a] doForSelectedLines d f = inActiveBufContext d $ \_ _ ebuf currentBuffer _ -> do (start,end) <- getStartAndEndLineOfSelection ebuf- mapM (f ebuf) [start .. end]+ beginUserAction ebuf+ result <- mapM (f ebuf) [start .. end]+ endUserAction ebuf+ return result -- * Buffer Modes
src/IDE/Command.hs view
@@ -69,6 +69,7 @@ import IDE.Pane.PackageEditor import IDE.Pane.Errors import IDE.Package+import IDE.HLint import IDE.Sandbox import IDE.Pane.Log import IDE.Pane.Modules@@ -99,7 +100,6 @@ import IDE.PaneGroups import IDE.Pane.Search (getSearch, IDESearch(..)) import IDE.Pane.Grep (getGrep)-import IDE.Pane.HLint (refreshHLint, getHLint) import IDE.Pane.WebKit.Documentation (getDocumentation) import IDE.Pane.WebKit.Output (getOutputPane) import IDE.Pane.WebKit.Inspect (getInspectPane)@@ -280,6 +280,8 @@ (packageTry packageInstallDependencies) [] False ,AD "RegisterPackage" (__ "_Register") Nothing Nothing (packageTry packageRegister) [] False+ ,AD "HLintPackage" (__ "_HLint") Nothing Nothing+ (packageTry packageHLint) [] False ,AD "TestPackage" (__ "Test") Nothing Nothing (packageTry packageTest) [] False ,AD "SdistPackage" (__ "Source Dist") Nothing Nothing@@ -397,8 +399,6 @@ (getFiles Nothing >>= \ p -> displayPane p False >> refreshFiles) [] False ,AD "ShowGrep" (__ "Grep") Nothing Nothing (getGrep Nothing >>= \ p -> displayPane p False) [] False- ,AD "ShowHLint" (__ "HLint") Nothing Nothing- (getHLint Nothing >>= \ p -> displayPane p False >> workspaceTry refreshHLint) [] False ,AD "ShowDocumentation" (__ "Documentation") Nothing Nothing (getDocumentation Nothing >>= \ p -> displayPane p False) [] False ,AD "ShowOutput" (__ "Output") Nothing Nothing@@ -937,6 +937,10 @@ (\ e@(GetTextPopup _) -> return (GetTextPopup (Just textPopupMenu))) registerEvent stRef "StatusbarChanged" (\ e@(StatusbarChanged args) -> changeStatusbar args >> return e)+ registerEvent stRef "SelectSrcSpan"+ (\ e@(SelectSrcSpan mbSpan) -> selectMatchingErrors mbSpan >> return e)+ registerEvent stRef "SavedFile"+ (\ e@(SavedFile file) -> scheduleHLint (Right file) >> return e) return ()
src/IDE/Core/State.hs view
@@ -34,6 +34,7 @@ , isStartingOrClosing , triggerEventIDE+, triggerEventIDE_ , deactivatePane @@ -255,7 +256,7 @@ window = head . windows errorRefs :: IDE -> [LogRef]-errorRefs = filter ((\ t -> t == ErrorRef || t == WarningRef || t == LintRef || t == TestFailureRef) . logRefType) .+errorRefs = filter ((`elem` [ErrorRef, WarningRef, LintRef, TestFailureRef]) . logRefType) . allLogRefs breakpointRefs :: IDE -> [LogRef]
src/IDE/Core/Types.hs view
@@ -136,6 +136,7 @@ import qualified Data.Text as T (unpack) import Language.Haskell.HLint3 (Idea(..)) import Data.Function (on)+import Control.Concurrent.STM.TVar (TVar) -- --------------------------------------------------------------------- -- IDE State@@ -175,6 +176,7 @@ , yiControl :: Yi.Control , serverQueue :: Maybe (MVar (ServerCommand, ServerAnswer -> IDEM ())) , server :: Maybe Handle+, hlintQueue :: Maybe (TVar [Either FilePath FilePath]) , vcsData :: (Map FilePath MenuItem, Maybe (Maybe Text)) -- menus for packages, password , logLaunches :: Map.Map Text LogLaunchData , autoCommand :: IDEAction@@ -294,6 +296,8 @@ | GetTextPopup (Maybe (IDERef -> Menu -> IO ())) | StatusbarChanged [StatusbarCompartment] | WorkspaceChanged Bool Bool -- ^ showPane updateFileCache+ | SelectSrcSpan (Maybe SrcSpan)+ | SavedFile FilePath instance Event IDEEvent Text where getSelector (InfoChanged _) = "InfoChanged"@@ -318,6 +322,8 @@ getSelector (GetTextPopup _) = "GetTextPopup" getSelector (StatusbarChanged _) = "StatusbarChanged" getSelector (WorkspaceChanged _ _) = "WorkspaceChanged"+ getSelector (SelectSrcSpan _) = "SelectSrcSpan"+ getSelector (SavedFile _) = "SavedFile" instance EventSource IDERef IDEEvent IDEM Text where canTriggerEvent _ "InfoChanged" = True@@ -344,6 +350,8 @@ canTriggerEvent _ "GetTextPopup" = True canTriggerEvent _ "StatusbarChanged" = True canTriggerEvent _ "WorkspaceChanged" = True+ canTriggerEvent _ "SelectSrcSpan" = True+ canTriggerEvent _ "SavedFile" = True canTriggerEvent _ _ = False getHandlers ideRef = do ide <- liftIO $ readIORef ideRef@@ -454,10 +462,16 @@ , removeTBlanks :: Bool , textviewFont :: Maybe Text , sourceStyle :: (Bool, Text)- , foundBackground :: Color- , matchBackground :: Color- , contextBackground :: Color- , breakpointBackground :: Color+ , foundBackgroundLight :: Color+ , matchBackgroundLight :: Color+ , contextBackgroundLight :: Color+ , breakpointBackgroundLight :: Color+ , lintBackgroundLight :: Color+ , foundBackgroundDark :: Color+ , matchBackgroundDark :: Color+ , contextBackgroundDark :: Color+ , breakpointBackgroundDark :: Color+ , lintBackgroundDark :: Color , autoLoad :: Bool , textEditorType :: Text , logviewFont :: Maybe Text@@ -500,8 +514,11 @@ data EditorStyle = EditorStyle { styleName :: Maybe Text , preferDark :: Bool- , breakpointBG :: Color- , contextBG :: Color+ , foundBG :: (Color, Color)+ , matchBG :: (Color, Color)+ , contextBG :: (Color, Color)+ , breakpointBG :: (Color, Color)+ , lintBG :: (Color, Color) } editorStyle :: Bool -> Prefs -> EditorStyle@@ -509,8 +526,11 @@ (False,_) -> Nothing (True,v) -> Just v , preferDark = preferDark- , breakpointBG = breakpointBackground prefs- , contextBG = contextBackground prefs+ , foundBG = (foundBackgroundDark prefs, foundBackgroundLight prefs)+ , matchBG = (matchBackgroundDark prefs, matchBackgroundLight prefs)+ , contextBG = (contextBackgroundDark prefs, contextBackgroundLight prefs)+ , breakpointBG = (breakpointBackgroundDark prefs, breakpointBackgroundLight prefs)+ , lintBG = (lintBackgroundDark prefs, lintBackgroundLight prefs) } data SearchHint = Forward | Backward | Insert | Delete | Initial@@ -539,14 +559,14 @@ -- Order determines priority of the icons in the gutter data LogRefType = ContextRef | BreakpointRef | ErrorRef | TestFailureRef | WarningRef | LintRef- deriving (Eq, Show, Enum, Bounded)+ deriving (Eq, Ord, Show, Enum, Bounded) data LogRef = LogRef { logRefSrcSpan :: SrcSpan , logRefPackage :: IDEPackage , refDescription :: Text , logRefIdea :: Maybe (Text, Idea)-, logLines :: (Int,Int)+, logLines :: Maybe (Int, Int) , logRefType :: LogRefType } deriving (Eq)
+ src/IDE/HLint.hs view
@@ -0,0 +1,306 @@+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+-----------------------------------------------------------------------------+--+-- Module : IDE.HLint+-- Copyright : 2007-2015 Juergen Nicklisch-Franken, Hamish Mackenzie+-- License : GPL+--+-- Maintainer : maintainer@leksah.org+-- Stability : provisional+-- Portability :+--+-- |+--+-----------------------------------------------------------------------------++module IDE.HLint (+ hlintSettings+ , scheduleHLint+ , packageHLint+ , resolveActiveHLint+) where++import Control.Applicative+import Prelude hiding(getChar, getLine)+import IDE.Core.Types+ (Prefs(..), LogRef(..), LogRefType(..), wsAllPackages, ipdBuildDir,+ IDEM, IDEAction, IDE(..), IDEPackage(..), PackageAction)+import Control.Monad.Reader (asks, MonadReader(..))+import IDE.Core.State+ (postSyncIDE, catchIDE, MessageLevel(..), ideMessage,+ leksahSubDir, reflectIDE, modifyIDE_, readIDE)+import Control.Concurrent.STM.TVar+ (newTVarIO, writeTVar, readTVar)+import Control.Concurrent (forkIO)+import Control.Monad+ (void, when, foldM, forM_, forM, unless, forever)+import Control.Monad.STM (retry, atomically)+import Control.Monad.Trans.Class (MonadTrans(..))+import Control.Monad.IO.Class (MonadIO(..))+import Language.Haskell.HLint3+ (Note(..), Idea(..), Severity(..), applyHints, ParseError(..),+ parseModuleEx, CppFlags(..), defaultParseFlags,+ parseFlagsAddFixities, resolveHints, readSettingsFile,+ findSettings, Hint(..), Classify(..), ParseFlags(..))+import System.FilePath.Windows (makeRelative, equalFilePath, (</>))+import System.Directory (doesFileExist)+import qualified System.IO.Strict as S (readFile)+import Language.Preprocessor.Cpphs+ (defaultCpphsOptions, runCpphsReturningSymTab, CpphsOptions(..))+import System.Log.Logger (debugM)+import Data.Monoid ((<>))+import Data.List (intercalate, find)+import qualified Data.Map as M (keys, lookup)+import qualified Data.Text as T+ (replicate, init, unlines, reverse, take, drop, lines, unpack,+ pack)+import Control.Exception (SomeException(..))+import Data.Maybe (mapMaybe, catMaybes)+import Distribution.Package (PackageIdentifier(..))+import Distribution.ModuleName (ModuleName)+import IDE.Core.CTypes+ (SrcSpan(..), mdMbSourcePath, pdModules, mdModuleId, modu,+ PackScope(..), GenScope(..), GenScope)+import IDE.Metainfo.Provider (getWorkspaceInfo)+import qualified Language.Haskell.Exts.SrcLoc as HSE+ (SrcLoc(..), SrcSpan(..))+import IDE.Pane.SourceBuffer+ (useCandyFor, selectSourceBuf, fileSave, inActiveBufContext,+ addLogRef, belongsToPackage, removeLogRefs)+import qualified Data.Text.IO as T (readFile)+import Data.Text (Text)+import IDE.TextEditor (TextEditor(..))+import IDE.SourceCandy+ (getCandylessPart, positionToCandy, stringToCandy)+import IDE.BufferMode (editInsertCode)++packageHLint :: PackageAction+packageHLint = asks ipdCabalFile >>= (lift . lift . scheduleHLint . Left)++scheduleHLint :: Either FilePath FilePath -> IDEAction+scheduleHLint what = do+ liftIO $ debugM "leksah" "scheduleHLint"+ mbQueue <- readIDE hlintQueue+ queue <- case mbQueue of+ Nothing -> do+ ideR <- ask+ queue <- liftIO $ newTVarIO []+ modifyIDE_ $ \ide -> ide { hlintQueue = Just queue }+ liftIO . forkIO . forever $ do+ x <- atomically $ do+ schedule <- readTVar queue+ case schedule of+ (x:xs) -> do+ writeTVar queue xs+ return x+ [] -> retry+ reflectIDE (runHLint x) ideR+ return queue+ Just queue -> return queue+ liftIO . atomically $ do+ scheduled <- readTVar queue+ unless (what `elem` scheduled) $+ writeTVar queue $ scheduled ++ [what]++runHLint :: Either FilePath FilePath -> IDEAction+runHLint (Right sourceFile) = do+ liftIO . debugM "leksah" $ "runHLint"+ packages <- maybe [] wsAllPackages <$> readIDE workspace+ case find (belongsToPackage sourceFile) packages of+ Just package -> runHLint' package (Just sourceFile)+ _ -> liftIO . debugM "leksah" $ "runHLint package not found for " <> sourceFile+runHLint (Left cabalFile) = do+ liftIO . debugM "leksah" $ "runHLint"+ packages <- maybe [] wsAllPackages <$> readIDE workspace+ case find ((== cabalFile) . ipdCabalFile) packages of+ Just package -> runHLint' package Nothing+ _ -> liftIO . debugM "leksah" $ "runHLint package not found for " <> cabalFile++runHLint' :: IDEPackage -> Maybe FilePath -> IDEAction+runHLint' package mbSourceFile = do+ liftIO . debugM "leksah" $ "runHLint'"+ ideR <- ask+ (flags, classify, hint) <- hlintSettings package+ let modules = M.keys (ipdModules package)+ paths <- case mbSourceFile of+ Just f -> return [f]+ Nothing -> getSourcePaths (ipdPackageId package) modules+ res <- forM paths $ \ full -> do+ let file = makeRelative (ipdBuildDir package) full+ postSyncIDE $ removeLogRefs [LintRef] (ipdBuildDir package) file+ text <- liftIO $ T.readFile full+ liftIO . debugM "leksah" $ "runHLint parsing " <> full+ do result <- liftIO $ parseModuleEx flags full (Just (T.unpack text))+ case result of+ Left e -> logHLintError package e >> return Nothing+ Right r -> do+ liftIO . debugM "leksah" $ "runHLint parsed " <> full+ return $ Just (r, (full, text))+ `catchIDE` (\(e :: SomeException) -> do+ reflectIDE (ideMessage Normal . T.pack $ "HLint Exception : " <> show e) ideR+ return Nothing)+ liftIO $ debugM "leksah" "runHLint parse complete"+ let results = catMaybes res+ ideas = map fst results+ texts = map snd results+ getText f = maybe "" snd $ find (equalFilePath f . fst) texts+ logHLintResult package (applyHints classify hint ideas) getText+++getSourcePaths :: PackageIdentifier -> [ModuleName] -> IDEM [FilePath]+getSourcePaths packId names = do+ mbWorkspaceInfo <- getWorkspaceInfo+ case mbWorkspaceInfo of+ Nothing -> return []+ Just (sc, _) -> return (mapMaybe (sourcePathFromScope sc) names)+ where+ sourcePathFromScope :: GenScope -> ModuleName -> Maybe FilePath+ sourcePathFromScope (GenScopeC (PackScope l _)) mn =+ case packId `M.lookup` l of+ Just pack ->+ case filter (\md -> modu (mdModuleId md) == mn)+ (pdModules pack) of+ (mod : tl) -> mdMbSourcePath mod+ [] -> Nothing+ Nothing -> Nothing++hlintSettings :: IDEPackage -> IDEM (ParseFlags, [Classify], Hint)+hlintSettings package = do+ mbHlintDir <- liftIO $ leksahSubDir "hlint"+ let cabalMacros = ipdBuildDir package </> "dist/build/autogen/cabal_macros.h"+ cabalMacrosExist <- liftIO $ doesFileExist cabalMacros+ defines <- liftIO $ if cabalMacrosExist+ then do+ raw <- S.readFile cabalMacros+ map (\(a, b) -> (a, concat (lines b))) . snd <$> runCpphsReturningSymTab defaultCpphsOptions cabalMacros raw+ else return []+ (fixities, classify, hints) <- liftIO $ findSettings (readSettingsFile mbHlintDir) Nothing+ let hint = resolveHints hints+ flags = parseFlagsAddFixities fixities defaultParseFlags{ cppFlags = Cpphs defaultCpphsOptions+ { defines = defines } }+ liftIO . debugM "leksah" $ "hlintSettings defines = " <> show defines+ return (flags, classify, hint)++logHLintResult :: IDEPackage -> [Idea] -> (FilePath -> Text) -> IDEAction+logHLintResult package allIdeas getText = do+ let ideas = filter (\Idea{..} -> ideaSeverity /= Ignore) allIdeas+ forM_ ideas $ \ idea@Idea{..} -> do+ let text = getText (HSE.srcSpanFilename ideaSpan)+ fixColumn c = max 0 (c - 1)+ srcSpan = SrcSpan (makeRelative (ipdBuildDir package) $ HSE.srcSpanFilename ideaSpan)+ (HSE.srcSpanStartLine ideaSpan)+ (HSE.srcSpanStartColumn ideaSpan - 1)+ (HSE.srcSpanEndLine ideaSpan)+ (HSE.srcSpanEndColumn ideaSpan - 1)+ fromLines = drop (HSE.srcSpanStartLine ideaSpan - 1)+ . take (HSE.srcSpanEndLine ideaSpan) $ T.lines text+ fixHead [] = []+ fixHead (x:xs) = T.drop (HSE.srcSpanStartColumn ideaSpan - 1) x : xs+ fixTail [] = []+ fixTail (x:xs) = T.take (HSE.srcSpanEndColumn ideaSpan - 1) x : xs+ from = T.reverse . T.drop 1 . T.reverse+ . T.unlines . fixHead . reverse . fixTail $ reverse fromLines+ ref = LogRef srcSpan package (T.pack $ showHLint idea)+ (Just (from, idea)) Nothing LintRef+ postSyncIDE $ addLogRef ref+ return ()++logHLintError :: IDEPackage -> ParseError -> IDEAction+logHLintError package error = do+ let loc = parseErrorLocation error+ srcSpan = SrcSpan (makeRelative (ipdBuildDir package) $ HSE.srcFilename loc)+ (HSE.srcLine loc)+ (HSE.srcColumn loc - 1)+ (HSE.srcLine loc)+ (HSE.srcColumn loc - 1)+ ref = LogRef srcSpan package ("Hlint Parse Error: " <> T.pack (parseErrorMessage error)) Nothing Nothing LintRef+ postSyncIDE $ addLogRef ref++-- Cut down version of showEx from HLint+showHLint :: Idea -> String+showHLint Idea{..} = intercalate "\n" $+ [if ideaHint == "" then "" else show ideaSeverity ++ ": " ++ ideaHint] +++ f "Found" (if ideaHint == "Reduce duplication" then Just ideaFrom else Nothing) +++ f "Why not" ideaTo +++ ["Note: " ++ n | let n = showNotes ideaNote, n /= ""]+ where+ f msg Nothing = []+ f msg (Just x) | null x = [msg ++ " remove it."]+ | otherwise = (msg ++ ":") : map (" "++) (lines x)+ showNotes :: [Note] -> String+ showNotes = intercalate ", " . map show . filter use+ where use ValidInstance{} = False -- Not important enough to tell an end user+ use _ = True++resolveActiveHLint :: IDEM Bool+resolveActiveHLint = inActiveBufContext False $ \_ _ ebuf _ _ -> do+ allLogRefs <- readIDE allLogRefs+ (iStart, iEnd) <- getSelectionBounds ebuf+ lStart <- getLine iStart+ cStart <- getLineOffset iStart+ lEnd <- getLine iEnd+ cEnd <- getLineOffset iEnd+ let selectedRefs = [ref | ref@LogRef{..} <- allLogRefs,+ logRefType == LintRef+ && maybe "" (ideaHint . snd) logRefIdea /= "Reduce duplication"+ && (lStart+1, cStart) <= (srcSpanEndLine logRefSrcSpan,+ srcSpanEndColumn logRefSrcSpan)+ && (lEnd+1, cEnd) >= (srcSpanStartLine logRefSrcSpan,+ srcSpanStartColumn logRefSrcSpan)]+ safeRefs = takeWhileNotOverlapping selectedRefs+ (changed, _) <- foldM replaceHLintSource (False, 0) . catMaybes $ map logRefIdea safeRefs+ prefs <- readIDE prefs+ when changed $ if backgroundBuild prefs+ then setModified ebuf True+ else void $ fileSave False+ return changed+ where+ takeWhileNotOverlapping = takeWhileNotOverlapping' (-1)+ takeWhileNotOverlapping' _ [] = []+ takeWhileNotOverlapping' line (ref:refs)+ | srcSpanEndLine (logRefSrcSpan ref) > line = ref : takeWhileNotOverlapping' (srcSpanEndLine $ logRefSrcSpan ref) refs+ | otherwise = takeWhileNotOverlapping' line refs++indentHLintText :: Int -> Text -> Text+indentHLintText startColumn text =+ T.init $ T.unlines (take 1 lines <> drop 1 (map (indent <>) lines))+ where+ lines = T.lines text+ indent = T.replicate startColumn " "++replaceHLintSource :: (Bool, Int) -> (Text, Idea) -> IDEM (Bool, Int)+replaceHLintSource (changed, delta) (from, Idea{ideaSpan = ideaSpan, ideaTo = Just ideaTo}) = do+ let HSE.SrcSpan{..} = ideaSpan+ to = indentHLintText (srcSpanStartColumn-1) (T.pack ideaTo)+ liftIO . debugM "leksah" $ "replaceHLintSource From: " <> show from <> "\nreplaceHLintSource To: " <> show to+ mbBuf <- selectSourceBuf srcSpanFilename+ case mbBuf of+ Just buf -> inActiveBufContext (changed, delta) $ \_ sv ebuf _ _ -> do+ useCandy <- useCandyFor buf+ candy' <- readIDE candy+ realString <- if useCandy then stringToCandy candy' to else return to+ (lineS', columnS', lineE', columnE') <- if useCandy+ then do+ (_,e1) <- positionToCandy candy' ebuf (srcSpanStartLine + delta, srcSpanStartColumn - 1)+ (_,e2) <- positionToCandy candy' ebuf (srcSpanEndLine + delta, srcSpanEndColumn - 1)+ return (srcSpanStartLine-1 + delta,e1,srcSpanEndLine-1 + delta,e2)+ else return (srcSpanStartLine-1 + delta,srcSpanStartColumn-1,srcSpanEndLine-1 + delta,srcSpanEndColumn-1)+ i1 <- getIterAtLine ebuf lineS'+ i1' <- forwardCharsC i1 columnS'+ i2 <- getIterAtLine ebuf lineE'+ i2' <- forwardCharsC i2 columnE'+ candy <- readIDE candy+ check <- getCandylessPart candy ebuf i1' i2'+ if check == from+ then do+ beginUserAction ebuf+ delete ebuf i1' i2'+ editInsertCode ebuf i1' realString+ endUserAction ebuf+ return (True, delta + length (T.lines to) - length (T.lines from))+ else return (changed, delta)+ _ -> return (changed, delta)+replaceHLintSource x _ = return x+
src/IDE/ImportTool.hs view
@@ -30,6 +30,7 @@ import Text.PrettyPrint (render) import Distribution.Text (simpleParse, display, disp) import IDE.Pane.SourceBuffer+import IDE.HLint (resolveActiveHLint) import Graphics.UI.Gtk import IDE.Utils.GUIUtils import Text.ParserCombinators.Parsec.Language (haskellStyle)
src/IDE/Leksah.hs view
@@ -215,8 +215,9 @@ startGUI yiConfig sessionFP mbWorkspaceFP sourceFPs iprefs isFirstStart = Yi.start yiConfig $ \yiControl -> do st <- unsafeInitGUIForThreadedRTS- when rtsSupportsBoundThreads- (sysMessage Normal "Linked with -threaded")+ when rtsSupportsBoundThreads $ do+ setNumCapabilities 2+ sysMessage Normal "Linked with -threaded" timeout <- timeoutAddFull (yield >> return True) priorityLow 10 mbScreen <- screenGetDefault case mbScreen of@@ -390,6 +391,7 @@ , yiControl = yiControl , serverQueue = Nothing , server = Nothing+ , hlintQueue = Nothing , vcsData = (Map.empty, Nothing) , logLaunches = Map.empty , autoCommand = return ()
src/IDE/LogRef.hs view
@@ -72,7 +72,7 @@ import qualified Data.Text as T (length, stripPrefix, isPrefixOf, unpack, unlines, pack, null) import Data.Monoid ((<>))-import qualified Data.Set as S (member, insert, empty)+import qualified Data.Set as S (notMember, member, insert, empty) import Data.Set (Set) import System.FilePath.Windows ((</>)) @@ -81,16 +81,12 @@ selectRef :: Maybe LogRef -> IDEAction selectRef (Just ref) = do- logRefs <- readIDE allLogRefs- case elemIndex ref logRefs of- Nothing -> liftIO . void $ debugM "leksah" "no index"- Just index -> do- mbBuf <- selectSourceBuf (logRefFullFilePath ref)- case mbBuf of- Just buf -> markRefInSourceBuf buf ref True- Nothing -> liftIO . void $ debugM "leksah" "no buf"- log :: Log.IDELog <- Log.getLog- Log.markErrorInLog log (logLines ref)+ mbBuf <- selectSourceBuf (logRefFullFilePath ref)+ case mbBuf of+ Just buf -> markRefInSourceBuf buf ref True+ Nothing -> liftIO . void $ debugM "leksah" "no buf"+ log :: Log.IDELog <- Log.getLog+ maybe (return ()) (Log.markErrorInLog log) (logLines ref) selectRef Nothing = return () forOpenLogRefs :: (LogRef -> IDEBuffer -> IDEAction) -> IDEAction@@ -114,17 +110,6 @@ buf <- getBuffer sv removeTagByName buf (T.pack $ show (logRefType logRef)) -setErrorList :: [LogRef] -> IDEAction-setErrorList errs = do- unmarkLogRefs- breaks <- readIDE breakpointRefs- contexts <- readIDE contextRefs- modifyIDE_ (\ide -> ide{allLogRefs = errs ++ breaks ++ contexts})- setCurrentError Nothing- markLogRefs- triggerEventIDE ErrorChanged- return ()- setBreakpointList :: [LogRef] -> IDEAction setBreakpointList breaks = do ideR <- ask@@ -149,104 +134,47 @@ triggerEventIDE TraceChanged return () +next :: (IDE -> [LogRef])+ -> (IDE -> Maybe LogRef)+ -> (Maybe LogRef -> IDEAction)+ -> IDEAction+next all current set = do+ all <- readIDE all+ current <- readIDE current+ let isCurrent = (== current) . Just+ case dropWhile isCurrent (dropWhile (not . isCurrent) all) <> all of+ (n:_) -> do+ set (Just n)+ selectRef (Just n)+ _ -> return ()+ nextError :: IDEAction-nextError = do- errs <- readIDE errorRefs- currentError <- readIDE currentError- unless (null errs) $- do let new- = case currentError of- Nothing -> 0- Just ref -> case elemIndex ref errs of- Nothing -> 0- Just n | (n + 1) < length errs -> n + 1- Just n -> n- setCurrentError (Just $ errs !! new)- selectRef $ Just (errs !! new)+nextError = next errorRefs currentError setCurrentError previousError :: IDEAction-previousError = do- errs <- readIDE errorRefs- currentError <- readIDE currentError- unless (null errs) $- do let new- = case currentError of- Nothing -> length errs - 1- Just ref -> case elemIndex ref errs of- Nothing -> length errs - 1- Just n | n > 0 -> n - 1- Just n -> 0- setCurrentError (Just $ errs !! new)- selectRef $ Just (errs !! new)+previousError = next (reverse . errorRefs) currentError setCurrentError nextBreakpoint :: IDEAction-nextBreakpoint = do- breaks <- readIDE breakpointRefs- currentBreak <- readIDE currentBreak- unless (null breaks) $- do let new- = case currentBreak of- Nothing -> 0- Just ref -> case elemIndex ref breaks of- Nothing -> 0- Just n | (n + 1) < length breaks -> n + 1- Just n -> n- setCurrentBreak (Just $ breaks !! new)- selectRef $ Just (breaks !! new)+nextBreakpoint = next breakpointRefs currentBreak setCurrentBreak previousBreakpoint :: IDEAction-previousBreakpoint = do- breaks <- readIDE breakpointRefs- currentBreak <- readIDE currentBreak- unless (null breaks) $- do let new- = case currentBreak of- Nothing -> length breaks - 1- Just ref -> case elemIndex ref breaks of- Nothing -> length breaks - 1- Just n | n > 0 -> n - 1- Just n -> 0- setCurrentBreak (Just $ breaks !! new)- selectRef $ Just (breaks !! new)+previousBreakpoint = next (reverse . breakpointRefs) currentBreak setCurrentBreak nextContext :: IDEAction-nextContext = do- contexts <- readIDE contextRefs- currentContext <- readIDE currentContext- unless (null contexts) $- do let new- = case currentContext of- Nothing -> 0- Just ref -> case elemIndex ref contexts of- Nothing -> 0- Just n | (n + 1) < length contexts -> n + 1- Just n -> n- setCurrentContext (Just $ contexts !! new)- selectRef $ Just (contexts !! new)+nextContext = next contextRefs currentContext setCurrentContext previousContext :: IDEAction-previousContext = do- contexts <- readIDE contextRefs- currentContext <- readIDE currentContext- unless (null contexts) $- do let new- = case currentContext of- Nothing -> length contexts - 1- Just ref -> case elemIndex ref contexts of- Nothing -> length contexts - 1- Just n | n > 0 -> n - 1- Just n -> 0- setCurrentContext (Just $ contexts !! new)- selectRef $ Just (contexts !! new)+previousContext = next (reverse . contextRefs) currentContext setCurrentContext lastContext :: IDEAction lastContext = do contexts <- readIDE contextRefs currentContext <- readIDE currentContext- unless (null contexts) $ do- let new = last contexts- setCurrentContext (Just new)- selectRef $ Just new+ case reverse contexts of+ (l:_) -> do+ setCurrentContext $ Just l+ selectRef $ Just l+ _ -> return () fixColumn c = max 0 (c - 1) @@ -503,7 +431,7 @@ -> Bool -> C.Sink ToolOutput IDEM [LogRef] logOutputForBuild package backgroundBuild jumpToWarnings = do- liftIO $ putStrLn "logOutputForBuild"+ liftIO $ debugM "leksah" "logOutputForBuild" log <- lift getLog logLaunch <- lift Log.getDefaultLogLaunch BuildOutputState {..} <- CL.foldM (readAndShow logLaunch) $ initialState log@@ -541,7 +469,7 @@ sysMessage Normal . T.pack $ show e return state { inError = False } (Right ne@(ErrorLine span refType str),_) -> do- let ref = LogRef span package str Nothing (lineNr,lineNr) refType+ let ref = LogRef span package str Nothing (Just (lineNr,lineNr)) refType root = logRefRootPath ref file = logRefFilePath ref fullFilePath = logRefFullFilePath ref@@ -552,22 +480,22 @@ , errs = ref:errs , filesCompiled = S.insert fullFilePath filesCompiled }- (Right (OtherLine str1), ref@(LogRef span rootPath str Nothing (l1,l2) refType):tl) ->+ (Right (OtherLine str1), ref@(LogRef span rootPath str Nothing (Just (l1,l2)) refType):tl) -> if inError then return state { errs = LogRef span rootPath (if T.null str then line else str <> "\n" <> line) Nothing- (l1, lineNr)+ (Just (l1, lineNr)) refType : tl } else return state- (Right (WarningLine str1),LogRef span rootPath str Nothing (l1, l2) isError : tl) ->+ (Right (WarningLine str1),LogRef span rootPath str Nothing (Just (l1, l2)) isError : tl) -> if inError then return state { errs = LogRef span rootPath (if T.null str then line else str <> "\n" <> line) Nothing- (l1, lineNr)+ (Just (l1, lineNr)) WarningRef : tl }@@ -594,14 +522,14 @@ , testFails = LogRef span package exp- Nothing (logLn,logLn) TestFailureRef : testFails+ Nothing (Just (logLn,logLn)) TestFailureRef : testFails }- (_, True, LogRef span rootPath str Nothing (l1, l2) refType : tl) -> do+ (_, True, LogRef span rootPath str Nothing (Just (l1, l2)) refType : tl) -> do logLn <- Log.appendLog log logLaunch (line <> "\n") ErrorTag return state { testFails = LogRef span rootPath (str <> "\n" <> line)- Nothing (l1,logLn) TestFailureRef : tl+ Nothing (Just (l1,logLn)) TestFailureRef : tl } _ -> do Log.appendLog log logLaunch (line <> "\n") LogTag@@ -648,7 +576,7 @@ logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag case parse breaksLineParser "" $ T.unpack line of Right (BreakpointDescription n span) ->- return $ Just $ LogRef span package line Nothing (logLineNumber, logLineNumber) BreakpointRef+ return $ Just $ LogRef span package line Nothing (Just (logLineNumber, logLineNumber)) BreakpointRef _ -> return Nothing _ -> do defaultLineLogger log logLaunch out@@ -665,7 +593,7 @@ logLineNumber <- liftIO $ Log.appendLog log logLaunch (line <> "\n") LogTag case parse setBreakpointLineParser "" $ T.unpack line of Right (BreakpointDescription n span) ->- return $ Just $ LogRef span package line Nothing (logLineNumber, logLineNumber) BreakpointRef+ return $ Just $ LogRef span package line Nothing (Just (logLineNumber, logLineNumber)) BreakpointRef _ -> return Nothing _ -> do defaultLineLogger log logLaunch out@@ -690,7 +618,7 @@ let contexts = getContexts line if null contexts then return Nothing- else return $ Just $ LogRef (last contexts) package line Nothing (logLineNumber, logLineNumber) ContextRef+ else return $ Just $ LogRef (last contexts) package line Nothing (Just (logLineNumber, logLineNumber)) ContextRef _ -> do defaultLineLogger log logLaunch out return Nothing)
src/IDE/Pane/Errors.hs view
@@ -1,3 +1,5 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE FlexibleInstances, TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable, OverloadedStrings #-} -----------------------------------------------------------------------------@@ -20,34 +22,37 @@ , fillErrorList , selectError , getErrors+, selectMatchingErrors ) where import Graphics.UI.Gtk-import Data.Typeable (Typeable(..))+import Data.Typeable (Typeable) import IDE.Core.State-import Graphics.UI.Gtk.General.Enums- (Click(..), MouseButton(..))-import Graphics.UI.Gtk.Gdk.Events (Event(..)) import IDE.ImportTool (addResolveMenuItems, resolveErrors) import Data.List (elemIndex) import IDE.LogRef (showSourceSpan) import Control.Monad.IO.Class (MonadIO(..))-import IDE.Utils.GUIUtils (treeViewContextMenu, __)-import Data.Maybe (isJust)-import Control.Monad (when)+import IDE.Utils.GUIUtils (getDarkState, treeViewContextMenu, __) import Data.Text (Text)-import qualified Data.Text as T (unpack)+import Control.Monad (void, when, forM_)+import qualified Data.Text as T+ (intercalate, lines, takeWhile, length, drop)+import Data.IORef (writeIORef, readIORef, newIORef, IORef)+import Data.Maybe (isNothing) -- | A breakpoints pane description -- data IDEErrors = IDEErrors { scrolledView :: ScrolledWindow , treeView :: TreeView-, errorStore :: TreeStore ErrColumn+, errorStore :: ListStore ErrColumn+, autoClose :: IORef Bool -- If the pane was only displayed to show current error } deriving Typeable -data ErrColumn = ErrColumn {logRef :: LogRef, text :: Text, index :: Int}+data ErrColumn = ErrColumn {+ logRef :: LogRef,+ background :: Text} data ErrorsState = ErrorsState { } deriving(Eq,Ord,Read,Show,Typeable)@@ -56,106 +61,112 @@ where primPaneName _ = __ "Errors" getTopWidget = castToWidget . scrolledView- paneId b = "*Errors"+ paneId _b = "*Errors" instance RecoverablePane IDEErrors ErrorsState IDEM where- saveState p = return (Just ErrorsState)- recoverState pp ErrorsState = do- nb <- getNotebook pp- p <- buildPane pp nb builder- fillErrorList- return p+ saveState _p = return (Just ErrorsState)+ recoverState pp ErrorsState = do nb <- getNotebook pp+ buildPane pp nb builder builder = builder' builder' :: PanePath -> Notebook -> Window -> IDEM (Maybe IDEErrors, Connections)-builder' pp nb windows = reifyIDE $ \ ideR -> do- errorStore <- treeStoreNew []- treeView <- treeViewNew+builder' _pp _nb _windows = reifyIDE $ \ ideR -> do+ errorStore <- listStoreNew []+ treeView <- treeViewNew treeViewSetModel treeView errorStore rendererA <- cellRendererTextNew colA <- treeViewColumnNew- treeViewColumnSetTitle colA (__ "Location")+ treeViewColumnSetTitle colA (__ "Description") treeViewColumnSetSizing colA TreeViewColumnAutosize treeViewColumnSetResizable colA True treeViewColumnSetReorderable colA True treeViewAppendColumn treeView colA cellLayoutPackStart colA rendererA False cellLayoutSetAttributes colA rendererA errorStore- $ \row -> [cellText := if index row == 0 then showSourceSpan (logRef row) else "",- cellTextForeground := case logRefType (logRef row) of- WarningRef -> "orange" :: Text- LintRef -> "green"- _ -> "red" ]+ $ \row -> [cellText := removeIndentation (refDescription (logRef row)),+ cellTextBackground := background row ] rendererB <- cellRendererTextNew colB <- treeViewColumnNew- treeViewColumnSetTitle colB (__ "Description")+ treeViewColumnSetTitle colB (__ "Location") treeViewColumnSetSizing colB TreeViewColumnAutosize treeViewColumnSetResizable colB True treeViewColumnSetReorderable colB True treeViewAppendColumn treeView colB cellLayoutPackStart colB rendererB False cellLayoutSetAttributes colB rendererB errorStore- $ \row -> [ cellText := text row]-- treeViewSetHeadersVisible treeView True+ $ \row -> [ cellText := showSourceSpan (logRef row),+ cellTextBackground := background row ]+ treeViewSetHeadersVisible treeView False selB <- treeViewGetSelection treeView- treeSelectionSetMode selB SelectionSingle+ treeSelectionSetMode selB SelectionMultiple scrolledView <- scrolledWindowNew Nothing Nothing scrolledWindowSetShadowType scrolledView ShadowIn containerAdd scrolledView treeView scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic- let pane = IDEErrors scrolledView treeView errorStore+ autoClose <- newIORef False+ let pane = IDEErrors {..} cid1 <- after treeView focusInEvent $ do liftIO $ reflectIDE (makeActive pane) ideR return True (cid2, cid3) <- treeViewContextMenu treeView $ errorsContextMenu ideR errorStore treeView cid4 <- treeView `on` rowActivated $ errorsSelect ideR errorStore+ reflectIDE (fillErrorList' pane) ideR return (Just pane, map ConnectC [cid1, cid2, cid3, cid4]) +removeIndentation t = T.intercalate "\n" $ map (T.drop minIndent) l+ where+ l = T.lines t+ minIndent = minimum $ map (T.length . T.takeWhile (== ' ')) l+ getErrors :: Maybe PanePath -> IDEM IDEErrors getErrors Nothing = forceGetPane (Right "*Errors") getErrors (Just pp) = forceGetPane (Left pp) fillErrorList :: IDEAction-fillErrorList = do- mbErrors <- getPane- case mbErrors of- Nothing -> return ()- Just pane -> do- refs <- readIDE errorRefs- liftIO $ do- treeStoreClear (errorStore pane)- mapM_ (insertError (errorStore pane)) (zip refs [0..length refs])- where- insertError treeStore (lr,index) =- case {--lines--} [refDescription lr] of- [] -> treeStoreInsert treeStore [] index (ErrColumn lr "" 0)- h:t -> do- treeStoreInsert treeStore [] index (ErrColumn lr h 0)- mapM_ (\(line,subind) ->- treeStoreInsert treeStore [index] subind (ErrColumn lr line (subind + 1)))- (zip t [0..length t])+fillErrorList = getPane >>= maybe (return ()) fillErrorList' +fillErrorList' :: IDEErrors -> IDEAction+fillErrorList' pane = do+ refs <- readIDE errorRefs+ ac <- liftIO $ readIORef (autoClose pane)+ when (null refs && ac) . void $ closePane pane+ isDark <- getDarkState+ liftIO $ do+ let store = errorStore pane+ listStoreClear store+ forM_ (zip refs [0..]) $ \ (lr, index) ->+ listStoreInsert store index $ ErrColumn lr (+ (if even index then fst else snd) $+ (if isDark then fst else snd) $+ case logRefType lr of+ WarningRef -> (("#282000", "#201900"), ("#FFF1DE", "#FFF5E8"))+ LintRef -> (("#003000", "#002800"), ("#DBFFDB", "#EDFFED"))+ _ -> (("#380000", "#280000"), ("#FFDEDE", "#FFEBEB")))+ getSelectedError :: TreeView- -> TreeStore ErrColumn+ -> ListStore ErrColumn -> IO (Maybe LogRef)-getSelectedError treeView treeStore = do+getSelectedError treeView store = do treeSelection <- treeViewGetSelection treeView paths <- treeSelectionGetSelectedRows treeSelection case paths of- a:r -> do- val <- treeStoreGetValue treeStore a+ [a]:r -> do+ val <- listStoreGetValue store a return (Just (logRef val)) _ -> return Nothing selectError :: Maybe LogRef -> IDEAction selectError mbLogRef = do+ (mbPane :: Maybe IDEErrors) <- getPane errorRefs' <- readIDE errorRefs errors <- getErrors Nothing+ when (isNothing mbPane) $ do+ liftIO $ writeIORef (autoClose errors) True+ displayPane errors False liftIO $ do selection <- treeViewGetSelection (treeView errors) case mbLogRef of@@ -165,7 +176,7 @@ Just ind -> treeSelectionSelectPath selection [ind] errorsContextMenu :: IDERef- -> TreeStore ErrColumn+ -> ListStore ErrColumn -> TreeView -> Menu -> IO ()@@ -179,15 +190,40 @@ Nothing -> return () errorsSelect :: IDERef- -> TreeStore ErrColumn+ -> ListStore ErrColumn -> TreePath -> TreeViewColumn -> IO ()-errorsSelect ideR store path _ = do- ref <- treeStoreGetValue store path+errorsSelect ideR store [index] _ = do+ ref <- listStoreGetValue store index reflectIDE (setCurrentError (Just (logRef ref))) ideR--+errorsSelect _ _ _ _ = return () +selectMatchingErrors :: Maybe SrcSpan -> IDEM ()+selectMatchingErrors mbSpan = do+ mbErrors <- getPane+ case mbErrors of+ Nothing -> return ()+ Just pane ->+ liftIO $ do+ treeSel <- treeViewGetSelection (treeView pane)+ case mbSpan of+ Nothing -> treeSelectionUnselectAll treeSel+ Just (SrcSpan file lStart cStart lEnd cEnd) -> do+ size <- listStoreGetSize (errorStore pane)+ forM_ (take size [0..]) $ \ n -> do+ mbIter <- treeModelGetIter (errorStore pane) [n]+ case mbIter of+ Nothing -> return ()+ Just iter -> do+ ErrColumn {logRef = ref@LogRef{..}} <- listStoreGetValue (errorStore pane) n+ isSelected <- treeSelectionIterIsSelected treeSel iter+ let shouldBeSel = file == logRefFullFilePath ref+ && (lStart, cStart) <= (srcSpanEndLine logRefSrcSpan,+ srcSpanEndColumn logRefSrcSpan)+ && (lEnd, cEnd) >= (srcSpanStartLine logRefSrcSpan,+ srcSpanStartColumn logRefSrcSpan)+ when (isSelected && not shouldBeSel) $ treeSelectionUnselectIter treeSel iter+ when (not isSelected && shouldBeSel) $ treeSelectionSelectIter treeSel iter
src/IDE/Pane/HLint.hs view
@@ -16,84 +16,26 @@ -- Stability : provisional -- Portability : portable ----- | The pane of ide where HLint results are displayed+-- | Deprecated. Kept in to make old session (.lkshs) files work. -- ----------------------------------------------------------------------------- module IDE.Pane.HLint (- IDEHLint(..)-, refreshHLint-, HLintState(..)-, getHLint+ HLintState(..) ) where --import Graphics.UI.Gtk hiding (get)-import qualified Graphics.UI.Gtk.Gdk.Events as Gdk-import Text.ParserCombinators.Parsec.Language-import Text.ParserCombinators.Parsec hiding(Parser)-import qualified Text.ParserCombinators.Parsec.Token as P-import Data.Maybe-import Data.Typeable-import IDE.Core.State hiding (SrcSpan(..))-import IDE.BufferMode-import IDE.LogRef (logOutput, defaultLineLogger)-import IDE.Pane.SourceBuffer- (hlintSettings, hlintBuffer, fileSave, goToSourceDefinition',- maybeActiveBuf, IDEBuffer(..), replaceHLintSource)-import IDE.TextEditor (TextEditor(..), grabFocus)-import Control.Applicative ((<$>))-import System.FilePath ((</>), dropFileName)-import System.Exit (ExitCode(..))-import IDE.Pane.Log (getLog)-import Control.Monad (forM, unless, void, forM_, foldM, when)-import Control.Monad.Trans.Reader (ask)-import Control.Monad.Trans.Class (MonadTrans(..))-import Control.Monad.IO.Class (MonadIO(..))-import Language.Haskell.Exts (SrcLoc(..))-import Language.Haskell.Exts.SrcLoc (SrcSpan(..))--import qualified Language.Haskell.HLint3 as H-import IDE.Utils.GUIUtils (__, treeViewContextMenu)-import Data.List (isPrefixOf, findIndex)-import Debug.Trace (trace)-import Control.Exception (SomeException, catch)-import Distribution.ModuleName (ModuleName)-import IDE.Metainfo.Provider (getWorkspaceInfo)-import qualified Data.Map as Map (keys, lookup)-import Distribution.Package (PackageIdentifier(..))+import Graphics.UI.Frame.Panes+ (RecoverablePane(..), RecoverablePane, Pane(..))+import Graphics.UI.Gtk.Display.Label (labelNew, Label)+import Data.Typeable (Typeable)+import IDE.Core.Types (IDEM)+import Graphics.UI.Gtk.Abstract.Widget (castToWidget)+import Graphics.UI.Frame.ViewFrame (getNotebook)+import IDE.Core.State (reifyIDE) import Data.Text (Text)-import qualified Data.Text as T- (replicate, unlines, init, lines, pack, unpack)-import Data.Monoid ((<>))-import qualified System.IO.Strict as S (readFile)-import Language.Haskell.HLint3- (CppFlags(..), defaultParseFlags, parseFlagsAddFixities,- resolveHints, readSettingsFile, findSettings, ParseFlags(..))-import Language.Preprocessor.Cpphs- (runCpphsReturningSymTab, defaultCpphsOptions, CpphsOptions(..))-import System.Log.Logger (debugM)-import System.Directory (doesFileExist)-import qualified System.IO as S (writeFile)-import System.Glib.GTypeConstants (flags) -data HLintRecord = HLintRecord {- condPackage :: Maybe IDEPackage- , context :: Text- , condIdea :: Maybe H.Idea- , parDir :: Maybe FilePath- } deriving (Eq)--isDir HLintRecord{parDir = Nothing} = True-isDir otherwies = False---- | A HLint pane description---- data IDEHLint = IDEHLint {- scrolledView :: ScrolledWindow-, treeView :: TreeView-, hlintStore :: TreeStore HLintRecord+ deprecatedLabel :: Label } deriving Typeable data HLintState = HLintState@@ -103,7 +45,7 @@ where primPaneName _ = "HLint" getAddedIndex _ = 0- getTopWidget = castToWidget . scrolledView+ getTopWidget = castToWidget . deprecatedLabel paneId b = "*HLint" instance RecoverablePane IDEHLint HLintState IDEM where@@ -112,221 +54,5 @@ nb <- getNotebook pp buildPane pp nb builder builder pp nb windows = reifyIDE $ \ ideR -> do- hlintStore <- treeStoreNew []- treeView <- treeViewNew- treeViewSetModel treeView hlintStore-- renderer1 <- cellRendererTextNew- renderer10 <- cellRendererPixbufNew- col1 <- treeViewColumnNew- treeViewColumnSetTitle col1 (__ "Context")- treeViewColumnSetSizing col1 TreeViewColumnAutosize- treeViewColumnSetResizable col1 True- treeViewColumnSetReorderable col1 True- treeViewAppendColumn treeView col1- cellLayoutPackStart col1 renderer10 False- cellLayoutPackStart col1 renderer1 True- cellLayoutSetAttributes col1 renderer1 hlintStore- $ \row -> [ cellText := context row ]-- treeViewSetHeadersVisible treeView False- sel <- treeViewGetSelection treeView- treeSelectionSetMode sel SelectionSingle-- scrolledView <- scrolledWindowNew Nothing Nothing- scrolledWindowSetShadowType scrolledView ShadowIn- containerAdd scrolledView treeView- scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic-- let hlint = IDEHLint {..}- cid1 <- after treeView focusInEvent $ do- liftIO $ reflectIDE (makeActive hlint) ideR- return True- cid2 <- on treeView rowExpanded $ \ iter path -> do- record <- treeStoreGetValue hlintStore path- case record of- HLintRecord { condPackage = Just p, parDir = Nothing } ->- reflectIDE (refreshDir hlintStore iter p) ideR- _ -> reflectIDE (ideMessage Normal (__ "Unexpected Expansion in HLint Pane")) ideR- cid3 <- on treeView rowActivated $ \ path col -> do- record <- treeStoreGetValue hlintStore path- mbIter <- treeModelGetIter hlintStore path- case (mbIter, record) of- (Just iter, HLintRecord { condPackage = Just p, parDir = Nothing }) ->- reflectIDE (refreshDir hlintStore iter p) ideR- _ -> return ()- cid4 <- on treeView keyPressEvent $ do- name <- eventKeyName- liftIO $ case name of- "Return" -> reflectIDE (gotoSource True treeView hlintStore) ideR- "Escape" -> do- reflectIDE (do- lastActiveBufferPane ?>>= \paneName -> do- (PaneC pane) <- paneFromName paneName- makeActive pane- return ()- triggerEventIDE StartFindInitial) ideR- return True- -- gotoSource True- _ -> return False- on sel treeSelectionSelectionChanged (reflectIDE (void $ gotoSource False treeView hlintStore) ideR)-- return (Just hlint,map ConnectC [cid1])--getHLint :: Maybe PanePath -> IDEM IDEHLint-getHLint Nothing = forceGetPane (Right "*HLint")-getHLint (Just pp) = forceGetPane (Left pp)--data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound--find :: Eq a => a -> TreeStore a -> Maybe TreeIter -> IO FindResult-find _ _ Nothing = return NotFound-find a store (Just iter) = do- row <- treeModelGetRow store iter- if row == a- then return $ WhereExpected iter- else treeModelIterNext store iter >>= find'- where- find' :: Maybe TreeIter -> IO FindResult- find' Nothing = return NotFound- find' (Just iter) = do- row <- treeModelGetRow store iter- if row == a- then return $ Found iter- else treeModelIterNext store iter >>= find'--removeUntil :: Eq a => a -> TreeStore a -> TreePath -> IO ()-removeUntil a store path = do- row <- treeStoreGetValue store path- when (row /= a) $ do- found <- treeStoreRemove store path- when found $ removeUntil a store path--removeRemaining :: TreeStore a -> TreePath -> IO ()-removeRemaining store path = do- found <- treeStoreRemove store path- when found $ removeRemaining store path---getSelectionHLintRecord :: TreeView- -> TreeStore HLintRecord- -> IO (Maybe HLintRecord)-getSelectionHLintRecord treeView hlintStore = do- treeSelection <- treeViewGetSelection treeView- paths <- treeSelectionGetSelectedRows treeSelection- case paths of- p:_ -> Just <$> treeStoreGetValue hlintStore p- _ -> return Nothing--refreshHLint :: WorkspaceAction-refreshHLint = do- ws <- ask- maybeActive <- lift $ readIDE activePack- let packages = case maybeActive of- Just active -> active : filter (/= active) (wsAllPackages ws)- Nothing -> wsAllPackages ws- lift $ hlintDirectories2 packages-----gotoSource :: Bool -> IDEM Bool-gotoSource focus treeView hlintStore = do- sel <- liftIO $ getSelectionHLintRecord treeView hlintStore- case sel of- Just record ->- case record of- HLintRecord {condIdea = Just idea} ->- goToSourceDefinition' (srcSpanFilename (H.ideaSpan idea))- (Location "" (srcSpanStartLine (H.ideaSpan idea))- (srcSpanStartColumn (H.ideaSpan idea))- (srcSpanEndLine (H.ideaSpan idea))- (srcSpanEndColumn (H.ideaSpan idea)))- ?>>= (\buf@IDEBuffer {sourceView = sv} -> do- hlintBuffer buf- when focus $ grabFocus sv)- _ -> return ()- Nothing -> return ()- return True---hlintDirectories2 :: [IDEPackage] -> IDEAction-hlintDirectories2 packages = do- hlint <- getHLint Nothing- let store = hlintStore hlint- liftIO $ do- treeStoreClear store- forM_ packages $ \ p -> do- nDir <- treeModelIterNChildren store Nothing- treeStoreInsert store [] nDir $ HLintRecord (Just p) (packageIdentifierToString (ipdPackageId p)) Nothing Nothing- treeStoreInsert store [nDir] 0 $ HLintRecord (Just p) (packageIdentifierToString (ipdPackageId p)) Nothing Nothing--refreshDir :: TreeStore HLintRecord -> TreeIter -> IDEPackage -> IDEM ()-refreshDir store iter package = do- ideR <- ask- (flags, classify, hint) <- hlintSettings package- let modules = Map.keys (ipdModules package)- paths <- getSourcePaths (ipdPackageId package) modules- res <- forM paths $ \ file -> do- str <- liftIO $ S.readFile file- liftIO . debugM "leksah" $ "refreshDir hlint parsing " <> file- do result <- liftIO $ H.parseModuleEx flags file (Just str)- case result of- Left e -> do ideMessage Normal . T.pack $- "can't parse: " <> H.parseErrorContents e <> " location " <>- show (H.parseErrorLocation e)- return Nothing- Right r -> do liftIO . debugM "leksah" $- "refreshDir hlint parsed " <> file- return $ Just r- `catchIDE` (\(e :: SomeException) -> do- reflectIDE (ideMessage Normal . T.pack $ show e) ideR- return Nothing)- liftIO $ debugM "leksah" "refreshDir hlint parse complete"- let ideas = H.applyHints classify hint (catMaybes res)- liftIO $ setHLint2Results store iter (T.unpack $ packageIdentifierToString (ipdPackageId package)) ideas- return ()---getSourcePaths :: PackageIdentifier -> [ModuleName] -> IDEM [FilePath]-getSourcePaths packId names = do- mbWorkspaceInfo <- getWorkspaceInfo- case mbWorkspaceInfo of- Nothing -> return []- Just (sc, _) -> return (mapMaybe (sourcePathFromScope sc) names)- where- sourcePathFromScope :: GenScope -> ModuleName -> Maybe FilePath- sourcePathFromScope (GenScopeC (PackScope l _)) mn =- case packId `Map.lookup` l of- Just pack ->- case filter (\md -> modu (mdModuleId md) == mn)- (pdModules pack) of- (mod : tl) -> mdMbSourcePath mod- [] -> Nothing- Nothing -> Nothing---hlint2Record dir idea = HLintRecord {- condPackage = Nothing,- context = T.pack $ show idea,- condIdea = Just idea,- parDir = Just dir}--setHLint2Results :: TreeStore HLintRecord -> TreeIter -> FilePath -> [H.Idea] -> IO Int-setHLint2Results store parent dir ideas = do- liftIO $ debugM "leksah" "setHLint2Results"- parentPath <- treeModelGetPath store parent- forM_ (zip [0..] records) $ \(n, record) -> do- mbChild <- treeModelIterNthChild store (Just parent) n- findResult <- find record store mbChild- case (mbChild, findResult) of- (_, WhereExpected _) -> return ()- (Just iter, Found _) -> do- path <- treeModelGetPath store iter- removeUntil record store path- _ -> treeStoreInsert store parentPath n record- liftIO $ debugM "leksah" "setHLint2Results removing remaining records"- removeRemaining store (parentPath++[nRecords])- return nRecords- where- records = map (hlint2Record dir) ideas- nRecords = length records-+ deprecatedLabel <- labelNew $ Just ("HLint has moved to the Errors pane and Package -> HLint menu item"::Text)+ return (Just IDEHLint {..}, [])
src/IDE/Pane/Log.hs view
@@ -408,18 +408,18 @@ (_,y') <- textViewWindowToBufferCoords tv TextWindowWidget (x,y) (iter,_) <- textViewGetLineAtY tv y' textIterGetLine iter- case filter (\es -> fst (logLines es) <= (line'+1) && snd (logLines es) >= (line'+1)) logRefs' of- [thisRef] -> do+ case [(s,e,es) | es@LogRef{logLines = Just (s, e)} <- logRefs', s <= (line'+1) && e >= (line'+1)] of+ [(s,e,thisRef)] -> do mbBuf <- selectSourceBuf (logRefFullFilePath thisRef) case mbBuf of Just buf -> markRefInSourceBuf buf thisRef True Nothing -> return () log :: IDELog <- getLog- markErrorInLog log (logLines thisRef)+ markErrorInLog log (s, e) case logRefType thisRef of BreakpointRef -> setCurrentBreak (Just thisRef) _ -> setCurrentError (Just thisRef)- otherwise -> return ()+ _ -> return () clicked _ _ _ _ _ = return () populatePopupMenu :: IDELog -> IDERef -> Menu -> IO ()@@ -438,10 +438,9 @@ (_,y') <- textViewWindowToBufferCoords tv TextWindowWidget (x,y) (iter,_) <- textViewGetLineAtY tv y' textIterGetLine iter- return $ filter (\(es,_) -> fst (logLines es) <= (line'+1) && snd (logLines es) >= (line'+1))- (zip logRefs' [0..(length logRefs')])) ideR+ return [es | es@LogRef{logLines = Just (s, e)} <- logRefs', s <= (line'+1) && e >= (line'+1)]) ideR case res of- [(thisRef,n)] -> do+ [thisRef] -> do addResolveMenuItems ideR menu thisRef widgetShowAll menu return ()@@ -516,7 +515,8 @@ log <- getLog buf <- liftIO $ textViewGetBuffer $ logLaunchTextView log liftIO $ textBufferSetText buf ("" :: Text)--- modifyIDE_ (\ide -> ide{allLogRefs = []})--- setCurrentError Nothing--- setCurrentBreak Nothing TODO: Check with Hamish+ modifyIDE_ (\ide -> ide{allLogRefs = []})+ setCurrentError Nothing+ setCurrentBreak Nothing+
src/IDE/Pane/Preferences.hs view
@@ -365,63 +365,103 @@ (paraName <<<- ParaName (__ "Found Text Background") $ emptyParams) (PP.text . show) colorParser- foundBackground- (\ b a -> a{foundBackground = b})+ foundBackgroundLight+ (\ b a -> a{foundBackgroundLight = b}) colorEditor (\c -> do buffers <- allBuffers- forM_ buffers $ \(IDEBuffer {sourceView = sv}) -> do- ebuf <- getBuffer sv- tagTable <- getTagTable ebuf- mbTag <- lookupTag tagTable "found"- case mbTag of- Just tag -> background tag c- Nothing -> return ())+ mapM_ updateStyle' buffers) , mkFieldPP (paraName <<<- ParaName (__ "Selection Match Text Background") $ emptyParams) (PP.text . show) colorParser- matchBackground- (\ b a -> a{matchBackground = b})+ matchBackgroundLight+ (\ b a -> a{matchBackgroundLight = b}) colorEditor (\c -> do buffers <- allBuffers- forM_ buffers $ \(IDEBuffer {sourceView = sv}) -> do- ebuf <- getBuffer sv- tagTable <- getTagTable ebuf- mbTag <- lookupTag tagTable "match"- case mbTag of- Just tag -> background tag c- Nothing -> return ())+ mapM_ updateStyle' buffers) , mkFieldPP (paraName <<<- ParaName (__ "Execution Context Text Background") $ emptyParams) (PP.text . show) colorParser- contextBackground- (\ b a -> a{contextBackground = b})+ contextBackgroundLight+ (\ b a -> a{contextBackgroundLight = b}) colorEditor (\c -> do buffers <- allBuffers- forM_ buffers $ \(IDEBuffer {sourceView = sv}) -> do- ebuf <- getBuffer sv- tagTable <- getTagTable ebuf- -- TODO find and set the tag background- return ())+ mapM_ updateStyle' buffers) , mkFieldPP (paraName <<<- ParaName (__ "Breakpoint Text Background") $ emptyParams) (PP.text . show) colorParser- breakpointBackground- (\ b a -> a{breakpointBackground = b})+ breakpointBackgroundLight+ (\ b a -> a{breakpointBackgroundLight = b}) colorEditor (\c -> do buffers <- allBuffers- forM_ buffers $ \(IDEBuffer {sourceView = sv}) -> do- ebuf <- getBuffer sv- tagTable <- getTagTable ebuf- -- TODO find and set the tag background- return ())+ mapM_ updateStyle' buffers) , mkFieldPP+ (paraName <<<- ParaName (__ "Lint Text Background") $ emptyParams)+ (PP.text . show)+ colorParser+ lintBackgroundLight+ (\ b a -> a{lintBackgroundLight = b})+ colorEditor+ (\c -> do+ buffers <- allBuffers+ mapM_ updateStyle' buffers)+ , mkFieldPP+ (paraName <<<- ParaName (__ "Found Text Dark Background") $ emptyParams)+ (PP.text . show)+ colorParser+ foundBackgroundDark+ (\ b a -> a{foundBackgroundDark = b})+ colorEditor+ (\c -> do+ buffers <- allBuffers+ mapM_ updateStyle' buffers)+ , mkFieldPP+ (paraName <<<- ParaName (__ "Selection Match Text Dark Background") $ emptyParams)+ (PP.text . show)+ colorParser+ matchBackgroundDark+ (\ b a -> a{matchBackgroundDark = b})+ colorEditor+ (\c -> do+ buffers <- allBuffers+ mapM_ updateStyle' buffers)+ , mkFieldPP+ (paraName <<<- ParaName (__ "Execution Context Text Dark Background") $ emptyParams)+ (PP.text . show)+ colorParser+ contextBackgroundDark+ (\ b a -> a{contextBackgroundDark = b})+ colorEditor+ (\c -> do+ buffers <- allBuffers+ mapM_ updateStyle' buffers)+ , mkFieldPP+ (paraName <<<- ParaName (__ "Breakpoint Text Dark Background") $ emptyParams)+ (PP.text . show)+ colorParser+ breakpointBackgroundDark+ (\ b a -> a{breakpointBackgroundDark = b})+ colorEditor+ (\c -> do+ buffers <- allBuffers+ mapM_ updateStyle' buffers)+ , mkFieldPP+ (paraName <<<- ParaName (__ "Lint Text Dark Background") $ emptyParams)+ (PP.text . show)+ colorParser+ lintBackgroundDark+ (\ b a -> a{lintBackgroundDark = b})+ colorEditor+ (\c -> do+ buffers <- allBuffers+ mapM_ updateStyle' buffers)+ , mkFieldPP (paraName <<<- ParaName (__ "Automatically load modified files modified outside of Leksah") $ emptyParams) (PP.text . show) boolParser@@ -792,10 +832,16 @@ , removeTBlanks = True , textviewFont = Nothing , sourceStyle = (True,"leksah")- , foundBackground = Color 65535 65535 32768- , matchBackground = Color 32768 32768 32768- , contextBackground = Color 65535 49152 49152- , breakpointBackground = Color 65535 49152 32768+ , foundBackgroundLight = Color 65535 65535 32768+ , matchBackgroundLight = Color 42064 55923 28520+ , contextBackgroundLight = Color 65535 46529 46529+ , breakpointBackgroundLight = Color 64879 51921 28114+ , lintBackgroundLight = Color 60000 65535 60000+ , foundBackgroundDark = Color 30364 29149 0+ , matchBackgroundDark = Color 18021 29927 6384+ , contextBackgroundDark = Color 20000 16000 16000+ , breakpointBackgroundDark = Color 15000 5000 5000+ , lintBackgroundDark = Color 0 15000 0 , textEditorType = "GtkSourceView" , autoLoad = False , logviewFont = Nothing
src/IDE/Pane/SourceBuffer.hs view
@@ -32,7 +32,6 @@ , goToSourceDefinition' , goToDefinition , insertInBuffer-, replaceHLintSource , fileNew , fileOpenThis@@ -68,10 +67,8 @@ , updateStyle , updateStyle' , addLogRef+, removeLogRefs , removeBuildLogRefs-, resolveActiveHLint-, hlintSettings-, hlintBuffer , markRefInSourceBuf , inBufContext , inActiveBufContext@@ -87,8 +84,10 @@ , recentSourceBuffers , newTextBuffer , belongsToPackages+, belongsToPackage , belongsToWorkspace , getIdentifierUnderCursorFromIter+, useCandyFor ) where @@ -136,7 +135,7 @@ import IDE.BufferMode import Control.Monad.Trans.Reader (ask) import Control.Monad.IO.Class (MonadIO(..))-import Control.Monad (filterM, foldM, void, unless, when, liftM)+import Control.Monad (filterM, void, unless, when, liftM) import Control.Exception as E (catch, SomeException) import qualified IDE.Command.Print as Print@@ -144,22 +143,11 @@ import System.Log.Logger (debugM) import Data.Text (Text) import qualified Data.Text as T- (reverse, take, drop, init, length, findIndex, replicate, lines,+ (length, findIndex, replicate, lines, dropWhileEnd, unlines, strip, null, pack, unpack) import Data.Monoid ((<>)) import qualified Data.Text.IO as T (writeFile, readFile) import Data.Time (UTCTime(..))-import Control.Concurrent (forkIO)-import Language.Haskell.HLint3- (Hint(..), Classify(..), ParseError(..), Idea(..), Severity(..),- parseFlagsAddFixities, resolveHints, readSettingsFile,- findSettings, applyHints, defaultParseFlags, parseModuleEx,- ParseFlags(..), CppFlags(..))-import qualified Language.Haskell.Exts.SrcLoc as HSE- (SrcLoc(..), SrcSpan(..))-import Language.Preprocessor.Cpphs as Cpphs- (runCpphsReturningSymTab, defaultCpphsOptions, CpphsOptions(..))-import qualified System.IO.Strict as S (readFile) import Graphics.UI.Gtk.Gdk.EventM (eventModifier, eventKeyName, eventKeyVal) import Data.Foldable (forM_)@@ -235,7 +223,7 @@ buildPane panePath notebook builder = return Nothing builder pp nb w = return (Nothing,[]) -startComplete :: IDEAction+-- startComplete :: IDEAction startComplete = do mbBuf <- maybeActiveBuf currentState' <- readIDE currentState@@ -243,7 +231,7 @@ Nothing -> return () Just (IDEBuffer {sourceView=v}) -> complete v True -selectSourceBuf :: FilePath -> IDEM (Maybe IDEBuffer)+-- selectSourceBuf :: FilePath -> IDEM (Maybe IDEBuffer) selectSourceBuf fp = do fpc <- liftIO $ myCanonicalizePath fp buffers <- allBuffers@@ -336,47 +324,6 @@ Nothing -> return () return mbBuf -indentHLintText :: Int -> Text -> Text-indentHLintText startColumn text =- T.init $ T.unlines (take 1 lines <> drop 1 (map (indent <>) lines))- where- lines = T.lines text- indent = T.replicate startColumn " " --replaceHLintSource :: (Bool, Int) -> (Text, Idea) -> IDEM (Bool, Int)-replaceHLintSource (changed, delta) (from, Idea{ideaSpan = ideaSpan, ideaTo = Just ideaTo}) = do- let HSE.SrcSpan{..} = ideaSpan- to = indentHLintText (srcSpanStartColumn-1) (T.pack ideaTo)- liftIO . debugM "leksah" $ "replaceHLintSource From: " <> show from <> "\nreplaceHLintSource To: " <> show to- mbBuf <- selectSourceBuf srcSpanFilename- case mbBuf of- Just buf -> inActiveBufContext (changed, delta) $ \_ sv ebuf _ _ -> do- useCandy <- useCandyFor buf- candy' <- readIDE candy- realString <- if useCandy then stringToCandy candy' to else return to- (lineS', columnS', lineE', columnE') <- if useCandy- then do- (_,e1) <- positionToCandy candy' ebuf (srcSpanStartLine + delta, srcSpanStartColumn - 1)- (_,e2) <- positionToCandy candy' ebuf (srcSpanEndLine + delta, srcSpanEndColumn - 1)- return (srcSpanStartLine-1 + delta,e1,srcSpanEndLine-1 + delta,e2)- else return (srcSpanStartLine-1 + delta,srcSpanStartColumn-1,srcSpanEndLine-1 + delta,srcSpanEndColumn-1)- i1 <- getIterAtLine ebuf lineS'- i1' <- forwardCharsC i1 columnS'- i2 <- getIterAtLine ebuf lineE'- i2' <- forwardCharsC i2 columnE'- candy <- readIDE candy- check <- getCandylessPart candy ebuf i1' i2'- if check == from- then do- beginUserAction ebuf- delete ebuf i1' i2'- editInsertCode ebuf i1' realString- endUserAction ebuf- return (True, delta + length (T.lines to) - length (T.lines from))- else return (changed, delta)- _ -> return (changed, delta)-replaceHLintSource x _ = return x- insertInBuffer :: Descr -> IDEAction insertInBuffer idDescr = do mbPaneName <- lastActiveBufferPane@@ -416,9 +363,28 @@ removeBuildLogRefs :: FilePath -> FilePath -> IDEAction removeBuildLogRefs = removeLogRefs [ErrorRef, WarningRef, TestFailureRef] +-- | Test failures have the same imporance as errors so should be+-- sorted the same+importance :: LogRef -> LogRefType+importance LogRef{ logRefType = TestFailureRef } = ErrorRef+importance ref = logRefType ref+ addLogRef :: LogRef -> IDEAction addLogRef ref = do- modifyIDE_ (\ide -> ide{allLogRefs = allLogRefs ide <> [ref]})+ -- Put most important errors first.+ -- If the importance of two errors is the same then+ -- then the older one might be stale (unless it is in the same file)+ modifyIDE_ $ \ ide ->+ let (moreImportant, rest) =+ partition (\old -> importance old < importance ref -- Note: a low LogRefType is more important+ || (importance old == importance ref+ && logRefFullFilePath old == logRefFullFilePath ref)) (allLogRefs ide)+ currErr = if currentError ide `elem` map Just moreImportant+ then currentError ide+ else Nothing in+ ide{ allLogRefs = moreImportant <> [ref] <> rest+ , currentEBC = (currErr, currentBreak ide, currentContext ide)+ } buffers <- allBuffers let matchingBufs = filter (maybe False (equalFilePath (logRefFullFilePath ref)) . fileName) buffers@@ -543,13 +509,10 @@ _ -> newDefaultBuffer mbfn fileContents >>= makeBuffer modTime where+ makeBuffer :: TextEditor editor => Maybe UTCTime -> EditorBuffer editor -> IDEM (Maybe IDEBuffer,Connections) makeBuffer modTime buffer = do ideR <- ask - tagTable <- getTagTable buffer- foundTag <- newTag tagTable "found"- background foundTag $ foundBackground prefs- beginNotUndoableAction buffer let mod = modFromFileName mbfn when (bs && isHaskellMode mod) $ modeTransformToCandy mod@@ -606,32 +569,37 @@ sysMessage Normal "SourceBuffer>> no text popup" return [] - --TODO refactor this- ids5 <- onMotionNotifyEvent sv $ do- liftIDE $ do- candy' <- readIDE candy- inActiveBufContext () $ \_ _ ebuf currentBuffer _ -> do- let tagName = "match"- tagTable <- getTagTable ebuf- mbTag <- lookupTag tagTable tagName- case mbTag of- Just existingTag -> removeTagByName ebuf tagName- Nothing -> do- tag <- newTag tagTable tagName- background tag $ matchBackground prefs-- hasSelection <- hasSelection ebuf- when hasSelection $ do- (si1,si2) <- getSelectionBounds ebuf-- sTxt <- getCandylessPart candy' ebuf si1 si2- let strippedSTxt = T.strip sTxt- unless (T.null strippedSTxt) $- do bi1 <- getStartIter ebuf- bi2 <- getEndIter ebuf- forwardApplying bi1 strippedSTxt (Just si1) tagName ebuf- forwardApplying si2 strippedSTxt (Just bi2) tagName ebuf- return False+ hasMatch <- liftIO $ newIORef False+ ids5 <- onSelectionChanged buffer $ do+ (iStart, iEnd) <- getSelectionBounds buffer+ lStart <- (+1) <$> getLine iStart+ cStart <- getLineOffset iStart+ lEnd <- (+1) <$> getLine iEnd+ cEnd <- getLineOffset iEnd+ triggerEventIDE_ . SelectSrcSpan $+ case mbfn of+ Just fn -> Just (SrcSpan fn lStart cStart lEnd cEnd)+ Nothing -> Nothing+ let tagName = "match"+ hasSelection <- hasSelection buffer+ m <- liftIO $ readIORef hasMatch+ when m $ removeTagByName buffer tagName+ r <- if hasSelection+ then do+ candy' <- readIDE candy+ sTxt <- getCandylessPart candy' buffer iStart iEnd+ let strippedSTxt = T.strip sTxt+ if T.null strippedSTxt+ then return False+ else do+ bi1 <- getStartIter buffer+ bi2 <- getEndIter buffer+ r1 <- forwardApplying bi1 strippedSTxt (Just iStart) tagName buffer+ r2 <- forwardApplying iEnd strippedSTxt (Just bi2) tagName buffer+ return (r1 || r2)+ else return False+ liftIO $ writeIORef hasMatch r+ return () ids6 <- onKeyPress sv $ do keyval <- lift eventKeyVal@@ -702,7 +670,7 @@ -> Maybe (EditorIter editor) -> Text -- tagname -> EditorBuffer editor- -> IDEM ()+ -> IDEM Bool forwardApplying tI txt mbTi tagName ebuf = do mbFTxt <- forwardSearch tI txt [TextSearchVisibleOnly, TextSearchTextOnly] mbTi case mbFTxt of@@ -711,8 +679,8 @@ endsWord <- endsWord end when (startsWord && endsWord) $ applyTagByName ebuf tagName start end- forwardApplying end txt mbTi tagName ebuf- Nothing -> return()+ (|| (startsWord && endsWord)) <$> forwardApplying end txt mbTi tagName ebuf+ Nothing -> return False isIdent a = isAlphaNum a || a == '\'' || a == '_' -- parts of haskell identifiers @@ -982,102 +950,7 @@ return False) setModified buf (not succ) markLabelAsChanged nb ideBuf- hlintBuffer' ideBuf text' fn--hlintSettings :: IDEPackage -> IDEM (ParseFlags, [Classify], Hint)-hlintSettings package = do- mbHlintDir <- liftIO $ leksahSubDir "hlint"- let cabalMacros = ipdBuildDir package </> "dist/build/autogen/cabal_macros.h"- cabalMacrosExist <- liftIO $ doesFileExist cabalMacros- defines <- liftIO $ if cabalMacrosExist- then do- raw <- S.readFile cabalMacros- map (\(a, b) -> (a, concat (lines b))) . snd <$> runCpphsReturningSymTab defaultCpphsOptions cabalMacros raw- else return []- (fixities, classify, hints) <- liftIO $ findSettings (readSettingsFile mbHlintDir) Nothing- let hint = resolveHints hints- flags = parseFlagsAddFixities fixities defaultParseFlags{ cppFlags = Cpphs defaultCpphsOptions- { defines = defines } }- liftIO . debugM "leksah" $ "hlintSettings defines = " <> show defines- return (flags, classify, hint)--hlintBuffer :: IDEBuffer -> IDEAction-hlintBuffer ideBuf@IDEBuffer{..} = do- buf <- getBuffer sourceView- candy <- readIDE candy- text <- getCandylessText candy buf- maybe (return ()) (hlintBuffer' ideBuf text) fileName--hlintBuffer' :: IDEBuffer -> Text -> FilePath -> IDEAction-hlintBuffer' ideBuf text fn = do- packs <- belongsToPackages ideBuf- ideR <- ask- case packs of- (package:_) -> do- let file = makeRelative (ipdBuildDir package) fn- removeLogRefs [LintRef] (ipdBuildDir package) file- liftIO . void . forkIO $ do- (flags, classify, hint) <- reflectIDE (hlintSettings package) ideR- parseResult <- parseModuleEx flags fn (Just $ T.unpack text)- case parseResult of- (Right m) -> do- let allIdeas = applyHints classify hint [m]- ideas = filter (\Idea{..} -> ideaSeverity /= Ignore- && equalFilePath (HSE.srcSpanFilename ideaSpan) fn) allIdeas- forM_ ideas $ \ idea@Idea{..} -> do- let fixColumn c = max 0 (c - 1)- srcSpan = SrcSpan file- (HSE.srcSpanStartLine ideaSpan)- (HSE.srcSpanStartColumn ideaSpan - 1)- (HSE.srcSpanEndLine ideaSpan)- (HSE.srcSpanEndColumn ideaSpan - 1)- fromLines = drop (HSE.srcSpanStartLine ideaSpan - 1)- . take (HSE.srcSpanEndLine ideaSpan) $ T.lines text- fixHead [] = []- fixHead (x:xs) = T.drop (HSE.srcSpanStartColumn ideaSpan - 1) x : xs- fixTail [] = []- fixTail (x:xs) = T.take (HSE.srcSpanEndColumn ideaSpan - 1) x : xs- from = T.reverse . T.drop 1 . T.reverse- . T.unlines . fixHead . reverse . fixTail $ reverse fromLines- reflectIDE (postAsyncIDE $ addLogRef- (LogRef srcSpan package (T.pack ideaHint <> maybe "" (("\n" <>) . T.pack) ideaTo)- (Just (from, idea)) (0, 0) LintRef)) ideR- Left error -> do- let loc = parseErrorLocation error- srcSpan = SrcSpan file- (HSE.srcLine loc)- (HSE.srcColumn loc - 1)- (HSE.srcLine loc)- (HSE.srcColumn loc - 1)- reflectIDE (postAsyncIDE $ addLogRef- (LogRef srcSpan package ("Hlint Parse Error: " <> T.pack (parseErrorMessage error))- Nothing (0, 0) LintRef)) ideR- _ -> liftIO . debugM "leksah" $ "hlintBuffer package not found for " <> fn--resolveActiveHLint :: IDEM Bool-resolveActiveHLint = inActiveBufContext False $ \_ _ ebuf _ _ -> do- allLogRefs <- readIDE allLogRefs- (iStart, iEnd) <- getSelectionBounds ebuf- lStart <- getLine iStart- cStart <- getLineOffset iStart- lEnd <- getLine iEnd- cEnd <- getLineOffset iEnd- let selectedRefs = filter (\ LogRef{..} -> logRefType == LintRef- && (lStart+1, cStart) <= (srcSpanEndLine logRefSrcSpan, srcSpanEndColumn logRefSrcSpan)- && (lEnd+1, cEnd) >= (srcSpanStartLine logRefSrcSpan, srcSpanStartColumn logRefSrcSpan)) allLogRefs- safeRefs = takeWhileNotOverlapping selectedRefs- (changed, _) <- foldM replaceHLintSource (False, 0) . catMaybes $ map logRefIdea safeRefs- prefs <- readIDE prefs- when changed $ if backgroundBuild prefs- then setModified ebuf True- else void $ fileSave False- return changed - where- takeWhileNotOverlapping = takeWhileNotOverlapping' (-1)- takeWhileNotOverlapping' _ [] = []- takeWhileNotOverlapping' line (ref:refs)- | srcSpanEndLine (logRefSrcSpan ref) > line = ref : takeWhileNotOverlapping' (srcSpanEndLine $ logRefSrcSpan ref) refs- | otherwise = takeWhileNotOverlapping' line refs+ triggerEventIDE_ $ SavedFile fn fileSave :: Bool -> IDEM Bool fileSave query = inActiveBufContext False $ fileSaveBuffer query
src/IDE/Pane/Workspace.hs view
@@ -35,7 +35,6 @@ import qualified Data.Map as Map (empty) import Data.List (sortBy) import IDE.Pane.Files (refreshFiles)-import IDE.Pane.HLint (refreshHLint) import Control.Monad (when) import Control.Monad.IO.Class (MonadIO(..)) import IDE.Utils.GUIUtils (treeViewContextMenu, __)@@ -229,5 +228,4 @@ liftIO $ treeStoreInsertForest (workspaceStore p) [] 0 forest when showPane $ displayPane p False refreshFiles- workspaceTry refreshHLint
src/IDE/Session.hs view
@@ -67,7 +67,7 @@ import IDE.Find import System.Time (getClockTime) import IDE.Package (deactivatePackage)-import IDE.Pane.Errors (ErrorsState(..))+import IDE.Pane.Errors (fillErrorList, ErrorsState(..)) import Control.Exception (catch, SomeException(..)) import IDE.Pane.Workspace (WorkspaceState(..)) import IDE.Workspaces (workspaceOpenThis)@@ -673,6 +673,7 @@ setDark :: Bool -> IDEM () setDark dark = do setInfoStyle+ fillErrorList prefs <- readIDE prefs buffers <- allBuffers mapM_ updateStyle' buffers
@@ -120,7 +120,8 @@ let hasNoControlModifier = mapControlCommand Control `notElem` mods lnbf <- readIORef lineNumberBugFix -- print ("ishint?, adjusted, event.x, ptr.x, adjustment,hasControl?",isHint,ptrx - fromMaybe (-1000) lnbf , eventX, ptrx, lnbf, hasNoControlModifier)- when (isHint && hasNoControlModifier) $+ -- when (isHint && hasNoControlModifier) $+ when (abs (ptrx - eventX) > 1) $ -- get difference between event X and pointer x -- event X is in coordinates of sourceView text -- pointer X is in coordinates of window (remember "show line numbers" ?)
src/IDE/TextEditor/Class.hs view
@@ -169,6 +169,7 @@ onLookupInfo :: EditorView editor -> IDEEventM EButton Bool -> IDEM [Connection] onMotionNotifyEvent :: EditorView editor -> IDEEventM EMotion Bool -> IDEM [Connection] onPopulatePopup :: EditorView editor -> (Menu -> IDEM ()) -> IDEM [Connection]+ onSelectionChanged :: EditorBuffer editor -> IDEM () -> IDEM [Connection] -- Iter backwardCharC :: EditorIter editor -> IDEM (EditorIter editor)
src/IDE/TextEditor/CodeMirror.hs view
@@ -540,5 +540,6 @@ menuPopup menu Nothing return True return [ConnectC id1]+ onSelectionChanged (CMBuffer cm) f = return [] -- TODO #endif
src/IDE/TextEditor/GtkSourceView.hs view
@@ -129,7 +129,7 @@ (drop, dropWhile, all, length, pack) import Data.Monoid ((<>)) import Graphics.UI.Gtk.Multiline.TextBuffer- (textBufferDeleteMarkByName, textBufferDeleteMark,+ (markSet, textBufferDeleteMarkByName, textBufferDeleteMark, textBufferGetMark) import Graphics.UI.Gtk.SourceView.SourceMarkAttributes (queryTooltipText, sourceMarkAttributesSetIconName,@@ -139,6 +139,7 @@ import Graphics.UI.Gtk.Multiline.TextMark (textMarkGetName, toTextMark) import Control.Arrow (Arrow(..))+import System.Log.Logger (debugM) transformGtkIter :: EditorIter GtkSourceView -> (TextIter -> IO a) -> IDEM (EditorIter GtkSourceView) transformGtkIter (GtkIter i) f = do@@ -181,6 +182,10 @@ textBufferSetText buffer contents sourceBufferEndNotUndoableAction buffer tagTable <- textBufferGetTagTable buffer+ textTagNew (Just "found") >>= textTagTableAdd tagTable+ textTagNew (Just "match") >>= textTagTableAdd tagTable+ textTagNew (Just "context") >>= textTagTableAdd tagTable+ textTagNew (Just "breakpoint") >>= textTagTableAdd tagTable forM_ [minBound .. maxBound :: LogRefType] $ \ refType -> textTagNew (Just . T.pack $ show refType) >>= textTagTableAdd tagTable return $ GtkBuffer buffer@@ -291,19 +296,17 @@ sourceBufferSetStyleScheme sb (Just scheme) tagTable <- getTagTable (GtkBuffer sb) let isDark = name `elem` ["leksah-dark", "oblivion", "cobalt"]- forM_ [minBound .. maxBound] $ \ refType -> do- mbTag <- lookupTag tagTable (T.pack $ show refType)- case mbTag of- Nothing -> return ()- Just tag ->- case refType of- ErrorRef -> underline tag UnderlineError- WarningRef -> underline tag UnderlineError- TestFailureRef -> underline tag UnderlineError- LintRef | isDark -> background tag $ Color 0 15000 0- | otherwise -> background tag $ Color 60000 65535 60000- BreakpointRef -> background tag breakpointBG- ContextRef -> background tag contextBG+ setBG (dark, light) (Just tag) = background tag (if isDark then dark else light)+ setBG _ Nothing = return ()+ setUnderline = maybe (return ()) (`underline` UnderlineError)+ lookupTag tagTable "match" >>= setBG matchBG+ lookupTag tagTable "found" >>= setBG foundBG+ lookupTag tagTable (T.pack $ show ErrorRef ) >>= setUnderline+ lookupTag tagTable (T.pack $ show WarningRef ) >>= setUnderline+ lookupTag tagTable (T.pack $ show TestFailureRef) >>= setUnderline+ lookupTag tagTable (T.pack $ show LintRef ) >>= setBG lintBG+ lookupTag tagTable (T.pack $ show BreakpointRef ) >>= setBG breakpointBG+ lookupTag tagTable (T.pack $ show ContextRef ) >>= setBG contextBG setText (GtkBuffer sb) text = liftIO $ textBufferSetText sb text undo (GtkBuffer sb) = liftIO $ sourceBufferUndo sb @@ -388,8 +391,11 @@ -- Paste operation is example of such sequential events (each word!). lastHandler <- newIORef Nothing id1 <- after sb bufferInsertText $ \iter text -> do- mapM_ idleRemove =<< maybeToList <$> readIORef lastHandler+ lh <- readIORef lastHandler+ debugM "leksah" $ "Removing " <> show lh+ mapM_ idleRemove $ maybeToList lh h <- flip idleAdd priorityDefault $ do+ writeIORef lastHandler Nothing let isIdent a = isAlphaNum a || a == '\'' || a == '_' || a == '.' let isOp a = isSymbol a || a == ':' || a == '\\' || a == '*' || a == '/' || a == '-' || a == '!' || a == '@' || a == '%' || a == '&' || a == '?'@@ -443,6 +449,13 @@ ideR <- ask liftIO $ do id1 <- sv `on` populatePopup $ \menu -> reflectIDE (f menu) ideR+ return [ConnectC id1]+ onSelectionChanged (GtkBuffer sb) handler = do+ ideR <- ask+ liftIO $ do+ id1 <- sb `on` markSet $ \ _ mark -> do+ name <- textMarkGetName mark+ when (name == Just "insert") $ reflectIDE handler ideR return [ConnectC id1] -- Iter