From: <as...@us...> - 2003-07-09 22:43:18
|
Update of /cvsroot/gtk2hs/gtk2hs/gtk/display In directory sc8-pr-cvs1:/tmp/cvs-serv25460/gtk/display Modified Files: AccelLabel.chs Image.chs Label.chs ProgressBar.chs Statusbar.chs Log Message: Make compile with GHC 6.00. There are two major changes in the FFI which made me separate everything that has to do with Foreign and Foreign.C into a new file called general/FFI.hs. The file UTFCForeign.hs is now obsolete as its string conversion functions are now in FFI.hs. The nullForeignPtr function is also located here. All files now import FFI instead of Foreign and UTFCForeign. The major changes are: newForeignPtr now takes a pointer to a C function as finalizer. Every destructor function is now defined differently depending on whether the new GHC is used or not. In particular there is now a function called free :: Ptr a -> IO () imported from the Foreign library. In addition to that I defined a function foreignFree which can be used as finalizer to a C data structure. It is equivalent to free if GHC version <=5.04 is used. The second change is that ForeignPtr are no longer accepted as arguments to foreign calls. This change is mainly reflected in c2hs, but also in some files which directly called functions. Index: AccelLabel.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/display/AccelLabel.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- AccelLabel.chs 5 Aug 2002 16:41:34 -0000 1.3 +++ AccelLabel.chs 9 Jul 2003 22:42:43 -0000 1.4 @@ -40,8 +40,8 @@ ) where import Monad (liftM) -import Foreign -import UTFCForeign +import FFI + import Object (makeNewObject) {#import Hierarchy#} {#import Signal#} @@ -53,7 +53,7 @@ -- @constructor accelLabelNew@ Create a new label with an accelerator key. -- accelLabelNew :: String -> IO AccelLabel -accelLabelNew str = withCString str $ \strPtr -> makeNewObject mkAccelLabel $ +accelLabelNew str = withUTFString str $ \strPtr -> makeNewObject mkAccelLabel $ liftM castPtr $ {#call unsafe accel_label_new#} strPtr -- @method accelLabelSetAccelWidget@ Set the key name from the activation Index: Image.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/display/Image.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Image.chs 6 Oct 2002 16:14:07 -0000 1.4 +++ Image.chs 9 Jul 2003 22:42:43 -0000 1.5 @@ -54,8 +54,8 @@ ) where import Monad (liftM) -import Foreign -import UTFCForeign +import FFI + import Object (makeNewObject) import GObject (makeNewGObject) {#import Hierarchy#} @@ -71,13 +71,13 @@ -- imageNewFromFile :: FilePath -> IO Image imageNewFromFile path = makeNewObject mkImage $ liftM castPtr $ - withCString path {#call unsafe image_new_from_file#} + withUTFString path {#call unsafe image_new_from_file#} -- @method imageNewFromStock@ Create a set of images by specifying a stock -- object. -- imageNewFromStock :: String -> IconSize -> IO Image -imageNewFromStock stock ic = withCString stock $ \strPtr -> +imageNewFromStock stock ic = withUTFString stock $ \strPtr -> makeNewObject mkImage $ liftM castPtr $ {#call unsafe image_new_from_stock#} strPtr (fromIntegral ic) @@ -94,4 +94,4 @@ -- imageNewFromPixbuf :: Pixbuf -> IO Image imageNewFromPixbuf pbuf = makeNewObject mkImage $ liftM castPtr $ - {#call unsafe image_new_from_pixbuf#} pbuf \ No newline at end of file + {#call unsafe image_new_from_pixbuf#} pbuf Index: Label.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/display/Label.chs,v retrieving revision 1.4 retrieving revision 1.5 diff -u -d -r1.4 -r1.5 --- Label.chs 8 Nov 2002 10:39:21 -0000 1.4 +++ Label.chs 9 Jul 2003 22:42:43 -0000 1.5 @@ -55,8 +55,8 @@ ) where import Monad (liftM) -import Foreign -import UTFCForeign +import FFI + import Object (makeNewObject) {#import Hierarchy#} {#import Signal#} @@ -73,13 +73,13 @@ labelNew str = makeNewObject mkLabel $ liftM castPtr $ case str of Nothing -> {#call label_new#} nullPtr - (Just str) -> withCString str {#call label_new#} + (Just str) -> withUTFString str {#call label_new#} -- @method labelSetText@ set the text the label widget shows -- labelSetText :: LabelClass l => l -> String -> IO () labelSetText l str = - withCString str $ {#call label_set_text#} (toLabel l) + withUTFString str $ {#call label_set_text#} (toLabel l) -- @method labelSetAttributes@ Set the text attributes. -- @@ -90,21 +90,21 @@ -- labelSetMarkup :: LabelClass l => l -> Markup -> IO () labelSetMarkup l str = - withCString str $ {#call label_set_markup#} (toLabel l) + withUTFString str $ {#call label_set_markup#} (toLabel l) -- @method labelSetMarkupWithMnemonic@ set the label to a markup string and -- interpret keyboard accelerators -- labelSetMarkupWithMnemonic :: LabelClass l => l -> Markup -> IO () labelSetMarkupWithMnemonic l str = - withCString str $ {#call label_set_markup_with_mnemonic#} (toLabel l) + withUTFString str $ {#call label_set_markup_with_mnemonic#} (toLabel l) -- @method labelSetPattern@ underline parts of the text, odd indices of the -- list represent underlined parts -- labelSetPattern :: LabelClass l => l -> [Int] -> IO () labelSetPattern l list = - withCString str $ {#call label_set_pattern#} (toLabel l) + withUTFString str $ {#call label_set_pattern#} (toLabel l) where str = concat $ zipWith replicate list (cycle ['_',' ']) @@ -152,7 +152,7 @@ -- @method labelGetText@ get the text stored in the label -- labelGetText :: LabelClass l => l -> IO String -labelGetText l = {#call unsafe label_get_text#} (toLabel l) >>= peekCString +labelGetText l = {#call unsafe label_get_text#} (toLabel l) >>= peekUTFString -- @constructor labelNewWithMnemonic@ Create a new label widget with @@ -164,7 +164,7 @@ -- labelNewWithMnemonic :: String -> IO Label labelNewWithMnemonic str = makeNewObject mkLabel $ liftM castPtr $ - withCString str {#call label_new_with_mnemonic#} + withUTFString str {#call label_new_with_mnemonic#} -- @method labelSelectRegion@ select a region in label -- @@ -191,5 +191,5 @@ -- labelSetTextWithMnemonic :: LabelClass l => l -> String -> IO () labelSetTextWithMnemonic l str = - withCString str $ {#call label_set_text_with_mnemonic#} (toLabel l) + withUTFString str $ {#call label_set_text_with_mnemonic#} (toLabel l) Index: ProgressBar.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/display/ProgressBar.chs,v retrieving revision 1.3 retrieving revision 1.4 diff -u -d -r1.3 -r1.4 --- ProgressBar.chs 24 May 2002 09:43:24 -0000 1.3 +++ ProgressBar.chs 9 Jul 2003 22:42:43 -0000 1.4 @@ -47,8 +47,8 @@ ) where import Monad (liftM) -import Foreign -import UTFCForeign +import FFI + import Object (makeNewObject) {#import Hierarchy#} {#import Signal#} @@ -78,7 +78,7 @@ -- superimposed on the progress bar. -- progressBarSetText :: ProgressBarClass pb => pb -> String -> IO () -progressBarSetText pb text = withCString text $ +progressBarSetText pb text = withUTFString text $ {#call unsafe progress_bar_set_text#} (toProgressBar pb) -- @method progressBarSetFraction@ Causes the progress bar to `fill in' the @@ -122,7 +122,7 @@ progressBarGetText :: ProgressBarClass pb => pb -> IO (Maybe String) progressBarGetText pb = do strPtr <- {#call unsafe progress_bar_get_text#} (toProgressBar pb) - if strPtr==nullPtr then return Nothing else liftM Just $ peekCString strPtr + if strPtr==nullPtr then return Nothing else liftM Just $ peekUTFString strPtr -- @method progressBarSetOrientation@ Causes the progress bar to switch to a -- different orientation (left-to-right, right-to-left, top-to-bottom, or Index: Statusbar.chs =================================================================== RCS file: /cvsroot/gtk2hs/gtk2hs/gtk/display/Statusbar.chs,v retrieving revision 1.2 retrieving revision 1.3 diff -u -d -r1.2 -r1.3 --- Statusbar.chs 24 May 2002 09:43:24 -0000 1.2 +++ Statusbar.chs 9 Jul 2003 22:42:43 -0000 1.3 @@ -63,8 +63,8 @@ ) where import Monad (liftM) -import Foreign -import UTFCForeign +import FFI + import Object (makeNewObject) {#import Hierarchy#} {#import Signal#} @@ -86,7 +86,7 @@ -- Statusbar. -- statusbarGetContextId :: StatusbarClass sb => sb -> String -> IO ContextId -statusbarGetContextId sb description = withCString description $ +statusbarGetContextId sb description = withUTFString description $ {#call unsafe statusbar_get_context_id#} (toStatusbar sb) @@ -96,7 +96,7 @@ -- be displayed as long as it is on top of the stack. -- statusbarPush :: StatusbarClass sb => sb -> ContextId -> String -> IO MessageId -statusbarPush sb context msg = withCString msg $ {#call statusbar_push#} +statusbarPush sb context msg = withUTFString msg $ {#call statusbar_push#} (toStatusbar sb) context -- @method statusbarPop@ Pops the topmost message that has the correct |