diff --git a/Readme.md b/Readme.md
--- a/Readme.md
+++ b/Readme.md
@@ -106,12 +106,14 @@
Get the leksah source:
- git clone https://github.org/leksah/leksah
+ git clone https://github.com/leksah/leksah
cd leksah
git submodule update --init
Build it using the Dockerfile:
+ wget http://dl.fedoraproject.org/pub/fedora/linux/releases/test/22_Beta/Docker/x86_64/Fedora-Docker-Base-22_Beta-20150415.x86_64.tar.xz
+ docker load -i Fedora-Docker-Base-22_Beta-20150415.x86_64.tar.xz
sudo docker build -t leksah/build .
Copy the resulting msi file out of the container (version number in the file name will match the one in the leksah.cabal file):
diff --git a/data/styles/leksah-dark.xml b/data/styles/leksah-dark.xml
--- a/data/styles/leksah-dark.xml
+++ b/data/styles/leksah-dark.xml
@@ -32,10 +32,10 @@
-
+
-
+
@@ -65,10 +65,10 @@
-
+
-
+
diff --git a/data/styles/leksah.xml b/data/styles/leksah.xml
--- a/data/styles/leksah.xml
+++ b/data/styles/leksah.xml
@@ -32,7 +32,7 @@
-
+
@@ -41,6 +41,10 @@
+
+
+
+
@@ -54,7 +58,7 @@
-
+
@@ -65,10 +69,10 @@
-
+
-
+
diff --git a/leksah.cabal b/leksah.cabal
--- a/leksah.cabal
+++ b/leksah.cabal
@@ -1,5 +1,5 @@
name: leksah
-version: 0.15.0.3
+version: 0.15.0.4
cabal-version: >=1.18
build-type: Simple
license: GPL
@@ -246,7 +246,7 @@
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.2 && <0.16,
+ hslogger >= 1.0.7 && <1.3, leksah-server >=0.15.0.3 && <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,
@@ -296,7 +296,7 @@
ghc-options: -threaded
hs-source-dirs: main
- build-depends: leksah == 0.15.0.3,
+ build-depends: leksah == 0.15.0.4,
base >= 4.0.0.0 && <=4.9,
gtk3 >=0.13.2 && <0.14
if os(linux) && flag(loc)
@@ -312,7 +312,7 @@
ghc-options: -rtsopts -fwarn-missing-fields -fwarn-incomplete-patterns -ferror-spans
executable bewleksah
- build-depends: leksah ==0.15.0.3,
+ build-depends: leksah ==0.15.0.4,
base >=4.0.0.0 && <=4.9,
jsaddle -any,
ghcjs-dom -any,
@@ -331,7 +331,7 @@
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.3,
+ leksah ==0.15.0.4,
containers,
ltk,
leksah-server,
diff --git a/src/IDE/Core/Types.hs b/src/IDE/Core/Types.hs
--- a/src/IDE/Core/Types.hs
+++ b/src/IDE/Core/Types.hs
@@ -482,6 +482,7 @@
, breakOnError :: Bool
, printBindResult :: Bool
, serverIP :: Text
+ , showHiddenFiles :: Bool
-- As well used by server
, serverPort :: Int
, sourceDirectories :: [FilePath]
diff --git a/src/IDE/Leksah.hs b/src/IDE/Leksah.hs
--- a/src/IDE/Leksah.hs
+++ b/src/IDE/Leksah.hs
@@ -78,7 +78,7 @@
import Control.Monad (when, unless, liftM)
import Control.Monad.IO.Class (MonadIO(..))
import Control.Applicative ((<$>))
-import qualified Data.Text as T (pack, unpack, stripPrefix)
+import qualified Data.Text as T (pack, unpack, stripPrefix, unlines)
import Data.Text (Text)
import Data.Monoid ((<>))
import Graphics.UI.Gtk.General.CssProvider
@@ -222,12 +222,19 @@
mbScreen <- screenGetDefault
case mbScreen of
Just screen -> do
- provider <- cssProviderNew
- cssProviderLoadFromString provider (
- ".window-frame,\n" <>
- ".window-frame:backdrop {\n" <>
- " box-shadow: none;\n" <>
- " margin: 0;}\n" :: Text)
+ provider <- cssProviderNew
+ cssProviderLoadFromString provider $
+ T.unlines [ ".window-frame,"
+ , ".window-frame:backdrop {"
+ , " box-shadow: none;"
+ , " margin: 0;}"
+ , "#errorLabel {"
+ , " padding: 10px;"
+ , " background: #F2DEDE;"
+ , " color: #A94442;"
+ , " border: 1px solid #EBCCD1;"
+ , " border-radius: 5px;}"
+ ]
styleContextAddProviderForScreen screen provider 600
Nothing -> debugM "leksah" "Unable to add style provider for screen"
mapM_ (sysMessage Normal . T.pack) st
@@ -446,6 +453,7 @@
welcomeCabal = welcomePath"leksah-welcome.cabal"
welcomeMain = welcomePath"src""Main.hs"
createDirectoryIfMissing True $ welcomePath"src"
+ createDirectoryIfMissing True $ welcomePath"test"
copyFile (welcomeSource"Setup.lhs") (welcomePath"Setup.lhs")
copyFile (welcomeSource"leksah-welcome.cabal") (welcomeCabal)
copyFile (welcomeSource"LICENSE") (welcomePath"LICENSE")
diff --git a/src/IDE/LogRef.hs b/src/IDE/LogRef.hs
--- a/src/IDE/LogRef.hs
+++ b/src/IDE/LogRef.hs
@@ -650,17 +650,23 @@
addLogRefs [last refs]
lastContext
+contextParser :: CharParser () SrcSpan
+contextParser = try (do
+ whiteSpace
+ (symbol "Logged breakpoint at" <|> symbol "Stopped at")
+ whiteSpace
+ srcSpanParser)
+ "historicContextParser"
+
logOutputForLiveContext :: IDEPackage
-> LogLaunch -- ^ loglaunch
-> C.Sink ToolOutput IDEM ()
logOutputForLiveContext package logLaunch = logOutputForContext package logLaunch (getContexts . T.unpack)
where
getContexts [] = []
- getContexts line@(x:xs) = case stripPrefix "Stopped at " line of
- Just rest -> case parse srcSpanParser "" rest of
- Right desc -> desc : getContexts xs
- _ -> getContexts xs
- _ -> getContexts xs
+ getContexts line@(x:xs) = case parse contextParser "" line of
+ Right desc -> desc : getContexts xs
+ _ -> getContexts xs
logOutputForLiveContextDefault :: IDEPackage
-> C.Sink ToolOutput IDEM ()
@@ -674,11 +680,9 @@
-> C.Sink ToolOutput IDEM ()
logOutputForHistoricContext package logLaunch = logOutputForContext package logLaunch getContexts
where
- getContexts line = case T.stripPrefix "Logged breakpoint at " line of
- Just rest -> case parse srcSpanParser "" $ T.unpack rest of
- Right desc -> [desc]
- _ -> []
- _ -> []
+ getContexts line = case parse contextParser "" $ T.unpack line of
+ Right desc -> [desc]
+ _ -> []
logOutputForHistoricContextDefault :: IDEPackage
-> C.Sink ToolOutput IDEM ()
diff --git a/src/IDE/Pane/Files.hs b/src/IDE/Pane/Files.hs
--- a/src/IDE/Pane/Files.hs
+++ b/src/IDE/Pane/Files.hs
@@ -41,7 +41,7 @@
treeViewColumnSetSizing, treeViewColumnSetTitle, treeViewColumnNew,
cellRendererPixbufNew, cellRendererTextNew, treeViewSetModel,
treeViewNew, treeStoreNew, castToWidget, TreeStore, TreeView,
- ScrolledWindow)
+ ScrolledWindow, treeViewRowExpanded, treeStoreGetTree)
import Data.Maybe (isJust)
import Control.Monad (forM, void, forM_, when)
import Data.Typeable (Typeable)
@@ -74,6 +74,8 @@
import Data.List (sortBy, sort)
import Data.Ord (comparing)
import Data.Char (toLower)
+import IDE.Core.Types (IDE(..), Prefs (..))
+import Data.Tree (Tree(..))
data FileRecord =
FileRecord FilePath
@@ -155,16 +157,16 @@
record <- treeStoreGetValue fileStore path
reflectIDE (
case record of
- DirRecord f -> liftIO $ refreshDir fileStore path f
- PackageRecord p -> liftIO $ refreshPackage fileStore path p
+ DirRecord f -> refreshDir fileStore path f
+ PackageRecord p -> refreshPackage fileStore path p
_ -> ideMessage Normal (__ "Unexpected Expansion in Files Pane")) ideR
on treeView rowActivated $ \ path col -> do
record <- treeStoreGetValue fileStore path
reflectIDE (
case record of
FileRecord f -> void (goToSourceDefinition' f (Location "" 1 0 1 0))
- DirRecord f -> liftIO $ refreshDir fileStore path f
- PackageRecord p -> liftIO $ refreshPackage fileStore path p
+ DirRecord f -> refreshDir fileStore path f
+ PackageRecord p -> refreshPackage fileStore path p
_ -> ideMessage Normal (__ "Unexpected Activation in Files Pane")) ideR
on sel treeSelectionSelectionChanged $ do
paths <- treeSelectionGetSelectedRows sel
@@ -173,8 +175,8 @@
reflectIDE (
case record of
FileRecord _ -> return ()
- DirRecord f -> liftIO $ refreshDir fileStore path f
- PackageRecord p -> liftIO $ refreshPackage fileStore path p
+ DirRecord f -> refreshDir fileStore path f
+ PackageRecord p -> refreshPackage fileStore path p
_ -> ideMessage Normal (__ "Unexpected Selection in Files Pane")) ideR
return (Just files,[ConnectC cid1])
@@ -183,6 +185,7 @@
getFiles Nothing = forceGetPane (Right "*Files")
getFiles (Just pp) = forceGetPane (Left pp)
+-- | Tries to get the 'FileRecord' of the selected node in the 'TreeView'
getSelectionFileRecord :: TreeView
-> TreeStore FileRecord
-> IO (Maybe FileRecord)
@@ -193,40 +196,81 @@
p:_ -> Just <$> treeStoreGetValue fileStore p
_ -> return Nothing
+
+-- | Refreshes the Files pane, lists all package directories and synchronizes the expanded
+-- folders with the file system
refreshFiles :: IDEAction
refreshFiles = do
files <- getFiles Nothing
let store = fileStore files
+ let view = treeView files
mbWS <- readIDE workspace
- liftIO $ setDirectories store Nothing $ map PackageRecord $ maybe [] wsPackages mbWS
+ let packages = maybe [] wsPackages mbWS
+ setDirectories store Nothing $ map PackageRecord packages
-dirContents :: FilePath -> IO [FileRecord]
+ forM_ (zip [0..] packages) $ \(n, package) -> do
+ refreshRecursively store [n] view
+
+-- | Returns the 'FileRecord's at the given 'FilePath'.
+dirContents :: FilePath -> IDEM [FileRecord]
dirContents dir = do
- contents <- filter ((/= '.') . head) <$> getDirectoryContents dir
- `catch` \ (e :: IOError) -> return []
- records <- forM contents $ \f -> do
+ prefs <- readIDE prefs
+ contents <- liftIO $ getDirectoryContents dir
+ `catch` \ (e :: IOError) -> return []
+ let filtered = if showHiddenFiles prefs
+ then filter (`notElem` [".", ".."]) contents
+ else filter ((/= '.') . head) contents
+ records <- forM filtered $ \f -> do
let full = dir f
- isDir <- doesDirectoryExist full
+ isDir <- liftIO $ doesDirectoryExist full
return $ if isDir then DirRecord full else FileRecord full
return (sort records)
-refreshPackage :: TreeStore FileRecord -> TreePath -> IDEPackage -> IO ()
+
+-- | Recursively refreshes the file tree with the given TreePath as root. Only refreshes contents
+-- of expanded folders.
+refreshRecursively :: TreeStore FileRecord -> TreePath -> TreeView -> IDEAction
+refreshRecursively store path view = do
+ isExpanded <- liftIO $ treeViewRowExpanded view path
+ record <- liftIO $ treeStoreGetValue store path
+
+ when isExpanded $ do
+ case record of
+ DirRecord dir -> do
+ refreshDir store path dir
+ nChildren <- length . subForest <$> liftIO (treeStoreGetTree store path)
+ forM_ [0..nChildren-1] (\n -> refreshRecursively store (path ++ [n]) view)
+
+ PackageRecord package -> do
+ refreshPackage store path package
+ nChildren <- length . subForest <$> liftIO (treeStoreGetTree store path)
+ forM_ [0..nChildren-1] (\n -> refreshRecursively store (path ++ [n]) view)
+
+ _ -> return ()
+
+-- | Refreshes the child nodes of the package node at the given 'TreePath'. Also adds sandbox
+-- add-source dependencies as a 'PackageRecord'.
+refreshPackage :: TreeStore FileRecord -> TreePath -> IDEPackage -> IDEAction
refreshPackage store path p = do
let dir = ipdBuildDir p
- mbIter <- treeModelGetIter store path
+ mbIter <- liftIO $ treeModelGetIter store path
when (isJust mbIter) $ do
contents <- dirContents dir
setDirectories store mbIter $ map PackageRecord (ipdSandboxSources p) ++ contents
-refreshDir :: TreeStore FileRecord -> TreePath -> FilePath -> IO ()
-refreshDir store path dir = do
- mbIter <- treeModelGetIter store path
+
+-- | Refreshes the child nodes of the node at the given 'TreePath'.
+refreshDir :: TreeStore FileRecord -> TreePath -> FilePath -> IDEAction
+refreshDir store path dir = do
+ mbIter <- liftIO $ treeModelGetIter store path
when (isJust mbIter) $ do
contents <- dirContents dir
setDirectories store mbIter contents
-setDirectories :: TreeStore FileRecord -> Maybe TreeIter -> [FileRecord] -> IO ()
-setDirectories store parent records = do
+-- | Sets the child nodes of the given 'TreeIter' to the provided list of 'FileRecord's. If a record
+-- is already present, it is kept in the same (expanded) state.
+setDirectories :: TreeStore FileRecord -> Maybe TreeIter -> [FileRecord] -> IDEAction
+setDirectories store parent records = liftIO $ do
parentPath <- case parent of
Just i -> treeModelGetPath store i
_ -> return []
@@ -240,6 +284,9 @@
removeUntil record store path
_ -> do
treeStoreInsert store parentPath n record
+
+ -- Insert placeholder children for dirs and packages so they can
+ -- be expanded on clicking, and have the contents loaded "lazily".
case record of
DirRecord _ -> treeStoreInsert store (parentPath++[n]) 0 PlaceHolder
PackageRecord _ -> treeStoreInsert store (parentPath++[n]) 0 PlaceHolder
@@ -248,6 +295,11 @@
data FindResult = WhereExpected TreeIter | Found TreeIter | NotFound
+-- | Tries to find the given value in the 'TreeStore'. Only looks at the given 'TreeIter' and its
+-- sibling nodes to the right.
+-- Returns @WhereExpected iter@ if the records is found at the provided 'TreeIter'
+-- Returns @Found iter@ if the record is found at a sibling iter
+-- Returns @NotFound@ otherwise
find :: Eq a => a -> TreeStore a -> Maybe TreeIter -> IO FindResult
find _ _ Nothing = return NotFound
find a store (Just iter) = do
@@ -264,6 +316,9 @@
then return $ Found iter
else treeModelIterNext store iter >>= find'
+
+-- | Starting at the node at the given 'TreePath', removes all sibling nodes to the right
+-- until the given value is found.
removeUntil :: Eq a => a -> TreeStore a -> TreePath -> IO ()
removeUntil a store path = do
row <- treeStoreGetValue store path
@@ -271,6 +326,8 @@
found <- treeStoreRemove store path
when found $ removeUntil a store path
+
+-- | Starting at the node at the given 'TreePath', removes all sibling nodes to the right
removeRemaining :: TreeStore a -> TreePath -> IO ()
removeRemaining store path = do
found <- treeStoreRemove store path
diff --git a/src/IDE/Pane/Modules.hs b/src/IDE/Pane/Modules.hs
--- a/src/IDE/Pane/Modules.hs
+++ b/src/IDE/Pane/Modules.hs
@@ -1186,27 +1186,47 @@
dia <- dialogNew
set dia [ windowTransientFor := parent
, windowTitle := (__ "Construct new module") ]
+ windowSetDefaultSize dia 400 100
#ifdef MIN_VERSION_gtk3
upper <- dialogGetContentArea dia
#else
upper <- dialogGetUpper dia
#endif
lower <- dialogGetActionArea dia
- (widget,inj,ext,_) <- buildEditor (moduleFields sourceRoots hasLib exesTests)
+ (widget,inj,ext,_) <- buildEditor (moduleFields sourceRoots hasLib exesTests)
(AddModule modString (head sourceRoots) (Just False) Set.empty)
bb <- hButtonBoxNew
boxSetSpacing bb 6
buttonBoxSetLayout bb ButtonboxSpread
- 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)
+ cancel <- buttonNewFromStock "gtk-cancel"
+ ok <- buttonNewFromStock "gtk-ok"
+ boxPackEnd bb cancel PackNatural 0
+ boxPackEnd bb ok PackNatural 0
+
+ errorLabel <- labelNew (Nothing :: Maybe String)
+ labelSetLineWrap errorLabel True
+ widgetSetName errorLabel ("errorLabel" :: String)
+
+ on ok buttonActivated $ do
+ mbAddModule <- ext (AddModule modString (head sourceRoots) (Just False) Set.empty)
+ case mbAddModule of
+ Nothing -> return ()
+ Just am -> do
+ let mbModName = simpleParse $ T.unpack (moduleName am) :: Maybe ModuleName
+ case mbModName of
+ Just _ -> dialogResponse dia ResponseOk
+ Nothing -> do
+ boxPackStart (castToBox upper) errorLabel PackNatural 0
+ boxReorderChild (castToBox upper) errorLabel 0
+ labelSetText errorLabel ("Invalid module name, use uppercase identifiers seperated by dots. For example Some.New.Module" :: String)
+ widgetShow errorLabel
+
+
+ on cancel buttonActivated (dialogResponse dia ResponseCancel)
boxPackStart (castToBox upper) widget PackGrow 0
- boxPackStart (castToBox lower) bb PackNatural 5
- set save [widgetCanDefault := True]
- widgetGrabDefault save
+ boxPackEnd (castToBox lower) bb PackNatural 5
+ set ok [widgetCanDefault := True]
+ widgetGrabDefault ok
widgetShowAll dia
resp <- dialogRun dia
value <- ext (AddModule modString (head sourceRoots) (Just False) Set.empty)
@@ -1235,11 +1255,11 @@
++ (if hasLibs
then [
mkField
- (paraName <<<- ParaName ((__ "Is this an exposed library module"))
+ (paraName <<<- ParaName ((__ "Library should"))
$ emptyParams)
libExposed
(\ a b -> b{libExposed = a})
- (maybeEditor (boolEditor, emptyParams) True (__ "Expose module"))]
+ (maybeEditor (boolEditor, paraName <<<- ParaName ((__ "Expose module")) $ emptyParams) True (__ "Include module"))]
else [])
++ map (\ name ->
mkField
diff --git a/src/IDE/Pane/Preferences.hs b/src/IDE/Pane/Preferences.hs
--- a/src/IDE/Pane/Preferences.hs
+++ b/src/IDE/Pane/Preferences.hs
@@ -85,12 +85,13 @@
import Data.Monoid ((<>))
import Control.Applicative ((<$>))
import Distribution.Text (display, simpleParse)
+import IDE.Pane.Files (refreshFiles)
-- ---------------------------------------------------------------------
-- This needs to be incremented, when the preferences format changes
--
prefsVersion :: Int
-prefsVersion = 2
+prefsVersion = 3
--
-- | The Preferences Pane
@@ -114,9 +115,9 @@
saveState p = return Nothing
recoverState pp st = return Nothing
builder pp nb windows = do
- prefs <- readIDE prefs
+ initialPrefs <- readIDE prefs
configDir <- liftIO getConfigDir
- lastAppliedPrefsRef <- liftIO $ newIORef prefs
+ lastAppliedPrefsRef <- liftIO $ newIORef initialPrefs
packageInfos <- liftIO getInstalledPackageIds
let flatPrefsDesc = flattenFieldDescriptionPP (prefsDescription configDir packageInfos)
reifyIDE $ \ ideR -> do
@@ -124,45 +125,52 @@
bb <- hButtonBoxNew
boxSetSpacing bb 6
buttonBoxSetLayout bb ButtonboxSpread
- apply <- buttonNewFromStock "gtk-apply"
+ preview <- buttonNewFromStock "Preview"
restore <- buttonNewFromStock "Restore"
closeB <- buttonNewFromStock "gtk-cancel"
save <- buttonNewFromStock "gtk-save"
widgetSetSensitive save False
- boxPackStart bb apply PackNatural 0
+ boxPackStart bb preview PackNatural 0
boxPackStart bb restore PackNatural 0
boxPackEnd bb closeB PackNatural 0
boxPackEnd bb save PackNatural 0
(widget,injb,ext,notifier) <- buildEditor
- (extractFieldDescription $ prefsDescription configDir packageInfos) prefs
+ (extractFieldDescription $ prefsDescription configDir packageInfos) initialPrefs
boxPackStart vb widget PackGrow 0
label <- labelNew (Nothing :: Maybe Text)
boxPackStart vb label PackNatural 0
boxPackEnd vb bb PackNatural 5
let prefsPane = IDEPrefs vb
- on apply buttonActivated $ do
- mbNewPrefs <- extract prefs [ext]
+
+ let applyPrefs newPrefs = do
+ lastAppliedPrefs <- readIORef lastAppliedPrefsRef
+ reflectIDE (modifyIDE_ (\ide -> ide{prefs = newPrefs})) ideR
+ mapM_ (\f -> reflectIDE (applicator f newPrefs lastAppliedPrefs) ideR) flatPrefsDesc
+ writeIORef lastAppliedPrefsRef newPrefs
+
+ on preview buttonActivated $ do
+ mbNewPrefs <- extract initialPrefs [ext]
case mbNewPrefs of
Nothing -> return ()
- Just newPrefs -> do
- lastAppliedPrefs <- readIORef lastAppliedPrefsRef
- mapM_ (\f -> reflectIDE (applicator f newPrefs lastAppliedPrefs) ideR) flatPrefsDesc
- writeIORef lastAppliedPrefsRef newPrefs
- on restore buttonActivated (do
- lastAppliedPrefs <- readIORef lastAppliedPrefsRef
- mapM_ (\f -> reflectIDE (applicator f prefs lastAppliedPrefs) ideR) flatPrefsDesc
- injb prefs
- writeIORef lastAppliedPrefsRef prefs
+ Just newPrefs -> applyPrefs newPrefs
+
+ on restore buttonActivated $ do
+ applyPrefs initialPrefs
+
+ -- update the UI
+ injb initialPrefs
markLabel nb (getTopWidget prefsPane) False
widgetSetSensitive save False
- )
+
+
on save buttonActivated $ do
- lastAppliedPrefs <- readIORef lastAppliedPrefsRef
- mbNewPrefs <- extract prefs [ext]
+ mbNewPrefs <- extract initialPrefs [ext]
case mbNewPrefs of
Nothing -> return ()
Just newPrefs -> do
- mapM_ (\f -> reflectIDE (applicator f newPrefs lastAppliedPrefs) ideR ) flatPrefsDesc
+ applyPrefs newPrefs
+
+ -- save preferences to disk
fp <- getConfigFilePathForSave standardPreferencesFilename
writePrefs fp newPrefs
fp2 <- getConfigFilePathForSave strippedPreferencesFilename
@@ -173,14 +181,16 @@
SP.retrieveStrategy = retrieveStrategy newPrefs,
SP.serverPort = serverPort newPrefs,
SP.endWithLastConn = endWithLastConn newPrefs}
- reflectIDE (modifyIDE_ (\ide -> ide{prefs = newPrefs})) ideR
+
+ -- close the UI
reflectIDE (void (closePane prefsPane)) ideR
+
on closeB buttonActivated $ do
- mbP <- extract prefs [ext]
+ mbP <- extract initialPrefs [ext]
let hasChanged = case mbP of
Nothing -> False
Just p -> p{prefsFormat = 0, prefsSaveTime = ""} /=
- prefs{prefsFormat = 0, prefsSaveTime = ""}
+ initialPrefs{prefsFormat = 0, prefsSaveTime = ""}
if not hasChanged
then reflectIDE (void (closePane prefsPane)) ideR
else do
@@ -192,17 +202,19 @@
resp <- dialogRun md
widgetDestroy md
case resp of
- ResponseYes -> reflectIDE (void (closePane prefsPane)) ideR
+ ResponseYes -> do
+ applyPrefs initialPrefs
+ reflectIDE (void (closePane prefsPane)) ideR
_ -> return ()
registerEvent notifier FocusIn (\e -> do
reflectIDE (makeActive prefsPane) ideR
return (e{gtkReturn=False}))
registerEvent notifier MayHaveChanged (\ e -> do
- mbP <- extract prefs [ext]
+ mbP <- extract initialPrefs [ext]
let hasChanged = case mbP of
Nothing -> False
Just p -> p{prefsFormat = 0, prefsSaveTime = ""} /=
- prefs{prefsFormat = 0, prefsSaveTime = ""}
+ initialPrefs{prefsFormat = 0, prefsSaveTime = ""}
when (isJust mbP) $ labelSetMarkup label ("" :: Text)
markLabel nb (getTopWidget prefsPane) hasChanged
widgetSetSensitive save hasChanged
@@ -459,6 +471,14 @@
paraName <<<- ParaName "Y" $ emptyParams))
(\a -> return ())
, mkFieldPP
+ (paraName <<<- ParaName (__ "Show hidden files in file tree") $ emptyParams)
+ (PP.text . show)
+ boolParser
+ showHiddenFiles
+ (\b a -> a {showHiddenFiles = b})
+ boolEditor
+ (\b -> refreshFiles)
+ , mkFieldPP
(paraName <<<- ParaName (__ "Use ctrl Tab for Notebook flipper") $ emptyParams)
(PP.text . show)
boolParser
@@ -838,6 +858,7 @@
, serverPort = 11111
, serverIP = "127.0.0.1"
, endWithLastConn = True
+ , showHiddenFiles = False
}
-- ------------------------------------------------------------
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
@@ -416,6 +416,13 @@
_ -> False
unless isOldContext $ do
liftIO $ debugM "lekash" "markRefInSourceBuf calling applyTagByName"
+ lineStart <- backwardToLineStartC iter
+ createMark sv tagName lineStart (
+ case logRefType logRef of
+ ErrorRef -> "dialog-error"
+ WarningRef -> "dialog-warning"
+ BreakpointRef -> "media-playback-pause"
+ ContextRef -> "media-playback-start") $ refDescription logRef
applyTagByName ebuf tagName iter iter2
when scrollTo $ do
ideR <- ask
@@ -1381,10 +1388,9 @@
when hasSelection $ do
realString <- if useCandy then stringToCandy candy' str else return str
(_,i) <- getSelectionBounds ebuf
- mark <- createMark ebuf i True
insert ebuf i realString
- i1 <- getIterAtMark ebuf mark
- i2 <- forwardCharsC i1 (T.length str)
+ (_,i1) <- getSelectionBounds ebuf
+ i2 <- forwardCharsC i1 (T.length realString)
selectRange ebuf i1 i2
-- | Returns the package, to which this buffer belongs, if possible
diff --git a/src/IDE/SourceCandy.hs b/src/IDE/SourceCandy.hs
--- a/src/IDE/SourceCandy.hs
+++ b/src/IDE/SourceCandy.hs
@@ -44,6 +44,10 @@
(pack, singleton, replicate, head, takeWhile, isSuffixOf, length,
index)
import Data.Monoid ((<>))
+import Control.Monad.IO.Class (MonadIO(..))
+import Graphics.UI.Gtk.SourceView (sourceBufferNew)
+import Graphics.UI.Gtk.Multiline.TextBuffer
+ (textBufferGetIterAtMark, textBufferCreateMark, textBufferSetText)
---------------------------------------------------------------------------------
-- * Implementation
@@ -163,6 +167,12 @@
endUserAction ebuf
setModified ebuf modified
+simpleGtkBuffer :: Text -> IDEM (EditorBuffer GtkSourceView)
+simpleGtkBuffer contents = liftIO $ GtkBuffer <$> do
+ buffer <- sourceBufferNew Nothing
+ textBufferSetText buffer contents
+ return buffer
+
getCandylessText :: TextEditor editor => CandyTable -> EditorBuffer editor -> IDEM Text
getCandylessText (CT(_,transformTableBack)) ebuf = do
i1 <- getStartIter ebuf
@@ -194,6 +204,10 @@
text2 <- getText workBuffer i1 i2 True
return text2
+-- We only need a TextMark here not a SourceMark
+createTextMark (GtkBuffer sb) (GtkIter i) leftGravity = liftIO $ textBufferCreateMark sb Nothing i leftGravity
+getIterAtTextMark (GtkBuffer sb) m = liftIO $ GtkIter <$> textBufferGetIterAtMark sb m
+
positionFromCandy :: TextEditor editor => CandyTable -> EditorBuffer editor -> (Int,Int) -> IDEM (Int,Int)
positionFromCandy candyTable ebuf (line,column) = do
i1 <- getIterAtLine ebuf (max 0 (line - 1))
@@ -201,9 +215,9 @@
text <- getText ebuf i1 i2 True
workBuffer <- simpleGtkBuffer text
i3 <- getIterAtOffset workBuffer column
- mark <- createMark workBuffer i3 True
+ mark <- createTextMark workBuffer i3 True
transformFromCandy candyTable workBuffer
- i4 <- getIterAtMark workBuffer mark
+ i4 <- getIterAtTextMark workBuffer mark
columnNew <- getLineOffset i4
return (line,columnNew)
@@ -215,9 +229,9 @@
workBuffer <- simpleGtkBuffer text
transformFromCandy candyTable workBuffer
i3 <- getIterAtOffset workBuffer column
- mark <- createMark workBuffer i3 True
+ mark <- createTextMark workBuffer i3 True
transformToCandy candyTable workBuffer (\ _ -> False)
- i4 <- getIterAtMark workBuffer mark
+ i4 <- getIterAtTextMark workBuffer mark
columnNew <- getLineOffset i4
return (line,columnNew)
diff --git a/src/IDE/TextEditor/Class.hs b/src/IDE/TextEditor/Class.hs
--- a/src/IDE/TextEditor/Class.hs
+++ b/src/IDE/TextEditor/Class.hs
@@ -49,9 +49,11 @@
canRedo :: EditorBuffer editor -> IDEM Bool
canUndo :: EditorBuffer editor -> IDEM Bool
copyClipboard :: EditorBuffer editor -> Clipboard -> IDEM ()
- createMark :: EditorBuffer editor
+ createMark :: EditorView editor
+ -> Text
-> EditorIter editor
- -> Bool
+ -> Text
+ -> Text
-> IDEM (EditorMark editor)
cutClipboard :: EditorBuffer editor -> Clipboard -> Bool -> IDEM ()
delete :: EditorBuffer editor -> EditorIter editor -> EditorIter editor -> IDEM ()
diff --git a/src/IDE/TextEditor/CodeMirror.hs b/src/IDE/TextEditor/CodeMirror.hs
--- a/src/IDE/TextEditor/CodeMirror.hs
+++ b/src/IDE/TextEditor/CodeMirror.hs
@@ -155,9 +155,7 @@
lastLine = js0 "lastLine"
getRange = js2 "getRange"
setValue = js1 "setValue"
-setBookmark = js1 "setBookmark"
setBookmark' = js2 "setBookmark"
-insertLeft = js "insertLeft"
find = js0 "find"
from = js "from"
getCursor :: (MakeValueRef a0, MakeObjectRef o) => a0 -> IndexPreservingGetter o (JSM JSValueRef)
@@ -263,15 +261,11 @@
m <- codeMirror
lift $ (m ^. historySize ^. undo') >>= valToBool
copyClipboard (CMBuffer cm) _ = return () -- TODO
- createMark (CMBuffer cm) (CMIter _ i) leftGravity = runCM cm $ do
+ createMark (CMView cm) _name (CMIter _ i) _icon _tooltip = runCM cm $ do
m <- codeMirror
- lift $ do
- CMMark <$> if leftGravity
- then m ^. setBookmark i
- else do
- o <- obj
- o ^. insertLeft <# True
- m ^. setBookmark' i o
+ lift $ CMMark <$> do
+ o <- obj
+ m ^. setBookmark' i o
cutClipboard (CMBuffer cm) _ _ = return () -- TODO
delete (CMBuffer cm) (CMIter _ first) (CMIter _ last) = runCM cm $ do
m <- codeMirror
diff --git a/src/IDE/TextEditor/GtkSourceView.hs b/src/IDE/TextEditor/GtkSourceView.hs
--- a/src/IDE/TextEditor/GtkSourceView.hs
+++ b/src/IDE/TextEditor/GtkSourceView.hs
@@ -27,7 +27,6 @@
, GtkSourceView(..)
, newGtkBuffer
- , simpleGtkBuffer
) where
@@ -82,7 +81,9 @@
import Data.Typeable (Typeable)
import Control.Applicative ((<$>))
import Graphics.UI.Gtk.SourceView
- (sourceStyleSchemeManagerAppendSearchPath, sourceViewSetTabWidth,
+ (sourceBufferCreateSourceMark, SourceMark,
+ sourceViewSetShowLineMarks,
+ sourceStyleSchemeManagerAppendSearchPath, sourceViewSetTabWidth,
sourceViewSetShowLineNumbers, sourceViewSetRightMarginPosition,
sourceViewSetShowRightMargin, sourceViewSetIndentWidth,
castToSourceBuffer, sourceViewSetDrawSpaces, sourceBufferUndo,
@@ -121,6 +122,14 @@
import Data.Text (Text)
import qualified Data.Text as T (all, length, pack)
import Data.Monoid ((<>))
+import Graphics.UI.Gtk.Multiline.TextBuffer
+ (textBufferDeleteMark, textBufferGetMark)
+import Graphics.UI.Gtk.SourceView.SourceMarkAttributes
+ (queryTooltipText, sourceMarkAttributesSetIconName,
+ sourceMarkAttributesNew)
+import Graphics.UI.Gtk.SourceView.SourceView
+ (sourceViewSetMarkAttributes)
+import Graphics.UI.Gtk.Multiline.TextMark (toTextMark)
transformGtkIter :: EditorIter GtkSourceView -> (TextIter -> IO a) -> IDEM (EditorIter GtkSourceView)
transformGtkIter (GtkIter i) f = do
@@ -180,7 +189,13 @@
canRedo (GtkBuffer sb) = liftIO $ sourceBufferGetCanRedo sb
canUndo (GtkBuffer sb) = liftIO $ sourceBufferGetCanUndo sb
copyClipboard (GtkBuffer sb) clipboard = liftIO $ textBufferCopyClipboard sb clipboard
- createMark (GtkBuffer sb) (GtkIter i) leftGravity = liftIO $ GtkMark <$> textBufferCreateMark sb Nothing i leftGravity
+ createMark (GtkView sv) name (GtkIter i) icon tooltip = liftIO $ do
+ attributes <- sourceMarkAttributesNew
+ sourceMarkAttributesSetIconName attributes (Just icon)
+ on attributes queryTooltipText $ \ mark -> return tooltip
+ sourceViewSetMarkAttributes sv name (Just attributes) 1
+ sb <- castToSourceBuffer <$> get sv textViewBuffer
+ GtkMark . toTextMark <$> sourceBufferCreateSourceMark sb (Just name) name i
cutClipboard (GtkBuffer sb) clipboard defaultEditable = liftIO $ textBufferCutClipboard sb clipboard defaultEditable
delete (GtkBuffer sb) (GtkIter first) (GtkIter last) = liftIO $
textBufferDelete sb first last
@@ -219,6 +234,7 @@
sourceViewSetIndentOnTab sv True
sourceViewSetAutoIndent sv True
sourceViewSetSmartHomeEnd sv SourceSmartHomeEndBefore
+ sourceViewSetShowLineMarks sv True
if wrapLines prefs
then textViewSetWrapMode sv WrapWord
else textViewSetWrapMode sv WrapNone
@@ -234,6 +250,10 @@
first <- textBufferGetStartIter sb
last <- textBufferGetEndIter sb
textBufferRemoveTagByName sb name first last
+ mbMark <- textBufferGetMark sb name
+ case mbMark of
+ Just mark -> textBufferDeleteMark sb mark
+ Nothing -> return ()
selectRange (GtkBuffer sb) (GtkIter first) (GtkIter last) = liftIO $
textBufferSelectRange sb first last
setModified (GtkBuffer sb) modified = liftIO $ textBufferSetModified sb modified >> return ()
@@ -447,11 +467,4 @@
-- Tag
background (GtkTag t) color = liftIO $ set t [textTagBackground := T.pack $ colorHexString color]
underline (GtkTag t) value = liftIO $ set t [textTagUnderline := value]
-
-simpleGtkBuffer :: Text -> IDEM (EditorBuffer GtkSourceView)
-simpleGtkBuffer contents = liftIO $ GtkBuffer <$> do
- buffer <- sourceBufferNew Nothing
- textBufferSetText buffer contents
- return buffer
-
diff --git a/src/IDE/TextEditor/Yi.hs b/src/IDE/TextEditor/Yi.hs
--- a/src/IDE/TextEditor/Yi.hs
+++ b/src/IDE/TextEditor/Yi.hs
@@ -155,8 +155,8 @@
canRedo (YiBuffer fb) = return True -- TODO
canUndo (YiBuffer fb) = return True -- TODO
copyClipboard (YiBuffer fb) _ = liftYi $ withEditor $ copy
- createMark (YiBuffer b) (YiIter (Iter _ p)) leftGravity = withYiBuffer b $
- YiMark <$> newMarkB (MarkValue p (if leftGravity then Backward else Forward))
+ createMark (YiView b) _name (YiIter (Iter _ p)) _icon _description = withYiBuffer b $
+ YiMark <$> newMarkB (MarkValue p Backward)
cutClipboard (YiBuffer fb) clipboard defaultEditable = liftYi $ withEditor $ cut
delete (YiBuffer b) (YiIter (Iter _ first)) (YiIter (Iter _ last)) =
withYiBuffer b $ deleteRegionB $ mkRegion first last
diff --git a/src/IDE/Utils/ServerConnection.hs b/src/IDE/Utils/ServerConnection.hs
--- a/src/IDE/Utils/ServerConnection.hs
+++ b/src/IDE/Utils/ServerConnection.hs
@@ -69,7 +69,7 @@
Nothing -> do
prefs' <- readIDE prefs
handle <- reifyIDE $ \ideR ->
- catch (connectTo (T.unpack $ serverIP prefs') (PortNumber(PortNum (fromIntegral $ serverPort prefs'))))
+ catch (connectTo (T.unpack $ serverIP prefs') (PortNumber (fromIntegral $ serverPort prefs')))
(\(exc :: SomeException) -> do
catch (startServer (serverPort prefs'))
(\(exc :: SomeException) -> throwIDE ("Can't start leksah-server" <> T.pack (show exc)))
@@ -111,7 +111,7 @@
waitForServer prefs s = do
threadDelay 100000 -- 0.1 second
catch (do
- handle <- liftIO $ connectTo (T.unpack $ serverIP prefs) (PortNumber(PortNum (fromIntegral $ serverPort prefs)))
+ handle <- liftIO $ connectTo (T.unpack $ serverIP prefs) (PortNumber (fromIntegral $ serverPort prefs))
return (Just handle))
(\(exc :: SomeException) -> waitForServer prefs (s-1))