diff --git a/Gtk2HsSetup.hs b/Gtk2HsSetup.hs new file mode 100644 --- /dev/null +++ b/Gtk2HsSetup.hs @@ -0,0 +1,451 @@ +{-# 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 +#endif + +-- | Build a Gtk2hs package. +-- +module Gtk2HsSetup ( + gtk2hsUserHooks, + getPkgConfigPackages, + checkGtk2hsBuildtools, + typeGenProgram, + signalGenProgram, + c2hsLocal + ) where + +import Distribution.Simple +import Distribution.Simple.PreProcess +import Distribution.InstalledPackageInfo ( importDirs, + showInstalledPackageInfo, + libraryDirs, + extraLibraries, + extraGHCiLibraries ) +import Distribution.Simple.PackageIndex ( lookupInstalledPackageId ) +import Distribution.PackageDescription as PD ( PackageDescription(..), + updatePackageDescription, + BuildInfo(..), + emptyBuildInfo, allBuildInfo, + Library(..), + libModules, hasLibs) +import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(withPackageDB, buildDir, localPkgDescr, installedPkgs, withPrograms), + InstallDirs(..), + componentPackageDeps, + absoluteInstallDirs) +import Distribution.Simple.Compiler ( Compiler(..) ) +import Distribution.Simple.Program ( + Program(..), ConfiguredProgram(..), + rawSystemProgramConf, rawSystemProgramStdoutConf, programName, programPath, + c2hsProgram, pkgConfigProgram, gccProgram, 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 ) +import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage ) +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, 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" + +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 (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. + +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@(library -> Just lib ) + lbi@(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 + installedPkgInfo pkg lbi inplace +#if CABAL_VERSION_CHECK(1,10,0) + packageDbs +#else + packageDb +#endif + + where + modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags)) + modeGenerateRegScript = fromFlag (regGenScript regFlags) + inplace = fromFlag (regInPlace regFlags) + packageDbs = nub $ withPackageDB lbi + ++ maybeToList (flagToMaybe (regPackageDB regFlags)) + packageDb = registrationPackageDB packageDbs + distPref = fromFlag (regDistPref regFlags) + verbosity = fromFlag (regVerbosity regFlags) + +register _ _ regFlags = notice verbosity "No package to register" + where + verbosity = fromFlag (regVerbosity regFlags) + + +------------------------------------------------------------------------------ +-- 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 | + ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi), + dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ] + (gccProg, _) <- requireProgram verbosity gccProgram (withPrograms lbi) + rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $ + map ("--include=" ++) (outDir:chiDirs) + ++ [ "--cpp=" ++ programPath gccProg, "--cppopts=-E" ] + ++ ["--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"] + ++ ["-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 + -> 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) + (PD.libModules lib) + + let files = [ f | Just f <- mFiles ] + installOrdinaryFiles verbosity libPref files + + +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") { + programFindVersion = findProgramVersion "--version" $ \str -> + -- Invoking "gtk2hsC2hs --version" gives a string like: + -- C->Haskell Compiler, version 0.13.4 (gtk2hs branch) "Bin IO", 13 Nov 2004 + case words str of + (_:_:_:ver:_) -> ver + _ -> "" + } + + +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 maj ++ "." ++ show d2 + | (maj, d2) <- [(maj, d2) | maj <- [0..(major-1)], d2 <- [0,2..20]] + ++ [(major, d2) | d2 <- [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 "" . 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 :: [Program] -> IO () +checkGtk2hsBuildtools programs = do + programInfos <- mapM (\ prog -> do + location <- onDefaultSearchPath programFindLocation prog normal + return (programName prog, 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) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,10 @@ +-- Standard setup file for a Gtk2Hs module. +-- +-- See also: +-- * SetupMain.hs : the real Setup script for this package +-- * Gtk2HsSetup.hs : Gtk2Hs-specific boilerplate +-- * SetupWrapper.hs : wrapper for compat with various ghc/cabal versions + +import SetupWrapper ( setupWrapper ) + +main = setupWrapper "SetupMain.hs" diff --git a/SetupMain.hs b/SetupMain.hs new file mode 100644 --- /dev/null +++ b/SetupMain.hs @@ -0,0 +1,13 @@ +-- The real Setup file for a Gtk2Hs package (invoked via the SetupWrapper). +-- It contains only adjustments specific to this package, +-- all Gtk2Hs-specific boilerplate is kept in Gtk2HsSetup.hs +-- which should be kept identical across all packages. +-- +import Gtk2HsSetup ( gtk2hsUserHooks, checkGtk2hsBuildtools, + typeGenProgram, signalGenProgram, c2hsLocal) +import Distribution.Simple ( defaultMainWithHooks ) + +main = do + checkGtk2hsBuildtools [typeGenProgram, signalGenProgram, c2hsLocal] + defaultMainWithHooks gtk2hsUserHooks + diff --git a/SetupWrapper.hs b/SetupWrapper.hs new file mode 100644 --- /dev/null +++ b/SetupWrapper.hs @@ -0,0 +1,164 @@ +-- 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 (exeExtension) +import Distribution.Simple.Configure (configCompiler) +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 +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" <.> 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 + index <- getInstalledPackages verbosity 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) <- configCompiler (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 diff --git a/hierarchy.list b/hierarchy.list new file mode 100644 --- /dev/null +++ b/hierarchy.list @@ -0,0 +1,342 @@ +# This list is the result of a copy-and-paste from the GtkObject hierarchy +# html documentation. Deprecated widgets are uncommented. Some additional +# object have been defined at the end of the copied list. + +# The Gtk prefix of every object is removed, the other prefixes are +# kept. The indentation implies the object hierarchy. In case the +# type query function cannot be derived from the name or the type name +# is different, an alternative name and type query function can be +# specified by appending 'as typename, '. In case this +# function is not specified, the is converted to +# gtk__get_type where is where each upperscore +# letter is converted to an underscore and lowerletter. The underscore +# is omitted if an upperscore letter preceeded: GtkHButtonBox -> +# gtk_hbutton_box_get_type. The generation of a type can be +# conditional by appending 'if '. Such types are only produces if +# --tag= is given on the command line of TypeGenerator. + + + GObject + GdkDrawable + GdkWindow as DrawWindow, gdk_window_object_get_type +# GdkDrawableImplX11 +# GdkWindowImplX11 + GdkPixmap + GdkGLPixmap if gtkglext + GdkGLWindow if gtkglext + GdkColormap + GdkScreen if gtk-2.2 + GdkDisplay if gtk-2.2 + GdkVisual + GdkDevice + GtkSettings + GtkTextBuffer + GtkSourceBuffer if sourceview + GtkSourceBuffer if gtksourceview2 + GtkTextTag + GtkSourceTag if sourceview + GtkTextTagTable + GtkSourceTagTable if sourceview + GtkStyle + GtkRcStyle + GdkDragContext + GdkPixbuf + GdkPixbufAnimation + GdkPixbufSimpleAnim + GdkPixbufAnimationIter + GtkTextChildAnchor + GtkTextMark + GtkSourceMarker if sourceview + GtkSourceMark if gtksourceview2 + GtkObject + GtkWidget + GtkMisc + GtkLabel + GtkAccelLabel + GtkTipsQuery if deprecated + GtkArrow + GtkImage + GtkContainer + WebKitWebView as WebView, webkit_web_view_get_type if webkit + GtkBin + GtkAlignment + GtkFrame + GtkAspectFrame + GtkButton + GtkToggleButton + GtkCheckButton + GtkRadioButton + GtkColorButton if gtk-2.4 + GtkFontButton if gtk-2.4 + GtkOptionMenu if deprecated + GtkItem + GtkMenuItem + GtkCheckMenuItem + GtkRadioMenuItem + GtkTearoffMenuItem + GtkImageMenuItem + GtkSeparatorMenuItem + GtkListItem if deprecated +# GtkTreeItem + GtkWindow + GtkDialog + GtkAboutDialog if gtk-2.6 + GtkColorSelectionDialog + GtkFileSelection + GtkFileChooserDialog if gtk-2.4 + GtkFontSelectionDialog + GtkInputDialog + GtkMessageDialog + GtkPlug if plugNsocket + GtkEventBox + GtkHandleBox + GtkScrolledWindow + GtkViewport + GtkExpander if gtk-2.4 + GtkComboBox if gtk-2.4 + GtkComboBoxEntry if gtk-2.4 + GtkToolItem if gtk-2.4 + GtkToolButton if gtk-2.4 + GtkMenuToolButton if gtk-2.6 + GtkToggleToolButton if gtk-2.4 + GtkRadioToolButton if gtk-2.4 + GtkSeparatorToolItem if gtk-2.4 + GtkMozEmbed if mozembed + VteTerminal as Terminal if vte + GtkBox + GtkButtonBox + GtkHButtonBox + GtkVButtonBox + GtkVBox + GtkColorSelection + GtkFontSelection + GtkFileChooserWidget if gtk-2.4 + GtkHBox + GtkCombo if deprecated + GtkFileChooserButton if gtk-2.6 + GtkStatusbar + GtkCList if deprecated + GtkCTree if deprecated + GtkFixed + GtkPaned + GtkHPaned + GtkVPaned + GtkIconView if gtk-2.6 + GtkLayout + GtkList if deprecated + GtkMenuShell + GtkMenu + GtkMenuBar + GtkNotebook +# GtkPacker + GtkSocket if plugNsocket + GtkTable + GtkTextView + GtkSourceView if sourceview + GtkSourceView if gtksourceview2 + GtkToolbar + GtkTreeView + GtkCalendar + GtkCellView if gtk-2.6 + GtkDrawingArea + GtkEntry + GtkSpinButton + GtkRuler + GtkHRuler + GtkVRuler + GtkRange + GtkScale + GtkHScale + GtkVScale + GtkScrollbar + GtkHScrollbar + GtkVScrollbar + GtkSeparator + GtkHSeparator + GtkVSeparator + GtkInvisible +# GtkOldEditable +# GtkText + GtkPreview if deprecated +# Progress is deprecated, ProgressBar contains everything necessary +# GtkProgress + GtkProgressBar + GtkAdjustment + GtkIMContext + GtkIMMulticontext + GtkItemFactory if deprecated + GtkTooltips + +# These object were added by hand because they do not show up in the hierarchy +# chart. +# These are derived from GtkObject: + GtkTreeViewColumn + GtkCellRenderer + GtkCellRendererPixbuf + GtkCellRendererText + GtkCellRendererCombo if gtk-2.6 + GtkCellRendererToggle + GtkCellRendererProgress if gtk-2.6 + GtkFileFilter if gtk-2.4 + GtkBuilder if gtk-2.12 +# These are actually interfaces, but all objects that implement it are at +# least GObjects. + GtkCellLayout if gtk-2.4 + GtkTreeSortable if gtk-2.4 + GtkTooltip if gtk-2.12 +# These are derived from GObject: + GtkStatusIcon if gtk-2.10 + GtkTreeSelection + GtkTreeModel + GtkTreeStore + GtkListStore + GtkTreeModelSort + GtkTreeModelFilter if gtk-2.4 + GtkIconFactory + GtkIconTheme + GtkSizeGroup + GtkClipboard if gtk-2.2 + GtkAccelGroup + GtkAccelMap if gtk-2.4 + GtkEntryCompletion if gtk-2.4 + GtkAction if gtk-2.4 + GtkToggleAction if gtk-2.4 + GtkRadioAction if gtk-2.4 + GtkActionGroup if gtk-2.4 + GtkUIManager if gtk-2.4 + GtkWindowGroup + GtkSourceLanguage if sourceview + GtkSourceLanguage if gtksourceview2 + GtkSourceLanguagesManager if sourceview + GtkSourceLanguageManager if gtksourceview2 + GladeXML as GladeXML, glade_xml_get_type if libglade + GConfClient as GConf if gconf +# These ones are actualy interfaces, but interface implementations are GObjects + GtkEditable + GtkSourceStyle as SourceStyleObject if gtksourceview2 + GtkSourceStyleScheme if sourceview + GtkSourceStyleScheme if gtksourceview2 + GtkSourceStyleSchemeManager if gtksourceview2 + GtkFileChooser if gtk-2.4 +## This now became a GObject in version 2: + GdkGC as GC, gdk_gc_get_type +## These are Pango structures + PangoContext as PangoContext, pango_context_get_type if pango + PangoLayout as PangoLayoutRaw, pango_layout_get_type if pango + PangoFont as Font, pango_font_get_type if pango + PangoFontFamily as FontFamily, pango_font_family_get_type if pango + PangoFontFace as FontFace, pango_font_face_get_type if pango + PangoFontMap as FontMap, pango_font_face_get_type if pango + PangoFontset as FontSet, pango_fontset_get_type if pango +## This type is only available for PANGO_ENABLE_BACKEND compiled source +## PangoFontsetSimple as FontSetSimple, pango_fontset_simple_get_type + +## GtkGlExt classes + GdkGLContext if gtkglext + GdkGLConfig if gtkglext + GdkGLDrawable if gtkglext + +## GnomeVFS classes + GnomeVFSVolume as Volume, gnome_vfs_volume_get_type if gnomevfs + GnomeVFSDrive as Drive, gnome_vfs_drive_get_type if gnomevfs + GnomeVFSVolumeMonitor as VolumeMonitor, gnome_vfs_volume_monitor_get_type if gnomevfs + +## GIO classes +# Note on all the "as" clauses: the prefix G is unfortunate since it leads +# to two consecutive upper case letters which are not translated with an +# underscore each (e.g. GConf -> gconf, GtkHButtonBox -> gtk_hbutton_box). +# GUnixMountMonitor as UnixMountMonitor, g_unix_mount_monitor_get_type if gio + GOutputStream as OutputStream, g_output_stream_get_type if gio + GFilterOutputStream as FilterOutputStream, g_filter_output_stream_get_type if gio + GDataOutputStream as DataOutputStream, g_data_output_stream_get_type if gio + GBufferedOutputStream as BufferedOutputStream, g_buffered_output_stream_get_type if gio +# GUnixOutputStream as UnixOutputStream, g_unix_output_stream_get_type if gio + GFileOutputStream as FileOutputStream, g_file_output_stream_get_type if gio + GMemoryOutputStream as MemoryOutputStream, g_memory_output_stream_get_type if gio + GInputStream as InputStream, g_input_stream_get_type if gio +# GUnixInputStream as UnixInputStream, g_unix_input_stream_get_type if gio + GMemoryInputStream as MemoryInputStream, g_memory_input_stream_get_type if gio + GFilterInputStream as FilterInputStream, g_filter_input_stream_get_type if gio + GBufferedInputStream as BufferedInputStream, g_buffered_input_stream_get_type if gio + GDataInputStream as DataInputStream, g_data_input_stream_get_type if gio + GFileInputStream as FileInputStream, g_file_input_stream_get_type if gio +# GDesktopAppInfo as DesktopAppInfo, g_desktop_app_info_get_type if gio + GFileMonitor as FileMonitor, g_file_monitor_get_type if gio + GVfs as Vfs, g_vfs_get_type if gio + GMountOperation as MountOperation, g_mount_operation_get_type if gio + GThemedIcon as ThemedIcon, g_themed_icon_get_type if gio + GEmblem as Emblem, g_emblem_get_type if gio + GEmblemedIcon as EmblemedIcon, g_emblemed_icon_get_type if gio + GFileEnumerator as FileEnumerator, g_file_enumerator_get_type if gio + GFilenameCompleter as FilenameCompleter, g_filename_completer_get_type if gio + GFileIcon as FileIcon, g_file_icon_get_type if gio + GVolumeMonitor as VolumeMonitor, g_volume_monitor_get_type if gio + GCancellable as Cancellable, g_cancellable_get_type if gio + GSimpleAsyncResult as SimpleAsyncResult, g_async_result_get_type if gio + GFileInfo as FileInfo, g_file_info_get_type if gio + GAppLaunchContext as AppLaunchContext, g_app_launch_context_get_type if gio +## these are actually GInterfaces + GIcon as Icon, g_icon_get_type if gio + GSeekable as Seekable, g_seekable_get_type if gio + GAppInfo as AppInfo, g_app_info_get_type if gio + GVolume as Volume, g_volume_get_type if gio + GAsyncResult as AsyncResult, g_async_result_get_type if gio + GLoadableIcon as LoadableIcon, g_loadable_icon_get_type if gio + GDrive as Drive, g_drive_get_type if gio + GFile noEq as File, g_file_get_type if gio + GMount as Mount, g_mount_get_type if gio + +## GStreamer classes + GstObject as Object, gst_object_get_type if gstreamer + GstPad as Pad, gst_pad_get_type if gstreamer + GstGhostPad as GhostPad, gst_ghost_pad_get_type if gstreamer + GstPluginFeature as PluginFeature, gst_plugin_feature_get_type if gstreamer + GstElementFactory as ElementFactory, gst_element_factory_get_type if gstreamer + GstTypeFindFactory as TypeFindFactory, gst_type_find_factory_get_type if gstreamer + GstIndexFactory as IndexFactory, gst_index_factory_get_type if gstreamer + GstElement as Element, gst_element_get_type if gstreamer + GstBin as Bin, gst_bin_get_type if gstreamer + GstPipeline as Pipeline, gst_pipeline_get_type if gstreamer + GstImplementsInterface as ImplementsInterface, gst_implements_interface_get_type if gstreamer + GstTagSetter as TagSetter, gst_tag_setter_get_type if gstreamer + GstBaseSrc as BaseSrc, gst_base_src_get_type if gstreamer + GstPushSrc as PushSrc, gst_push_src_get_type if gstreamer + GstBaseSink as BaseSink, gst_base_sink_get_type if gstreamer + GstBaseTransform as BaseTransform, gst_base_transform_get_type if gstreamer + GstPlugin as Plugin, gst_plugin_get_type if gstreamer + GstRegistry as Registry, gst_registry_get_type if gstreamer + GstBus as Bus, gst_bus_get_type if gstreamer + GstClock as Clock, gst_clock_get_type if gstreamer + GstAudioClock as AudioClock, gst_audio_clock_get_type if gstreamer + GstSystemClock as SystemClock, gst_system_clock_get_type if gstreamer + GstNetClientClock as NetClientClock, gst_net_client_clock_get_type if gstreamer + GstIndex as Index, gst_index_get_type if gstreamer + GstPadTemplate as PadTemplate, gst_pad_template_get_type if gstreamer + GstTask as Task, gst_task_get_type if gstreamer + GstXML as XML, gst_xml_get_type if gstreamer + GstChildProxy as ChildProxy, gst_child_proxy_get_type if gstreamer + GstCollectPads as CollectPads, gst_collect_pads_get_type if gstreamer +## these are actually GInterfaces + GstURIHandler as URIHandler, gst_uri_handler_get_type if gstreamer + GstAdapter as Adapter, gst_adapter_get_type if gstreamer + GstController as Controller, gst_controller_get_type if gstreamer + + WebKitWebFrame as WebFrame, webkit_web_frame_get_type if webkit + WebKitWebSettings as WebSettings, webkit_web_settings_get_type if webkit + WebKitNetworkRequest as NetworkRequest, webkit_network_request_get_type if webkit + WebKitNetworkResponse as NetworkResponse, webkit_network_response_get_type if webkit + WebKitDownload as Download, webkit_download_get_type if webkit + WebKitWebBackForwardList as WebBackForwardList, webkit_web_back_forward_list_get_type if webkit + WebKitWebHistoryItem as WebHistoryItem, webkit_web_history_item_get_type if webkit + WebKitWebInspector as WebInspector, webkit_web_inspector_get_type if webkit + WebKitHitTestResult as HitTestResult, webkit_hit_test_result_get_type if webkit + WebKitSecurityOrigin as SecurityOrigin, webkit_security_origin_get_type if webkit + WebKitSoupAuthDialog as SoupAuthDialog, webkit_soup_auth_dialog_get_type if webkit + WebKitWebDatabase as WebDatabase, webkit_web_database_get_type if webkit + WebKitWebDataSource as WebDataSource, webkit_web_data_source_get_type if webkit + WebKitWebNavigationAction as WebNavigationAction, webkit_web_navigation_action_get_type if webkit + WebKitWebPolicyDecision as WebPolicyDecision, webkit_web_policy_decision_get_type if webkit + WebKitWebResource as WebResource, webkit_web_resource_get_type if webkit + WebKitWebWindowFeatures as WebWindowFeatures, webkit_web_window_features_get_type if webkit + WebKitGeolocationPolicyDecision as GeolocationPolicyDecision, webkit_geolocation_policy_decision_get_type if webkit + diff --git a/hsjscore.h b/hsjscore.h new file mode 100644 --- /dev/null +++ b/hsjscore.h @@ -0,0 +1,41 @@ +/* + * Copyright (C) 2009 Cjacker Huang . + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Library General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Library General Public License for more details. + * + * You should have received a copy of the GNU Library General Public License + * along with this library; see the file COPYING.LIB. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + */ + +#ifndef HS_WEBKITJAVASCRIPTCORE_H +#define HS_WEBKITJAVASCRIPTCORE_H +/* to avoid stdbool.h error in JavaScriptCore/JSBase.h*/ +#define _Bool unsigned char // unsigned short // previously, int + +#define CALLBACK +#define WINAPI + +/* include webkit headers*/ +#include +#include +#include +#include +#include +#include + +typedef JSStaticValue* JSStaticValueRef; + +typedef JSStaticFunction* JSStaticFunctionRef; + +typedef JSClassDefinition* JSClassDefinitionRef; +#endif diff --git a/marshal.list b/marshal.list new file mode 100644 --- /dev/null +++ b/marshal.list @@ -0,0 +1,67 @@ +# see glib-genmarshal(1) for a detailed description of the file format, +# possible parameter types are: +# VOID indicates no return type, or no extra +# parameters. if VOID is used as the parameter +# list, no additional parameters may be present. +# BOOLEAN for boolean types (gboolean) +# CHAR for signed char types (gchar) +# UCHAR for unsigned char types (guchar) +# INT for signed integer types (gint) +# UINT for unsigned integer types (guint) +# LONG for signed long integer types (glong) +# ULONG for unsigned long integer types (gulong) +# ENUM for enumeration types (gint) +# FLAGS for flag enumeration types (guint) +# FLOAT for single-precision float types (gfloat) +# DOUBLE for double-precision float types (gdouble) +# STRING for string types (gchar*) +# MSTRING for string types (gchar*) that could be NUL +# BOXED for boxed (anonymous but reference counted) types (GBoxed*) +# POINTER for anonymous pointer types (gpointer) +# NONE deprecated alias for VOID +# BOOL deprecated alias for BOOLEAN + +# +# One discrepancy from Gtk+ is that for signals that may pass NULL for an object +# reference, the Haskell signal should be passed a 'Maybe GObject'. +# We therefore have two variants that are marshalled as a maybe type: +# +# OBJECT for GObject or derived types (GObject*) +# MOBJECT for GObject or derived types (GObject*) that may be NULL + +# Furthermore, some objects needs to be destroyed synchronously from the main loop of +# Gtk rather than during GC. These objects need to be marshalled using TOBJECT (for thread-safe +# object). It doesn't hurt to use TOBJECT for an object that doesn't need it, except for the +# some performance. As a rule of thumb, use TOBJECT for all libraries that build on package +# 'gtk' and use OBJECT for all packages that only need packages 'glib', 'pango', 'cairo', +# 'gio'. Again both variants exist. Note that the same names will be generated for OBJECT and +# TOBJECT, so you have to remove the OBJECT handler if you need both. +# +# TOBJECT for GObject or derived types (GObject*) +# MTOBJECT for GObject or derived types (GObject*) that may be NULL + +# If you add a new signal type, please check that it actually works! +# If it is a Boxed type check that the reference counting is right. + +VOID:POINTER,POINTER +BOOLEAN:TOBJECT +BOOLEAN:TOBJECT,STRING,BOXED +POINTER:TOBJECT +BOOLEAN:INT,INT,STRING +BOOLEAN:STRING,STRING,INT,STRING +BOOLEAN:TOBJECT,STRING +BOOLEAN:TOBJECT,STRING,STRING +BOOLEAN:TOBJECT,TOBJECT,TOBJECT,TOBJECT +BOOLEAN:TOBJECT,TOBJECT,STRING,TOBJECT +NONE:TOBJECT,TOBJECT,TOBJECT,TOBJECT +NONE:TOBJECT,TOBJECT,MTOBJECT,MTOBJECT +BOOLEAN:ENUM,INT +BOOLEAN:NONE +NONE:NONE +NONE:MSTRING,MSTRING +NONE:TOBJECT,STRING +NONE:TOBJECT,TOBJECT +NONE:STRING,STRING +NONE:TOBJECT +NONE:INT +NONE:STRING diff --git a/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSBase.chs b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSBase.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSBase.chs @@ -0,0 +1,56 @@ +{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-} + +module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase where + +import Foreign.Ptr +import Foreign.C.Types +import Debug.Trace + +-- #include + +-- | conversion from CInt to Bool +-- strangely, n often becomes -256 for False +getBool :: CUChar -> Bool -- CInt -> Bool +getBool n | n == 1 = True + | otherwise = False + +setBool :: Bool -> CUChar -- CInt +setBool True = 1 +setBool False = 0 + +data OpaqueJSContextGroup +{#pointer JSContextGroupRef as JSContextGroupRef -> OpaqueJSContextGroup #} + +data OpaqueJSContext +{#pointer JSContextRef as JSContextRef -> OpaqueJSContext #} +{#pointer JSGlobalContextRef as JSGlobalContextRef -> OpaqueJSContext #} + +data OpaqueJSString +{#pointer JSStringRef as JSStringRef -> OpaqueJSString #} + +data OpaqueJSClass +{#pointer JSClassRef as JSClassRef -> OpaqueJSClass #} + +data OpaqueJSPropertyNameArray +{#pointer JSPropertyNameArrayRef as JSPropertyNameArrayRef -> OpaqueJSPropertyNameArray #} + +data OpaqueJSPropertyNameAccumulator +{#pointer JSPropertyNameAccumulatorRef as JSPropertyNameAccumulatorRef -> OpaqueJSPropertyNameAccumulator #} + +data OpaqueJSValue +{#pointer JSValueRef as JSValueRef -> OpaqueJSValue #} +{#pointer JSObjectRef as JSObjectRef -> OpaqueJSValue #} + +{#pointer *JSValueRef as JSValueRefRef -> JSValueRef #} +{#pointer *JSStringRef as JSStringRefRef -> JSStringRef #} + + +{#fun JSEvaluateScript as ^ {id `JSContextRef', id `JSStringRef', id `JSObjectRef', id `JSStringRef', fromIntegral `Int', id `JSValueRefRef'} -> `JSValueRef' id #} + +{#fun JSCheckScriptSyntax as ^ {id `JSContextRef', id `JSStringRef', id `JSStringRef', fromIntegral `Int', id `JSValueRefRef'} -> `Bool' getBool #} + +{#fun JSGarbageCollect as ^ {id `JSContextRef'} -> `()' #} + + + + diff --git a/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSContextRef.chs @@ -0,0 +1,32 @@ +{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-} + +module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef where + +import Foreign.Ptr +import Foreign.C.Types + +-- import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef +-- import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef + +{#import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase #} + +-- {#pointer JSGlobalContextRef as JSGlobalContextRef -> OpaqueJSContext #} + +{#fun JSContextGroupCreate as ^ {} -> `JSContextGroupRef' id #} + +{#fun JSContextGroupRetain as ^ {id `JSContextGroupRef'} -> `JSContextGroupRef' id #} + +{#fun JSContextGroupRelease as ^ {id `JSContextGroupRef'} -> `()' #} + +{#fun JSGlobalContextCreate as ^ {id `JSClassRef'} -> `JSGlobalContextRef' id #} + +{#fun JSGlobalContextCreateInGroup as ^ {id `JSContextGroupRef', id `JSClassRef'} -> `JSGlobalContextRef' id #} + +{#fun JSGlobalContextRetain as ^ {id `JSGlobalContextRef'} -> `JSGlobalContextRef' id #} + +{#fun JSGlobalContextRelease as ^ { id `JSGlobalContextRef' } -> `()' #} + +{#fun JSContextGetGlobalObject as ^ { id `JSContextRef' } -> `JSObjectRef' id #} + +{#fun JSContextGetGroup as ^ { id `JSContextRef' } -> `JSContextGroupRef' id #} + diff --git a/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSObjectRef.chs b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSObjectRef.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSObjectRef.chs @@ -0,0 +1,293 @@ +{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-} + +module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef where + +import Foreign.C.String +import Foreign.C.Types +import Foreign.Ptr +import Foreign.Storable +import Data.Word (Word) + +{# import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase #} + +-- {#pointer *JSValueRef as Ptr JSValueRef #} + +type JSCSize = {#type size_t #} + +type JSPropertyAttributes = {#type JSPropertyAttributes #} + +type JSClassAttributes = {#type JSClassAttributes #} + +type JSObjectInitializeCallback = {#type JSObjectInitializeCallback #} + +type JSObjectFinalizeCallback = {#type JSObjectFinalizeCallback #} + +type JSObjectHasPropertyCallback = {#type JSObjectHasPropertyCallback #} + +type JSObjectGetPropertyCallback = {#type JSObjectGetPropertyCallback #} + +type JSObjectSetPropertyCallback = {#type JSObjectSetPropertyCallback #} + +type JSObjectDeletePropertyCallback = {#type JSObjectDeletePropertyCallback #} + +type JSObjectGetPropertyNamesCallback = {#type JSObjectGetPropertyNamesCallback #} + +type JSObjectCallAsFunctionCallback' = + JSContextRef + -> JSObjectRef + -> JSObjectRef + -> JSCSize + -> JSValueRefRef + -> JSValueRefRef + -> IO JSValueRef + +type JSObjectCallAsFunctionCallback = {#type JSObjectCallAsFunctionCallback #} + +type JSObjectCallAsConstructorCallback' = + JSContextRef + -> JSObjectRef + -> JSCSize + -> JSValueRefRef + -> JSValueRefRef + -> IO JSValueRef + +type JSObjectCallAsConstructorCallback = {#type JSObjectCallAsConstructorCallback #} + +type JSObjectHasInstanceCallback = {#type JSObjectHasInstanceCallback #} + +type JSObjectConvertToTypeCallback = {#type JSObjectConvertToTypeCallback #} + +type JSStaticValueRef = {#type JSStaticValueRef #} + + +value_get_name :: JSStaticValueRef -> IO String +value_get_name t = {#get JSStaticValue -> name #} t >>= peekCString + +value_set_name :: JSStaticValueRef -> String -> IO () +value_set_name t str = {#set JSStaticFunction -> name #} t =<< newCString str + + +value_get_getProperty :: JSStaticValueRef -> IO JSObjectGetPropertyCallback +value_get_getProperty t = {#get JSStaticValue -> getProperty #} t + + +value_set_getProperty :: JSStaticValueRef -> JSObjectGetPropertyCallback -> IO () +value_set_getProperty t cbk = {#set JSStaticValue -> getProperty #} t cbk + + +value_get_setProperty :: JSStaticValueRef -> IO JSObjectSetPropertyCallback +value_get_setProperty t = {#get JSStaticValue -> setProperty #} t + +value_set_setProperty :: JSStaticValueRef -> JSObjectSetPropertyCallback -> IO () +value_set_setProperty t cbk = {#set JSStaticValue -> setProperty #} t cbk + +value_get_attributes :: JSStaticValueRef -> IO JSPropertyAttributes +value_get_attributes t = {#get JSStaticValue -> attributes #} t + +value_set_attributes :: JSStaticValueRef -> JSPropertyAttributes -> IO () +value_set_attributes t attr = {#set JSStaticValue -> attributes #} t attr + + +type JSStaticFunctionRef = {#type JSStaticFunctionRef #} + +func_get_name :: JSStaticFunctionRef -> IO String +func_get_name t = {#get JSStaticFunction -> name #} t >>= peekCString + +func_set_name :: JSStaticFunctionRef -> String -> IO () +func_set_name t str = {#set JSStaticFunction -> name #} t =<< newCString str + +func_get_callAsFunction :: JSStaticFunctionRef -> IO JSObjectCallAsFunctionCallback +func_get_callAsFunction t = {#get JSStaticFunction -> callAsFunction #} t + +func_set_callAsFunction :: JSStaticFunctionRef -> JSObjectCallAsFunctionCallback -> IO () +func_set_callAsFunction t cbk = {#set JSStaticFunction -> callAsFunction #} t cbk + +func_get_attributes :: JSStaticFunctionRef -> IO JSPropertyAttributes +func_get_attributes t = {#get JSStaticFunction -> attributes #} t + +func_set_attributes :: JSStaticFunctionRef -> JSPropertyAttributes -> IO () +func_set_attributes t attr = {#set JSStaticFunction -> attributes #} t attr + +type JSClassDefinitionRef = {#type JSClassDefinitionRef #} + +class_get_version :: JSClassDefinitionRef -> IO Int +class_get_version t = {#get JSClassDefinition -> version #} t >>= return . fromIntegral + +class_set_version :: JSClassDefinitionRef -> Int -> IO () +class_set_version t n = {#set JSClassDefinition -> version #} t (fromIntegral n) + +class_get_attributes :: JSClassDefinitionRef -> IO JSClassAttributes +class_get_attributes t = {#get JSClassDefinition -> attributes #} t + +class_set_attributes :: JSClassDefinitionRef -> JSClassAttributes -> IO () +class_set_attributes t attr = {#set JSClassDefinition -> attributes #} t attr + +class_get_className :: JSClassDefinitionRef -> IO String +class_get_className t = {#get JSClassDefinition -> className #} t >>= peekCString + +class_set_className :: JSClassDefinitionRef -> String -> IO () +class_set_className t cname = {#set JSClassDefinition -> className #} t =<< newCString cname + +class_get_parentClass :: JSClassDefinitionRef -> IO JSClassRef +class_get_parentClass t = {#get JSClassDefinition -> parentClass #} t >>= return . castPtr + +class_set_parentClass :: JSClassDefinitionRef -> JSClassRef -> IO () +class_set_parentClass t c = {#set JSClassDefinition -> parentClass #} t (castPtr c) + + +class_get_staticValues :: JSClassDefinitionRef -> IO JSStaticValueRef +class_get_staticValues t = {#get JSClassDefinition -> staticValues #} t + +class_set_staticValues :: JSClassDefinitionRef -> JSStaticValueRef -> IO () +class_set_staticValues t v = {#set JSClassDefinition -> staticValues #} t v + + +class_get_staticFunctions :: JSClassDefinitionRef -> IO JSStaticFunctionRef +class_get_staticFunctions t = {#get JSClassDefinition -> staticFunctions #} t + + +class_set_staticFunctions :: JSClassDefinitionRef -> JSStaticFunctionRef -> IO () +class_set_staticFunctions t f = {#set JSClassDefinition -> staticFunctions #} t f + +class_get_initialize :: JSClassDefinitionRef -> IO JSObjectInitializeCallback +class_get_initialize t = {#get JSClassDefinition -> initialize #} t + +class_set_initialize :: JSClassDefinitionRef -> JSObjectInitializeCallback -> IO () +class_set_initialize t cbk = {#set JSClassDefinition -> initialize #} t cbk + + + +class_get_finalize :: JSClassDefinitionRef -> IO JSObjectFinalizeCallback +class_get_finalize t = {#get JSClassDefinition -> finalize #} t + +class_set_finalize :: JSClassDefinitionRef -> JSObjectFinalizeCallback -> IO () +class_set_finalize t f = {#set JSClassDefinition -> finalize #} t f + + +class_get_hasProperty :: JSClassDefinitionRef -> IO JSObjectHasPropertyCallback +class_get_hasProperty t = {#get JSClassDefinition -> hasProperty #} t + +class_set_hasProperty :: JSClassDefinitionRef -> JSObjectHasPropertyCallback -> IO () +class_set_hasProperty t f = {#set JSClassDefinition -> hasProperty #} t f + +class_get_getProperty :: JSClassDefinitionRef -> IO JSObjectGetPropertyCallback +class_get_getProperty t = {#get JSClassDefinition -> getProperty #} t + +class_set_getProperty :: JSClassDefinitionRef -> JSObjectGetPropertyCallback -> IO () +class_set_getProperty t f = {#set JSClassDefinition -> getProperty #} t f + +class_get_setProperty :: JSClassDefinitionRef -> IO JSObjectSetPropertyCallback +class_get_setProperty t = {#get JSClassDefinition -> setProperty #} t + +class_set_setProperty :: JSClassDefinitionRef -> JSObjectSetPropertyCallback -> IO () +class_set_setProperty t f = {#set JSClassDefinition -> setProperty #} t f + +class_get_deleteProperty :: JSClassDefinitionRef -> IO JSObjectDeletePropertyCallback +class_get_deleteProperty t = {#get JSClassDefinition -> deleteProperty #} t + +class_set_deleteProperty :: JSClassDefinitionRef -> JSObjectDeletePropertyCallback -> IO () +class_set_deleteProperty t f = {#set JSClassDefinition -> deleteProperty #} t f + +class_get_getPropertyNames :: JSClassDefinitionRef -> IO JSObjectGetPropertyNamesCallback +class_get_getPropertyNames t = {#get JSClassDefinition -> getPropertyNames #} t + +class_set_getPropertyNames :: JSClassDefinitionRef -> JSObjectGetPropertyNamesCallback -> IO () +class_set_getPropertyNames t f = {#set JSClassDefinition -> getPropertyNames #} t f + +class_get_callAsFunction :: JSClassDefinitionRef -> IO JSObjectCallAsFunctionCallback +class_get_callAsFunction t = {#get JSClassDefinition -> callAsFunction #} t + +class_set_callAsFunction :: JSClassDefinitionRef -> JSObjectCallAsFunctionCallback -> IO () +class_set_callAsFunction t f = {#set JSClassDefinition -> callAsFunction #} t f + + +class_get_callAsConstructor :: JSClassDefinitionRef -> IO JSObjectCallAsConstructorCallback +class_get_callAsConstructor t = {#get JSClassDefinition -> callAsConstructor #} t + +class_set_callAsConstructor :: JSClassDefinitionRef -> JSObjectCallAsConstructorCallback -> IO () +class_set_callAsConstructor t f = {#set JSClassDefinition -> callAsConstructor #} t f + + +class_get_hasInstance :: JSClassDefinitionRef -> IO JSObjectHasInstanceCallback +class_get_hasInstance t = {#get JSClassDefinition -> hasInstance #} t + +class_set_hasInstance :: JSClassDefinitionRef -> JSObjectHasInstanceCallback -> IO () +class_set_hasInstance t f = {#set JSClassDefinition -> hasInstance #} t f + + +class_get_convertToType :: JSClassDefinitionRef -> IO JSObjectConvertToTypeCallback +class_get_convertToType t = {#get JSClassDefinition -> convertToType #} t + +class_set_convertToType :: JSClassDefinitionRef -> JSObjectConvertToTypeCallback -> IO () +class_set_convertToType t f = {#set JSClassDefinition -> convertToType #} t f + + +-- kJSClassDefinitionEmpty + +{#fun JSClassCreate as ^ {id `JSClassDefinitionRef'} -> `JSClassRef' id #} + +{#fun JSClassRetain as ^ {id `JSClassRef'} -> `JSClassRef' id #} + +{#fun JSClassRelease as ^ {id `JSClassRef'} -> `()' #} + +{#fun JSObjectMake as ^ {id `JSContextRef', id `JSClassRef', id `Ptr ()'} -> `JSObjectRef' id #} + +{#fun JSObjectMakeFunctionWithCallback as ^ {id `JSContextRef', id `JSStringRef', id `JSObjectCallAsFunctionCallback'} -> `JSObjectRef' id #} + +{#fun JSObjectMakeConstructor as ^ {id `JSContextRef', id `JSClassRef', id `JSObjectCallAsConstructorCallback'} -> `JSObjectRef' id #} + +{#fun JSObjectMakeArray as ^ {id `JSContextRef', fromIntegral `CSize', id `JSValueRefRef', id `JSValueRefRef'} -> `JSObjectRef' id #} + +{#fun JSObjectMakeDate as ^ {id `JSContextRef', fromIntegral `CSize', id `JSValueRefRef', id `JSValueRefRef'} -> `JSObjectRef' id #} + +{#fun JSObjectMakeError as ^ {id `JSContextRef', fromIntegral `CSize', id `JSValueRefRef', id `JSValueRefRef'} -> `JSObjectRef' id #} + +{#fun JSObjectMakeRegExp as ^ {id `JSContextRef', fromIntegral `CSize', id `JSValueRefRef', id `JSValueRefRef'} -> `JSObjectRef' id #} + + +{#fun JSObjectMakeFunction as ^ {id `JSContextRef', id `JSStringRef', id `CUInt', id `JSStringRefRef', id `JSStringRef', id `JSStringRef', fromIntegral `Int', id `JSValueRefRef'} -> `JSObjectRef' id #} + +{#fun JSObjectGetPrototype as ^ {id `JSContextRef', id `JSObjectRef'} -> `JSValueRef' id #} + +{#fun JSObjectSetPrototype as ^ {id `JSContextRef', id `JSObjectRef', id `JSValueRef'} -> `()' #} + +{#fun JSObjectHasProperty as ^ {id `JSContextRef', id `JSObjectRef', id `JSStringRef'} -> `Bool' getBool #} + +{#fun JSObjectGetProperty as ^ {id `JSContextRef', id `JSObjectRef', id `JSStringRef', id `JSValueRefRef'} -> `JSValueRef' id #} + +{#fun JSObjectSetProperty as ^ {id `JSContextRef', id `JSObjectRef', id `JSStringRef', id `JSValueRef', id `JSPropertyAttributes', id `JSValueRefRef'} -> `()' #} + +{#fun JSObjectDeleteProperty as ^ {id `JSContextRef', id `JSObjectRef', id `JSStringRef', id `JSValueRefRef'} -> `Bool' getBool #} + +{#fun JSObjectGetPropertyAtIndex as ^ {id `JSContextRef', id `JSObjectRef', id `CUInt', id `JSValueRefRef'} -> `JSValueRef' id #} + +{#fun JSObjectSetPropertyAtIndex as ^ {id `JSContextRef', id `JSObjectRef', id `CUInt', id `JSValueRef', id `JSValueRefRef'} -> `()' #} + +{#fun JSObjectGetPrivate as ^ {id `JSObjectRef'} -> `Ptr ()' id #} + +{#fun JSObjectSetPrivate as ^ {id `JSObjectRef', id `Ptr ()'} -> `Bool' getBool #} + +{#fun JSObjectIsFunction as ^ {id `JSContextRef', id `JSObjectRef'} -> `Bool' getBool #} + +{#fun JSObjectCallAsFunction as ^ {id `JSContextRef', id `JSObjectRef', id `JSObjectRef', fromIntegral `CSize', id `JSValueRefRef', id `JSValueRefRef'} -> `JSValueRef' id #} + +{#fun JSObjectCallAsConstructor as ^ {id `JSContextRef', id `JSObjectRef', fromIntegral `CSize', id `JSValueRefRef', id `JSValueRefRef'} -> `JSObjectRef' id #} + +{#fun JSObjectCopyPropertyNames as ^ {id `JSContextRef', id `JSObjectRef'} -> `JSPropertyNameArrayRef' id #} + +{#fun JSPropertyNameArrayRetain as ^ {id `JSPropertyNameArrayRef'} -> `JSPropertyNameArrayRef' id #} + +{#fun JSPropertyNameArrayRelease as ^ {id `JSPropertyNameArrayRef'} -> `()' #} + +{#fun JSPropertyNameArrayGetCount as ^ {id `JSPropertyNameArrayRef'} -> `CSize' fromIntegral #} + +{#fun JSPropertyNameArrayGetNameAtIndex as ^ {id `JSPropertyNameArrayRef', fromIntegral `CSize'} -> `JSStringRef' id #} + +{#fun JSPropertyNameAccumulatorAddName as ^ {id `JSPropertyNameAccumulatorRef', id `JSStringRef'} -> `()' #} + + + + + + + diff --git a/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSStringRef.chs @@ -0,0 +1,34 @@ +{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-} + +module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef where + +import Foreign.Ptr +import Foreign.C.String +import Foreign.C.Types + +{#import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase #} +{#import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef #} + +type JSChar = {#type JSChar #} +{#pointer *JSChar as JSCharRef -> JSChar #} + +{#fun JSStringCreateWithCharacters as ^ { id `JSCharRef', fromIntegral `CSize' } -> `JSStringRef' id #} + +{#fun JSStringCreateWithUTF8CString as ^ { `String' } -> `JSStringRef' id #} + +{#fun JSStringRetain as ^ { id `JSStringRef' } -> `JSStringRef' id #} + +{#fun JSStringRelease as ^ { id `JSStringRef' } -> `()' #} + +{#fun JSStringGetLength as ^ { id `JSStringRef' } -> `CSize' fromIntegral #} + +{#fun JSStringGetCharactersPtr as ^ {id `JSStringRef' } -> `JSCharRef' id #} + +{#fun JSStringGetMaximumUTF8CStringSize as ^ {id `JSStringRef'} -> `CSize' fromIntegral #} + +{#fun JSStringGetUTF8CString as ^ {id `JSStringRef', `String', fromIntegral `CSize'} -> `CSize' fromIntegral #} + +{#fun JSStringIsEqual as ^ {id `JSStringRef', id `JSStringRef' } -> `Bool' getBool #} + +{#fun JSStringIsEqualToUTF8CString as ^ {id `JSStringRef', `String'} -> `Bool' getBool #} + diff --git a/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSValueRef.chs b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSValueRef.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/JSValueRef.chs @@ -0,0 +1,64 @@ +{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-} + +module Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef where + +import Foreign.Ptr +import Foreign.C.Types + + +{#import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase #} + +{#enum JSType {underscoreToCase} deriving (Show,Eq) #} + +toEnumFromIntegral :: (Enum a, Integral i) => i -> a +toEnumFromIntegral = toEnum . fromIntegral + + + +{#fun JSValueGetType as ^ {id `JSContextRef', id `JSValueRef'}-> `JSType' toEnumFromIntegral #} + +{#fun JSValueIsUndefined as ^ {id `JSContextRef', id `JSValueRef'} -> `Bool' getBool #} + +{#fun JSValueIsNull as ^ {id `JSContextRef', id `JSValueRef'} -> `Bool' getBool #} + +{#fun JSValueIsBoolean as ^ {id `JSContextRef', id `JSValueRef'} -> `Bool' getBool #} + +{#fun JSValueIsNumber as ^ {id `JSContextRef', id `JSValueRef'} -> `Bool' getBool #} + +{#fun JSValueIsString as ^ {id `JSContextRef', id `JSValueRef'} -> `Bool' getBool #} + +{#fun JSValueIsObject as ^ {id `JSContextRef', id `JSValueRef'} -> `Bool' getBool #} + +{#fun JSValueIsObjectOfClass as ^ {id `JSContextRef', id `JSValueRef', id `JSClassRef'} -> `Bool' getBool #} + +{#fun JSValueIsEqual as ^ {id `JSContextRef', id `JSValueRef', id `JSValueRef', id `JSValueRefRef'} -> `Bool' getBool #} + +{#fun JSValueIsStrictEqual as ^ {id `JSContextRef', id `JSValueRef', id `JSValueRef'} -> `Bool' getBool #} + +{#fun JSValueIsInstanceOfConstructor as ^ {id `JSContextRef', id `JSValueRef', id `JSObjectRef', id `JSValueRefRef'} -> `Bool' getBool #} + +{#fun JSValueMakeUndefined as ^ {id `JSContextRef'} -> `JSValueRef' id #} + +{#fun JSValueMakeNull as ^ {id `JSContextRef'} -> `JSValueRef' id #} + +{#fun JSValueMakeBoolean as ^ {id `JSContextRef', setBool `Bool'} -> `JSValueRef' id #} + +{#fun JSValueMakeNumber as ^ {id `JSContextRef', realToFrac `Double' } -> `JSValueRef' id #} + +{#fun JSValueMakeString as ^ {id `JSContextRef', id `JSStringRef'} -> `JSValueRef' id #} + +{#fun JSValueMakeFromJSONString as ^ {id `JSContextRef', id `JSStringRef'} -> `JSValueRef' id #} + +{#fun JSValueCreateJSONString as ^ {id `JSContextRef', id `JSValueRef', fromIntegral `CUInt', id `JSValueRefRef'} -> `JSStringRef' id #} + +{#fun JSValueToBoolean as ^ {id `JSContextRef', id `JSValueRef'} -> `Bool' getBool #} + +{#fun JSValueToNumber as ^ {id `JSContextRef', id `JSValueRef', id `JSValueRefRef'} -> `Double' realToFrac #} + +{#fun JSValueToStringCopy as ^ {id `JSContextRef', id `JSValueRef', id `JSValueRefRef'} -> `JSStringRef' id #} + +{#fun JSValueToObject as ^ {id `JSContextRef', id `JSValueRef', id `JSValueRefRef'} -> `JSObjectRef' id #} + +{#fun JSValueProtect as ^ {id `JSContextRef', id `JSValueRef'} -> `()' #} + +{#fun JSValueUnprotect as ^ {id `JSContextRef', id `JSValueRef'} -> `()' #} diff --git a/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/WebFrame.chs b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/WebFrame.chs new file mode 100644 --- /dev/null +++ b/src/Graphics/UI/Gtk/WebKit/JavaScriptCore/WebFrame.chs @@ -0,0 +1,23 @@ +{-# LANGUAGE EmptyDataDecls, ForeignFunctionInterface #-} + +module Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame where + +#if __GLASGOW_HASKELL__ >= 704 +import Foreign.ForeignPtr.Unsafe +#else +import Foreign.ForeignPtr +#endif +import Foreign.Ptr +import Foreign.C.Types + +import Graphics.UI.Gtk.WebKit.Types +import Graphics.UI.Gtk.WebKit.WebFrame +-- {#import Graphics.UI.Gtk.WebKit.JavaScriptCore.Types #} +{#import Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase #} + +#include + +webFrameGetGlobalContext :: WebFrameClass self => self -> IO JSGlobalContextRef +webFrameGetGlobalContext webframe = {#call webkit_web_frame_get_global_context#} ((castPtr.unsafeForeignPtrToPtr.unWebFrame.toWebFrame) webframe) + + diff --git a/webkitgtk3-javascriptcore.cabal b/webkitgtk3-javascriptcore.cabal new file mode 100644 --- /dev/null +++ b/webkitgtk3-javascriptcore.cabal @@ -0,0 +1,61 @@ +Name: webkitgtk3-javascriptcore +Version: 0.12.5.0 +Synopsis: JavaScriptCore FFI from webkitgtk +Description: FFI for JavaScriptCore module from webkitgtk +License: BSD3 +License-file: LICENSE +Author: Ian-Woo Kim +Maintainer: Ian-Woo Kim +Build-Type: Custom +Cabal-Version: >= 1.8 +Extra-Source-Files: hsjscore.h + SetupWrapper.hs SetupMain.hs Gtk2HsSetup.hs + marshal.list + hierarchy.list + +x-Types-File: src/Graphics/UI/Gtk/WebKit/JavaScriptCore/Types.chs +x-Types-Tag: webkit webkit-dom +x-Types-ModName: Graphics.UI.Gtk.WebKit.JavaScriptCore.Types +x-Types-Forward: *Graphics.UI.GtkInternals +x-Types-Destructor: objectUnrefFromMainloop +x-Types-Hierarchy: hierarchy.list + +Source-Repository head + type: git + location: https://github.com/gtk2hs/webkit-javascriptcore + +Library + hs-source-dirs: src + build-depends: base >= 4 && < 5, + glib + + build-tools: gtk2hsC2hs >= 0.13.8, + gtk2hsHookGenerator, gtk2hsTypeGen + + exposed-modules: + Graphics.UI.Gtk.WebKit.JavaScriptCore.JSBase + Graphics.UI.Gtk.WebKit.JavaScriptCore.JSContextRef + Graphics.UI.Gtk.WebKit.JavaScriptCore.JSObjectRef + Graphics.UI.Gtk.WebKit.JavaScriptCore.JSStringRef + Graphics.UI.Gtk.WebKit.JavaScriptCore.JSValueRef + -- + -- Graphics.UI.Gtk.WebKit.JavaScriptCore.Types + Graphics.UI.Gtk.WebKit.JavaScriptCore.WebFrame + other-modules: + + + extensions: ForeignFunctionInterface + + x-Signals-File: src/Graphics/UI/Gtk/WebKit/JavaScriptCore/Signals.chs + x-Signals-Modname: src/Graphics.UI.Gtk.WebKit.JavaScriptCore.Signals + x-Signals-Types: marshal.list + x-Signals-Import: Graphics.UI.GtkInternals + + include-dirs: . + include + -- /usr/include/webkitgtk-1.0 + -- /usr/include/glib-2.0 + -- /usr/lib/x86_64-linux-gnu/glib-2.0/include + x-c2hs-Header: hsjscore.h + pkgconfig-depends: webkitgtk-3.0 >=1.1.15 + build-depends: gtk3 >=0.12.5.0 && <0.13, webkitgtk3 >= 0.12.5