gtk2hs-commit — Mailing list for Darcs commit messages.

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Scrolling ScrolledWindow.chs,1.4,1.5

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Scrolling
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30354/gtk/Graphics/UI/Gtk/Scrolling

Modified Files:
	ScrolledWindow.chs 
Log Message:
Add properties.

For the first round, just the easy properties that are implemented in terms
of existing getter/setter functions and where there are no issues with
NULL/Maybe types.

Add Attributes file to glib package and modify Makefile.am accordingly.


Index: ScrolledWindow.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Scrolling/ScrolledWindow.chs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- ScrolledWindow.chs	25 Feb 2005 22:53:43 -0000	1.4
+++ ScrolledWindow.chs	13 Mar 2005 19:34:37 -0000	1.5
@@ -96,12 +96,19 @@
   scrolledWindowGetShadowType,
   scrolledWindowSetHAdjustment,
   scrolledWindowSetVAdjustment,
+
+-- * Properties
+  scrolledWindowHAdjustment,
+  scrolledWindowVAdjustment,
+  scrolledWindowShadowType,
+  scrolledWindowPlacement
   ) where
 
 import Monad	(liftM)
 import Maybe    (fromMaybe)
 
 import System.Glib.FFI
+import System.Glib.Attributes		(Attr(..))
 import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
 {#import Graphics.UI.Gtk.Types#}
 {#import Graphics.UI.Gtk.Signals#}
@@ -207,4 +214,36 @@
 scrolledWindowSetVAdjustment w adj = {#call scrolled_window_set_vadjustment#}
   (toScrolledWindow w) adj
 
+--------------------
+-- Properties
+
+-- | The 'Adjustment' for the horizontal position.
+--
+scrolledWindowHAdjustment :: Attr ScrolledWindow Adjustment
+scrolledWindowHAdjustment = Attr 
+  scrolledWindowGetHAdjustment
+  scrolledWindowSetHAdjustment
 
+-- | The 'Adjustment' for the vertical position.
+--
+scrolledWindowVAdjustment :: Attr ScrolledWindow Adjustment
+scrolledWindowVAdjustment = Attr 
+  scrolledWindowGetVAdjustment
+  scrolledWindowSetVAdjustment
+
+-- | Style of bevel around the contents.
+--
+-- Default value: 'ShadowNone'
+--
+scrolledWindowShadowType :: Attr ScrolledWindow ShadowType
+scrolledWindowShadowType = Attr 
+  scrolledWindowGetShadowType
+  scrolledWindowSetShadowType
+
+-- | \'placement\' property. See 'scrolledWindowGetPlacement' and
+-- 'scrolledWindowSetPlacement'
+--
+scrolledWindowPlacement :: Attr ScrolledWindow CornerType
+scrolledWindowPlacement = Attr 
+  scrolledWindowGetPlacement
+  scrolledWindowSetPlacement

[Gtk2hs-commit] gtk2hs/glib/System/Glib Attributes.hs,NONE,1.1

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/glib/System/Glib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30354/glib/System/Glib

Added Files:
	Attributes.hs 
Log Message:
Add properties.

For the first round, just the easy properties that are implemented in terms
of existing getter/setter functions and where there are no issues with
NULL/Maybe types.

Add Attributes file to glib package and modify Makefile.am accordingly.


--- NEW FILE: Attributes.hs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Attributes interface
--
--  Author : Duncan Coutts
--
--  Created: 21 January 2005
--
--  Copyright (C) 2005 Duncan Coutts
--
--  Partially derived from the hs-fltk and wxHaskell projects which
--  are both under LGPL compatible licenses.
--
--  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  : gtk...@li...
-- Stability   : provisional
-- Portability : non-portable (uses Gtk+ C library)
--
-- |
--
module System.Glib.Attributes where

-- | Object attributes can be get and set.
data Attr w a = Attr (w -> IO a) (w -> a -> IO ())

[Gtk2hs-commit] gtk2hs/tools/apiGen CodeGen.hs,1.12,1.13

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31503/tools/apiGen

Modified Files:
	CodeGen.hs 
Log Message:
Prefix property names with their object.
Make sure all properties are in the export list.


Index: CodeGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v
retrieving revision 1.12
retrieving revision 1.13
diff -u -d -r1.12 -r1.13
--- CodeGen.hs	4 Mar 2005 22:21:35 -0000	1.12
+++ CodeGen.hs	6 Mar 2005 17:50:46 -0000	1.13
@@ -210,44 +210,47 @@
     method_deprecated = False
   }  
 
-properties :: Object -> [PropDoc] -> [(Property, Maybe PropDoc)]
+properties :: Object -> [PropDoc] -> [(Either Property (Method, Method), Maybe PropDoc)]
 properties object docs =
-  [ (property, property_cname property `lookup` docmap)
-  | property <- object_properties object ]
-  where docmap = [ (map dashToUnderscore (propdoc_name doc), doc)
-                 | doc <- docs ]
-        dashToUnderscore '-' = '_'
-        dashToUnderscore  c  =  c
-
-genProperties :: KnownSymbols -> Object -> [PropDoc] -> [(ShowS, (Since, Deprecated))]
-genProperties knownSymbols object apiDoc = 
   map snd $
   sortBy (comparing fst) $    --sort into the order as they appear in the gtk-docs
+    [ (maxBound :: Int
+      ,(Right methods
+       ,Just $ extraPropDocumentation getter setter))
+    | methods@(getter, setter) <- extraProps ]
 
-    [ (0
-      ,let doc = extraPropDocumentation getter setter in
-       (genAtterFromGetterSetter knownSymbols object getter setter (Just doc)
-      ,(propdoc_since doc, notDeprecated)))
-    | (getter, setter) <- extraProps ]
-
- ++ [ (index
-      ,(genAtterFromGetterSetter knownSymbols object getter setter doc
-      ,(maybe "" propdoc_since doc, notDeprecated)))
-    | (((_, doc), index), (getter, setter)) <- directProps ]
+ ++ [ (index :: Int
+      ,(Right (getter, setter)
+       ,lookup (property_cname property) docmap))
+    | ((property, index), (getter, setter)) <- directProps ]
 
- ++ [ (index
-      ,(genAtterFromProperty knownSymbols object property doc
-      ,(maybe "" propdoc_since doc, notDeprecated)))
-    | ((property, doc), index) <- genericProps ]
+ ++ [ (index :: Int
+      ,(Left property
+       ,lookup (property_cname property) docmap))
+    | (property, index) <- genericProps ]
 
-  where (genericProps, -- existing GObject properties with generic implementation
+  where docmap = [ (map dashToUnderscore (propdoc_name doc), doc)
+                 | doc <- docs ]
+        dashToUnderscore '-' = '_'
+        dashToUnderscore  c  =  c
+        
+        (genericProps, -- existing GObject properties with generic implementation
          directProps,  -- existing GObject properties but with direct implementation
          extraProps)   -- extra properties with direct implementation
-          = mergeBy (\((prop,_), _) (method, _) ->
+          = mergeBy (\(prop, _) (method, _) ->
                       property_name prop `compare` drop 3 (method_name method))
-                    (sortBy (comparing (property_name.fst.fst)) (zip (properties object apiDoc) [1..]))
+                    (sortBy (comparing (property_name.fst)) (zip (object_properties object) [1..]))
                     (sortBy (comparing (method_name.fst)) (methodsThatLookLikeProperties object))
 
+genProperties :: KnownSymbols -> Object -> [PropDoc] -> [(ShowS, (Since, Deprecated))]
+genProperties knownSymbols object apiDoc = 
+  [ let implementation = case property of
+          Left property          -> genAtterFromProperty knownSymbols object property doc
+          Right (getter, setter) -> genAtterFromGetterSetter knownSymbols object getter setter doc
+     in (implementation
+        ,(maybe "" propdoc_since doc, notDeprecated))
+  | (property, doc) <- properties object apiDoc ]
+
 extraPropDocumentation :: Method -> Method -> PropDoc
 extraPropDocumentation getter setter =
   let propertyName = lowerCaseFirstChar (drop 3 (method_name getter)) in
@@ -275,7 +278,7 @@
 genAtterFromProperty knownSymbols object property doc = 
   genAtter knownSymbols object doc propertyName propertyType (getter "") (setter "")
 
-  where propertyName = lowerCaseFirstChar (property_name property)
+  where propertyName = lowerCaseFirstChar (object_name object ++ property_name property)
         (propertyType, gvalueConstructor) = genMarshalProperty knownSymbols (property_type property)
         getter = ss "(\\obj -> do ". ss gvalueConstructor. ss " result <- objectGetProperty \"". ss (property_cname property). ss "\"".
                  indent 7. ss "return result)"
@@ -286,7 +289,7 @@
   genAtter knownSymbols object doc propertyName propertyType getter setter
 
   where --propertyName = cFuncNameToHsPropName (method_cname getterMethod)
-        propertyName = lowerCaseFirstChar (drop 3 (method_name getterMethod))
+        propertyName = lowerCaseFirstChar (object_name object ++ drop 3 (method_name getterMethod))
         (propertyType, _) = genMarshalResult knownSymbols (method_cname getterMethod)
                               (method_return_type getterMethod)
         getter = cFuncNameToHsName (method_cname getterMethod)
@@ -441,7 +444,8 @@
      | (method, doc, _) <- methods object (moduledoc_functions docs)
                              (module_methods modInfo) False]
   ++ sectionHeader "Properties"
-     [ (ss "  ". ss (lowerCaseFirstChar (property_name property)). sc ','
+     [ (let propertyName = either property_name (drop 3.method_name.fst) property in
+        ss "  ". ss (lowerCaseFirstChar (object_name object ++ propertyName)). sc ','
        ,(maybe "" propdoc_since doc, notDeprecated))
      | (property, doc) <- properties object (moduledoc_properties docs)]
   ++ (sectionHeader "Signals"

[Gtk2hs-commit] gtk2hs ChangeLog,1.378,1.379

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv31503

Modified Files:
	ChangeLog 
Log Message:
Prefix property names with their object.
Make sure all properties are in the export list.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.378
retrieving revision 1.379
diff -u -d -r1.378 -r1.379
--- ChangeLog	4 Mar 2005 22:21:35 -0000	1.378
+++ ChangeLog	6 Mar 2005 17:50:45 -0000	1.379
@@ -1,3 +1,8 @@
+2005-03-06 Duncan Coutts <du...@co...>
+
+	* tools/apiGen/CodeGen.hs: Prefix property names with their object.
+	Make sure all properties are in the export list.
+
 2005-03-04 Duncan Coutts <du...@co...>
 
 	* Makefile.am: Fix one of the GHC 6.4 build failures by changing the

[Gtk2hs-commit] gtk2hs/tools/apiGen ApiGen.hs,1.19,1.20 ModuleScan.hs,1.4,1.5 CodeGen.hs,1.11,1.12 Marshal.hs,1.7,1.8

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3685/tools/apiGen

Modified Files:
	ApiGen.hs ModuleScan.hs CodeGen.hs Marshal.hs 
Log Message:
ApiGen.hs: remove pointless and verbose warnings.

ModuleScan.hs: collect export list from existing modules.

CodeGen.hs: generate signals and methods export lists in the same order as in
	the original modules. Also, improve the signal code generaton - though
	it's still not quite there yet for object types.

Marshal.hs: For signals, produce the Haskell type as well as the signal
	handler tag. For object types this is not right yet because it uses
	the object type rather than the object class.
	Also change the marshaling of object parameter types to cover all four
	possibilities of: (leaf class/non-leaf class) x (ordinary/maybe type).


Index: Marshal.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Marshal.hs,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- Marshal.hs	27 Feb 2005 20:02:16 -0000	1.7
+++ Marshal.hs	4 Mar 2005 22:21:35 -0000	1.8
@@ -113,18 +113,23 @@
            && last typeName' == '*'
            && last typeName /= '*'
            && symbolIsObject typeKind =
-	if leafClass typeName
-          then (Nothing, Just shortTypeName,
-               \body -> body.
-                        indent 2. ss name)
-        else if maybeNullParameter funcName name
-          then (Just $ shortTypeName ++ "Class " ++ name, Just ("Maybe " ++ name),
-               \body -> body.
-                        indent 2. ss "(maybe (". ss shortTypeName. ss " nullForeignPtr) to".
-                                                  ss shortTypeName. sc ' '. ss name. ss ")")
-          else (Just $ shortTypeName ++ "Class " ++ name, Just name,
-               \body -> body.
-                        indent 2. ss "(to". ss shortTypeName. sc ' '. ss name. ss ")")
+  let classContext
+        | leafClass typeName = Nothing
+        | otherwise          = Just $ shortTypeName ++ "Class " ++ name
+      argType = Just $ (if maybeNullParameter funcName name then "Maybe " else "")
+                    ++ (if leafClass typeName then shortTypeName else name)
+      implementation
+        | leafClass typeName && maybeNullParameter funcName name
+                             = ss "(fromMaybe (". ss shortTypeName. ss " nullForeignPtr) ".
+                                                  ss name. ss ")"
+        | leafClass typeName = ss name
+        | maybeNullParameter funcName name
+                             = ss "(maybe (". ss shortTypeName. ss " nullForeignPtr) to".
+                                              ss shortTypeName. sc ' '. ss name. sc ')'
+        | otherwise          = ss "(to". ss shortTypeName. sc ' '. ss name. sc ')'
+   in (classContext, argType,
+      \body -> body.
+               indent 2. implementation)
   where typeName = init typeName'
         shortTypeName = stripKnownPrefixes typeName
         typeKind = lookupFM knownSymbols typeName
@@ -288,32 +293,33 @@
 
 genMarshalProperty _ unknown = ("{-" ++ unknown ++ "-}", "{-" ++ unknown ++ "-}")
 
--- Takes the type string and returns the signal marshaing category
+-- Takes the type string and returns the signal marshaing category and the
+-- Haskell type
 --
-convertSignalType :: KnownSymbols -> String -> String
-convertSignalType _ "void"     = "NONE"
-convertSignalType _ "gchar"    = "CHAR"
-convertSignalType _ "guchar"   = "UCHAR"
-convertSignalType _ "gboolean" = "BOOLEAN"
-convertSignalType _ "gint"     = "INT"
-convertSignalType _ "guint"    = "UINT"
-convertSignalType _ "glong"    = "LONG"
-convertSignalType _ "gulong"   = "ULONG"
-convertSignalType _ "gfloat"   = "FLOAT"
-convertSignalType _ "gdouble"  = "DOUBLE"
-convertSignalType _ "gchar*"   = "STRING"
-convertSignalType _ "const-gchar*" = "STRING"
+convertSignalType :: KnownSymbols -> String -> (String, String)
+convertSignalType _ "void"     = ("NONE",   "()")
+convertSignalType _ "gchar"    = ("CHAR",   "Char")
+convertSignalType _ "guchar"   = ("UCHAR",  "Char")
+convertSignalType _ "gboolean" = ("BOOL",   "Bool")
+convertSignalType _ "gint"     = ("INT",    "Int")
+convertSignalType _ "guint"    = ("UINT",   "Int")
+convertSignalType _ "glong"    = ("LONG",   "Int")
+convertSignalType _ "gulong"   = ("ULONG",  "Int")
+convertSignalType _ "gfloat"   = ("FLOAT",  "Float")
+convertSignalType _ "gdouble"  = ("DOUBLE", "Double")
+convertSignalType _ "gchar*"   = ("STRING", "String")
+convertSignalType _ "const-gchar*" = ("STRING", "String")
 convertSignalType knownSymbols typeName
-  | symbolIsEnum   typeKind    = "ENUM"
-  | symbolIsFlags  typeKind    = "FLAGS"
+  | symbolIsEnum   typeKind    = ("ENUM",  stripKnownPrefixes typeName)
+  | symbolIsFlags  typeKind    = ("FLAGS", stripKnownPrefixes typeName)
   where typeKind = lookupFM knownSymbols typeName
 convertSignalType knownSymbols typeName@(_:_)
     | last typeName == '*'
-   && symbolIsBoxed  typeKind  = "BOXED"
+   && symbolIsBoxed  typeKind  = ("BOXED",  stripKnownPrefixes (init typeName))
     | last typeName == '*'
-   && symbolIsObject typeKind  = "OBJECT"
+   && symbolIsObject typeKind  = ("OBJECT", stripKnownPrefixes (init typeName))
   where typeKind = lookupFM knownSymbols (init typeName)
-convertSignalType _ typeName   =  "{-" ++ typeName ++ "-}"
+convertSignalType _ typeName   =  ("{-" ++ typeName ++ "-}", "{-" ++ typeName ++ "-}")
 
 -------------------------------------------------------------------------------
 -- Now for some special cases, we can override the generation of {# call #}'s

Index: CodeGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- CodeGen.hs	1 Mar 2005 21:20:44 -0000	1.11
+++ CodeGen.hs	4 Mar 2005 22:21:35 -0000	1.12
@@ -17,7 +17,7 @@
 
 import Prelude hiding (Enum, lines)
 import List   (groupBy, sortBy, isPrefixOf, isSuffixOf, partition, find)
-import Maybe  (isNothing)
+import Maybe  (isNothing, fromMaybe)
 import Data.FiniteMap
 
 import Debug.Trace (trace)
@@ -339,19 +339,24 @@
 genSignal :: KnownSymbols -> Object -> Signal -> Maybe SignalDoc -> ShowS
 genSignal knownSymbols object signal doc = 
   formattedDoc.
-  ss "on". signalName. ss ", after". signalName. ss " :: ". nl.
-  ss "on".    signalName. ss " = connect_". connectType. sc ' '. signalCName. ss " False". nl.
-  ss "after". signalName. ss " = connect_". connectType. sc ' '. signalCName. ss " True". nl
+  ss "on". signalName. ss ", after". signalName. ss " :: ". signalType.
+  ss "on".    signalName. ss " = connect_". connectCall. sc ' '. signalCName. ss " False". nl.
+  ss "after". signalName. ss " = connect_". connectCall. sc ' '. signalCName. ss " True"
 
-  where connectType = sepBy "_" paramTypes . ss "__" . ss returnType
+  where connectCall = let paramCategories' = if null paramCategories then ["NONE"] else paramCategories
+                       in sepBy "_" paramCategories' . ss "__" . ss returnCategory
         -- strip off the object arg to the signal handler
         params = case signal_parameters signal of
                    (param:params) | parameter_type param == object_cname object ++ "*" -> params
                    params -> params
-        paramTypes | null params = ["NONE"]
-                   | otherwise = [ convertSignalType knownSymbols (parameter_type parameter)
-                                 | parameter <- params ]
-        returnType = convertSignalType knownSymbols (signal_return_type signal)
+        (paramCategories, paramTypes) = unzip [ convertSignalType knownSymbols (parameter_type parameter)
+                                              | parameter <- params ]
+        (returnCategory, returnType) = convertSignalType knownSymbols (signal_return_type signal)
+        signalType = ss (object_name object). ss "Class self => self\n".
+                     ss " -> ". (if null paramTypes
+                                  then ss "IO ". ss returnType
+                                  else sc '('. sepBy " -> " (paramTypes ++ ["IO " ++ returnType]). sc ')').
+                     ss "\n -> IO (ConnectId self)\n"
         signalName = ss (toStudlyCaps . canonicalSignalName . signal_cname $ signal)
         signalCName = sc '"'. ss (signal_cname signal). sc '"'
         formattedDoc = haddocFormatDeclaration knownSymbols False signaldoc_paragraphs doc
@@ -416,9 +421,9 @@
 
 genExports :: Object -> ModuleDoc -> ModuleInfo -> ShowS
 genExports object docs modInfo =
-  doVersionIfDefs lines $
-  map adjustDeprecatedAndSinceVersion $
-     [(ss "-- * Types", defaultAttrs)
+    doVersionIfDefs lines
+  . map adjustDeprecatedAndSinceVersion
+  $  [(ss "-- * Types", defaultAttrs)
      ,(ss "  ".ss (object_name object).sc ',', defaultAttrs)
      ,(ss "  ".ss (object_name object).ss "Class,", defaultAttrs)
      ,(ss "  ".ss "castTo".ss (object_name object).sc ',', defaultAttrs)] 
@@ -426,20 +431,27 @@
      [ (ss "  ". ss (cFuncNameToHsName (method_cname constructor)). sc ','
        ,(maybe "" funcdoc_since doc, notDeprecated))
      | (constructor, doc, _) <- constructors object (moduledoc_functions docs) []]
-  ++ sectionHeader "Methods"
-     [ (ss "  ". ss (cFuncNameToHsName (method_cname method)). sc ','
+  ++ (sectionHeader "Methods"
+    . map fst
+    . sortBy (comparing snd))
+     [ let functionName = cFuncNameToHsName (method_cname method) in
+       ((ss "  ". ss functionName. sc ','
        ,(maybe "" funcdoc_since doc, method_deprecated method))
+       ,fromMaybe (maxBound::Int) (lookup functionName exportIndexMap))
      | (method, doc, _) <- methods object (moduledoc_functions docs)
                              (module_methods modInfo) False]
   ++ sectionHeader "Properties"
      [ (ss "  ". ss (lowerCaseFirstChar (property_name property)). sc ','
        ,(maybe "" propdoc_since doc, notDeprecated))
      | (property, doc) <- properties object (moduledoc_properties docs)]
-  ++ sectionHeader "Signals"
+  ++ (sectionHeader "Signals"
+    . map fst
+    . sortBy (comparing snd))
      [ let signalName = (toStudlyCaps . canonicalSignalName . signal_cname) signal in 
-       (ss "  on".    ss signalName. sc ','.nl.
+       ((ss "  on".    ss signalName. sc ','.nl.
         ss "  after". ss signalName. sc ','
        ,(maybe "" signaldoc_since doc, notDeprecated))
+       ,fromMaybe (maxBound::Int) (lookup ("on"++signalName) exportIndexMap))
      | (signal, doc) <- signals object (moduledoc_signals docs)]
 
   where defaultAttrs = ("", notDeprecated)
@@ -447,6 +459,7 @@
         sectionHeader name entries = (id, defaultAttrs):(ss "-- * ". ss name, defaultAttrs):entries
         adjustDeprecatedAndSinceVersion (doc, (since, deprecated)) =
           (doc, (moduledoc_since docs `max` since, object_deprecated object || deprecated))
+        exportIndexMap = zip (module_exports modInfo) [1..]
 
 genImports :: ModuleInfo -> ShowS
 genImports modInfo = 

Index: ApiGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- ApiGen.hs	1 Mar 2005 21:20:44 -0000	1.19
+++ ApiGen.hs	4 Mar 2005 22:21:35 -0000	1.20
@@ -140,9 +140,6 @@
               Just moduleInfo -> do mkDirHier outdir (splitOn '.' (module_prefix moduleInfo))
                                     return moduleInfo
               Nothing -> do
-                when (not (null moduleRoot) && not (object_deprecated object)) $
-                  putStrLn ("Warning: no existing module found for module "
-	                  ++ show (object_name object))
                 return ModuleInfo {
                     module_name              = object_name object,
                     module_prefix            = modPrefix,
@@ -152,6 +149,7 @@
                     module_created           = date,
                     module_copyright_dates   = Left year,
                     module_copyright_holders = ["[Insert your full name here]"],
+                    module_exports           = [],
                     module_imports           = [],
                     module_context_lib       = if null lib then namespace_library namespace else lib,
                     module_context_prefix    = if null prefix then namespace_library namespace else prefix,

Index: ModuleScan.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ModuleScan.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- ModuleScan.hs	25 Feb 2005 01:32:11 -0000	1.4
+++ ModuleScan.hs	4 Mar 2005 22:21:35 -0000	1.5
@@ -25,6 +25,7 @@
     module_copyright_dates   :: Either String (String, String),
                                 -- eg "2004" or "2004-2005"
     module_copyright_holders :: [String],
+    module_exports           :: [String],
     module_imports           :: [(String, String)], -- mod name and the whole line
     module_context_lib       :: String,
     module_context_prefix    :: String,
@@ -42,13 +43,23 @@
           | Created String
           | Copyright (Either String (String, String)) [String]
           | Module String String
+          | Export String
+          | ExportEnd
           | Import String String
           | Context String String
           | CCall MethodInfo
+  deriving Show
 
 usefulLine None = False
 usefulLine _    = True
 
+isModuleLine (Module _ _) = True
+isModuleLine _            = False
+isExportEndLine ExportEnd = True
+isExportEndLine _         = False
+isCCallLine (CCall _) = True
+isCCallLine _         = False
+
 main = do
   [path] <- getArgs
   modules <- findModules [] path
@@ -101,20 +112,27 @@
 
 scanModuleContent :: String -> String -> ModuleInfo
 scanModuleContent content filename =
-  let usefulLines = filter usefulLine [ scanLine line (tokenise line) | line <- lines content ] in
-  ModuleInfo {
-    module_name              = head $ [ name    | Module name prefix  <- usefulLines ] ++ [missing],
-    module_prefix            = head $ [ prefix  | Module name prefix  <- usefulLines ] ++ [missing],
+  let (headerLines, bodyLines) =
+         break isCCallLine
+       . filter usefulLine
+       $ [ scanLine line (tokenise line) | line <- lines content ]
+  in ModuleInfo {
+    module_name              = head $ [ name    | Module name prefix  <- headerLines ] ++ [missing],
+    module_prefix            = head $ [ prefix  | Module name prefix  <- headerLines ] ++ [missing],
     module_needspreproc      = ".chs.pp" `isSuffixOf` filename,
     module_filename          = "",
-    module_authors           = head $ [ authors | Authors authors     <- usefulLines ] ++ [[missing]],
-    module_created           = head $ [ created | Created created     <- usefulLines ] ++ [missing],
-    module_copyright_dates   = head $ [ dates   | Copyright dates _   <- usefulLines ] ++ [Left missing],
-    module_copyright_holders = head $ [ authors | Copyright _ authors <- usefulLines ] ++ [[missing]],
-    module_imports           = [ (name, line)   | Import name line    <- usefulLines ],
-    module_context_lib       = head $ [ lib     | Context lib prefix  <- usefulLines ] ++ [missing],
-    module_context_prefix    = head $ [ prefix  | Context lib prefix  <- usefulLines ] ++ [missing],
-    module_methods           =        [ call    | CCall call  <- usefulLines ]
+    module_authors           = head $ [ authors | Authors authors     <- headerLines ] ++ [[missing]],
+    module_created           = head $ [ created | Created created     <- headerLines ] ++ [missing],
+    module_copyright_dates   = head $ [ dates   | Copyright dates _   <- headerLines ] ++ [Left missing],
+    module_copyright_holders = head $ [ authors | Copyright _ authors <- headerLines ] ++ [[missing]],
+    module_exports           = let exportLines = takeWhile (not.isExportEndLine)
+                                               . dropWhile (not.isModuleLine)
+                                               $ headerLines
+                                in [ name       | Export name         <- exportLines ],
+    module_imports           = [ (name, line)   | Import name line    <- headerLines ],
+    module_context_lib       = head $ [ lib     | Context lib prefix  <- headerLines ] ++ [missing],
+    module_context_prefix    = head $ [ prefix  | Context lib prefix  <- headerLines ] ++ [missing],
+    module_methods           =        [ call    | CCall call  <- bodyLines ]
   }
   where missing = "{-missing-}"
 
@@ -128,10 +146,15 @@
 scanLine _ ("--":"Author":":":author)   = scanAuthor author
 scanLine _ ("--":"Created:":created)    = Created (unwords created)
 scanLine _ ("--":"Copyright":"(":c:")":copyright) = scanCopyright copyright
+scanLine (' ':' ':_) ("module":moduleName) = Export (concat moduleName)
 scanLine _ ("module":moduleName)        = scanModuleName moduleName
+scanLine (' ':' ':_) (export:",":[])    = Export export
+scanLine (' ':' ':_) (export:",":"--":_)= Export export
+scanLine (' ':' ':_) (export:[])        = Export export
+scanLine _ (")":"where":[])             = ExportEnd
 scanLine _ ("{#":"context":context)     = scanContext context
-scanLine line ("import":moduleName)      = scanImport line moduleName
-scanLine line ("{#":"import":moduleName) = scanImport line moduleName
+scanLine line ("import":moduleName)     = scanImport line moduleName
+scanLine line ("{#":"import":moduleName)= scanImport line moduleName
 scanLine _ tokens | "{#" `elem` tokens  = scanCCall tokens
 
 scanLine _ _ = None

[Gtk2hs-commit] gtk2hs ChangeLog,1.377,1.378

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv3685

Modified Files:
	ChangeLog 
Log Message:
ApiGen.hs: remove pointless and verbose warnings.

ModuleScan.hs: collect export list from existing modules.

CodeGen.hs: generate signals and methods export lists in the same order as in
	the original modules. Also, improve the signal code generaton - though
	it's still not quite there yet for object types.

Marshal.hs: For signals, produce the Haskell type as well as the signal
	handler tag. For object types this is not right yet because it uses
	the object type rather than the object class.
	Also change the marshaling of object parameter types to cover all four
	possibilities of: (leaf class/non-leaf class) x (ordinary/maybe type).


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.377
retrieving revision 1.378
diff -u -d -r1.377 -r1.378
--- ChangeLog	4 Mar 2005 22:10:43 -0000	1.377
+++ ChangeLog	4 Mar 2005 22:21:35 -0000	1.378
@@ -15,6 +15,22 @@
 	widgetLockAccelerators and widgetUnlockAccelerators as they do not
 	exist in Gtk+ anymore (probably since version 2.0).
 
+	* tools/apiGen/ApiGen.hs: remove pointless and verbose warnings.
+
+	* tools/apiGen/ModuleScan.hs: collect export list from existing
+	modules.
+
+	* tools/apiGen/CodeGen.hs: generate signals and methods export lists
+	in the same order as in the original modules. Also, improve the signal
+	code generaton - though it's still not quite there yet for object
+	types.
+
+	* tools/apiGen/Marshal.hs: For signals, produce the Haskell type as
+	well as the signal handler tag. For object types this is not right yet
+	because it uses the object type rather than the object class. Also
+	change the marshaling of object parameter types to cover all four
+	possibilities of: (leaf class/non-leaf class) x (ordinary/maybe type).
+
 2005-03-01 Duncan Coutts <du...@co...>
 
 	* tools/apiGen/CodeGen.hs: do deprecated and version ifdefs a bit

[Gtk2hs-commit] gtk2hs ChangeLog,1.376,1.377

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv535

Modified Files:
	ChangeLog 
Log Message:
remove widgetLockAccelerators and widgetUnlockAccelerators as they do not
exist in Gtk+ anymore (probably since version 2.0).


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.376
retrieving revision 1.377
diff -u -d -r1.376 -r1.377
--- ChangeLog	4 Mar 2005 22:04:59 -0000	1.376
+++ ChangeLog	4 Mar 2005 22:10:43 -0000	1.377
@@ -11,6 +11,10 @@
 	the MOSTLYCLEANFILES to reflect the changed location of the .deps
 	files.
 
+	* gtk/Graphics/UI/Gtk/Abstract/Widget.chs: remove
+	widgetLockAccelerators and widgetUnlockAccelerators as they do not
+	exist in Gtk+ anymore (probably since version 2.0).
+
 2005-03-01 Duncan Coutts <du...@co...>
 
 	* tools/apiGen/CodeGen.hs: do deprecated and version ifdefs a bit

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Abstract Widget.chs,1.4,1.5

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv535/gtk/Graphics/UI/Gtk/Abstract

Modified Files:
	Widget.chs 
Log Message:
remove widgetLockAccelerators and widgetUnlockAccelerators as they do not
exist in Gtk+ anymore (probably since version 2.0).


Index: Widget.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Abstract/Widget.chs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- Widget.chs	25 Feb 2005 22:53:41 -0000	1.4
+++ Widget.chs	4 Mar 2005 22:10:44 -0000	1.5
@@ -108,8 +108,6 @@
   TextDirection(..),
   widgetSetDirection,		-- General Setup.
   widgetGetDirection,
---  widgetLockAccelerators,
---  widgetUnlockAccelerators,
 
 -- * Signals
   Event(..),
@@ -397,19 +395,6 @@
 widgetGetDirection w = liftM (toEnum.fromIntegral) $ 
   {#call widget_get_direction#} (toWidget w)
 
--- Accelerator handling.
-
--- Lock accelerators.
---
---widgetLockAccelerators :: WidgetClass w => w -> IO ()
---widgetLockAccelerators = {#call unsafe widget_lock_accelerators#}.toWidget
-
-
--- Unlock accelerators.
---
---widgetUnlockAccelerators :: WidgetClass w => w -> IO ()
---widgetUnlockAccelerators = {#call widget_unlock_accelerators#}.toWidget
-
 --------------------
 -- Signals
 

[Gtk2hs-commit] gtk2hs ChangeLog,1.375,1.376 Makefile.am,1.54,1.55

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30929

Modified Files:
	ChangeLog Makefile.am 
Log Message:
Fix one of the GHC 6.4 build failures by changing the root path that
c2hs_config.h gets #include'ed from. Previously it was ok to #include relative
to the build root whereas GHC 6.4 only allows it to be relative to the source
file being compiled.
Move tools/c2hs/toplevel/C2HSConfig.hs from tools_c2hs_c2hsLocal_SOURCES
to nodist_tools_c2hs_c2hsLocal_SOURCES so that the file does not end up in the
.tar.gz distribution. It is generated from C2HSConfig.hs.in so C2HSConfig.hs
should not be present in a clean tree.
Also change MOSTLYCLEANFILES to reflect the changed location of the .deps
files.


Index: Makefile.am
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v
retrieving revision 1.54
retrieving revision 1.55
diff -u -d -r1.54 -r1.55
--- Makefile.am	26 Feb 2005 02:54:34 -0000	1.54
+++ Makefile.am	4 Mar 2005 22:04:59 -0000	1.55
@@ -1,6 +1,6 @@
 AUTOMAKE_OPTIONS = foreign subdir-objects
 SUFFIXES = .hs.uncpp .chs.pp .chs .hsc .deps .dep
-MOSTLYCLEANFILES = *.deps.bak
+MOSTLYCLEANFILES = */*.deps.bak tools/*/*.deps.bak
 CLEANFILES =
 DISTCLEANFILES = */*.precomp
 
@@ -181,20 +181,26 @@
 	tools/c2hs/state/Switches.hs		\
 	tools/c2hs/toplevel/Main.hs		\
 	tools/c2hs/toplevel/Version.hs		\
-	tools/c2hs/toplevel/C2HSConfig.hs	\
 	tools/c2hs/toplevel/c2hs_config.c
 
+nodist_tools_c2hs_c2hsLocal_SOURCES =		\
+	tools/c2hs/toplevel/C2HSConfig.hs
+
+tools_c2hs_c2hsLocal_ALLSOURCES =		\
+	$(tools_c2hs_c2hsLocal_SOURCES)		\
+	$(nodist_tools_c2hs_c2hsLocal_SOURCES)
+
 tools_c2hs_base_general_Binary_hs_HCFLAGS = -O -funbox-strict-fields
 tools_c2hs_base_general_FastMutInt_hs_HCFLAGS = -O
 tools_c2hs_base_syntax_Parsers_hs_HCFLAGS = -fglasgow-exts
 tools_c2hs_toplevel_C2HSConfig_hs_HCFLAGS = -fffi -fvia-C \
-	'-\#include<tools/c2hs/toplevel/c2hs_config.h>'
+	'-\#include<c2hs_config.h>'
 
 tools_c2hs_c2hsLocal_HSFILES		= \
-	$(filter %.hs,$(tools_c2hs_c2hsLocal_SOURCES))
+	$(filter %.hs,$(tools_c2hs_c2hsLocal_ALLSOURCES))
 # Fix automake - the subdir-objects option doesn't work here.
 am_tools_c2hs_c2hsLocal_OBJECTS = \
-	$(addsuffix .$(OBJEXT),$(basename $(tools_c2hs_c2hsLocal_SOURCES)))
+	$(addsuffix .$(OBJEXT),$(basename $(tools_c2hs_c2hsLocal_ALLSOURCES)))
 MOSTLYCLEANFILES+= $(am_tools_c2hs_c2hsLocal_OBJECTS)
 MOSTLYCLEANFILES+= $(tools_c2hs_c2hsLocal_HSFILES:.hs=.hi)
 CLEANFILES+= $(tools_c2hs_c2hsLocal_BUILDSOURCES)

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.375
retrieving revision 1.376
diff -u -d -r1.375 -r1.376
--- ChangeLog	1 Mar 2005 21:20:44 -0000	1.375
+++ ChangeLog	4 Mar 2005 22:04:59 -0000	1.376
@@ -1,3 +1,16 @@
+2005-03-04 Duncan Coutts <du...@co...>
+
+	* Makefile.am: Fix one of the GHC 6.4 build failures by changing the
+	root path that c2hs_config.h gets #include'ed from. Previously it was
+	ok to #include relative to the build root whereas GHC 6.4 only allows
+	it to be relative to the source file being compiled. Move
+	tools/c2hs/toplevel/C2HSConfig.hs from tools_c2hs_c2hsLocal_SOURCES
+	to nodist_tools_c2hs_c2hsLocal_SOURCES so that the file does not end
+	up in the .tar.gz distribution. It is generated from C2HSConfig.hs.in
+	so C2HSConfig.hs should not be present in a clean tree. Also change
+	the MOSTLYCLEANFILES to reflect the changed location of the .deps
+	files.
+
 2005-03-01 Duncan Coutts <du...@co...>
 
 	* tools/apiGen/CodeGen.hs: do deprecated and version ifdefs a bit
@@ -10,7 +23,7 @@
 
 	* tools/apiGen/ApiGen.hs: trivial follow on change.
 
-	* tools/apiGen/FormatDocs.hs: for deprecated module, instead of
+	* tools/apiGen/FormatDocs.hs: for deprecated modules, instead of
 	anotating every function with a deprecation warning, just add a note
 	to the module summary. Also put version notes in the module summary
 	rather than at the end of the detail section.

[Gtk2hs-commit] gtk2hs ChangeLog,1.374,1.375

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28810

Modified Files:
	ChangeLog 
Log Message:
Yet more code generator improvements...
Most important is that it now works with gtk-2.6.1

CodeGen.hs: do deprecated and version ifdefs a bit better especialy if the
	whole module is new or deprecated.
Docs.hs: seperate documentation of callbacks from documentation of methods.
	Generalise the summary field to be list of paragraphs rather than just
	a single paragraph so that we can add things to the summary
	documentations like deprecation notices.
FormatDocs.hs: for deprecated modules, instead of anotating every function
	with a deprecation warning, just add a note to the module summary.
	Also put version notes in the module summary rather than at the end
	of the detail section.
gapi2xml.pl, gtk-sources.xml: merge upstream changes to the gapi parser tool
	and adjust the sources spec file so that it will now work with
	gtk+-2.6.1. (There seems to be an additional problem with 2.6.2 and
	2.6.3 in the filechooser modules which I have not yet tracked down)


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.374
retrieving revision 1.375
diff -u -d -r1.374 -r1.375
--- ChangeLog	27 Feb 2005 20:02:13 -0000	1.374
+++ ChangeLog	1 Mar 2005 21:20:44 -0000	1.375
@@ -1,3 +1,26 @@
+2005-03-01 Duncan Coutts <du...@co...>
+
+	* tools/apiGen/CodeGen.hs: do deprecated and version ifdefs a bit
+	better especialy if the whole module is new or deprecated.
+
+	* tools/apiGen/Docs.hs: seperate documentation of callbacks from
+	documentation of methods. Generalise the summary field to be list of
+	paragraphs rather than just a single paragraph so that we can add
+	things to the summary documentations like deprecation notices.
+
+	* tools/apiGen/ApiGen.hs: trivial follow on change.
+
+	* tools/apiGen/FormatDocs.hs: for deprecated module, instead of
+	anotating every function with a deprecation warning, just add a note
+	to the module summary. Also put version notes in the module summary
+	rather than at the end of the detail section.
+
+	* tools/apiGen/gapi2xml.pl, tools/apiGen/gtk-sources.xml: merge
+	upstream changes to the gapi parser tool and adjust the sources spec
+	file so that it will now work with gtk+-2.6.1. (There seems to be an
+	additional problem with 2.6.2 and 2.6.3 in the filechooser modules
+	which I have not yet tracked down)
+
 2005-02-27 Duncan Coutts <du...@co...>
 
 	* glib/System/Glib/GObject.chs.pp: change mkDestructor into

[Gtk2hs-commit] gtk2hs/tools/apiGen CodeGen.hs,1.10,1.11 Docs.hs,1.2,1.3 ApiGen.hs,1.18,1.19 FormatDocs.hs,1.8,1.9 gapi2xml.pl,1.2,1.3 gtk-sources.xml,1.4,1.5

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv28810/tools/apiGen

Modified Files:
	CodeGen.hs Docs.hs ApiGen.hs FormatDocs.hs gapi2xml.pl 
	gtk-sources.xml 
Log Message:
Yet more code generator improvements...
Most important is that it now works with gtk-2.6.1

CodeGen.hs: do deprecated and version ifdefs a bit better especialy if the
	whole module is new or deprecated.
Docs.hs: seperate documentation of callbacks from documentation of methods.
	Generalise the summary field to be list of paragraphs rather than just
	a single paragraph so that we can add things to the summary
	documentations like deprecation notices.
FormatDocs.hs: for deprecated modules, instead of anotating every function
	with a deprecation warning, just add a note to the module summary.
	Also put version notes in the module summary rather than at the end
	of the detail section.
gapi2xml.pl, gtk-sources.xml: merge upstream changes to the gapi parser tool
	and adjust the sources spec file so that it will now work with
	gtk+-2.6.1. (There seems to be an additional problem with 2.6.2 and
	2.6.3 in the filechooser modules which I have not yet tracked down)


Index: CodeGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -d -r1.10 -r1.11
--- CodeGen.hs	27 Feb 2005 20:02:16 -0000	1.10
+++ CodeGen.hs	1 Mar 2005 21:20:44 -0000	1.11
@@ -28,9 +28,6 @@
 genFunction :: KnownSymbols -> Method -> Maybe FuncDoc -> Maybe MethodInfo -> ShowS
 genFunction knownSymbols method doc info =
   formattedDoc.
-  (if method_deprecated method
-     then ss "-- * Warning this function is deprecated\n--\n"
-     else id).
   ss functionName. ss " :: ". functionType. nl.
   ss functionName. sc ' '. formattedParamNames. sc '='.
   indent 1. body
@@ -108,6 +105,7 @@
 genModuleBody :: KnownSymbols -> Object -> ModuleDoc -> ModuleInfo -> ShowS
 genModuleBody knownSymbols object apiDoc modInfo =
   doVersionIfDefs (sepBy' "\n\n") $
+  map adjustDeprecatedAndSinceVersion $
      sectionHeader "Interfaces"
      (genImplements object)
   ++ sectionHeader "Constructors"
@@ -119,7 +117,11 @@
   ++ sectionHeader "Signals"
      (genSignals      knownSymbols object (moduledoc_signals apiDoc))
   where sectionHeader name []      = []
-        sectionHeader name entries = (ss "--------------------\n-- ". ss name, ("", False)):entries
+        sectionHeader name entries =
+          let header = (ss "--------------------\n-- ". ss name, ("", notDeprecated))
+           in header : entries
+        adjustDeprecatedAndSinceVersion (doc, (since, deprecated)) =
+          (doc, (moduledoc_since apiDoc `max` since, object_deprecated object || deprecated))
 
 -- fixup the names of the C functions we got from scaning the original modules
 -- we want the fully qualified "gtk_foo_bar" rather than "foo_bar" so that the
@@ -414,37 +416,37 @@
 
 genExports :: Object -> ModuleDoc -> ModuleInfo -> ShowS
 genExports object docs modInfo =
-  comment.ss "* Types".
-  indent 1.ss (object_name object).sc ','.
-  indent 1.ss (object_name object).ss "Class,".
-  indent 1.ss "castTo".ss (object_name object).sc ','.
-  (case [ (ss "  ". ss (cFuncNameToHsName (method_cname constructor)). sc ','
-          ,(maybe "" funcdoc_since doc, notDeprecated))
-        | (constructor, doc, _) <- constructors object (moduledoc_functions docs) []] of
-     [] -> id
-     cs -> nl.nl.comment.ss "* Constructors".nl.
-           doVersionIfDefs lines cs).
-  (case [ (ss "  ". ss (cFuncNameToHsName (method_cname method)). sc ','
-          ,(maybe "" funcdoc_since doc, method_deprecated method))
-        | (method, doc, _) <- methods object (moduledoc_functions docs)
-                                (module_methods modInfo) False] of
-     [] -> id
-     cs -> nl.nl.comment.ss "* Methods".nl.
-           doVersionIfDefs lines cs).
-  (case [ (ss "  ". ss (lowerCaseFirstChar (property_name property)). sc ','
-          ,(maybe "" propdoc_since doc, notDeprecated))
-        | (property, doc) <- properties object (moduledoc_properties docs)] of
-     [] -> id
-     cs -> nl.nl.comment.ss "* Properties".nl.
-           doVersionIfDefs lines cs).
-  (case [ let signalName = (toStudlyCaps . canonicalSignalName . signal_cname) signal in 
-          (ss "  on".    ss signalName. sc ','.nl.
-           ss "  after". ss signalName. sc ','
-          ,(maybe "" signaldoc_since doc, notDeprecated))
-        | (signal, doc) <- signals object (moduledoc_signals docs)] of
-     [] -> id
-     cs -> nl.nl.comment.ss "* Signals".nl.
-           doVersionIfDefs lines cs)
+  doVersionIfDefs lines $
+  map adjustDeprecatedAndSinceVersion $
+     [(ss "-- * Types", defaultAttrs)
+     ,(ss "  ".ss (object_name object).sc ',', defaultAttrs)
+     ,(ss "  ".ss (object_name object).ss "Class,", defaultAttrs)
+     ,(ss "  ".ss "castTo".ss (object_name object).sc ',', defaultAttrs)] 
+  ++ sectionHeader "Constructors"
+     [ (ss "  ". ss (cFuncNameToHsName (method_cname constructor)). sc ','
+       ,(maybe "" funcdoc_since doc, notDeprecated))
+     | (constructor, doc, _) <- constructors object (moduledoc_functions docs) []]
+  ++ sectionHeader "Methods"
+     [ (ss "  ". ss (cFuncNameToHsName (method_cname method)). sc ','
+       ,(maybe "" funcdoc_since doc, method_deprecated method))
+     | (method, doc, _) <- methods object (moduledoc_functions docs)
+                             (module_methods modInfo) False]
+  ++ sectionHeader "Properties"
+     [ (ss "  ". ss (lowerCaseFirstChar (property_name property)). sc ','
+       ,(maybe "" propdoc_since doc, notDeprecated))
+     | (property, doc) <- properties object (moduledoc_properties docs)]
+  ++ sectionHeader "Signals"
+     [ let signalName = (toStudlyCaps . canonicalSignalName . signal_cname) signal in 
+       (ss "  on".    ss signalName. sc ','.nl.
+        ss "  after". ss signalName. sc ','
+       ,(maybe "" signaldoc_since doc, notDeprecated))
+     | (signal, doc) <- signals object (moduledoc_signals docs)]
+
+  where defaultAttrs = ("", notDeprecated)
+        sectionHeader name []      = []
+        sectionHeader name entries = (id, defaultAttrs):(ss "-- * ". ss name, defaultAttrs):entries
+        adjustDeprecatedAndSinceVersion (doc, (since, deprecated)) =
+          (doc, (moduledoc_since docs `max` since, object_deprecated object || deprecated))
 
 genImports :: ModuleInfo -> ShowS
 genImports modInfo = 

Index: FormatDocs.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/FormatDocs.hs,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- FormatDocs.hs	27 Feb 2005 20:02:16 -0000	1.8
+++ FormatDocs.hs	1 Mar 2005 21:20:45 -0000	1.9
@@ -20,7 +20,7 @@
   addVersionParagraphs
 ) where
 
-import Api (NameSpace(namespace_name))
+import Api (NameSpace(..), Object(..), Method(..))
 import Docs
 import Marshal (KnownSymbols, CSymbol(..))
 import MarshalFixup (stripKnownPrefixes, knownMiscType, fixCFunctionName)
@@ -75,28 +75,43 @@
 addVersionParagraphs :: NameSpace -> ModuleDoc -> ModuleDoc
 addVersionParagraphs namespace apiDoc =
   apiDoc {
-    moduledoc_description = moduledoc_description apiDoc ++ moduleVersionParagraph,
-    moduledoc_functions = functionVersionParagraphs moduleVersion (moduledoc_functions apiDoc)
+    moduledoc_summary = moduledoc_summary apiDoc ++ moduleVersionParagraph
+                                                 ++ moduleDeprecatedParagraph,
+    moduledoc_functions = functionVersionParagraphs moduleVersion (moduledoc_functions apiDoc),
+    moduledoc_since = moduleVersion
   }
   where functionVersionParagraphs :: String -> [FuncDoc] -> [FuncDoc]
         functionVersionParagraphs baseVersion funcdocs =
           [ if funcdoc_since funcdoc > baseVersion
               then funcdoc {
                      funcdoc_paragraphs = funcdoc_paragraphs funcdoc ++
-                       let line = "* Available since " ++ namespace_name namespace
+                       let line = "Available since " ++ namespace_name namespace
                               ++ " version " ++ funcdoc_since funcdoc
-                        in [DocParaText [DocText line]]
+                        in [DocParaListItem [DocText line]]
                    }
-              else funcdoc
+              else let method = lookup (funcdoc_name funcdoc) methodMap
+                       methodDeprecated = maybe False method_deprecated method
+                       objectDeprecated = maybe False object_deprecated object
+                   in if methodDeprecated && not objectDeprecated
+                        then funcdoc {
+                               funcdoc_paragraphs = funcdoc_paragraphs funcdoc ++
+                                 let line = "Warning: this function is deprecated "
+                                         ++ "and should not be used in newly-written code."
+                                  in [DocParaListItem [DocText line]]
+                             }
+                        else funcdoc
           | funcdoc <- funcdocs ]
+          where methodMap = [ (method_cname method, method)
+                            | method <- maybe [] object_methods object ]
   
         moduleVersionParagraph =
           case moduleVersion of
             "" -> []
             since ->
-              let line = "* Module available since " ++ namespace_name namespace
+              let line = "Module available since " ++ (let name = namespace_name namespace
+                                                          in if name == "Gtk" then "Gtk+" else name)
                       ++ " version " ++ since
-               in [DocParaText [DocText line]]
+               in [DocParaListItem [DocText line]]       
   
         -- figure out if the whole module appeared in some version of gtk later 
         -- than the original version
@@ -105,6 +120,18 @@
                              | funcdoc <- moduledoc_functions apiDoc ] of
                           [] -> ""
                           versions -> minimum versions
+
+        moduleDeprecatedParagraph =
+          if maybe False object_deprecated object
+            then let line = "Warning: this module is deprecated "
+                         ++ "and should not be used in newly-written code."
+            
+                  in [DocParaListItem [DocText line]]
+            else []
+        
+        object = lookup (moduledoc_name apiDoc)
+                   [ (object_cname object, object)
+                   | object <- namespace_objects namespace ]
   
 haddocFormatSections :: KnownSymbols -> [DocSection] -> ShowS
 haddocFormatSections knownSymbols = 

Index: gapi2xml.pl
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gapi2xml.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- gapi2xml.pl	27 Jan 2005 23:10:15 -0000	1.2
+++ gapi2xml.pl	1 Mar 2005 21:20:45 -0000	1.3
@@ -169,12 +169,19 @@
 		}
 		$cast_macro =~ s/\\\n\s*//g;
 		$cast_macro =~ s/\s+/ /g;
-		if ($cast_macro =~ /G_TYPE_CHECK_(\w+)_CAST.*,\s*(\w+),\s*(\w+)/) {
+		if ($cast_macro =~ /G_TYPE_CHECK_(\w+)_CAST.*,\s*(\w+),\s*(\w+)\)/) {
 			if ($1 eq "INSTANCE") {
 				$objects{$2} = $3 . $objects{$2};
 			} else {
 				$objects{$2} .= ":$3";
 			}
+		} elsif ($cast_macro =~ /G_TYPE_CHECK_(\w+)_CAST.*,\s*([a-zA-Z0-9]+)_(\w+)_get_type\s*\(\),\s*(\w+)\)/) {
+			$typename = uc ("$2_type_$3");
+			if ($1 eq "INSTANCE") {
+				$objects{$typename} = $4 . $objects{$typename};
+			} else {
+				$objects{$typename} .= ":$4";
+			}
 		} elsif ($cast_macro =~ /GTK_CHECK_CAST.*,\s*(\w+),\s*(\w+)/) {
 			$objects{$1} = $2 . $objects{$1};
 		} elsif ($cast_macro =~ /GTK_CHECK_CLASS_CAST.*,\s*(\w+),\s*(\w+)/) {
@@ -309,7 +316,6 @@
 ##############################################################
 
 foreach $type (sort(keys(%objects))) {
-	
 	($inst, $class) = split(/:/, $objects{$type});
 	$class = $inst . "Class" if (!$class);
 	$initfunc = $pedefs{lc($inst)};
@@ -619,8 +625,9 @@
 			$fmt = $1; $args = $2;
 			($params_el, @junk) = $el->getElementsByTagName ("parameters");
 			(@params) = $params_el->getElementsByTagName ("parameter");
-			$params[$fmt-1]->setAttribute ("printf_format", "true");
-			$params[$args-1]->setAttribute ("printf_format_args", "true");
+			$offset = 1 + $drop_1st;
+			$params[$fmt-$offset]->setAttribute ("printf_format", "true");
+			$params[$args-$offset]->setAttribute ("printf_format_args", "true");
 		}
 	}
 }
@@ -754,6 +761,7 @@
 		$parm =~ s/(\w+)\s+const /const \1 /g;
 		$parm =~ s/(\*+)\s*const\s+/\1 /g;
 		$parm =~ s/const\s+/const-/g;
+		$parm =~ s/unsigned\s+/unsigned-/g;
 		if ($parm =~ /(.*)\(\s*\**\s*(\w+)\)\s+\((.*)\)/) {
 			my $ret = $1; my $cbn = $2; my $params = $3;
 			$cb_elem = addNameElem($parms_elem, 'callback', $cbn);
@@ -869,7 +877,7 @@
 	} else {
 		$tok =~ s/_TYPE//; 
 		$tok =~ s/\|.*STATIC_SCOPE//; 
-		$tok =~ s/\s+//g;
+		$tok =~ s/\W+//g;
 		return StudlyCaps (lc($tok));
 	}
 }

Index: ApiGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- ApiGen.hs	27 Feb 2005 20:02:15 -0000	1.18
+++ ApiGen.hs	1 Mar 2005 21:20:44 -0000	1.19
@@ -165,7 +165,7 @@
 	    "OBJECT_NAME"    -> ss $ module_name moduleInfo
 	    "AUTHORS"        -> ss $ concat $ intersperse ", " $ module_authors moduleInfo
             "COPYRIGHT"      -> ss $ concat $ intersperse ", " $ module_copyright_holders moduleInfo
-            "DESCRIPTION"    -> haddocFormatSpans knownTypes False 3 (moduledoc_summary moduleDoc)
+            "DESCRIPTION"    -> haddocFormatParas knownTypes False (moduledoc_summary moduleDoc)
 	    "DOCUMENTATION"  -> genModuleDocumentation knownTypes moduleDoc
 	    "TODO"           -> genTodoItems object
 	    "MODULE_NAME"    -> ss $ if null (module_prefix moduleInfo)

Index: gtk-sources.xml
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/gtk-sources.xml,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- gtk-sources.xml	17 Feb 2005 00:13:21 -0000	1.4
+++ gtk-sources.xml	1 Mar 2005 21:20:45 -0000	1.5
@@ -3,6 +3,8 @@
     <library name="gtk">
       <namespace name="Gtk">
         <dir>gtk+/gtk</dir>
+      	<!-- Stuff that breaks the gapi parser -->
+	<exclude>gtk+/gtk/gtkclipboard.c</exclude>
         <!-- Internal stuff -->
         <exclude>gtk+/gtk/gtkfilechooserdefault.c</exclude>
         <exclude>gtk+/gtk/gtkfilechooserdefault.h</exclude>

Index: Docs.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Docs.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- Docs.hs	14 Feb 2005 02:10:49 -0000	1.2
+++ Docs.hs	1 Mar 2005 21:20:44 -0000	1.3
@@ -15,6 +15,9 @@
 
 import qualified Text.XML.HaXml as Xml
 
+import Char (isUpper)
+import List (partition)
+
 -------------------------------------------------------------------------------
 -- Types representing the content of the documentation XML file
 -------------------------------------------------------------------------------
@@ -23,14 +26,16 @@
 data ModuleDoc = ModuleDoc {
     moduledoc_name :: String,              -- these docs apply to this object
     moduledoc_altname :: String,           -- sometimes a better index entry
-    moduledoc_summary :: [DocParaSpan],    -- a one line summary
+    moduledoc_summary :: [DocPara],        -- usually a one line summary
     moduledoc_description :: [DocPara],    -- the main description
     moduledoc_sections :: [DocSection],    -- any additional titled subsections
     moduledoc_hierarchy :: [DocParaSpan],  -- a tree of parent objects (as text)
     moduledoc_functions :: [FuncDoc],      -- documentation for each function
+    moduledoc_callbacks :: [FuncDoc],      -- documentation for callback types
     moduledoc_properties :: [PropDoc],     -- documentation for each property
-    moduledoc_signals :: [SignalDoc]       -- documentation for each signal
-  }
+    moduledoc_signals :: [SignalDoc],      -- documentation for each signal
+    moduledoc_since :: String              -- which version of the api the
+  }  					   -- module is available from, eg "2.4"
 
 noModuleDoc = ModuleDoc {
     moduledoc_name = "",
@@ -40,8 +45,10 @@
     moduledoc_sections = [],
     moduledoc_hierarchy = [],
     moduledoc_functions = [],
+    moduledoc_callbacks = [],
     moduledoc_properties = [],
-    moduledoc_signals = []
+    moduledoc_signals = [],
+    moduledoc_since = ""
   }
 
 data DocSection = DocSection {
@@ -104,8 +111,11 @@
   let functions = [ e | e@(Xml.CElem (Xml.Elem "function" _ _)) <- rest ]
       properties = [ e | e@(Xml.CElem (Xml.Elem "property" _ _)) <- rest ]
       signals = [ e | e@(Xml.CElem (Xml.Elem "signal" _ _)) <- rest ]
+      (callbacks, functions') = partition (isUpper.head.funcdoc_name)
+                                         (map extractDocFunc functions)
   in (extractDocModuleinfo moduleinfo) {
-    moduledoc_functions = map extractDocFunc functions,
+    moduledoc_functions = functions',
+    moduledoc_callbacks = callbacks,
     moduledoc_properties = map extractDocProp properties,
     moduledoc_signals = map extractDocSignal signals
   }
@@ -126,13 +136,15 @@
    in ModuleDoc {
     moduledoc_name = Xml.verbatim name,
     moduledoc_altname = Xml.verbatim altname,
-    moduledoc_summary = map extractDocParaSpan summary,
+    moduledoc_summary = [DocParaText (map extractDocParaSpan summary)],
     moduledoc_description = concatMap extractDocPara paras,
     moduledoc_sections = map extractDocSection sections,
     moduledoc_hierarchy = map extractDocParaSpan objHierSpans,
     moduledoc_functions = undefined,
+    moduledoc_callbacks = undefined,
     moduledoc_properties = undefined,
-    moduledoc_signals = undefined
+    moduledoc_signals = undefined,
+    moduledoc_since = ""
   }
 
 extractDocSection :: Xml.Content -> DocSection
@@ -156,7 +168,8 @@
   )) =
   let since = case since' of
                 [] -> ""
-		[Xml.CString _ since] -> since
+		[Xml.CString _ since] | last since == '.' -> init since
+                                      | otherwise         -> since
    in FuncDoc {
         funcdoc_name = name,
 	funcdoc_paragraphs = concatMap extractDocPara paras,

[Gtk2hs-commit] gtk2hs ChangeLog,1.373,1.374

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5321

Modified Files:
	ChangeLog 
Log Message:
More code generator improvements:

Preserve import declerations from original modules.
Produce properties using exisiting bound getter/setter methods in cases where
	that makes sense.
Add "implements interface" feature where gobject classes that implement
	'GInterface's get modeled as Haskell class instance declerations.
Change the name of the "Description" section to "Detail" so that the Haddock
	documentation does not have two "Description" sections which is
	probably confusing.
Various other minor changes and code refactoring.


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.373
retrieving revision 1.374
diff -u -d -r1.373 -r1.374
--- ChangeLog	27 Feb 2005 19:42:05 -0000	1.373
+++ ChangeLog	27 Feb 2005 20:02:13 -0000	1.374
@@ -20,6 +20,33 @@
 	mkFunPtrDestructor following the same pattern as before. This reduces
 	code duplication a bit (saves about 350 lines of code).
 
+	* tools/apiGen/StringUtils.hs: extra utility function.
+
+	* tools/apiGen/Template.chs: change the way imports are generated.
+
+	* tools/apiGen/ApiGen.hs: use new genImports function.
+
+	* tools/apiGen/CodeGen.hs: new genImports function which preserves
+	imports from original module. Add "Implements" code section for
+	gobject classes that implement interfaces; this is modeled in Haskell
+	just by extra instance declerations. Significantly reworked code for
+	generating proeprties to use getter setter functions rather than a
+	generic implementation where that makes sence.
+
+	* tools/apiGen/FormatDocs.hs: move some common formatting code out of
+	CodeGen.hs to this module. Also change the name of the "Description"
+	section to "Detail" so that the Haddock documentation does not have
+	two "Description" sections which is probably confusing.
+
+	* tools/apiGen/Api.hs: extract "implements interface" information
+	from the api xml files. And move a hack from this module to CodeGen.hs
+
+	* tools/apiGen/Marshal.hs: factor out "IO" return type from marshaling
+	functions to where they are used. Also make flag types be lists, which
+	was previously incorrect.
+
+	* tools/apiGen/MarshalFixup.hs: add a couple more leaf classes.
+
 2005-02-26 Duncan Coutts <du...@co...>
 
 	* tools/callbackGen/Signal.chs-boot1: add #hide Haddock annotation so

[Gtk2hs-commit] gtk2hs/tools/apiGen StringUtils.hs,1.2,1.3 Template.chs,1.8,1.9 ApiGen.hs,1.17,1.18 CodeGen.hs,1.9,1.10 FormatDocs.hs,1.7,1.8 Api.hs,1.3,1.4 Marshal.hs,1.6,1.7 MarshalFixup.hs,1.2,1.3

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/apiGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5321/tools/apiGen

Modified Files:
	StringUtils.hs Template.chs ApiGen.hs CodeGen.hs FormatDocs.hs 
	Api.hs Marshal.hs MarshalFixup.hs 
Log Message:
More code generator improvements:

Preserve import declerations from original modules.
Produce properties using exisiting bound getter/setter methods in cases where
	that makes sense.
Add "implements interface" feature where gobject classes that implement
	'GInterface's get modeled as Haskell class instance declerations.
Change the name of the "Description" section to "Detail" so that the Haddock
	documentation does not have two "Description" sections which is
	probably confusing.
Various other minor changes and code refactoring.


Index: Template.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Template.chs,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- Template.chs	25 Feb 2005 01:32:11 -0000	1.8
+++ Template.chs	27 Feb 2005 20:02:14 -0000	1.9
@@ -31,10 +31,8 @@
 @EXPORTS@
   ) where
 
-import Monad	(liftM)
-
-import System.Glib.FFI
 @IMPORTS@
+
 {# context lib="@CONTEXT_LIB@" prefix="@CONTEXT_PREFIX@" #}
 
 @MODULE_BODY@

Index: Marshal.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Marshal.hs,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- Marshal.hs	23 Feb 2005 14:12:35 -0000	1.6
+++ Marshal.hs	27 Feb 2005 20:02:16 -0000	1.7
@@ -3,10 +3,6 @@
   CSymbol(..),
   ObjectKind(..),
   EnumKind(..),
-  stripKnownPrefixes,
-  knownMiscType,
-  maybeNullParameter,
-  maybeNullResult,
   genMarshalParameter,
   genMarshalResult,
   genMarshalProperty,
@@ -147,7 +143,7 @@
 genMarshalParameter knownSymbols _ name typeName
             | isUpper (head typeName)
            && symbolIsFlags typeKind =
-	(Nothing, Just shortTypeName,
+	(Nothing, Just ("[" ++ shortTypeName ++ "]"),
 	\body -> body.
                  indent 2. ss "((fromIntegral . fromFlags) ". ss name. ss ")")
   where shortTypeName = stripKnownPrefixes typeName
@@ -183,26 +179,26 @@
 	String -> 	--C type decleration for the return value we will marshal
 	(String,	--Haskell return type 
 	ShowS -> ShowS)	--marshaling code (\body -> ... body ...)
-genMarshalResult _ _ "gboolean" = ("IO Bool", \body -> ss "liftM toBool $". indent 1. body)
-genMarshalResult _ _ "gint"     = ("IO Int",  \body -> ss "liftM fromIntegral $". indent 1. body)
-genMarshalResult _ _ "guint"    = ("IO Int",  \body -> ss "liftM fromIntegral $". indent 1. body)
-genMarshalResult _ _ "gdouble"  = ("IO Double", \body -> ss "liftM realToFrac $". indent 1. body)
-genMarshalResult _ _ "gfloat"   = ("IO Float",  \body -> ss "liftM realToFrac $". indent 1. body)
-genMarshalResult _ _ "void"     = ("IO ()", id)
+genMarshalResult _ _ "gboolean" = ("Bool", \body -> ss "liftM toBool $". indent 1. body)
+genMarshalResult _ _ "gint"     = ("Int",  \body -> ss "liftM fromIntegral $". indent 1. body)
+genMarshalResult _ _ "guint"    = ("Int",  \body -> ss "liftM fromIntegral $". indent 1. body)
+genMarshalResult _ _ "gdouble"  = ("Double", \body -> ss "liftM realToFrac $". indent 1. body)
+genMarshalResult _ _ "gfloat"   = ("Float",  \body -> ss "liftM realToFrac $". indent 1. body)
+genMarshalResult _ _ "void"     = ("()", id)
 genMarshalResult _ funcName "const-gchar*" =
   if maybeNullResult funcName
-    then ("IO (Maybe String)",
+    then ("(Maybe String)",
          \body -> body.
                   indent 1. ss  ">>= maybePeek peekUTFString")
-    else ("IO String",
+    else ("String",
          \body -> body.
                   indent 1. ss  ">>= peekUTFString")
 genMarshalResult _ funcName "gchar*" =
   if maybeNullResult funcName
-    then ("IO (Maybe String)",
+    then ("(Maybe String)",
          \body -> body.
                   indent 1. ss  ">>= maybePeek readUTFString")
-    else ("IO String",
+    else ("String",
          \body -> body.
                   indent 1. ss  ">>= readUTFString")
 genMarshalResult _ _ "const-GSList*" =
@@ -227,10 +223,10 @@
            && last typeName /= '*'
            && symbolIsObject typeKind =
   if maybeNullResult funcName
-    then ("IO (Maybe " ++ shortTypeName ++ ")",
+    then ("(Maybe " ++ shortTypeName ++ ")",
          \body -> ss "maybeNull (" .ss constructor. ss " mk". ss shortTypeName. ss ") $".
                   indent 1. body)
-    else ("IO " ++ shortTypeName,
+    else (shortTypeName,
          \body -> ss constructor. ss " mk". ss shortTypeName. ss " $".
                   indent 1. body)
   where typeName = init typeName'
@@ -242,7 +238,7 @@
 genMarshalResult knownSymbols _ typeName
             | isUpper (head typeName)
            && symbolIsEnum typeKind =
-  ("IO " ++ shortTypeName,
+  (shortTypeName,
   \body -> ss "liftM (toEnum . fromIntegral) $".
            indent 1. body)
   where shortTypeName = stripKnownPrefixes typeName
@@ -251,7 +247,7 @@
 genMarshalResult knownSymbols _ typeName
             | isUpper (head typeName)
            && symbolIsFlags typeKind =
-  ("IO " ++ shortTypeName,
+  ("[" ++ shortTypeName ++ "]",
   \body -> ss "liftM (toFlags . fromIntegral) $".
            indent 1. body)
   where shortTypeName = stripKnownPrefixes typeName

Index: CodeGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- CodeGen.hs	25 Feb 2005 01:32:11 -0000	1.9
+++ CodeGen.hs	27 Feb 2005 20:02:16 -0000	1.10
@@ -1,6 +1,7 @@
 module CodeGen (
   genModuleBody,
   genExports,
+  genImports,
   genTodoItems,
   makeKnownSymbolsMap,
   mungeMethodInfo
@@ -12,9 +13,10 @@
 import Marshal
 import StringUtils
 import ModuleScan
+import MarshalFixup (stripKnownPrefixes, maybeNullParameter, maybeNullResult, fixCFunctionName)
 
 import Prelude hiding (Enum, lines)
-import List   (groupBy, sortBy, isPrefixOf, isSuffixOf)
+import List   (groupBy, sortBy, isPrefixOf, isSuffixOf, partition, find)
 import Maybe  (isNothing)
 import Data.FiniteMap
 
@@ -48,7 +50,7 @@
         formattedParamNames = cat (map (\name -> ss name.sc ' ') paramNames)
 	(returnType', returnMarshaler) =
 		genMarshalResult knownSymbols (method_cname method) (method_return_type method)
-        returnType = (returnType', lookup "Returns" paramDocMap)
+        returnType = ("IO " ++ returnType', lookup "Returns" paramDocMap)
 	functionType = (case classConstraints of
 	                  []  -> id
 			  [c] -> ss c. ss " => "
@@ -60,10 +62,7 @@
         safety = case info of
                   Nothing -> False
                   Just info -> methodinfo_unsafe info
-        formattedDoc = case doc of
-          Nothing  -> ss "-- | \n-- \n"
-          Just doc -> ss "-- | ". haddocFormatParas knownSymbols docNullsAllFixed (funcdoc_paragraphs doc). nl.
-                      ss "--\n"
+        formattedDoc = haddocFormatDeclaration knownSymbols docNullsAllFixed funcdoc_paragraphs doc
         docNullsAllFixed = maybeNullResult (method_cname method)
                         || or [ maybeNullParameter (method_cname method) (parameter_name p)
                               | p <- method_parameters method ]
@@ -109,7 +108,9 @@
 genModuleBody :: KnownSymbols -> Object -> ModuleDoc -> ModuleInfo -> ShowS
 genModuleBody knownSymbols object apiDoc modInfo =
   doVersionIfDefs (sepBy' "\n\n") $
-     sectionHeader "Constructors"
+     sectionHeader "Interfaces"
+     (genImplements object)
+  ++ sectionHeader "Constructors"
      (genConstructors knownSymbols object (moduledoc_functions apiDoc) (module_methods modInfo))
   ++ sectionHeader "Methods"
      (genMethods      knownSymbols object (moduledoc_functions apiDoc) (module_methods modInfo))
@@ -218,26 +219,108 @@
 
 genProperties :: KnownSymbols -> Object -> [PropDoc] -> [(ShowS, (Since, Deprecated))]
 genProperties knownSymbols object apiDoc = 
-  [ (genProperty knownSymbols object property doc, (maybe "" propdoc_since doc, notDeprecated))
-  | (property, doc) <- properties object apiDoc ]
+  map snd $
+  sortBy (comparing fst) $    --sort into the order as they appear in the gtk-docs
 
-genProperty :: KnownSymbols -> Object -> Property -> Maybe PropDoc -> ShowS
-genProperty knownSymbols object property doc = 
+    [ (0
+      ,let doc = extraPropDocumentation getter setter in
+       (genAtterFromGetterSetter knownSymbols object getter setter (Just doc)
+      ,(propdoc_since doc, notDeprecated)))
+    | (getter, setter) <- extraProps ]
+
+ ++ [ (index
+      ,(genAtterFromGetterSetter knownSymbols object getter setter doc
+      ,(maybe "" propdoc_since doc, notDeprecated)))
+    | (((_, doc), index), (getter, setter)) <- directProps ]
+
+ ++ [ (index
+      ,(genAtterFromProperty knownSymbols object property doc
+      ,(maybe "" propdoc_since doc, notDeprecated)))
+    | ((property, doc), index) <- genericProps ]
+
+  where (genericProps, -- existing GObject properties with generic implementation
+         directProps,  -- existing GObject properties but with direct implementation
+         extraProps)   -- extra properties with direct implementation
+          = mergeBy (\((prop,_), _) (method, _) ->
+                      property_name prop `compare` drop 3 (method_name method))
+                    (sortBy (comparing (property_name.fst.fst)) (zip (properties object apiDoc) [1..]))
+                    (sortBy (comparing (method_name.fst)) (methodsThatLookLikeProperties object))
+
+extraPropDocumentation :: Method -> Method -> PropDoc
+extraPropDocumentation getter setter =
+  let propertyName = lowerCaseFirstChar (drop 3 (method_name getter)) in
+  PropDoc {
+    propdoc_name = "",
+    propdoc_paragraphs = [DocParaText
+                           [DocText ("'" ++ propertyName ++ "' property. See ")
+                           ,DocFuncXRef (method_cname getter)
+                           ,DocText " and "
+                           ,DocFuncXRef (method_cname setter)]],
+    propdoc_since = ""
+  }
+
+genAtter :: KnownSymbols -> Object -> Maybe PropDoc -> String -> String -> String -> String -> ShowS
+genAtter knownSymbols object doc propertyName propertyType getter setter = 
   formattedDoc.
   ss propertyName. ss " :: Attr ". objectType. sc ' '. ss propertyType. nl.
   ss propertyName. ss " = Attr ". 
-  indent 1. getter.
-  indent 1. setter
+  indent 1. ss getter.
+  indent 1. ss setter
   where objectType = ss (object_name object)
-        propertyName = lowerCaseFirstChar (property_name property)
+        formattedDoc = haddocFormatDeclaration knownSymbols False propdoc_paragraphs doc
+
+genAtterFromProperty :: KnownSymbols -> Object -> Property -> Maybe PropDoc -> ShowS
+genAtterFromProperty knownSymbols object property doc = 
+  genAtter knownSymbols object doc propertyName propertyType (getter "") (setter "")
+
+  where propertyName = lowerCaseFirstChar (property_name property)
+        (propertyType, gvalueConstructor) = genMarshalProperty knownSymbols (property_type property)
         getter = ss "(\\obj -> do ". ss gvalueConstructor. ss " result <- objectGetProperty \"". ss (property_cname property). ss "\"".
                  indent 7. ss "return result)"
         setter = ss "(\\obj val -> objectSetProperty obj \"". ss (property_cname property). ss "\" (". ss gvalueConstructor. ss " val))"
-        formattedDoc = case doc of
-          Nothing  -> ss "-- | \n-- \n"
-          Just doc -> ss "-- | ". haddocFormatParas knownSymbols False (propdoc_paragraphs doc). nl.
-                      ss "--\n"
-        (propertyType, gvalueConstructor) = genMarshalProperty knownSymbols (property_type property)
+
+genAtterFromGetterSetter :: KnownSymbols -> Object -> Method -> Method -> Maybe PropDoc -> ShowS
+genAtterFromGetterSetter knownSymbols object getterMethod setterMethod doc = 
+  genAtter knownSymbols object doc propertyName propertyType getter setter
+
+  where --propertyName = cFuncNameToHsPropName (method_cname getterMethod)
+        propertyName = lowerCaseFirstChar (drop 3 (method_name getterMethod))
+        (propertyType, _) = genMarshalResult knownSymbols (method_cname getterMethod)
+                              (method_return_type getterMethod)
+        getter = cFuncNameToHsName (method_cname getterMethod)
+        setter = cFuncNameToHsName (method_cname setterMethod)
+--        cFuncNameToHsPropName =
+--            lowerCaseFirstChar
+--          . concatMap upperCaseFirstChar
+--          . map fixCFunctionName
+--          . tail
+--          . dropWhile (/="get")
+--          . filter (not.null)
+--          . splitBy '_'
+
+methodsThatLookLikeProperties :: Object -> [(Method, Method)]
+methodsThatLookLikeProperties object =
+  filter (uncurry checkTypes) $
+  intersectBy comparingMethodName getters setters
+  where getters = [ method
+                  | method <- object_methods object
+                  , not (method_deprecated method) 
+                  , "Get" `isPrefixOf` method_name method ]
+        setters = [ method
+                  | method <- object_methods object
+                  , not (method_deprecated method) 
+                  , "Set" `isPrefixOf` method_name method ]
+
+        comparingMethodName method1 method2 = drop 3 (method_name method1)
+                                           == drop 3 (method_name method2)
+        intersectBy :: (a -> a -> Bool) -> [a] -> [a] -> [(a,a)]
+        intersectBy eq xs ys = [ (x,y) | x <- xs, Just y <- [find (eq x) ys] ]
+        
+        checkTypes getter setter =
+            length (method_parameters getter) == 0
+         && length (method_parameters setter) == 1
+         && method_return_type setter == "void"
+--         && method_return_type getter == parameter_type (method_parameters setter !! 0)
 
 signals :: Object -> [SignalDoc] -> [(Signal, Maybe SignalDoc)]
 signals object docs =
@@ -269,10 +352,15 @@
         returnType = convertSignalType knownSymbols (signal_return_type signal)
         signalName = ss (toStudlyCaps . canonicalSignalName . signal_cname $ signal)
         signalCName = sc '"'. ss (signal_cname signal). sc '"'
-        formattedDoc = case doc of
-          Nothing  -> ss "-- | \n-- \n"
-          Just doc -> ss "-- | ". haddocFormatParas knownSymbols False (signaldoc_paragraphs doc). nl.
-                      ss "--\n"
+        formattedDoc = haddocFormatDeclaration knownSymbols False signaldoc_paragraphs doc
+
+genImplements :: Object -> [(ShowS, (Since, Deprecated))]
+genImplements object = 
+  [ (genImplement object implement, ("", notDeprecated))
+  | implement <- object_implements object ] 
+
+genImplement object implements =
+  ss "instance ".ss (stripKnownPrefixes implements). ss "Class ". ss (object_name object)
 
 canonicalSignalName :: String -> String
 canonicalSignalName = map dashToUnderscore
@@ -307,6 +395,7 @@
                                  ++ show (objectParents object)) SymStructType
                 lookup ("GObject":os) = SymObjectType GObjectKind
                 lookup ("GtkObject":os) = SymObjectType GtkObjectKind
+                lookup ("GdkBitmap":os) = SymObjectType GObjectKind -- Hack!
                 lookup (_:os) = lookup os
         objectParents :: Object -> [String]
         objectParents object = object_cname object :
@@ -357,6 +446,24 @@
      cs -> nl.nl.comment.ss "* Signals".nl.
            doVersionIfDefs lines cs)
 
+genImports :: ModuleInfo -> ShowS
+genImports modInfo = 
+  (case [ ss importLine
+        | (importModule, importLine) <- stdModules ] of
+     []   -> id
+     mods -> lines mods. ss "\n\n").
+  lines [ ss importLine
+        | (importModule, importLine) <- extraModules ]
+  where (stdModules, extraModules)
+          | null (module_imports modInfo) =
+             ([(undefined, "import Monad\t(liftM)")]
+             ,[(undefined, "import System.Glib.FFI")
+             ,(undefined, "{#import Graphics.UI.Gtk.Types#}")
+             ,(undefined, "-- CHECKME: extra imports may be required")])
+          | otherwise = partition (\(mod, _) -> mod `elem` knownStdModules)
+                                  (module_imports modInfo)
+        knownStdModules = ["Maybe", "Monad", "Char", "List", "Data.IORef"]
+
 genTodoItems :: Object -> ShowS
 genTodoItems object =
   let varargsFunctions = 

Index: Api.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Api.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- Api.hs	20 Feb 2005 18:52:09 -0000	1.3
+++ Api.hs	27 Feb 2005 20:02:16 -0000	1.4
@@ -56,6 +56,7 @@
     object_methods :: [Method],
     object_properties :: [Property],
     object_signals :: [Signal],
+    object_implements :: [String],
     object_deprecated :: Bool,
     object_isinterface ::Bool
   } deriving Show
@@ -177,7 +178,7 @@
                       remainder) content)) =
   let (parent, deprecated) =
         case remainder of
-          [] | Xml.verbatim cname == "GdkBitmap" -> ([Left "GdkDrawable"], False) --Hack
+          [] -> ([Left "Unknown"], False)
           [("parent", Xml.AttValue parent)] -> (parent, False)
           [("deprecated", Xml.AttValue deprecated),
            ("parent", Xml.AttValue parent)] -> (parent, True)
@@ -189,6 +190,7 @@
     object_methods = catMaybes (map extractMethod content),
     object_properties = catMaybes (map extractProperty content),
     object_signals = catMaybes (map extractSignal content),
+    object_implements = concat (catMaybes (map extractImplements content)),
     object_deprecated = deprecated,
     object_isinterface = False
   }
@@ -203,6 +205,7 @@
     object_methods = catMaybes (map extractMethod content),
     object_properties = catMaybes (map extractProperty content),
     object_signals = catMaybes (map extractSignal content),
+    object_implements = concat (catMaybes (map extractImplements content)),
     object_deprecated = False,
     object_isinterface = True
   }
@@ -338,6 +341,15 @@
   }
 extractSignal _ = Nothing
 
+extractImplements :: Xml.Content -> Maybe [String]
+extractImplements (Xml.CElem (Xml.Elem "implements" [] interfaces)) =
+  Just $ map extractInterface interfaces
+extractImplements _ = Nothing
+
+extractInterface :: Xml.Content -> String
+extractInterface (Xml.CElem (Xml.Elem "interface"
+                    [("cname", Xml.AttValue cname)] [] )) = Xml.verbatim cname
+
 extractMisc :: Xml.Content -> Maybe Misc
 extractMisc (Xml.CElem (Xml.Elem elem
                   (("name", Xml.AttValue name):

Index: FormatDocs.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/FormatDocs.hs,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- FormatDocs.hs	25 Feb 2005 01:32:11 -0000	1.7
+++ FormatDocs.hs	27 Feb 2005 20:02:16 -0000	1.8
@@ -8,6 +8,7 @@
 
 module FormatDocs (
   genModuleDocumentation,
+  haddocFormatDeclaration,
   cFuncNameToHsName,
   cParamNameToHsName,
   toStudlyCaps,
@@ -21,8 +22,8 @@
 
 import Api (NameSpace(namespace_name))
 import Docs
-import Marshal (stripKnownPrefixes, knownMiscType, KnownSymbols, CSymbol(..))
-import MarshalFixup (fixCFunctionName)
+import Marshal (KnownSymbols, CSymbol(..))
+import MarshalFixup (stripKnownPrefixes, knownMiscType, fixCFunctionName)
 import StringUtils
 
 import Maybe (isJust)
@@ -38,7 +39,7 @@
 genModuleDocumentation knownSymbols moduledoc =
   (if null (moduledoc_description moduledoc)
      then id
-     else comment.ss "* Description".nl.
+     else comment.ss "* Detail".nl.
           comment.nl.
           comment.ss "| ".haddocFormatParas knownSymbols False (moduledoc_description moduledoc).nl).
   (if null (moduledoc_sections moduledoc)
@@ -52,6 +53,12 @@
           comment.ss "|  ".haddocFormatHierarchy knownSymbols (moduledoc_hierarchy moduledoc).nl.
           comment.ss "@".nl)
 
+haddocFormatDeclaration :: KnownSymbols -> Bool -> (doc -> [DocPara]) -> Maybe doc -> ShowS
+haddocFormatDeclaration knownSymbols handleNULLs doc_paragraphs Nothing = ss "-- | \n--\n"
+haddocFormatDeclaration knownSymbols handleNULLs doc_paragraphs (Just doc)
+  = ss "-- | ". haddocFormatParas knownSymbols handleNULLs (doc_paragraphs doc). nl.
+    ss "--\n"
+
 haddocFormatHierarchy :: KnownSymbols -> [DocParaSpan] -> ShowS
 haddocFormatHierarchy knownSymbols =
     sepBy "\n-- |"

Index: ApiGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/ApiGen.hs,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -d -r1.17 -r1.18
--- ApiGen.hs	21 Feb 2005 11:03:06 -0000	1.17
+++ ApiGen.hs	27 Feb 2005 20:02:15 -0000	1.18
@@ -140,7 +140,7 @@
               Just moduleInfo -> do mkDirHier outdir (splitOn '.' (module_prefix moduleInfo))
                                     return moduleInfo
               Nothing -> do
-                when (not (null moduleRoot)) $
+                when (not (null moduleRoot) && not (object_deprecated object)) $
                   putStrLn ("Warning: no existing module found for module "
 	                  ++ show (object_name object))
                 return ModuleInfo {
@@ -172,8 +172,7 @@
                                  then module_name moduleInfo
                                  else module_prefix moduleInfo ++ "." ++ module_name moduleInfo
 	    "EXPORTS"        -> genExports object moduleDoc moduleInfo
-	    "IMPORTS"        -> ss $ "{#import Graphics.UI.Gtk.Types#}\n"
-                                  ++ "-- CHECKME: extra imports may be required\n"
+	    "IMPORTS"        -> genImports moduleInfo
 	    "CONTEXT_LIB"    -> ss $ module_context_lib moduleInfo
 	    "CONTEXT_PREFIX" -> ss $ module_context_prefix  moduleInfo
 	    "MODULE_BODY"    -> genModuleBody knownTypes object moduleDoc moduleInfo

Index: StringUtils.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/StringUtils.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- StringUtils.hs	7 Feb 2005 00:38:02 -0000	1.2
+++ StringUtils.hs	27 Feb 2005 20:02:13 -0000	1.3
@@ -74,3 +74,14 @@
                    ([],_) -> Nothing
                    (w,_:r) -> Just (w,r)
                    (w,[]) -> Just (w,[]))
+
+-- mergeBy cmp xs ys = (only_in_xs, in_both, only_in_ys)
+mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> ([a], [(a, b)], [b])
+mergeBy cmp = merge [] [] []
+  where merge l m r []     ys     = (reverse l, reverse m, reverse (ys++r))
+        merge l m r xs     []     = (reverse (xs++l), reverse m, reverse r)
+        merge l m r (x:xs) (y:ys) = 
+          case x `cmp` y of
+            GT -> merge    l         m  (y:r) (x:xs)    ys
+            EQ -> merge    l  ((x,y):m)    r     xs     ys
+            LT -> merge (x:l)        m     r     xs  (y:ys)

Index: MarshalFixup.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/MarshalFixup.hs,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- MarshalFixup.hs	25 Feb 2005 01:32:11 -0000	1.2
+++ MarshalFixup.hs	27 Feb 2005 20:02:17 -0000	1.3
@@ -53,7 +53,9 @@
 leafClass :: String -> Bool
 leafClass "GtkAdjustment" = True
 leafClass "GdkPixbuf"     = True
-leafClass "GtkIconFactory" = True
+leafClass "GtkIconFactory"  = True
+leafClass "GtkEntryCompletion" = True
+leafClass "GtkFileFilter" = True
 leafClass _ = False
 
 -- This is a table of fixup information. It lists function parameters that

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/General General.chs,1.3,1.4

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/General
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32363/gtk/Graphics/UI/Gtk/General

Modified Files:
	General.chs 
Log Message:
GObject.chs.pp: change mkDestructor into mkFunPtrDestructor which is a tad
	more abstract (hiding the use of IORefs).

General.chs: change use of mkDestructor to mkFunPtrDestructor and no longer
	export mkDestructor.

EntryCompletion.chs.pp, TreeSelection.chs.pp, TreeView.chs.pp: change use of
	mkDestructor to mkFunPtrDestructor.

Signal.chs-boot2: Following the same pattern for GClosureNotify as for
	GDestroyNotify above define a local copy of mkFunPtrDestructor for use
	in signal connection functions.

HookGenerator.hs: change use of mkDestructor to mkFunPtrDestructor following
	the same pattern as before. This reduces code duplication a bit (saves
	about 350 lines of code).


Index: General.chs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/General/General.chs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- General.chs	12 Feb 2005 17:19:22 -0000	1.3
+++ General.chs	27 Feb 2005 19:42:06 -0000	1.4
@@ -40,8 +40,6 @@
   grabAdd,
   grabGetCurrent,
   grabRemove,
-  mkDestructor,
-  DestroyNotify,
   priorityLow,
   priorityDefault,
   priorityHigh,
@@ -59,6 +57,7 @@
 
 import System.Glib.FFI
 import System.Glib.UTFString
+import System.Glib.GObject		(DestroyNotify, mkFunPtrDestructor)
 import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
 {#import Graphics.UI.Gtk.Types#}	 
 {#import Graphics.UI.Gtk.Signals#}
@@ -183,12 +182,8 @@
 
 {#pointer GSourceFunc as Function#}
 
-{#pointer GDestroyNotify as DestroyNotify#}
-
 foreign import ccall "wrapper" mkHandler :: IO {#type gint#} -> IO Function
 
-foreign import ccall "wrapper" mkDestructor :: IO () -> IO DestroyNotify
-
 type HandlerId = {#type guint#}
 
 -- Turn a function into a function pointer and a destructor pointer.
@@ -196,12 +191,7 @@
 makeCallback :: IO {#type gint#} -> IO (Function, DestroyNotify)
 makeCallback fun = do
   funPtr <- mkHandler fun
-  dRef <- newIORef nullFunPtr
-  dPtr <- mkDestructor $ do
-    freeHaskellFunPtr funPtr
-    dPtr <- readIORef dRef
-    freeHaskellFunPtr dPtr
-  writeIORef dRef dPtr
+  dPtr <- mkFunPtrDestructor funPtr
   return (funPtr, dPtr)
 
 -- | Register a function that is to be called after

[Gtk2hs-commit] gtk2hs ChangeLog,1.372,1.373

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32363

Modified Files:
	ChangeLog 
Log Message:
GObject.chs.pp: change mkDestructor into mkFunPtrDestructor which is a tad
	more abstract (hiding the use of IORefs).

General.chs: change use of mkDestructor to mkFunPtrDestructor and no longer
	export mkDestructor.

EntryCompletion.chs.pp, TreeSelection.chs.pp, TreeView.chs.pp: change use of
	mkDestructor to mkFunPtrDestructor.

Signal.chs-boot2: Following the same pattern for GClosureNotify as for
	GDestroyNotify above define a local copy of mkFunPtrDestructor for use
	in signal connection functions.

HookGenerator.hs: change use of mkDestructor to mkFunPtrDestructor following
	the same pattern as before. This reduces code duplication a bit (saves
	about 350 lines of code).


Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.372
retrieving revision 1.373
diff -u -d -r1.372 -r1.373
--- ChangeLog	26 Feb 2005 02:54:34 -0000	1.372
+++ ChangeLog	27 Feb 2005 19:42:05 -0000	1.373
@@ -1,3 +1,25 @@
+2005-02-27 Duncan Coutts <du...@co...>
+
+	* glib/System/Glib/GObject.chs.pp: change mkDestructor into
+	mkFunPtrDestructor which is a tad more abstract (hiding the use of
+	IORefs). Also this reduces the amount of code in client modules.
+
+	* gtk/Graphics/UI/Gtk/General/General.chs: change use of mkDestructor
+	to mkFunPtrDestructor and no longer export mkDestructor.
+
+	* gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp,
+	gtk/Graphics/UI/Gtk/TreeList/TreeSelection.chs.pp,
+	gtk/Graphics/UI/Gtk/TreeList/TreeView.chs.pp: change use of
+	mkDestructor to mkFunPtrDestructor.
+
+	* tools/callbackGen/Signal.chs-boot2: Following	the same pattern for
+	GClosureNotify as for GDestroyNotify above define a local copy of
+	mkFunPtrDestructor for use in signal connection	functions.
+
+	* tools/callbackGen/HookGenerator.hs: change use of mkDestructor to
+	mkFunPtrDestructor following the same pattern as before. This reduces
+	code duplication a bit (saves about 350 lines of code).
+
 2005-02-26 Duncan Coutts <du...@co...>
 
 	* tools/callbackGen/Signal.chs-boot1: add #hide Haddock annotation so

[Gtk2hs-commit] gtk2hs/tools/callbackGen Signal.chs-boot2,1.5,1.6 HookGenerator.hs,1.3,1.4

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/tools/callbackGen
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32363/tools/callbackGen

Modified Files:
	Signal.chs-boot2 HookGenerator.hs 
Log Message:
GObject.chs.pp: change mkDestructor into mkFunPtrDestructor which is a tad
	more abstract (hiding the use of IORefs).

General.chs: change use of mkDestructor to mkFunPtrDestructor and no longer
	export mkDestructor.

EntryCompletion.chs.pp, TreeSelection.chs.pp, TreeView.chs.pp: change use of
	mkDestructor to mkFunPtrDestructor.

Signal.chs-boot2: Following the same pattern for GClosureNotify as for
	GDestroyNotify above define a local copy of mkFunPtrDestructor for use
	in signal connection functions.

HookGenerator.hs: change use of mkDestructor to mkFunPtrDestructor following
	the same pattern as before. This reduces code duplication a bit (saves
	about 350 lines of code).


Index: HookGenerator.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/callbackGen/HookGenerator.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- HookGenerator.hs	20 Dec 2004 03:25:55 -0000	1.3
+++ HookGenerator.hs	27 Feb 2005 19:42:07 -0000	1.4
@@ -463,12 +463,7 @@
   indent 4.ss "liftM ".mkMarshRet sig.ss " $".
   indent 5.ss "user".mkFuncArgs sig.
   indent 3.sc ')'.
-  indent 2.ss "dRef <- newIORef nullFunPtr".
-  indent 2.ss "dPtr <- mkDestructor $ do".
-  indent 3.ss "freeHaskellFunPtr hPtr".
-  indent 3.ss "dPtr <- readIORef dRef".
-  indent 3.ss "freeHaskellFunPtr dPtr".
-  indent 2.ss "writeIORef dRef dPtr".
+  indent 2.ss "dPtr <- mkFunPtrDestructor hPtr".
   indent 2.ss "sigId <- withCString signal $ \\nPtr ->".
   indent 3.ss "withForeignPtr ((unGObject.toGObject) obj) $ \\objPtr ->".
   indent 4.ss "{#call unsafe g_signal_connect_data#} (castPtr objPtr)".

Index: Signal.chs-boot2
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/callbackGen/Signal.chs-boot2,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Signal.chs-boot2	8 Jan 2005 17:27:26 -0000	1.5
+++ Signal.chs-boot2	27 Feb 2005 19:42:07 -0000	1.6
@@ -9,7 +9,7 @@
 
 import System.Glib.FFI
 import System.Glib.GError   (failOnGError)
-{#import System.Glib.GObject#} hiding (mkDestructor)
+{#import System.Glib.GObject#} hiding (mkFunPtrDestructor)
 
 {#context lib="gtk" prefix="gtk" #}
 
@@ -27,6 +27,16 @@
 
 foreign import ccall "wrapper" mkDestructor :: IO () -> IO GClosureNotify
 
+mkFunPtrDestructor :: FunPtr a -> IO GClosureNotify
+mkFunPtrDestructor hPtr = do
+  dRef <- newIORef nullFunPtr
+  dPtr <- mkDestructor $ do
+    freeHaskellFunPtr hPtr
+    dPtr <- readIORef dRef
+    freeHaskellFunPtr dPtr
+  writeIORef dRef dPtr
+  return dPtr
+
 disconnect :: GObjectClass obj => ConnectId obj -> IO ()
 disconnect (ConnectID handler obj) =
   withForeignPtr  ((unGObject.toGObject) obj) $ \objPtr ->

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/TreeList TreeSelection.chs.pp,1.2,1.3 TreeView.chs.pp,1.6,1.7

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/TreeList
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32363/gtk/Graphics/UI/Gtk/TreeList

Modified Files:
	TreeSelection.chs.pp TreeView.chs.pp 
Log Message:
GObject.chs.pp: change mkDestructor into mkFunPtrDestructor which is a tad
	more abstract (hiding the use of IORefs).

General.chs: change use of mkDestructor to mkFunPtrDestructor and no longer
	export mkDestructor.

EntryCompletion.chs.pp, TreeSelection.chs.pp, TreeView.chs.pp: change use of
	mkDestructor to mkFunPtrDestructor.

Signal.chs-boot2: Following the same pattern for GClosureNotify as for
	GDestroyNotify above define a local copy of mkFunPtrDestructor for use
	in signal connection functions.

HookGenerator.hs: change use of mkDestructor to mkFunPtrDestructor following
	the same pattern as before. This reduces code duplication a bit (saves
	about 350 lines of code).


Index: TreeSelection.chs.pp
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/TreeList/TreeSelection.chs.pp,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -d -r1.2 -r1.3
--- TreeSelection.chs.pp	25 Feb 2005 01:11:37 -0000	1.2
+++ TreeSelection.chs.pp	27 Feb 2005 19:42:06 -0000	1.3
@@ -97,17 +97,16 @@
   ) where
 
 import Monad	(liftM)
-import Data.IORef (newIORef, readIORef, writeIORef)
 
 import System.Glib.FFI
 import System.Glib.GList                (GList, fromGList, toGList)
+import System.Glib.GObject		(mkFunPtrDestructor)
 import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
 {#import Graphics.UI.Gtk.Types#}
 {#import Graphics.UI.Gtk.Signals#}
 import Graphics.UI.Gtk.General.Enums    (SelectionMode(..))
 {#import Graphics.UI.Gtk.TreeList.TreeModel#}
 import Graphics.UI.Gtk.General.Structs	(treeIterSize)
-import Graphics.UI.Gtk.General.General	(mkDestructor)
 
 {# context lib="gtk" prefix="gtk" #}
 
@@ -140,12 +139,7 @@
     path <- nativeTreePathGetIndices (NativeTreePath (castPtr tp))
     liftM fromBool $ fun path
     )
-  dRef <- newIORef nullFunPtr
-  dPtr <- mkDestructor $ do
-    dPtr <- readIORef dRef
-    freeHaskellFunPtr dPtr
-    freeHaskellFunPtr fPtr
-  writeIORef dRef dPtr
+  dPtr <- mkFunPtrDestructor fPtr
   {#call tree_selection_set_select_function#} (toTreeSelection ts) fPtr 
     nullPtr dPtr
 

Index: TreeView.chs.pp
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/TreeList/TreeView.chs.pp,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- TreeView.chs.pp	25 Feb 2005 22:53:42 -0000	1.6
+++ TreeView.chs.pp	27 Feb 2005 19:42:06 -0000	1.7
@@ -166,15 +166,13 @@
 
 import Monad	(liftM, mapM)
 import Maybe	(fromMaybe)
-import Data.IORef (newIORef, readIORef, writeIORef)
 
 import System.Glib.FFI
 import System.Glib.UTFString
-import Graphics.UI.Gtk.General.General	(mkDestructor)
+import System.Glib.GList		(GList, fromGList)
+import System.Glib.GObject		(makeNewGObject, mkFunPtrDestructor)
 import Graphics.UI.Gtk.General.Structs	(Point, Rectangle)
-import System.Glib.GObject		(makeNewGObject)
 import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
-import System.Glib.GList		(GList, fromGList)
 {#import Graphics.UI.Gtk.Types#}
 {#import Graphics.UI.Gtk.Signals#}
 {#import Graphics.UI.Gtk.TreeList.TreeModel#}
@@ -811,12 +809,7 @@
     key <- peekUTFString keyPtr
     iter <- createTreeIter itPtr
     liftM fromBool $ pred (fromIntegral col) key iter)
-  dRef <- newIORef nullFunPtr
-  dPtr <- mkDestructor $ do
-    dPtr <- readIORef dRef
-    freeHaskellFunPtr dPtr
-    freeHaskellFunPtr fPtr
-  writeIORef dRef dPtr
+  dPtr <- mkFunPtrDestructor fPtr
   {#call tree_view_set_search_equal_func#} (toTreeView tv) fPtr 
     nullPtr dPtr
 

[Gtk2hs-commit] gtk2hs/glib/System/Glib GObject.chs.pp,1.1,1.2

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/glib/System/Glib
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32363/glib/System/Glib

Modified Files:
	GObject.chs.pp 
Log Message:
GObject.chs.pp: change mkDestructor into mkFunPtrDestructor which is a tad
	more abstract (hiding the use of IORefs).

General.chs: change use of mkDestructor to mkFunPtrDestructor and no longer
	export mkDestructor.

EntryCompletion.chs.pp, TreeSelection.chs.pp, TreeView.chs.pp: change use of
	mkDestructor to mkFunPtrDestructor.

Signal.chs-boot2: Following the same pattern for GClosureNotify as for
	GDestroyNotify above define a local copy of mkFunPtrDestructor for use
	in signal connection functions.

HookGenerator.hs: change use of mkDestructor to mkFunPtrDestructor following
	the same pattern as before. This reduces code duplication a bit (saves
	about 350 lines of code).


Index: GObject.chs.pp
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/glib/System/Glib/GObject.chs.pp,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -d -r1.1 -r1.2
--- GObject.chs.pp	8 Jan 2005 17:46:16 -0000	1.1
+++ GObject.chs.pp	27 Feb 2005 19:42:06 -0000	1.2
@@ -35,8 +35,9 @@
   objectRef,
   objectUnref,
   makeNewGObject,
+  DestroyNotify,
+  mkFunPtrDestructor,
   GWeakNotify,
-  mkDestructor,
   objectWeakref,
   objectWeakunref
   ) where
@@ -84,14 +85,9 @@
 objectUnref :: Ptr a -> FinalizerPtr a
 objectUnref _ = object_unref'
 
-#elif __GLASGOW_HASKELL__>=504
-
-foreign import ccall unsafe "g_object_unref"
-  objectUnref :: Ptr a -> IO ()
-
 #else
 
-foreign import ccall "g_object_unref" unsafe
+foreign import ccall unsafe "g_object_unref"
   objectUnref :: Ptr a -> IO ()
 
 #endif
@@ -110,6 +106,25 @@
   obj <- newForeignPtr objPtr (objectUnref objPtr)
   return $ constr obj
 
+{#pointer GDestroyNotify as DestroyNotify#}
+
+foreign import ccall "wrapper" mkDestroyNotifyPtr :: IO () -> IO DestroyNotify
+
+-- | Many methods in classes derived from GObject take a callback function and
+-- a destructor function which is called to free that callback function when
+-- it is no longer required. This function constructs a DestroyNotify function
+-- pointer which when called from C land will free the given Haskell function
+-- pointer (and itself).
+mkFunPtrDestructor :: FunPtr a -> IO DestroyNotify
+mkFunPtrDestructor hPtr = do
+  dRef <- newIORef nullFunPtr
+  dPtr <- mkDestroyNotifyPtr $ do
+    freeHaskellFunPtr hPtr
+    dPtr <- readIORef dRef
+    freeHaskellFunPtr dPtr
+  writeIORef dRef dPtr
+  return dPtr
+
 {#pointer GWeakNotify#}
 
 foreign import ccall "wrapper" mkDestructor :: IO () -> IO GWeakNotify

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Entry EntryCompletion.chs.pp,1.4,1.5

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv32363/gtk/Graphics/UI/Gtk/Entry

Modified Files:
	EntryCompletion.chs.pp 
Log Message:
GObject.chs.pp: change mkDestructor into mkFunPtrDestructor which is a tad
	more abstract (hiding the use of IORefs).

General.chs: change use of mkDestructor to mkFunPtrDestructor and no longer
	export mkDestructor.

EntryCompletion.chs.pp, TreeSelection.chs.pp, TreeView.chs.pp: change use of
	mkDestructor to mkFunPtrDestructor.

Signal.chs-boot2: Following the same pattern for GClosureNotify as for
	GDestroyNotify above define a local copy of mkFunPtrDestructor for use
	in signal connection functions.

HookGenerator.hs: change use of mkDestructor to mkFunPtrDestructor following
	the same pattern as before. This reduces code duplication a bit (saves
	about 350 lines of code).


Index: EntryCompletion.chs.pp
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- EntryCompletion.chs.pp	25 Feb 2005 22:53:42 -0000	1.4
+++ EntryCompletion.chs.pp	27 Feb 2005 19:42:06 -0000	1.5
@@ -26,7 +26,7 @@
 --
 -- Completion functionality for the 'Entry' widget.
 --
--- * Added in GTK+ 2.4
+-- * Available since Gtk version 2.4
 --
 module Graphics.UI.Gtk.Entry.EntryCompletion (
 -- * Description
@@ -95,7 +95,7 @@
 
 import System.Glib.FFI
 import System.Glib.UTFString
-import System.Glib.GObject		(makeNewGObject)
+import System.Glib.GObject		(makeNewGObject, mkFunPtrDestructor)
 import Graphics.UI.Gtk.Abstract.Object  (makeNewObject)
 {#import Graphics.UI.Gtk.Types#}
 {#import Graphics.UI.Gtk.Signals#}
@@ -172,9 +172,6 @@
 -------------------------------------------------
 -- Callback stuff for entryCompletionSetMatchFunc
 --
-{#pointer GDestroyNotify#}
-
-foreign import ccall "wrapper" mkDestructor :: IO () -> IO GDestroyNotify
 
 type GtkEntryCompletionMatchFunc =
   Ptr EntryCompletion -> --GtkEntryCompletion *completion
@@ -195,12 +192,7 @@
     (\_ keyPtr iterPtr _ -> do key <- peekUTFString keyPtr
                                iter <- createTreeIter iterPtr
                                user key iter)
-  dRef <- newIORef nullFunPtr
-  dPtr <- mkDestructor $ do
-    freeHaskellFunPtr hPtr
-    dPtr <- readIORef dRef
-    freeHaskellFunPtr dPtr
-  writeIORef dRef dPtr
+  dPtr <- mkFunPtrDestructor hPtr
   {# call gtk_entry_completion_set_match_func #} ec
     (castFunPtr hPtr) nullPtr dPtr
 #endif

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI Gtk.hs,1.4,1.5

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17085/gtk/Graphics/UI

Modified Files:
	Gtk.hs 
Log Message:
Change the names of the two modules, GArrow and FileSel.


Index: Gtk.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk.hs,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -d -r1.4 -r1.5
--- Gtk.hs	17 Feb 2005 00:13:20 -0000	1.4
+++ Gtk.hs	26 Feb 2005 02:54:35 -0000	1.5
@@ -55,7 +55,6 @@
   -- * Windows
   module Graphics.UI.Gtk.Windows.Window,
   module Graphics.UI.Gtk.Windows.Dialog,
-  module Graphics.UI.Gtk.Windows.FileSel,
   -- * Display widgets,
   module Graphics.UI.Gtk.Display.AccelLabel,
   module Graphics.UI.Gtk.Display.Image,
@@ -113,7 +112,7 @@
   -- * Selectors (file\/font\/color)
   module Graphics.UI.Gtk.Selectors.ColorSelection,
   module Graphics.UI.Gtk.Selectors.ColorSelectionDialog,
---  module FileSelection,
+  module Graphics.UI.Gtk.Selectors.FileSelection,
   module Graphics.UI.Gtk.Selectors.FontSelection,
   module Graphics.UI.Gtk.Selectors.FontSelectionDialog,
 --  module InputDialog,
@@ -145,7 +144,7 @@
   module Graphics.UI.Gtk.Scrolling.VScrollbar,
   -- * Miscellaneous
   module Graphics.UI.Gtk.Misc.Adjustment,
-  module Graphics.UI.Gtk.Misc.GArrow,
+  module Graphics.UI.Gtk.Misc.Arrow,
   module Graphics.UI.Gtk.Misc.Calendar,
   module Graphics.UI.Gtk.Misc.DrawingArea,
   module Graphics.UI.Gtk.Misc.EventBox,
@@ -196,7 +195,6 @@
 import Graphics.UI.Gtk.Gdk.Gdk
 -- windows
 import Graphics.UI.Gtk.Windows.Dialog
-import Graphics.UI.Gtk.Windows.FileSel
 import Graphics.UI.Gtk.Windows.Window
 --import WindowGroup
 -- display widgets
@@ -265,7 +263,7 @@
 -- selectors (file\/font\/color\/input device)
 import Graphics.UI.Gtk.Selectors.ColorSelection
 import Graphics.UI.Gtk.Selectors.ColorSelectionDialog
---import FileSelection
+import Graphics.UI.Gtk.Selectors.FileSelection
 import Graphics.UI.Gtk.Selectors.FileChooser
 import Graphics.UI.Gtk.Selectors.FileChooserDialog
 import Graphics.UI.Gtk.Selectors.FileChooserWidget
@@ -296,7 +294,7 @@
 import Graphics.UI.Gtk.Scrolling.ScrolledWindow
 -- miscellaneous
 import Graphics.UI.Gtk.Misc.Adjustment
-import Graphics.UI.Gtk.Misc.GArrow
+import Graphics.UI.Gtk.Misc.Arrow
 import Graphics.UI.Gtk.Misc.Calendar
 import Graphics.UI.Gtk.Misc.DrawingArea
 import Graphics.UI.Gtk.Misc.EventBox

[Gtk2hs-commit] gtk2hs ChangeLog,1.371,1.372 Makefile.am,1.53,1.54

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv17085

Modified Files:
	ChangeLog Makefile.am 
Log Message:
Change the names of the two modules, GArrow and FileSel.


Index: Makefile.am
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/Makefile.am,v
retrieving revision 1.53
retrieving revision 1.54
diff -u -d -r1.53 -r1.54
--- Makefile.am	26 Feb 2005 02:03:03 -0000	1.53
+++ Makefile.am	26 Feb 2005 02:54:34 -0000	1.54
@@ -365,7 +365,7 @@
 	gtk/Graphics/UI/Gtk/Misc/Calendar.chs.pp			\
 	gtk/Graphics/UI/Gtk/Misc/DrawingArea.chs			\
 	gtk/Graphics/UI/Gtk/Misc/EventBox.chs.pp			\
-	gtk/Graphics/UI/Gtk/Misc/GArrow.chs				\
+	gtk/Graphics/UI/Gtk/Misc/Arrow.chs				\
 	gtk/Graphics/UI/Gtk/Misc/HandleBox.chs				\
 	gtk/Graphics/UI/Gtk/Misc/SizeGroup.chs				\
 	gtk/Graphics/UI/Gtk/Misc/Tooltips.chs.pp			\
@@ -397,7 +397,7 @@
 	gtk/Graphics/UI/Gtk/TreeList/TreeStore.chs.pp			\
 	gtk/Graphics/UI/Gtk/TreeList/TreeView.chs.pp			\
 	gtk/Graphics/UI/Gtk/Windows/Dialog.chs				\
-	gtk/Graphics/UI/Gtk/Windows/FileSel.chs.pp			\
+	gtk/Graphics/UI/Gtk/Selectors/FileSelection.chs.pp		\
 	gtk/Graphics/UI/Gtk/Windows/Window.chs.pp			\
 	gtk/Graphics/UI/Gtk/Gdk/Drawable.chs.pp				\
 	gtk/Graphics/UI/Gtk/Gdk/GC.chs					\

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.371
retrieving revision 1.372
diff -u -d -r1.371 -r1.372
--- ChangeLog	26 Feb 2005 02:17:26 -0000	1.371
+++ ChangeLog	26 Feb 2005 02:54:34 -0000	1.372
@@ -32,6 +32,9 @@
 
 	* Makefile.am: change names of the two modules, GArrow and FileSel.
 
+	* gtk/Graphics/UI/Gtk.hs: change the names of the two modules, GArrow
+	and FileSel.
+
 2005-02-25 Duncan Coutts <du...@co...>
 
 	* gtk/Graphics/UI/Gtk/Abstract/Bin.chs,

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Selectors FileSelection.chs.pp,NONE,1.1

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Selectors
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5954/gtk/Graphics/UI/Gtk/Selectors

Added Files:
	FileSelection.chs.pp 
Log Message:
Rename the GArrow module to Arrow.
Rename the Windows.FileSel module to Selectors.FileSelection
Various documentation and formattign changes to both modules too.
Update Makefile.am accordingly and remove the TODO item.


--- NEW FILE: FileSelection.chs.pp ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget FileSelection
--
--  Author : Manuel M T Chakravarty
--
--  Created: 20 January 1999
--
--  Version $Revision: 1.1 $ from $Date: 2005/02/26 02:17:27 $
--
--  Copyright (C) 1999-2005 Manuel M T Chakravarty, Jens Petersen
--
--  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.
--
-- TODO
--
-- Fix fileSelectionQueryButtons
--
-- |
-- Maintainer  : gtk...@li...
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- Prompt the user for a file or directory name.
--
-- * As of Gtk+ 2.4 this module has been deprecated in favour of 'FileChooser'
--
module Graphics.UI.Gtk.Selectors.FileSelection (
-- * Description
-- 
-- | 'FileSelection' should be used to retrieve file or directory names from
-- the user. It will create a new dialog window containing a directory list,
-- and a file list corresponding to the current working directory. The
-- filesystem can be navigated using the directory list or the drop-down
-- history menu. Alternatively, the TAB key can be used to navigate using
-- filename completion - common in text based editors such as emacs and jed.
--
-- File selection dialogs are created with a call to 'fileSelectionNew'.
--
-- The default filename can be set using 'fileSelectionSetFilename' and the
-- selected filename retrieved using 'fileSelectionGetFilename'.
--
-- Use 'fileSelectionComplete' to display files and directories that match a
-- given pattern. This can be used for example, to show only *.txt files, or
-- only files beginning with gtk*.
--
-- Simple file operations; create directory, delete file, and rename file,
-- are available from buttons at the top of the dialog. These can be hidden
-- using 'fileSelectionHideFileopButtons' and shown again using
-- 'fileSelectionShowFileopButtons'.
--

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Container'
-- |                     +----'Bin'
-- |                           +----'Window'
-- |                                 +----'Dialog'
-- |                                       +----FileSelection
-- @

-- * Types
  FileSelection,
  FileSelectionClass,
  castToFileSelection,

-- * Constructors
  fileSelectionNew,

-- * Methods
  fileSelectionSetFilename,
  fileSelectionGetFilename,
  fileSelectionShowFileopButtons,
  fileSelectionHideFileopButtons,
  fileSelectionGetButtons,
  fileSelectionComplete
  ) where

import Monad            (liftM)

import System.Glib.FFI
import System.Glib.UTFString
{#import Graphics.UI.Gtk.Types#}
import Graphics.UI.Gtk.Abstract.Object		(makeNewObject)
import Graphics.UI.Gtk.General.Structs		(fileSelectionGetButtons)

{# context lib="libgtk" prefix="gtk" #}

--------------------
-- Constructors

-- | Create a new file selection dialog with 
-- the given window title.
--
fileSelectionNew ::
    String
 -> IO FileSelection
fileSelectionNew title =
  makeNewObject mkFileSelection $ liftM castPtr $
  withUTFString title $ \titlePtr ->
  {# call unsafe file_selection_new #}
    titlePtr

--------------------
-- Methods

-- | Set the filename for the given file 
-- selection dialog.
--
fileSelectionSetFilename :: FileSelectionClass fsel => fsel -> String -> IO ()
fileSelectionSetFilename fsel str = 
  withUTFString str $ \strPtr -> 
#if defined (WIN32) && GTK_CHECK_VERSION(2,6,0)
    {#call unsafe file_selection_set_filename_utf8#}
#else
    {#call unsafe file_selection_set_filename#}
#endif
      (toFileSelection fsel) strPtr

-- | Get the filename currently selected by 
-- the given file selection dialog.
--
fileSelectionGetFilename :: FileSelectionClass fsel => fsel -> IO String
fileSelectionGetFilename fsel = 
  do
#if defined (WIN32) && GTK_CHECK_VERSION(2,6,0)
    strPtr <- {#call unsafe file_selection_get_filename_utf8#} 
#else
    strPtr <- {#call unsafe file_selection_get_filename#} 
#endif
      (toFileSelection fsel)
    peekUTFString strPtr

-- | Show the file operation buttons 
-- of the given file selection dialog.
--
fileSelectionShowFileopButtons :: FileSelectionClass fsel => fsel -> IO ()
fileSelectionShowFileopButtons  =
  {#call file_selection_show_fileop_buttons#} . toFileSelection

-- | Hide the file operation buttons 
-- of the given file selection dialog.
--
fileSelectionHideFileopButtons :: FileSelectionClass fsel => fsel -> IO ()
fileSelectionHideFileopButtons  =
  {#call file_selection_hide_fileop_buttons#} . toFileSelection

-- currently broken
-- -- query the widgets of the file selectors buttons
-- --
-- -- * this is useful to attach signals handlers to these buttons
-- --
-- -- * the buttons are OK & Cancel (in this order)
-- --
-- fileSelectionQueryButtons :: FileSelectionClass fsel 
-- 			  => fsel
-- 			  -> IO (Button, Button)
-- fileSelectionQueryButtons fsel =
--   withForeignPtr (unFileSelection $ toFileSelection fsel) $ \ ptr -> do
--       ok     <- {#get FileSelection.ok_button    #} ptr
--       cancel <- {#get FileSelection.cancel_button#} ptr
--       return (castToButton ok, castToButton cancel)

-- | Only show files matching pattern.
--
fileSelectionComplete :: FileSelectionClass fsel => fsel -> String -> IO ()
fileSelectionComplete fsel pattern =
  withUTFString pattern $ \patternPtr ->
    {#call file_selection_complete#} (toFileSelection fsel) patternPtr

[Gtk2hs-commit] gtk2hs TODO,1.8,1.9 ChangeLog,1.370,1.371

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5954

Modified Files:
	TODO ChangeLog 
Log Message:
Rename the GArrow module to Arrow.
Rename the Windows.FileSel module to Selectors.FileSelection
Various documentation and formattign changes to both modules too.
Update Makefile.am accordingly and remove the TODO item.


Index: TODO
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/TODO,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -d -r1.8 -r1.9
--- TODO	11 Feb 2005 18:29:50 -0000	1.8
+++ TODO	26 Feb 2005 02:17:26 -0000	1.9
@@ -1,20 +1,6 @@
 TODO for gtk2hs
 
-11/2/2005 Duncan Coutts <du...@co...>
-
-	* rename these modules:
-		Graphics/UI/Gtk/Misc/GArrow.chs
-	to	Graphics/UI/Gtk/Misc/Arrow.chs
-		Graphics/UI/Gtk/Windows/FileSel.chs
-	to	Graphics/UI/Gtk/Selectors/FileSelection.chs
-
 8/12/2004  Duncan Coutts <du...@co...>
-	
-	* automake issues, building targets that are pulled in by the
-	-include *.deps .depend lines somtimes seem to happen with the
-	wrong $(NAME), so the CFLAGS or other $(NAME)-dependant variables
-	come from the wrong package. To reproduce this problem set
-	libmogul_a_CPPFLAGS =	#nothing
 
 	* there sould be a rule to rebuild .chi files even if the corresponding
 	.hs file still exists. Otherwise the build can stick and you have to

Index: ChangeLog
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/ChangeLog,v
retrieving revision 1.370
retrieving revision 1.371
diff -u -d -r1.370 -r1.371
--- ChangeLog	26 Feb 2005 02:02:54 -0000	1.370
+++ ChangeLog	26 Feb 2005 02:17:26 -0000	1.371
@@ -21,6 +21,17 @@
 	.chs.pp files as well as .chs file when calculating the deps. This is
 	possibly a bit of a hack.
 
+	* gtk/Graphics/UI/Gtk/Misc/GArrow.chs,
+	  gtk/Graphics/UI/Gtk/Misc/Arrow.chs: rename module from GArrow.chs
+	and also make various documentation and formatting changes.
+
+	* gtk/Graphics/UI/Gtk/Windows/FileSel.chs.pp,
+	  gtk/Graphics/UI/Gtk/Selectors/FileSelection.chs.pp: rename module
+	and move it to a more appropriate category. Also make various
+	documentation and formatting changes.
+
+	* Makefile.am: change names of the two modules, GArrow and FileSel.
+
 2005-02-25 Duncan Coutts <du...@co...>
 
 	* gtk/Graphics/UI/Gtk/Abstract/Bin.chs,

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Misc Arrow.chs,NONE,1.1 GArrow.chs,1.2,NONE

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Misc
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5954/gtk/Graphics/UI/Gtk/Misc

Added Files:
	Arrow.chs 
Removed Files:
	GArrow.chs 
Log Message:
Rename the GArrow module to Arrow.
Rename the Windows.FileSel module to Selectors.FileSelection
Various documentation and formattign changes to both modules too.
Update Makefile.am accordingly and remove the TODO item.


--- GArrow.chs DELETED ---

--- NEW FILE: Arrow.chs ---
-- -*-haskell-*-
--  GIMP Toolkit (GTK) Widget Arrow
--
--  Author : Axel Simon
--
--  Created: 23 May 2001
--
--  Version $Revision: 1.1 $ from $Date: 2005/02/26 02:17:27 $
--
--  Copyright (C) 1999-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.
--
-- |
-- Maintainer  : gtk...@li...
-- Stability   : provisional
-- Portability : portable (depends on GHC)
--
-- An Arrow pointing in one of the four cardinal directions.
--
module Graphics.UI.Gtk.Misc.Arrow (
-- * Description
-- 
-- | 'Arrow' should be used to draw simple arrows that need to point in one of
-- the four cardinal directions (up, down, left, or right). The style of the
-- arrow can be one of shadow in, shadow out, etched in, or etched out. Note
-- that these directions and style types may be ammended in versions of Gtk to
-- come.
--
-- 'Arrow' will fill any space alloted to it, but since it is inherited from
-- 'Misc', it can be padded and\/or aligned, to fill exactly the space the
-- programmer desires.
--
-- Arrows are created with a call to 'arrowNew'. The direction or style of
-- an arrow can be changed after creation by using 'arrowSet'.

-- * Class Hierarchy
-- |
-- @
-- |  'GObject'
-- |   +----'Object'
-- |         +----'Widget'
-- |               +----'Misc'
-- |                     +----Arrow
-- @

-- * Types
  Arrow,
  ArrowClass,
  castToArrow,
  ArrowType(..),
  ShadowType(..),

-- * Constructors
  arrowNew,

-- * Methods
  arrowSet
  ) where

import Monad	(liftM)

import System.Glib.FFI
import Graphics.UI.Gtk.Abstract.Object	(makeNewObject)
{#import Graphics.UI.Gtk.Types#}
{#import Graphics.UI.Gtk.Signals#}
import Graphics.UI.Gtk.General.Enums	(ArrowType(..), ShadowType(..))

{# context lib="gtk" prefix="gtk" #}

--------------------
-- Constructors

-- | Creates a new arrow with display options.
--
arrowNew :: 
    ArrowType
 -> ShadowType
 -> IO Arrow
arrowNew arrowType shadowType =
  makeNewObject mkArrow $ liftM castPtr $ 
  {# call unsafe arrow_new #}
    ((fromIntegral . fromEnum) arrowType)
    ((fromIntegral . fromEnum) shadowType)

--------------------
-- Methods

-- | Sets the direction and style of the 'Arrow'.
--
arrowSet :: ArrowClass self => self
 -> ArrowType
 -> ShadowType
 -> IO ()
arrowSet self arrowType shadowType =
  {# call arrow_set #}
    (toArrow self)
    ((fromIntegral . fromEnum) arrowType)
    ((fromIntegral . fromEnum) shadowType)

[Gtk2hs-commit] gtk2hs/gtk/Graphics/UI/Gtk/Windows FileSel.chs.pp,1.1,NONE

[Duncan C. <dun...@us...>]

Update of /cvsroot/gtk2hs/gtk2hs/gtk/Graphics/UI/Gtk/Windows
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5954/gtk/Graphics/UI/Gtk/Windows

Removed Files:
	FileSel.chs.pp 
Log Message:
Rename the GArrow module to Arrow.
Rename the Windows.FileSel module to Selectors.FileSelection
Various documentation and formattign changes to both modules too.
Update Makefile.am accordingly and remove the TODO item.


--- FileSel.chs.pp DELETED ---