@@ -96,8 +96,9 @@ xform = map buildPython . dependencyOrder
9696 globals = [mkDict " _events" , mkDict " _errors" ]
9797 name = xheader_header header
9898 add = [mkAddExt header]
99- parts <- mapM (processXDecl name) $ xheader_decls header
100- let (requests, decls) = collectBindings parts
99+ partsList <- mapM (processXDecl name) $ xheader_decls header
100+ let parts = concat partsList
101+ (requests, decls) = collectBindings parts
101102 ext = if length requests > 0
102103 then [mkClass (name ++ " Extension" ) " xcffib.Extension" requests]
103104 else []
@@ -674,18 +675,18 @@ mkSyntheticMethod membs = do
674675
675676processXDecl :: String
676677 -> XDecl
677- -> State TypeInfoMap BindingPart
678+ -> State TypeInfoMap [ BindingPart ]
678679processXDecl ext (XTypeDef name typ) =
679680 do modify $ \ m -> mkModify ext name (m M. ! typ) m
680- return Noop
681+ return [ Noop ]
681682processXDecl ext (XidType name) =
682683 -- http://www.markwitmer.com/guile-xcb/doc/guile-xcb/XIDs.html
683684 do modify $ mkModify ext name (BaseType " I" )
684- return Noop
685+ return [ Noop ]
685686processXDecl _ (XImport n) =
686- return $ Declaration [ mkRelImport n]
687+ return [ Declaration [ mkRelImport n] ]
687688processXDecl _ (XEnum name membs) =
688- return $ Declaration [mkEnum name $ xEnumElemsToPyEnum id membs]
689+ return [ Declaration [mkEnum name $ xEnumElemsToPyEnum id membs] ]
689690processXDecl ext (XStruct n _ membs) = do
690691 m <- get
691692 let (statements, len) = mkStructStyleUnpack " " ext m membs
@@ -696,7 +697,7 @@ processXDecl ext (XStruct n _ membs) = do
696697 let rhs = Int theLen
697698 return $ mkAssign " fixed_size" rhs
698699 modify $ mkModify ext n (CompositeType ext n)
699- return $ Declaration [mkXClass n " xcffib.Struct" False statements (pack : fixedLength ++ synthetic)]
700+ return [ Declaration [mkXClass n " xcffib.Struct" False statements (pack : fixedLength ++ synthetic)] ]
700701processXDecl ext (XEvent name opcode _ xge membs noSequence) = do
701702 m <- get
702703 let cname = name ++ " Event"
@@ -707,9 +708,9 @@ processXDecl ext (XEvent name opcode _ xge membs noSequence) = do
707708 eventsUpd = mkDictUpdate " _events" opcode cname
708709 isxge = fromMaybe False xge
709710 -- xgeexp = mkAssign "xge" (if fromMaybe False xge then (mkName "True") else (mkName "False"))
710- return $ Declaration [ mkXClass cname " xcffib.Event" isxge statements (pack : synthetic)
711+ return [ Declaration [ mkXClass cname " xcffib.Event" isxge statements (pack : synthetic)
711712 , eventsUpd
712- ]
713+ ]]
713714processXDecl ext (XError name opcode _ membs) = do
714715 m <- get
715716 let cname = name ++ " Error"
@@ -718,10 +719,10 @@ processXDecl ext (XError name opcode _ membs) = do
718719 (statements, _) = mkStructStyleUnpack prefix ext m membs
719720 errorsUpd = mkDictUpdate " _errors" opcode cname
720721 alias = mkAssign (" Bad" ++ name) (mkName cname)
721- return $ Declaration [ mkXClass cname " xcffib.Error" False statements [pack]
722+ return [ Declaration [ mkXClass cname " xcffib.Error" False statements [pack]
722723 , alias
723724 , errorsUpd
724- ]
725+ ]]
725726processXDecl ext (XRequest name opcode _ membs reply) = do
726727 m <- get
727728 let
@@ -756,7 +757,13 @@ processXDecl ext (XRequest name opcode _ membs reply) = do
756757 ++ [argChecked])
757758 requestBody = buf ++ packStmts ++ [ret]
758759 request = mkMethod name allArgs requestBody
759- return $ Request request replyDecl
760+ baseArgs = (" self" : (filter (not . null ) args))
761+ checkedMethod = mkMethod (name ++ " Checked" ) baseArgs
762+ [mkReturn $ mkCall (" self." ++ name) (map mkName (tail baseArgs) ++ [mkName " is_checked=True" ])]
763+ uncheckedMethod = mkMethod (name ++ " Unchecked" ) baseArgs
764+ [mkReturn $ mkCall (" self." ++ name) (map mkName (tail baseArgs) ++ [mkName " is_checked=False" ])]
765+
766+ return [Request request replyDecl, Request checkedMethod [] , Request uncheckedMethod [] ]
760767processXDecl ext (XUnion name _ membs) = do
761768 m <- get
762769 let unpackF = structElemToPyUnpack unpackerCopy ext m
@@ -772,7 +779,7 @@ processXDecl ext (XUnion name _ membs) = do
772779 pack = mkPackMethod ext name m Nothing [head membs] Nothing
773780 decl = [mkXClass name " xcffib.Union" False initMethodStmts [pack]]
774781 modify $ mkModify ext name (CompositeType ext name)
775- return $ Declaration decl
782+ return [ Declaration decl]
776783 where
777784 unpackerCopy = mkCall " unpacker.copy" []
778785 mkUnionUnpack :: (Maybe String , String )
@@ -788,7 +795,7 @@ processXDecl ext (XUnion name _ membs) = do
788795processXDecl ext (XidUnion name _) =
789796 -- These are always unions of only XIDs.
790797 do modify $ mkModify ext name (BaseType " I" )
791- return Noop
798+ return [ Noop ]
792799
793800-- EventStruct basically describes a set of possible events that could be
794801-- represented by this one member. Slated to land in 1.13, it is only used in
@@ -803,7 +810,7 @@ processXDecl ext (XidUnion name _) =
803810-- again.
804811processXDecl ext (XEventStruct name _) = do
805812 modify $ mkModify ext name (CompositeType ext name)
806- return $ Declaration $ [mkXClass name " xcffib.Buffer" False [] [] ]
813+ return [ Declaration $ [mkXClass name " xcffib.Buffer" False [] [] ]]
807814
808815mkVersion :: XHeader -> Suite
809816mkVersion header =
0 commit comments