{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-} ----------------------------------------------------------------------------- -- | -- Module : Hoodle.Coroutine.File -- Copyright : (c) 2011-2014 Ian-Woo Kim -- -- License : GPL-3 -- Maintainer : Ian-Woo Kim -- Stability : experimental -- Portability : GHC -- ----------------------------------------------------------------------------- module Hoodle.Coroutine.File where -- from other packages import Control.Applicative ((<$>),(<*>)) import Control.Concurrent import Control.Lens (view,set,over,(%~), (.~)) import Control.Monad.State hiding (mapM,mapM_,forM_) import Control.Monad.Trans.Either import Control.Monad.Trans.Maybe (MaybeT(..)) -- import Control.Monad.Trans.Reader (runReaderT) import Data.Attoparsec (parseOnly) import Data.ByteString.Char8 as B (pack,unpack,readFile) import qualified Data.ByteString.Lazy as L import Data.Digest.Pure.MD5 (md5) import Data.Foldable (mapM_,forM_) import qualified Data.List as List import Data.Maybe import qualified Data.IntMap as IM import Data.Time.Clock import Filesystem.Path.CurrentOS (decodeString, encodeString) import qualified Graphics.Rendering.Cairo as Cairo import qualified Graphics.UI.Gtk as Gtk -- hiding (get,set) import System.Directory import System.FilePath import qualified System.FSNotify as FS import System.IO (hClose, hFileSize, openFile, IOMode(..)) import System.Process -- from hoodle-platform import Control.Monad.Trans.Crtn import Control.Monad.Trans.Crtn.Queue -- import Data.Hoodle.BBox import Data.Hoodle.Generic import Data.Hoodle.Simple import Data.Hoodle.Select import Graphics.Hoodle.Render (Xform4Page(..),cnstrctRHoodle) import Graphics.Hoodle.Render.Generic import Graphics.Hoodle.Render.Item import Graphics.Hoodle.Render.Type import Graphics.Hoodle.Render.Type.HitTest import Text.Hoodle.Builder import Text.Hoodle.Migrate.FromXournal import qualified Text.Hoodlet.Parse.Attoparsec as Hoodlet import qualified Text.Xournal.Parse.Conduit as XP -- import qualified Text.Hoodlet.Parse.Attoparsec as Hoodlet -- from this package import Hoodle.Accessor import Hoodle.Coroutine.Dialog import Hoodle.Coroutine.Draw import Hoodle.Coroutine.Commit import Hoodle.Coroutine.Minibuffer import Hoodle.Coroutine.Mode import Hoodle.Coroutine.Page import Hoodle.Coroutine.Scroll import Hoodle.Coroutine.TextInput -- import Hoodle.Coroutine.Window import Hoodle.ModelAction.File import Hoodle.ModelAction.Layer import Hoodle.ModelAction.Page import Hoodle.ModelAction.Select -- import Hoodle.ModelAction.Select.Transform import Hoodle.ModelAction.Window import qualified Hoodle.Script.Coroutine as S import Hoodle.Script.Hook import Hoodle.Type.Canvas import Hoodle.Type.Coroutine import Hoodle.Type.Event hiding (TypSVG) import Hoodle.Type.HoodleState import Hoodle.Type.PageArrangement import Hoodle.Util -- import Prelude hiding (readFile,concat,mapM,mapM_) -- | askIfSave :: MainCoroutine () -> MainCoroutine () askIfSave action = do xstate <- get if not (view isSaved xstate) then do b <- okCancelMessageBox "Current canvas is not saved yet. Will you proceed without save?" case b of True -> action False -> return () else action -- | askIfOverwrite :: FilePath -> MainCoroutine () -> MainCoroutine () askIfOverwrite fp action = do b <- liftIO $ doesFileExist fp if b then do r <- okCancelMessageBox ("Overwrite " ++ fp ++ "???") if r then action else return () else action -- | get file content from xournal file and update xournal state getFileContent :: Maybe FilePath -> MainCoroutine () getFileContent (Just fname) = do xstate <- get let ext = takeExtension fname case ext of ".hdl" -> do bstr <- liftIO $ B.readFile fname r <- liftIO $ checkVersionAndMigrate bstr case r of Left err -> liftIO $ putStrLn err Right h -> do constructNewHoodleStateFromHoodle h ctime <- liftIO $ getCurrentTime modify ( hoodleFileControl.hoodleFileName .~ Just fname ) modify ( hoodleFileControl.lastSavedTime .~ Just ctime ) commit_ ".xoj" -> do liftIO (XP.parseXojFile fname) >>= \x -> case x of Left str -> liftIO $ putStrLn $ "file reading error : " ++ str Right xojcontent -> do hdlcontent <- liftIO $ mkHoodleFromXournal xojcontent constructNewHoodleStateFromHoodle hdlcontent ctime <- liftIO $ getCurrentTime modify ( hoodleFileControl.hoodleFileName .~ Just fname ) modify ( hoodleFileControl.lastSavedTime .~ Just ctime ) commit_ ".pdf" -> do let doesembed = view (settings.doesEmbedPDF) xstate mhdl <- liftIO $ makeNewHoodleWithPDF doesembed fname case mhdl of Nothing -> getFileContent Nothing Just hdl -> do constructNewHoodleStateFromHoodle hdl modify ( hoodleFileControl.hoodleFileName .~ Nothing) commit_ _ -> getFileContent Nothing xstate' <- get doIOaction $ \evhandler -> do Gtk.postGUIAsync (setTitleFromFileName xstate') return (UsrEv ActionOrdered) ActionOrdered <- waitSomeEvent (\case ActionOrdered -> True ; _ -> False ) return () getFileContent Nothing = do constructNewHoodleStateFromHoodle =<< liftIO defaultHoodle modify ( hoodleFileControl.hoodleFileName .~ Nothing ) commit_ -- | constructNewHoodleStateFromHoodle :: Hoodle -> MainCoroutine () constructNewHoodleStateFromHoodle hdl' = do callRenderer $ cnstrctRHoodle hdl' >>= return . GotRHoodle RenderEv (GotRHoodle rhdl) <- waitSomeEvent (\case RenderEv (GotRHoodle _) -> True; _ -> False) modify (hoodleModeState .~ ViewAppendState rhdl) -- | fileNew :: MainCoroutine () fileNew = do getFileContent Nothing xstate' <- get ncvsinfo <- liftIO $ setPage xstate' 0 (getCurrentCanvasId xstate') xstate'' <- return $ over currentCanvasInfo (const ncvsinfo) xstate' liftIO $ setTitleFromFileName xstate'' commit xstate'' invalidateAll -- | fileSave :: MainCoroutine () fileSave = do xstate <- get case view (hoodleFileControl.hoodleFileName) xstate of Nothing -> fileSaveAs Just filename -> do -- this is rather temporary not to make mistake if takeExtension filename == ".hdl" then do put =<< (liftIO (saveHoodle xstate)) (S.afterSaveHook filename . rHoodle2Hoodle . getHoodle) xstate else fileExtensionInvalid (".hdl","save") >> fileSaveAs -- | interleaving a monadic action between each pair of subsequent actions sequence1_ :: (Monad m) => m () -> [m ()] -> m () sequence1_ _ [] = return () sequence1_ _ [a] = a sequence1_ i (a:as) = a >> i >> sequence1_ i as -- | renderjob :: RenderCache -> RHoodle -> FilePath -> IO () renderjob cache h ofp = do let p = maybe (error "renderjob") id $ IM.lookup 0 (view gpages h) let Dim width height = view gdimension p let rf x = cairoRenderOption (RBkgDrawPDF,DrawFull) cache (x,Nothing :: Maybe Xform4Page) >> return () Cairo.withPDFSurface ofp width height $ \s -> Cairo.renderWith s $ (sequence1_ Cairo.showPage . map rf . IM.elems . view gpages ) h -- | fileExport :: MainCoroutine () fileExport = fileChooser Gtk.FileChooserActionSave Nothing >>= maybe (return ()) action where action filename = -- this is rather temporary not to make mistake if takeExtension filename /= ".pdf" then fileExtensionInvalid (".pdf","export") >> fileExport else do xstate <- get let hdl = getHoodle xstate cache = view renderCache xstate liftIO (renderjob cache hdl filename) -- | fileStartSync :: MainCoroutine () fileStartSync = do xst <- get let mf = (,) <$> view (hoodleFileControl.hoodleFileName) xst <*> view (hoodleFileControl.lastSavedTime) xst maybe (return ()) (\(filename,lasttime) -> action filename lasttime) mf where action filename _lasttime = do let ioact = mkIOaction $ \evhandler ->do forkIO $ do FS.withManager $ \wm -> do origfile <- canonicalizePath filename let (filedir,_) = splitFileName origfile print filedir _ <- FS.watchDir wm (decodeString filedir) (const True) $ \ev -> do let mchangedfile = case ev of FS.Added fp _ -> Just (encodeString fp) FS.Modified fp _ -> Just (encodeString fp) FS.Removed _fp _ -> Nothing print mchangedfile case mchangedfile of Nothing -> return () Just changedfile -> do let changedfilename = takeFileName changedfile changedfile' = (filedir changedfilename) if changedfile' == origfile then do ctime <- getCurrentTime evhandler (UsrEv (Sync ctime)) else return () let sec = 1000000 forever (threadDelay (100 * sec)) return (UsrEv ActionOrdered) modify (tempQueue %~ enqueue ioact) -- | need to be merged with ContextMenuEventSVG exportCurrentPageAsSVG :: MainCoroutine () exportCurrentPageAsSVG = fileChooser Gtk.FileChooserActionSave Nothing >>= maybe (return ()) action where action filename = -- this is rather temporary not to make mistake if takeExtension filename /= ".svg" then fileExtensionInvalid (".svg","export") >> exportCurrentPageAsSVG else do cache <- view renderCache <$> get cpg <- getCurrentPageCurr let Dim w h = view gdimension cpg liftIO $ Cairo.withSVGSurface filename w h $ \s -> Cairo.renderWith s $ cairoRenderOption (InBBoxOption Nothing) cache (InBBox cpg,Nothing :: Maybe Xform4Page) >> return () -- | fileLoad :: FilePath -> MainCoroutine () fileLoad filename = do getFileContent (Just filename) xstate <- get ncvsinfo <- liftIO $ setPage xstate 0 (getCurrentCanvasId xstate) xstateNew <- return $ over currentCanvasInfo (const ncvsinfo) xstate put . set isSaved True $ xstateNew let ui = view gtkUIManager xstateNew liftIO $ toggleSave ui False liftIO $ setTitleFromFileName xstateNew clearUndoHistory modeChange ToViewAppendMode resetHoodleBuffers invalidateAll applyActionToAllCVS adjustScrollbarWithGeometryCvsId -- | resetHoodleBuffers :: MainCoroutine () resetHoodleBuffers = do liftIO $ putStrLn "resetHoodleBuffers called" xst <- get nhdlst <- liftIO $ resetHoodleModeStateBuffers (view renderCache xst) (view hoodleModeState xst) let nxst = set hoodleModeState nhdlst xst put nxst -- | main coroutine for open a file fileOpen :: MainCoroutine () fileOpen = do mfilename <- fileChooser Gtk.FileChooserActionOpen Nothing forM_ mfilename fileLoad -- | main coroutine for save as fileSaveAs :: MainCoroutine () fileSaveAs = do xstate <- get let hdl = (rHoodle2Hoodle . getHoodle) xstate maybe (defSaveAsAction xstate hdl) (\f -> liftIO (f hdl)) (hookSaveAsAction xstate) where hookSaveAsAction xstate = do hset <- view hookSet xstate saveAsHook hset defSaveAsAction xstate hdl = do let msuggestedact = view hookSet xstate >>= fileNameSuggestionHook (msuggested :: Maybe String) <- maybe (return Nothing) (liftM Just . liftIO) msuggestedact mr <- fileChooser Gtk.FileChooserActionSave msuggested maybe (return ()) (action xstate hdl) mr where action xst' hd filename = if takeExtension filename /= ".hdl" then fileExtensionInvalid (".hdl","save") else do askIfOverwrite filename $ do let ntitle = B.pack . snd . splitFileName $ filename (hdlmodst',hdl') = case view hoodleModeState xst' of ViewAppendState hdlmap -> if view gtitle hdlmap == "untitled" then ( ViewAppendState . set gtitle ntitle $ hdlmap , (set title ntitle hd)) else (ViewAppendState hdlmap,hd) SelectState thdl -> if view gselTitle thdl == "untitled" then ( SelectState $ set gselTitle ntitle thdl , set title ntitle hd) else (SelectState thdl,hd) xstateNew = set (hoodleFileControl.hoodleFileName) (Just filename) . set hoodleModeState hdlmodst' $ xst' liftIO . L.writeFile filename . builder $ hdl' put . set isSaved True $ xstateNew let ui = view gtkUIManager xstateNew liftIO $ toggleSave ui False liftIO $ setTitleFromFileName xstateNew S.afterSaveHook filename hdl' -- | main coroutine for open a file fileReload :: MainCoroutine () fileReload = do xstate <- get case view (hoodleFileControl.hoodleFileName) xstate of Nothing -> return () Just filename -> do if not (view isSaved xstate) then do b <- okCancelMessageBox "Discard changes and reload the file?" case b of True -> fileLoad filename False -> return () else fileLoad filename -- | fileExtensionInvalid :: (String,String) -> MainCoroutine () fileExtensionInvalid (ext,a) = okMessageBox $ "only " ++ ext ++ " extension is supported for " ++ a -- | fileAnnotatePDF :: MainCoroutine () fileAnnotatePDF = fileChooser Gtk.FileChooserActionOpen Nothing >>= maybe (return ()) action where warning = do okMessageBox "cannot load the pdf file. Check your hoodle compiled with poppler library" invalidateAll action filename = do xstate <- get let doesembed = view (settings.doesEmbedPDF) xstate mhdl <- liftIO $ makeNewHoodleWithPDF doesembed filename flip (maybe warning) mhdl $ \hdl -> do constructNewHoodleStateFromHoodle hdl modify ( hoodleFileControl.hoodleFileName .~ Nothing) commit_ setTitleFromFileName_ canvasZoomUpdateAll -- invalidateAll -- | set frame title according to file name setTitleFromFileName_ :: MainCoroutine () setTitleFromFileName_ = get >>= liftIO . setTitleFromFileName -- | checkEmbedImageSize :: FilePath -> MainCoroutine (Maybe FilePath) checkEmbedImageSize filename = do xst <- get runMaybeT $ do sizelimit <- (MaybeT . return) (warningEmbedImageSize =<< view hookSet xst) siz <- liftIO $ do h <- openFile filename ReadMode s <- hFileSize h hClose h return s guard (siz > sizelimit) let suggestscale :: Double = sqrt (fromIntegral sizelimit / fromIntegral siz) b <- lift . okCancelMessageBox $ "The size of " ++ filename ++ "=" ++ show siz ++ "\nis bigger than limit=" ++ show sizelimit ++ ".\nWill you reduce size?" guard b let ext = let x' = takeExtension filename in if (not.null) x' then tail x' else "" tmpfile <- liftIO $ mkTmpFile ext cmd <- (MaybeT . return) (shrinkCmd4EmbedImage =<< view hookSet xst) liftIO $ cmd suggestscale filename tmpfile return tmpfile -- | fileLoadPNGorJPG :: MainCoroutine () fileLoadPNGorJPG = do fileChooser Gtk.FileChooserActionOpen Nothing >>= maybe (return ()) embedImage embedImage :: FilePath -> MainCoroutine () embedImage filename = do xst <- get nitm <- if view (settings.doesEmbedImage) xst then do mf <- checkEmbedImageSize filename -- callRenderer $ case mf of Nothing -> liftIO (makeNewItemImage True filename) >>= cnstrctRItem >>= return . GotRItem Just f -> liftIO (makeNewItemImage True f) >>= cnstrctRItem >>= return . GotRItem RenderEv (GotRItem r) <- waitSomeEvent (\case RenderEv (GotRItem _) -> True ; _ -> False ) return r else do callRenderer $ liftIO (makeNewItemImage False filename) >>= cnstrctRItem >>= return . GotRItem RenderEv (GotRItem r) <- waitSomeEvent (\case RenderEv (GotRItem _) -> True ; _ -> False ) return r let cpn = view (currentCanvasInfo . unboxLens currentPageNum) xst my <- autoPosText let mpos = (\y->(PageNum cpn,PageCoord (50,y)))<$>my insertItemAt mpos nitm -- | fileLoadSVG :: MainCoroutine () fileLoadSVG = do fileChooser Gtk.FileChooserActionOpen Nothing >>= maybe (return ()) action where action filename = do xstate <- get liftIO $ putStrLn filename bstr <- liftIO $ B.readFile filename let pgnum = view (currentCanvasInfo . unboxLens currentPageNum) xstate hdl = getHoodle xstate currpage = getPageFromGHoodleMap pgnum hdl currlayer = getCurrentLayer currpage -- callRenderer $ return . GotRItem =<< (cnstrctRItem . ItemSVG) (SVG Nothing Nothing bstr (100,100) (Dim 300 300)) RenderEv (GotRItem newitem) <- waitSomeEvent (\case RenderEv (GotRItem _) -> True ; _ -> False ) -- let otheritems = view gitems currlayer let ntpg = makePageSelectMode currpage (otheritems :- (Hitted [newitem]) :- Empty) modeChange ToSelectMode nxstate <- get let cache = view renderCache nxstate thdl <- case view hoodleModeState nxstate of SelectState thdl' -> return thdl' _ -> (lift . EitherT . return . Left . Other) "fileLoadSVG" nthdl <- liftIO $ updateTempHoodleSelectIO cache thdl ntpg pgnum put ( ( set hoodleModeState (SelectState nthdl) . set isOneTimeSelectMode YesAfterSelect) nxstate) invalidateAll -- | askQuitProgram :: MainCoroutine () askQuitProgram = do b <- okCancelMessageBox "Current canvas is not saved yet. Will you close hoodle?" case b of True -> liftIO Gtk.mainQuit False -> return () -- | embedPredefinedImage :: MainCoroutine () embedPredefinedImage = do mpredefined <- S.embedPredefinedImageHook case mpredefined of Nothing -> return () Just filename -> embedImage filename -- | this is temporary. I will remove it embedPredefinedImage2 :: MainCoroutine () embedPredefinedImage2 = do mpredefined <- S.embedPredefinedImage2Hook case mpredefined of Nothing -> return () Just filename -> embedImage filename -- | this is temporary. I will remove it embedPredefinedImage3 :: MainCoroutine () embedPredefinedImage3 = do mpredefined <- S.embedPredefinedImage3Hook case mpredefined of Nothing -> return () Just filename -> embedImage filename -- | embedAllPDFBackground :: MainCoroutine () embedAllPDFBackground = do xst <- get let hdl = getHoodle xst nhdl <- liftIO . embedPDFInHoodle $ hdl modeChange ToViewAppendMode commit (set hoodleModeState (ViewAppendState nhdl) xst) invalidateAll -- | embed an item from hoodlet using hoodlet identifier embedHoodlet :: String -> MainCoroutine () embedHoodlet str = loadHoodlet str >>= mapM_ (insertItemAt Nothing) -- | mkRevisionHdlFile :: Hoodle -> IO (String,String) mkRevisionHdlFile hdl = do hdir <- getHomeDirectory tempfile <- mkTmpFile "hdl" let hdlbstr = builder hdl L.writeFile tempfile hdlbstr ctime <- getCurrentTime let idstr = B.unpack (view hoodleID hdl) md5str = show (md5 hdlbstr) name = "UUID_"++idstr++"_MD5Digest_"++md5str++"_ModTime_"++ show ctime nfilename = name <.> "hdl" vcsdir = hdir ".hoodle.d" "vcs" b <- doesDirectoryExist vcsdir unless b $ createDirectory vcsdir renameFile tempfile (vcsdir nfilename) return (md5str,name) mkRevisionPdfFile :: RenderCache -> RHoodle -> String -> IO () mkRevisionPdfFile cache hdl fname = do hdir <- getHomeDirectory tempfile <- mkTmpFile "pdf" renderjob cache hdl tempfile let nfilename = fname <.> "pdf" vcsdir = hdir ".hoodle.d" "vcs" b <- doesDirectoryExist vcsdir unless b $ createDirectory vcsdir renameFile tempfile (vcsdir nfilename) -- | fileVersionSave :: MainCoroutine () fileVersionSave = do rhdl <- getHoodle <$> get cache <- view renderCache <$> get let hdl = rHoodle2Hoodle rhdl rmini <- minibufDialog "Commit Message:" case rmini of Right [] -> return () Right strks' -> do doIOaction $ \_evhandler -> do (md5str,fname) <- mkRevisionHdlFile hdl mkRevisionPdfFile cache rhdl fname return (UsrEv (GotRevisionInk md5str strks')) r <- waitSomeEvent (\case GotRevisionInk _ _ -> True ; _ -> False ) let GotRevisionInk md5str strks = r nrev = RevisionInk (B.pack md5str) strks modify (\xst -> let hdlmodst = view hoodleModeState xst in case hdlmodst of ViewAppendState rhdl' -> let nrhdl = over grevisions (<> [nrev]) rhdl' in set hoodleModeState (ViewAppendState nrhdl) xst SelectState thdl -> let nthdl = over gselRevisions (<> [nrev]) thdl in set hoodleModeState (SelectState nthdl) xst) commit_ Left () -> do txtstr <- maybe "" id <$> textInputDialog doIOaction $ \_evhandler -> do (md5str,fname) <- mkRevisionHdlFile hdl mkRevisionPdfFile cache rhdl fname return (UsrEv (GotRevision md5str txtstr)) r <- waitSomeEvent (\case GotRevision _ _ -> True ; _ -> False ) let GotRevision md5str txtstr' = r nrev = Revision (B.pack md5str) (B.pack txtstr') modify (\xst -> let hdlmodst = view hoodleModeState xst in case hdlmodst of ViewAppendState rhdl' -> let nrhdl = over grevisions (<> [nrev]) rhdl' in set hoodleModeState (ViewAppendState nrhdl) xst SelectState thdl -> let nthdl = over gselRevisions (<> [nrev]) thdl in set hoodleModeState (SelectState nthdl) xst) commit_ showRevisionDialog :: Hoodle -> [Revision] -> MainCoroutine () showRevisionDialog hdl revs = liftM (view renderCache) get >>= \cache -> modify (tempQueue %~ enqueue (action cache)) >> waitSomeEvent (\case GotOk -> True ; _ -> False) >> return () where action cache = mkIOaction $ \_evhandler -> do dialog <- Gtk.dialogNew vbox <- Gtk.dialogGetUpper dialog mapM_ (addOneRevisionBox cache vbox hdl) revs _btnOk <- Gtk.dialogAddButton dialog "Ok" Gtk.ResponseOk Gtk.widgetShowAll dialog _res <- Gtk.dialogRun dialog Gtk.widgetDestroy dialog return (UsrEv GotOk) mkPangoText :: String -> Cairo.Render () mkPangoText str = do let pangordr = do ctxt <- Gtk.cairoCreateContext Nothing layout <- Gtk.layoutEmpty ctxt fdesc <- Gtk.fontDescriptionNew Gtk.fontDescriptionSetFamily fdesc "Sans Mono" Gtk.fontDescriptionSetSize fdesc 8.0 Gtk.layoutSetFontDescription layout (Just fdesc) Gtk.layoutSetWidth layout (Just 250) Gtk.layoutSetWrap layout Gtk.WrapAnywhere Gtk.layoutSetText layout str return layout rdr layout = do Cairo.setSourceRGBA 0 0 0 1 Gtk.updateLayout layout Gtk.showLayout layout layout <- liftIO $ pangordr rdr layout addOneRevisionBox :: RenderCache -> Gtk.VBox -> Hoodle -> Revision -> IO () addOneRevisionBox cache vbox hdl rev = do cvs <- Gtk.drawingAreaNew cvs `Gtk.on` Gtk.sizeRequest $ return (Gtk.Requisition 250 25) cvs `Gtk.on` Gtk.exposeEvent $ Gtk.tryEvent $ do drawwdw <- liftIO $ Gtk.widgetGetDrawWindow cvs liftIO . Gtk.renderWithDrawable drawwdw $ do case rev of RevisionInk _ strks -> Cairo.scale 0.5 0.5 >> mapM_ (cairoRender cache) strks Revision _ txt -> mkPangoText (B.unpack txt) hdir <- getHomeDirectory let vcsdir = hdir ".hoodle.d" "vcs" btn <- Gtk.buttonNewWithLabel "view" btn `Gtk.on` Gtk.buttonPressEvent $ Gtk.tryEvent $ do files <- liftIO $ getDirectoryContents vcsdir let fstrinit = "UUID_" ++ B.unpack (view hoodleID hdl) ++ "_MD5Digest_" ++ B.unpack (view revmd5 rev) matched = filter ((== "fdp") . take 3 . reverse) . filter (\f -> fstrinit `List.isPrefixOf` f) $ files case matched of x : _ -> liftIO (createProcess (proc "evince" [vcsdir x])) >> return () _ -> return () hbox <- Gtk.hBoxNew False 0 Gtk.boxPackStart hbox cvs Gtk.PackNatural 0 Gtk.boxPackStart hbox btn Gtk.PackGrow 0 Gtk.boxPackStart vbox hbox Gtk.PackNatural 0 fileShowRevisions :: MainCoroutine () fileShowRevisions = do rhdl <- liftM getHoodle get let hdl = rHoodle2Hoodle rhdl let revs = view grevisions rhdl showRevisionDialog hdl revs fileShowUUID :: MainCoroutine () fileShowUUID = do hdl <- liftM getHoodle get let uuidstr = view ghoodleID hdl okMessageBox (B.unpack uuidstr) loadHoodlet :: String -> MainCoroutine (Maybe RItem) loadHoodlet str = do homedir <- liftIO getHomeDirectory let hoodled = homedir ".hoodle.d" hoodletdir = hoodled "hoodlet" b' <- liftIO $ doesDirectoryExist hoodletdir if b' then do let fp = hoodletdir str <.> "hdlt" bstr <- liftIO $ B.readFile fp case parseOnly Hoodlet.hoodlet bstr of Left err -> liftIO $ putStrLn err >> return Nothing Right itm -> do -- callRenderer $ cnstrctRItem itm >>= return . GotRItem RenderEv (GotRItem ritm) <- waitSomeEvent (\case RenderEv (GotRItem _) -> True; _ -> False ) -- return (Just ritm) else return Nothing