webkit-0.12.3/0000755000000000000000000000000011633370412011250 5ustar0000000000000000webkit-0.12.3/webkit.cabal0000644000000000000000000000652611633370412013532 0ustar0000000000000000Name: webkit Version: 0.12.3 License: LGPL-2.1 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team Author: Cjacker Huang, Andy Stewart, Axel Simon Maintainer: gtk2hs-users@lists.sourceforge.net Build-Type: Custom Cabal-Version: >= 1.8 Stability: provisional homepage: http://projects.haskell.org/gtk2hs/ bug-reports: http://hackage.haskell.org/trac/gtk2hs/ Synopsis: Binding to the Webkit library. Description: WebKit is a web content engine, derived from KHTML and KJS from KDE, and used primarily in Apple's Safari browser. It is made to be embedded in other applications, such as mail readers, or web browsers. It is able to display content such as HTML, SVG, XML, and others. It also supports DOM, XMLHttpRequest, XSLT, CSS, Javascript/ECMAscript and more. Category: Graphics Tested-With: GHC == 6.10.4, GHC == 6.12.3, GHC == 7.0.4, GHC == 7.2.1 Extra-Source-Files: hswebkit.h SetupWrapper.hs SetupMain.hs Gtk2HsSetup.hs marshal.list hierarchy.list Data-Dir: demo Data-Files: Webkit.hs Makefile x-Types-File: Graphics/UI/Gtk/WebKit/Types.chs x-Types-Tag: webkit x-Types-ModName: Graphics.UI.Gtk.WebKit.Types x-Types-Forward: *Graphics.UI.GtkInternals x-Types-Destructor: objectUnrefFromMainloop x-Types-Hierarchy: hierarchy.list Source-Repository head type: darcs location: http://code.haskell.org/webkit/ Library build-depends: base >= 4 && < 5, glib >= 0.12 && < 0.13, pango >= 0.12 && < 0.13, cairo >= 0.12 && < 0.13, gtk >= 0.12 && < 0.13 build-tools: gtk2hsC2hs >= 0.13.5, gtk2hsHookGenerator, gtk2hsTypeGen exposed-modules: Graphics.UI.Gtk.WebKit.CacheModel Graphics.UI.Gtk.WebKit.Download Graphics.UI.Gtk.WebKit.GeolocationPolicyDecision Graphics.UI.Gtk.WebKit.HitTestResult Graphics.UI.Gtk.WebKit.NetworkRequest Graphics.UI.Gtk.WebKit.NetworkResponse Graphics.UI.Gtk.WebKit.SecurityOrigin Graphics.UI.Gtk.WebKit.SoupAuthDialog Graphics.UI.Gtk.WebKit.WebBackForwardList Graphics.UI.Gtk.WebKit.WebDatabase Graphics.UI.Gtk.WebKit.WebDataSource Graphics.UI.Gtk.WebKit.WebFrame Graphics.UI.Gtk.WebKit.WebHistoryItem Graphics.UI.Gtk.WebKit.WebInspector Graphics.UI.Gtk.WebKit.WebNavigationAction Graphics.UI.Gtk.WebKit.WebPolicyDecision Graphics.UI.Gtk.WebKit.WebResource Graphics.UI.Gtk.WebKit.WebSettings Graphics.UI.Gtk.WebKit.WebView Graphics.UI.Gtk.WebKit.WebWindowFeatures other-modules: Graphics.UI.Gtk.WebKit.Internal Graphics.UI.Gtk.WebKit.Types Graphics.UI.Gtk.WebKit.Signals extensions: ForeignFunctionInterface x-Signals-File: Graphics/UI/Gtk/WebKit/Signals.chs x-Signals-Modname: Graphics.UI.Gtk.WebKit.Signals x-Signals-Types: marshal.list x-Signals-Import: Graphics.UI.GtkInternals x-c2hs-Header: hswebkit.h pkgconfig-depends: webkit-1.0 >= 1.1.15 webkit-0.12.3/Setup.hs0000644000000000000000000000050411633370412012703 0ustar0000000000000000-- 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" webkit-0.12.3/SetupWrapper.hs0000644000000000000000000001427711633370412014260 0ustar0000000000000000-- 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 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 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) webkit-0.12.3/hswebkit.h0000644000000000000000000000200211633370412013233 0ustar0000000000000000/* * 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_WEBKIT_H #define HS_WEBKIT_H /* to avoid stdbool.h error in JavaScriptCore/JSBase.h*/ #define _Bool int /* include webkit headers*/ #include #endif webkit-0.12.3/marshal.list0000644000000000000000000000555611633370412013607 0ustar0000000000000000# 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 webkit-0.12.3/Gtk2HsSetup.hs0000644000000000000000000004545211633370412013741 0ustar0000000000000000{-# LANGUAGE CPP #-} #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 ) 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(..), 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, 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. 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 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"] 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 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 "" . 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) webkit-0.12.3/hierarchy.list0000644000000000000000000004042511633370412014130 0ustar0000000000000000# 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 webkit-0.12.3/SetupMain.hs0000644000000000000000000000070111633370412013507 0ustar0000000000000000-- 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 ) import Distribution.Simple ( defaultMainWithHooks ) main = do checkGtk2hsBuildtools ["gtk2hsC2hs", "gtk2hsTypeGen", "gtk2hsHookGenerator"] defaultMainWithHooks gtk2hsUserHooks webkit-0.12.3/COPYING0000644000000000000000000006351011633370412012310 0ustar0000000000000000 GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 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 Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! webkit-0.12.3/Graphics/0000755000000000000000000000000011633370412013010 5ustar0000000000000000webkit-0.12.3/Graphics/UI/0000755000000000000000000000000011633370412013325 5ustar0000000000000000webkit-0.12.3/Graphics/UI/Gtk/0000755000000000000000000000000011633370412014052 5ustar0000000000000000webkit-0.12.3/Graphics/UI/Gtk/WebKit/0000755000000000000000000000000011633370412015237 5ustar0000000000000000webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebSettings.chs0000644000000000000000000003756511633370412020214 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebSettings -- Author : Cjacker Huang -- Copyright : (c) 2009 Cjacker Huang -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Control the behaviour of a 'WebView' ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebSettings ( -- * Desciption -- | WebKitWebSettings can be applied to a WebKitWebView to control the to be used text encoding, color, -- font sizes, printing mode, script support, loading of images and various other things. -- * Types WebSettings, WebSettingsClass, EditingBehavior, -- * Constructors webSettingsNew, -- * Methods webSettingsCopy, webSettingsGetUserAgent, -- * Attributes -- ** Family webSettingsCursiveFontFamily, webSettingsDefaultFontFamily, webSettingsFantasyFontFamily, webSettingsMonospaceFontFamily, webSettingsSansFontFamily, webSettingsSerifFontFamily, -- ** FontSize webSettingsDefaultFontSize, webSettingsDefaultMonospaceFontSize, webSettingsMinimumFontSize, webSettingsMinimumLogicalFontSize, -- ** Image webSettingsAutoLoadImages, webSettingsAutoShrinkImages, -- ** Encoding webSettingsDefaultEncoding, -- ** Other webSettingsEditingBehavior, webSettingsEnableCaretBrowsing, webSettingsEnableDeveloperExtras, webSettingsEnableHtml5Database, webSettingsEnableHtml5LocalStorage, webSettingsEnableOfflineWebApplicationCache, webSettingsEnablePlugins, webSettingsEnablePrivateBrowsing, webSettingsEnableScripts, webSettingsEnableSpellChecking, webSettingsEnableUniversalAccessFromFileUris, webSettingsEnableXssAuditor, webSettingsEnableSiteSpecificQuirks, #if WEBKIT_CHECK_VERSION (1,1,16) webSettingsEnableDomPaste, #endif #if WEBKIT_CHECK_VERSION (1,1,18) webSettingsEnableDefaultContextMenu, webSettingsEnablePageCache, #endif #if WEBKIT_CHECK_VERSION (1,1,23) webSettingsEnableSpatialNavigation, #endif webSettingsEnforce96Dpi, webSettingsJSCanOpenWindowAuto, webSettingsPrintBackgrounds, webSettingsResizableTextAreas, webSettingsSpellCheckingLang, #if WEBKIT_CHECK_VERSION (1,1,17) webSettingsTabKeyCyclesThroughElements, #endif webSettingsUserAgent, webSettingsUserStylesheetUri, webSettingsZoomStep, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import System.Glib.Properties import System.Glib.Attributes import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} {#enum EditingBehavior {underscoreToCase}#} ------------------ -- Constructors -- | Create a new 'WebSettings' instance. -- -- A 'WebSettings' can be applied to a 'WebView' -- to control the to be used text encoding, color, font size, -- printing mode,script support, loading of images and various other things. webSettingsNew :: IO WebSettings webSettingsNew = wrapNewGObject mkWebSettings $ {#call web_settings_new#} -- | Copy an existing 'WebSettings' instance. webSettingsCopy :: WebSettingsClass self => self -> IO WebSettings webSettingsCopy websettings = constructNewGObject mkWebSettings $ {#call web_settings_copy#} (toWebSettings websettings) -- | Return the User-Agent string currently used. webSettingsGetUserAgent :: WebSettingsClass self => self -> IO (Maybe String) -- ^ User-Agent string or @Nothing@ in case failed. webSettingsGetUserAgent websettings = {#call web_settings_get_user_agent#} (toWebSettings websettings) >>= maybePeek peekCString -- | Load images automatically -- -- Default value: True webSettingsAutoLoadImages :: (WebSettingsClass self) => Attr self Bool webSettingsAutoLoadImages = newAttrFromBoolProperty "auto-load-images" -- | Automatically shrink standalone images to fit -- -- Default value: True webSettingsAutoShrinkImages :: (WebSettingsClass self) => Attr self Bool webSettingsAutoShrinkImages = newAttrFromBoolProperty "auto-shrink-images" -- | The default Cursive font family used to display text -- -- Default value "serif" webSettingsCursiveFontFamily :: (WebSettingsClass self) => Attr self String webSettingsCursiveFontFamily = newAttrFromStringProperty "cursive-font-family" -- | The default encoding used to display text -- -- Default value "iso-8859-1" webSettingsDefaultEncoding :: (WebSettingsClass self) => Attr self String webSettingsDefaultEncoding = newAttrFromStringProperty "default-encoding" -- | The default font family used to display text -- -- Default value: "sans-serif" webSettingsDefaultFontFamily :: (WebSettingsClass self) => Attr self String webSettingsDefaultFontFamily = newAttrFromStringProperty "default-font-family" -- | The default font size used to display text -- -- Default value: >=5 webSettingsDefaultFontSize :: (WebSettingsClass self) => Attr self Int webSettingsDefaultFontSize = newAttrFromIntProperty "default-font-size" -- | The default font size used to display monospace text -- -- Allowed values: >= 5 -- -- Default value: 10 webSettingsDefaultMonospaceFontSize :: (WebSettingsClass self) => Attr self Int webSettingsDefaultMonospaceFontSize = newAttrFromIntProperty "default-monospace-font-size" -- | This settings controls various editing behaviors webSettingsEditingBehavior :: (WebSettingsClass self) => Attr self EditingBehavior webSettingsEditingBehavior = newAttrFromEnumProperty "editing-behavior" {#call pure unsafe webkit_editing_behavior_get_type#} -- | Whether to enable caret browsing mode. webSettingsEnableCaretBrowsing :: (WebSettingsClass self) => Attr self Bool webSettingsEnableCaretBrowsing = newAttrFromBoolProperty "enable-caret-browsing" -- | Whether developer extensions should be enabled. -- -- This enables, for now, the 'WebInspector' webSettingsEnableDeveloperExtras :: (WebSettingsClass self) => Attr self Bool webSettingsEnableDeveloperExtras = newAttrFromBoolProperty "enable-developer-extras" #if WEBKIT_CHECK_VERSION (1,1,16) -- | Whether to enable DOM paste. If set to 'True', document.execCommand("Paste") will correctly execute -- and paste content of the clipboard. -- -- Default value: 'False' -- -- * Since 1.1.16 webSettingsEnableDomPaste :: (WebSettingsClass self) => Attr self Bool webSettingsEnableDomPaste = newAttrFromBoolProperty "enable-dom-paste" #endif -- | Whether to enable HTML5 client-side SQL database support. webSettingsEnableHtml5Database :: (WebSettingsClass self) => Attr self Bool webSettingsEnableHtml5Database = newAttrFromBoolProperty "enable-html5-database" -- | Whether to enable HTML5 localStorage support. webSettingsEnableHtml5LocalStorage :: (WebSettingsClass self) => Attr self Bool webSettingsEnableHtml5LocalStorage = newAttrFromBoolProperty "enable-html5-local-storage" -- | Whether to enable HTML5 offline web application cache support. webSettingsEnableOfflineWebApplicationCache :: (WebSettingsClass self) => Attr self Bool webSettingsEnableOfflineWebApplicationCache = newAttrFromBoolProperty "enable-offline-web-application-cache" -- | Enable embedded plugin objects. webSettingsEnablePlugins :: (WebSettingsClass self) => Attr self Bool webSettingsEnablePlugins = newAttrFromBoolProperty "enable-plugins" -- | Whether to enable private browsing mode. webSettingsEnablePrivateBrowsing :: (WebSettingsClass self) => Attr self Bool webSettingsEnablePrivateBrowsing = newAttrFromBoolProperty "enable-private-browsing" -- | Enable embedded scripting languages webSettingsEnableScripts :: (WebSettingsClass self) => Attr self Bool webSettingsEnableScripts = newAttrFromBoolProperty "enable-scripts" -- | Whether to enable speel checking while typing. webSettingsEnableSpellChecking :: (WebSettingsClass self) => Attr self Bool webSettingsEnableSpellChecking = newAttrFromBoolProperty "enable-spell-checking" -- | Whether to allow files loaded through file:// URLs universal access to all pages. webSettingsEnableUniversalAccessFromFileUris :: (WebSettingsClass self) => Attr self Bool webSettingsEnableUniversalAccessFromFileUris = newAttrFromBoolProperty "enable-universal-access-from-file-uris" -- | Whether to enable the XSS Auditor. -- -- This feature filters some kinds of reflective XSS attacks on vulnerable web sites. webSettingsEnableXssAuditor :: (WebSettingsClass self) => Attr self Bool webSettingsEnableXssAuditor = newAttrFromBoolProperty "enable-xss-auditor" -- | Enforce a resolution of 96 DPI. webSettingsEnforce96Dpi :: (WebSettingsClass self) => Attr self Bool webSettingsEnforce96Dpi = newAttrFromBoolProperty "enforce-96-dpi" -- | The default Fantasy font family used to display text webSettingsFantasyFontFamily :: (WebSettingsClass self) => Attr self String webSettingsFantasyFontFamily = newAttrFromStringProperty "fantasy-font-family" -- | Whether JavaScript can open popup windows automatically without user intervention. webSettingsJSCanOpenWindowAuto :: (WebSettingsClass self) => Attr self Bool webSettingsJSCanOpenWindowAuto = newAttrFromBoolProperty "javascript-can-open-windows-automatically" -- | The minimum font size used to display text. -- -- Allowed values: >=1 -- -- Default value: 5 webSettingsMinimumFontSize :: (WebSettingsClass self) => Attr self Int webSettingsMinimumFontSize = newAttrFromIntProperty "minimum-font-size" -- | The minimum logical font size used to display text -- -- Allowed values: >=1 -- -- Default value: 5 webSettingsMinimumLogicalFontSize :: (WebSettingsClass self) => Attr self Int webSettingsMinimumLogicalFontSize = newAttrFromIntProperty "minimum-logical-font-size" -- | The default font family used to display monospace text. -- -- Default value: "monospace" webSettingsMonospaceFontFamily :: (WebSettingsClass self) => Attr self String webSettingsMonospaceFontFamily = newAttrFromStringProperty "monospace-font-family" -- | Whether background images should be printed -- -- Default value: True webSettingsPrintBackgrounds :: (WebSettingsClass self) => Attr self Bool webSettingsPrintBackgrounds = newAttrFromBoolProperty "print-backgrounds" -- | Whether text areas are resizable -- -- Default value : True webSettingsResizableTextAreas :: (WebSettingsClass self) => Attr self Bool webSettingsResizableTextAreas = newAttrFromBoolProperty "resizable-text-areas" -- | The default Sans Serif font family used to display text -- -- Default value "sans-serif" webSettingsSansFontFamily :: (WebSettingsClass self) => Attr self String webSettingsSansFontFamily = newAttrFromStringProperty "sans-serif-font-family" -- | The default Serif font family used to display text -- -- Default value: "serif" webSettingsSerifFontFamily :: (WebSettingsClass self) => Attr self String webSettingsSerifFontFamily = newAttrFromStringProperty "serif-font-family" -- | The languages to be used for spell checking, separated by commas -- -- The locale string typically is in the form lang_COUNTRY, -- where lang is an ISO-639 language code, and COUNTRY is an ISO-3166 country code. -- For instance, sv_FI for Swedish as written in Finland or pt_BR for Portuguese as written in Brazil. -- -- If no value is specified then the value returned by gtk_get_default_language will be used. -- -- Default value: @Nothing@ webSettingsSpellCheckingLang :: (WebSettingsClass self) => Attr self (Maybe String) webSettingsSpellCheckingLang = newAttrFromMaybeStringProperty "spell-checking-languages" #if WEBKIT_CHECK_VERSION (1,1,17) -- | Whether the tab key cycles through elements on the page. -- -- If flag is 'True', pressing the tab key will focus the next element in the @webView@. If flag is 'False', -- the @webView@ will interpret tab key presses as normal key presses. If the selected element is -- editable, the tab key will cause the insertion of a tab character. -- -- Default value: 'True' -- -- * Since 1.1.17 webSettingsTabKeyCyclesThroughElements :: (WebSettingsClass self) => Attr self Bool webSettingsTabKeyCyclesThroughElements = newAttrFromBoolProperty "tab-key-cycles-through-elements" #endif #if WEBKIT_CHECK_VERSION (1,1,18) -- | Whether right-clicks should be handled automatically to create, and display the context -- menu. Turning this off will make WebKitGTK+ not emit the populate-popup signal. Notice that the -- default button press event handler may still handle right clicks for other reasons, such as in-page -- context menus, or right-clicks that are handled by the page itself. -- -- Default value: 'True' -- -- * Since 1.1.18 webSettingsEnableDefaultContextMenu :: (WebSettingsClass self) => Attr self Bool webSettingsEnableDefaultContextMenu = newAttrFromBoolProperty "enable-default-context-menu" -- | Enable or disable the page cache. Disabling the page cache is generally only useful for special -- circumstances like low-memory scenarios or special purpose applications like static HTML -- viewers. This setting only controls the Page Cache, this cache is different than the disk-based or -- memory-based traditional resource caches, its point is to make going back and forth between pages -- much faster. For details about the different types of caches and their purposes see: -- http://webkit.org/ blog/427/webkit-page-cache-i-the-basics/ -- -- Default value: 'False' -- -- * Since 1.1.18 webSettingsEnablePageCache :: (WebSettingsClass self) => Attr self Bool webSettingsEnablePageCache = newAttrFromBoolProperty "enable-page-cache" #endif -- | The User-Agent string used by WebKit -- -- This will return a default User-Agent string if a custom string wasn't provided by the application. -- Setting this property to a NULL value or an empty string will result in -- the User-Agent string being reset to the default value. -- -- Default value: \"Mozilla/5.0 (X11; U; Linux x86_64; c) AppleWebKit/531.2+ (KHTML, like Gecko) Safari/531.2+\" webSettingsUserAgent :: (WebSettingsClass self) => Attr self String webSettingsUserAgent = newAttrFromStringProperty "user-agent" -- | The URI of a stylesheet that is applied to every page. -- -- Default value: @Nothing@ webSettingsUserStylesheetUri :: (WebSettingsClass self) => Attr self (Maybe String) webSettingsUserStylesheetUri = newAttrFromMaybeStringProperty "user-stylesheet-uri" -- | The value by which the zoom level is changed when zooming in or out -- -- Allowed values: >= 0 -- -- Default value: 0.1 webSettingsZoomStep :: (WebSettingsClass self) => Attr self Float webSettingsZoomStep = newAttrFromFloatProperty "zoom-step" -- | Enables the site-specific compatibility workarounds. -- -- Default value: False webSettingsEnableSiteSpecificQuirks :: WebSettingsClass self => Attr self Bool webSettingsEnableSiteSpecificQuirks = newAttrFromBoolProperty "enable-site-specific-quirks" #if WEBKIT_CHECK_VERSION (1,1,23) -- | Whether to enable the Spatial Navigation. This feature consists in the ability to navigate between -- focusable elements in a Web page, such as hyperlinks and form controls, by using Left, Right, Up and -- Down arrow keys. For example, if an user presses the Right key, heuristics determine whether there -- is an element he might be trying to reach towards the right, and if there are multiple elements, -- which element he probably wants. -- -- Default value: 'False' -- -- * Since 1.1.23 webSettingsEnableSpatialNavigation :: WebSettingsClass self => Attr self Bool webSettingsEnableSpatialNavigation = newAttrFromBoolProperty "enable-spatial-navigation" #endif webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebResource.chs0000644000000000000000000000706211633370412020170 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebResource -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Note: -- -- Function `webkit_web_resource_get_data` haven't binding -- no idea how to handle `GString`. -- -- Access to the WebKit Web Resource ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebResource ( -- * Description -- | A web resource encapsulates the data of the download as well as the URI, MIME type and frame name of -- the resource. -- * Types WebResource, WebResourceClass, -- * Constructors webResourceNew, -- * Methods webResourceGetData, webResourceGetEncoding, webResourceGetFrameName, webResourceGetMimeType, webResourceGetUri, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GString import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- | Returns a new WebKitWebResource. -- The @encoding@ can be empty. -- The @frameName@ can be used if the resource represents contents of an -- entire HTML frame, otherwise pass empty. webResourceNew :: String -> Int -> String -> String -> String -> String -> IO WebResource webResourceNew resData size uri mimeType encoding frameName = withCString resData $ \dataPtr -> withCString uri $ \uriPtr -> withCString mimeType $ \mimePtr -> withCString encoding $ \encodingPtr -> withCString frameName $ \framePtr -> wrapNewGObject mkWebResource $ {#call web_resource_new#} dataPtr (fromIntegral size) uriPtr mimePtr encodingPtr framePtr -- | Returns the data of the WebResource. webResourceGetData :: WebResourceClass self => self -> IO (Maybe String) webResourceGetData wr = {#call web_resource_get_data#} (toWebResource wr) >>= readGString -- | Get encoding. webResourceGetEncoding :: WebResourceClass self => self -> IO (Maybe String) webResourceGetEncoding wr = {#call web_resource_get_encoding#} (toWebResource wr) >>= maybePeek peekCString -- | Get frame name. webResourceGetFrameName :: WebResourceClass self => self -> IO (Maybe String) webResourceGetFrameName wr = {#call web_resource_get_frame_name#} (toWebResource wr) >>= maybePeek peekCString -- | Get mime type. webResourceGetMimeType :: WebResourceClass self => self -> IO (Maybe String) webResourceGetMimeType wr = {#call web_resource_get_mime_type#} (toWebResource wr) >>= maybePeek peekCString -- | Get uri. webResourceGetUri :: WebResourceClass self => self -> IO String webResourceGetUri wr = {#call web_resource_get_uri#} (toWebResource wr) >>= peekCString webkit-0.12.3/Graphics/UI/Gtk/WebKit/Types.chs0000644000000000000000000005302211633370412017044 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell -- -- Author : Axel Simon -- -- Copyright (C) 2001-2005 Axel Simon -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- #hide -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- This file reflects the Gtk+ object hierarchy in terms of Haskell classes. -- -- Note: the mk... functions were originally meant to simply be an alias -- for the constructor. However, in order to communicate the destructor -- of an object to objectNew, the mk... functions are now a tuple containing -- Haskell constructor and the destructor function pointer. This hack avoids -- changing all modules that simply pass mk... to objectNew. -- module Graphics.UI.Gtk.WebKit.Types ( module Graphics.UI.GtkInternals, WebView(WebView), WebViewClass, toWebView, mkWebView, unWebView, castToWebView, gTypeWebView, WebFrame(WebFrame), WebFrameClass, toWebFrame, mkWebFrame, unWebFrame, castToWebFrame, gTypeWebFrame, WebSettings(WebSettings), WebSettingsClass, toWebSettings, mkWebSettings, unWebSettings, castToWebSettings, gTypeWebSettings, NetworkRequest(NetworkRequest), NetworkRequestClass, toNetworkRequest, mkNetworkRequest, unNetworkRequest, castToNetworkRequest, gTypeNetworkRequest, NetworkResponse(NetworkResponse), NetworkResponseClass, toNetworkResponse, mkNetworkResponse, unNetworkResponse, castToNetworkResponse, gTypeNetworkResponse, Download(Download), DownloadClass, toDownload, mkDownload, unDownload, castToDownload, gTypeDownload, WebBackForwardList(WebBackForwardList), WebBackForwardListClass, toWebBackForwardList, mkWebBackForwardList, unWebBackForwardList, castToWebBackForwardList, gTypeWebBackForwardList, WebHistoryItem(WebHistoryItem), WebHistoryItemClass, toWebHistoryItem, mkWebHistoryItem, unWebHistoryItem, castToWebHistoryItem, gTypeWebHistoryItem, WebInspector(WebInspector), WebInspectorClass, toWebInspector, mkWebInspector, unWebInspector, castToWebInspector, gTypeWebInspector, HitTestResult(HitTestResult), HitTestResultClass, toHitTestResult, mkHitTestResult, unHitTestResult, castToHitTestResult, gTypeHitTestResult, SecurityOrigin(SecurityOrigin), SecurityOriginClass, toSecurityOrigin, mkSecurityOrigin, unSecurityOrigin, castToSecurityOrigin, gTypeSecurityOrigin, SoupAuthDialog(SoupAuthDialog), SoupAuthDialogClass, toSoupAuthDialog, mkSoupAuthDialog, unSoupAuthDialog, castToSoupAuthDialog, gTypeSoupAuthDialog, WebDatabase(WebDatabase), WebDatabaseClass, toWebDatabase, mkWebDatabase, unWebDatabase, castToWebDatabase, gTypeWebDatabase, WebDataSource(WebDataSource), WebDataSourceClass, toWebDataSource, mkWebDataSource, unWebDataSource, castToWebDataSource, gTypeWebDataSource, WebNavigationAction(WebNavigationAction), WebNavigationActionClass, toWebNavigationAction, mkWebNavigationAction, unWebNavigationAction, castToWebNavigationAction, gTypeWebNavigationAction, WebPolicyDecision(WebPolicyDecision), WebPolicyDecisionClass, toWebPolicyDecision, mkWebPolicyDecision, unWebPolicyDecision, castToWebPolicyDecision, gTypeWebPolicyDecision, WebResource(WebResource), WebResourceClass, toWebResource, mkWebResource, unWebResource, castToWebResource, gTypeWebResource, WebWindowFeatures(WebWindowFeatures), WebWindowFeaturesClass, toWebWindowFeatures, mkWebWindowFeatures, unWebWindowFeatures, castToWebWindowFeatures, gTypeWebWindowFeatures, GeolocationPolicyDecision(GeolocationPolicyDecision), GeolocationPolicyDecisionClass, toGeolocationPolicyDecision, mkGeolocationPolicyDecision, unGeolocationPolicyDecision, castToGeolocationPolicyDecision, gTypeGeolocationPolicyDecision ) where import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr) import Foreign.C.Types (CULong, CUInt) import System.Glib.GType (GType, typeInstanceIsA) {#import Graphics.UI.GtkInternals#} {# context lib="gtk" prefix="gtk" #} -- The usage of foreignPtrToPtr should be safe as the evaluation will only be -- forced if the object is used afterwards -- castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String -> (obj -> obj') castTo gtype objTypeName obj = case toGObject obj of gobj@(GObject objFPtr) | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype -> unsafeCastGObject gobj | otherwise -> error $ "Cannot cast object to " ++ objTypeName -- ******************************************************************** WebView {#pointer *WebKitWebView as WebView foreign newtype #} deriving (Eq,Ord) mkWebView = (WebView, objectUnrefFromMainloop) unWebView (WebView o) = o class ContainerClass o => WebViewClass o toWebView :: WebViewClass o => o -> WebView toWebView = unsafeCastGObject . toGObject instance WebViewClass WebView instance ContainerClass WebView instance WidgetClass WebView instance ObjectClass WebView instance GObjectClass WebView where toGObject = GObject . castForeignPtr . unWebView unsafeCastGObject = WebView . castForeignPtr . unGObject castToWebView :: GObjectClass obj => obj -> WebView castToWebView = castTo gTypeWebView "WebView" gTypeWebView :: GType gTypeWebView = {# call fun unsafe webkit_web_view_get_type #} -- ******************************************************************* WebFrame {#pointer *WebKitWebFrame as WebFrame foreign newtype #} deriving (Eq,Ord) mkWebFrame = (WebFrame, objectUnrefFromMainloop) unWebFrame (WebFrame o) = o class GObjectClass o => WebFrameClass o toWebFrame :: WebFrameClass o => o -> WebFrame toWebFrame = unsafeCastGObject . toGObject instance WebFrameClass WebFrame instance GObjectClass WebFrame where toGObject = GObject . castForeignPtr . unWebFrame unsafeCastGObject = WebFrame . castForeignPtr . unGObject castToWebFrame :: GObjectClass obj => obj -> WebFrame castToWebFrame = castTo gTypeWebFrame "WebFrame" gTypeWebFrame :: GType gTypeWebFrame = {# call fun unsafe webkit_web_frame_get_type #} -- **************************************************************** WebSettings {#pointer *WebKitWebSettings as WebSettings foreign newtype #} deriving (Eq,Ord) mkWebSettings = (WebSettings, objectUnrefFromMainloop) unWebSettings (WebSettings o) = o class GObjectClass o => WebSettingsClass o toWebSettings :: WebSettingsClass o => o -> WebSettings toWebSettings = unsafeCastGObject . toGObject instance WebSettingsClass WebSettings instance GObjectClass WebSettings where toGObject = GObject . castForeignPtr . unWebSettings unsafeCastGObject = WebSettings . castForeignPtr . unGObject castToWebSettings :: GObjectClass obj => obj -> WebSettings castToWebSettings = castTo gTypeWebSettings "WebSettings" gTypeWebSettings :: GType gTypeWebSettings = {# call fun unsafe webkit_web_settings_get_type #} -- ************************************************************* NetworkRequest {#pointer *WebKitNetworkRequest as NetworkRequest foreign newtype #} deriving (Eq,Ord) mkNetworkRequest = (NetworkRequest, objectUnrefFromMainloop) unNetworkRequest (NetworkRequest o) = o class GObjectClass o => NetworkRequestClass o toNetworkRequest :: NetworkRequestClass o => o -> NetworkRequest toNetworkRequest = unsafeCastGObject . toGObject instance NetworkRequestClass NetworkRequest instance GObjectClass NetworkRequest where toGObject = GObject . castForeignPtr . unNetworkRequest unsafeCastGObject = NetworkRequest . castForeignPtr . unGObject castToNetworkRequest :: GObjectClass obj => obj -> NetworkRequest castToNetworkRequest = castTo gTypeNetworkRequest "NetworkRequest" gTypeNetworkRequest :: GType gTypeNetworkRequest = {# call fun unsafe webkit_network_request_get_type #} -- ************************************************************ NetworkResponse {#pointer *WebKitNetworkResponse as NetworkResponse foreign newtype #} deriving (Eq,Ord) mkNetworkResponse = (NetworkResponse, objectUnrefFromMainloop) unNetworkResponse (NetworkResponse o) = o class GObjectClass o => NetworkResponseClass o toNetworkResponse :: NetworkResponseClass o => o -> NetworkResponse toNetworkResponse = unsafeCastGObject . toGObject instance NetworkResponseClass NetworkResponse instance GObjectClass NetworkResponse where toGObject = GObject . castForeignPtr . unNetworkResponse unsafeCastGObject = NetworkResponse . castForeignPtr . unGObject castToNetworkResponse :: GObjectClass obj => obj -> NetworkResponse castToNetworkResponse = castTo gTypeNetworkResponse "NetworkResponse" gTypeNetworkResponse :: GType gTypeNetworkResponse = {# call fun unsafe webkit_network_response_get_type #} -- ******************************************************************* Download {#pointer *WebKitDownload as Download foreign newtype #} deriving (Eq,Ord) mkDownload = (Download, objectUnrefFromMainloop) unDownload (Download o) = o class GObjectClass o => DownloadClass o toDownload :: DownloadClass o => o -> Download toDownload = unsafeCastGObject . toGObject instance DownloadClass Download instance GObjectClass Download where toGObject = GObject . castForeignPtr . unDownload unsafeCastGObject = Download . castForeignPtr . unGObject castToDownload :: GObjectClass obj => obj -> Download castToDownload = castTo gTypeDownload "Download" gTypeDownload :: GType gTypeDownload = {# call fun unsafe webkit_download_get_type #} -- ********************************************************* WebBackForwardList {#pointer *WebKitWebBackForwardList as WebBackForwardList foreign newtype #} deriving (Eq,Ord) mkWebBackForwardList = (WebBackForwardList, objectUnrefFromMainloop) unWebBackForwardList (WebBackForwardList o) = o class GObjectClass o => WebBackForwardListClass o toWebBackForwardList :: WebBackForwardListClass o => o -> WebBackForwardList toWebBackForwardList = unsafeCastGObject . toGObject instance WebBackForwardListClass WebBackForwardList instance GObjectClass WebBackForwardList where toGObject = GObject . castForeignPtr . unWebBackForwardList unsafeCastGObject = WebBackForwardList . castForeignPtr . unGObject castToWebBackForwardList :: GObjectClass obj => obj -> WebBackForwardList castToWebBackForwardList = castTo gTypeWebBackForwardList "WebBackForwardList" gTypeWebBackForwardList :: GType gTypeWebBackForwardList = {# call fun unsafe webkit_web_back_forward_list_get_type #} -- ************************************************************* WebHistoryItem {#pointer *WebKitWebHistoryItem as WebHistoryItem foreign newtype #} deriving (Eq,Ord) mkWebHistoryItem = (WebHistoryItem, objectUnrefFromMainloop) unWebHistoryItem (WebHistoryItem o) = o class GObjectClass o => WebHistoryItemClass o toWebHistoryItem :: WebHistoryItemClass o => o -> WebHistoryItem toWebHistoryItem = unsafeCastGObject . toGObject instance WebHistoryItemClass WebHistoryItem instance GObjectClass WebHistoryItem where toGObject = GObject . castForeignPtr . unWebHistoryItem unsafeCastGObject = WebHistoryItem . castForeignPtr . unGObject castToWebHistoryItem :: GObjectClass obj => obj -> WebHistoryItem castToWebHistoryItem = castTo gTypeWebHistoryItem "WebHistoryItem" gTypeWebHistoryItem :: GType gTypeWebHistoryItem = {# call fun unsafe webkit_web_history_item_get_type #} -- *************************************************************** WebInspector {#pointer *WebKitWebInspector as WebInspector foreign newtype #} deriving (Eq,Ord) mkWebInspector = (WebInspector, objectUnrefFromMainloop) unWebInspector (WebInspector o) = o class GObjectClass o => WebInspectorClass o toWebInspector :: WebInspectorClass o => o -> WebInspector toWebInspector = unsafeCastGObject . toGObject instance WebInspectorClass WebInspector instance GObjectClass WebInspector where toGObject = GObject . castForeignPtr . unWebInspector unsafeCastGObject = WebInspector . castForeignPtr . unGObject castToWebInspector :: GObjectClass obj => obj -> WebInspector castToWebInspector = castTo gTypeWebInspector "WebInspector" gTypeWebInspector :: GType gTypeWebInspector = {# call fun unsafe webkit_web_inspector_get_type #} -- ************************************************************** HitTestResult {#pointer *WebKitHitTestResult as HitTestResult foreign newtype #} deriving (Eq,Ord) mkHitTestResult = (HitTestResult, objectUnrefFromMainloop) unHitTestResult (HitTestResult o) = o class GObjectClass o => HitTestResultClass o toHitTestResult :: HitTestResultClass o => o -> HitTestResult toHitTestResult = unsafeCastGObject . toGObject instance HitTestResultClass HitTestResult instance GObjectClass HitTestResult where toGObject = GObject . castForeignPtr . unHitTestResult unsafeCastGObject = HitTestResult . castForeignPtr . unGObject castToHitTestResult :: GObjectClass obj => obj -> HitTestResult castToHitTestResult = castTo gTypeHitTestResult "HitTestResult" gTypeHitTestResult :: GType gTypeHitTestResult = {# call fun unsafe webkit_hit_test_result_get_type #} -- ************************************************************* SecurityOrigin {#pointer *WebKitSecurityOrigin as SecurityOrigin foreign newtype #} deriving (Eq,Ord) mkSecurityOrigin = (SecurityOrigin, objectUnrefFromMainloop) unSecurityOrigin (SecurityOrigin o) = o class GObjectClass o => SecurityOriginClass o toSecurityOrigin :: SecurityOriginClass o => o -> SecurityOrigin toSecurityOrigin = unsafeCastGObject . toGObject instance SecurityOriginClass SecurityOrigin instance GObjectClass SecurityOrigin where toGObject = GObject . castForeignPtr . unSecurityOrigin unsafeCastGObject = SecurityOrigin . castForeignPtr . unGObject castToSecurityOrigin :: GObjectClass obj => obj -> SecurityOrigin castToSecurityOrigin = castTo gTypeSecurityOrigin "SecurityOrigin" gTypeSecurityOrigin :: GType gTypeSecurityOrigin = {# call fun unsafe webkit_security_origin_get_type #} -- ************************************************************* SoupAuthDialog {#pointer *WebKitSoupAuthDialog as SoupAuthDialog foreign newtype #} deriving (Eq,Ord) mkSoupAuthDialog = (SoupAuthDialog, objectUnrefFromMainloop) unSoupAuthDialog (SoupAuthDialog o) = o class GObjectClass o => SoupAuthDialogClass o toSoupAuthDialog :: SoupAuthDialogClass o => o -> SoupAuthDialog toSoupAuthDialog = unsafeCastGObject . toGObject instance SoupAuthDialogClass SoupAuthDialog instance GObjectClass SoupAuthDialog where toGObject = GObject . castForeignPtr . unSoupAuthDialog unsafeCastGObject = SoupAuthDialog . castForeignPtr . unGObject castToSoupAuthDialog :: GObjectClass obj => obj -> SoupAuthDialog castToSoupAuthDialog = castTo gTypeSoupAuthDialog "SoupAuthDialog" gTypeSoupAuthDialog :: GType gTypeSoupAuthDialog = {# call fun unsafe webkit_soup_auth_dialog_get_type #} -- **************************************************************** WebDatabase {#pointer *WebKitWebDatabase as WebDatabase foreign newtype #} deriving (Eq,Ord) mkWebDatabase = (WebDatabase, objectUnrefFromMainloop) unWebDatabase (WebDatabase o) = o class GObjectClass o => WebDatabaseClass o toWebDatabase :: WebDatabaseClass o => o -> WebDatabase toWebDatabase = unsafeCastGObject . toGObject instance WebDatabaseClass WebDatabase instance GObjectClass WebDatabase where toGObject = GObject . castForeignPtr . unWebDatabase unsafeCastGObject = WebDatabase . castForeignPtr . unGObject castToWebDatabase :: GObjectClass obj => obj -> WebDatabase castToWebDatabase = castTo gTypeWebDatabase "WebDatabase" gTypeWebDatabase :: GType gTypeWebDatabase = {# call fun unsafe webkit_web_database_get_type #} -- ************************************************************** WebDataSource {#pointer *WebKitWebDataSource as WebDataSource foreign newtype #} deriving (Eq,Ord) mkWebDataSource = (WebDataSource, objectUnrefFromMainloop) unWebDataSource (WebDataSource o) = o class GObjectClass o => WebDataSourceClass o toWebDataSource :: WebDataSourceClass o => o -> WebDataSource toWebDataSource = unsafeCastGObject . toGObject instance WebDataSourceClass WebDataSource instance GObjectClass WebDataSource where toGObject = GObject . castForeignPtr . unWebDataSource unsafeCastGObject = WebDataSource . castForeignPtr . unGObject castToWebDataSource :: GObjectClass obj => obj -> WebDataSource castToWebDataSource = castTo gTypeWebDataSource "WebDataSource" gTypeWebDataSource :: GType gTypeWebDataSource = {# call fun unsafe webkit_web_data_source_get_type #} -- ******************************************************** WebNavigationAction {#pointer *WebKitWebNavigationAction as WebNavigationAction foreign newtype #} deriving (Eq,Ord) mkWebNavigationAction = (WebNavigationAction, objectUnrefFromMainloop) unWebNavigationAction (WebNavigationAction o) = o class GObjectClass o => WebNavigationActionClass o toWebNavigationAction :: WebNavigationActionClass o => o -> WebNavigationAction toWebNavigationAction = unsafeCastGObject . toGObject instance WebNavigationActionClass WebNavigationAction instance GObjectClass WebNavigationAction where toGObject = GObject . castForeignPtr . unWebNavigationAction unsafeCastGObject = WebNavigationAction . castForeignPtr . unGObject castToWebNavigationAction :: GObjectClass obj => obj -> WebNavigationAction castToWebNavigationAction = castTo gTypeWebNavigationAction "WebNavigationAction" gTypeWebNavigationAction :: GType gTypeWebNavigationAction = {# call fun unsafe webkit_web_navigation_action_get_type #} -- ********************************************************** WebPolicyDecision {#pointer *WebKitWebPolicyDecision as WebPolicyDecision foreign newtype #} deriving (Eq,Ord) mkWebPolicyDecision = (WebPolicyDecision, objectUnrefFromMainloop) unWebPolicyDecision (WebPolicyDecision o) = o class GObjectClass o => WebPolicyDecisionClass o toWebPolicyDecision :: WebPolicyDecisionClass o => o -> WebPolicyDecision toWebPolicyDecision = unsafeCastGObject . toGObject instance WebPolicyDecisionClass WebPolicyDecision instance GObjectClass WebPolicyDecision where toGObject = GObject . castForeignPtr . unWebPolicyDecision unsafeCastGObject = WebPolicyDecision . castForeignPtr . unGObject castToWebPolicyDecision :: GObjectClass obj => obj -> WebPolicyDecision castToWebPolicyDecision = castTo gTypeWebPolicyDecision "WebPolicyDecision" gTypeWebPolicyDecision :: GType gTypeWebPolicyDecision = {# call fun unsafe webkit_web_policy_decision_get_type #} -- **************************************************************** WebResource {#pointer *WebKitWebResource as WebResource foreign newtype #} deriving (Eq,Ord) mkWebResource = (WebResource, objectUnrefFromMainloop) unWebResource (WebResource o) = o class GObjectClass o => WebResourceClass o toWebResource :: WebResourceClass o => o -> WebResource toWebResource = unsafeCastGObject . toGObject instance WebResourceClass WebResource instance GObjectClass WebResource where toGObject = GObject . castForeignPtr . unWebResource unsafeCastGObject = WebResource . castForeignPtr . unGObject castToWebResource :: GObjectClass obj => obj -> WebResource castToWebResource = castTo gTypeWebResource "WebResource" gTypeWebResource :: GType gTypeWebResource = {# call fun unsafe webkit_web_resource_get_type #} -- ********************************************************** WebWindowFeatures {#pointer *WebKitWebWindowFeatures as WebWindowFeatures foreign newtype #} deriving (Eq,Ord) mkWebWindowFeatures = (WebWindowFeatures, objectUnrefFromMainloop) unWebWindowFeatures (WebWindowFeatures o) = o class GObjectClass o => WebWindowFeaturesClass o toWebWindowFeatures :: WebWindowFeaturesClass o => o -> WebWindowFeatures toWebWindowFeatures = unsafeCastGObject . toGObject instance WebWindowFeaturesClass WebWindowFeatures instance GObjectClass WebWindowFeatures where toGObject = GObject . castForeignPtr . unWebWindowFeatures unsafeCastGObject = WebWindowFeatures . castForeignPtr . unGObject castToWebWindowFeatures :: GObjectClass obj => obj -> WebWindowFeatures castToWebWindowFeatures = castTo gTypeWebWindowFeatures "WebWindowFeatures" gTypeWebWindowFeatures :: GType gTypeWebWindowFeatures = {# call fun unsafe webkit_web_window_features_get_type #} -- ************************************************** GeolocationPolicyDecision {#pointer *WebKitGeolocationPolicyDecision as GeolocationPolicyDecision foreign newtype #} deriving (Eq,Ord) mkGeolocationPolicyDecision = (GeolocationPolicyDecision, objectUnrefFromMainloop) unGeolocationPolicyDecision (GeolocationPolicyDecision o) = o class GObjectClass o => GeolocationPolicyDecisionClass o toGeolocationPolicyDecision :: GeolocationPolicyDecisionClass o => o -> GeolocationPolicyDecision toGeolocationPolicyDecision = unsafeCastGObject . toGObject instance GeolocationPolicyDecisionClass GeolocationPolicyDecision instance GObjectClass GeolocationPolicyDecision where toGObject = GObject . castForeignPtr . unGeolocationPolicyDecision unsafeCastGObject = GeolocationPolicyDecision . castForeignPtr . unGObject castToGeolocationPolicyDecision :: GObjectClass obj => obj -> GeolocationPolicyDecision castToGeolocationPolicyDecision = castTo gTypeGeolocationPolicyDecision "GeolocationPolicyDecision" gTypeGeolocationPolicyDecision :: GType gTypeGeolocationPolicyDecision = {# call fun unsafe webkit_geolocation_policy_decision_get_type #} webkit-0.12.3/Graphics/UI/Gtk/WebKit/SecurityOrigin.chs0000644000000000000000000001042211633370412020714 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebSecurityOrigin -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Access to the WebKit Web SecurityOrigin ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.SecurityOrigin ( -- * Desciption -- | WebKitSecurityOrigin is a representation of a security domain defined by web sites. An origin -- consists of a host name, a protocol, and a port number. Web sites with the same security origin can -- access each other's resources for client-side scripting or database access. -- -- Use 'webFrameGetSecurityOrigin' to get the security origin of a WebKitWebFrame. -- -- Database quotas and usages are also defined per security origin. The cumulative disk usage of an -- origin's databases may be retrieved with 'securityOriginGetWebDatabaseUsage'. An origin's -- quota can be adjusted with 'securityOriginSetWebDatabaseQuota'. -- * Types SecurityOrigin, SecurityOriginClass, -- * Methods securityOriginGetAllWebDatabases, securityOriginGetHost, securityOriginGetPort, securityOriginGetProtocol, securityOriginGetWebDatabaseQuota, securityOriginSetWebDatabaseQuota, securityOriginGetWebDatabaseUsage, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- * Methods. -- | Returns the frame's security origin. securityOriginGetAllWebDatabases :: SecurityOriginClass self => self -> IO [WebDatabase] securityOriginGetAllWebDatabases so = do glist <- {#call security_origin_get_all_web_databases#} (toSecurityOrigin so) databasePtr <- fromGList glist mapM (makeNewGObject mkWebDatabase . return) databasePtr -- | Returns the hostname for the security origin. securityOriginGetHost :: SecurityOriginClass self => self -> IO String securityOriginGetHost so = {#call security_origin_get_host#} (toSecurityOrigin so) >>= peekCString -- | Returns the port for the security origin. securityOriginGetPort :: SecurityOriginClass self => self -> IO Int securityOriginGetPort so = liftM fromIntegral $ {#call security_origin_get_port#} (toSecurityOrigin so) -- | Returns the protocol for the security origin. securityOriginGetProtocol :: SecurityOriginClass self => self -> IO String securityOriginGetProtocol so = {#call security_origin_get_protocol#} (toSecurityOrigin so) >>= peekCString -- | Returns the quota for Web Database storage of the security origin in bytes. securityOriginGetWebDatabaseQuota :: SecurityOriginClass self => self -> IO Int securityOriginGetWebDatabaseQuota so = liftM fromIntegral $ {#call security_origin_get_web_database_quota#} (toSecurityOrigin so) -- | Returns the usage for Web Database storage of the security origin in bytes. securityOriginGetWebDatabaseUsage :: SecurityOriginClass self => self -> IO Int securityOriginGetWebDatabaseUsage so = liftM fromIntegral $ {#call security_origin_get_web_database_usage#} (toSecurityOrigin so) -- | Adjust the quota for Web Database storage of the security origin securityOriginSetWebDatabaseQuota :: SecurityOriginClass self => self -> Int -> IO () securityOriginSetWebDatabaseQuota so quota = {#call security_origin_set_web_database_quota#} (toSecurityOrigin so) (fromIntegral quota) webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebInspector.chs0000644000000000000000000001701111633370412020342 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebInspector -- Author : Cjacker Huang -- Copyright : (c) 2009 Cjacker Huang -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Access to the WebKit Inspector ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebInspector ( -- * Description -- | The WebKit Inspector is a graphical tool to inspect and change the content of a WebKitWebView. It -- also includes an interactive JavaScriptDebugger. Using this class one can get a 'Widget' which can -- be embedded into an application to show the inspector. -- -- The inspector is available when the WebKitWebSettings of the WebKitWebView has set the -- 'enableDeveloperExtras' to true otherwise no inspector is available. -- * Types WebInspector, WebInspectorClass, -- * Methods webInspectorGetInspectedUri, webInspectorGetWebView, #if WEBKIT_CHECK_VERSION (1,1,17) webInspectorInspectCoordinates, webInspectorShow, webInspectorClose, #endif -- * Attribute webInspectorInspectedUri, webInspectorJSProfilingEnable, #if WEBKIT_CHECK_VERSION (1,1,17) webInspectorTimelineProfilingEnabled, #endif webInspectorWebView, -- * Signals attachWindow, detachWindow, closeWindow, showWindow, finished, inspectWebView, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import Graphics.UI.Gtk.WebKit.Internal#} {#import Graphics.UI.Gtk.WebKit.Signals#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} ------------------ -- | Obtains the URI that is currently being inspected webInspectorGetInspectedUri :: WebInspectorClass self => self -> IO String webInspectorGetInspectedUri inspector = {#call web_inspector_get_inspected_uri#} (toWebInspector inspector) >>= peekCString -- | Obtains the 'WebView' that is used to render the 'WebInspector'. -- -- The 'WebView' instance is created by the application, -- by handling the "inspect-web-view" signal. -- This means that it may return @Nothing@ if the user hasn't inspected anything webInspectorGetWebView :: WebInspectorClass self => self -> IO (Maybe WebView) webInspectorGetWebView inspector = maybeNull (makeNewObject mkWebView) $ liftM castPtr $ {#call web_inspector_get_web_view#} (toWebInspector inspector) #if WEBKIT_CHECK_VERSION (1,1,17) -- | Causes the Web Inspector to inspect the node that is located at the given coordinates of the -- widget. The coordinates should be relative to the WebKitWebView widget, not to the scrollable -- content, and may be obtained from a 'Event' directly. -- -- This means x, and y being zero doesn't guarantee you will hit the left-most top corner of the -- content, since the contents may have been scrolled. -- -- * Since 1.1.17 webInspectorInspectCoordinates :: WebInspectorClass self => self -- ^ @webInspector@ the WebKitWebInspector that will do the inspection -> Int -- ^ @x@ the X coordinate of the node to be inspected -> Int -- ^ @y@ the Y coordinate of the node to be inspected -> IO () webInspectorInspectCoordinates inspect x y = {#call web_inspector_inspect_coordinates#} (toWebInspector inspect) (fromIntegral x) (fromIntegral y) -- | Causes the Web Inspector to be shown. -- -- * Since 1.1.17 webInspectorShow :: WebInspectorClass self => self -> IO () webInspectorShow inspect = {#call webkit_web_inspector_show#} (toWebInspector inspect) -- | Causes the Web Inspector to be closed. -- -- * Since 1.1.17 webInspectorClose :: WebInspectorClass self => self -> IO () webInspectorClose inspect = {#call webkit_web_inspector_close#} (toWebInspector inspect) #endif -- * Attribute -- | The URI that is currently being inspected. webInspectorInspectedUri :: (WebInspectorClass self) => ReadAttr self String webInspectorInspectedUri = readAttr webInspectorGetInspectedUri -- | This is enabling JavaScript profiling in the Inspector. This means that Console.profiles will return the profiles. webInspectorJSProfilingEnable :: (WebInspectorClass self) => Attr self Bool webInspectorJSProfilingEnable = newAttrFromBoolProperty "javascript-profiling-enabled" #if WEBKIT_CHECK_VERSION (1,1,17) -- | This is enabling Timeline profiling in the Inspector. -- -- Default value: 'False' -- -- * Since 1.1.17 webInspectorTimelineProfilingEnabled :: (WebInspectorClass self) => Attr self Bool webInspectorTimelineProfilingEnabled = newAttrFromBoolProperty "timeline-profiling-enabled" #endif -- | The Web View that renders the Web Inspector itself. webInspectorWebView :: (WebInspectorClass self) => ReadAttr self WebView webInspectorWebView = readAttrFromObjectProperty "web-view" {#call pure webkit_web_view_get_type#} -- * Signals -- | Emitted when the inspector should appear in a separate window -- -- return True if the signal is handled attachWindow :: WebInspectorClass self => Signal self (IO Bool) attachWindow = Signal (connect_NONE__BOOL "attach_window") -- | Emitted when the inspector should appear in a separate window. -- -- return True if the signal has been handled detachWindow :: WebInspectorClass self => Signal self (IO Bool) detachWindow = Signal (connect_NONE__BOOL "detach_window") -- | Emitted when the inspector window should be closed. -- -- return True if the signal is handled. closeWindow :: WebInspectorClass self => Signal self (IO Bool) closeWindow = Signal (connect_NONE__BOOL "close_window") -- | Emitted when the inspector window should be displayed. -- Notice that the window must have been created already by handling 'inspectWebView'. -- -- return True if the signal has been handled showWindow :: WebInspectorClass self => Signal self (IO Bool) showWindow = Signal (connect_NONE__BOOL "show_window") -- | Emitted when the inspection is done. You should release your references on the inspector at this time. -- The inspected 'WebView' may no longer exist when this signal is emitted. finished :: WebInspectorClass self => Signal self (IO ()) finished = Signal (connect_NONE__NONE "finished") -- | Emitted when the user activates the 'inspect' context menu item to inspect a web view. -- The application which is interested in the inspector should create a window, -- or otherwise add the 'WebView' it creates to an existing window. -- -- You don't need to handle the reference count of the 'WebView' instance you create; -- the widget to which you add it will do that. inspectWebView :: WebInspectorClass self => Signal self (WebView -> IO WebView) inspectWebView = Signal (connect_OBJECT__OBJECTPTR "inspect_web_view") webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebNavigationAction.chs0000644000000000000000000001103011633370412021624 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebNavigationAction -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Access to the WebKit NavigationAction ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebNavigationAction ( -- * Description -- | 'WebNavigationAction' is used in signals to provide details about what led the navigation to -- happen. This includes, for instance, if the user clicked a link to start that navigation, and what -- mouse button was used. -- * Types WebNavigationAction, WebNavigationActionClass, -- * Enums NavigationReason(..), -- * Methods webNavigationActionGetButton, webNavigationActionGetModifierState, webNavigationActionGetOriginalUri, webNavigationActionSetOriginalUri, webNavigationActionGetReason, webNavigationActionSetReason, webNavigationActionGetTargetFrame, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- * Enums {#enum WebNavigationReason as NavigationReason {underscoreToCase}#} -- * Methods -- | Returns the DOM identifier for the mouse button used to click. -- DOM button values are 0, 1 and 2 for left, middle and right buttons. -- If the action was not initiated by a mouse click, returns -1. webNavigationActionGetButton :: WebNavigationActionClass self => self -> IO Int webNavigationActionGetButton action = liftM fromIntegral $ {#call web_navigation_action_get_button#} (toWebNavigationAction action) -- | Returns a bitmask with the the state of the modifier keys. webNavigationActionGetModifierState :: WebNavigationActionClass self => self -> IO Int webNavigationActionGetModifierState action = liftM fromIntegral $ {#call web_navigation_action_get_modifier_state#} (toWebNavigationAction action) -- | Returns the URI that was originally requested. -- This may differ from the navigation target, for instance because of a redirect. webNavigationActionGetOriginalUri :: WebNavigationActionClass self => self -> IO String webNavigationActionGetOriginalUri action = {#call web_navigation_action_get_original_uri#} (toWebNavigationAction action) >>= peekCString -- | Returns the reason why WebKit is requesting a navigation. webNavigationActionGetReason :: WebNavigationActionClass self => self -> IO NavigationReason webNavigationActionGetReason action = liftM (toEnum . fromIntegral) $ {#call web_navigation_action_get_reason#} (toWebNavigationAction action) -- | Returns the target frame of the action. webNavigationActionGetTargetFrame :: WebNavigationActionClass self => self -> IO String webNavigationActionGetTargetFrame action = {#call web_navigation_action_get_target_frame#} (toWebNavigationAction action) >>= peekCString -- | Sets the URI that was originally requested. -- This may differ from the navigation target, for instance because of a redirect. webNavigationActionSetOriginalUri :: WebNavigationActionClass self => self -> String -> IO () webNavigationActionSetOriginalUri action uri = withCString uri $ \uriPtr -> {#call web_navigation_action_set_original_uri#} (toWebNavigationAction action) uriPtr -- | Sets the reason why WebKit is requesting a navigation. webNavigationActionSetReason :: WebNavigationActionClass self => self -> NavigationReason -> IO () webNavigationActionSetReason action reason = {#call web_navigation_action_set_reason#} (toWebNavigationAction action) (fromIntegral (fromEnum reason)) webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebBackForwardList.chs0000644000000000000000000002056611633370412021426 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.Download -- Author : Cjacker Huang -- Copyright : (c) 2009 Cjacker Huang -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The history of a 'WebView' ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebBackForwardList ( -- * Types WebViewClass, WebBackForwardList, WebBackForwardListClass, -- * Constructors webBackForwardListNewWithWebView, -- * Methods webBackForwardListGoForward, webBackForwardListGoBack, webBackForwardListContainsItem, webBackForwardListGoToItem, webBackForwardListGetBackItem, webBackForwardListGetCurrentItem, webBackForwardListGetForwardItem, webBackForwardListGetNthItem, webBackForwardListGetBackLength, webBackForwardListGetForwardLength, webBackForwardListGetLimit, webBackForwardListSetLimit, webBackForwardListAddItem, webBackForwardListGetForwardListWithLimit, webBackForwardListGetBackListWithLimit, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} ------------------ -- Constructors -- | Create an WebBackForwardList with a controlling WebView. webBackForwardListNewWithWebView :: (WebViewClass webview) => webview -> IO WebBackForwardList webBackForwardListNewWithWebView webview = wrapNewGObject mkWebBackForwardList $ {#call web_back_forward_list_new_with_web_view#} (toWebView webview) -- | Steps forward in the back forward list. webBackForwardListGoForward :: WebBackForwardListClass self => self -> IO() webBackForwardListGoForward webbackforwardlist = {#call web_back_forward_list_go_forward#} (toWebBackForwardList webbackforwardlist) -- | Steps back in the back forward list. webBackForwardListGoBack :: WebBackForwardListClass self => self -> IO() webBackForwardListGoBack webbackforwardlist = {#call web_back_forward_list_go_back#} (toWebBackForwardList webbackforwardlist) -- | Check if an history item in the back forward list. webBackForwardListContainsItem :: (WebBackForwardListClass self, WebHistoryItemClass item) => self -> item -> IO Bool webBackForwardListContainsItem webbackforwardlist webhistoryitem = liftM toBool $ {#call web_back_forward_list_contains_item#} (toWebBackForwardList webbackforwardlist) (toWebHistoryItem webhistoryitem) -- | Go to the specified history item in the back forward list. webBackForwardListGoToItem :: (WebBackForwardListClass self,WebHistoryItemClass item) => self -> item -> IO() webBackForwardListGoToItem webbackforwardlist webhistoryitem = {#call web_back_forward_list_go_to_item#} (toWebBackForwardList webbackforwardlist) (toWebHistoryItem webhistoryitem) -- | Return the history item that precedes the current history item. webBackForwardListGetBackItem :: WebBackForwardListClass self => self -> IO (Maybe WebHistoryItem) -- ^ A 'WebHistoryItem' or @Nothing@ -- if there is nothing precedes the current item. webBackForwardListGetBackItem webbackforwardlist = maybeNull (makeNewGObject mkWebHistoryItem) $ {#call web_back_forward_list_get_back_item#} (toWebBackForwardList webbackforwardlist) -- | Return the current history item of the back forward list webBackForwardListGetCurrentItem :: WebBackForwardListClass self => self -> IO WebHistoryItem webBackForwardListGetCurrentItem webbackforwardlist = makeNewGObject mkWebHistoryItem $ {#call web_back_forward_list_get_current_item#} (toWebBackForwardList webbackforwardlist) -- | Return the item that succeeds the current item webBackForwardListGetForwardItem :: WebBackForwardListClass self => self -> IO (Maybe WebHistoryItem) -- ^ A 'WebHistoryItem' or @Nothing@ -- if there is nothing succeeds the current item. webBackForwardListGetForwardItem webbackforwardlist = maybeNull (makeNewGObject mkWebHistoryItem) $ {#call web_back_forward_list_get_forward_item#} (toWebBackForwardList webbackforwardlist) -- | Return the history item at a given index relative to the current item. webBackForwardListGetNthItem :: WebBackForwardListClass self => self -- ^ @webbackforwardlist@ - a WebBackForwardList -> Int -- ^ @index@ - the index of the item -> IO WebHistoryItem webBackForwardListGetNthItem webbackforwardlist index = makeNewGObject mkWebHistoryItem $ {#call web_back_forward_list_get_nth_item#} (toWebBackForwardList webbackforwardlist) (fromIntegral index) -- | Return the number of items that preced the current item. webBackForwardListGetBackLength :: WebBackForwardListClass self => self -> IO Int webBackForwardListGetBackLength webbackforwardlist = liftM fromIntegral $ {#call web_back_forward_list_get_back_length#} (toWebBackForwardList webbackforwardlist) -- | Return the number of items that succeed the current item. webBackForwardListGetForwardLength :: WebBackForwardListClass self => self -> IO Int webBackForwardListGetForwardLength webbackforwardlist = liftM fromIntegral $ {#call web_back_forward_list_get_forward_length#} (toWebBackForwardList webbackforwardlist) -- | Return the maximum limit of the back forward list. webBackForwardListGetLimit :: WebBackForwardListClass self => self -> IO Int webBackForwardListGetLimit webbackforwardlist = liftM fromIntegral $ {#call web_back_forward_list_get_limit#} (toWebBackForwardList webbackforwardlist) -- | Set the maximum limit of the back forward list. -- -- if the back forward list exceeds its capacity, -- items will be removed everytime a new item had been added. -- webBackForwardListSetLimit :: WebBackForwardListClass self => self -> Int -> IO() webBackForwardListSetLimit webbackforwardlist limit = {#call web_back_forward_list_set_limit#} (toWebBackForwardList webbackforwardlist) (fromIntegral limit) -- | Add the item to the back forward list. webBackForwardListAddItem :: (WebBackForwardListClass self,WebHistoryItemClass item) => self -> item -> IO () webBackForwardListAddItem webbackforwardlist webhistoryitem = {#call web_back_forward_list_add_item#} (toWebBackForwardList webbackforwardlist) (toWebHistoryItem webhistoryitem) -- | Return a list of items that succeed the current item, limited by @limit@. webBackForwardListGetForwardListWithLimit :: WebBackForwardListClass self => self -> Int -- ^ the number of items to retrieve -> IO [WebHistoryItem] -- ^ a 'List' of items succeeding the current item, limited by limit. webBackForwardListGetForwardListWithLimit webbackforwardlist limit = {#call web_back_forward_list_get_forward_list_with_limit#} (toWebBackForwardList webbackforwardlist) (fromIntegral limit) >>= fromGList >>= mapM (makeNewGObject mkWebHistoryItem . return) -- | Return a list of items that preced the current item. -- limited by limit. webBackForwardListGetBackListWithLimit :: WebBackForwardListClass self => self -> Int -- ^ the number of items to retrieve -> IO [WebHistoryItem] -- ^ a 'List' of items preceding the current item, limited by limit webBackForwardListGetBackListWithLimit webbackforwardlist limit = {#call web_back_forward_list_get_back_list_with_limit#} (toWebBackForwardList webbackforwardlist) (fromIntegral limit) >>= fromGList >>= mapM (makeNewGObject mkWebHistoryItem . return) webkit-0.12.3/Graphics/UI/Gtk/WebKit/HitTestResult.chs0000644000000000000000000000316411633370412020525 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.HitTestResult -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Access to the WebKit Web Resource ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.HitTestResult ( -- * Description -- | This class holds context information about the coordinates specified by a GDK event. -- * Types HitTestResult, HitTestResultClass, -- * Enums. HitTestResultContext(..), ) where import System.Glib.FFI import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- * Enums. {#enum HitTestResultContext {underscoreToCase}#} webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebPolicyDecision.chs0000644000000000000000000000505211633370412021313 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebPolicyDecision -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Access to the WebKit PolicyDecision ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebPolicyDecision ( -- * Desciption -- | 'WebPolicyDecision' objects are given to the application on signal emissions that deal with -- policy decisions, such as if a new window should be opened, or if a given navigation should be -- allowed. The application uses it to tell the engine what to do. -- * Types WebPolicyDecision, WebPolicyDecisionClass, -- * Methods webPolicyDecisionDownload, webPolicyDecisionIgnore, webPolicyDecisionUse, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- * Methods -- | Will send the DOWNLOAD decision to the policy implementer. webPolicyDecisionDownload :: WebPolicyDecisionClass self => self -> IO () webPolicyDecisionDownload pd = {#call web_policy_decision_download#} (toWebPolicyDecision pd) -- | Will send the IGNORE decision to the policy implementer. webPolicyDecisionIgnore :: WebPolicyDecisionClass self => self -> IO () webPolicyDecisionIgnore pd = {#call web_policy_decision_ignore#} (toWebPolicyDecision pd) -- | Will send the USE decision to the policy implementer. webPolicyDecisionUse :: WebPolicyDecisionClass self => self -> IO () webPolicyDecisionUse pd = {#call web_policy_decision_use#} (toWebPolicyDecision pd) webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebView.chs0000644000000000000000000012753111633370412017317 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebView -- Author : Cjacker Huang -- Copyright : (c) 2009 Cjacker Huang -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Note: -- -- Signal `window-object-cleared` can't bidning now, -- because it need JavaScriptCore that haven't binding. -- -- Signal `create-plugin-widget` can't binding now, -- no idea how to binding `GHaskellTable` -- -- -- TODO: -- -- `webViewGetHitTestResult` -- -- The central class of the WebKit ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebView ( -- * Description -- | WebKitWebView is the central class of the WebKitGTK+ API. It is a 'Widget' implementing the -- scrolling interface which means you can embed in a 'ScrolledWindow'. It is responsible for managing -- the drawing of the content, forwarding of events. You can load any URI into the WebKitWebView or any -- kind of data string. With WebKitWebSettings you can control various aspects of the rendering and -- loading of the content. Each WebKitWebView has exactly one WebKitWebFrame as main frame. A -- WebKitWebFrame can have n children. -- * Types WebView, WebViewClass, -- * Enums NavigationResponse(..), TargetInfo(..), LoadStatus(..), -- * Constructors webViewNew, -- * Methods -- ** Load webViewLoadUri, webViewLoadHtmlString, webViewLoadRequest, webViewLoadString, -- ** Reload webViewStopLoading, webViewReload, webViewReloadBypassCache, -- ** History webViewCanGoBack, webViewCanGoForward, webViewGoBack, webViewGoForward, webViewGetBackForwardList, webViewSetMaintainsBackForwardList, webViewGoToBackForwardItem, webViewCanGoBackOrForward, webViewGoBackOrForward, -- ** Zoom webViewGetZoomLevel, webViewSetZoomLevel, webViewZoomIn, webViewZoomOut, webViewGetFullContentZoom, webViewSetFullContentZoom, -- ** Clipboard webViewCanCutClipboard, webViewCanCopyClipboard, webViewCanPasteClipboard, webViewCutClipboard, webViewCopyClipboard, webViewPasteClipboard, -- ** Undo/Redo webViewCanRedo, webViewCanUndo, webViewRedo, webViewUndo, -- ** Selection webViewDeleteSelection, webViewHasSelection, webViewSelectAll, -- ** Encoding webViewGetEncoding, webViewSetCustomEncoding, webViewGetCustomEncoding, -- ** Source Mode webViewGetViewSourceMode, webViewSetViewSourceMode, -- ** Transparent webViewGetTransparent, webViewSetTransparent, -- ** Target List webViewGetCopyTargetList, webViewGetPasteTargetList, -- ** Text Match webViewMarkTextMatches, webViewUnMarkTextMatches, webViewSetHighlightTextMatches, -- ** Other webViewExecuteScript, webViewCanShowMimeType, webViewGetEditable, webViewSetEditable, webViewGetInspector, webViewGetProgress, webViewSearchText, webViewMoveCursor, webViewGetMainFrame, webViewGetFocusedFrame, webViewSetWebSettings, webViewGetWebSettings, webViewGetWindowFeatures, #if WEBKIT_CHECK_VERSION (1,1,18) webViewGetIconUri, #endif webViewGetTitle, webViewGetUri, -- * Attributes webViewZoomLevel, webViewFullContentZoom, webViewEncoding, webViewCustomEncoding, webViewLoadStatus, webViewProgress, webViewTitle, webViewInspector, webViewWebSettings, webViewViewSourceMode, webViewTransparent, webViewEditable, webViewUri, webViewCopyTargetList, webViewPasteTargetList, webViewWindowFeatures, #if WEBKIT_CHECK_VERSION (1,1,18) webViewIconUri, #endif #if WEBKIT_CHECK_VERSION (1,1,20) webViewImContext, #endif -- * Signals loadStarted, loadCommitted, progressChanged, loadFinished, loadError, titleChanged, hoveringOverLink, createWebView, webViewReady, closeWebView, consoleMessage, copyClipboard, cutClipboard, pasteClipboard, populatePopup, printRequested, scriptAlert, scriptConfirm, scriptPrompt, statusBarTextChanged, selectAll, selectionChanged, setScrollAdjustments, databaseQuotaExceeded, documentLoadFinished, downloadRequested, #if WEBKIT_CHECK_VERSION (1,1,18) iconLoaded, #endif redo, undo, mimeTypePolicyDecisionRequested, moveCursor, navigationPolicyDecisionRequested, newWindowPolicyDecisionRequested, resourceRequestStarting, #if WEBKIT_CHECK_VERSION (1,1,23) geolocationPolicyDecisionCancelled, geolocationPolicyDecisionRequested, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import Graphics.UI.Gtk.WebKit.Signals#} {#import Graphics.UI.Gtk.WebKit.Internal#} {#import System.Glib.GObject#} {#import Graphics.UI.Gtk.General.Selection#} ( TargetList ) {#import Graphics.UI.Gtk.MenuComboToolbar.Menu#} {#import Graphics.UI.Gtk.General.Enums#} {#context lib="webkit" prefix ="webkit"#} ------------------ -- Enums {#enum NavigationResponse {underscoreToCase}#} {#enum WebViewTargetInfo as TargetInfo {underscoreToCase}#} {#enum LoadStatus {underscoreToCase}#} ------------------ -- Constructors -- | Create a new 'WebView' widget. -- -- It is a 'Widget' you can embed in a 'ScrolledWindow'. -- -- You can load any URI into the 'WebView' or any kind of data string. webViewNew :: IO WebView webViewNew = do isGthreadInited <- liftM toBool {#call g_thread_get_initialized#} if not isGthreadInited then {#call g_thread_init#} nullPtr else return () makeNewObject mkWebView $ liftM castPtr {#call web_view_new#} -- | Apply 'WebSettings' to a given 'WebView' -- -- !!NOTE!!, currently lack of useful APIs of 'WebSettings' in webkitgtk. -- If you want to set the encoding, font family or font size of the 'WebView', -- please use related functions. webViewSetWebSettings :: (WebViewClass self, WebSettingsClass settings) => self -> settings -> IO () webViewSetWebSettings webview websettings = {#call web_view_set_settings#} (toWebView webview) (toWebSettings websettings) -- | Return the 'WebSettings' currently used by 'WebView'. webViewGetWebSettings :: WebViewClass self => self -> IO WebSettings webViewGetWebSettings webview = makeNewGObject mkWebSettings $ {#call web_view_get_settings#} (toWebView webview) -- | Returns the instance of WebKitWebWindowFeatures held by the given WebKitWebView. webViewGetWindowFeatures :: WebViewClass self => self -> IO WebWindowFeatures webViewGetWindowFeatures webview = makeNewGObject mkWebWindowFeatures $ {#call web_view_get_window_features#} (toWebView webview) #if WEBKIT_CHECK_VERSION (1,1,18) -- | Obtains the URI for the favicon for the given WebKitWebView, or 'Nothing' if there is none. -- -- * Since 1.1.18 webViewGetIconUri :: WebViewClass self => self -> IO (Maybe String) webViewGetIconUri webview = {#call webkit_web_view_get_icon_uri #} (toWebView webview) >>= maybePeek peekUTFString #endif -- | Return the main 'WebFrame' of the given 'WebView'. webViewGetMainFrame :: WebViewClass self => self -> IO WebFrame webViewGetMainFrame webview = makeNewGObject mkWebFrame $ {#call web_view_get_main_frame#} (toWebView webview) -- | Return the focused 'WebFrame' of the given 'WebView'. webViewGetFocusedFrame :: WebViewClass self => self -> IO WebFrame webViewGetFocusedFrame webview = makeNewGObject mkWebFrame $ {#call web_view_get_focused_frame#} (toWebView webview) -- |Requests loading of the specified URI string in a 'WebView' webViewLoadUri :: WebViewClass self => self -> String -- ^ @uri@ - an URI string. -> IO() webViewLoadUri webview url = withCString url $ \urlPtr -> {#call web_view_load_uri#} (toWebView webview) urlPtr -- |Determine whether 'WebView' has a previous history item. webViewCanGoBack :: WebViewClass self => self -> IO Bool -- ^ True if able to move back, False otherwise. webViewCanGoBack webview = liftM toBool $ {#call web_view_can_go_back#} (toWebView webview) -- |Determine whether 'WebView' has a next history item. webViewCanGoForward :: WebViewClass self => self -> IO Bool -- ^ True if able to move forward, False otherwise. webViewCanGoForward webview = liftM toBool $ {#call web_view_can_go_forward#} (toWebView webview) -- |Loads the previous history item. webViewGoBack :: WebViewClass self => self -> IO () webViewGoBack webview = {#call web_view_go_back#} (toWebView webview) -- |Loads the next history item. webViewGoForward :: WebViewClass self => self -> IO () webViewGoForward webview = {#call web_view_go_forward#} (toWebView webview) -- |Set the 'WebView' to maintian a back or forward list of history items. webViewSetMaintainsBackForwardList :: WebViewClass self => self -> Bool -- ^ @flag@ - to tell the view to maintain a back or forward list. -> IO() webViewSetMaintainsBackForwardList webview flag = {#call web_view_set_maintains_back_forward_list#} (toWebView webview) (fromBool flag) -- |Return the 'WebBackForwardList' webViewGetBackForwardList :: WebViewClass self => self -> IO WebBackForwardList webViewGetBackForwardList webview = makeNewGObject mkWebBackForwardList $ {#call web_view_get_back_forward_list#} (toWebView webview) -- |Go to the specified 'WebHistoryItem' webViewGoToBackForwardItem :: (WebViewClass self, WebHistoryItemClass item) => self -> item -> IO Bool -- ^ True if loading of item is successful, False if not. webViewGoToBackForwardItem webview item = liftM toBool $ {#call web_view_go_to_back_forward_item#} (toWebView webview) (toWebHistoryItem item) -- |Determines whether 'WebView' has a history item of @steps@. -- -- Negative values represent steps backward while positive values -- represent steps forward webViewCanGoBackOrForward :: WebViewClass self => self -> Int -- ^ @steps@ - the number of steps -> IO Bool -- ^ True if able to move back or forward the given number of steps, -- False otherwise webViewCanGoBackOrForward webview steps = liftM toBool $ {#call web_view_can_go_back_or_forward#} (toWebView webview) (fromIntegral steps) -- |Loads the history item that is the number of @steps@ away from the current item. -- -- Negative values represent steps backward while positive values represent steps forward. webViewGoBackOrForward :: WebViewClass self => self -> Int -> IO () webViewGoBackOrForward webview steps = {#call web_view_go_back_or_forward#} (toWebView webview) (fromIntegral steps) -- |Determines whether or not it is currently possible to redo the last editing command in the view webViewCanRedo :: WebViewClass self => self -> IO Bool webViewCanRedo webview = liftM toBool $ {#call web_view_can_redo#} (toWebView webview) -- |Determines whether or not it is currently possible to undo the last editing command in the view webViewCanUndo :: WebViewClass self => self -> IO Bool webViewCanUndo webview = liftM toBool $ {#call web_view_can_undo#} (toWebView webview) -- |Redoes the last editing command in the view, if possible. webViewRedo :: WebViewClass self => self -> IO() webViewRedo webview = {#call web_view_redo#} (toWebView webview) -- |Undoes the last editing command in the view, if possible. webViewUndo :: WebViewClass self => self -> IO() webViewUndo webview = {#call web_view_undo#} (toWebView webview) -- | Returns whether or not a @mimetype@ can be displayed using this view. webViewCanShowMimeType :: WebViewClass self => self -> String -- ^ @mimetype@ - a MIME type -> IO Bool -- ^ True if the @mimetype@ can be displayed, otherwise False webViewCanShowMimeType webview mime = withCString mime $ \mimePtr -> liftM toBool $ {#call web_view_can_show_mime_type#} (toWebView webview) mimePtr -- | Returns whether the user is allowed to edit the document. webViewGetEditable :: WebViewClass self => self -> IO Bool webViewGetEditable webview = liftM toBool $ {#call web_view_get_editable#} (toWebView webview) -- | Sets whether allows the user to edit its HTML document. webViewSetEditable :: WebViewClass self => self -> Bool -> IO () webViewSetEditable webview editable = {#call web_view_set_editable#} (toWebView webview) (fromBool editable) -- | Returns whether 'WebView' is in view source mode webViewGetViewSourceMode :: WebViewClass self => self -> IO Bool webViewGetViewSourceMode webview = liftM toBool $ {#call web_view_get_view_source_mode#} (toWebView webview) -- | Set whether the view should be in view source mode. -- -- Setting this mode to TRUE before loading a URI will display -- the source of the web page in a nice and readable format. webViewSetViewSourceMode :: WebViewClass self => self -> Bool -> IO () webViewSetViewSourceMode webview mode = {#call web_view_set_view_source_mode#} (toWebView webview) (fromBool mode) -- | Returns whether the 'WebView' has a transparent background webViewGetTransparent :: WebViewClass self => self -> IO Bool webViewGetTransparent webview = liftM toBool $ {#call web_view_get_transparent#} (toWebView webview) -- |Sets whether the WebKitWebView has a transparent background. -- -- Pass False to have the 'WebView' draw a solid background (the default), -- otherwise pass True. webViewSetTransparent :: WebViewClass self => self -> Bool -> IO () webViewSetTransparent webview trans = {#call web_view_set_transparent#} (toWebView webview) (fromBool trans) -- |Obtains the 'WebInspector' associated with the 'WebView' webViewGetInspector :: WebViewClass self => self -> IO WebInspector webViewGetInspector webview = makeNewGObject mkWebInspector $ {#call web_view_get_inspector#} (toWebView webview) -- |Requests loading of the specified asynchronous client request. -- -- Creates a provisional data source that will transition to a committed data source once -- any data has been received. -- use 'webViewStopLoading' to stop the load. webViewLoadRequest :: (WebViewClass self, NetworkRequestClass request) => self -> request -> IO() webViewLoadRequest webview request = {#call web_view_load_request#} (toWebView webview) (toNetworkRequest request) -- |Returns the zoom level of 'WebView' -- -- i.e. the factor by which elements in the page are scaled with respect to their original size. webViewGetZoomLevel :: WebViewClass self => self -> IO Float -- ^ the zoom level of 'WebView' webViewGetZoomLevel webview = liftM realToFrac $ {#call web_view_get_zoom_level#} (toWebView webview) -- |Sets the zoom level of 'WebView'. webViewSetZoomLevel :: WebViewClass self => self -> Float -- ^ @zoom_level@ - the new zoom level -> IO () webViewSetZoomLevel webview zlevel = {#call web_view_set_zoom_level#} (toWebView webview) (realToFrac zlevel) -- |Loading the @content@ string as html. The URI passed in base_uri has to be an absolute URI. webViewLoadHtmlString :: WebViewClass self => self -> String -- ^ @content@ - the html string -> String -- ^ @base_uri@ - the base URI -> IO() webViewLoadHtmlString webview htmlstr url = withCString htmlstr $ \htmlPtr -> withCString url $ \urlPtr -> {#call web_view_load_html_string#} (toWebView webview) htmlPtr urlPtr -- | Requests loading of the given @content@ with the specified @mime_type@, @encoding@ and @base_uri@. -- -- If @mime_type@ is @Nothing@, "text/html" is assumed. -- -- If @encoding@ is @Nothing@, "UTF-8" is assumed. -- webViewLoadString :: WebViewClass self => self -> String -- ^ @content@ - the content string to be loaded. -> (Maybe String) -- ^ @mime_type@ - the MIME type or @Nothing@. -> (Maybe String) -- ^ @encoding@ - the encoding or @Nothing@. -> String -- ^ @base_uri@ - the base URI for relative locations. -> IO() webViewLoadString webview content mimetype encoding baseuri = withCString content $ \contentPtr -> maybeWith withCString mimetype $ \mimetypePtr -> maybeWith withCString encoding $ \encodingPtr -> withCString baseuri $ \baseuriPtr -> {#call web_view_load_string#} (toWebView webview) contentPtr mimetypePtr encodingPtr baseuriPtr -- |Returns the 'WebView' document title webViewGetTitle :: WebViewClass self => self -> IO (Maybe String) -- ^ the title of 'WebView' or Nothing in case of failed. webViewGetTitle webview = {#call web_view_get_title#} (toWebView webview) >>= maybePeek peekUTFString -- |Returns the current URI of the contents displayed by the 'WebView' webViewGetUri :: WebViewClass self => self -> IO (Maybe String) -- ^ the URI of 'WebView' or Nothing in case of failed. webViewGetUri webview = {#call web_view_get_uri#} (toWebView webview) >>= maybePeek peekUTFString -- | Stops and pending loads on the given data source. webViewStopLoading :: WebViewClass self => self -> IO () webViewStopLoading webview = {#call web_view_stop_loading#} (toWebView webview) -- | Reloads the 'WebView' webViewReload :: WebViewClass self => self -> IO () webViewReload webview = {#call web_view_reload#} (toWebView webview) -- | Reloads the 'WebView' without using any cached data. webViewReloadBypassCache :: WebViewClass self => self -> IO() webViewReloadBypassCache webview = {#call web_view_reload_bypass_cache#} (toWebView webview) -- | Increases the zoom level of 'WebView'. webViewZoomIn :: WebViewClass self => self -> IO() webViewZoomIn webview = {#call web_view_zoom_in#} (toWebView webview) -- | Decreases the zoom level of 'WebView'. webViewZoomOut :: WebViewClass self => self -> IO() webViewZoomOut webview = {#call web_view_zoom_out#} (toWebView webview) -- | Looks for a specified string inside 'WebView' webViewSearchText :: WebViewClass self => self -> String -- ^ @text@ - a string to look for -> Bool -- ^ @case_sensitive@ - whether to respect the case of text -> Bool -- ^ @forward@ - whether to find forward or not -> Bool -- ^ @wrap@ - whether to continue looking at beginning -- after reaching the end -> IO Bool -- ^ True on success or False on failure webViewSearchText webview text case_sensitive forward wrap = withCString text $ \textPtr -> liftM toBool $ {#call web_view_search_text#} (toWebView webview) textPtr (fromBool case_sensitive) (fromBool forward) (fromBool wrap) -- |Attempts to highlight all occurances of string inside 'WebView' webViewMarkTextMatches :: WebViewClass self => self -> String -- ^ @string@ - a string to look for -> Bool -- ^ @case_sensitive@ - whether to respect the case of text -> Int -- ^ @limit@ - the maximum number of strings to look for or 0 for all -> IO Int -- ^ the number of strings highlighted webViewMarkTextMatches webview text case_sensitive limit = withCString text $ \textPtr -> liftM fromIntegral $ {#call web_view_mark_text_matches#} (toWebView webview) textPtr (fromBool case_sensitive) (fromIntegral limit) -- | Move the cursor in view as described by step and count. webViewMoveCursor :: WebViewClass self => self -> MovementStep -> Int -> IO () webViewMoveCursor webview step count = {#call web_view_move_cursor#} (toWebView webview) (fromIntegral $ fromEnum step) (fromIntegral count) -- | Removes highlighting previously set by 'webViewMarkTextMarches' webViewUnMarkTextMatches :: WebViewClass self => self -> IO () webViewUnMarkTextMatches webview = {#call web_view_unmark_text_matches#} (toWebView webview) -- | Highlights text matches previously marked by 'webViewMarkTextMatches' webViewSetHighlightTextMatches :: WebViewClass self => self -> Bool -- ^ @highlight@ - whether to highlight text matches -> IO () webViewSetHighlightTextMatches webview highlight = {#call web_view_set_highlight_text_matches#} (toWebView webview) (fromBool highlight) -- | Execute the script specified by @script@ webViewExecuteScript :: WebViewClass self => self -> String -- ^ @script@ - script to be executed -> IO() webViewExecuteScript webview script = withCString script $ \scriptPtr -> {#call web_view_execute_script#} (toWebView webview) scriptPtr -- | Determines whether can cuts the current selection -- inside 'WebView' to the clipboard webViewCanCutClipboard :: WebViewClass self => self -> IO Bool webViewCanCutClipboard webview = liftM toBool $ {#call web_view_can_cut_clipboard#} (toWebView webview) -- | Determines whether can copies the current selection -- inside 'WebView' to the clipboard webViewCanCopyClipboard :: WebViewClass self => self -> IO Bool webViewCanCopyClipboard webview = liftM toBool $ {#call web_view_can_copy_clipboard#} (toWebView webview) -- | Determines whether can pastes the current contents of the clipboard -- to the 'WebView' webViewCanPasteClipboard :: WebViewClass self => self -> IO Bool webViewCanPasteClipboard webview = liftM toBool $ {#call web_view_can_paste_clipboard#} (toWebView webview) -- | Cuts the current selection inside 'WebView' to the clipboard. webViewCutClipboard :: WebViewClass self => self -> IO() webViewCutClipboard webview = {#call web_view_cut_clipboard#} (toWebView webview) -- | Copies the current selection inside 'WebView' to the clipboard. webViewCopyClipboard :: WebViewClass self => self -> IO() webViewCopyClipboard webview = {#call web_view_copy_clipboard#} (toWebView webview) -- | Pastes the current contents of the clipboard to the 'WebView' webViewPasteClipboard :: WebViewClass self => self -> IO() webViewPasteClipboard webview = {#call web_view_paste_clipboard#} (toWebView webview) -- | Deletes the current selection inside the 'WebView' webViewDeleteSelection :: WebViewClass self => self -> IO () webViewDeleteSelection webview = {#call web_view_delete_selection#} (toWebView webview) -- | Determines whether text was selected webViewHasSelection :: WebViewClass self => self -> IO Bool webViewHasSelection webview = liftM toBool $ {#call web_view_has_selection#} (toWebView webview) -- | Attempts to select everything inside the 'WebView' webViewSelectAll :: WebViewClass self => self -> IO () webViewSelectAll webview = {#call web_view_select_all#} (toWebView webview) -- | Returns whether the zoom level affects only text or all elements. webViewGetFullContentZoom :: WebViewClass self => self -> IO Bool -- ^ False if only text should be scaled(the default) -- True if the full content of the view should be scaled. webViewGetFullContentZoom webview = liftM toBool $ {#call web_view_get_full_content_zoom#} (toWebView webview) -- | Sets whether the zoom level affects only text or all elements. webViewSetFullContentZoom :: WebViewClass self => self -> Bool -- ^ @full_content_zoom@ - False if only text should be scaled (the default) -- True if the full content of the view should be scaled. -> IO () webViewSetFullContentZoom webview full = {#call web_view_set_full_content_zoom#} (toWebView webview) (fromBool full) -- | Returns the default encoding of the 'WebView' webViewGetEncoding :: WebViewClass self => self -> IO (Maybe String) -- ^ the default encoding or @Nothing@ in case of failed webViewGetEncoding webview = {#call web_view_get_encoding#} (toWebView webview) >>= maybePeek peekUTFString -- | Sets the current 'WebView' encoding, -- without modifying the default one, and reloads the page webViewSetCustomEncoding :: WebViewClass self => self -> (Maybe String) -- ^ @encoding@ - the new encoding, -- or @Nothing@ to restore the default encoding. -> IO () webViewSetCustomEncoding webview encoding = maybeWith withCString encoding $ \encodingPtr -> {#call web_view_set_custom_encoding#} (toWebView webview) encodingPtr -- | Returns the current encoding of 'WebView',not the default encoding. webViewGetCustomEncoding :: WebViewClass self => self -> IO (Maybe String) -- ^ the current encoding string -- or @Nothing@ if there is none set. webViewGetCustomEncoding webview = {#call web_view_get_custom_encoding#} (toWebView webview) >>= maybePeek peekUTFString -- | Determines the current status of the load. webViewGetLoadStatus :: WebViewClass self => self -> IO LoadStatus -- ^ the current load status:'LoadStatus' webViewGetLoadStatus webview = liftM (toEnum . fromIntegral) $ {#call web_view_get_load_status#} (toWebView webview) -- | Determines the current progress of the load webViewGetProgress :: WebViewClass self => self -> IO Double -- ^ the load progress webViewGetProgress webview = liftM realToFrac $ {#call web_view_get_progress#} (toWebView webview) -- | This function returns the list of targets this 'WebView' can provide for clipboard copying and as DND source. -- The targets in the list are added with values from the 'WebViewTargetInfo' enum, -- using 'targetListAdd' and 'targetListAddTextTargets'. webViewGetCopyTargetList :: WebViewClass self => self -> IO (Maybe TargetList) webViewGetCopyTargetList webview = do tlPtr <- {#call web_view_get_copy_target_list#} (toWebView webview) if tlPtr==nullPtr then return Nothing else liftM Just (mkTargetList tlPtr) -- | This function returns the list of targets this 'WebView' can provide for clipboard pasteing and as DND source. -- The targets in the list are added with values from the 'WebViewTargetInfo' enum, -- using 'targetListAdd' and 'targetListAddTextTargets'. webViewGetPasteTargetList :: WebViewClass self => self -> IO (Maybe TargetList) webViewGetPasteTargetList webview = do tlPtr <- {#call web_view_get_paste_target_list#} (toWebView webview) if tlPtr==nullPtr then return Nothing else liftM Just (mkTargetList tlPtr) -- * Attibutes -- | Zoom level of the 'WebView' instance webViewZoomLevel :: WebViewClass self => Attr self Float webViewZoomLevel = newAttr webViewGetZoomLevel webViewSetZoomLevel -- | Whether the full content is scaled when zooming -- -- Default value: False webViewFullContentZoom :: WebViewClass self => Attr self Bool webViewFullContentZoom = newAttr webViewGetFullContentZoom webViewSetFullContentZoom -- | The default encoding of the 'WebView' instance -- -- Default value: @Nothing@ webViewEncoding :: WebViewClass self => ReadAttr self (Maybe String) webViewEncoding = readAttr webViewGetEncoding -- | Determines the current status of the load. -- -- Default value: @LoadFinished@ webViewLoadStatus :: WebViewClass self => ReadAttr self LoadStatus webViewLoadStatus = readAttr webViewGetLoadStatus -- |Determines the current progress of the load -- -- Default Value: 1 webViewProgress :: WebViewClass self => ReadAttr self Double webViewProgress = readAttr webViewGetProgress -- | The associated webSettings of the 'WebView' instance webViewWebSettings :: WebViewClass self => Attr self WebSettings webViewWebSettings = newAttr webViewGetWebSettings webViewSetWebSettings -- | Title of the 'WebView' instance webViewTitle :: WebViewClass self => ReadAttr self (Maybe String) webViewTitle = readAttr webViewGetTitle -- | The associated webInspector instance of the 'WebView' webViewInspector :: WebViewClass self => ReadAttr self WebInspector webViewInspector = readAttr webViewGetInspector -- | The custom encoding of the 'WebView' instance -- -- Default value: @Nothing@ webViewCustomEncoding :: WebViewClass self => Attr self (Maybe String) webViewCustomEncoding = newAttr webViewGetCustomEncoding webViewSetCustomEncoding -- | view source mode of the 'WebView' instance webViewViewSourceMode :: WebViewClass self => Attr self Bool webViewViewSourceMode = newAttr webViewGetViewSourceMode webViewSetViewSourceMode -- | transparent background of the 'WebView' instance webViewTransparent :: WebViewClass self => Attr self Bool webViewTransparent = newAttr webViewGetTransparent webViewSetTransparent -- | Whether content of the 'WebView' can be modified by the user -- -- Default value: @False@ webViewEditable :: WebViewClass self => Attr self Bool webViewEditable = newAttr webViewGetEditable webViewSetEditable -- | Returns the current URI of the contents displayed by the @web_view@. -- -- Default value: Nothing webViewUri :: WebViewClass self => ReadAttr self (Maybe String) webViewUri = readAttr webViewGetUri -- | The list of targets this web view supports for clipboard copying. webViewCopyTargetList :: WebViewClass self => ReadAttr self (Maybe TargetList) webViewCopyTargetList = readAttr webViewGetCopyTargetList -- | The list of targets this web view supports for clipboard pasteing. webViewPasteTargetList :: WebViewClass self => ReadAttr self (Maybe TargetList) webViewPasteTargetList = readAttr webViewGetPasteTargetList -- | An associated 'WebWindowFeatures' instance. webViewWindowFeatures :: WebViewClass self => Attr self WebWindowFeatures webViewWindowFeatures = newAttrFromObjectProperty "window-features" {#call pure webkit_web_window_features_get_type#} #if WEBKIT_CHECK_VERSION (1,1,18) -- | The URI for the favicon for the WebKitWebView. -- -- Default value: 'Nothing' -- -- * Since 1.1.18 webViewIconUri :: WebViewClass self => ReadAttr self String webViewIconUri = readAttrFromStringProperty "icon-uri" #endif #if WEBKIT_CHECK_VERSION (1,1,20) -- | The 'IMMulticontext' for the WebKitWebView. -- -- This is the input method context used for all text entry widgets inside the WebKitWebView. It can be -- used to generate context menu items for controlling the active input method. -- -- * Since 1.1.20 webViewImContext :: WebViewClass self => ReadAttr self IMContext webViewImContext = readAttrFromObjectProperty "im-context" {#call pure gtk_im_context_get_type #} #endif -- * Signals -- | When Document title changed, this signal is emitted. -- -- It can be used to set the Application 'Window' title. -- -- webframe - which 'WebFrame' changes the document title. -- -- title - current title string. titleChanged :: WebViewClass self => Signal self ( WebFrame -> String -> IO() ) titleChanged = Signal (connect_OBJECT_STRING__NONE "title_changed") -- | When the cursor is over a link, this signal is emitted. -- -- title - the link's title or @Nothing@ in case of failure. -- -- uri - the URI the link points to or @Nothing@ in case of failure. hoveringOverLink :: WebViewClass self => Signal self (Maybe String -> Maybe String -> IO()) hoveringOverLink = Signal (connect_MSTRING_MSTRING__NONE "hovering_over_link") -- | When a 'WebFrame' begins to load, this signal is emitted loadStarted :: WebViewClass self => Signal self (WebFrame -> IO()) loadStarted = Signal (connect_OBJECT__NONE "load_started") -- | When a 'WebFrame' loaded the first data, this signal is emitted loadCommitted :: WebViewClass self => Signal self (WebFrame -> IO()) loadCommitted = Signal (connect_OBJECT__NONE "load_committed") -- | When the global progress changed, this signal is emitted -- -- the global progress will be passed back to user function progressChanged :: WebViewClass self => Signal self (Int-> IO()) progressChanged = Signal (connect_INT__NONE "load_progress_changed") -- | When loading finished, this signal is emitted loadFinished :: WebViewClass self => Signal self (WebFrame -> IO()) loadFinished = Signal (connect_OBJECT__NONE "load_finished") -- | When An error occurred while loading. -- -- By default, if the signal is not handled, -- the WebView will display a stock error page. -- -- You need to handle the signal -- if you want to provide your own error page. -- -- The URI that triggered the error and the 'GError' will be passed back to user function. loadError :: WebViewClass self => Signal self (WebFrame -> String -> GError -> IO Bool) loadError = Signal (connect_OBJECT_STRING_BOXED__BOOL "load_error" peek) createWebView :: WebViewClass self => Signal self (WebFrame -> IO WebView) createWebView = Signal (connect_OBJECT__OBJECTPTR "create_web_view") -- | Emitted when closing a WebView is requested. -- -- This occurs when a call is made from JavaScript's window.close function. -- The default signal handler does not do anything. -- It is the owner's responsibility to hide or delete the 'WebView', if necessary. -- -- User function should return True to stop the handlers from being invoked for the event -- or False to propagate the event furter closeWebView :: WebViewClass self => Signal self (IO Bool) closeWebView = Signal (connect_NONE__BOOL "close_web_view") -- | A JavaScript console message was created. consoleMessage :: WebViewClass self => Signal self (String -> String -> Int -> String -> IO Bool) consoleMessage = Signal (connect_STRING_STRING_INT_STRING__BOOL "console_message") -- | The 'copyClipboard' signal is a keybinding signal which gets emitted to copy the selection to the clipboard. -- -- The default bindings for this signal are Ctrl-c and Ctrl-Insert. copyClipboard :: WebViewClass self => Signal self (IO ()) copyClipboard = Signal (connect_NONE__NONE "copy_clipboard") -- | The 'cutClipboard' signal is a keybinding signal which gets emitted to cut the selection to the clipboard. -- -- The default bindings for this signal are Ctrl-x and Shift-Delete. cutClipboard :: WebViewClass self => Signal self (IO ()) cutClipboard = Signal (connect_NONE__NONE "cut_clipboard") -- | The 'pasteClipboard' signal is a keybinding signal which gets emitted to paste the contents of the clipboard into the Web view. -- -- The default bindings for this signal are Ctrl-v and Shift-Insert. pasteClipboard :: WebViewClass self => Signal self (IO ()) pasteClipboard = Signal (connect_NONE__NONE "paste_clipboard") -- | When a context menu is about to be displayed this signal is emitted. populatePopup :: WebViewClass self => Signal self (Menu -> IO ()) populatePopup = Signal (connect_OBJECT__NONE "populate_popup") -- | Emitted when printing is requested by the frame, usually because of a javascript call. -- When handling this signal you should call 'webFramePrintFull' or 'webFramePrint' to do the actual printing. -- -- The default handler will present a print dialog and carry a print operation. -- Notice that this means that if you intend to ignore a print -- request you must connect to this signal, and return True. printRequested :: WebViewClass self => Signal self (WebFrame -> IO Bool) printRequested = Signal (connect_OBJECT__BOOL "print_requested") -- | A JavaScript alert dialog was created. scriptAlert :: WebViewClass self => Signal self (WebFrame -> String -> IO Bool) scriptAlert = Signal (connect_OBJECT_STRING__BOOL "scriptAlert") -- | A JavaScript confirm dialog was created, providing Yes and No buttons. scriptConfirm :: WebViewClass self => Signal self (WebFrame -> String -> IO Bool) scriptConfirm = Signal (connect_OBJECT_STRING__BOOL "script_confirm") -- | A JavaScript prompt dialog was created, providing an entry to input text. scriptPrompt :: WebViewClass self => Signal self (WebFrame -> String -> String -> IO Bool) scriptPrompt = Signal (connect_OBJECT_STRING_STRING__BOOL "script_prompt") -- | When status-bar text changed, this signal will emitted. statusBarTextChanged :: WebViewClass self => Signal self (String -> IO ()) statusBarTextChanged = Signal (connect_STRING__NONE "status_bar_text_changed") -- | The 'selectAll' signal is a keybinding signal which gets emitted to select the complete contents of the text view. -- -- The default bindings for this signal is Ctrl-a. selectAll :: WebViewClass self => Signal self (IO ()) selectAll = Signal (connect_NONE__NONE "select_all") -- | When selection changed, this signal is emitted. selectionChanged :: WebViewClass self => Signal self (IO ()) selectionChanged = Signal (connect_NONE__NONE "selection_changed") -- | When set scroll adjustments, this signal is emitted. setScrollAdjustments :: WebViewClass self => Signal self (Adjustment -> Adjustment -> IO ()) setScrollAdjustments = Signal (connect_OBJECT_OBJECT__NONE "set_scroll_adjustments") -- | The 'databaseQuotaExceeded' signal will be emitted when a Web Database exceeds the quota of its security origin. -- This signal may be used to increase the size of the quota before the originating operation fails. databaseQuotaExceeded :: WebViewClass self => Signal self (WebFrame -> WebDatabase -> IO ()) databaseQuotaExceeded = Signal (connect_OBJECT_OBJECT__NONE "database_quota_exceeded") -- | When document loading finished, this signal is emitted documentLoadFinished :: WebViewClass self => Signal self (WebFrame -> IO ()) documentLoadFinished = Signal (connect_OBJECT__NONE "document_load_finished") -- | Emitted after new 'WebView' instance had been created in 'onCreateWebView' user function -- when the new 'WebView' should be displayed to the user. -- -- All the information about how the window should look, -- including size,position,whether the location, status and scroll bars should be displayed, -- is ready set. webViewReady:: WebViewClass self => Signal self (IO Bool) webViewReady = Signal (connect_NONE__BOOL "web_view_ready") -- | Emitted after A new 'Download' is being requested. -- -- By default, if the signal is not handled, the download is cancelled. -- -- Notice that while handling this signal you must set the target URI using 'downloadSetDestinationUri' -- -- If you intend to handle downloads yourself, return False in user function. downloadRequested :: WebViewClass self => Signal self (Download -> IO Bool) downloadRequested = Signal (connect_OBJECT__BOOL "download_requested") #if WEBKIT_CHECK_VERSION (1,1,18) -- | Emitted after Icon loaded iconLoaded :: WebViewClass self => Signal self (String -> IO ()) iconLoaded = Signal (connect_STRING__NONE "icon_loaded") #endif -- | The "redo" signal is a keybinding signal which gets emitted to redo the last editing command. -- -- The default binding for this signal is Ctrl-Shift-z redo :: WebViewClass self => Signal self (IO ()) redo = Signal (connect_NONE__NONE "redo") -- | The "undo" signal is a keybinding signal which gets emitted to undo the last editing command. -- -- The default binding for this signal is Ctrl-z undo :: WebViewClass self => Signal self (IO ()) undo = Signal (connect_NONE__NONE "undo") -- | Decide whether or not to display the given MIME type. -- If this signal is not handled, the default behavior is to show the content of the -- requested URI if WebKit can show this MIME type and the content disposition is not a download; -- if WebKit is not able to show the MIME type nothing happens. -- -- Notice that if you return True, meaning that you handled the signal, -- you are expected to be aware of the "Content-Disposition" header. -- A value of "attachment" usually indicates a download regardless of the MIME type, -- see also soupMessageHeadersGetContentDisposition' -- And you must call 'webPolicyDecisionIgnore', 'webPolicyDecisionDownload', or 'webPolicyDecisionUse' -- on the 'webPolicyDecision' object. mimeTypePolicyDecisionRequested :: WebViewClass self => Signal self (WebFrame -> NetworkRequest -> String -> WebPolicyDecision -> IO Bool) mimeTypePolicyDecisionRequested = Signal (connect_OBJECT_OBJECT_STRING_OBJECT__BOOL "mime_type_policy_decision_requested") -- | The 'moveCursor' will be emitted to apply the cursor movement described by its parameters to the view. moveCursor :: WebViewClass self => Signal self (MovementStep -> Int -> IO Bool) moveCursor = Signal (connect_ENUM_INT__BOOL "move_cursor") -- | Emitted when frame requests a navigation to another page. -- If this signal is not handled, the default behavior is to allow the navigation. -- -- Notice that if you return True, meaning that you handled the signal, -- you are expected to be aware of the "Content-Disposition" header. -- A value of "attachment" usually indicates a download regardless of the MIME type, -- see also soupMessageHeadersGetContentDisposition' -- And you must call 'webPolicyDecisionIgnore', 'webPolicyDecisionDownload', or 'webPolicyDecisionUse' -- on the 'webPolicyDecision' object. navigationPolicyDecisionRequested :: WebViewClass self => Signal self (WebFrame -> NetworkRequest -> WebNavigationAction -> WebPolicyDecision -> IO Bool) navigationPolicyDecisionRequested = Signal (connect_OBJECT_OBJECT_OBJECT_OBJECT__BOOL "navigation_policy_decision_requested") -- | Emitted when frame requests opening a new window. -- With this signal the browser can use the context of the request to decide about the new window. -- If the request is not handled the default behavior is to allow opening the new window to load the URI, -- which will cause a 'createWebView' signal emission where the browser handles the new window action -- but without information of the context that caused the navigation. -- The following 'navigationPolicyDecisionRequested' emissions will load the page -- after the creation of the new window just with the information of this new navigation context, -- without any information about the action that made this new window to be opened. -- -- Notice that if you return True, meaning that you handled the signal, -- you are expected to be aware of the "Content-Disposition" header. -- A value of "attachment" usually indicates a download regardless of the MIME type, -- see also soupMessageHeadersGetContentDisposition' -- And you must call 'webPolicyDecisionIgnore', 'webPolicyDecisionDownload', or 'webPolicyDecisionUse' -- on the 'webPolicyDecision' object. newWindowPolicyDecisionRequested :: WebViewClass self => Signal self (WebFrame -> NetworkRequest -> WebNavigationAction -> WebPolicyDecision -> IO Bool) newWindowPolicyDecisionRequested = Signal (connect_OBJECT_OBJECT_OBJECT_OBJECT__BOOL "new_window_policy_decision_requested") -- | Emitted when a request is about to be sent. -- You can modify the request while handling this signal. -- You can set the URI in the 'NetworkRequest' object itself, -- and add/remove/replace headers using the SoupMessage object it carries, -- if it is present. See 'networkRequestGetMessage'. -- Setting the request URI to "about:blank" will effectively cause the request to load nothing, -- and can be used to disable the loading of specific resources. -- -- Notice that information about an eventual redirect is available in response's SoupMessage, -- not in the SoupMessage carried by the request. -- If response is NULL, then this is not a redirected request. -- -- The 'WebResource' object will be the same throughout all the lifetime of the resource, -- but the contents may change from inbetween signal emissions. resourceRequestStarting :: WebViewClass self => Signal self (WebFrame -> WebResource -> Maybe NetworkRequest -> Maybe NetworkResponse -> IO ()) resourceRequestStarting = Signal (connect_OBJECT_OBJECT_MOBJECT_MOBJECT__NONE "resource_request_starting") #if WEBKIT_CHECK_VERSION (1,1,23) -- | When a frame wants to cancel geolocation permission it had requested before. -- -- * Since 1.1.23 geolocationPolicyDecisionCancelled :: WebViewClass self => Signal self (WebFrame -> IO ()) geolocationPolicyDecisionCancelled = Signal (connect_OBJECT__NONE "geolocation_policy_decision_cancelled") -- | When a frame wants to get its geolocation permission. The receiver must reply with a boolean wether -- it handled or not the request. If the request is not handled, default behaviour is to deny -- geolocation. -- -- * Since 1.1.23 geolocationPolicyDecisionRequested :: WebViewClass self => Signal self (WebFrame -> GeolocationPolicyDecision -> IO ()) geolocationPolicyDecisionRequested = Signal (connect_OBJECT_OBJECT__NONE "geolocation_policy_decision_requested") #endif webkit-0.12.3/Graphics/UI/Gtk/WebKit/Download.chs0000644000000000000000000002322311633370412017507 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.Download -- Author : Cjacker Huang -- Copyright : (c) 2009 Cjacker Huang -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Object used to communicate with the application when downloading ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.Download ( -- * Description -- | WebKitDownload carries information about a download request, including a WebKitNetworkRequest -- object. The application may use this object to control the download process, or to simply figure out -- what is to be downloaded, and do it itself. -- * Types Download, DownloadClass, -- * Enums DownloadError(..), DownloadStatus(..), -- * Constructors downloadNew, -- * Methods downloadStart, downloadCancel, downloadGetUri, downloadGetNetworkRequest, #if WEBKIT_CHECK_VERSION (1,1,16) downloadGetNetworkResponse, #endif downloadGetSuggestedFilename, downloadGetDestinationUri, downloadGetProgress, downloadGetElapsedTime, downloadGetTotalSize, downloadGetCurrentSize, downloadGetStatus, downloadSetDestinationUri, -- * Attributes currentSize, destinationUri, networkRequest, #if WEBKIT_CHECK_VERSION (1,1,16) networkResponse, #endif progress, status, suggestedFilename, totalSize, -- * Signals downloadError, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import Graphics.UI.Gtk.WebKit.Signals#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- * Enums {#enum DownloadError {underscoreToCase}#} {#enum DownloadStatus {underscoreToCase}#} ------------------ -- Constructors -- | Create a new 'Download' instance for the given 'NetworkRequest' -- -- Object used to communicate with the application when downloading. downloadNew :: NetworkRequestClass request => request -> IO Download downloadNew nr = wrapNewGObject mkDownload $ {#call download_new#} (toNetworkRequest nr) -- | Initiates the 'Download'. -- -- Notice that you must have set the destination-uri property before -- calling this function. downloadStart:: DownloadClass self => self -> IO() downloadStart dl = {#call download_start#} (toDownload dl) -- | Cancels the 'Download'. downloadCancel:: DownloadClass self => self -> IO() downloadCancel dl = {#call download_cancel#} (toDownload dl) -- | Retrieves the URI from 'Download' which is being downloaded. downloadGetUri:: DownloadClass self => self -> IO (Maybe String) -- ^ the uri or @Nothing@ in case of failed downloadGetUri dl = {#call download_get_uri#} (toDownload dl) >>= maybePeek peekCString -- | Retrieves the 'NetworkRequest' that backs the download process. downloadGetNetworkRequest :: DownloadClass self => self -> IO NetworkRequest downloadGetNetworkRequest dl = makeNewGObject mkNetworkRequest $ {#call download_get_network_request#} (toDownload dl) #if WEBKIT_CHECK_VERSION (1,1,16) -- | Retrieves the 'NetworkResponse' object that backs the download process. -- -- * Since 1.1.16 downloadGetNetworkResponse :: DownloadClass self => self -> IO NetworkResponse downloadGetNetworkResponse dl = makeNewGObject mkNetworkResponse $ {#call download_get_network_response#} (toDownload dl) #endif -- | Retrieves the filename that was suggested by the server, -- or the one derived from the URI. downloadGetSuggestedFilename :: DownloadClass self => self -> IO (Maybe String) -- ^ the suggested filename or @Nothing@ in case of failed downloadGetSuggestedFilename dl = {#call download_get_suggested_filename#} (toDownload dl) >>= maybePeek peekCString -- | Obtains the URI to which the downloaded file will be written. -- -- It is set by Application before call 'downloadStart' downloadGetDestinationUri :: DownloadClass self => self -> IO (Maybe String) downloadGetDestinationUri dl = {#call download_get_destination_uri#} (toDownload dl) >>= maybePeek peekCString -- | Defines the URI that should be used to save the downloaded file to. downloadSetDestinationUri :: DownloadClass self => self -> String -- ^ @destination_uri@ - the destination URI -> IO() downloadSetDestinationUri dl dest = withCString dest $ \destPtr -> {#call download_set_destination_uri#} (toDownload dl) destPtr -- |Determines the current progress of the 'Download' downloadGetProgress :: DownloadClass self => self -> IO Double -- ^ a 'Double' ranging from 0.0 to 1.0 downloadGetProgress dl = liftM realToFrac $ {#call download_get_progress#} (toDownload dl) -- |Return elapsed time for the 'Download' in seconds. -- includeing any fractional part. -- -- If the 'Download' is finished, had an error or was cancelled, -- this is the time between its start and the event. downloadGetElapsedTime :: DownloadClass self => self -> IO Double -- ^ seconds since the 'Download' was started. downloadGetElapsedTime dl = liftM realToFrac $ {#call download_get_elapsed_time#} (toDownload dl) -- |Returns the excepted total size of the download. -- -- This is expected because the server may provide incorrect or missing -- Content-Length. -- -- Notice that this may grow over time. downloadGetTotalSize :: DownloadClass self => self -> IO Int -- ^ the expected total size of the downloaded file. downloadGetTotalSize dl = liftM fromIntegral $ {#call download_get_total_size#} (toDownload dl) -- | Returns the current already downleaded size downloadGetCurrentSize :: DownloadClass self => self -> IO Int -- ^ the already downloaded size. downloadGetCurrentSize dl = liftM fromIntegral $ {#call download_get_current_size#} (toDownload dl) -- | Obtains the current status of the 'Download' as 'DownloadStatus' downloadGetStatus :: DownloadClass self => self -> IO DownloadStatus -- ^ the current 'DownloadStatus' downloadGetStatus dl = liftM (toEnum . fromIntegral) $ {#call download_get_status#} (toDownload dl) -- * Attibutes -- | The length of the data already downloaded -- -- Default value: 0 -- -- * Since 1.1.2 -- currentSize :: DownloadClass self => ReadAttr self Int currentSize = readAttr downloadGetCurrentSize -- | The URI of the save location for this download. -- -- Default value: \"\" -- -- * Since 1.1.2 destinationUri :: DownloadClass self => Attr self (Maybe String) destinationUri = newAttrFromMaybeStringProperty "destination-uri" -- | The NetworkRequest instance associated with the download. -- -- * Since 1.1.2 networkRequest :: DownloadClass self => Attr self NetworkRequest networkRequest = newAttrFromObjectProperty "network-request" {#call pure webkit_network_request_get_type#} #if WEBKIT_CHECK_VERSION (1,1,16) -- | The NetworkResponse instance associated with the download. -- -- * Since 1.1.16 networkResponse :: DownloadClass self => Attr self NetworkResponse networkResponse = newAttrFromObjectProperty "network-response" {#call pure webkit_network_response_get_type#} #endif -- | Determines the current progress of the download. -- Notice that, although the progress changes are reported as soon as possible, -- the emission of the notify signal for this property is throttled, for the benefit of download managers. -- If you care about every update, use 'Download' : currentSize. -- -- Allowed values: [0,1] -- -- Default value: 1 -- -- * Since 1.1.2 progress :: DownloadClass self => ReadAttr self Double progress = readAttr downloadGetProgress -- | Determines the current status of the download. -- -- Default value: 'DownloadStatusCreated' -- -- * Since 1.1.2 status :: DownloadClass self => ReadAttr self DownloadStatus status = readAttr downloadGetStatus -- | The file name suggested as default when saving -- -- Default value: \"\" -- -- * Since 1.1.2 suggestedFilename :: DownloadClass self => ReadAttr self (Maybe String) suggestedFilename = readAttr downloadGetSuggestedFilename -- | The total size of the file -- -- Default value: 0 -- -- * Since 1.1.2 totalSize :: DownloadClass self => ReadAttr self Int totalSize = readAttr downloadGetTotalSize -- * Signals -- | Emitted when download is interrupted either by user action or by network errors, -- errorDetail will take any value of 'DownloadError'. -- -- 'download': the object on which the signal is emitted -- 'errorCode': the corresponding error code -- 'errorDetail': detailed error code for the error, see 'DownloadError' -- 'reason': a string describing the error -- -- Since 1.1.2 downloadError :: DownloadClass self => Signal self (Int -> Int -> String -> IO Bool) downloadError = Signal (connect_INT_INT_STRING__BOOL "error") webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebWindowFeatures.chs0000644000000000000000000001251611633370412021347 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebWindowFeatures -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Access to the WebKit Web WindowFeatures ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebWindowFeatures ( -- * Description -- | The content of a WebKitWebView can request to change certain properties of a WebKitWebView. This can -- include the x, y position of the window, the width and height but also if a toolbar, scrollbar, -- statusbar, locationbar should be visible to the user, the request to show the WebKitWebView -- fullscreen. -- -- In the normal case one will use 'webViewGetWindowFeatures' to get the -- WebKitWebWindowFeatures and then monitor the property changes. Be aware that the -- WebKitWebWindowFeatures might change change before 'webViewReady' signal is emitted. To be safe -- listen to the 'windowFeatures' signal of the WebKitWebView and reconnect the signals whenever -- the WebKitWebWindowFeatures of a WebKitWebView changes. -- * Types WebWindowFeatures, WebWindowFeaturesClass, -- * Constructors webWindowFeaturesNew, -- * Methods webWindowFeaturesEqual, -- * Attributes webWindowFeaturesFullscreen, webWindowFeaturesHeight, webWindowFeaturesWidth, webWindowFeaturesX, webWindowFeaturesY, webWindowFeaturesLocationbarVisible, webWindowFeaturesMenubarVisible, webWindowFeaturesScrollbarVisible, webWindowFeaturesStatusbarVisible, webWindowFeaturesToolbarVisible, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import System.Glib.Attributes import System.Glib.Properties import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- * Constructors -- | Creates a new 'WebWindowFeatures' instance with default values. -- It must be manually attached to a WebView. webWindowFeaturesNew :: IO WebWindowFeatures webWindowFeaturesNew = wrapNewGObject mkWebWindowFeatures $ {#call web_window_features_new#} -- | Decides if a 'WebWindowFeatures' instance equals another, as in has the same values. webWindowFeaturesEqual :: (WebWindowFeaturesClass winA, WebWindowFeaturesClass winB) => winA -> winB -> IO Bool webWindowFeaturesEqual winA winB = liftM toBool $ {#call web_window_features_equal#} (toWebWindowFeatures winA) (toWebWindowFeatures winB) -- * Attributes -- | Controls whether window will be displayed fullscreen. webWindowFeaturesFullscreen :: WebWindowFeaturesClass self => Attr self Bool webWindowFeaturesFullscreen = newAttrFromBoolProperty "fullscreen" -- | The height of the window on the screen. webWindowFeaturesHeight :: WebWindowFeaturesClass self => Attr self Int webWindowFeaturesHeight = newAttrFromIntProperty "height" -- | The width of the window on the screen. webWindowFeaturesWidth :: WebWindowFeaturesClass self => Attr self Int webWindowFeaturesWidth = newAttrFromIntProperty "width" -- | Controls whether the locationbar should be visible for the window. webWindowFeaturesLocationbarVisible :: WebWindowFeaturesClass self => Attr self Bool webWindowFeaturesLocationbarVisible = newAttrFromBoolProperty "locationbar-visible" -- | Controls whether the menubar should be visible for the window. webWindowFeaturesMenubarVisible :: WebWindowFeaturesClass self => Attr self Bool webWindowFeaturesMenubarVisible = newAttrFromBoolProperty "menubar-visible" -- | Controls whether the scrollbar should be visible for the window. webWindowFeaturesScrollbarVisible :: WebWindowFeaturesClass self => Attr self Bool webWindowFeaturesScrollbarVisible = newAttrFromBoolProperty "scrollbar-visible" -- | Controls whether the statusbar should be visible for the window. webWindowFeaturesStatusbarVisible :: WebWindowFeaturesClass self => Attr self Bool webWindowFeaturesStatusbarVisible = newAttrFromBoolProperty "statusbar-visible" -- | Controls whether the toolbar should be visible for the window. webWindowFeaturesToolbarVisible :: WebWindowFeaturesClass self => Attr self Bool webWindowFeaturesToolbarVisible = newAttrFromBoolProperty "toolbar-visible" -- | The starting x position of the window on the screen. webWindowFeaturesX :: WebWindowFeaturesClass self => Attr self Int webWindowFeaturesX = newAttrFromIntProperty "x" -- | The starting y position of the window on the screen. webWindowFeaturesY :: WebWindowFeaturesClass self => Attr self Int webWindowFeaturesY = newAttrFromIntProperty "y" webkit-0.12.3/Graphics/UI/Gtk/WebKit/Internal.chs0000644000000000000000000000456511633370412017524 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.Internal -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Access to the WebKit Internal -- -- This module contain some functions for help binding Webkit. -- ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.Internal ( -- * Methods -- Below functions just help binding use in internal. -- Don't call those functions in your code. connect_OBJECT__OBJECTPTR, webViewToWebViewPtr, ) where import System.Glib.FFI import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import Graphics.UI.Gtk.WebKit.Signals#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- | Signal helper functions. connect_OBJECT__OBJECTPTR :: (GObjectClass a', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> IO WebView) -> IO (ConnectId obj) connect_OBJECT__OBJECTPTR signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> IO (Ptr WebView) action _ obj1 = failOnGError $ makeNewGObject mkGObject (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') >>= webViewToWebViewPtr -- | Internal helper function for convert. webViewToWebViewPtr :: WebViewClass self => self -> IO (Ptr WebView) webViewToWebViewPtr webview = return $ unsafeForeignPtrToPtr (unWebView (toWebView webview)) webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebFrame.chs0000644000000000000000000002523211633370412017432 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebFrame -- Author : Cjacker Huang -- Copyright : (c) 2009 Cjacker Huang -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The content of a 'WebView' -- -- Note: -- Functon `webkit_web_frame_get_global_context` can't binding now, -- Because it need `JSGlobalContextRef` exist in JavaScriptCore. -- -- Function `webkit_web_frame_print_full` can't binding now, -- Because library `GtkPrintOperation` haven't binding. -- ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebFrame ( -- * Description -- | A WebKitWebView contains a main WebKitWebFrame. A WebKitWebFrame contains the content of one -- URI. The URI and name of the frame can be retrieved, the load status and progress can be observed -- using the signals and can be controlled using the methods of the WebKitWebFrame. A WebKitWebFrame -- can have any number of children and one child can be found by using 'webFrameFindFrame'. -- * Types WebFrame, WebFrameClass, LoadStatus, -- * Constructors webFrameNew, -- * Methods webFrameGetWebView, webFrameGetName, #if WEBKIT_CHECK_VERSION (1,1,18) webFrameGetNetworkResponse, #endif webFrameGetTitle, webFrameGetUri, webFrameGetParent, webFrameGetLoadStatus, webFrameLoadUri, webFrameLoadString, webFrameLoadAlternateString, webFrameLoadRequest, webFrameStopLoading, webFrameReload, webFrameFindFrame, webFrameGetDataSource, webFrameGetHorizontalScrollbarPolicy, webFrameGetVerticalScrollbarPolicy, webFrameGetProvisionalDataSource, webFrameGetSecurityOrigin, webFramePrint, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events import Graphics.UI.Gtk.General.Enums {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- * Enums {#enum LoadStatus {underscoreToCase}#} ------------------ -- Constructors -- | Create a new 'WebFrame' instance with the given @webview@. -- -- A 'WebFrame' contains the content of one URI. webFrameNew :: WebViewClass webview => webview -- ^ @webview@ - the given webview -> IO WebFrame webFrameNew webview = wrapNewGObject mkWebFrame $ {#call web_frame_new#} (toWebView webview) -- | Return the 'WebView' that manages the given 'WebFrame'. webFrameGetWebView :: WebFrameClass self => self -> IO WebView webFrameGetWebView webframe = makeNewObject mkWebView $ liftM castPtr $ {#call web_frame_get_web_view#} (toWebFrame webframe) -- | Return the name of the given 'WebFrame'. webFrameGetName :: WebFrameClass self => self -> IO (Maybe String) -- ^ the name string or @Nothing@ in case failed. webFrameGetName webframe = {#call web_frame_get_name#} (toWebFrame webframe) >>= maybePeek peekCString #if WEBKIT_CHECK_VERSION (1,1,18) -- | Returns a WebKitNetworkResponse object representing the response that was given to the request for -- the given frame, or 'Nothing' if the frame was not created by a load. -- -- * Since 1.1.18 webFrameGetNetworkResponse :: WebFrameClass self => self -> IO (Maybe NetworkResponse) webFrameGetNetworkResponse frame = maybeNull (makeNewGObject mkNetworkResponse) $ {#call webkit_web_frame_get_network_response#} (toWebFrame frame) #endif -- | Return the title of the given 'WebFrame'. webFrameGetTitle :: WebFrameClass self => self -> IO (Maybe String) -- ^ the title string or @Nothing@ in case failed. webFrameGetTitle webframe = {#call web_frame_get_title#} (toWebFrame webframe) >>= maybePeek peekCString -- | Return the URI of the given 'WebFrame'. webFrameGetUri :: WebFrameClass self => self -> IO (Maybe String) -- ^ the URI string or @Nothing@ in case failed. webFrameGetUri webframe = {#call web_frame_get_uri#} (toWebFrame webframe) >>= maybePeek peekCString -- | Return the 'WebFrame''s parent frame if it has one, -- Otherwise return Nothing. webFrameGetParent :: WebFrameClass self => self -> IO (Maybe WebFrame) -- ^ a 'WebFrame' or @Nothing@ in case failed. webFrameGetParent webframe = maybeNull (makeNewGObject mkWebFrame) $ {#call web_frame_get_parent#} (toWebFrame webframe) -- | Determines the current status of the load. -- -- frame : a WebKitWebView -- -- * Since 1.1.7 webFrameGetLoadStatus :: WebFrameClass self => self -> IO LoadStatus webFrameGetLoadStatus ls = liftM (toEnum . fromIntegral) $ {#call web_frame_get_load_status#} (toWebFrame ls) -- | Request loading of the specified URI string. webFrameLoadUri :: WebFrameClass self => self -> String -- ^ @uri@ - an URI string. -> IO () webFrameLoadUri webframe uri = withCString uri $ \uriPtr -> {#call web_frame_load_uri#} (toWebFrame webframe) uriPtr -- | Requests loading of the given @content@ -- with the specified @mime_type@, @encoding@ and @base_uri@. -- -- If @mime_type@ is @Nothing@, \"text/html\" is assumed. -- -- If @encoding@ is @Nothing@, \"UTF-8\" is assumed. webFrameLoadString :: WebFrameClass self => self -> String -- ^ @content@ - the content string to be loaded. -> (Maybe String) -- ^ @mime_type@ - the MIME type or @Nothing@. -> (Maybe String) -- ^ @encoding@ - the encoding or @Nothing@. -> String -- ^ @base_uri@ - the base URI for relative locations. -> IO() webFrameLoadString webframe content mimetype encoding baseuri = withCString content $ \contentPtr -> maybeWith withCString mimetype $ \mimetypePtr -> maybeWith withCString encoding $ \encodingPtr -> withCString baseuri $ \baseuriPtr -> {#call web_frame_load_string#} (toWebFrame webframe) contentPtr mimetypePtr encodingPtr baseuriPtr -- |Request loading of an alternate content for a URL that is unreachable. -- -- Using this method will preserve the back-forward list. -- The URI passed in @base_uri@ has to be an absolute URI. webFrameLoadAlternateString :: WebFrameClass self => self -> String -- ^ @content@ - the alternate content to display -- as the main page of the frame -> String -- ^ @base_uri@ - the base URI for relative locations. -> String -- ^ @unreachable_url@ - the URL for the alternate page content. -> IO() webFrameLoadAlternateString webframe content baseurl unreachableurl = withCString content $ \contentPtr -> withCString baseurl $ \baseurlPtr -> withCString unreachableurl $ \unreachableurlPtr -> {#call web_frame_load_alternate_string#} (toWebFrame webframe) contentPtr baseurlPtr unreachableurlPtr -- | Connects to a given URI by initiating an asynchronous client request. -- -- Creates a provisional data source that will transition to a committed data source once any data has been received. -- Use 'webFrameStopLoading' to stop the load. -- This function is typically invoked on the main frame. webFrameLoadRequest :: (WebFrameClass self, NetworkRequestClass requ) => self -> requ -> IO () webFrameLoadRequest webframe request = {#call web_frame_load_request#} (toWebFrame webframe) (toNetworkRequest request) -- | Stops and pending loads on the given data source and those of its children. webFrameStopLoading :: WebFrameClass self => self -> IO() webFrameStopLoading webframe = {#call web_frame_stop_loading#} (toWebFrame webframe) -- |Reloads the initial request. webFrameReload :: WebFrameClass self => self -> IO() webFrameReload webframe = {#call web_frame_reload#} (toWebFrame webframe) -- |Return the 'WebFrame' associated with the given name -- or @Nothing@ in case none if found -- -- For pre-defined names, return the given webframe if name is webFrameFindFrame:: WebFrameClass self => self -> String -- ^ @name@ - the name of the frame to be found. -> IO (Maybe WebFrame) webFrameFindFrame webframe name = withCString name $ \namePtr -> maybeNull (makeNewGObject mkWebFrame) $ {#call web_frame_find_frame#} (toWebFrame webframe) namePtr -- | Returns the committed data source. webFrameGetDataSource :: WebFrameClass self => self -> IO WebDataSource webFrameGetDataSource webframe = makeNewGObject mkWebDataSource $ {#call web_frame_get_data_source#} (toWebFrame webframe) -- | Return the policy of horizontal scrollbar. webFrameGetHorizontalScrollbarPolicy :: WebFrameClass self => self -> IO PolicyType webFrameGetHorizontalScrollbarPolicy webframe = liftM (toEnum.fromIntegral) $ {#call web_frame_get_horizontal_scrollbar_policy#} (toWebFrame webframe) -- | Return the policy of vertical scrollbar. webFrameGetVerticalScrollbarPolicy :: WebFrameClass self => self -> IO PolicyType webFrameGetVerticalScrollbarPolicy webframe = liftM (toEnum.fromIntegral) $ {#call web_frame_get_vertical_scrollbar_policy#} (toWebFrame webframe) -- | You use the 'webFrameLoadRequest' method to initiate a request that creates a provisional data source. -- The provisional data source will transition to a committed data source once any data has been received. -- Use 'webFrameGetDataSource' to get the committed data source. webFrameGetProvisionalDataSource :: WebFrameClass self => self -> IO WebDataSource webFrameGetProvisionalDataSource webframe = makeNewGObject mkWebDataSource $ {#call web_frame_get_provisional_data_source#} (toWebFrame webframe) -- | Returns the frame's security origin. webFrameGetSecurityOrigin :: WebFrameClass self => self -> IO SecurityOrigin webFrameGetSecurityOrigin webframe = makeNewGObject mkSecurityOrigin $ {#call web_frame_get_security_origin#} (toWebFrame webframe) -- |Prints the given 'WebFrame'. -- -- by presenting a print dialog to the user. webFramePrint:: WebFrameClass self => self -> IO() webFramePrint webframe = {#call web_frame_print#} (toWebFrame webframe) webkit-0.12.3/Graphics/UI/Gtk/WebKit/SoupAuthDialog.chs0000644000000000000000000000322511633370412020630 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.SoupAuthDialog -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Access to the WebKit Web Resource ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.SoupAuthDialog ( -- * Description -- | WebKitSoupAuthDialog is a SoupSessionFeature that you can attach to your SoupSession to provide a -- simple authentication dialog while handling HTTP basic auth. It is built as a simple C-only module -- to ease reuse. -- * Types SoupAuthDialog, SoupAuthDialogClass, ) where import System.Glib.FFI import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} webkit-0.12.3/Graphics/UI/Gtk/WebKit/NetworkRequest.chs0000644000000000000000000000603111633370412020740 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.NetworkRequest -- Author : Cjacker Huang -- Copyright : (c) 2009 Cjacker Huang -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The target of a navigation request ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.NetworkRequest ( -- * Description -- | This class represents the network related aspects of a navigation request. It is used whenever -- WebKit wants to provide information about a request that will be sent, or has been sent. Inside it -- you can find the URI of the request, and, for valid URIs, a SoupMessage object, which provides -- access to further information such as headers. -- * Types NetworkRequest, NetworkRequestClass, -- * Constructors networkRequestNew, -- * Methods networkRequestSetUri, networkRequestGetUri, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} ------------------ -- Constructors -- | Create a new NetworkRequest with the given @uri@. -- -- It is used whenever WebKit wants to provide information -- about a request that will be sent, or has been sent. networkRequestNew :: String -- ^ @uri@ - the uri of the request -> IO NetworkRequest networkRequestNew uri = withCString uri $ \uriPtr -> wrapNewGObject mkNetworkRequest $ {#call network_request_new#} uriPtr -- | Set the URI of 'NetworkRequest'. -- networkRequestSetUri :: NetworkRequestClass self => self -> String -- ^ @uri@ - the uri will be set to the request. -> IO() networkRequestSetUri networkrequest uri = withCString uri $ \uriPtr -> {#call network_request_set_uri#} (toNetworkRequest networkrequest) uriPtr -- | Return the uri of 'NetworkRequest'. networkRequestGetUri :: NetworkRequestClass self => self -> IO (Maybe String) -- ^ the URI or @Nothing@ in case failed. networkRequestGetUri networkrequest = {#call network_request_get_uri#} (toNetworkRequest networkrequest) >>= maybePeek peekCString webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebDataSource.chs0000644000000000000000000001454511633370412020437 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebDataSource -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Note -- -- Function `webkit_web_data_source_get_data` haven't binding, -- no idea how to handle `GString` -- -- Access to the WebKit Web DataSource ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebDataSource ( -- * Description -- | Data source encapsulates the content of a WebKitWebFrame. A WebKitWebFrame has a main resource and -- subresources and the data source provides access to these resources. When a request gets loaded -- initially, it is set to a provisional state. The application can request for the request that -- initiated the load by asking for the provisional data source and invoking the -- 'webDataSourceGetInitialRequest' method of WebKitWebDataSource. This data source may not -- have enough data and some methods may return empty values. To get a "full" data source with the data -- and resources loaded, you need to get the non-provisional data source through WebKitWebFrame's -- 'webFrameGetDataSource' method. This data source will have the data after everything was -- loaded. Make sure that the data source was finished loading before using any of its methods. You can -- do this via 'webDataSourceIsLoading'. -- * Types WebDataSource, WebDataSourceClass, -- * Constructors webDataSourceNew, -- * Methods webDataSourceGetData, webDataSourceGetEncoding, webDataSourceGetInitialRequest, webDataSourceGetMainResource, webDataSourceGetRequest, webDataSourceGetSubresources, webDataSourceGetUnreachableUri, webDataSourceGetWebFrame, webDataSourceIsLoading, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GString import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- | Creates a new 'WebDataSource' instance. -- The URL of the 'WebDataSource' will be set to "about:blank". webDataSourceNew :: IO WebDataSource webDataSourceNew = wrapNewGObject mkWebDataSource $ {#call web_data_source_new#} -- | Returns the raw data that represents the the frame's content. The data will be incomplete until the -- data has finished loading. Returns 'Nothing' if the web frame hasn't loaded any data. Use -- @webkitWebDataSourceIsLoading@ to test if data source is in the process of loading. webDataSourceGetData :: WebDataSourceClass self => self -> IO (Maybe String) webDataSourceGetData ds = do gstr <- {#call webkit_web_data_source_get_data #} (toWebDataSource ds) readGString gstr -- | Returns the text encoding name as set in the 'WebView', or if not, the text encoding of the response. webDataSourceGetEncoding :: WebDataSourceClass self => self -> IO String webDataSourceGetEncoding ds = {#call web_data_source_get_encoding#} (toWebDataSource ds) >>= peekCString -- | Returns a reference to the original request that was used to load the web content. -- The NetworkRequest returned by this method is the -- request prior to the "committed" load state. -- See 'webDataSourceGetRequest' for getting the "committed" request. webDataSourceGetInitialRequest :: WebDataSourceClass self => self -> IO NetworkRequest webDataSourceGetInitialRequest ds = makeNewGObject mkNetworkRequest $ {# call web_data_source_get_initial_request#} (toWebDataSource ds) -- | Returns the main resource of the data_source webDataSourceGetMainResource :: WebDataSourceClass self => self -> IO WebResource webDataSourceGetMainResource ds = makeNewGObject mkWebResource $ {#call web_data_source_get_main_resource#} (toWebDataSource ds) -- | Returns a NetworkRequest that was used to create this 'WebDataSource'. -- The NetworkRequest returned by this method is the request that was "committed", -- and hence, different from the request you get from the 'webDataSourceGetInitialRequest' method. webDataSourceGetRequest :: WebDataSourceClass self => self -> IO NetworkRequest webDataSourceGetRequest ds = makeNewGObject mkNetworkRequest $ {# call web_data_source_get_request#} (toWebDataSource ds) -- | Gives you a List of 'WebResource' objects that compose the 'WebView' to which this 'WebDataSource' is attached. webDataSourceGetSubresources :: WebDataSourceClass self => self -> IO [WebResource] webDataSourceGetSubresources ds = do glist <- {#call web_data_source_get_subresources#} (toWebDataSource ds) resourcePtr <- fromGList glist mapM (makeNewGObject mkWebResource . return) resourcePtr -- | Return the unreachable URI of data_source. -- The 'dataSource' will have an unreachable URL -- if it was created using 'WebFrame''s -- 'webFrameLoadAlternateHtmlString' method. webDataSourceGetUnreachableUri :: WebDataSourceClass self => self -> IO String webDataSourceGetUnreachableUri ds = {#call web_data_source_get_unreachable_uri#} (toWebDataSource ds) >>= peekCString -- | Returns the 'WebFrame' that represents this data source webDataSourceGetWebFrame :: WebDataSourceClass self => self -> IO WebFrame webDataSourceGetWebFrame ds = makeNewGObject mkWebFrame $ {#call web_data_source_get_web_frame#} (toWebDataSource ds) -- | Determines whether the data source is in the process of loading its content. webDataSourceIsLoading :: WebDataSourceClass self => self -> IO Bool webDataSourceIsLoading ds = liftM toBool $ {#call web_data_source_is_loading#} (toWebDataSource ds) webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebHistoryItem.chs0000644000000000000000000001602611633370412020661 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebHistoryItem -- Author : Cjacker Huang -- Copyright : (c) 2009 Cjacker Huang -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- One item of the 'WebBackForwardList' and or global history ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebHistoryItem ( -- * Description -- | A history item consists out of a title and a uri. It can be part of the WebKitWebBackForwardList and -- the global history. The global history is used for coloring the links of visited -- sites. WebKitWebHistoryItem's constructed with 'webHistoryItemNew' and -- 'webHistoryItemNewWithData' are automatically added to the global history. -- * Types WebHistoryItem, WebHistoryItemClass, -- * Constructors webHistoryItemNew, webHistoryItemNewWithData, -- * Attributes webHistoryItemTitle, webHistoryItemAlternateTitle, webHistoryItemUri, webHistoryItemOriginalUri, webHistoryItemLastVisitedTime, -- * Methods webHistoryItemGetTitle, webHistoryItemGetAlternateTitle, webHistoryItemSetAlternateTitle, webHistoryItemGetUri, webHistoryItemGetOriginalUri, webHistoryItemGetLastVisitedTime, #if WEBKIT_CHECK_VERSION (1,1,18) webHistoryItemCopy, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import System.Glib.Attributes import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} ------------------ -- Constructors -- | Create a new 'WebHistoryItem' instance. -- -- A history item consists out of a title and a uri, -- it can be part of the WebBackForwardList and the global history. -- -- The global history is used for coloring the links of visited sites. -- 'WebHistoryItem' constructed with 'webHistoryItemNew' are -- automatically added to the global history. webHistoryItemNew :: IO WebHistoryItem webHistoryItemNew = wrapNewGObject mkWebHistoryItem $ {#call web_history_item_new#} -- | Create a new 'WebHistoryItem' instance with the given @uri@ and @title@. -- -- 'WebHistoryItem' constructed with 'webHistoryItemNewWithData' are -- automatically added to the global history. webHistoryItemNewWithData :: String -- ^ @uri@ - the uri of the item -> String -- ^ @title@ - the title of the item -> IO WebHistoryItem webHistoryItemNewWithData uri title = withCString uri $ \uriPtr -> withCString title $ \titlePtr -> wrapNewGObject mkWebHistoryItem $ {#call web_history_item_new_with_data#} uriPtr titlePtr -- | Return the title of 'WebHistoryItem'. webHistoryItemGetTitle :: WebHistoryItemClass self => self -> IO (Maybe String) -- ^ the title or @Nothing@ in case failed. webHistoryItemGetTitle webhistoryitem = {#call web_history_item_get_title#} (toWebHistoryItem webhistoryitem) >>= maybePeek peekCString -- | Return the alternate title of WebHistoryItem. webHistoryItemGetAlternateTitle :: WebHistoryItemClass self => self -> IO (Maybe String) -- ^ the alternate title or @Nothing@ in case failed. webHistoryItemGetAlternateTitle webhistoryitem = {#call web_history_item_get_alternate_title#} (toWebHistoryItem webhistoryitem) >>= maybePeek peekCString -- | Set an alternate title for WebHistoryItem. webHistoryItemSetAlternateTitle :: WebHistoryItemClass self => self -> (Maybe String) -- ^ @title@ - the alternate title for this history item. -> IO() webHistoryItemSetAlternateTitle webhistoryitem title = maybeWith withCString title $ \titlePtr -> {#call web_history_item_set_alternate_title#} (toWebHistoryItem webhistoryitem) titlePtr -- | Return the URI of WebHistoryItem. webHistoryItemGetUri :: WebHistoryItemClass self => self -> IO (Maybe String) -- ^ the URI or @Nothing@ in case failed. webHistoryItemGetUri webhistoryitem = {#call web_history_item_get_uri#} (toWebHistoryItem webhistoryitem) >>= maybePeek peekCString -- | Return the original URI of WebHistoryItem. webHistoryItemGetOriginalUri :: WebHistoryItemClass self => self -> IO (Maybe String) -- ^ the URI or @Nothing@ in case failed webHistoryItemGetOriginalUri webhistoryitem = {#call web_history_item_get_original_uri#} (toWebHistoryItem webhistoryitem) >>= maybePeek peekCString -- | Return the last visited time of WebHistoryItem. webHistoryItemGetLastVisitedTime :: WebHistoryItemClass self => self -> IO Double -- ^ the last visited time of this history item. webHistoryItemGetLastVisitedTime webhistoryitem = liftM realToFrac $ {#call web_history_item_get_last_visited_time#} (toWebHistoryItem webhistoryitem) #if WEBKIT_CHECK_VERSION (1,1,18) -- | Makes a copy of the item for use with other WebView objects. -- -- * Since 1.1.18 webHistoryItemCopy :: WebHistoryItemClass self => self -> IO WebHistoryItem webHistoryItemCopy webhistoryitem = makeNewGObject mkWebHistoryItem $ {#call webkit_web_history_item_copy#} (toWebHistoryItem webhistoryitem) #endif -- | The title of the 'WebHistoryItem' -- -- Default value: @Nothing@ webHistoryItemTitle :: (WebHistoryItemClass self) => ReadAttr self (Maybe String) webHistoryItemTitle = readAttr webHistoryItemGetTitle -- | The alternate title of the history item. -- -- Default value: @Nothing@ webHistoryItemAlternateTitle :: (WebHistoryItemClass self) => Attr self (Maybe String) webHistoryItemAlternateTitle = newAttr webHistoryItemGetAlternateTitle webHistoryItemSetAlternateTitle -- | The URI of the history item. -- -- Default value: @Nothing@ webHistoryItemUri :: (WebHistoryItemClass self) => ReadAttr self (Maybe String) webHistoryItemUri = readAttr webHistoryItemGetUri -- | The original URI of the history item. -- -- Default value: @Nothing@ webHistoryItemOriginalUri :: (WebHistoryItemClass self) => ReadAttr self (Maybe String) webHistoryItemOriginalUri = readAttr webHistoryItemGetOriginalUri -- | The time at which the history item was last visited. -- -- Allowed values: >= 0 -- -- Default value: 0 webHistoryItemLastVisitedTime :: (WebHistoryItemClass self) => ReadAttr self Double webHistoryItemLastVisitedTime = readAttr webHistoryItemGetLastVisitedTime webkit-0.12.3/Graphics/UI/Gtk/WebKit/GeolocationPolicyDecision.chs0000644000000000000000000000546711633370412023053 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.GeolocationPolicyDecision -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Object used to communicate with the application when downloading ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.GeolocationPolicyDecision ( #if WEBKIT_CHECK_VERSION (1,1,23) -- * Description -- | WebKitGeolocationPolicyDecision objects are given to the application when -- geolocation-policy-decision-requested signal is emitted. The application uses it to tell the engine -- whether it wants to allow or deny geolocation for a given frame. -- * Types GeolocationPolicyDecision, GeolocationPolicyDecisionClass, -- * Methods geolocationPolicyAllow, geolocationPolicyDeny, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import Graphics.UI.Gtk.WebKit.Signals#} {#import Graphics.UI.Gtk.WebKit.Internal#} {#import System.Glib.GObject#} {#import Graphics.UI.Gtk.General.Selection#} ( TargetList ) {#import Graphics.UI.Gtk.MenuComboToolbar.Menu#} {#import Graphics.UI.Gtk.General.Enums#} {#context lib="webkit" prefix ="webkit"#} #if WEBKIT_CHECK_VERSION (1,1,23) -- | Will send the allow decision to the policy implementer. -- -- * Since 1.1.23 geolocationPolicyAllow :: GeolocationPolicyDecisionClass decision => decision -> IO () geolocationPolicyAllow decision = {#call webkit_geolocation_policy_allow #} (toGeolocationPolicyDecision decision) -- | Will send the deny decision to the policy implementer. -- -- * Since 1.1.23 geolocationPolicyDeny :: GeolocationPolicyDecisionClass decision => decision -> IO () geolocationPolicyDeny decision = {#call webkit_geolocation_policy_deny #} (toGeolocationPolicyDecision decision) #endif webkit-0.12.3/Graphics/UI/Gtk/WebKit/CacheModel.chs0000644000000000000000000000654311633370412017732 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.CacheModel -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Object used to communicate with the application when downloading ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.CacheModel ( #if WEBKIT_CHECK_VERSION (1,1,18) -- * Enums CacheModel (..), -- * Methods getCacheModel, setCacheModel, #endif ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.Attributes import System.Glib.Properties import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import Graphics.UI.Gtk.WebKit.Signals#} {#import Graphics.UI.Gtk.WebKit.Internal#} {#import System.Glib.GObject#} {#import Graphics.UI.Gtk.General.Selection#} ( TargetList ) {#import Graphics.UI.Gtk.MenuComboToolbar.Menu#} {#import Graphics.UI.Gtk.General.Enums#} {#context lib="webkit" prefix ="webkit"#} #if WEBKIT_CHECK_VERSION (1,1,18) ------------------ -- Enums {#enum CacheModel {underscoreToCase}#} ------------------ -- Methods -- | Returns the current cache model. For more information about this value check the documentation of -- the function 'setCacheModel'. -- -- * Since 1.1.18 getCacheModel :: IO CacheModel getCacheModel = liftM (toEnum . fromIntegral) $ {#call webkit_get_cache_model #} -- | Specifies a usage model for WebViews, which WebKit will use to determine its caching behavior. All -- web views follow the cache model. This cache model determines the RAM and disk space to use for -- caching previously viewed content . -- -- Research indicates that users tend to browse within clusters of documents that hold resources in -- common, and to revisit previously visited documents. WebKit and the frameworks below it include -- built-in caches that take advantage of these patterns, substantially improving document load speed -- in browsing situations. The WebKit cache model controls the behaviors of all of these caches, -- including various WebCore caches. -- -- Browsers can improve document load speed substantially by specifying -- WebkitCacheModelWebBrowser. Applications without a browsing interface can reduce memory usage -- substantially by specifying WebkitCacheModelDocumentViewer. Default value is -- WebkitCacheModelWebBrowser. -- -- * Since 1.1.18 setCacheModel :: CacheModel -> IO () setCacheModel model = {#call webkit_set_cache_model #} ((fromIntegral . fromEnum) model) #endif webkit-0.12.3/Graphics/UI/Gtk/WebKit/Signals.chs0000644000000000000000000003633711633370412017352 0ustar0000000000000000{-# OPTIONS_HADDOCK hide #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ------------ -- Callback installers for the GIMP Toolkit (GTK) Binding for Haskell -- -- Author : Axel Simon -- -- Created: 1 July 2000 -- -- Copyright (C) 2000-2005 Axel Simon -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- #hide -- These functions are used to connect signals to widgets. They are auto- -- matically created through HookGenerator.hs which takes a list of possible -- function signatures that are included in the GTK sources (gtkmarshal.list). -- -- The object system in the second version of GTK is based on GObject from -- GLIB. This base class is rather primitive in that it only implements -- ref and unref methods (and others that are not interesting to us). If -- the marshall list mentions OBJECT it refers to an instance of this -- GObject which is automatically wrapped with a ref and unref call. -- Structures which are not derived from GObject have to be passed as -- BOXED which gives the signal connect function a possibility to do the -- conversion into a proper ForeignPtr type. In special cases the signal -- connect function use a PTR type which will then be mangled in the -- user function directly. The latter is needed if a signal delivers a -- pointer to a string and its length in a separate integer. -- module Graphics.UI.Gtk.WebKit.Signals ( module System.Glib.Signals, connect_PTR_PTR__NONE, connect_OBJECT__BOOL, connect_OBJECT_STRING_BOXED__BOOL, connect_OBJECT__PTR, connect_INT_INT_STRING__BOOL, connect_STRING_STRING_INT_STRING__BOOL, connect_OBJECT_STRING__BOOL, connect_OBJECT_STRING_STRING__BOOL, connect_OBJECT_OBJECT_OBJECT_OBJECT__BOOL, connect_OBJECT_OBJECT_STRING_OBJECT__BOOL, connect_OBJECT_OBJECT_OBJECT_OBJECT__NONE, connect_OBJECT_OBJECT_MOBJECT_MOBJECT__NONE, connect_ENUM_INT__BOOL, connect_NONE__BOOL, connect_NONE__NONE, connect_MSTRING_MSTRING__NONE, connect_OBJECT_STRING__NONE, connect_OBJECT_OBJECT__NONE, connect_STRING_STRING__NONE, connect_OBJECT__NONE, connect_INT__NONE, connect_STRING__NONE, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString (peekUTFString,maybePeekUTFString) import System.Glib.GError (failOnGError) {#import System.Glib.Signals#} {#import System.Glib.GObject#} import Graphics.UI.GtkInternals {#context lib="gtk" prefix="gtk" #} -- Here are the generators that turn a Haskell function into -- a C function pointer. The fist Argument is always the widget, -- the last one is the user g_pointer. Both are ignored. connect_PTR_PTR__NONE :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (Ptr a -> Ptr b -> IO ()) -> IO (ConnectId obj) connect_PTR_PTR__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr () -> Ptr () -> IO () action _ ptr1 ptr2 = failOnGError $ user (castPtr ptr1) (castPtr ptr2) connect_OBJECT__BOOL :: (GObjectClass a', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> IO Bool) -> IO (ConnectId obj) connect_OBJECT__BOOL signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> IO Bool action _ obj1 = failOnGError $ makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') connect_OBJECT_STRING_BOXED__BOOL :: (GObjectClass a', GObjectClass obj) => SignalName -> (Ptr c' -> IO c) -> ConnectAfter -> obj -> (a' -> String -> c -> IO Bool) -> IO (ConnectId obj) connect_OBJECT_STRING_BOXED__BOOL signal boxedPre3 after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> CString -> Ptr () -> IO Bool action _ obj1 str2 box3 = failOnGError $ boxedPre3 (castPtr box3) >>= \box3' -> peekUTFString str2 >>= \str2' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') str2' box3' connect_OBJECT__PTR :: (GObjectClass a', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> IO (Ptr b)) -> IO (ConnectId obj) connect_OBJECT__PTR signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> IO (Ptr ()) action _ obj1 = failOnGError $ liftM castPtr $ makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') connect_INT_INT_STRING__BOOL :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (Int -> Int -> String -> IO Bool) -> IO (ConnectId obj) connect_INT_INT_STRING__BOOL signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Int -> Int -> CString -> IO Bool action _ int1 int2 str3 = failOnGError $ peekUTFString str3 >>= \str3' -> user int1 int2 str3' connect_STRING_STRING_INT_STRING__BOOL :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (String -> String -> Int -> String -> IO Bool) -> IO (ConnectId obj) connect_STRING_STRING_INT_STRING__BOOL signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> CString -> CString -> Int -> CString -> IO Bool action _ str1 str2 int3 str4 = failOnGError $ peekUTFString str4 >>= \str4' -> peekUTFString str2 >>= \str2' -> peekUTFString str1 >>= \str1' -> user str1' str2' int3 str4' connect_OBJECT_STRING__BOOL :: (GObjectClass a', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> String -> IO Bool) -> IO (ConnectId obj) connect_OBJECT_STRING__BOOL signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> CString -> IO Bool action _ obj1 str2 = failOnGError $ peekUTFString str2 >>= \str2' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') str2' connect_OBJECT_STRING_STRING__BOOL :: (GObjectClass a', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> String -> String -> IO Bool) -> IO (ConnectId obj) connect_OBJECT_STRING_STRING__BOOL signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> CString -> CString -> IO Bool action _ obj1 str2 str3 = failOnGError $ peekUTFString str3 >>= \str3' -> peekUTFString str2 >>= \str2' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') str2' str3' connect_OBJECT_OBJECT_OBJECT_OBJECT__BOOL :: (GObjectClass a', GObjectClass b', GObjectClass c', GObjectClass d', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> b' -> c' -> d' -> IO Bool) -> IO (ConnectId obj) connect_OBJECT_OBJECT_OBJECT_OBJECT__BOOL signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> Ptr GObject -> Ptr GObject -> Ptr GObject -> IO Bool action _ obj1 obj2 obj3 obj4 = failOnGError $ makeNewGObject (GObject, objectUnrefFromMainloop) (return obj4) >>= \obj4' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj3) >>= \obj3' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj2) >>= \obj2' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') (unsafeCastGObject obj2') (unsafeCastGObject obj3') (unsafeCastGObject obj4') connect_OBJECT_OBJECT_STRING_OBJECT__BOOL :: (GObjectClass a', GObjectClass b', GObjectClass d', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> b' -> String -> d' -> IO Bool) -> IO (ConnectId obj) connect_OBJECT_OBJECT_STRING_OBJECT__BOOL signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> Ptr GObject -> CString -> Ptr GObject -> IO Bool action _ obj1 obj2 str3 obj4 = failOnGError $ makeNewGObject (GObject, objectUnrefFromMainloop) (return obj4) >>= \obj4' -> peekUTFString str3 >>= \str3' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj2) >>= \obj2' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') (unsafeCastGObject obj2') str3' (unsafeCastGObject obj4') connect_OBJECT_OBJECT_OBJECT_OBJECT__NONE :: (GObjectClass a', GObjectClass b', GObjectClass c', GObjectClass d', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> b' -> c' -> d' -> IO ()) -> IO (ConnectId obj) connect_OBJECT_OBJECT_OBJECT_OBJECT__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> Ptr GObject -> Ptr GObject -> Ptr GObject -> IO () action _ obj1 obj2 obj3 obj4 = failOnGError $ makeNewGObject (GObject, objectUnrefFromMainloop) (return obj4) >>= \obj4' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj3) >>= \obj3' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj2) >>= \obj2' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') (unsafeCastGObject obj2') (unsafeCastGObject obj3') (unsafeCastGObject obj4') connect_OBJECT_OBJECT_MOBJECT_MOBJECT__NONE :: (GObjectClass a', GObjectClass b', GObjectClass c', GObjectClass d', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> b' -> Maybe c' -> Maybe d' -> IO ()) -> IO (ConnectId obj) connect_OBJECT_OBJECT_MOBJECT_MOBJECT__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> Ptr GObject -> Ptr GObject -> Ptr GObject -> IO () action _ obj1 obj2 obj3 obj4 = failOnGError $ maybeNull (makeNewGObject (GObject, objectUnrefFromMainloop)) (return obj4) >>= \obj4' -> maybeNull (makeNewGObject (GObject, objectUnrefFromMainloop)) (return obj3) >>= \obj3' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj2) >>= \obj2' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') (unsafeCastGObject obj2') (liftM unsafeCastGObject obj3') (liftM unsafeCastGObject obj4') connect_ENUM_INT__BOOL :: (Enum a, GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a -> Int -> IO Bool) -> IO (ConnectId obj) connect_ENUM_INT__BOOL signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Int -> Int -> IO Bool action _ enum1 int2 = failOnGError $ user (toEnum enum1) int2 connect_NONE__BOOL :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (IO Bool) -> IO (ConnectId obj) connect_NONE__BOOL signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> IO Bool action _ = failOnGError $ user connect_NONE__NONE :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (IO ()) -> IO (ConnectId obj) connect_NONE__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> IO () action _ = failOnGError $ user connect_MSTRING_MSTRING__NONE :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (Maybe String -> Maybe String -> IO ()) -> IO (ConnectId obj) connect_MSTRING_MSTRING__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> CString -> CString -> IO () action _ str1 str2 = failOnGError $ maybePeekUTFString str2 >>= \str2' -> maybePeekUTFString str1 >>= \str1' -> user str1' str2' connect_OBJECT_STRING__NONE :: (GObjectClass a', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> String -> IO ()) -> IO (ConnectId obj) connect_OBJECT_STRING__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> CString -> IO () action _ obj1 str2 = failOnGError $ peekUTFString str2 >>= \str2' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') str2' connect_OBJECT_OBJECT__NONE :: (GObjectClass a', GObjectClass b', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> b' -> IO ()) -> IO (ConnectId obj) connect_OBJECT_OBJECT__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> Ptr GObject -> IO () action _ obj1 obj2 = failOnGError $ makeNewGObject (GObject, objectUnrefFromMainloop) (return obj2) >>= \obj2' -> makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') (unsafeCastGObject obj2') connect_STRING_STRING__NONE :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (String -> String -> IO ()) -> IO (ConnectId obj) connect_STRING_STRING__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> CString -> CString -> IO () action _ str1 str2 = failOnGError $ peekUTFString str2 >>= \str2' -> peekUTFString str1 >>= \str1' -> user str1' str2' connect_OBJECT__NONE :: (GObjectClass a', GObjectClass obj) => SignalName -> ConnectAfter -> obj -> (a' -> IO ()) -> IO (ConnectId obj) connect_OBJECT__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Ptr GObject -> IO () action _ obj1 = failOnGError $ makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' -> user (unsafeCastGObject obj1') connect_INT__NONE :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (Int -> IO ()) -> IO (ConnectId obj) connect_INT__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> Int -> IO () action _ int1 = failOnGError $ user int1 connect_STRING__NONE :: GObjectClass obj => SignalName -> ConnectAfter -> obj -> (String -> IO ()) -> IO (ConnectId obj) connect_STRING__NONE signal after obj user = connectGeneric signal after obj action where action :: Ptr GObject -> CString -> IO () action _ str1 = failOnGError $ peekUTFString str1 >>= \str1' -> user str1' webkit-0.12.3/Graphics/UI/Gtk/WebKit/WebDatabase.chs0000644000000000000000000001074111633370412020103 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.WebDatabase -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- Access to the WebKit Web Database ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.WebDatabase ( -- * Description -- | WebKitWebDatabase is a representation of a Web Database database. The proposed Web Database standard -- introduces support for SQL databases that web sites can create and access on a local computer -- through JavaScript. -- -- To get access to all databases defined by a security origin, use -- 'securityOriginGetDatabases' Each database has a canonical name, as well as a user-friendly -- display name. -- -- WebKit uses SQLite to create and access the local SQL databases. The location of a WebKitWebDatabase -- can be accessed wth 'webDatabaseGetFilename' You can configure the location of all -- databases with 'setDatabaseDirectoryPath'. -- -- For each database the web site can define an estimated size which can be accessed with -- 'webDatabaseGetExpectedSize' The current size of the database in bytes is returned by -- 'webDatabaseGetSize'. -- -- For more information refer to the Web Database specification proposal at -- http://dev.w3.org/html5/webdatabase -- * Types WebDatabase, WebDatabaseClass, -- * Methods webDatabaseGetDisplayName, webDatabaseGetExpectedSize, webDatabaseGetFilename, webDatabaseGetName, webDatabaseGetSecurityOrigin, webDatabaseGetSize, webDatabaseRemove, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} -- | Returns the name of the 'WebDatabase' as seen by the user. webDatabaseGetDisplayName :: WebDatabaseClass self => self -> IO String webDatabaseGetDisplayName wd = {#call web_database_get_display_name#} (toWebDatabase wd) >>= peekCString -- | Returns the expected size of the Database in bytes as defined by the web author. The Web Database standard allows web authors to -- specify an expected size of the database to optimize the user experience. webDatabaseGetExpectedSize :: WebDatabaseClass self => self -> IO Int webDatabaseGetExpectedSize wd = liftM fromIntegral $ {#call web_database_get_expected_size#} (toWebDatabase wd) -- | Returns the absolute filename to the WebKitWebDatabase file on disk. webDatabaseGetFilename :: WebDatabaseClass self => self -> IO String webDatabaseGetFilename wd = {#call web_database_get_filename#} (toWebDatabase wd) >>= peekCString -- | Returns the canonical name of the 'WebDatabase'. webDatabaseGetName :: WebDatabaseClass self => self -> IO String webDatabaseGetName wd = {#call web_database_get_name#} (toWebDatabase wd) >>= peekCString -- | Returns the security origin of the WebKitWebDatabase. webDatabaseGetSecurityOrigin :: WebDatabaseClass self => self -> IO SecurityOrigin webDatabaseGetSecurityOrigin wd = makeNewGObject mkSecurityOrigin $ {#call web_database_get_security_origin#} (toWebDatabase wd) -- | Returns the actual size of the 'WebDatabase' space on disk in bytes. webDatabaseGetSize :: WebDatabaseClass self => self -> IO Int webDatabaseGetSize wd = liftM fromIntegral $ {#call web_database_get_size#} (toWebDatabase wd) -- | Removes the 'WebDatabase' from its security origin and destroys all data stored in the database. webDatabaseRemove :: WebDatabaseClass self => self -> IO () webDatabaseRemove wd = {#call web_database_remove#} (toWebDatabase wd) webkit-0.12.3/Graphics/UI/Gtk/WebKit/NetworkResponse.chs0000644000000000000000000000450511633370412021112 0ustar0000000000000000{-# LANGUAGE CPP #-} -- -*-haskell-*- ----------------------------------------------------------------------------- -- Module : Graphics.UI.Gtk.WebKit.NetworkResponse -- Author : Cjacker Huang -- Copyright : (c) 2009 Cjacker Huang -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 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 -- Lesser General Public License for more details. -- -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- The response given to a network request ----------------------------------------------------------------------------- module Graphics.UI.Gtk.WebKit.NetworkResponse ( -- * Description -- | This class represents the network related aspects of a navigation response. -- * Types NetworkResponse, NetworkResponseClass, -- * Methods networkResponseSetUri, networkResponseGetUri, ) where import Control.Monad (liftM) import System.Glib.FFI import System.Glib.UTFString import System.Glib.GList import System.Glib.GError import Graphics.UI.Gtk.Gdk.Events {#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject) {#import Graphics.UI.Gtk.WebKit.Types#} {#import System.Glib.GObject#} {#context lib="webkit" prefix ="webkit"#} ------------------ -- Constructors -- | Set the URI of 'NetworkResponse'. -- networkResponseSetUri :: NetworkResponseClass self => self -> String -- ^ @uri@ - the uri will be set to the response. -> IO() networkResponseSetUri response uri = withCString uri $ \uriPtr -> {#call network_response_set_uri#} (toNetworkResponse response) uriPtr -- | Return the uri of 'NetworkResponse'. networkResponseGetUri :: NetworkResponseClass self => self -> IO (Maybe String) -- ^ the URI or @Nothing@ in case failed. networkResponseGetUri response = {#call network_response_get_uri#} (toNetworkResponse response) >>= maybePeek peekCString webkit-0.12.3/demo/0000755000000000000000000000000011633370412012174 5ustar0000000000000000webkit-0.12.3/demo/Webkit.hs0000644000000000000000000000503511633370412013760 0ustar0000000000000000-- | WebKit browser demo. -- Author : Andy Stewart -- Copyright : (c) 2010 Andy Stewart -- | This simple browser base on WebKit API. -- For simple, i just make all link open in current window. -- Of course, you can integrate signal `createWebView` with `notebook` -- to build multi-tab browser. -- -- You can click right-button for forward or backward page. -- -- Usage: -- webkit [uri] -- module Main where import Graphics.UI.Gtk import Graphics.UI.Gtk.WebKit.WebView import Graphics.UI.Gtk.WebKit.WebFrame import System.Process import System.Environment -- | Main entry. main :: IO () main = do -- Get program arguments. args <- getArgs case args of -- Display help ["--help"] -> putStrLn $ "Welcome to Gtk2hs WebKit demo. :)\n\n" ++ "Usage: webkit [uri]\n\n" ++ " -- Gtk2hs Team" -- Start program. [arg] -> browser arg -- entry user input url _ -> browser "http://www.google.com" -- entry default url -- | Internal browser fucntion. browser :: String -> IO () browser url = do -- Init. initGUI -- Create window. window <- windowNew windowSetDefaultSize window 900 600 windowSetPosition window WinPosCenter windowSetOpacity window 0.8 -- this function need window-manager support Alpha channel in X11 -- Create WebKit view. webView <- webViewNew -- Create window box. winBox <- vBoxNew False 0 -- Create address bar. addressBar <- entryNew -- Create scroll window. scrollWin <- scrolledWindowNew Nothing Nothing -- Load uri. webViewLoadUri webView url entrySetText addressBar url -- Open uri when user press `return` at address bar. onEntryActivate addressBar $ do uri <- entryGetText addressBar -- get uri from address bar webViewLoadUri webView uri -- load new uri -- Add current uri to address bar when load start. webView `on` loadStarted $ \frame -> do currentUri <- webFrameGetUri frame case currentUri of Just uri -> entrySetText addressBar uri Nothing -> return () -- Open all link in current window. webView `on` createWebView $ \frame -> do newUri <- webFrameGetUri frame case newUri of Just uri -> webViewLoadUri webView uri Nothing -> return () return webView -- Connect and show. boxPackStart winBox addressBar PackNatural 0 boxPackStart winBox scrollWin PackGrow 0 window `containerAdd` winBox scrollWin `containerAdd` webView window `onDestroy` mainQuit widgetShowAll window mainGUI webkit-0.12.3/demo/Makefile0000644000000000000000000000026011633370412013632 0ustar0000000000000000 PROGS = webkit SOURCES = Webkit.hs all : $(PROGS) webkit : Webkit.hs $(HC) --make $< -o $@ $(HCFLAGS) clean: rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) HC=ghc