diff --git a/leksah.cabal b/leksah.cabal --- a/leksah.cabal +++ b/leksah.cabal @@ -1,5 +1,5 @@ name: leksah -version: 0.13.3.0 +version: 0.13.4.0 cabal-version: >=1.10 build-type: Simple license: GPL @@ -166,9 +166,12 @@ x-gettext-po-files: po/*.po x-gettext-domain-name: leksah - extra-tmp-files: +source-repository head + type: git + location: https://github.com/leksah/leksah + flag yi Description: Experimental Yi support Default: False @@ -245,14 +248,14 @@ mtl >=1.1.0.2 && <2.2, 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-base ==0.93.*, utf8-string >=0.3.1.1 && <0.4, array >=0.2.0.0 && <0.6, - time >=0.1 && <1.5, ltk >= 0.13.1.0 && <0.14, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4, + time >=0.1 && <1.5, ltk >= 0.13.2.0 && <0.14, binary-shared >= 0.8 && <0.9, deepseq >= 1.1.0.0 && <1.4, hslogger >= 1.0.7 && <1.3, leksah-server >=0.13.1.0 && <0.14, network >= 2.2 && <3.0, ghc >=6.10.1 && <7.9, strict >= 0.3.2 && <0.4, conduit >= 1.0.8 && <1.1, text >= 0.11.1.5 && < 1.2, gio >=0.12.2 && <0.13, transformers >=0.2.2.0 && <0.4, executable-path >=0.0.3 && <0.1, vcsgui >=0.0.1 && < 0.1, vcswrapper >=0.0.1 && < 0.1, QuickCheck >=2.4.2 && <2.7, haskell-src-exts >=1.13.5 && <1.15, - hlint >=1.8.39 && <1.9, vado >=0.0.1 && <0.1 + hlint >=1.8.59 && <1.9, vado >=0.0.1 && <0.1 exposed-modules: IDE.Leksah IDE.Completion IDE.ImportTool IDE.Find IDE.Session IDE.Command IDE.Keymap IDE.Utils.GUIUtils IDE.SymbolNavigation @@ -313,7 +316,7 @@ ghc-options: -threaded hs-source-dirs: main - build-depends: leksah == 0.13.3.0, base >= 4.0.0.0 && <=4.8, gtk3 -any + build-depends: leksah == 0.13.4.0, base >= 4.0.0.0 && <=4.8, gtk3 -any if os(linux) && flag(loc) cpp-options: -DLOCALIZATION build-depends: hgettext, setlocale @@ -332,7 +335,7 @@ if !flag(webkit) buildable: False else - build-depends: leksah ==0.13.3.0, base >=4.0.0.0 && <=4.8, + build-depends: leksah ==0.13.4.0, base >=4.0.0.0 && <=4.8, jsaddle -any, ghcjs-dom -any if flag(gtk3) build-depends: gtk3 >=0.12.4 && <0.13, gtksourceview3 >=0.10.0 && <0.13, @@ -349,7 +352,7 @@ test-suite tests build-depends: base >=4.0.0.0 && <4.8, Cabal >=1.6.0.1 && <1.19, - QuickCheck >=2.4.2 && <2.7, leksah ==0.13.3.0, + QuickCheck >=2.4.2 && <2.7, leksah ==0.13.4.0, containers, ltk, leksah-server, hslogger, transformers, glib, monad-loops if flag(gtk3) diff --git a/src/IDE/Command/VCS/Types.hs b/src/IDE/Command/VCS/Types.hs --- a/src/IDE/Command/VCS/Types.hs +++ b/src/IDE/Command/VCS/Types.hs @@ -20,11 +20,12 @@ ,reflectIDE' ) where import Control.Monad.Reader +import Control.Applicative import IDE.Core.Types import IDE.Core.State newtype VCSAction a = VCSAction (ReaderT (VCSConf,FilePath) IDEM a) - deriving (Monad, MonadIO, MonadReader (VCSConf,FilePath)) + deriving (Functor, Applicative, Monad, MonadIO, MonadReader (VCSConf,FilePath)) askIDERef :: VCSAction IDERef askIDERef = VCSAction $ lift $ ask diff --git a/src/IDE/ImportTool.hs b/src/IDE/ImportTool.hs --- a/src/IDE/ImportTool.hs +++ b/src/IDE/ImportTool.hs @@ -353,21 +353,26 @@ isSub <- optionMaybe (try (choice [symbol "type constructor or class" , symbol "data constructor"])) ( (do - char '`' + choice [char '`',char '‘'] mbQual <- optionMaybe (try (do q <- lexeme conid dot return q)) id <- optionMaybe (try identifier) case id of +#if MIN_VERSION_ghc(7,8,0) Just id -> return (NotInScopeParseResult mbQual + id (isJust isSub) False) +#else + Just id -> return (NotInScopeParseResult mbQual (take (length id - 1) id) (isJust isSub) False) +#endif Nothing -> do op <- operator char '\'' return (NotInScopeParseResult mbQual op (isJust isSub) True)) <|> (do - char '‛' + choice [char '`',char '‘'] mbQual <- optionMaybe (try (do q <- lexeme conid dot @@ -375,7 +380,7 @@ id <- optionMaybe (try identifier) result <- case id of Just id -> return (NotInScopeParseResult mbQual - (take (length id) id) (isJust isSub) False) + id (isJust isSub) False) Nothing -> do op <- operator return (NotInScopeParseResult mbQual op (isJust isSub) True) diff --git a/src/IDE/Leksah.hs b/src/IDE/Leksah.hs --- a/src/IDE/Leksah.hs +++ b/src/IDE/Leksah.hs @@ -212,20 +212,20 @@ st <- unsafeInitGUIForThreadedRTS when rtsSupportsBoundThreads (sysMessage Normal "Linked with -threaded") + mapM_ (sysMessage Normal) st + initGtkRc + dataDir <- getDataDir + mbStartupPrefs <- if not isFirstStart + then return $ Just iprefs + else do + firstStartOK <- firstStart iprefs + if not firstStartOK + then return Nothing + else do + prefsPath <- getConfigFilePathForLoad standardPreferencesFilename Nothing dataDir + prefs <- readPrefs prefsPath + return $ Just prefs postGUIAsync $ do - mapM_ (sysMessage Normal) st - initGtkRc - dataDir <- getDataDir - mbStartupPrefs <- if not isFirstStart - then return $ Just iprefs - else do - firstStartOK <- firstStart iprefs - if not firstStartOK - then return Nothing - else do - prefsPath <- getConfigFilePathForLoad standardPreferencesFilename Nothing dataDir - prefs <- readPrefs prefsPath - return $ Just prefs case mbStartupPrefs of Nothing -> return () Just startupPrefs -> startMainWindow yiControl sessionFP mbWorkspaceFP sourceFPs diff --git a/src/IDE/Package.hs b/src/IDE/Package.hs --- a/src/IDE/Package.hs +++ b/src/IDE/Package.hs @@ -517,7 +517,7 @@ filePath <- getConfigFilePathForLoad (template ++ leksahTemplateFileExtension) Nothing dataDir template <- UTF8.readFile filePath return (foldl' (\ a (from, to) -> replace from to a) template - [ ("@License@" , (show . license) pd) + [ ("@License@" , (display . license) pd) , ("@Maintainer@" , maintainer pd) , ("@Stability@" , stability pd) , ("@Portability@" , "") diff --git a/src/IDE/Pane/HLint.hs b/src/IDE/Pane/HLint.hs --- a/src/IDE/Pane/HLint.hs +++ b/src/IDE/Pane/HLint.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE CPP, FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses, +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE FlexibleInstances, DeriveDataTypeable, MultiParamTypeClasses, TypeSynonymInstances, RecordWildCards #-} ----------------------------------------------------------------------------- -- @@ -29,11 +30,11 @@ import qualified Text.ParserCombinators.Parsec.Token as P import Data.Maybe import Data.Typeable -import IDE.Core.State +import IDE.Core.State hiding (SrcSpan(..)) import IDE.BufferMode import IDE.LogRef (logOutput, defaultLineLogger) import IDE.Pane.SourceBuffer - (goToSourceDefinition, maybeActiveBuf, IDEBuffer(..)) + (goToSourceDefinition, maybeActiveBuf, IDEBuffer(..), replaceHLintSource) import IDE.TextEditor (grabFocus) import Control.Applicative ((<$>)) import System.FilePath ((), dropFileName) @@ -45,13 +46,22 @@ import Control.Monad.IO.Class (MonadIO(..)) import Language.Haskell.HLint (Suggestion(..), suggestionLocation) import Language.Haskell.Exts (SrcLoc(..)) -import qualified Language.Haskell.HLint as H (hlint) -import IDE.Utils.GUIUtils (__) +import Language.Haskell.Exts.SrcLoc (SrcSpan(..)) +import qualified Language.Haskell.HLint2 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(..)) + data HLintRecord = HLintRecord { - file :: FilePath - , line :: Int + condPackage :: Maybe IDEPackage , context :: String + , condIdea :: Maybe H.Idea , parDir :: Maybe FilePath } deriving (Eq) @@ -110,36 +120,26 @@ scrolledWindowSetPolicy scrolledView PolicyAutomatic PolicyAutomatic let hlint = IDEHLint {..} - gotoSource :: Bool -> IO Bool - gotoSource focus = do - sel <- getSelectionHLintRecord treeView hlintStore - case sel of - Just record -> reflectIDE (do - case record of - HLintRecord {file=f, line=l, parDir=Just pp} -> - (goToSourceDefinition (pp f) $ Just $ Location l 0 l 0) - ?>>= (\(IDEBuffer {sourceView = sv}) -> when focus $ grabFocus sv) - _ -> return ()) ideR - Nothing -> return () - return True 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 { file = f, parDir = Nothing } -> refreshDir hlintStore iter f + 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 { file = f, parDir = Nothing }) -> refreshDir hlintStore iter f + (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" -> gotoSource True + "Return" -> reflectIDE (gotoSource True treeView hlintStore) ideR "Escape" -> do reflectIDE (do lastActiveBufferPane ?>>= \paneName -> do @@ -150,34 +150,48 @@ return True -- gotoSource True _ -> return False - on sel treeSelectionSelectionChanged (gotoSource False >> return ()) + treeViewContextMenu treeView + $ hlintContextMenu ideR hlintStore treeView + on sel treeSelectionSelectionChanged (reflectIDE (gotoSource False treeView hlintStore + >> return ()) ideR) - return (Just hlint,map ConnectC [cid1, cid2, cid3, cid4]) + return (Just hlint,map ConnectC [cid1]) getHLint :: Maybe PanePath -> IDEM IDEHLint getHLint Nothing = forceGetPane (Right "*HLint") getHLint (Just pp) = forceGetPane (Left pp) -hlintLineParser :: CharParser () HLintRecord -hlintLineParser = try (do - file <- many (noneOf ":") - char ':' - line <- int - char ':' - context <- many anyChar - let parDir = Nothing - return $ HLintRecord {..} - "hlintLineParser") +data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound -lexer = P.makeTokenParser emptyDef -lexeme = P.lexeme lexer -whiteSpace = P.whiteSpace lexer -hexadecimal = P.hexadecimal lexer -symbol = P.symbol lexer -identifier = P.identifier lexer -colon = P.colon lexer -int = fmap fromInteger $ P.integer lexer +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) @@ -195,40 +209,83 @@ let packages = case maybeActive of Just active -> active : (filter (/= active) $ wsPackages ws) Nothing -> wsPackages ws - lift $ hlintDirectories $ - concatMap (\p -> map (dropFileName (ipdCabalFile p) ) $ ipdSrcDirs p) $ packages + lift $ hlintDirectories2 packages -hlintDirectories :: [FilePath] -> IDEAction -hlintDirectories dirs = do + +--gotoSource :: Bool -> IDEM Bool +gotoSource focus treeView hlintStore = do + sel <- liftIO $ getSelectionHLintRecord treeView hlintStore + case sel of + Just record -> do + case record of + HLintRecord {condIdea = Just idea} -> + (goToSourceDefinition (srcSpanFilename (H.ideaSpan idea)) + (Just $ Location (srcSpanStartLine (H.ideaSpan idea)) + (srcSpanStartColumn (H.ideaSpan idea)) + (srcSpanEndLine (H.ideaSpan idea)) + (srcSpanEndColumn (H.ideaSpan idea)))) + ?>>= (\(IDEBuffer {sourceView = sv}) -> 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_ dirs $ \ dir -> do + forM_ packages $ \ p -> do nDir <- treeModelIterNChildren store Nothing - treeStoreInsert store [] nDir $ HLintRecord dir 0 dir Nothing - treeStoreInsert store [nDir] 0 $ HLintRecord dir 0 dir 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 -> FilePath -> IO () -refreshDir store iter dir = do - mbHlintDir <- leksahSubDir "hlint" +refreshDir :: TreeStore HLintRecord -> TreeIter -> IDEPackage -> IDEM () +refreshDir store iter package = do + mbHlintDir <- liftIO $ leksahSubDir "hlint" let datadirOpt = case mbHlintDir of Just d -> "--datadir":[d] Nothing -> [] - suggestions <- take 1000 <$> H.hlint ("--quiet":dir:datadirOpt) - setHLintResults store iter dir suggestions + (flags, classify, hint) <- liftIO $ H.autoSettings + let modules = Map.keys (ipdModules package) + pathes <- getSourcePathes (ipdPackageId package) modules + resL <- liftIO $ mapM (\dir -> H.parseModuleEx flags dir Nothing) pathes + let resOk = mapMaybe (\ pr -> case pr of + Left e -> trace ("can't parse: " ++ H.parseErrorContents e ++ + " location " ++ show H.parseErrorLocation) Nothing + Right r -> Just r) resL + let ideas = H.applyHints classify hint resOk + liftIO $ setHLint2Results store iter (packageIdentifierToString (ipdPackageId package)) ideas return () -hlintRecord dir suggestion = HLintRecord { - file = srcFilename loc, - line = srcLine loc, - context = show suggestion, - parDir = Just dir} - where - loc = suggestionLocation suggestion -setHLintResults :: TreeStore HLintRecord -> TreeIter -> FilePath -> [Suggestion] -> IO Int -setHLintResults store parent dir suggestions = do +getSourcePathes :: PackageIdentifier -> [ModuleName] -> IDEM [FilePath] +getSourcePathes 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 = show idea, + condIdea = Just idea, + parDir = Just dir} + +setHLint2Results :: TreeStore HLintRecord -> TreeIter -> FilePath -> [H.Idea] -> IO Int +setHLint2Results store parent dir ideas = do parentPath <- treeModelGetPath store parent forM_ (zip [0..] records) $ \(n, record) -> do mbChild <- treeModelIterNthChild store (Just parent) n @@ -243,35 +300,38 @@ removeRemaining store (parentPath++[nRecords]) return nRecords where - records = map (hlintRecord dir) suggestions + records = map (hlint2Record dir) ideas nRecords = length records -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' +hlintContextMenu :: IDERef + -> TreeStore HLintRecord + -> TreeView + -> Menu + -> IO () +hlintContextMenu ideR store treeView theMenu = do + mbSel <- getSelectionHLintRecord treeView store + item0 <- menuItemNewWithLabel (__ "Replace") + item0 `on` menuItemActivate $ do + reflectIDE (replaceHlint store treeView mbSel) ideR + menuShellAppend theMenu item0 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 + replaceableSelection Nothing = False + replaceableSelection (Just s) | isNothing (parDir s) = True + | otherwise = False -removeRemaining :: TreeStore a -> TreePath -> IO () -removeRemaining store path = do - found <- treeStoreRemove store path - when found $ removeRemaining store path +replaceHlint store treeView (Just sel) = + case condIdea sel of + Just idea | isJust (H.ideaTo idea) -> + let lined = lines (fromJust (H.ideaTo idea)) + startColumn = srcSpanStartColumn (H.ideaSpan idea) + source = init $ unlines (head lined : + map (\ s -> replicate startColumn ' ' ++ s) (tail lined)) + in do + replaceHLintSource (srcSpanFilename (H.ideaSpan idea)) + (srcSpanStartLine (H.ideaSpan idea)) + startColumn + (srcSpanEndLine (H.ideaSpan idea)) + (srcSpanEndColumn (H.ideaSpan idea)) + source + otherwise -> return () +replaceHlint _ _ Nothing = return () diff --git a/src/IDE/Pane/PackageEditor.hs b/src/IDE/Pane/PackageEditor.hs --- a/src/IDE/Pane/PackageEditor.hs +++ b/src/IDE/Pane/PackageEditor.hs @@ -35,8 +35,6 @@ import System.FilePath import Data.Maybe import System.Directory -import System.IO (withFile, IOMode(..)) -import System.IO.Strict (hGetContents) import IDE.Core.State import IDE.Utils.FileUtils @@ -76,13 +74,9 @@ paraName, getParameterPrim) import Graphics.UI.Editor.Simple - (staticListMultiEditor, - intEditor, - boolEditor, - fileEditor, - comboSelectionEditor, - multilineStringEditor, - stringEditor) + (comboEntryEditor, staticListMultiEditor, intEditor, boolEditor, + fileEditor, comboSelectionEditor, multilineStringEditor, + stringEditor) import Graphics.UI.Editor.Basics (Notifier, Editor(..), GUIEventSelector(..), GUIEvent(..)) import Distribution.Compiler @@ -122,6 +116,7 @@ import qualified Data.Conduit.List as CL (fold) import qualified Data.Conduit as C (Sink) import IDE.Utils.ExternalTool (runExternalTool') +import qualified System.IO.Strict as S (readFile) import Data.Char (toLower) -- | Get the last item @@ -263,8 +258,10 @@ $ emptyParams) templatePackage (\ a b -> b{templatePackage = a}) - (stringEditor (const True) True)] + (comboEntryEditor examplePackages)] +examplePackages = ["hello", "gtk2hs-hello"] + newPackageDialog :: Window -> FilePath -> IO (Maybe NewPackage) newPackageDialog parent workspaceDir = do dia <- dialogNew @@ -278,17 +275,11 @@ lower <- dialogGetActionArea dia (widget,inj,ext,_) <- buildEditor (packageFields workspaceDir) (NewPackage "" workspaceDir "hello") - bb <- hButtonBoxNew - closeB <- buttonNewFromStock "gtk-cancel" - save <- buttonNewFromStock "gtk-ok" - boxPackEnd bb closeB PackNatural 0 - boxPackEnd bb save PackNatural 0 - on save buttonActivated (dialogResponse dia ResponseOk) - on closeB buttonActivated (dialogResponse dia ResponseCancel) + okButton <- dialogAddButton dia "Ok" ResponseOk + dialogAddButton dia "Cancel" ResponseCancel boxPackStart (castToBox upper) widget PackGrow 7 - boxPackStart (castToBox lower) bb PackNatural 7 - set save [widgetCanDefault := True] - widgetGrabDefault save + set okButton [widgetCanDefault := True] + widgetGrabDefault okButton widgetShowAll dia resp <- dialogRun dia value <- ext (NewPackage "" workspaceDir "hello") @@ -378,14 +369,14 @@ packageToClone :: String, cloneParentDir :: FilePath} -cloneFields :: FilePath -> FieldDescription ClonePackageSourceRepo -cloneFields workspaceDir = VFD emptyParams [ +cloneFields :: [PackageId] -> FilePath -> FieldDescription ClonePackageSourceRepo +cloneFields packages workspaceDir = VFD emptyParams [ mkField (paraName <<<- ParaName ((__ "Existing package to clone source repository")) $ emptyParams) packageToClone (\ a b -> b{packageToClone = a}) - (stringEditor (const True) True), + (comboEntryEditor ((sort . nub) (map (display . pkgName) packages))), mkField (paraName <<<- ParaName ((__ "Parent directory")) $ paraMinSize <<<- ParaMinSize (-1, 120) @@ -396,6 +387,7 @@ clonePackageSourceDialog :: Window -> FilePath -> IO (Maybe ClonePackageSourceRepo) clonePackageSourceDialog parent workspaceDir = do + packages <- getInstalledPackageIds dia <- dialogNew set dia [ windowTransientFor := parent , windowTitle := (__ "Clone Package") ] @@ -405,19 +397,13 @@ upper <- dialogGetUpper dia #endif lower <- dialogGetActionArea dia - (widget,inj,ext,_) <- buildEditor (cloneFields workspaceDir) + (widget,inj,ext,_) <- buildEditor (cloneFields packages workspaceDir) (ClonePackageSourceRepo "" workspaceDir) - bb <- hButtonBoxNew - closeB <- buttonNewFromStock "gtk-cancel" - save <- buttonNewFromStock "gtk-ok" - boxPackEnd bb closeB PackNatural 0 - boxPackEnd bb save PackNatural 0 - on save buttonActivated (dialogResponse dia ResponseOk) - on closeB buttonActivated (dialogResponse dia ResponseCancel) + okButton <- dialogAddButton dia "Ok" ResponseOk + dialogAddButton dia "Cancel" ResponseCancel boxPackStart (castToBox upper) widget PackGrow 7 - boxPackStart (castToBox lower) bb PackNatural 7 - set save [widgetCanDefault := True] - widgetGrabDefault save + set okButton [widgetCanDefault := True] + widgetGrabDefault okButton widgetShowAll dia resp <- dialogRun dia value <- ext (ClonePackageSourceRepo "" workspaceDir) @@ -466,7 +452,7 @@ (Just cfn, Just newName) -> do let newCfn = takeDirectory cfn newName ++ ".cabal" when (cfn /= newCfn) . liftIO $ do - s <- withFile cfn ReadMode $ hGetContents + s <- S.readFile cfn writeFile newCfn $ renameCabalFile (takeBaseName cfn) newName s removeFile cfn activateAction newCfn diff --git a/src/IDE/Pane/SourceBuffer.hs b/src/IDE/Pane/SourceBuffer.hs --- a/src/IDE/Pane/SourceBuffer.hs +++ b/src/IDE/Pane/SourceBuffer.hs @@ -25,6 +25,7 @@ , goToSourceDefinition , goToDefinition , insertInBuffer +, replaceHLintSource , fileNew , fileOpenThis @@ -292,6 +293,30 @@ return () return mbBuf +replaceHLintSource :: FilePath -> Int -> Int -> Int -> Int -> String -> IDEAction +replaceHLintSource file lineS columnS lineE columnE to = do + mbBuf <- selectSourceBuf file + case mbBuf of + Just buf -> inActiveBufContext () $ \_ 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 (lineS,columnS - 1) + (_,e2) <- positionToCandy candy' ebuf (lineE,columnE - 1) + return (lineS-1,e1,lineE-1,e2) + else return (lineS-1, columnS-1, lineE-1, columnE-1) + i1 <- getIterAtLine ebuf (lineS') + i1' <- forwardCharsC i1 (columnS') + i2 <- getIterAtLine ebuf (lineE') + i2' <- forwardCharsC i2 (columnE') + delete ebuf i1' i2' + editInsertCode ebuf i1' realString + fileSave False + setModified ebuf True + _ -> return () + insertInBuffer :: Descr -> IDEAction insertInBuffer idDescr = do mbPaneName <- lastActiveBufferPane @@ -740,7 +765,7 @@ (do nmt <- getModificationTime fn writeIORef (modTime buf) (Just nmt)) - (\(e::SomeException) -> do + (\(e:: SomeException) -> do sysMessage Normal (show e) return ())