[Gtk2hs-commit] (main branch): gnomevfs: fix demos to work again, new demo TestVolumeMonitor

[Duncan C. <dun...@wo...>]

Sat Jul  7 14:23:33 PDT 2007  pg...@gm...
  * gnomevfs: fix demos to work again, new demo TestVolumeMonitor

    hunk ./demo/gnomevfs/Makefile 2
    -PROGS  = test-sync test-dir test-xfer test-drive-volume
    -SOURCES = TestSync.hs TestDir.hs TestXfer.hs TestDriveVolume.hs
    +PROGS  = test-sync test-dir test-xfer test-drive-volume test-volume-monitor
    +SOURCES = TestSync.hs TestDir.hs TestXfer.hs TestDriveVolume.hs TestVolumeMonitor.hs
    hunk ./demo/gnomevfs/Makefile 15
    +test-volume-monitor : TestVolumeMonitor.hs
    +	$(HC_RULE)
    hunk ./demo/gnomevfs/TestDriveVolume.hs 33
    -                          VFS.volumeGetDevicePath volume >>=  printf "\t\tDevice Path: %s\n"
    -                          VFS.volumeGetFilesystemType volume >>= printf "\t\tFilesystem Type: %s\n"
    +                          VFS.volumeGetDevicePath volume >>=  (printf "\t\tDevice Path: %s\n") . show
    +                          VFS.volumeGetFilesystemType volume >>= (printf "\t\tFilesystem Type: %s\n") . show
    addfile ./demo/gnomevfs/TestVolumeMonitor.hs
    hunk ./demo/gnomevfs/TestVolumeMonitor.hs 1
    +module Main where
    +
    +import qualified System.Gnome.VFS as VFS
    +import Control.Exception ( handleJust )
    +import Control.Monad     ( when
    +                         , liftM )
    +import Data.Maybe        ( fromMaybe )
    +import Text.Printf       ( printf )
    +import System.Glib.MainLoop ( mainLoopNew
    +                            , mainLoopRun )
    +import System.IO
    +import System.Exit
    +import System.Environment
    +
    +main :: IO ()
    +main =
    +    do VFS.init >>= (\success ->
    +                     when (not success) $
    +                          do hPutStrLn stderr $ "could not initialize GnomeVFS"
    +                             exitFailure)
    +       [_$_]
    +       mainLoop <- mainLoopNew Nothing True
    +       [_$_]
    +       putStrLn "Waiting for Volume mount/unmount events..."
    +       VFS.onVolumeMonitorVolumeMounted VFS.volumeMonitor $ \volume ->
    +           do VFS.volumeGetDisplayName volume >>= printf "volume-mounted: %s\n"
    +              return ()
    +       VFS.onVolumeMonitorVolumePreUnmount VFS.volumeMonitor $ \volume ->
    +           do VFS.volumeGetDisplayName volume >>= printf "volume-pre-unmount: %s\n"
    +              return ()
    +       VFS.onVolumeMonitorVolumeUnmounted VFS.volumeMonitor $ \volume ->
    +           do VFS.volumeGetDisplayName volume >>= printf "volume-unmounted: %s\n"
    +              return ()
    +       [_$_]
    +       mainLoopRun mainLoop
    +       [_$_]
    +       return ()
    hunk ./demo/gnomevfs/TestXfer.hs 83
    -                       VFS.XferErrorModeQuery VFS.XferOverwriteModeQuery
    hunk ./demo/gnomevfs/TestXfer.hs 84
    -                       (Just xferOverwriteCallback) Nothing
    +                       (Right xferOverwriteCallback) Nothing