leksah-0.16.2.2: src/IDE/TextEditor/Yi.hs
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE OverloadedStrings #-}
-----------------------------------------------------------------------------
--
-- Module : IDE.TextEditor.Yi
-- Copyright : 2007-2013 Juergen Nicklisch-Franken, Hamish Mackenzie
-- License : GPL Nothing
--
-- Maintainer : maintainer@leksah.org
-- Stability : provisional
-- Portability :
--
-- |
--
-----------------------------------------------------------------------------
module IDE.TextEditor.Yi (
Yi(..)
#ifdef LEKSAH_WITH_YI
, TextEditor(..)
, EditorBuffer(..)
, EditorView(..)
, EditorIter(..)
, EditorMark(..)
, EditorTag(..)
, EditorTagTable(..)
, newYiBuffer
#endif
) where
import Data.Typeable (Typeable)
#ifdef LEKSAH_WITH_YI
import Data.Text (Text)
import qualified Data.Text as T (pack, unpack)
import GI.Gtk
(noWidget, getCurrentEventTime, menuPopup, menuAttachToWidget,
menuNew, onWidgetPopupMenu, onWidgetKeyReleaseEvent,
onWidgetLeaveNotifyEvent, onWidgetMotionNotifyEvent,
onWidgetKeyPressEvent, onWidgetButtonReleaseEvent,
onWidgetButtonPressEvent, widgetAddEvents, afterWidgetFocusInEvent,
widgetGrabFocus, toWidget, widgetGetWindow)
import GI.Gdk
(getEventButtonState)
import Graphics.UI.Frame.Rectangle
(Rectangle(..), newRectangle)
import Data.GI.Base.Attributes (AttrOp(..))
import GI.Pango (layoutSetFontDescription)
import Yi (nelemsB, readAtB, moveB)
import Yi.Buffer.TextUnit (TextUnit(..))
import GI.Gdk.Flags (ModifierType(..), EventMask(..))
import Control.Monad (void)
import qualified Yi.Rope as R (head)
import IDE.Core.Types (MonadIDE(..))
import Data.GI.Base.BasicConversions (gflagsToWord)
import IDE.TextEditor.Class (TextEditor(..))
import IDE.Core.Types (IDEM)
import IDE.Core.State (liftYi, onIDE, reflectIDE, liftYiControl)
import qualified Yi.UI.Pango.Control as Yi
(getBuffer, setText, newView, getText, newBuffer)
import Yi.UI.Pango.Control
(Control(..), View(..), iterFBufRef, Iter(..), fBufRef, Buffer(..),
setBufferMode)
import Yi
(moveToColB, gotoLn, atSol, atEof, atSof, curCol, curLn, readLnB,
nextWordB, moveToEol, rightB, rightN,
unitWord, atBoundaryB, moveToSol, prevWordB, leftB, readB,
doUntilB_, prevPointB, Mode, modifyMode, insertingA, undoB,
markSavedB, setSelectRegionB, redoB, markPointA, insertNAt,
regionIsEmpty, regionEnd, regionStart, selMark, isUnchangedBuffer,
Point(..), MarkValue(..), lineOf, pointOfLineColB,
askMarks, insMark, sizeB, getRawestSelectRegionB, mkRegion,
deleteRegionB, newMarkB, Mark, pointB, moveTo, savingPointB, Point,
withGivenBuffer, withEditor, BufferM, BufferRef, Mode(..),
IndentSettings(..), BufferId(..))
import qualified Yi.Rope as Yi (length, fromText)
import Control.Applicative ((<$>))
import Yi.Keymap.Cua (paste, cut, copy)
import Yi.Buffer.Basic (Direction(..))
import Control.Monad.State.Class (gets)
import Control.Monad (unless)
import Control.Monad.IO.Class (MonadIO(..))
import Data.Time (getCurrentTime)
import IDE.Utils.GUIUtils (fontDescription)
import Control.Monad.Reader.Class (MonadReader(..))
import Graphics.UI.Editor.Basics (Connection(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Control.Lens (use)
#endif
data Yi = Yi deriving( Typeable, Show )
#ifdef LEKSAH_WITH_YI
newYiBuffer :: Maybe FilePath -> Text -> IDEM (EditorBuffer Yi)
newYiBuffer mbFilename contents = do
liftYiControl $ do
let (filename, id) = case mbFilename of
Just fn -> (fn, FileBuffer fn)
Nothing -> ("Unknown.hs", MemBuffer "*leksah*")
buffer <- Yi.newBuffer id $ Yi.fromText contents
setBufferMode filename buffer
return $ YiBuffer buffer
withYiBuffer' :: BufferRef -> BufferM a -> IDEM a
withYiBuffer' b f = liftYi $ withEditor $ withGivenBuffer b f
withYiBuffer :: Buffer -> BufferM a -> IDEM a
withYiBuffer b f = withYiBuffer' (fBufRef b) f
mkYiIter' :: BufferRef -> Point -> EditorIter Yi
mkYiIter' b p = YiIter $ Iter b p
mkYiIter :: Buffer -> Point -> EditorIter Yi
mkYiIter b p = mkYiIter' (fBufRef b) p
withYiIter :: Iter -> BufferM a -> IDEM a
withYiIter (Iter b p) f = withYiBuffer' b $ do
savingPointB $ do
moveTo p
f
transformYiIter' :: Iter -> BufferM Point -> IDEM (EditorIter Yi)
transformYiIter' i f = mkYiIter' (iterFBufRef i) <$> withYiIter i f
transformYiIter :: Iter -> BufferM a -> IDEM (EditorIter Yi)
transformYiIter i f = transformYiIter' i (f >> pointB)
tryTransformYiIter' :: Iter -> BufferM Point -> IDEM (Maybe (EditorIter Yi))
tryTransformYiIter' i@(Iter b p) f = withYiIter i $ do
newPoint <- f
if p == newPoint
then return Nothing
else return . Just $ mkYiIter' b newPoint
tryTransformYiIter :: Iter -> BufferM a -> IDEM (Maybe (EditorIter Yi))
tryTransformYiIter i f = tryTransformYiIter' i (f >> pointB)
iterFromYiBuffer' :: BufferRef -> BufferM Point -> IDEM (EditorIter Yi)
iterFromYiBuffer' b f = mkYiIter' b <$> withYiBuffer' b f
iterFromYiBuffer :: Buffer -> BufferM Point -> IDEM (EditorIter Yi)
iterFromYiBuffer b f = iterFromYiBuffer' (fBufRef b) f
instance TextEditor Yi where
data EditorBuffer Yi = YiBuffer Buffer
data EditorView Yi = YiView View
data EditorMark Yi = YiMark Mark
data EditorIter Yi = YiIter Iter
data EditorTagTable Yi = YiTagTable
data EditorTag Yi = YiTag
newBuffer = newYiBuffer
applyTagByName (YiBuffer fb) name (YiIter first) (YiIter last) = return () -- TODO
beginNotUndoableAction (YiBuffer fb) = return () -- TODO
beginUserAction (YiBuffer fb) = return () -- TODO
canRedo (YiBuffer fb) = return True -- TODO
canUndo (YiBuffer fb) = return True -- TODO
copyClipboard (YiBuffer fb) _ = liftYi $ withEditor $ copy
createMark (YiView b) _name (YiIter (Iter _ p)) _toolTip = void . withYiBuffer (Yi.getBuffer 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
deleteSelection (YiBuffer b) = withYiBuffer b $ do
region <- getRawestSelectRegionB
deleteRegionB region -- TODO support flags
endNotUndoableAction (YiBuffer fb) = return () -- TODO
endUserAction (YiBuffer fb) = return () -- TODO
getEndIter (YiBuffer b) = iterFromYiBuffer b sizeB
getInsertMark (YiBuffer b) = YiMark <$> (withYiBuffer b $ insMark <$> askMarks)
getIterAtLine (YiBuffer b) line = iterFromYiBuffer b $ pointOfLineColB line 1
getIterAtMark (YiBuffer b) (YiMark m) = iterFromYiBuffer b $ (use . markPointA) m
getIterAtOffset (YiBuffer b) offset = return $ mkYiIter b $ Point offset
getLineCount (YiBuffer b) = withYiBuffer b $ sizeB >>= lineOf
getModified (YiBuffer b) = not <$> (withYiBuffer b $ gets isUnchangedBuffer)
getSelectionBoundMark (YiBuffer b) = YiMark . selMark <$> (withYiBuffer b $ askMarks)
getSelectionBounds (YiBuffer b) = withYiBuffer b $ do
region <- getRawestSelectRegionB
return (mkYiIter b (regionStart region),
mkYiIter b (regionEnd region))
getInsertIter (YiBuffer b) = withYiBuffer b $ do
insertMark <- insMark <$> askMarks
mkYiIter b <$> (use . markPointA) insertMark
getSlice (YiBuffer b) (YiIter first) (YiIter last) includeHidenChars = liftYiControl $
Yi.getText b first last
getStartIter (YiBuffer b) = return $ mkYiIter b $ Point 0
getTagTable (YiBuffer b) = return YiTagTable -- TODO
getText (YiBuffer b) (YiIter first) (YiIter last) includeHidenChars = liftYiControl $
Yi.getText b first last
hasSelection (YiBuffer b) = withYiBuffer b $ do
region <- getRawestSelectRegionB
return $ not $ regionIsEmpty region
insert (YiBuffer b) (YiIter (Iter _ p)) text = withYiBuffer b $ insertNAt (Yi.fromText text) p
newView (YiBuffer b) mbFontString = do
fd <- fontDescription mbFontString
v <- liftYiControl $ Yi.newView b fd
return (YiView v, scrollWin v)
pasteClipboard (YiBuffer b) clipboard (YiIter (Iter _ p)) defaultEditable = liftYi $ withEditor $ paste
placeCursor (YiBuffer b) (YiIter (Iter _ p)) = withYiBuffer b $ moveTo p
redo (YiBuffer b) = withYiBuffer b redoB
removeTagByName (YiBuffer b) name = return () -- TODO
selectRange (YiBuffer b) (YiIter (Iter _ first)) (YiIter (Iter _ last)) = withYiBuffer b $
setSelectRegionB $ mkRegion first last
setModified (YiBuffer b) modified = unless modified $ do
now <- liftIO $ getCurrentTime
withYiBuffer b $ markSavedB now
setStyle (YiBuffer b) mbStyle = return () -- TODO
setText (YiBuffer b) text = liftYiControl $ Yi.setText b (Yi.fromText text)
undo (YiBuffer b) = withYiBuffer b undoB
bufferToWindowCoords (YiView v) point = return point -- TODO
drawTabs (YiView _) = return () -- TODO
getBuffer (YiView v) = return $ YiBuffer $ Yi.getBuffer v
getWindow (YiView v) = widgetGetWindow (drawArea v)
getIterAtLocation (YiView View{viewFBufRef = b}) x y = return $ mkYiIter' b $ Point 0 -- TODO
getIterLocation (YiView v) (YiIter i) = newRectangle 0 0 0 0 -- TODO
getOverwrite (YiView View{viewFBufRef = b}) = withYiBuffer' b $ not <$> use insertingA
getScrolledWindow (YiView v) = return $ scrollWin v
getEditorWidget (YiView v) = liftIO . toWidget $ drawArea v
grabFocus (YiView View{drawArea = da}) = widgetGrabFocus da
scrollToMark (YiView v) (YiMark m) withMargin mbAlign = return () -- TODO
scrollToIter (YiView v) (YiIter i) withMargin mbAlign = return () -- TODO
setFont (YiView v) mbFontString = do
fd <- fontDescription mbFontString
layoutSetFontDescription (layout v) (Just fd)
setIndentWidth (YiView View{viewFBufRef = b}) width =
withYiBuffer' b $ modifyMode $
\ (mode@Mode{modeIndentSettings = mis}) ->
mode{modeIndentSettings = mis{shiftWidth = width}}
setWrapMode (YiView View{viewFBufRef = b}) width = return ()
setRightMargin (YiView v) mbRightMargin = return () -- TODO
setShowLineNumbers (YiView v) show = return () -- TODO
setTabWidth (YiView View{viewFBufRef = b}) width =
withYiBuffer' b $ modifyMode $
\ (mode@Mode{modeIndentSettings = mis}) ->
mode{modeIndentSettings = mis{tabSize = width}}
backwardCharC (YiIter i) = transformYiIter' i prevPointB
backwardFindCharC (YiIter i) pred mbLimit = tryTransformYiIter i $
doUntilB_ (pred <$> readB) leftB
backwardWordStartC (YiIter i@(Iter b p)) = withYiIter i $ do
prevWordB
newPoint <- pointB
if p == newPoint
then return Nothing
else return . Just $ mkYiIter' b newPoint
backwardToLineStartC (YiIter i) = transformYiIter i moveToSol
endsWord (YiIter i) = withYiIter i $ do
atBoundaryB unitWord Forward
forwardCharC i = forwardCharsC i 1
forwardCharsC (YiIter i) n = transformYiIter i $ rightN n
forwardFindCharC (YiIter i) pred mbLimit = tryTransformYiIter i $
doUntilB_ (pred <$> readB) rightB
forwardSearch (YiIter i) str pred mbLimit = return Nothing -- TODO
forwardToLineEndC (YiIter i) = transformYiIter i moveToEol
forwardWordEndC (YiIter i@(Iter b p)) = withYiIter i $ do
nextWordB
newPoint <- pointB
if p == newPoint
then return Nothing
else return . Just $ mkYiIter' b newPoint
getChar (YiIter (Iter b p)) = withYiBuffer' b $ R.head <$> nelemsB 1 p
getCharsInLine (YiIter i) = withYiIter i $ Yi.length <$> readLnB
getLine (YiIter i) = withYiIter i curLn
getLineOffset (YiIter i) = withYiIter i curCol
getOffset (YiIter (Iter _ (Point o))) = return o
isStart (YiIter i) = withYiIter i atSof
isEnd (YiIter i) = withYiIter i atEof
iterEqual (YiIter (Iter _ p1)) (YiIter (Iter _ p2)) = return $ p1 == p2
startsLine (YiIter i) = withYiIter i atSol
startsWord (YiIter i) = withYiIter i atSol -- TODO
atEnd (YiIter (Iter b _)) = iterFromYiBuffer' b sizeB
atLine (YiIter i) line = transformYiIter i $ gotoLn line
atLineOffset (YiIter i) column = transformYiIter i $ moveToColB column
atOffset (YiIter (Iter b _)) offset = return $ YiIter $ Iter b (Point offset)
atStart (YiIter (Iter b _)) = return $ mkYiIter' b $ Point 0
newTag (YiTagTable) name = return YiTag -- TODO
lookupTag (YiTagTable) name = return Nothing -- TODO
background (YiTag) color = return () -- TODO
underline (YiTag) value = return () -- TODO
afterFocusIn (YiView v) f = do
ideR <- ask
id1 <- onIDE afterWidgetFocusInEvent (drawArea v) $ liftIDE f >> return True
return [id1]
afterModifiedChanged (YiBuffer b) f = return [] -- TODO
afterMoveCursor (YiView v) f = return [] -- TODO
afterToggleOverwrite (YiView v) f = return [] -- TODO
onButtonPress (YiView v) f = do
id1 <- onIDE onWidgetButtonPressEvent (drawArea v) f
return [id1]
onButtonRelease (YiView v) f = do
id1 <- onIDE onWidgetButtonReleaseEvent (drawArea v) f
return [id1]
onCompletion (YiView v) start cancel = return [] -- TODO
onKeyPress (YiView v) f = do
id1 <- onIDE onWidgetKeyPressEvent (drawArea v) f
return [id1]
onMotionNotify (YiView v) f = do
id1 <- onIDE onWidgetMotionNotifyEvent (drawArea v) f
return [id1]
onLeaveNotify (YiView v) f = do
id1 <- onIDE onWidgetLeaveNotifyEvent (drawArea v) f
return [id1]
onKeyRelease (YiView v) f = do
id1 <- onIDE onWidgetKeyReleaseEvent (drawArea v) f
return [id1]
onLookupInfo (YiView v) f = do
widgetAddEvents (drawArea v) (gflagsToWord [EventMaskButtonReleaseMask])
id1 <- onIDE onWidgetButtonReleaseEvent (drawArea v) $ do
e <- lift ask
mod <- getEventButtonState e
case mod of
[ModifierTypeControlMask] -> f >> return True
_ -> return False
return [id1]
onMotionNotifyEvent (YiView v) f = return [] -- TODO
onPopulatePopup (YiView v) f = do
ideR <- ask
liftIO $ do
id1 <- ConnectC (drawArea v) <$> onWidgetPopupMenu (drawArea v) (do
menu <- menuNew
menuAttachToWidget menu (drawArea v) Nothing
reflectIDE (f menu) ideR
menuPopup menu noWidget noWidget Nothing 0 =<< getCurrentEventTime
return True)
return [id1]
onSelectionChanged (YiBuffer b) handler = return [] -- TODO
setEditable _ _ = return () -- TODO
#endif