module IDE.NotebookFlipper (
flipDown
, flipUp
) where
import Graphics.UI.Gtk
(treeSelectionGetSelectedRows,
treeSelectionSelectionChanged, treeViewGetSelection, rowActivated,
treeViewSetCursor, treeViewGetCursor, treeModelIterNChildren,
treeViewGetModel, treeViewRowActivated, treeViewGetColumn,
widgetShowAll, windowWindowPosition, widgetDestroy, widgetHide,
listStoreGetValue, keyReleaseEvent,
treeViewHeadersVisible, cellText, cellLayoutSetAttributes,
treeViewColumnPackStart, cellRendererTextNew, treeViewAppendColumn,
treeViewColumnNew, treeViewSetModel, listStoreNew, treeViewNew,
containerAdd, windowResizable, windowTransientFor,
windowNewPopup, TreeViewClass, WindowPosition(..),
signalDisconnect, AttrOp(..), set, EventM, EKey, eventKeyName,
windowGetSize, windowTypeHint, WindowTypeHint(..), windowDecorated,
windowDefaultWidth, windowDefaultHeight, scrolledWindowNew)
import IDE.Core.State hiding (window, name)
import Control.Monad (when)
import IDE.Pane.SourceBuffer(recentSourceBuffers)
import Control.Monad.IO.Class (MonadIO(..))
import System.Glib.Signals (on)
import qualified Control.Monad.Reader as Gtk (liftIO)
flipDown :: IDEAction
flipDown = do
currentState' <- readIDE currentState
case currentState' of
IsFlipping tv -> moveFlipperDown tv
IsRunning -> initFlipper True
_ -> return ()
flipUp :: IDEAction
flipUp = do
currentState' <- readIDE currentState
case currentState' of
IsFlipping tv -> moveFlipperUp tv
IsRunning -> initFlipper False
_ -> return ()
moveFlipperDown :: TreeViewClass alpha => alpha -> IDEAction
moveFlipperDown tree = liftIO $ do
mbStore <- treeViewGetModel tree
case mbStore of
Nothing -> throwIDE "NotebookFlipper>>setFlipper: no store"
Just store -> do
n <- treeModelIterNChildren store Nothing
when (n /= 0) $ do
(cl, _) <- treeViewGetCursor tree
case cl of
(current:_) -> let next = if current == n 1
then 0
else current + 1
in treeViewSetCursor tree [min (n1) next] Nothing
[] -> treeViewSetCursor tree [1] Nothing
moveFlipperUp :: TreeViewClass alpha => alpha -> IDEAction
moveFlipperUp tree = liftIO $ do
mbStore <- treeViewGetModel tree
case mbStore of
Nothing -> throwIDE "NotebookFlipper>>setFlipper: no store"
Just store -> do
n <- treeModelIterNChildren store Nothing
when (n /= 0) $ do
(cl, _) <- treeViewGetCursor tree
case cl of
(current:_) -> let next = if current == 0
then n 1
else current 1
in treeViewSetCursor tree [min (n1) next] Nothing
[] -> treeViewSetCursor tree [n1] Nothing
initFlipper :: Bool -> IDEAction
initFlipper direction = do
mainWindow <- getMainWindow
recentPanes' <- recentSourceBuffers
(tree', store') <- reifyIDE $ \ideR -> do
window <- windowNewPopup
(_, height) <- windowGetSize mainWindow
set window [
windowTypeHint := WindowTypeHintUtility,
windowDecorated := False,
windowResizable := True,
windowDefaultWidth := 200,
windowDefaultHeight := height,
windowTransientFor := mainWindow]
scrolledWindow <- scrolledWindowNew Nothing Nothing
containerAdd window scrolledWindow
tree <- treeViewNew
containerAdd scrolledWindow tree
store <- listStoreNew recentPanes'
treeViewSetModel tree store
column <- treeViewColumnNew
_ <- treeViewAppendColumn tree column
renderer <- cellRendererTextNew
treeViewColumnPackStart column renderer True
cellLayoutSetAttributes column renderer store
(\str -> [ cellText := str])
set tree [treeViewHeadersVisible := False]
cid <- mainWindow `on` keyReleaseEvent $ handleKeyRelease tree ideR
_ <- tree `on` rowActivated $ \treePath _column -> do
signalDisconnect cid
let [row] = treePath
string <- listStoreGetValue store row
reflectIDE (do
mbPane <- mbPaneFromName string
case mbPane of
Just (PaneC pane) -> do
makeActive pane
modifyIDE_ $ \ide -> ide{
recentPanes = paneName pane : filter (/= paneName pane) (recentPanes ide)}
Nothing -> return ()) ideR
widgetHide window
widgetDestroy window
reflectIDE (modifyIDE_ (\ide -> ide{currentState = IsRunning})) ideR
treeSelection <- treeViewGetSelection tree
_ <- treeSelection `on` treeSelectionSelectionChanged $ do
rows <- treeSelectionGetSelectedRows treeSelection
case rows of
[[row]] -> do
string <- listStoreGetValue store row
reflectIDE (do
mbPane <- mbPaneFromName string
case mbPane of
Just (PaneC pane) -> makeActive pane
Nothing -> return ()) ideR
_ -> return ()
set window [windowWindowPosition := WinPosCenterOnParent]
widgetShowAll window
return (tree, store)
modifyIDE_ (\ide -> ide{currentState = IsFlipping tree'})
liftIO $ do
n <- treeModelIterNChildren store' Nothing
treeViewSetCursor tree' [if direction then min 1 (n 1) else n 1] Nothing
return ()
handleKeyRelease :: TreeViewClass alpha => alpha -> IDERef -> EventM EKey Bool
handleKeyRelease tree ideR = do
name <- eventKeyName
Gtk.liftIO $ case name of
ctrl | (ctrl == "Control_L") || (ctrl == "Control_R") -> do
currentState' <- reflectIDE (readIDE currentState) ideR
case currentState' of
IsFlipping _tv -> do
(treePath, _) <- treeViewGetCursor tree
Just column <- treeViewGetColumn tree 0
treeViewRowActivated tree treePath column
return False
_ -> return False
_ -> return False