module Yavie.MainTools (
defaultWithInitEditor
, getOptions
, getCmdLns
, defaultGetReadOnlyFlag
, UI(..)
, Pos
, YavieConfig(..)
, runYavie
, RefMonad
) where
import Yavie.Editor
import Yavie.Keybind
import Yavie.Tools
import Control.EventDriven
( getEventValue, EventState, initEvent, putEvent )
import System.Directory
import Control.Monad
import System.Console.GetOpt ( getOpt, ArgOrder(..), OptDescr(..), ArgDescr(..) )
import System.Environment
import Data.Maybe
import System.FilePath
import Data.IORef
class RefMonad m a where
type Ref m :: * -> *
newRef :: a -> m ( Ref m a )
readRef :: Ref m a -> m a
writeRef :: Ref m a -> a -> m ()
instance RefMonad IO a where
type Ref IO = IORef
newRef = newIORef
readRef = readIORef
writeRef = writeIORef
getContainer :: ( Monad m, RefMonad m ( EventState e c )) =>
Ref m ( EventState e c ) -> m c
getContainer = liftM getEventValue . readRef
withCursorPos :: FilePath -> ( Pos -> IO ( Editor c ) ) -> IO ()
withCursorPos fn action = runWithFileCursor $ \fc -> do
let pos = fromMaybe ( 0, 0 ) $ lookup fn fc
action pos
runWithFileCursor :: ( [ ( FilePath, Pos ) ] -> IO ( Editor c ) ) -> IO ()
runWithFileCursor action = do
home <- fmap (++"/.yjedit/") getHomeDirectory
createDirectoryIfMissing False home
let bcFile = home ++ "/buffer_cursor_xy.txt"
e <- doesFileExist bcFile
unless e $ writeFile bcFile ""
fc <- getFileCursor
ret <- action fc
putFileCursor $ updateFileCursor ret fc
getFileCursor :: IO [ ( FilePath, Pos ) ]
getFileCursor = do
home <- getHomeDirectory
let fn = home ++ "/.yjedit/buffer_cursor_xy.txt"
cnt <- readFile fn
putStr $ take ( length cnt length cnt ) "dummy"
return $ map ( \ln -> let [ f, x, y ] = words ln
in ( f, ( read x, read y ) ) ) $ lines cnt
updateFileCursor :: Editor c -> [ ( FilePath, Pos ) ] -> [ ( FilePath, Pos ) ]
updateFileCursor ed fc =
( fileName ed, cursorPos ed ) : filter ( (/=fileName ed) . fst ) fc
putFileCursor :: [ ( FilePath, Pos ) ] -> IO ()
putFileCursor fc = do
home <- getHomeDirectory
let fn = home ++ "/.yjedit/buffer_cursor_xy.txt"
writeFile fn $ unlines $
map ( \( f, ( x, y ) ) -> f ++ " " ++ show x ++ " " ++ show y ) fc
data CmdLnOption = OptGtk | OptX11 | OptRO | OptDemo deriving ( Eq, Show )
data UI = UIGtk | UIX11 | UIVty deriving Show
getOptions :: IO ( UI, Bool, Bool, Maybe String )
getOptions = do
options <- getArgs
let ( opts, args, _err ) = getOpt Permute optDescrs options
ui = if OptGtk `elem` opts
then UIGtk
else if OptX11 `elem` opts
then UIX11 else UIVty
ro = elem OptRO opts
demo = elem OptDemo opts || null args
fn = listToMaybe args
return ( ui, ro, demo, fn )
optDescrs :: [ OptDescr CmdLnOption ]
optDescrs = [ optDescrX11, optDescrRO, optDescrDemo, optDescrGtk ]
optDescrX11, optDescrRO, optDescrDemo, optDescrGtk :: OptDescr CmdLnOption
optDescrX11 = Option "x" [ "x11" ] ( NoArg OptX11 ) "use X11"
optDescrRO = Option "R" [ ] ( NoArg OptRO ) "read only"
optDescrDemo = Option "" [ "demo" ] ( NoArg OptDemo ) "demo"
optDescrGtk = Option "g" [ "gtk" ] ( NoArg OptGtk ) "use gtk"
defaultGetReadOnlyFlag :: IO Bool
defaultGetReadOnlyFlag = do
( _, ro, _, _, _, _ ) <- getCmdLns
return ro
getCmdLns :: IO ( UI, Bool, Bool, Bool, FilePath, String )
getCmdLns = do
( ui, ro, demo, mfn ) <- getOptions
fn <- case mfn of
Just fn_ -> mkAbsoluteFilePath fn_
Nothing -> mkAbsoluteFilePath ".yavie.NONAME"
ex <- doesFileExist fn
cnt <- if ex then readFile fn else return ""
putStr $ take ( length cnt length cnt ) "dummy"
return ( ui, ro, demo, ex, fn, cnt )
defaultWithInitEditor :: Int -> Int -> ( Editor c -> IO ( Editor c ) ) -> IO ()
defaultWithInitEditor iw ih action = do
( _, _, _, ex, fn, cnt ) <- getCmdLns
let status = if ex then show $ takeFileName fn
else show ( takeFileName fn ) ++ " [New file]"
withCursorPos fn $ \( cx, cy ) -> do
let initEditor = scrollForCursorMiddle $ cursorToXY cx cy $ setStatus status
$ initialSaveToEditor iw ih fn cnt
action initEditor
data YavieConfig m iface c = YavieConfig {
isEventDriven :: Bool ,
withInitEditor :: Int -> Int -> ( Editor c -> m ( Editor c ) ) -> m () ,
displaySize :: iface -> m ( Int, Int ) ,
initialize :: m iface ,
supplyEvent :: iface -> ( Event -> m Bool ) -> m () ,
finalize :: iface -> m () ,
drawDisplay :: iface -> m ( Editor c ) -> m () ,
keybind :: Keybind c ,
romode :: Keybind c ,
getReadOnlyFlag :: m Bool ,
runAction :: Editor c -> m ( Editor c )
}
runYavie :: ( Monad m, RefMonad m ( EventState Event ( Editor c ) ) ) =>
YavieConfig m iface c -> m ()
runYavie cfg = do
iface <- initialize cfg
( w, h ) <- displaySize cfg iface
ro <- getReadOnlyFlag cfg
let kb = if ro then romode cfg else keybind cfg
withInitEditor cfg w h $ \initEditor -> do
talkerRef <- newRef $ initEvent initEditor kb
drawDisplay cfg iface (
if isEventDriven cfg then getContainer talkerRef
else return initEditor )
supplyEvent cfg iface $ \ev -> do
tk <- readRef talkerRef
mtk <- putEvent
( \ed -> do
ned <- runAction cfg ed
drawDisplay cfg iface
(
if isEventDriven cfg then getContainer talkerRef
else return ned )
return ned )
tk ev
case mtk of
Nothing -> return False
Just ntk -> do
mntk <- putEvent return ntk EvDeleteEditor
case mntk of
Nothing -> return False
Just nntk -> writeRef talkerRef nntk >> return True
getContainer talkerRef
finalize cfg iface