poppler 0.12.2.2 → 0.14.2
raw patch · 9 files changed
Files
- Graphics/UI/Gtk/Poppler/Enums.chs +0/−2
- Graphics/UI/Gtk/Poppler/Structs.hsc +11/−9
- Graphics/UI/Gtk/Poppler/Types.chs +20/−15
- Gtk2HsSetup.hs +0/−511
- Setup.hs +8/−6
- SetupWrapper.hs +166/−0
- hspoppler.h +1/−0
- poppler.cabal +52/−26
- template-hsc-gtk2hs.h +1/−0
Graphics/UI/Gtk/Poppler/Enums.chs view
@@ -30,7 +30,6 @@ module Graphics.UI.Gtk.Poppler.Enums ( -- * Enums Error(..),- Orientation(..), SelectionStyle(..), PageTransitionType(..), PageTransitionAlignment(..),@@ -60,7 +59,6 @@ {# context lib="poppler" prefix="poppler" #} {# enum PopplerError as Error {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #}-{# enum PopplerOrientation as Orientation {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #} {# enum PopplerSelectionStyle as SelectionStyle {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #} {# enum PopplerPageTransitionType as PageTransitionType {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #} {# enum PopplerPageTransitionAlignment as PageTransitionAlignment {underscoreToCase} with prefix = "Poppler" deriving (Eq, Ord, Bounded, Show, Typeable) #}
Graphics/UI/Gtk/Poppler/Structs.hsc view
@@ -21,8 +21,9 @@ -- -- #hide -#include <glib-2.0/glib.h>-#include <glib/poppler.h>+-- #include <glib-2.0/glib.h>+#include "poppler.h"+#include <glib.h> #include "template-hsc-gtk2hs.h" -- |@@ -37,7 +38,7 @@ peekPopplerColor, ) where -import Control.Monad (liftM)+import Control.Monad (liftM) import Data.IORef import Control.Exception @@ -51,7 +52,7 @@ -- * Specifies x, y, width and height -- data PopplerRectangle = PopplerRectangle Double Double Double Double- deriving Show+ deriving Show instance Storable PopplerRectangle where sizeOf _ = #{const sizeof(PopplerRectangle)}@@ -68,10 +69,10 @@ peekPopplerRectangle :: Ptr PopplerRectangle -> IO PopplerRectangle peekPopplerRectangle ptr = do- (x1_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, x1} ptr- (y1_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, y1} ptr- (x2_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, x2} ptr- (y2_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, y2} ptr+ (x1_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, x1} ptr+ (y1_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, y1} ptr+ (x2_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, x2} ptr+ (y2_ ::#gtk2hs_type gdouble) <- #{peek PopplerRectangle, y2} ptr return (PopplerRectangle (realToFrac x1_) (realToFrac y1_) (realToFrac x2_) (realToFrac y2_)) @@ -89,7 +90,8 @@ peekPopplerColor :: Ptr PopplerColor -> IO PopplerColor peekPopplerColor ptr = do- red <- #{peek PopplerColor, red} ptr+ red <- #{peek PopplerColor, red} ptr green <- #{peek PopplerColor, green} ptr blue <- #{peek PopplerColor, blue} ptr return $ PopplerColor red green blue+
Graphics/UI/Gtk/Poppler/Types.chs view
@@ -1,5 +1,6 @@-{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE CPP #-}+{-# OPTIONS_HADDOCK hide #-}+{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell@@ -35,6 +36,7 @@ -- module Graphics.UI.Gtk.Poppler.Types ( + module System.Glib.GObject, Document(Document), DocumentClass, toDocument, mkDocument, unDocument,@@ -69,15 +71,18 @@ castToLayer, gTypeLayer ) where -import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr)-#if __GLASGOW_HASKELL__>=704-import Foreign.C.Types (CULong(..), CUInt(..))+import Foreign.ForeignPtr (ForeignPtr, castForeignPtr)+-- TODO work around cpphs https://ghc.haskell.org/trac/ghc/ticket/13553+#if __GLASGOW_HASKELL__ >= 707 || __GLASGOW_HASKELL__ == 0+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr) #else-import Foreign.C.Types (CULong, CUInt)+import Foreign.ForeignPtr (unsafeForeignPtrToPtr) #endif-import System.Glib.GType (GType, typeInstanceIsA)-import System.Glib.GObject +import Foreign.C.Types (CULong(..), CUInt(..), CULLong(..))+import System.Glib.GType (GType, typeInstanceIsA)+{#import System.Glib.GObject#}+ {# context lib="poppler" prefix="poppler" #} -- The usage of foreignPtrToPtr should be safe as the evaluation will only be@@ -95,7 +100,7 @@ -- ******************************************************************* Document -{#pointer *Document foreign newtype #} deriving (Eq,Ord)+{#pointer *PopplerDocument as Document foreign newtype #} deriving (Eq,Ord) mkDocument = (Document, objectUnref) unDocument (Document o) = o@@ -118,7 +123,7 @@ -- ****************************************************************** FontsIter -{#pointer *FontsIter foreign newtype #} deriving (Eq,Ord)+{#pointer *PopplerFontsIter as FontsIter foreign newtype #} deriving (Eq,Ord) mkFontsIter = (FontsIter, objectUnref) unFontsIter (FontsIter o) = o@@ -141,7 +146,7 @@ -- *********************************************************************** Page -{#pointer *Page foreign newtype #} deriving (Eq,Ord)+{#pointer *PopplerPage as Page foreign newtype #} deriving (Eq,Ord) mkPage = (Page, objectUnref) unPage (Page o) = o@@ -164,7 +169,7 @@ -- ****************************************************************** FormField -{#pointer *FormField foreign newtype #} deriving (Eq,Ord)+{#pointer *PopplerFormField as FormField foreign newtype #} deriving (Eq,Ord) mkFormField = (FormField, objectUnref) unFormField (FormField o) = o@@ -187,7 +192,7 @@ -- ********************************************************************* PSFile -{#pointer *PSFile foreign newtype #} deriving (Eq,Ord)+{#pointer *PopplerPSFile as PSFile foreign newtype #} deriving (Eq,Ord) mkPSFile = (PSFile, objectUnref) unPSFile (PSFile o) = o@@ -210,7 +215,7 @@ -- ******************************************************************* FontInfo -{#pointer *FontInfo foreign newtype #} deriving (Eq,Ord)+{#pointer *PopplerFontInfo as FontInfo foreign newtype #} deriving (Eq,Ord) mkFontInfo = (FontInfo, objectUnref) unFontInfo (FontInfo o) = o@@ -233,7 +238,7 @@ -- ***************************************************************** Attachment -{#pointer *Attachment foreign newtype #} deriving (Eq,Ord)+{#pointer *PopplerAttachment as Attachment foreign newtype #} deriving (Eq,Ord) mkAttachment = (Attachment, objectUnref) unAttachment (Attachment o) = o@@ -256,7 +261,7 @@ -- ********************************************************************** Layer -{#pointer *Layer foreign newtype #} deriving (Eq,Ord)+{#pointer *PopplerLayer as Layer foreign newtype #} deriving (Eq,Ord) mkLayer = (Layer, objectUnref) unLayer (Layer o) = o
− Gtk2HsSetup.hs
@@ -1,511 +0,0 @@-{-# LANGUAGE CPP #-}--#define CABAL_VERSION_ENCODE(major, minor, micro) ( \- ((major) * 10000) \- + ((minor) * 100) \- + ((micro) * 1))--#define CABAL_VERSION_CHECK(major,minor,micro) \- (CABAL_VERSION >= CABAL_VERSION_ENCODE(major,minor,micro))---- now, this is bad, but Cabal doesn't seem to actually pass any information about--- its version to CPP, so guess the version depending on the version of GHC-#ifdef CABAL_VERSION_MINOR-#ifndef CABAL_VERSION_MAJOR-#define CABAL_VERSION_MAJOR 1-#endif-#ifndef CABAL_VERSION_MICRO-#define CABAL_VERSION_MICRO 0-#endif-#define CABAL_VERSION CABAL_VERSION_ENCODE( \- CABAL_VERSION_MAJOR, \- CABAL_VERSION_MINOR, \- CABAL_VERSION_MICRO)-#else-#warning Setup.hs is guessing the version of Cabal. If compilation of Setup.hs fails use -DCABAL_VERSION_MINOR=x for Cabal version 1.x.0 when building (prefixed by --ghc-option= when using the 'cabal' command)-#if (__GLASGOW_HASKELL__ >= 700)-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,10,0)-#else-#if (__GLASGOW_HASKELL__ >= 612)-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,8,0)-#else-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,6,0)-#endif-#endif-#endif---- | Build a Gtk2hs package.----module Gtk2HsSetup ( - gtk2hsUserHooks, - getPkgConfigPackages, - checkGtk2hsBuildtools- ) where--import Distribution.Simple-import Distribution.Simple.PreProcess-import Distribution.InstalledPackageInfo ( importDirs,- showInstalledPackageInfo,- libraryDirs,- extraLibraries,- extraGHCiLibraries )-import Distribution.Simple.PackageIndex (-#if CABAL_VERSION_CHECK(1,8,0)- lookupInstalledPackageId-#else- lookupPackageId-#endif- )-import Distribution.PackageDescription as PD ( PackageDescription(..),- updatePackageDescription,- BuildInfo(..),- emptyBuildInfo, allBuildInfo,- Library(..),- libModules, hasLibs)-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),- InstallDirs(..),-#if CABAL_VERSION_CHECK(1,8,0)- componentPackageDeps,-#else- packageDeps,-#endif- absoluteInstallDirs)-import Distribution.Simple.Compiler ( Compiler(..) )-import Distribution.Simple.Program (- Program(..), ConfiguredProgram(..),- rawSystemProgramConf, rawSystemProgramStdoutConf, programName,- c2hsProgram, pkgConfigProgram, requireProgram, ghcPkgProgram,- simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg)-import Distribution.ModuleName ( ModuleName, components, toFilePath )-import Distribution.Simple.Utils-import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..),- defaultCopyFlags, ConfigFlags(configVerbosity),- fromFlag, toFlag, RegisterFlags(..), flagToMaybe,- fromFlagOrDefault, defaultRegisterFlags)-import Distribution.Simple.BuildPaths ( autogenModulesDir )-import Distribution.Simple.Install ( install )-#if CABAL_VERSION_CHECK(1,8,0)-import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage )-#else-import qualified Distribution.Simple.Register as Register ( register )-#endif-import Distribution.Text ( simpleParse, display )-import System.FilePath-import System.Exit (exitFailure)-import System.Directory ( doesFileExist, getDirectoryContents, doesDirectoryExist )-import Distribution.Version (Version(..))-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 qualified Data.Map as M-import qualified Data.Set as S--import Control.Applicative ((<$>))---- the name of the c2hs pre-compiled header file-precompFile = "precompchs.bin"--gtk2hsUserHooks = simpleUserHooks {- hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal],- hookedPreProcessors = [("chs", ourC2hs)],- confHook = \pd cf ->- (fmap adjustLocalBuildInfo (confHook simpleUserHooks pd cf)),- postConf = \args cf pd lbi -> do- genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi- postConf simpleUserHooks args cf pd lbi,- buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd ->- buildHook simpleUserHooks pd lbi uh bf,- copyHook = \pd lbi uh flags -> copyHook simpleUserHooks pd lbi uh flags >>- installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)),- instHook = \pd lbi uh flags ->-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)- installHook pd lbi uh flags >>- installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest,- regHook = registerHook-#else- instHook simpleUserHooks pd lbi uh flags >>- installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest-#endif- }----------------------------------------------------------------------------------- Lots of stuff for windows ghci support---------------------------------------------------------------------------------getDlls :: [FilePath] -> IO [FilePath]-getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$>- mapM getDirectoryContents dirs--fixLibs :: [FilePath] -> [String] -> [String]-fixLibs dlls = concatMap $ \ lib ->- case filter (("lib" ++ lib) `isPrefixOf`) dlls of- dll:_ -> [dropExtension dll]- _ -> if lib == "z" then [] else [lib]---- 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.--#if CABAL_VERSION_CHECK(1,8,0)- -installHook :: PackageDescription -> LocalBuildInfo- -> UserHooks -> InstallFlags -> IO ()-installHook pkg_descr localbuildinfo _ flags = do- let copyFlags = defaultCopyFlags {- copyDistPref = installDistPref flags,- copyDest = toFlag NoCopyDest,- copyVerbosity = installVerbosity flags- }- install pkg_descr localbuildinfo copyFlags- let registerFlags = defaultRegisterFlags {- regDistPref = installDistPref flags,- regInPlace = installInPlace flags,- regPackageDB = installPackageDB flags,- regVerbosity = installVerbosity flags- }- when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags--registerHook :: PackageDescription -> LocalBuildInfo- -> UserHooks -> RegisterFlags -> IO ()-registerHook pkg_descr localbuildinfo _ flags =- if hasLibs pkg_descr- then register pkg_descr localbuildinfo flags- else setupMessage verbosity- "Package contains no library to register:" (packageId pkg_descr)- where verbosity = fromFlag (regVerbosity flags)--register :: PackageDescription -> LocalBuildInfo- -> RegisterFlags -- ^Install in the user's database?; verbose- -> IO ()-register pkg@PackageDescription { library = Just lib }- lbi@LocalBuildInfo { libraryConfig = Just clbi } regFlags- = do-- installedPkgInfoRaw <- generateRegistrationInfo- verbosity pkg lib lbi clbi inplace distPref-- dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls- let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw)- installedPkgInfo = installedPkgInfoRaw {- extraGHCiLibraries = libs }-- -- Three different modes:- case () of- _ | modeGenerateRegFile -> die "Generate Reg File not supported"- | modeGenerateRegScript -> die "Generate Reg Script not supported"- | otherwise -> registerPackage verbosity-#if CABAL_VERSION_CHECK(1,10,0)- installedPkgInfo pkg lbi inplace [packageDb]-#else- installedPkgInfo pkg lbi inplace packageDb-#endif-- where- modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))- modeGenerateRegScript = fromFlag (regGenScript regFlags)- inplace = fromFlag (regInPlace regFlags)- packageDb = case flagToMaybe (regPackageDB regFlags) of- Just db -> db- Nothing -> registrationPackageDB (withPackageDB lbi)- distPref = fromFlag (regDistPref regFlags)- verbosity = fromFlag (regVerbosity regFlags)--register _ _ regFlags = notice verbosity "No package to register"- where- verbosity = fromFlag (regVerbosity regFlags)--#else-installHook :: PackageDescription -> LocalBuildInfo- -> UserHooks -> InstallFlags -> IO ()-installHook pkg_descr localbuildinfo _ flags = do- let copyFlags = defaultCopyFlags {- copyDistPref = installDistPref flags,- copyInPlace = installInPlace flags,- copyUseWrapper = installUseWrapper flags,- copyDest = toFlag NoCopyDest,- copyVerbosity = installVerbosity flags- }- install pkg_descr localbuildinfo copyFlags- let registerFlags = defaultRegisterFlags {- regDistPref = installDistPref flags,- regInPlace = installInPlace flags,- regPackageDB = installPackageDB flags,- regVerbosity = installVerbosity flags- }- when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags--registerHook :: PackageDescription -> LocalBuildInfo- -> UserHooks -> RegisterFlags -> IO ()-registerHook pkg_descr localbuildinfo _ flags =- if hasLibs pkg_descr- then register pkg_descr localbuildinfo flags- else setupMessage verbosity- "Package contains no library to register:" (packageId pkg_descr)- where verbosity = fromFlag (regVerbosity flags)--register :: PackageDescription -> LocalBuildInfo- -> RegisterFlags -- ^Install in the user's database?; verbose- -> IO ()-register pkg_descr lbi regFlags = do- let verbosity = fromFlag (regVerbosity regFlags)- warn verbosity "Cannot register ghci libraries with Cabal 1.6 (need 1.8)."- Register.register pkg_descr lbi regFlags- -#endif----------------------------------------------------------------------------------- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later---------------------------------------------------------------------------------adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo-adjustLocalBuildInfo lbi =- let extra = (Just libBi, [])- libBi = emptyBuildInfo { includeDirs = [ autogenModulesDir lbi- , buildDir lbi ] }- in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) }----------------------------------------------------------------------------------- Processing .chs files with our local c2hs.---------------------------------------------------------------------------------ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor-ourC2hs bi lbi = PreProcessor {- platformIndependent = False,- runPreProcessor = runC2HS bi lbi-}--runC2HS :: BuildInfo -> LocalBuildInfo ->- (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO ()-runC2HS bi lbi (inDir, inFile) (outDir, outFile) verbosity = do- -- have the header file name if we don't have the precompiled header yet- header <- case lookup "x-c2hs-header" (customFieldsBI bi) of- Just h -> return h- Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "++- "that sets the C header file to process .chs.pp files.")-- -- c2hs will output files in out dir, removing any leading path of the input file.- -- Thus, append the dir of the input file to the output dir.- let (outFileDir, newOutFile) = splitFileName outFile- let newOutDir = outDir </> outFileDir- -- additional .chi files might be needed that other packages have installed;- -- we assume that these are installed in the same place as .hi files- let chiDirs = [ dir |-#if CABAL_VERSION_CHECK(1,8,0)- ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi),- dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ]-#else- ipi <- packageDeps lbi,- dir <- maybe [] importDirs (lookupPackageId (installedPkgs lbi) ipi) ]-#endif- rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $- map ("--include=" ++) (outDir:chiDirs)- ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi]- ++ ["--output-dir=" ++ newOutDir,- "--output=" ++ newOutFile,- "--precomp=" ++ buildDir lbi </> precompFile,- header, inDir </> inFile]--getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]-getCppOptions bi lbi- = nub $- ["-I" ++ dir | dir <- PD.includeDirs bi]- ++ [opt | opt@('-':c:_) <- PD.cppOptions bi ++ PD.ccOptions bi, c `elem` "DIU"]--installCHI :: PackageDescription -- ^information from the .cabal file- -> LocalBuildInfo -- ^information from the configure step- -> Verbosity -> CopyDest -- ^flags sent to copy or install- -> IO ()-installCHI pkg@PD.PackageDescription { library = Just lib } lbi verbosity copydest = do- let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest- -- cannot use the recommended 'findModuleFiles' since it fails if there exists- -- a modules that does not have a .chi file- mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi] . toFilePath)-#if CABAL_VERSION_CHECK(1,8,0)- (PD.libModules lib)-#else- (PD.libModules pkg)-#endif- - let files = [ f | Just f <- mFiles ]-#if CABAL_VERSION_CHECK(1,8,0)- installOrdinaryFiles verbosity libPref files-#else- copyFiles verbosity libPref files-#endif-- -installCHI _ _ _ _ = return ()----------------------------------------------------------------------------------- Generating the type hierarchy and signal callback .hs files.---------------------------------------------------------------------------------typeGenProgram :: Program-typeGenProgram = simpleProgram "gtk2hsTypeGen"--signalGenProgram :: Program-signalGenProgram = simpleProgram "gtk2hsHookGenerator"--c2hsLocal :: Program-c2hsLocal = simpleProgram "gtk2hsC2hs"--genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()-genSynthezisedFiles verb pd lbi = do-- cPkgs <- getPkgConfigPackages verb lbi pd-- let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd)- ++customFieldsPD pd- typeOpts :: String -> [ProgArg]- typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field++'=':val) (words content)- | (field,content) <- xList,- tag `isPrefixOf` field,- field /= (tag++"file")]- ++ [ "--tag=" ++ tag- | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs- , let name' = filter isAlpha (display name)- , tag <- name'- : [ name' ++ "-" ++ show major ++ "." ++ show digit- | digit <- [0,2..minor] ]- ]-- signalsOpts :: [ProgArg]- signalsOpts = concat [ map (\val -> '-':'-':drop 10 field++'=':val) (words content)- | (field,content) <- xList,- "x-signals-" `isPrefixOf` field,- field /= "x-signals-file"]-- genFile :: Program -> [ProgArg] -> FilePath -> IO ()- genFile prog args outFile = do- res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args- rewriteFile outFile res-- forM_ (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $- \(fileTag, f) -> do- let tag = reverse (drop 4 (reverse fileTag))- info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.")- genFile typeGenProgram (typeOpts tag) f-- case lookup "x-signals-file" xList of- Nothing -> return ()- Just f -> do- info verb ("Ensuring that callback hooks in "++f++" are up-to-date.")- genFile signalGenProgram signalsOpts f----FIXME: Cabal should tell us the selected pkg-config package versions in the--- LocalBuildInfo or equivalent.--- In the mean time, ask pkg-config again.--getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId]-getPkgConfigPackages verbosity lbi pkg =- sequence- [ do version <- pkgconfig ["--modversion", display pkgname]- case simpleParse version of- Nothing -> die "parsing output of pkg-config --modversion failed"- Just v -> return (PackageIdentifier pkgname v)- | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ]- where- pkgconfig = rawSystemProgramStdoutConf verbosity- pkgConfigProgram (withPrograms lbi)----------------------------------------------------------------------------------- Dependency calculation amongst .chs files.----------------------------------------------------------------------------------- Given all files of the package, find those that end in .chs and extract the--- .chs files they depend upon. Then return the PackageDescription with these--- files rearranged so that they are built in a sequence that files that are--- needed by other files are built first.-fixDeps :: PackageDescription -> IO PackageDescription-fixDeps pd@PD.PackageDescription {- PD.library = Just lib@PD.Library {- PD.exposedModules = expMods,- PD.libBuildInfo = bi@PD.BuildInfo {- PD.hsSourceDirs = srcDirs,- PD.otherModules = othMods- }}} = do- let findModule m = findFileWithExtension [".chs.pp",".chs"] srcDirs- (joinPath (components m))- mExpFiles <- mapM findModule expMods- mOthFiles <- mapM findModule othMods-- -- tag all exposed files with True so we throw an error if we need to build- -- an exposed module before an internal modules (we cannot express this)- let modDeps = zipWith (ModDep True []) expMods mExpFiles++- zipWith (ModDep False []) othMods mOthFiles- modDeps <- mapM extractDeps modDeps- let (expMods, othMods) = span mdExposed $ sortTopological modDeps- badOther = map (fromMaybe "<no file>" . mdLocation) $- filter (not . mdExposed) expMods- unless (null badOther) $- die ("internal chs modules "++intercalate "," badOther++- " depend on exposed chs modules; cabal needs to build internal modules first")- return pd { PD.library = Just lib {- PD.exposedModules = map mdOriginal expMods,- PD.libBuildInfo = bi { PD.otherModules = map mdOriginal othMods }- }}--data ModDep = ModDep {- mdExposed :: Bool,- mdRequires :: [ModuleName],- mdOriginal :: ModuleName,- mdLocation :: Maybe FilePath-}--instance Show ModDep where- show x = show (mdLocation x)--instance Eq ModDep where- ModDep { mdOriginal = m1 } == ModDep { mdOriginal = m2 } = m1==m2-instance Ord ModDep where- compare ModDep { mdOriginal = m1 } ModDep { mdOriginal = m2 } = compare m1 m2---- Extract the dependencies of this file. This is intentionally rather naive as it--- ignores CPP conditionals. We just require everything which means that the--- existance of a .chs module may not depend on some CPP condition. -extractDeps :: ModDep -> IO ModDep-extractDeps md@ModDep { mdLocation = Nothing } = return md-extractDeps md@ModDep { mdLocation = Just f } = withUTF8FileContents f $ \con -> do- let findImports acc (('{':'#':xs):xxs) = case (dropWhile (' ' ==) xs) of- ('i':'m':'p':'o':'r':'t':' ':ys) ->- case simpleParse (takeWhile ('#' /=) ys) of- Just m -> findImports (m:acc) xxs - Nothing -> die ("cannot parse chs import in "++f++":\n"++- "offending line is {#"++xs)- -- no more imports after the first non-import hook- _ -> return acc- findImports acc (_:xxs) = findImports acc xxs- findImports acc [] = return acc- mods <- findImports [] (lines con)- return md { mdRequires = mods }---- Find a total order of the set of modules that are partially sorted by their--- dependencies on each other. The function returns the sorted list of modules--- together with a list of modules that are required but not supplied by this--- in the input set of modules.-sortTopological :: [ModDep] -> [ModDep]-sortTopological ms = reverse $ fst $ foldl visit ([], S.empty) (map mdOriginal ms)- where- set = M.fromList (map (\m -> (mdOriginal m, m)) ms)- visit (out,visited) m- | m `S.member` visited = (out,visited)- | otherwise = case m `M.lookup` set of- Nothing -> (out, m `S.insert` visited)- Just md -> (md:out', visited')- where- (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md)---- Check user whether install gtk2hs-buildtools correctly.-checkGtk2hsBuildtools :: [String] -> IO ()-checkGtk2hsBuildtools programs = do- programInfos <- mapM (\ name -> do- location <- programFindLocation (simpleProgram name) normal- return (name, location)- ) programs- let printError name = do- putStrLn $ "Cannot find " ++ name ++ "\n" - ++ "Please install `gtk2hs-buildtools` first and check that the install directory is in your PATH (e.g. HOME/.cabal/bin)."- exitFailure- forM_ programInfos $ \ (name, location) ->- when (isNothing location) (printError name)
Setup.hs view
@@ -1,10 +1,12 @@--- Setup file for a Gtk2Hs module. Contains only adjustments specific to this module,--- all Gtk2Hs-specific boilerplate is stored in Gtk2HsSetup.hs which should be kept--- identical across all modules.-import Gtk2HsSetup ( gtk2hsUserHooks, checkGtk2hsBuildtools )+-- Adjustments specific to this package,+-- all Gtk2Hs-specific boilerplate is kept in+-- gtk2hs-buildtools:Gtk2HsSetup+--+import Gtk2HsSetup ( gtk2hsUserHooks, checkGtk2hsBuildtools,+ typeGenProgram, signalGenProgram, c2hsLocal) import Distribution.Simple ( defaultMainWithHooks ) main = do- checkGtk2hsBuildtools ["gtk2hsC2hs", "gtk2hsTypeGen", "gtk2hsHookGenerator"]+ checkGtk2hsBuildtools [typeGenProgram, signalGenProgram, c2hsLocal] defaultMainWithHooks gtk2hsUserHooks- +
+ SetupWrapper.hs view
@@ -0,0 +1,166 @@+{-# LANGUAGE CPP #-}++-- A wrapper script for Cabal Setup.hs scripts. Allows compiling the real Setup+-- conditionally depending on the Cabal version.++module SetupWrapper (setupWrapper) where++import Distribution.Package+import Distribution.Compiler+import Distribution.Simple.Utils+import Distribution.Simple.Program+import Distribution.Simple.Compiler+import Distribution.Simple.BuildPaths as B (exeExtension)+import Distribution.Simple.Configure (configCompilerEx)+import Distribution.Simple.GHC (getInstalledPackages)+import qualified Distribution.Simple.PackageIndex as PackageIndex+import Distribution.Version+import Distribution.Verbosity+import Distribution.Text++import System.Environment+import System.Process+import System.Exit (ExitCode(..), exitWith)+import System.FilePath+import System.Directory+import qualified Control.Exception as Exception+import System.IO.Error (isDoesNotExistError)++import Data.List+import Data.Char+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+ createDirectoryIfMissingVerbose verbosity True setupDir+ compileSetupExecutable+ invokeSetupScript args++ where+ setupDir = "dist/setup-wrapper"+ setupVersionFile = setupDir </> "setup" <.> "version"+ setupProgFile = setupDir </> "setup" <.> B.exeExtension+ setupMacroFile = setupDir </> "wrapper-macros.h"++ useCabalVersion = Version [1,8] []+ usePackageDB = [GlobalPackageDB, UserPackageDB]+ verbosity = normal++ cabalLibVersionToUse comp conf = do+ savedVersion <- savedCabalVersion+ case savedVersion of+ Just version+ -> return version+ _ -> do version <- installedCabalVersion comp conf+ writeFile setupVersionFile (show version ++ "\n")+ return version++ savedCabalVersion = do+ versionString <- readFile setupVersionFile+ `Exception.catch` \e -> if isDoesNotExistError e+ then return ""+ else Exception.throwIO e+ case reads versionString of+ [(version,s)] | all isSpace s -> return (Just version)+ _ -> return Nothing++ installedCabalVersion comp conf = do+ (compiler,_,_) <- configCompilerEx defaultCompilerFlavor Nothing Nothing conf verbosity+ index <- getInstalledPackages verbosity compiler usePackageDB conf+ let cabalDep = Dependency (PackageName "Cabal")+ (orLaterVersion useCabalVersion)+ case PackageIndex.lookupDependency index cabalDep of+ [] -> die $ "The package requires Cabal library version "+ ++ display useCabalVersion+ ++ " but no suitable version is installed."+ pkgs -> return $ bestVersion (map fst pkgs)+ where+ bestVersion = maximumBy (comparing preference)+ preference version = (sameVersion, sameMajorVersion+ ,stableVersion, latestVersion)+ where+ sameVersion = version == cabalVersion+ sameMajorVersion = majorVersion version == majorVersion cabalVersion+ majorVersion = take 2 . versionBranch+ stableVersion = case versionBranch version of+ (_:x:_) -> even x+ _ -> False+ latestVersion = version++ -- | If the Setup.hs is out of date wrt the executable then recompile it.+ -- Currently this is GHC only. It should really be generalised.+ --+ compileSetupExecutable = do+ setupHsNewer <- setupHsFile `moreRecentFile'` setupProgFile+ cabalVersionNewer <- setupVersionFile `moreRecentFile'` setupProgFile+ let outOfDate = setupHsNewer || cabalVersionNewer+ when outOfDate $ do+ debug verbosity "Setup script is out of date, compiling..."++ (comp, _, conf) <- configCompilerEx (Just GHC) Nothing Nothing+ defaultProgramConfiguration verbosity+ cabalLibVersion <- cabalLibVersionToUse comp conf+ let cabalPkgid = PackageIdentifier (PackageName "Cabal") cabalLibVersion+ debug verbosity $ "Using Cabal library version " ++ display cabalLibVersion++ writeFile setupMacroFile (generateVersionMacro cabalLibVersion)++ rawSystemProgramConf verbosity ghcProgram conf $+ ["--make", setupHsFile, "-o", setupProgFile]+ ++ ghcPackageDbOptions usePackageDB+ ++ ["-package", display cabalPkgid+ ,"-cpp", "-optP-include", "-optP" ++ setupMacroFile+ ,"-odir", setupDir, "-hidir", setupDir]+ where++ ghcPackageDbOptions dbstack = case dbstack of+ (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs+ (GlobalPackageDB:dbs) -> "-no-user-package-conf"+ : concatMap specific dbs+ _ -> ierror+ where+ specific (SpecificPackageDB db) = [ "-package-conf", db ]+ specific _ = ierror+ ierror = error "internal error: unexpected package db stack"++ generateVersionMacro :: Version -> String+ generateVersionMacro version =+ concat+ ["/* DO NOT EDIT: This file is automatically generated by Cabal */\n\n"+ ,"#define CABAL_VERSION_CHECK(major1,major2,minor) (\\\n"+ ," (major1) < ",major1," || \\\n"+ ," (major1) == ",major1," && (major2) < ",major2," || \\\n"+ ," (major1) == ",major1," && (major2) == ",major2," && (minor) <= ",minor,")"+ ,"\n\n"+ ]+ where+ (major1:major2:minor:_) = map show (versionBranch version ++ repeat 0)++ invokeSetupScript :: [String] -> IO ()+ invokeSetupScript args = do+ info verbosity $ unwords (setupProgFile : args)+ process <- runProcess (currentDir </> setupProgFile) args+ Nothing Nothing+ Nothing Nothing Nothing+ exitCode <- waitForProcess process+ unless (exitCode == ExitSuccess) $ exitWith exitCode
+ hspoppler.h view
@@ -0,0 +1,1 @@+#include <poppler.h>
poppler.cabal view
@@ -1,50 +1,72 @@+-- Note that poppler is packaged after pango. if we have any issue in build (gtk2hs packages are+-- pretty entangled), please refer to pango and adjust this following the change made in pango. Name: poppler-Version: 0.12.2.2+Version: 0.14.2 License: GPL-2 License-file: COPYING-Copyright: (c) 2001-2010 The Gtk2Hs Team+Copyright: (c) 2001-2012, 2014-2016 The Gtk2Hs Team Author: Andy Stewart Maintainer: Ian-Woo Kim <ianwookim@gmail.com> Build-Type: Custom-Cabal-Version: >= 1.6+Cabal-Version: >= 1.24 Stability: stable-homepage: http://www.haskell.org/gtk2hs/-bug-reports: http://hackage.haskell.org/trac/gtk2hs/+homepage: http://projects.haskell.org/gtk2hs+bug-reports: http://github.com/wavewave/poppler/issues Synopsis: Binding to the Poppler. Description: Poppler is a fork of the xpdf PDF viewer, to provide PDF rendering functionality as a shared library, to centralize the maintenance effort.- And move to forward in a number of areas that don't fit within the goals of xpdf.+ And move to forward in a number of areas that don't fit within the goals of xpdf. Category: Graphics-Tested-With: GHC == 7.4-Extra-Source-Files: Gtk2HsSetup.hs- hierarchy.list- template-hsc-gtk2hs.h+Tested-With: GHC == 7.10, GHC == 8.0+Extra-Source-Files: SetupWrapper.hs+ -- SetupMain.hs+ -- Gtk2HsSetup.hs+ hierarchy.list+ template-hsc-gtk2hs.h+ hspoppler.h x-Types-File: Graphics/UI/Gtk/Poppler/Types.chs x-Types-ModName: Graphics.UI.Gtk.Poppler.Types-x-Types-Import: System.Glib.GObject+x-Types-Forward: *System.Glib.GObject x-Types-Lib: poppler x-Types-Prefix: poppler x-Types-Tag: poppler x-Types-Hierarchy: hierarchy.list -Data-Dir: demo-Data-Files: PdfViewer.hs- Makefile+Data-Dir: demo+Data-Files: PdfViewer.hs+ Makefile Source-Repository head- type: darcs- location: http://patch-tag.com/r/AndyStewart/poppler+ type: git+ location: git://github.com/wavewave/poppler.git +flag gtk3+ description: compile with gtk3+ default: False++custom-setup+ setup-depends: base >= 4.6,+ Cabal >= 1.24 && < 2.1,+ gtk2hs-buildtools >= 0.13.1.0 && < 0.14+ Library- build-depends: base >= 4 && < 5, array, containers, + build-depends: base >= 4 && < 5, array, containers, mtl, bytestring,- glib >= 0.12 && < 0.13,- cairo >= 0.12 && < 0.13,- gtk >= 0.12 && < 0.13--- haskell98, + glib >= 0.13 && < 0.15,+ cairo >= 0.13 && < 0.15+ if flag(gtk3)+ build-depends: gtk3 >= 0.14.3 && < 0.15+ else+ build-depends: gtk >= 0.14.3 && < 0.15 build-tools: gtk2hsC2hs, gtk2hsHookGenerator, gtk2hsTypeGen- ++ cpp-options: -U__BLOCKS__+ if os(darwin) || os(freebsd)+ cpp-options: -D__attribute__(A)= -D_Nullable= -D_Nonnull=+ if os(windows)+ cpp-options: -D__USE_MINGW_ANSI_STDIO=1+ exposed-modules: Graphics.UI.Gtk.Poppler.Action Graphics.UI.Gtk.Poppler.Attachment@@ -58,8 +80,12 @@ Graphics.UI.Gtk.Poppler.Structs Graphics.UI.Gtk.Poppler.Types - extensions: ForeignFunctionInterface- + default-language: Haskell98+ default-extensions: ForeignFunctionInterface+ x-c2hs-Header: hspoppler.h include-dirs: .- x-c2hs-Header: glib/poppler.h- pkgconfig-depends: poppler-glib >= 0.12.4, gobject-2.0, glib-2.0, cairo >= 1.2.0, gdk-2.0, gdk-pixbuf-2.0, pango+ includes: hspoppler.h+ if flag(gtk3)+ pkgconfig-depends: poppler-glib >= 0.12.4, cairo >= 1.2.0, gdk-3.0, pango+ else+ pkgconfig-depends: poppler-glib >= 0.12.4, gobject-2.0, glib-2.0, cairo >= 1.2.0, gdk-2.0, gdk-pixbuf-2.0, pango
template-hsc-gtk2hs.h view
@@ -1,6 +1,7 @@ #ifndef _TEMPLATE_HSC_GTK2HS_H_ #define _TEMPLATE_HSC_GTK2HS_H_ +#include <stdio.h> #include <glib.h> #define hsc_gtk2hs_type(t) \