diff --git a/Gtk2HsSetup.hs b/Gtk2HsSetup.hs --- a/Gtk2HsSetup.hs +++ b/Gtk2HsSetup.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP #-} +{-# LANGUAGE CPP, ViewPatterns #-} #ifndef CABAL_VERSION_CHECK #error This module has to be compiled via the Setup.hs program which generates the gtk2hs-macros.h file @@ -29,7 +29,7 @@ emptyBuildInfo, allBuildInfo, Library(..), libModules, hasLibs) -import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..), +import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(withPackageDB, buildDir, localPkgDescr, installedPkgs, withPrograms), InstallDirs(..), componentPackageDeps, absoluteInstallDirs) @@ -56,13 +56,26 @@ import Distribution.Verbosity import Control.Monad (when, unless, filterM, liftM, forM, forM_) import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList ) -import Data.List (isPrefixOf, isSuffixOf, nub) -import Data.Char (isAlpha) +import Data.List (isPrefixOf, isSuffixOf, stripPrefix, nub) +import Data.Char (isAlpha, isNumber) import qualified Data.Map as M import qualified Data.Set as S +import qualified Distribution.Simple.LocalBuildInfo as LBI +import Distribution.Simple.Compiler (compilerVersion) import Control.Applicative ((<$>)) +#if CABAL_VERSION_CHECK(1,17,0) +import Distribution.Simple.Program.Find ( defaultProgramSearchPath ) +onDefaultSearchPath f a b = f a b defaultProgramSearchPath +libraryConfig lbi = case [clbi | (LBI.CLibName, clbi, _) <- LBI.componentsConfigs lbi] of + [clbi] -> Just clbi + _ -> Nothing +#else +onDefaultSearchPath = id +libraryConfig = LBI.libraryConfig +#endif + -- the name of the c2hs pre-compiled header file precompFile = "precompchs.bin" @@ -99,10 +112,16 @@ fixLibs :: [FilePath] -> [String] -> [String] fixLibs dlls = concatMap $ \ lib -> - case filter (("lib" ++ lib) `isPrefixOf`) dlls of + case filter (isLib lib) dlls of dll:_ -> [dropExtension dll] _ -> if lib == "z" then [] else [lib] - + where + isLib lib dll = + case stripPrefix ("lib"++lib) dll of + Just ('.':_) -> True + Just ('-':n:_) | isNumber n -> True + _ -> False + -- The following code is a big copy-and-paste job from the sources of -- Cabal 1.8 just to be able to fix a field in the package file. Yuck. @@ -135,8 +154,8 @@ register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO () -register pkg@PackageDescription { library = Just lib } - lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags +register pkg@(library -> Just lib ) + lbi@(libraryConfig -> Just clbi) regFlags = do installedPkgInfoRaw <- generateRegistrationInfo @@ -228,6 +247,10 @@ = nub $ ["-I" ++ dir | dir <- PD.includeDirs bi] ++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"] + ++ ["-D__GLASGOW_HASKELL__="++show (ghcDefine . versionBranch . compilerVersion $ LBI.compiler lbi)] + where + ghcDefine (v1:v2:_) = v1 * 100 + v2 + ghcDefine _ = __GLASGOW_HASKELL__ installCHI :: PackageDescription -- ^information from the .cabal file -> LocalBuildInfo -- ^information from the configure step @@ -417,7 +440,7 @@ checkGtk2hsBuildtools :: [Program] -> IO () checkGtk2hsBuildtools programs = do programInfos <- mapM (\ prog -> do - location <- programFindLocation prog normal + location <- onDefaultSearchPath programFindLocation prog normal return (programName prog, location) ) programs let printError name = do diff --git a/SetupWrapper.hs b/SetupWrapper.hs --- a/SetupWrapper.hs +++ b/SetupWrapper.hs @@ -29,6 +29,24 @@ import Control.Monad +-- moreRecentFile is implemented in Distribution.Simple.Utils, but only in +-- Cabal >= 1.18. For backwards-compatibility, we implement a copy with a new +-- name here. Some desirable alternate strategies don't work: +-- * We can't use CPP to check which version of Cabal we're up against because +-- this is the file that's generating the macros for doing that. +-- * We can't use the name moreRecentFiles and use +-- import D.S.U hiding (moreRecentFiles) +-- because on old GHC's (and according to the Report) hiding a name that +-- doesn't exist is an error. +moreRecentFile' :: FilePath -> FilePath -> IO Bool +moreRecentFile' a b = do + exists <- doesFileExist b + if not exists + then return True + else do tb <- getModificationTime b + ta <- getModificationTime a + return (ta > tb) + setupWrapper :: FilePath -> IO () setupWrapper setupHsFile = do args <- getArgs @@ -91,8 +109,8 @@ -- Currently this is GHC only. It should really be generalised. -- compileSetupExecutable = do - setupHsNewer <- setupHsFile `moreRecentFile` setupProgFile - cabalVersionNewer <- setupVersionFile `moreRecentFile` setupProgFile + setupHsNewer <- setupHsFile `moreRecentFile'` setupProgFile + cabalVersionNewer <- setupVersionFile `moreRecentFile'` setupProgFile let outOfDate = setupHsNewer || cabalVersionNewer when outOfDate $ do debug verbosity "Setup script is out of date, compiling..." @@ -144,12 +162,3 @@ Nothing Nothing Nothing exitCode <- waitForProcess process unless (exitCode == ExitSuccess) $ exitWith exitCode - -moreRecentFile :: FilePath -> FilePath -> IO Bool -moreRecentFile a b = do - exists <- doesFileExist b - if not exists - then return True - else do tb <- getModificationTime b - ta <- getModificationTime a - return (ta > tb) diff --git a/System/GIO/Types.chs b/System/GIO/Types.chs --- a/System/GIO/Types.chs +++ b/System/GIO/Types.chs @@ -1,5 +1,4 @@ {-# OPTIONS_HADDOCK hide #-} -{-# LANGUAGE CPP #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell @@ -177,7 +176,12 @@ castToMount, gTypeMount ) where -import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr) +import Foreign.ForeignPtr (ForeignPtr, castForeignPtr) +#if __GLASGOW_HASKELL__ >= 707 +import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) +#else +import Foreign.ForeignPtr (unsafeForeignPtrToPtr) +#endif import Foreign.C.Types (CULong(..), CUInt(..)) import System.Glib.GType (GType, typeInstanceIsA) import System.Glib.GObject @@ -199,7 +203,7 @@ -- *************************************************************** OutputStream -{#pointer *OutputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GOutputStream as OutputStream foreign newtype #} deriving (Eq,Ord) mkOutputStream = (OutputStream, objectUnref) unOutputStream (OutputStream o) = o @@ -222,7 +226,7 @@ -- ********************************************************* FilterOutputStream -{#pointer *FilterOutputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GFilterOutputStream as FilterOutputStream foreign newtype #} deriving (Eq,Ord) mkFilterOutputStream = (FilterOutputStream, objectUnref) unFilterOutputStream (FilterOutputStream o) = o @@ -246,7 +250,7 @@ -- *********************************************************** DataOutputStream -{#pointer *DataOutputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GDataOutputStream as DataOutputStream foreign newtype #} deriving (Eq,Ord) mkDataOutputStream = (DataOutputStream, objectUnref) unDataOutputStream (DataOutputStream o) = o @@ -271,7 +275,7 @@ -- ******************************************************* BufferedOutputStream -{#pointer *BufferedOutputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GBufferedOutputStream as BufferedOutputStream foreign newtype #} deriving (Eq,Ord) mkBufferedOutputStream = (BufferedOutputStream, objectUnref) unBufferedOutputStream (BufferedOutputStream o) = o @@ -296,7 +300,7 @@ -- *********************************************************** FileOutputStream -{#pointer *FileOutputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GFileOutputStream as FileOutputStream foreign newtype #} deriving (Eq,Ord) mkFileOutputStream = (FileOutputStream, objectUnref) unFileOutputStream (FileOutputStream o) = o @@ -320,7 +324,7 @@ -- ********************************************************* MemoryOutputStream -{#pointer *MemoryOutputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GMemoryOutputStream as MemoryOutputStream foreign newtype #} deriving (Eq,Ord) mkMemoryOutputStream = (MemoryOutputStream, objectUnref) unMemoryOutputStream (MemoryOutputStream o) = o @@ -344,7 +348,7 @@ -- **************************************************************** InputStream -{#pointer *InputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GInputStream as InputStream foreign newtype #} deriving (Eq,Ord) mkInputStream = (InputStream, objectUnref) unInputStream (InputStream o) = o @@ -367,7 +371,7 @@ -- ********************************************************** MemoryInputStream -{#pointer *MemoryInputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GMemoryInputStream as MemoryInputStream foreign newtype #} deriving (Eq,Ord) mkMemoryInputStream = (MemoryInputStream, objectUnref) unMemoryInputStream (MemoryInputStream o) = o @@ -391,7 +395,7 @@ -- ********************************************************** FilterInputStream -{#pointer *FilterInputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GFilterInputStream as FilterInputStream foreign newtype #} deriving (Eq,Ord) mkFilterInputStream = (FilterInputStream, objectUnref) unFilterInputStream (FilterInputStream o) = o @@ -415,7 +419,7 @@ -- ******************************************************** BufferedInputStream -{#pointer *BufferedInputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GBufferedInputStream as BufferedInputStream foreign newtype #} deriving (Eq,Ord) mkBufferedInputStream = (BufferedInputStream, objectUnref) unBufferedInputStream (BufferedInputStream o) = o @@ -440,7 +444,7 @@ -- ************************************************************ DataInputStream -{#pointer *DataInputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GDataInputStream as DataInputStream foreign newtype #} deriving (Eq,Ord) mkDataInputStream = (DataInputStream, objectUnref) unDataInputStream (DataInputStream o) = o @@ -466,7 +470,7 @@ -- ************************************************************ FileInputStream -{#pointer *FileInputStream foreign newtype #} deriving (Eq,Ord) +{#pointer *GFileInputStream as FileInputStream foreign newtype #} deriving (Eq,Ord) mkFileInputStream = (FileInputStream, objectUnref) unFileInputStream (FileInputStream o) = o @@ -490,7 +494,7 @@ -- **************************************************************** FileMonitor -{#pointer *FileMonitor foreign newtype #} deriving (Eq,Ord) +{#pointer *GFileMonitor as FileMonitor foreign newtype #} deriving (Eq,Ord) mkFileMonitor = (FileMonitor, objectUnref) unFileMonitor (FileMonitor o) = o @@ -513,7 +517,7 @@ -- ************************************************************************ Vfs -{#pointer *Vfs foreign newtype #} deriving (Eq,Ord) +{#pointer *GVfs as Vfs foreign newtype #} deriving (Eq,Ord) mkVfs = (Vfs, objectUnref) unVfs (Vfs o) = o @@ -536,7 +540,7 @@ -- ************************************************************* MountOperation -{#pointer *MountOperation foreign newtype #} deriving (Eq,Ord) +{#pointer *GMountOperation as MountOperation foreign newtype #} deriving (Eq,Ord) mkMountOperation = (MountOperation, objectUnref) unMountOperation (MountOperation o) = o @@ -559,7 +563,7 @@ -- ***************************************************************** ThemedIcon -{#pointer *ThemedIcon foreign newtype #} deriving (Eq,Ord) +{#pointer *GThemedIcon as ThemedIcon foreign newtype #} deriving (Eq,Ord) mkThemedIcon = (ThemedIcon, objectUnref) unThemedIcon (ThemedIcon o) = o @@ -582,7 +586,7 @@ -- ********************************************************************* Emblem -{#pointer *Emblem foreign newtype #} deriving (Eq,Ord) +{#pointer *GEmblem as Emblem foreign newtype #} deriving (Eq,Ord) mkEmblem = (Emblem, objectUnref) unEmblem (Emblem o) = o @@ -605,7 +609,7 @@ -- *************************************************************** EmblemedIcon -{#pointer *EmblemedIcon foreign newtype #} deriving (Eq,Ord) +{#pointer *GEmblemedIcon as EmblemedIcon foreign newtype #} deriving (Eq,Ord) mkEmblemedIcon = (EmblemedIcon, objectUnref) unEmblemedIcon (EmblemedIcon o) = o @@ -628,7 +632,7 @@ -- ************************************************************* FileEnumerator -{#pointer *FileEnumerator foreign newtype #} deriving (Eq,Ord) +{#pointer *GFileEnumerator as FileEnumerator foreign newtype #} deriving (Eq,Ord) mkFileEnumerator = (FileEnumerator, objectUnref) unFileEnumerator (FileEnumerator o) = o @@ -651,7 +655,7 @@ -- ********************************************************** FilenameCompleter -{#pointer *FilenameCompleter foreign newtype #} deriving (Eq,Ord) +{#pointer *GFilenameCompleter as FilenameCompleter foreign newtype #} deriving (Eq,Ord) mkFilenameCompleter = (FilenameCompleter, objectUnref) unFilenameCompleter (FilenameCompleter o) = o @@ -674,7 +678,7 @@ -- ******************************************************************* FileIcon -{#pointer *FileIcon foreign newtype #} deriving (Eq,Ord) +{#pointer *GFileIcon as FileIcon foreign newtype #} deriving (Eq,Ord) mkFileIcon = (FileIcon, objectUnref) unFileIcon (FileIcon o) = o @@ -697,7 +701,7 @@ -- ************************************************************** VolumeMonitor -{#pointer *VolumeMonitor foreign newtype #} deriving (Eq,Ord) +{#pointer *GVolumeMonitor as VolumeMonitor foreign newtype #} deriving (Eq,Ord) mkVolumeMonitor = (VolumeMonitor, objectUnref) unVolumeMonitor (VolumeMonitor o) = o @@ -720,7 +724,7 @@ -- **************************************************************** Cancellable -{#pointer *Cancellable foreign newtype #} deriving (Eq,Ord) +{#pointer *GCancellable as Cancellable foreign newtype #} deriving (Eq,Ord) mkCancellable = (Cancellable, objectUnref) unCancellable (Cancellable o) = o @@ -743,7 +747,7 @@ -- ********************************************************** SimpleAsyncResult -{#pointer *SimpleAsyncResult foreign newtype #} deriving (Eq,Ord) +{#pointer *GSimpleAsyncResult as SimpleAsyncResult foreign newtype #} deriving (Eq,Ord) mkSimpleAsyncResult = (SimpleAsyncResult, objectUnref) unSimpleAsyncResult (SimpleAsyncResult o) = o @@ -766,7 +770,7 @@ -- ******************************************************************* FileInfo -{#pointer *FileInfo foreign newtype #} deriving (Eq,Ord) +{#pointer *GFileInfo as FileInfo foreign newtype #} deriving (Eq,Ord) mkFileInfo = (FileInfo, objectUnref) unFileInfo (FileInfo o) = o @@ -789,7 +793,7 @@ -- *********************************************************** AppLaunchContext -{#pointer *AppLaunchContext foreign newtype #} deriving (Eq,Ord) +{#pointer *GAppLaunchContext as AppLaunchContext foreign newtype #} deriving (Eq,Ord) mkAppLaunchContext = (AppLaunchContext, objectUnref) unAppLaunchContext (AppLaunchContext o) = o @@ -813,7 +817,7 @@ -- *********************************************************************** Icon -{#pointer *Icon foreign newtype #} deriving (Eq,Ord) +{#pointer *GIcon as Icon foreign newtype #} deriving (Eq,Ord) mkIcon = (Icon, objectUnref) unIcon (Icon o) = o @@ -836,7 +840,7 @@ -- ******************************************************************* Seekable -{#pointer *Seekable foreign newtype #} deriving (Eq,Ord) +{#pointer *GSeekable as Seekable foreign newtype #} deriving (Eq,Ord) mkSeekable = (Seekable, objectUnref) unSeekable (Seekable o) = o @@ -859,7 +863,7 @@ -- ******************************************************************** AppInfo -{#pointer *AppInfo foreign newtype #} deriving (Eq,Ord) +{#pointer *GAppInfo as AppInfo foreign newtype #} deriving (Eq,Ord) mkAppInfo = (AppInfo, objectUnref) unAppInfo (AppInfo o) = o @@ -882,7 +886,7 @@ -- ********************************************************************* Volume -{#pointer *Volume foreign newtype #} deriving (Eq,Ord) +{#pointer *GVolume as Volume foreign newtype #} deriving (Eq,Ord) mkVolume = (Volume, objectUnref) unVolume (Volume o) = o @@ -905,7 +909,7 @@ -- **************************************************************** AsyncResult -{#pointer *AsyncResult foreign newtype #} deriving (Eq,Ord) +{#pointer *GAsyncResult as AsyncResult foreign newtype #} deriving (Eq,Ord) mkAsyncResult = (AsyncResult, objectUnref) unAsyncResult (AsyncResult o) = o @@ -928,7 +932,7 @@ -- *************************************************************** LoadableIcon -{#pointer *LoadableIcon foreign newtype #} deriving (Eq,Ord) +{#pointer *GLoadableIcon as LoadableIcon foreign newtype #} deriving (Eq,Ord) mkLoadableIcon = (LoadableIcon, objectUnref) unLoadableIcon (LoadableIcon o) = o @@ -951,7 +955,7 @@ -- ********************************************************************** Drive -{#pointer *Drive foreign newtype #} deriving (Eq,Ord) +{#pointer *GDrive as Drive foreign newtype #} deriving (Eq,Ord) mkDrive = (Drive, objectUnref) unDrive (Drive o) = o @@ -974,7 +978,7 @@ -- *********************************************************************** File -{#pointer *File foreign newtype #} +{#pointer *GFile as File foreign newtype #} mkFile = (File, objectUnref) unFile (File o) = o @@ -997,7 +1001,7 @@ -- ********************************************************************** Mount -{#pointer *Mount foreign newtype #} deriving (Eq,Ord) +{#pointer *GMount as Mount foreign newtype #} deriving (Eq,Ord) mkMount = (Mount, objectUnref) unMount (Mount o) = o diff --git a/gio.cabal b/gio.cabal --- a/gio.cabal +++ b/gio.cabal @@ -1,5 +1,5 @@ Name: gio -Version: 0.12.4 +Version: 0.12.5.0 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team @@ -35,14 +35,14 @@ FileManager.hs Source-Repository head - type: darcs - location: http://code.haskell.org/gtk2hs/ + type: git + location: https://github.com/gtk2hs/gtk2hs subdir: gio Library build-depends: base >= 4 && < 5, array, containers, mtl, bytestring, - glib >= 0.12.0 && < 0.13 - build-tools: gtk2hsC2hs >= 0.13.5, + glib >= 0.12.5 && < 0.13 + build-tools: gtk2hsC2hs >= 0.13.8, gtk2hsHookGenerator, gtk2hsTypeGen exposed-modules: