[Gtk2hs-commit] gtk2hs/tools/apiGen MarshalFixup.hs,NONE,1.1 Marshal.hs,1.5,1.6 FormatDocs.hs,1.5,1.6 CodeGen.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-serv2466/tools/apiGen

Modified Files:
	Marshal.hs FormatDocs.hs CodeGen.hs 
Added Files:
	MarshalFixup.hs 
Log Message:
MarshalFixup.hs: Add new module containing fixup information about specials
cases. This is existing tables of info moved out of Marshal.hs and
FormatDocs.hs so it is better seperated and so it's esier to change for people
who don't understand the rest of the code. Also added some more leaf classes
and some functions with maybe null return values.

Marshal.hs: move the tables of fixup info into their own module.

FormatDocs.hs: customise the C to Haskell function name conversion with a
bunch of special cases, eg "hadjustment" becomes "HAdjustment" rather than
"Hadjustment". The special cases go in the new MarshalFixup.hs module.

CodeGen.hs: fix generation of property and signal names


Index: Marshal.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/Marshal.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- Marshal.hs	21 Feb 2005 11:03:08 -0000	1.5
+++ Marshal.hs	23 Feb 2005 14:12:35 -0000	1.6
@@ -14,6 +14,8 @@
   genCall
   ) where
 
+import MarshalFixup
+
 import StringUtils
 import Char (isUpper)
 import Data.FiniteMap
@@ -53,59 +55,6 @@
 symbolIsBoxed (Just SymBoxedType) = True
 symbolIsBoxed _                   = False
 
-stripKnownPrefixes :: String -> String
-stripKnownPrefixes ('A':'t':'k':remainder) = remainder
-stripKnownPrefixes ('G':'t':'k':remainder) = remainder
-stripKnownPrefixes ('G':'d':'k':remainder) = remainder
-stripKnownPrefixes ('P':'a':'n':'g':'o':remainder) = remainder
-stripKnownPrefixes ('G':'n':'o':'m':'e':remainder) = remainder
-stripKnownPrefixes other = other
-
--- These are ones we have bound and so we can make documentation references to
--- them. Otherwise we generate FIXME messages in the docs.
-knownMiscType :: String -> Bool
-knownMiscType "GtkTreePath" = True
-knownMiscType "GtkTreeIter" = True
-knownMiscType "GdkColor"    = True
-knownMiscType "GtkTextIter" = True
-knownMiscType "GtkIconSet"  = True
-knownMiscType _ = False
-
--- These are classes from which no other class derives or is ever likely to
--- derive. In this case we can use the actual type rather than the type class
--- For example: GtkAdjustment we say
--- > Adjustment -> ...
--- rather than
--- > AdjustmentClass adjustment => adjustment -> ...
-leafClass :: String -> Bool
-leafClass "GtkAdjustment" = True
-leafClass "GdkPixbuf"     = True
-leafClass _ = False
-
--- This is a table of fixup information. It lists function parameters that
--- can be null and so should therefore be converted to use a Maybe type.
--- The perameters are identifed by C function name and parameter name.
---
--- Note that if you set this to True for any parameter then the docs for this
--- function will use @Nothing@ in place of NULL rather than a FIXME message. So
--- make sure all possibly-null parameters have been fixed since all NULLs in
--- the function docs are suppressed (since there is no automatic way of working
--- out which function doc NULLs correspond to which parameters).
---
-maybeNullParameter :: String -> String -> Bool
-maybeNullParameter "gtk_entry_completion_set_model" "model" = True
-maybeNullParameter "gtk_label_new" "str" = True
-maybeNullParameter _ _ = False
-
--- similarly for method return values/types.
-maybeNullResult :: String -> Bool
-maybeNullResult "gtk_entry_completion_get_entry" = True
-maybeNullResult "gtk_entry_completion_get_model" = True
-maybeNullResult "gtk_accel_label_get_accel_widget" = True
-maybeNullResult "gtk_progress_bar_get_text" = True
-maybeNullResult "gtk_bin_get_child" = True
-maybeNullResult _ = False
-
 -------------------------------------------------------------------------------
 -- Here's the interesting bit that generates the fragments of mashaling code
 -------------------------------------------------------------------------------
@@ -392,25 +341,6 @@
 -- generate code uses the _utf8 version if we're building on windows and using
 -- gtk version 2.6 or later. Ugh.
 
-win32FileNameFunctions =
-  ["gtk_image_new_from_file"
-  ,"gdk_pixbuf_new_from_file"
-  ,"gtk_icon_source_get_filename"
-  ,"gtk_icon_source_set_filename"
-  ,"gtk_file_chooser_get_filename"
-  ,"gtk_file_chooser_set_filename"
-  ,"gtk_file_chooser_select_filename"
-  ,"gtk_file_chooser_unselect_filename"
-  ,"gtk_file_chooser_get_filenames"
-  ,"gtk_file_chooser_set_current_folder"
-  ,"gtk_file_chooser_get_current_folder"
-  ,"gtk_file_chooser_get_preview_filename"
-  ,"gtk_file_chooser_add_shortcut_folder"
-  ,"gtk_file_chooser_remove_shortcut_folder"
-  ,"gtk_file_chooser_list_shortcut_folders"
-  ,"gtk_file_selection_set_filename"
-  ,"gtk_file_selection_get_filename"]
-
 genCall :: String -> Bool -> String
 genCall cname safty | cname `elem` win32FileNameFunctions
                            = "#if defined (WIN32) && GTK_CHECK_VERSION(2,6,0)\n  "

Index: CodeGen.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/CodeGen.hs,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -d -r1.7 -r1.8
--- CodeGen.hs	21 Feb 2005 11:03:08 -0000	1.7
+++ CodeGen.hs	23 Feb 2005 14:12:35 -0000	1.8
@@ -229,7 +229,7 @@
   indent 1. getter.
   indent 1. setter
   where objectType = ss (object_name object)
-        propertyName = cFuncNameToHsName (property_cname property)
+        propertyName = lowerCaseFirstChar (property_name 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))"
@@ -342,13 +342,13 @@
      [] -> id
      cs -> nl.nl.comment.ss "* Methods".nl.
            doVersionIfDefs lines cs).
-  (case [ (ss "  ". ss (cFuncNameToHsName (property_cname property)). sc ','
+  (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 = (upperCaseFirstChar . cFuncNameToHsName . signal_cname) signal in 
+  (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))

Index: FormatDocs.hs
===================================================================
RCS file: /cvsroot/gtk2hs/gtk2hs/tools/apiGen/FormatDocs.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- FormatDocs.hs	21 Feb 2005 11:03:08 -0000	1.5
+++ FormatDocs.hs	23 Feb 2005 14:12:35 -0000	1.6
@@ -179,7 +179,10 @@
 cFuncNameToHsName =
     lowerCaseFirstChar
   . stripKnownPrefixes
-  . toStudlyCaps
+  . concatMap upperCaseFirstChar
+  . map fixNames
+  . filter (not.null) --to ignore tailing underscores
+  . splitBy '_'
   . takeWhile ('('/=)
 
 cParamNameToHsName :: String -> String
@@ -199,6 +202,24 @@
   . filter (not.null) --to ignore tailing underscores
   . splitBy '_'
 
+-- some special cases 
+fixNames :: String -> String
+fixNames "hadjustment" = "HAdjustment"
+fixNames "vadjustment" = "VAdjustment"
+fixNames "hscale"  = "HScale"
+fixNames "vscale"  = "VScale"
+fixNames "hbox"    = "HBox"
+fixNames "vbox"    = "VBox"
+fixNames "hbutton" = "HButton"
+fixNames "vbutton" = "VButton"
+fixNames "hpaned"  = "HPaned"
+fixNames "vpaned"  = "VPaned"
+fixNames "hseparator" = "HSeparator"
+fixNames "vseparator" = "VSeparator"
+fixNames "hscrollbar" = "HScrollbar"
+fixNames "vscrollbar" = "VScrollbar"
+fixNames other = other
+
 changeIllegalNames :: String -> String
 changeIllegalNames "type" = "type_"  --this is a common variable name in C but of
                                      --course a keyword in Haskell

--- NEW FILE: MarshalFixup.hs ---
-- This module actually contains data. It is specific to the Gtk+ libs that
-- we're playing with. If we really cared enough we could split this
-- information out into seperate data files that get read in at runtime.
-- However for now it's easier just to edit the data here and recompile.

module MarshalFixup where

stripKnownPrefixes :: String -> String
stripKnownPrefixes ('A':'t':'k':remainder) = remainder
stripKnownPrefixes ('G':'t':'k':remainder) = remainder
stripKnownPrefixes ('G':'d':'k':remainder) = remainder
stripKnownPrefixes ('P':'a':'n':'g':'o':remainder) = remainder
stripKnownPrefixes ('G':'n':'o':'m':'e':remainder) = remainder
stripKnownPrefixes other = other

-- These are ones we have bound and so we can make documentation references to
-- them. Otherwise we generate FIXME messages in the docs.
knownMiscType :: String -> Bool
knownMiscType "GtkTreePath" = True
knownMiscType "GtkTreeIter" = True
knownMiscType "GdkColor"    = True
knownMiscType "GtkTextIter" = True
knownMiscType "GtkIconSet"  = True
knownMiscType _ = False

-- These are classes from which no other class derives or is ever likely to
-- derive. In this case we can use the actual type rather than the type class
-- For example: GtkAdjustment we say
-- > Adjustment -> ...
-- rather than
-- > AdjustmentClass adjustment => adjustment -> ...
leafClass :: String -> Bool
leafClass "GtkAdjustment" = True
leafClass "GdkPixbuf"     = True
leafClass "GtkIconFactory" = True
leafClass _ = False

-- This is a table of fixup information. It lists function parameters that
-- can be null and so should therefore be converted to use a Maybe type.
-- The perameters are identifed by C function name and parameter name.
--
-- Note that if you set this to True for any parameter then the docs for this
-- function will use @Nothing@ in place of NULL rather than a FIXME message. So
-- make sure all possibly-null parameters have been fixed since all NULLs in
-- the function docs are suppressed (since there is no automatic way of working
-- out which function doc NULLs correspond to which parameters).
--
maybeNullParameter :: String -> String -> Bool
maybeNullParameter "gtk_entry_completion_set_model" "model" = True
maybeNullParameter "gtk_label_new" "str" = True
maybeNullParameter _ _ = False

-- similarly for method return values/types.
maybeNullResult :: String -> Bool
maybeNullResult "gtk_entry_completion_get_entry" = True
maybeNullResult "gtk_entry_completion_get_model" = True
maybeNullResult "gtk_accel_label_get_accel_widget" = True
maybeNullResult "gtk_progress_bar_get_text" = True
maybeNullResult "gtk_bin_get_child" = True
maybeNullResult "gtk_container_get_focus_hadjustment" = True
maybeNullResult "gtk_container_get_focus_vadjustment" = True
maybeNullResult "gtk_paned_get_child1" = True
maybeNullResult "gtk_paned_get_child2" = True
maybeNullResult _ = False

-- On win32 for glib/gtk 2.6 they changed the interpretation of functions that
-- take or return system file names (as opposed to user displayable
-- representations of file names). Previously the string encoding of the file
-- name was that of the systems native 'codepage' which was usually ascii but
-- could be one of several obscure multi-byte encodings. For 2.6 they have
-- changed to always use a UTF8 encoding. However to maintain binary backwards
-- compatability they kept the old names and added new ones with a _utf8 suffix
-- for the new interpretation. However the old names are only in the binary,
-- they are not exposed through the C header files so all software building
-- against glib/gtk 2.6 on windows must use the _utf8 versions. Hence we
-- generate code uses the _utf8 version if we're building on windows and using
-- gtk version 2.6 or later. Ugh.

win32FileNameFunctions =
  ["gtk_image_new_from_file"
  ,"gdk_pixbuf_new_from_file"
  ,"gtk_icon_source_get_filename"
  ,"gtk_icon_source_set_filename"
  ,"gtk_file_chooser_get_filename"
  ,"gtk_file_chooser_set_filename"
  ,"gtk_file_chooser_select_filename"
  ,"gtk_file_chooser_unselect_filename"
  ,"gtk_file_chooser_get_filenames"
  ,"gtk_file_chooser_set_current_folder"
  ,"gtk_file_chooser_get_current_folder"
  ,"gtk_file_chooser_get_preview_filename"
  ,"gtk_file_chooser_add_shortcut_folder"
  ,"gtk_file_chooser_remove_shortcut_folder"
  ,"gtk_file_chooser_list_shortcut_folders"
  ,"gtk_file_selection_set_filename"
  ,"gtk_file_selection_get_filename"]