Permalink
Browse files

changes for billeksah

  • Loading branch information...
1 parent 48af6cb commit 17e3b3446f2f4c5da1883ec337c619fbf92d830e @jutaro jutaro committed Nov 1, 2011
View
@@ -1,3 +1,4 @@
+*~
dist/
/*.lkshf
/.DS_Store
@@ -117,7 +117,7 @@ mySessionExt = [GenS (SessionExtension "dummy" (return 5)
(\ i -> liftIO $ putStrLn ("recovery2 " ++ show (i + 0.1))))]
openDummy :: StateM ()
-openDummy = (getOrBuildDisplay (Left []) True :: StateM (Maybe DummyPane)) >> return ()
+openDummy = (getOrBuildDisplay (Left []) True () :: StateM (Maybe DummyPane)) >> return ()
-- ----------------------------------------------
-- * It's a pane
@@ -133,6 +133,7 @@ data DummyPaneState = DPState
instance PaneInterface DummyPane where
data PaneState DummyPane = DummyPaneState
deriving(Eq,Ord,Read,Show)
+ type PaneArgs DummyPane = ()
getTopWidget = \ p -> castToWidget (sw p)
primPaneName = \ dp -> "Dummy"
paneType = \ _ -> "**Dummy"
@@ -142,7 +143,7 @@ instance PaneInterface DummyPane where
instance Pane DummyPane
-buildDummy panePath notebook window = do
+buildDummy _ panePath notebook window = do
reifyState $ \ stateR -> do
ibox <- vBoxNew False 0
button <- buttonNew
@@ -15,10 +15,20 @@ category: IDE
author: Juergen "jutaro" Nicklisch-Franken
tested-with: GHC ==7.0
data-files: LICENSE
+ data/plugins/billeksah-forms-1.0.0.lkshp
+ data/plugins/billeksah-pane-1.0.0.lkshp
+ data/plugins/Default.prefs
+ data/plugins/leksah.lkshc
+ data/plugins/leksah-dummy-1.0.0.lkshp
+ data/plugins/leksah-main-1.0.0.lkshp
+ data/plugins/leksah-plugin-pane-1.0.0.lkshp
+data-dir: ""
+
Library
exposed-modules:
Leksah
+ Graphics.MyMissingGtk
other-modules:
Paths_leksah_main
exposed: True
@@ -0,0 +1,40 @@
+{-# Language CPP #-}
+-----------------------------------------------------------------------------
+--
+-- Module : Graphics.MyMissingGtk
+-- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie
+-- License : GNU-GPL
+--
+-- Maintainer : Juergen Nicklisch-Franken <info@leksah.org>
+-- Stability : provisional
+-- Portability : portable
+--
+-- | Module for missing base functions
+--
+------------------------------------------------------------------------------
+
+module Graphics.MyMissingGtk (
+ colorHexString,
+ controlIsPressed
+) where
+
+import Numeric (showHex)
+import Graphics.UI.Gtk.Gdk.GC (Color(..))
+import qualified Graphics.UI.Gtk.Gdk.Events as G (Event(..))
+import qualified Graphics.UI.Gtk
+#if MIN_VERSION_gtk(0,10,5)
+import Graphics.UI.Gtk.Gdk.EventM (Modifier(..))
+#else
+import Graphics.UI.Gtk.Gdk.Enums (Modifier(..))
+#endif
+
+-- This should probably be in Gtk2Hs allong with a suitable parser
+colorHexString (Color r g b) = '#' : (pad $ showHex r "")
+ ++ (pad $ showHex g "")
+ ++ (pad $ showHex b "")
+ where pad s = replicate (4 - length s) '0' ++ s
+
+
+controlIsPressed :: G.Event -> Bool
+controlIsPressed (G.Button _ _ _ _ _ mods _ _ _) | Control `elem` mods = True
+controlIsPressed _ = False
View
@@ -18,6 +18,11 @@ module Leksah (
, LeksahEvent(..)
, getLeksahEvent
, triggerLeksahEvent
+
+-- * Renaming
+ , IDEM
+ , IDEAction
+ , reflectIDE
) where
import Base
@@ -37,6 +42,10 @@ import Control.Exception (catch, SomeException)
import System.FilePath((</>))
import Prelude hiding(catch)
+type IDEM = StateM
+type IDEAction = StateAction
+reflectIDE = reflectState
+
-- ------------------------------------------------
-- * It's a plugin
--
@@ -124,7 +133,7 @@ aboutDialog = do
aboutDialogSetComments d $ "An integrated development environement (IDE) for the " ++
"programming language Haskell and the Glasgow Haskell Compiler"
dd <- getDataDir
- license <- catch (readFile $ dd </> "LICENSE") (\ (_ :: SomeException) -> return "")
+ license <- catch(readFile $ dd </> "LICENSE") (\ (_ :: SomeException) -> return "")
aboutDialogSetLicense d $ Just license
aboutDialogSetWebsite d "http://leksah.org/"
aboutDialogSetAuthors d ["Jürgen Nicklisch-Franken","Hamish Mackenzie"]
@@ -62,13 +62,15 @@ getPluginPaneEvent = getEvent LeksahPluginPaneSel
data PluginPane = PluginPane {
ppTop :: VBox,
ppInj :: Injector Plugin,
- ppExt :: Extractor Plugin
+ ppExt :: Extractor Plugin,
+ ppEvent :: GEvent
} deriving (Typeable)
instance PaneInterface PluginPane where
data PaneState PluginPane = PPState (Maybe Plugin)
deriving(Read,Show)
+ type PaneArgs PluginPane = ()
getTopWidget = \ p -> castToWidget (ppTop p)
primPaneName = \ dp -> "Plugin"
@@ -78,7 +80,7 @@ instance PaneInterface PluginPane where
return $ Just (PPState mbVal)
recoverState = \ pp ps -> do
nb <- getNotebook pp
- mbP <- buildPane pp nb builder
+ mbP <- buildPanePrim pp nb (builder ())
case mbP of
Nothing -> return Nothing
Just p -> case ps of
@@ -97,7 +99,7 @@ openPluginPane (name,bounds) = do
case res of
Right errorStr -> message Error ("Can't find plugin: " ++ errorStr)
Left plugin -> do
- pane :: Maybe PluginPane <- getOrBuildDisplay (Left []) True
+ pane :: Maybe PluginPane <- getOrBuildDisplay (Left []) True ()
case pane of
Nothing -> return ()
Just p -> do
@@ -109,7 +111,7 @@ openPluginPane' plugin = do
currentConfigPath <- liftM dropFileName getCurrentConfigPath
choices <- liftIO $ getPrereqChoices (dropFileName currentConfigPath)
let choices' = filter (\ (n,_) -> n /= (plName plugin)) choices
- pane :: Maybe PluginPane <- getOrBuildDisplay (Left []) True
+ pane :: Maybe PluginPane <- getOrBuildDisplay (Left []) True ()
case pane of
Nothing -> return ()
Just p -> do
@@ -167,18 +169,44 @@ pluginDescr = VertBoxG defaultParams [
prerequisitesEditor mbDeleteHandler =
selectionEditor
- (ColumnDescr True
- [("Plugin",\ (pluginName',(_,_)) -> [cellText := pluginName'],Nothing),
- ("Lower",\ (_,(lower,_)) -> [cellText := showMbVersion lower],
- Just (\ row@(pn,(lower,upper)) str ->
- case parse boundParser "" str of
- Left _ -> row
- Right v -> (pn,(v,upper)))),
- ("Upper",\ (_,(_,upper)) -> [cellText := showMbVersion upper],
- Just (\ old@(pn,(lower,upper)) str ->
- case parse boundParser "" str of
- Left _ -> old
- Right v -> (pn,(lower,v))))])
+ (ColumnsDescr True [
+ ColumnDescr{
+ tcdLabel = "Plugin",
+ tcdRenderer = cellRendererTextNew,
+ tcdRenderFunc = \ (pluginName',(_,_)) -> [cellText := pluginName'],
+ tcdMbEditFunc = Nothing},
+ ColumnDescr{
+ tcdLabel = "Lower",
+ tcdRenderer = cellRendererTextNew,
+ tcdRenderFunc = \ (_,(lower,_)) -> [cellText := showMbVersion lower],
+ tcdMbEditFunc = Just (\ renderer listStore notifier stateR -> do
+ set renderer [cellTextEditable := True]
+ on renderer edited (\ (p:_) str -> do
+ row@(pn,(lower,upper)) <- listStoreGetValue listStore p
+ let newRow = case parse boundParser "" str of
+ Left _ -> row
+ Right v -> (pn,(v,upper))
+ listStoreSetValue listStore p newRow
+ reflectState (triggerGUIEvent notifier
+ dummyGUIEvent {geSelector = MayHaveChanged}) stateR
+ return ())
+ return ())},
+ ColumnDescr{
+ tcdLabel = "Upper",
+ tcdRenderer = cellRendererTextNew,
+ tcdRenderFunc = \ (_,(_,upper)) -> [cellText := showMbVersion upper],
+ tcdMbEditFunc = Just (\ renderer listStore notifier stateR -> do
+ set renderer [cellTextEditable := True]
+ on renderer edited (\ (p:_) str -> do
+ row@(pn,(lower,upper)) <- listStoreGetValue listStore p
+ let newRow = case parse boundParser "" str of
+ Left _ -> row
+ Right v -> (pn,(lower,v))
+ listStoreSetValue listStore p newRow
+ reflectState (triggerGUIEvent notifier
+ dummyGUIEvent {geSelector = MayHaveChanged}) stateR
+ return ())
+ return ())}])
(Just (\ (pluginName1,_) (pluginName2,_) -> compare pluginName1 pluginName2))
(Just (\ (pluginName1,_) (pluginName2,_) -> pluginName1 == pluginName2))
mbDeleteHandler
@@ -190,8 +218,8 @@ prerequisitesEditor mbDeleteHandler =
-- * Building the forms pane in standard form
--
-buildPluginPane :: PanePath -> Notebook -> Window -> StateM (Maybe PluginPane, Connections)
-buildPluginPane = \ pp nb w -> makeValue >>= \ initial ->
+buildPluginPane :: () -> PanePath -> Notebook -> Window -> StateM (Maybe PluginPane, Connections)
+buildPluginPane _ pp nb w = makeValue >>= \ initial ->
(buildFormsPane pluginDescr initial formPaneDescr) pp nb w
where
@@ -202,7 +230,7 @@ buildPluginPane = \ pp nb w -> makeValue >>= \ initial ->
return defaultPlugin{plChoices = choices}
formPaneDescr :: FormPaneDescr Plugin PluginPane = FormPaneDescr {
- fpGetPane = \ top inj ext -> PluginPane top inj ext,
+ fpGetPane = \ top inj ext gevent -> PluginPane top inj ext gevent,
fpSaveAction = \ v -> do
currentConfigPath <- getCurrentConfigPath
liftIO $ writePluginDescr (dropFileName currentConfigPath
@@ -78,7 +78,7 @@ myPaneTypes =
openPluginConfigPane :: StateM ()
openPluginConfigPane = do
message Debug "Open plugin config pane"
- mbPane :: Maybe PluginConfigPane <- getOrBuildDisplay (Left []) True
+ mbPane :: Maybe PluginConfigPane <- getOrBuildDisplay (Left []) True ()
case mbPane of
Nothing -> return ()
Just p -> registerRefresh p >> return ()
@@ -106,21 +106,23 @@ registerRefresh pane = getPluginPaneEvent >>= (\e -> registerEvent' e handler)
data PluginConfigPane = PluginConfigPane {
pcpTopW :: VBox,
pcpInj :: Injector PluginConfig,
- pcpExt :: Extractor PluginConfig
+ pcpExt :: Extractor PluginConfig,
+ pcpEvent :: GEvent
} deriving Typeable
instance PaneInterface PluginConfigPane where
data PaneState PluginConfigPane = PCPaneState
deriving(Read,Show)
+ type PaneArgs PluginConfigPane = ()
getTopWidget = \ p -> castToWidget (pcpTopW p)
primPaneName = \ dp -> "PluginConfig"
paneType = \ _ -> "**PluginConfig"
saveState = \ s -> return $ Just (PCPaneState)
recoverState = \ pp ps -> do
nb <- getNotebook pp
- mbP <- buildPane pp nb builder
+ mbP <- buildPanePrim pp nb (builder ())
return mbP
builder = buildPluginConfigPane
@@ -191,9 +193,9 @@ deleteHandler' currentConfigPath (name,bounds) = do
-- ----------------------------------------------
-- * Building the pane in standard form
--
-buildPluginConfigPane :: PanePath -> Notebook -> Window
+buildPluginConfigPane :: () -> PanePath -> Notebook -> Window
-> StateM (Maybe PluginConfigPane, Connections)
-buildPluginConfigPane = \ pp nb w -> do
+buildPluginConfigPane _ pp nb w = do
initialValue <- makeValue
(buildFormsPane pluginConfDescr initialValue formPaneDescr) pp nb w
where
@@ -204,7 +206,7 @@ buildPluginConfigPane = \ pp nb w -> do
return $ pluginConfig{cfChoices = prerequisites ++ cfPlugins pluginConfig}
formPaneDescr :: FormPaneDescr PluginConfig PluginConfigPane =
FormPaneDescr {
- fpGetPane = \ top inj ext -> PluginConfigPane top inj ext,
+ fpGetPane = PluginConfigPane,
fpSaveAction = \ v -> do
currentConfigPath <- getCurrentConfigPath
liftIO $ writePluginConfig currentConfigPath v

0 comments on commit 17e3b34

Please sign in to comment.