gtk2hs-buildtools 0.12.5.2 → 0.13.0.0
raw patch · 5 files changed
+49/−19 lines, 5 files
Files
- c2hs/c/CParser.y +6/−2
- c2hs/toplevel/Version.hs +1/−1
- callbackGen/HookGenerator.hs +38/−13
- callbackGen/Signal.chs.template +3/−2
- gtk2hs-buildtools.cabal +1/−1
c2hs/c/CParser.y view
@@ -1814,9 +1814,13 @@ attribute_params :: { () } attribute_params- : constant_expression { () }- | attribute_params ',' constant_expression { () }+ : attribute_param { () }+ | attribute_params ',' attribute_param { () } +attribute_param :: { () }+attribute_param+ : constant_expression { () }+ | ident '=' cfloat { () } {
c2hs/toplevel/Version.hs view
@@ -6,7 +6,7 @@ -- idstr = "$Id: Version.hs,v 1.1 2012/05/27 16:49:07 dmwit Exp $" name = "C->Haskell Compiler"-versnum = "0.13.9 (gtk2hs branch)"+versnum = "0.13.10 (gtk2hs branch)" versnick = "\"Bin IO\"" date = "27 May 2012" version = name ++ ", version " ++ versnum ++ " " ++ versnick ++ ", " ++ date
callbackGen/HookGenerator.hs view
@@ -26,7 +26,9 @@ | Tfloat | Tdouble | Tstring- | Tmstring + | Tmstring+ | Tgstring+ | Tmgstring | Tboxed -- a struct which is passed by value | Tptr -- pointer | Ttobject -- foreign with WidgetClass context@@ -41,7 +43,7 @@ ------------------------------------------------------------------------------- -- Parsing -------------------------------------------------------------------------------- + parseSignatures :: String -> Signatures parseSignatures content = (nub.parseSig 1.scan) content @@ -75,7 +77,7 @@ let (args,rem') = parseArg l rem in (ty:args, rem') parseArg l rem = error ("parse error on line "++show l++": expected type"++- " followed by comma or EOL, found\n "++ + " followed by comma or EOL, found\n "++ concatMap show (take 5 rem)) scan :: String -> [Token]@@ -100,6 +102,8 @@ scan ('D':'O':'U':'B':'L':'E':xs) = TokType Tdouble:scan xs scan ('S':'T':'R':'I':'N':'G':xs) = TokType Tstring:scan xs scan ('M':'S':'T':'R':'I':'N':'G':xs) = TokType Tmstring:scan xs+scan ('G':'L':'I':'B':'S':'T':'R':'I':'N':'G':xs) = TokType Tgstring:scan xs+scan ('M':'G':'L':'I':'B':'S':'T':'R':'I':'N':'G':xs) = TokType Tmgstring:scan xs scan ('B':'O':'X':'E':'D':xs) = TokType Tboxed:scan xs scan ('P':'O':'I':'N':'T':'E':'R':xs) = TokType Tptr:scan xs scan ('T':'O':'B':'J':'E':'C':'T':xs) = TokType Ttobject:scan xs@@ -141,6 +145,8 @@ identifier Tdouble = ss "DOUBLE" identifier Tstring = ss "STRING" identifier Tmstring = ss "MSTRING"+identifier Tgstring = ss "GLIBSTRING"+identifier Tmgstring = ss "MGLIBSTRING" identifier Tboxed = ss "BOXED" identifier Tptr = ss "PTR" identifier Ttobject = ss "OBJECT"@@ -166,6 +172,8 @@ rawtype Tdouble = ss "Double" rawtype Tstring = ss "CString" rawtype Tmstring = ss "CString"+rawtype Tgstring = ss "CString"+rawtype Tmgstring = ss "CString" rawtype Tboxed = ss "Ptr ()" rawtype Tptr = ss "Ptr ()" rawtype Ttobject = ss "Ptr GObject"@@ -192,6 +200,8 @@ rawtype Tdouble = ss "{#type gdouble#}" rawtype Tstring = ss "CString" rawtype Tmstring = ss "CString"+rawtype Tgstring = ss "CString"+rawtype Tmgstring = ss "CString" rawtype Tboxed = ss "Ptr ()" rawtype Tptr = ss "Ptr ()" rawtype Ttobject = ss "Ptr GObject"@@ -201,13 +211,13 @@ #endif --- The possibly polymorphic type which +-- The possibly polymorphic type which usertype :: Types -> [Char] -> (ShowS,[Char]) usertype Tunit cs = (ss "()",cs) usertype Tbool (c:cs) = (ss "Bool",cs) usertype Tchar (c:cs) = (ss "Char",cs) usertype Tuchar (c:cs) = (ss "Char",cs)-usertype Tint (c:cs) = (ss "Int",cs) +usertype Tint (c:cs) = (ss "Int",cs) usertype Tuint (c:cs) = (ss "Word",cs) usertype Tlong (c:cs) = (ss "Int",cs) usertype Tulong (c:cs) = (ss "Int",cs)@@ -217,6 +227,8 @@ usertype Tdouble (c:cs) = (ss "Double",cs) usertype Tstring (c:cs) = (ss "String",cs) usertype Tmstring (c:cs) = (ss "Maybe String",cs)+usertype Tgstring (c:cs) = (sc c.sc '\'',cs)+usertype Tmgstring (c:cs) = (ss "Maybe ".sc c.sc '\'',cs) usertype Tboxed (c:cs) = (sc c,cs) usertype Tptr (c:cs) = (ss "Ptr ".sc c,cs) usertype Ttobject (c:cs) = (sc c.sc '\'',cs)@@ -237,6 +249,8 @@ context (Tmtobject:ts) (c:cs) = ss "GObjectClass ".sc c.sc '\'': context ts cs context (Tobject:ts) (c:cs) = ss "GObjectClass ".sc c.sc '\'': context ts cs context (Tmobject:ts) (c:cs) = ss "GObjectClass ".sc c.sc '\'': context ts cs+context (Tgstring:ts) (c:cs) = ss "Glib.GlibString ".sc c.sc '\'': context ts cs+context (Tmgstring:ts) (c:cs) = ss "Glib.GlibString ".sc c.sc '\'': context ts cs context (_:ts) (c:cs) = context ts cs context [] _ = [] @@ -278,6 +292,8 @@ nameArg Tdouble c = ss "double".shows c nameArg Tstring c = ss "str".shows c nameArg Tmstring c = ss "str".shows c+nameArg Tgstring c = ss "str".shows c+nameArg Tmgstring c = ss "str".shows c nameArg Tboxed c = ss "box".shows c nameArg Tptr c = ss "ptr".shows c nameArg Ttobject c = ss "obj".shows c@@ -307,6 +323,10 @@ body. sc ' '. arg. sc '\'' marshExec Tmstring arg _ body = indent 5. ss "maybePeekUTFString ". arg. ss " >>= \\". arg. ss "\' ->". body. sc ' '. arg. sc '\''+marshExec Tgstring arg _ body = indent 5. ss "peekUTFString ". arg. ss " >>= \\". arg. ss "\' ->".+ body. sc ' '. arg. sc '\''+marshExec Tmgstring arg _ body = indent 5. ss "maybePeekUTFString ". arg. ss " >>= \\". arg. ss "\' ->".+ body. sc ' '. arg. sc '\'' marshExec Tboxed arg n body = indent 5. ss "boxedPre". ss (show n). ss " (castPtr ". arg. ss ") >>= \\". arg. ss "\' ->". body. sc ' '. arg. sc '\'' marshExec Tptr arg _ body = body. ss " (castPtr ". arg. sc ')'@@ -331,6 +351,7 @@ marshRet Tfloat body = body marshRet Tdouble body = body marshRet Tstring body = body. indent 5. ss ">>= newUTFString"+marshRet Tgstring body = body. indent 5. ss ">>= newUTFString" marshRet Tptr body = indent 5. ss "liftM castPtr $ ". body marshRet _ _ = error "Signal handlers cannot return structured types." @@ -363,6 +384,10 @@ ss "' <- peekCString str".shows n marshExec Tmstring n = indent 4.ss "str".shows n. ss "' <- maybePeekCString str".shows n+marshExec Tgstring n = indent 4.ss "str".shows n.+ ss "' <- peekCString str".shows n+marshExec Tmgstring n = indent 4.ss "str".shows n.+ ss "' <- maybePeekCString str".shows n marshExec Tboxed n = indent 4.ss "box".shows n.ss "' <- boxedPre". shows n.ss " $ castPtr box".shows n marshExec Tptr n = indent 4.ss "let ptr".shows n.ss "' = castPtr ptr".@@ -399,7 +424,7 @@ mkUserType :: Signature -> ShowS mkUserType (ret,ts) = let- (str,cs) = foldl (\(str,cs) t -> + (str,cs) = foldl (\(str,cs) t -> let (str',cs') = usertype t cs in (str.str'.ss " -> ",cs')) (sc '(',['a'..]) ts (str',_) = usertype ret cs@@ -413,7 +438,7 @@ mkMarshType :: Signature -> [ShowS] mkMarshType (ret,ts) = marshType (ts++[ret]) ['a'..]- + mkType sig = let types = mkMarshType sig in if null types then id else foldl (.) (indent 1) types @@ -433,7 +458,7 @@ #else mkMarshExec :: Signature -> ShowS-mkMarshExec (_,ts) = foldl (.) id $ +mkMarshExec (_,ts) = foldl (.) id $ zipWith marshExec ts [1..] #endif@@ -444,7 +469,7 @@ ss "__".identifier ret mkRawtype :: Signature -> ShowS-mkRawtype (ret,ts) = +mkRawtype (ret,ts) = foldl (.) id (map (\ty -> rawtype ty.ss " -> ") ts). (case ret of Tboxed -> ss "IO (".rawtype ret.sc ')'@@ -456,13 +481,13 @@ _ -> ss "IO ".rawtype ret) mkLambdaArgs :: Signature -> ShowS-mkLambdaArgs (_,ts) = foldl (.) id $ +mkLambdaArgs (_,ts) = foldl (.) id $ zipWith (\a b -> nameArg a b.sc ' ') ts [1..] #ifndef USE_GCLOSURE_SIGNALS_IMPL mkFuncArgs :: Signature -> ShowS-mkFuncArgs (_,ts) = foldl (.) id $ +mkFuncArgs (_,ts) = foldl (.) id $ zipWith (\a b -> sc ' '.nameArg a b.sc '\'') ts [1..] mkMarshRet :: Signature -> ShowS@@ -511,11 +536,11 @@ "MODULE_EXPORTS" -> genExport sigs "MODULE_IMPORTS" -> genImports extraImports "MODULE_BODY" -> foldl (.) id (map generate sigs)- _ -> error var + _ -> error var ) "" templateSubstitute :: String -> (String -> ShowS) -> ShowS-templateSubstitute template varSubst = doSubst template +templateSubstitute template varSubst = doSubst template where doSubst [] = id doSubst ('\\':'@':cs) = sc '@' . doSubst cs doSubst ('@':cs) = let (var,_:cs') = span ('@'/=) cs
callbackGen/Signal.chs.template view
@@ -28,7 +28,7 @@ -- 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 +-- 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@@ -47,9 +47,10 @@ import System.Glib.FFI import System.Glib.UTFString (peekUTFString,maybePeekUTFString)+import qualified System.Glib.UTFString as Glib import System.Glib.GError (failOnGError) {#import System.Glib.Signals#}-{#import System.Glib.GObject#} +{#import System.Glib.GObject#} @MODULE_IMPORTS@ {#context lib="gtk" prefix="gtk" #}
gtk2hs-buildtools.cabal view
@@ -1,5 +1,5 @@ Name: gtk2hs-buildtools-Version: 0.12.5.2+Version: 0.13.0.0 License: GPL-2 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team