module HTk.Toolkit.LogWin (
LogWin(..),
createLogWin,
HasFile(..),
writeLogWin
) where
import System.IO.Unsafe
import Reactor.ReferenceVariables
import HTk.Toplevel.HTk
import HTk.Kernel.Core
import HTk.Toolkit.ScrollBox
import HTk.Toolkit.FileDialog
import System.Environment
data LogWin = LogWin Toplevel Editor (IO ())
createLogWin :: [Config Toplevel]
-> IO LogWin
createLogWin cnf =
do
win <- createToplevel cnf
b <- newVFBox win [relief Groove, borderwidth (cm 0.05) ]
pack b []
mb <- createMenu win False []
filecasc <- createMenuCascade mb [text "File"]
mfile <- createMenu win False []
filecasc # menu mfile
savecmd <- createMenuCommand mfile [text "Save"]
clickedsavecmd <- clicked savecmd
quitcmd <- createMenuCommand mfile [text "Quit"]
clickedquitcmd <- clicked quitcmd
win # menu mb
(sb, ed) <- newScrollBox b (\par -> newEditor par [bg "white"]) []
pack sb []
death <- newChannel
let listen :: Event ()
listen = (clickedsavecmd >> always (saveLog ed) >> listen) +>
(clickedquitcmd >>> destroy win) +>
receive death
_ <- spawnEvent listen
return (LogWin win ed (syncNoWait (send death ())))
pathRef :: Ref String
pathRef = unsafePerformIO $ getEnv "HOME" >>= newRef
saveLog :: Editor -> IO ()
saveLog ed =
do selev <- fileDialog "Open file" pathRef
file <- sync selev
case file of
Just fp -> try (writeTextToFile ed fp) >> done
_ -> done
instance GUIObject LogWin where
toGUIObject (LogWin win _ _) = toGUIObject win
cname _ = "LogWin"
instance Destroyable LogWin where
destroy (LogWin win _ death) = death >> destroy win
writeLogWin :: LogWin
-> String
-> IO ()
writeLogWin lw@(LogWin _ ed _) str =
do
try (insertText ed EndOfText str)
moveto Vertical ed 1.0
done