Menu
▾
▴
gtk2hs-commit — Mailing list for Darcs commit messages.
You can subscribe to this list here.
| 2003 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(4) |
Jun
|
Jul
(68) |
Aug
(4) |
Sep
|
Oct
(23) |
Nov
(95) |
Dec
(9) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(3) |
Feb
|
Mar
|
Apr
(51) |
May
(81) |
Jun
(2) |
Jul
(86) |
Aug
(143) |
Sep
(3) |
Oct
(31) |
Nov
(63) |
Dec
(90) |
| 2005 |
Jan
(277) |
Feb
(157) |
Mar
(99) |
Apr
(195) |
May
(151) |
Jun
(148) |
Jul
(98) |
Aug
(123) |
Sep
(20) |
Oct
(174) |
Nov
(155) |
Dec
(26) |
| 2006 |
Jan
(51) |
Feb
(19) |
Mar
(16) |
Apr
(12) |
May
(5) |
Jun
|
Jul
(11) |
Aug
(7) |
Sep
(10) |
Oct
(31) |
Nov
(174) |
Dec
(56) |
| 2007 |
Jan
(45) |
Feb
(52) |
Mar
(10) |
Apr
(5) |
May
(47) |
Jun
(16) |
Jul
(80) |
Aug
(29) |
Sep
(14) |
Oct
(59) |
Nov
(46) |
Dec
(16) |
| 2008 |
Jan
(10) |
Feb
(1) |
Mar
|
Apr
|
May
(49) |
Jun
(26) |
Jul
(8) |
Aug
(4) |
Sep
(25) |
Oct
(53) |
Nov
(9) |
Dec
(1) |
| 2009 |
Jan
(66) |
Feb
(11) |
Mar
(1) |
Apr
(14) |
May
(8) |
Jun
(1) |
Jul
(2) |
Aug
(2) |
Sep
(9) |
Oct
(23) |
Nov
(35) |
Dec
|
| 2010 |
Jan
(7) |
Feb
(2) |
Mar
(39) |
Apr
(19) |
May
(161) |
Jun
(19) |
Jul
(32) |
Aug
(65) |
Sep
(113) |
Oct
(120) |
Nov
(2) |
Dec
|
| 2012 |
Jan
|
Feb
(5) |
Mar
(4) |
Apr
(7) |
May
(9) |
Jun
(14) |
Jul
(1) |
Aug
|
Sep
(1) |
Oct
(1) |
Nov
(12) |
Dec
(2) |
| 2013 |
Jan
(1) |
Feb
(17) |
Mar
(4) |
Apr
(4) |
May
(9) |
Jun
|
Jul
(8) |
Aug
|
Sep
(2) |
Oct
|
Nov
|
Dec
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 14:13:53
|
Wed May 23 07:13:41 PDT 2007 Duncan Coutts <du...@ha...>
* Update TODO, a couple items are done
hunk ./TODO 14
- * eliminate checkGErrorWithCont, it's ugly
-
hunk ./TODO 25
- * add PDF & PS backends to cairo
-
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 14:01:56
|
Wed May 23 07:01:26 PDT 2007 Duncan Coutts <du...@ha...>
* Actually we only need cairo 1.0
We detect the backends being enabled separately
and we can conditionally compile code depending on the cairo version.
hunk ./configure.ac 331
-GTKHS_PKG_CHECK(cairo, cairo, CAIRO, [cairo >= 1.2.0],
+GTKHS_PKG_CHECK(cairo, cairo, CAIRO, [cairo >= 1.0.0],
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 13:42:16
|
Wed May 23 06:41:55 PDT 2007 Duncan Coutts <du...@ha...>
* Remove unused GError function
hunk ./glib/System/Glib/GError.chs.pp 83
- -- Either\/Maybe) then you should use 'checkGError' or 'checkGErrorWithCont'.
+ -- Either\/Maybe) then you should use 'checkGError'.
hunk ./glib/System/Glib/GError.chs.pp 87
- checkGError,
- checkGErrorWithCont
- [_$_]
+ checkGError
hunk ./glib/System/Glib/GError.chs.pp 178
- {# call unsafe g_error_free #} (castPtr errPtr)
- handler gerror
-
--- | Like 'checkGError' but with an extra continuation applied to the result.
--- This can be useful when something needs to be done after making the call
--- to the function that can raise an error but is should only be done if there
--- was no error.
---
--- Example of use:
---
--- > checkGErrorWithCont (\gerrorPtr ->
--- > {# call g_some_function_that_might_return_an_error #} a b gerrorPtr)
--- > (\(GError domain code msg) -> ...) -- what to do in case of error
--- > (\result -> ...) -- what to do after if no error
---
-checkGErrorWithCont :: (Ptr (Ptr ()) -> IO b) -> (GError -> IO a) -> (b -> IO a) -> IO a
-checkGErrorWithCont action handler cont =
- alloca $ \(errPtrPtr :: Ptr (Ptr GError)) -> do
- poke errPtrPtr nullPtr
- result <- action (castPtr errPtrPtr)
- errPtr <- peek errPtrPtr
- if errPtr == nullPtr
- then cont result
- else do gerror <- peek errPtr
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 13:42:14
|
Wed May 23 06:40:47 PDT 2007 Duncan Coutts <du...@ha...>
* Use exceptions for image loading errors rather than Either
Using exceptions here makes for a much nicer api.
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 126
- checkGError, checkGErrorWithCont)
+ propagateGError)
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 256
-handlePixbufError :: GError -> IO (PixbufError,String)
-handlePixbufError (GError dom code msg)
- | dom == pixbufErrorDomain = return (toEnum code, msg)
- | otherwise = fail msg
-
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 266
-pixbufNewFromFile :: FilePath -> IO (Either (PixbufError,String) Pixbuf)
+pixbufNewFromFile :: FilePath -> IO Pixbuf
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 268
- checkGErrorWithCont
- (\errPtrPtr -> [_$_]
+ constructNewGObject mkPixbuf $
+ propagateGError $ \errPtrPtr ->
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 276
- strPtr errPtrPtr)
- (\gerror -> liftM Left $ handlePixbufError gerror)
- (\pbPtr -> liftM Right $ constructNewGObject mkPixbuf (return pbPtr))
+ strPtr errPtrPtr
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 290
-pixbufNewFromFileAtSize :: String -> Int -> Int -> IO (Either (PixbufError,String) Pixbuf)
+pixbufNewFromFileAtSize :: String -> Int -> Int -> IO Pixbuf
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 292
- checkGErrorWithCont
- (\errPtrPtr -> [_$_]
+ constructNewGObject mkPixbuf $
+ propagateGError $ \errPtrPtr ->
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 303
- errPtrPtr)
- (\gerror -> liftM Left $ handlePixbufError gerror)
- (\pbPtr -> liftM Right $ constructNewGObject mkPixbuf (return pbPtr))
+ errPtrPtr
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 324
-pixbufNewFromFileAtScale :: String -> Int -> Int -> Bool -> IO (Either (PixbufError,String) Pixbuf)
+pixbufNewFromFileAtScale :: String -> Int -> Int -> Bool -> IO Pixbuf
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 326
- checkGErrorWithCont
- (\errPtrPtr -> [_$_]
+ constructNewGObject mkPixbuf $
+ propagateGError $ \errPtrPtr ->
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 338
- errPtrPtr)
- (\gerror -> liftM Left $ handlePixbufError gerror)
- (\pbPtr -> liftM Right $ constructNewGObject mkPixbuf (return pbPtr))
+ errPtrPtr
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 372
- checkGError (\errPtrPtr ->
+ propagateGError $ \errPtrPtr ->
hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 383
- return Nothing)
- (\gerror -> liftM Just $ handlePixbufError gerror)
+ return Nothing
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 12:45:27
|
Wed May 23 03:41:07 PDT 2007 Duncan Coutts <du...@ha...>
* Add test of cairo SVG backend
and add messages to say what files have been written.
hunk ./demo/cairo/StarAndRing.hs 99
+ putStrLn "wrote StarAndRing.png"
hunk ./demo/cairo/StarAndRing.hs 102
+ putStrLn "wrote StarAndRing.pdf"
hunk ./demo/cairo/StarAndRing.hs 105
+ putStrLn "wrote StarAndRing.ps"
+ withSVGSurface "StarAndRing.svg" (fromIntegral width) (fromIntegral height)
+ (flip renderWith $ starAndRing width height)
+ putStrLn "wrote StarAndRing.svg"
hunk ./demo/cairo/StarAndRing.hs 113
-
-
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 12:45:26
|
Wed May 23 03:27:01 PDT 2007 Duncan Coutts <du...@ha...>
* Rearange the export list for the cairo backends
More sensible order and only include description if the backend is enabled.
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 173
- -- ** PDF surfaces
-#ifdef ENABLE_CAIRO_PDF_SURFACE
- , withPDFSurface
- , pdfSurfaceSetSize
-#endif
-
- -- ** PNG support
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 174
+ -- ** PNG support
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 179
- -- ** PS surfaces
+#ifdef ENABLE_CAIRO_PDF_SURFACE
+ -- ** PDF surfaces
+ , withPDFSurface
+ , pdfSurfaceSetSize
+#endif
+
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 186
+ -- ** PS surfaces
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 12:45:23
|
Wed May 23 03:24:26 PDT 2007 Duncan Coutts <du...@ha...>
* conditionally compile the cairo backends
move ./cairo/Graphics/Rendering/Cairo.hs ./cairo/Graphics/Rendering/Cairo.hs.pp
move ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs.pp
move ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PNG.chs ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PNG.chs.pp
move ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs.pp
hunk ./Makefile.am 1243
- cairo/Graphics/Rendering/Cairo.hs \
+ cairo/Graphics/Rendering/Cairo.hs.pp \
hunk ./Makefile.am 1254
- cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs \
- cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PNG.chs \
- cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs \
+ cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs.pp \
+ cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PNG.chs.pp \
+ cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs.pp \
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 174
+#ifdef ENABLE_CAIRO_PDF_SURFACE
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 177
+#endif
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 180
+#ifdef ENABLE_CAIRO_PNG_FUNCTIONS
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 183
+#endif
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 186
+#ifdef ENABLE_CAIRO_PS_SURFACE
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 189
+#endif
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 1539
+#ifdef ENABLE_CAIRO_PDF_SURFACE
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 1570
+#endif
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 1572
+#ifdef ENABLE_CAIRO_PNG_FUNCTIONS
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 1596
+#endif
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 1598
+#ifdef ENABLE_CAIRO_PS_SURFACE
hunk ./cairo/Graphics/Rendering/Cairo.hs.pp 1631
+#endif
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs.pp 23
+#ifdef ENABLE_CAIRO_PDF_SURFACE
+
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs.pp 28
+#endif
+
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PNG.chs.pp 25
+#ifdef ENABLE_CAIRO_PNG_FUNCTIONS
+
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PNG.chs.pp 35
+#endif
+
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs.pp 23
+#ifdef ENABLE_CAIRO_PS_SURFACE
+
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs.pp 28
+#endif
+
hunk ./cairo/cairo.h 2
+#ifdef CAIRO_HAS_PDF_SURFACE
hunk ./cairo/cairo.h 4
+#endif
+#ifdef CAIRO_HAS_PS_SURFACE
hunk ./cairo/cairo.h 7
+#endif
+#ifdef CAIRO_HAS_SVG_SURFACE
+#include <cairo-svg.h>
+#endif
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 12:45:23
|
Wed May 23 02:59:06 PDT 2007 Duncan Coutts <du...@ha...>
* Use the right cairo backend headers in the package registration files
If we're using one of the backend headers then client code might need it too.
So we have to be accurate about which ones we include. We can't inlcude ones
that are not enabled either or we'll get cpp errors.
hunk ./cairo/cairo.package.conf.in 17
-includes: cairo.h
+includes: @CAIRO_HEADERS@
hunk ./cairo/cairo.pkg.in 10
- c_includes = ["cairo.h"],
+ c_includes = [@CAIRO_HEADERS@],
hunk ./configure.ac 466
+CAIRO_HEADERS="\"cairo.h\""
hunk ./configure.ac 469
+CAIRO_HEADERS="${CAIRO_HEADERS}, \"cairo-ps.h\""
hunk ./configure.ac 473
+CAIRO_HEADERS="${CAIRO_HEADERS}, \"cairo-pdf.h\""
hunk ./configure.ac 477
+CAIRO_HEADERS="${CAIRO_HEADERS}, \"cairo-svg.h\""
hunk ./configure.ac 793
+AC_SUBST(CAIRO_HEADERS)
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 12:45:22
|
Wed May 9 02:24:55 PDT 2007 Toby Allsopp <to...@mi...>
* Enable PDF and PS backends (requires cairo >= 1.2.0)
* configure.ac: Require cairo >= 1.2.0 for PDF and PS support.
* Makefile.am (libHScairo_a_HEADER): Use local cairo.h.
(libHScairo_a_SOURCES): Make PDF and PS surfaces first class
citizens. Remove Graphics.Rendering.Cairo.PDF and PS modules.
(htmldoc_HSFILES_EXCLUDE): Exclude PDF and PS internal modules.
* cairo/cairo.h: Uncomment PDF and PS includes, as this include
file is used now.
* cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs: Update
PS surface binding.
* cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs: Update
PDF surface binding.
* cairo/Graphics/Rendering/Cairo/PDF.hs: Remove file.
* cairo/Graphics/Rendering/Cairo/PS.hs: Remove file.
* cairo/Graphics/Rendering/Cairo/Internal.hs: Include PDF and PS
internal surface modules.
* cairo/Graphics/Rendering/Cairo.hs: Include PDF and PS surface
functions.
(withPDFSurface, pdfSurfaceSetSize, withPSSurface)
(psSurfaceSetSize): New functions (from PDF.hs and PS.hs).
* demo/cairo/StarAndRing.hs (main): Create PDF and PS files as
well as the PNG file.
hunk ./cairo/Graphics/Rendering/Cairo/PDF.hs 1
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.Cairo.PDF
--- Copyright : (c) Paolo Martini 2005
--- License : BSD-style (see cairo/COPYRIGHT)
---
--- Maintainer : p.m...@ne...
--- Stability : experimental
--- Portability : portable
---
--- Rendering PDF documents.
------------------------------------------------------------------------------
-
-module Graphics.Rendering.Cairo.PDF where
-
-import Graphics.Rendering.Cairo.Types
-import qualified Graphics.Rendering.Cairo.Internal.Surfaces.PDF as PDF
-import Graphics.Rendering.Cairo.Internal.Surfaces.Surface (surfaceDestroy)
-
-withPDFSurface :: FilePath -> Double -> Double -> (Surface -> IO a) -> IO a
-withPDFSurface filename width height = do
- surface <- PDF.pdfSurfaceCreate filename width height
- ret <- f surface
- surfaceDestroy surface
- return ret
-
-pdfSurfaceSetDPI :: Surface -> Double -> Double -> IO a
-pdfSurfaceSetDPI surface x y = PDF.pdfSurfaceSetDPI surface x y
rmfile ./cairo/Graphics/Rendering/Cairo/PDF.hs
hunk ./cairo/Graphics/Rendering/Cairo/PS.hs 1
------------------------------------------------------------------------------
--- |
--- Module : Graphics.Rendering.Cairo.PS
--- Copyright : (c) Paolo Martini 2005
--- License : BSD-style (see cairo/COPYRIGHT)
---
--- Maintainer : p.m...@ne...
--- Stability : experimental
--- Portability : portable
---
--- Rendering PS documents.
------------------------------------------------------------------------------
-
-module Graphics.Rendering.Cairo.PS where
-
-import Graphics.Rendering.Cairo.Types
-import qualified Graphics.Rendering.Cairo.Internal.Surfaces.PS as PS
-import Graphics.Rendering.Cairo.Internal.Surfaces.Surface (surfaceDestroy)
-
-withPSSurface :: FilePath -> Double -> Double -> (Surface -> IO a) -> IO a
-withPSSurface filename width height = do
- surface <- PS.psSurfaceCreate filename width height
- ret <- f surface
- surfaceDestroy surface
- return ret
-
-psSurfaceSetDPI :: Surface -> Double -> Double -> IO a
-psSurfaceSetDPI surface x y = PS.psSurfaceSetDPI surface x y
rmfile ./cairo/Graphics/Rendering/Cairo/PS.hs
hunk ./Makefile.am 1227
-libHScairo_a_HEADER = cairo.h
+libHScairo_a_HEADER = cairo/cairo.h
hunk ./Makefile.am 1254
+ cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs \
hunk ./Makefile.am 1256
+ cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs \
hunk ./Makefile.am 1259
-# cairo/Graphics/Rendering/Cairo/PDF.hs
-# cairo/Graphics/Rendering/Cairo/PS.hs
-# cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs
-# cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs
hunk ./Makefile.am 1273
+ cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.hs \
hunk ./Makefile.am 1275
+ cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.hs \
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PDF.chs 21
-{#fun cairo_pdf_surface_create as pdfSurfaceCreate { `FilePath', `Double', `Double' } -> `Surface' Surface#}
-{#fun cairo_pdf_surface_set_dpi as pdfSurfaceSetDPI { `Surface', `Double', `Double' } -> `()'#}
+{#context lib="cairo" prefix="cairo"#}
+
+{#fun pdf_surface_create as pdfSurfaceCreate { withCString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#}
+{#fun pdf_surface_set_size as pdfSurfaceSetSize { withSurface* `Surface', `Double', `Double' } -> `()'#}
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs 18
+import Foreign
hunk ./cairo/Graphics/Rendering/Cairo/Internal/Surfaces/PS.chs 21
-{#fun cairo_ps_surface_create as psSurfaceCreate { `FilePath', `Double', `Double' } -> `Surface' Surface#}
-{#fun cairo_ps_surface_set_dpi as psSurfaceSetDPI { `Surface', `Double', `Double' } -> `()'#}
+{#context lib="cairo" prefix="cairo"#}
+
+{#fun ps_surface_create as psSurfaceCreate { withCString* `FilePath', `Double', `Double' } -> `Surface' mkSurface*#}
+{#fun cairo_ps_surface_set_size as psSurfaceSetSize { withSurface* `Surface', `Double', `Double' } -> `()'#}
hunk ./cairo/Graphics/Rendering/Cairo/Internal.hs 25
--- , module Graphics.Rendering.Cairo.Internal.Surfaces.PDF
+ , module Graphics.Rendering.Cairo.Internal.Surfaces.PDF
hunk ./cairo/Graphics/Rendering/Cairo/Internal.hs 27
+ , module Graphics.Rendering.Cairo.Internal.Surfaces.PS
hunk ./cairo/Graphics/Rendering/Cairo/Internal.hs 41
--- import Graphics.Rendering.Cairo.Internal.Surfaces.PDF
+import Graphics.Rendering.Cairo.Internal.Surfaces.PDF
hunk ./cairo/Graphics/Rendering/Cairo/Internal.hs 43
+import Graphics.Rendering.Cairo.Internal.Surfaces.PS
hunk ./cairo/Graphics/Rendering/Cairo.hs 173
+ -- ** PDF surfaces
+ , withPDFSurface
+ , pdfSurfaceSetSize
+
hunk ./cairo/Graphics/Rendering/Cairo.hs 181
+ -- ** PS surfaces
+ , withPSSurface
+ , psSurfaceSetSize
+
hunk ./cairo/Graphics/Rendering/Cairo.hs 1533
+-- | Creates a PostScript surface of the specified size in points to
+-- be written to @filename@.
+--
+-- Note that the size of individual pages of the PostScript output can
+-- vary. See 'psSurfaceSetSize'.
+--
+withPDFSurface ::
+ FilePath -- ^ @filename@ - a filename for the PS output (must be writable)
+ -> Double -- ^ width of the surface, in points (1 point == 1\/72.0 inch)
+ -> Double -- ^ height of the surface, in points (1 point == 1\/72.0 inch)
+ -> (Surface -> IO a) -- ^ an action that may use the surface. The surface is
+ -- only valid within in this action.
+ -> IO a
+withPDFSurface filename width height f = do
+ surface <- Internal.pdfSurfaceCreate filename width height
+ ret <- f surface
+ Internal.surfaceDestroy surface
+ return ret
+
+-- | Changes the size of a PDF surface for the current (and
+-- subsequent) pages.
+--
+-- This function should only be called before any drawing operations
+-- have been performed on the current page. The simplest way to do
+-- this is to call this function immediately after creating the
+-- surface or immediately after completing a page with either
+-- 'showPage' or 'copyPage'.
+--
+pdfSurfaceSetSize :: Surface -> Double -> Double -> Render ()
+pdfSurfaceSetSize s x y = liftIO $ Internal.pdfSurfaceSetSize s x y
+
hunk ./cairo/Graphics/Rendering/Cairo.hs 1588
+-- | Creates a PostScript surface of the specified size in points to
+-- be written to @filename@.
+--
+-- Note that the size of individual pages of the PostScript output can
+-- vary. See 'psSurfaceSetSize'.
+--
+withPSSurface ::
+ FilePath -- ^ @filename@ - a filename for the PS output (must be writable)
+ -> Double -- ^ width of the surface, in points (1 point == 1\/72.0 inch)
+ -> Double -- ^ height of the surface, in points (1 point == 1\/72.0 inch)
+ -> (Surface -> IO a) -- ^ an action that may use the surface. The surface is
+ -- only valid within in this action.
+ -> IO a
+withPSSurface filename width height f = [_$_]
+ bracket (Internal.psSurfaceCreate filename width height)
+ (\surface -> do status <- Internal.surfaceStatus surface
+ Internal.surfaceDestroy surface
+ unless (status == StatusSuccess) $
+ Internal.statusToString status >>= fail)
+ (\surface -> f surface)
+
+-- | Changes the size of a PostScript surface for the current (and
+-- subsequent) pages.
+--
+-- This function should only be called before any drawing operations
+-- have been performed on the current page. The simplest way to do
+-- this is to call this function immediately after creating the
+-- surface or immediately after completing a page with either
+-- 'showPage' or 'copyPage'.
+--
+psSurfaceSetSize :: Surface -> Double -> Double -> Render ()
+psSurfaceSetSize s x y = liftIO $ Internal.psSurfaceSetSize s x y
+
hunk ./cairo/cairo.h 2
-// #include <cairo-pdf.h>
-// #include <cairo-ps.h>
+#include <cairo-pdf.h>
+#include <cairo-ps.h>
hunk ./configure.ac 331
-GTKHS_PKG_CHECK(cairo, cairo, CAIRO, [cairo >= 1.0.0],
+GTKHS_PKG_CHECK(cairo, cairo, CAIRO, [cairo >= 1.2.0],
hunk ./demo/cairo/StarAndRing.hs 95
-main =
+main = do
hunk ./demo/cairo/StarAndRing.hs 97
- renderWith result $ starAndRing width height
- surfaceWriteToPNG result "StarAndRing.png"
+ renderWith result $ starAndRing width height
+ surfaceWriteToPNG result "StarAndRing.png"
+ withPDFSurface "StarAndRing.pdf" (fromIntegral width) (fromIntegral height)
+ (flip renderWith $ starAndRing width height >> showPage)
+ withPSSurface "StarAndRing.ps" (fromIntegral width) (fromIntegral height)
+ (flip renderWith $ starAndRing width height >> showPage)
|
|
From: Duncan C. <dun...@wo...> - 2007-05-23 12:45:22
|
Wed May 23 02:29:21 PDT 2007 Duncan Coutts <du...@ha...>
* add defines for cairo version and features into gtk2hs-config.h
so that we will be able to conditionally compile cairo binding code
depending on the cairo version and on which backends are enabled.
hunk ./configure.ac 439
+
+dnl Also allow us to conditionally compile bindings to Glib APIs.
+dnl We also want to know if certain cairo backends are enabled or not
+dnl we can find out by checking the appropriate cpp defines in cairo-features.h
+dnl Actually getting at these cpp defines is a bit tricky, what we do is
+dnl pre-process a shell file and include cairo-features.h then we run that
+dnl shell file to bring in the values of the shell vars it defines.
+dnl Then finally we substitute those into our config header file.
+CAIRO_CPP_FLAGS="`$PKG_CONFIG --cflags cairo` -include cairo-features.h"
+$CPP $CAIRO_CPP_FLAGS - > conftest.sh <<_ACEOF
+#ifdef CAIRO_HAS_PS_SURFACE
+_CAIRO_HAS_PS_SURFACE=1
+#endif
+#ifdef CAIRO_HAS_PDF_SURFACE
+_CAIRO_HAS_PDF_SURFACE=1
+#endif
+#ifdef CAIRO_HAS_SVG_SURFACE
+_CAIRO_HAS_SVG_SURFACE=1
+#endif
+#ifdef CAIRO_HAS_PNG_FUNCTIONS
+_CAIRO_HAS_PNG_FUNCTIONS=1
+#endif
+_CAIRO_VERSION_MAJOR=CAIRO_VERSION_MAJOR
+_CAIRO_VERSION_MINOR=CAIRO_VERSION_MINOR
+_CAIRO_VERSION_MICRO=CAIRO_VERSION_MICRO
+_ACEOF
+. ./conftest.sh
+if test ${_CAIRO_HAS_PS_SURFACE}; then
+AC_DEFINE_UNQUOTED(ENABLE_CAIRO_PS_SURFACE, [], [cairo ps backend enabled])
+fi
+if test ${_CAIRO_HAS_PDF_SURFACE}; then
+AC_DEFINE_UNQUOTED(ENABLE_CAIRO_PDF_SURFACE, [], [cairo pdf backend enabled])
+fi
+if test ${_CAIRO_HAS_SVG_SURFACE}; then
+AC_DEFINE_UNQUOTED(ENABLE_CAIRO_SVG_SURFACE, [], [cairo svg backend enabled])
+fi
+if test ${_CAIRO_HAS_PNG_FUNCTIONS}; then
+AC_DEFINE_UNQUOTED(ENABLE_CAIRO_PNG_FUNCTIONS, [], [cairo png functions available])
+fi
+AC_DEFINE_UNQUOTED(_CAIRO_MAJOR_VERSION, (${_CAIRO_VERSION_MAJOR}), [cairo major version number])
+AC_DEFINE_UNQUOTED(_CAIRO_MINOR_VERSION, (${_CAIRO_VERSION_MINOR}), [cairo minor version number])
+AC_DEFINE_UNQUOTED(_CAIRO_MICRO_VERSION, (${_CAIRO_VERSION_MICRO}), [cairo minor patch level])
+AH_BOTTOM([
+/* Allow code to be compiled differently for different versions of cairo */
+#define CAIRO_CHECK_VERSION(major,minor,micro) \
+ (_CAIRO_MAJOR_VERSION > (major) || \
+ (_CAIRO_MAJOR_VERSION == (major) && _CAIRO_MINOR_VERSION > (minor)) || \
+ (_CAIRO_MAJOR_VERSION == (major) && _CAIRO_MINOR_VERSION == (minor) && \
+ _CAIRO_MICRO_VERSION >= (micro)))
+])
+
|
|
From: Duncan C. <dun...@wo...> - 2007-05-19 17:01:20
|
Sat May 19 09:54:10 PDT 2007 Duncan Coutts <du...@co...>
* html hidden list are .hs not .chs, fixes make of docs when arelady built
hunk ./Makefile.am 585
- gtk/Graphics/UI/Gtk/General/DNDTypes.chs
+ gtk/Graphics/UI/Gtk/General/DNDTypes.hs
|
|
From: Duncan C. <dun...@wo...> - 2007-05-19 17:01:17
|
Sat May 19 09:55:54 PDT 2007 Duncan Coutts <du...@co...>
* Move onFocus into Widget module and fix return type
For some reason we had it in the container module but it really applies
to all widgets, not just containers. Also, the return type was wrong.
hunk ./gtk/Graphics/UI/Gtk/Abstract/Container.chs 159
- DirectionType(..),
hunk ./gtk/Graphics/UI/Gtk/Abstract/Container.chs 185
- onFocus,
- afterFocus,
hunk ./gtk/Graphics/UI/Gtk/Abstract/Container.chs 201
-import Graphics.UI.Gtk.General.Enums (DirectionType(..), ResizeMode(..))
+import Graphics.UI.Gtk.General.Enums (ResizeMode(..))
hunk ./gtk/Graphics/UI/Gtk/Abstract/Container.chs 521
--- | This signal is called if the container receives the
--- input focus.
---
-onFocus, afterFocus :: ContainerClass con => con ->
- (DirectionType -> IO DirectionType) ->
- IO (ConnectId con)
-onFocus = connect_ENUM__ENUM "focus" False
-afterFocus = connect_ENUM__ENUM "focus" True
-
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs.pp 70
+ DirectionType(..),
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs.pp 165
+ onFocus,
+ afterFocus,
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs.pp 240
- AccelFlags(..))
+ AccelFlags(..), DirectionType(..))
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs.pp 1299
+-- | This signal is called if the widget receives the input focus.
+--
+onFocus, afterFocus :: WidgetClass w => w -> (DirectionType -> IO Bool) ->
+ IO (ConnectId w)
+onFocus = connect_ENUM__BOOL "focus" False
+afterFocus = connect_ENUM__BOOL "focus" True
+
|
|
From: Duncan C. <dun...@wo...> - 2007-05-03 22:08:18
|
Thu May 3 10:19:20 PDT 2007 Malte Milatz <ma...@gm...>
* Cleaned up description of the Matrix datatype.
hunk ./cairo/Graphics/Rendering/Cairo/Matrix.chs 31
--- | Representation of a 2-D affine transformation as a matrix.
+-- | Representation of a 2-D affine transformation.
hunk ./cairo/Graphics/Rendering/Cairo/Matrix.chs 33
--- The 'Matrix' type actually represents as 3x3 matrix but with some elements
--- are constant and so are not included. Specifically if we assume that our
--- coordinates are row vectors then correspondence is:
+-- The Matrix type represents a 2x2 transformation matrix along with a
+-- translation vector. @Matrix a1 a2 b1 b2 c1 c2@ describes the
+-- transformation of a point with coordinates x,y that is defined by
hunk ./cairo/Graphics/Rendering/Cairo/Matrix.chs 37
--- > Matrix xx yx xy yy x0 y0
--- > ==
--- > / xx yx 0 \
--- > | xy yy 0 |
--- > \ x0 y0 1 /
+-- > / x' \ = / a1 b1 \ / x \ + / c1 \
+-- > \ y' / \ a2 b2 / \ y / \ c2 /
hunk ./cairo/Graphics/Rendering/Cairo/Matrix.chs 40
--- and the matrix operates on @(x,y)@ coordinates:
---
--- > (x y 1) / xx yx 0 \ = (x' y' 1)
--- > | xy yy 0 | where x' = xx * x + xy * y + x0
--- > \ x0 y0 1 / y' = yx * x + yy * y + y0
+-- or
hunk ./cairo/Graphics/Rendering/Cairo/Matrix.chs 42
+-- > x' = a1 * x + b1 * y + c1
+-- > y' = a2 * x + b2 * y + c2
+
|
|
From: Duncan C. <dun...@wo...> - 2007-05-02 22:49:27
|
Wed May 2 15:10:18 PDT 2007 Duncan Coutts <du...@co...>
* Add ApiGen.cabal to record deps explicitly
addfile ./tools/apiGen/ApiGen.cabal
hunk ./tools/apiGen/ApiGen.cabal 1
+name: ApiGen
+version: 0.3
+build-depends: base, HaXml >= 1.13 && < 1.14, regex-compat
+license: GPL
+
+executable: ApiGen
+main-is: ApiGen.hs
+hs-source-dirs: src
+other-modules: Api, Docs, AddDocs, HaddockDocs, CodeGen, Marshal, [_$_]
+ MarshalFixup, ModuleScan, ExcludeApi, Utils, Module, Names
|
|
From: Duncan C. <dun...@wo...> - 2007-05-02 22:49:26
|
Wed May 2 15:09:41 PDT 2007 Duncan Coutts <du...@co...>
* Don't use haskell98 package in apigen
hunk ./tools/apiGen/src/ModuleScan.hs 17
-import Directory (getDirectoryContents, doesDirectoryExist, doesFileExist)
+import System.Directory (getDirectoryContents, doesDirectoryExist,
+ doesFileExist)
|
|
From: Duncan C. <dun...@wo...> - 2007-05-02 21:02:06
|
Wed May 2 11:22:28 PDT 2007 Duncan Coutts <du...@co...>
* Remove many unused c2hs modules.
This is a backport of changes in upstream c2hs.
Also move Position into it's own module.
Also remove the old c2hs Makefiles.
hunk ./tools/c2hs/base/syntax/ParserMonad.hs 1
--- The HiPar Toolkit: General parser monad
---
--- Author : Manuel M. T. Chakravarty
--- Created: 16 February 98
---
--- Version $Revision: 1.1.1.1 $ from $Date: 2004/11/13 16:42:51 $
---
--- Copyright (c) [1998..2000] Manuel M. T. Chakravarty
---
--- This library is free software; you can redistribute it and/or
--- modify it under the terms of the GNU Library General Public
--- License as published by the Free Software Foundation; either
--- version 2 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
--- Library General Public License for more details.
---
---- DESCRIPTION ---------------------------------------------------------------
---
--- This module provides some basic definitions for building parsers with
--- the generator happy using the `%monad' option.
---
---- DOCU ----------------------------------------------------------------------
---
--- language: Haskell 98
---
--- * The `[Name]' component of the parser monad is threaded (in contrast to
--- the position and input string, which are treated as readers).
---
---- TODO ----------------------------------------------------------------------
---
--- * The fact that `ParseResult' and expecially `Parse' are exported openly
--- and that this exploited in the lexers creates awkward dependencies.
--- Unfortunately, a more abstract export policy might have a negative
--- impact on the performance of the parser (at least without cross-module
--- inlining). [_$_]
---
-
-module ParserMonad (ParseResult(..), Parse,
- thenParse, returnParse, parseError, parseNewName, runParse)
-where
-
-import Common (Position)
-import UNames (Name)
-
-
--- the parser result (EXPORTED)
---
-data ParseResult a = PRParsed [Name] a -- parsed `a'
- | PRFailed Position [String] -- parse or lex error
-
--- the monad is a combined reader state-transformer monad with exception
--- handling (EXPORTED)
---
--- * it contains the input string and the current position
---
--- * the result is `PRFailed' in case of an error (i.e., flagging an
--- exception)
---
-type Parse a = String -> Position -> [Name] -> ParseResult a
-
--- standard monad combinators (EXPORTED)
---
-
-thenParse :: Parse a -> (a -> Parse b) -> Parse b
-thenParse p q = \s pos ns -> case (p s pos ns) of
- PRParsed ns' t -> q t s pos ns'
- PRFailed pos msg -> PRFailed pos msg
-
-returnParse :: a -> Parse a
-returnParse t = \_ _ ns -> PRParsed ns t
-
--- non-standard combinators
---
-
--- yield a parse errror at the given position with the given error message
--- (EXPORTED) [_$_]
---
-parseError :: [String] -> Parse a
-parseError msg = \_ pos _ -> PRFailed pos msg
-
--- get a unique name (EXPORTED)
---
-parseNewName :: Parse Name
-parseNewName = \_ _ (n:ns) -> PRParsed ns n
-
--- Apply a given parser to a string with initial position (EXPORTED)
---
--- * A success and a failure continuation are supplied to deal with the
--- parsing result. [_$_]
---
-runParse :: (a -> b) -- success cont
- -> (Position -> [String] -> b) -- failure cont
- -> [Name]
- -> Position [_$_]
- -> String [_$_]
- -> (Parse a) [_$_]
- -> b
-runParse succ fail ns pos s p = [_$_]
- case (p s pos ns) of
- PRParsed _ t -> succ t
- PRFailed pos err -> fail pos err
rmfile ./tools/c2hs/base/syntax/ParserMonad.hs
hunk ./tools/c2hs/base/syntax/Parsers.hs 1
--- Compiler Toolkit: Self-optimizing LL(1) parser combinators
---
--- Author : Manuel M T Chakravarty
--- Created: 27 February 99
---
--- Version $Revision: 1.2 $ from $Date: 2004/11/13 17:26:51 $
---
--- Copyright (c) [1999..2004] Manuel M T Chakravarty
---
--- This library is free software; you can redistribute it and/or
--- modify it under the terms of the GNU Library General Public
--- License as published by the Free Software Foundation; either
--- version 2 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
--- Library General Public License for more details.
---
---- DESCRIPTION ---------------------------------------------------------------
---
--- This module implements fully deterministic, self-optimizing LL(1) parser
--- combinators, which generate parse tables on-the-fly and are based on a
--- technique introduced by Swierstra & Duponcheel. The applied technique for
--- efficiently computing the parse tables makes essential use of the
--- memorization build into lazy evaluation.
---
--- The present implementation is rather different from S. D. Swierstra and
--- L. Duponcheel, ``Deterministic, Error-Correcting Combinator Parsers'', in
--- John Launchbury, Erik Meijer, and Tim Sheard (Eds.) "Advanced Functional
--- Programming", Springer-Verlag, Lecture Notes in Computer Science 1129,
--- 184-207, 1996. It is much closer to a a revised version published by
--- S. D. Swierstra, but handles actions completely different. In particular, [_$_]
--- Swierstra's version does not have a threaded state and meta actions. The
--- present module also defines a number of additional combinators and uses
--- finite maps to optimise the construction of the transition relation stored [_$_]
--- in the node of the transition graph (this also saves substantial memory).
---
---- DOCU ----------------------------------------------------------------------
---
--- language: Haskell 98 & rank-2 polymorphism (existentially quantified type [_$_]
--- variables)
---
--- Unlike conventional parser combinators, the combinators do not produce
--- parsers, but only specifications of parsers that can then be executed
--- using the function `parse'.
---
--- It is basically impossible to get this efficient without universally-
--- quantified data type fields (or existentially quantified type variables)
--- as soon as we encode the parsers in a data structure. The reason is that
--- we cannot store the action functions in the structure without that
--- feature.
---
--- A user-defined state can be passed down in the parser and be threaded
--- through the individual actions.
---
--- Tokens:
---
--- * Tokens must contain a position and equality as well as an ordering
--- relation must be defined for them. The equality determines whether
--- tokens "match" during parsing, ie, whether they are equal modulo their
--- attributes (the position is, of course, an attribute). The ordering
--- supports an optimised representation of the transition graph. Tokens
--- are, furthermore, printable (instance of `Show'); the resulting string
--- should correspond to the lexeme of the token and not the data
--- constructor used to represent it internally.
---
--- * I tried using arrays to represent the transition relation in the nodes
--- of the graph, but this leads to an enormous memory consumption (at least [_$_]
--- with ghc 4.05). One reason for this is certainly that these arrays are
--- relatively sparsely populated.
---
---- TODO ----------------------------------------------------------------------
---
--- * Error correction is still missing.
---
-
-module Parsers (Token, Parser, empty, token, skip, (<|>), (*$>), (*>), ($>),
- action, meta, opt, (-*>), (*->), many, list, many1, list1,
- sep, seplist, sep1, seplist1, execParser)
-where
-
-import List (sort)
-
-import Common (Position, Pos (posOf), nopos)
-import Map (Map)
-import qualified Map as Map (singleton, unionWith, map, lookup, toList)
-import Errors (interr, ErrorLvl(..), Error, makeError)
-
-infix 5 `opt`
-infixl 4 *>, -*>, *->, *$>, $>
-infixl 3 `action`
-infixl 2 <|>
-
-
--- data structures
--- ---------------
-
--- token class (EXPORTED)
---
-class (Pos t, Show t, Eq t, Ord t) => Token t
-
--- tree structure used to represent parsers specifications (EXPORTED
--- ABSTRACTLY) [_$_]
---
--- * each node corresponds to a state of the represented automaton and is
--- composed out of an action and a parsing continuation, which encodes the
--- state transition function in the current state
---
-data Token t =>
- Parser a t r = forall q. Parser (Action a t q r) -- action functions
- (Cont a t q) -- parsing continuation
-
--- parsing continuation
---
-data Token t =>
- Cont a t r = -- maybe end of input
- --
- Empty r -- return if no input
- (Parser a t r) -- used if there is input
- --
- -- selection of acceptable tokens paired with following [_$_]
- -- parser state
- --
- | Alts (Map t (Parser a t r))
- --
- -- represents an automaton without any transitions
- -- (semantically equivalent to `Alts zeroFM', but easier to
- -- match)
- --
- | Done
-
--- actions
---
--- * Note that the rank-2 polymorphism (existentially quantified type [_$_]
--- variable) is essential here to seperate the action function from the
--- parser (if we don't do that, the actions are pushed down in the parser
--- structure until they reach the `Empty' variant matching the end-of-file
--- in the actual parse - this makes the parser structure as deep as the
--- input has tokens!)
---
--- * the meta action is transforming a threaded state top-down; the result of
--- the state transformer (type `q'') is passed to the tree constructor
--- action, after the following parser has been applied; the meta action has
--- to be executed before the parser is applied, as the parser get's the
--- internal state *after* transformed by the meta action; overall we have,
--- (1) meta action, (2) recursive application of the parser, (3) tree
--- constructing action
---
-data Token t =>
- Action a t q r = forall q'. Action (a -> (a, q')) -- meta action
- (q' -> t -> q -> r) -- tree constr
-
--- internal tree constructors
---
-
-nometa :: Token t => (t -> q -> r) -> Action a t q r
-nometa simpleAction = Action (\s -> (s, ())) (\_ -> simpleAction)
-
-singleton :: Token t => t -> Parser a t r -> Cont a t r
-singleton t p = Alts $ Map.singleton t p
-
-noaction :: Token t => Cont a t q -> Parser a t q
-noaction = Parser $ nometa (flip const)
-
-tokaction :: Token t => Cont a t q -> Parser a t t
-tokaction = Parser $ nometa const
-
-noparser :: Token t => Parser a t r
-noparser = noaction Done
-
-
--- basic combinators
--- -----------------
-
--- Without consuming any input, yield the given result value (EXPORTED)
---
-empty :: Token t => r -> Parser a t r
-empty x = noaction $ Empty x noparser
-
--- Consume a token that is equal to the given one; the consumed token is
--- returned as the result (EXPORTED) [_$_]
---
-token :: Token t => t -> Parser a t t
-token t = tokaction $ singleton t (empty ())
-
--- Consume a token that is equal to the given one; the consumed token is
--- thrown away (EXPORTED) [_$_]
---
-skip :: Token t => t -> Parser a t ()
-skip t = noaction $ singleton t (empty ())
-
--- Alternative parsers (EXPORTED)
---
-(<|>) :: Token t => Parser a t r -> Parser a t r -> Parser a t r
---
--- * Alternatives require to merge the alternative sets of the two parsers.
--- The most interesting case is where both sets contain cases for the same
--- token. In this case, we left factor over this token. This requires some [_$_]
--- care with the actions, because we have to be able to decide which of
--- the two actions to apply. To do so, the two parsers prefix their results [_$_]
--- with a `Left' or `Right' tag, which makes it easy to decided in the new
--- combined action, which of the two subparsers did match.
---
-(Parser _ Done) <|> q = q
-p <|> (Parser _ Done) = p
---(Parser a (Empty _ p)) <|> (Parser a' (Empty _ q)) = grammarErr p q
-(Parser a (Empty x p)) <|> q = mergeEpsilon a x p q
-p <|> (Parser a' (Empty x q)) = mergeEpsilon a' x q p
-(Parser a (Alts alts1)) <|> (Parser a' (Alts alts2)) = [_$_]
- Parser (a `joinActions` a') $ Alts (Map.unionWith (<|>) alts1' alts2')
- where
- alts1' = Map.map (\p -> Left $> p) alts1
- alts2' = Map.map (\p -> Right $> p) alts2
-
-grammarErr :: Token t => Parser a t r -> Parser a t r -> b
-grammarErr p q = interr $ "Parsers.<|>: Ambiguous grammar!\n\
- \ first (left parser): " ++ first p ++ "\n\
- \ first (right parser): " ++ first q ++ "\n"
-
-mergeEpsilon :: Token t
- => Action a t q r -> q -> Parser a t q -> Parser a t r [_$_]
- -> Parser a t r
-mergeEpsilon a x p q = [_$_]
- let anew = a `joinActions` nometa (flip const) -- mustn't touch token!
- newcon = Empty (Left x) (Left $> p <|> Right $> q)
- in
- Parser anew newcon [_$_]
-
-joinActions :: Token t [_$_]
- => Action a t q r -> Action a t q' r [_$_]
- -> Action a t (Either q q') r
-(Action m con) `joinActions` (Action m' con') =
- Action (joinMeta m m')
- (\(q'1, q'2) t qalt -> case qalt of
- Left q -> con q'1 t q
- Right q -> con' q'2 t q)
-
--- combine two meta action into one, which yields a pair of the individual
--- results (the state is threaded through one after another - no assumption
--- may be made about the order)
---
-joinMeta :: (a -> (a, r1)) -> (a -> (a, r2)) -> a -> (a, (r1, r2))
-joinMeta meta meta' = \s -> let [_$_]
- (s' , q'1) = meta s
- (s'', q'2) = meta' s'
- in [_$_]
- (s'', (q'1, q'2))
-
--- Sequential parsers, where the result of the first is applied to the result
--- of the second (EXPORTED)
---
-(*$>) :: Token t => Parser a t (s -> r) -> Parser a t s -> Parser a t r
--- !!!
-(Parser a@(Action m con) Done) *$> q = [_$_]
- let con' = interr "Parsers.(*$>): Touched action after an error!"
- in
- Parser (Action m con') Done
-(Parser a@(Action m con) (Empty f p)) *$> q = [_$_]
--- _scc_ "*$>:Empty"
- let a' = Action m (\q' t q -> con q' t f q)
- in
- contract a p *$> q <|> contract a' q
-(Parser (Action m con) (Alts alts)) *$> q = [_$_]
--- _scc_ "*$>:Alt"
- let con' x' t (xp, xq) = con x' t xp xq
- in
- Parser (Action m con') (Alts $ Map.map (\p -> p *> q) alts)
-
-contract :: Token t => Action a t q r -> Parser a t q -> Parser a t r
-contract (Action m con) (Parser (Action m' con') c) =
- let a' = Action (joinMeta m m')
- (\(x'1, x'2) t x -> con x'1 notok (con' x'2 t x))
- in
- Parser a' c
- where
- notok = interr $ "Parsers.(*$>): Touched forbidden token!"
-
--- Sequential parsers, where the overall result is the pair of the component
--- results (EXPORTED)
---
-(*>) :: Token t => Parser a t s -> Parser a t r -> Parser a t (s, r)
-p *> q = (,) $> p *$> q
-
--- apply a function to the result yielded by a parser (EXPORTED)
---
-($>) :: Token t => (s -> r) -> Parser a t s -> Parser a t r
-f $> Parser (Action m con) c = let con' q' t q = f $ con q' t q
- in
- Parser (Action m con') c
-
--- produces a parser that encapsulates a meta action manipulating the
--- threaded state (EXPORTED)
---
-meta :: Token t => (a -> (a, r)) -> Parser a t r
-meta g = Parser (Action g (\q' _ _ -> q')) (Empty () noparser)
-
-
--- non-basic combinators
--- ---------------------
-
--- postfix action (EXPORTED)
---
-action :: Token t => Parser a t s -> (s -> r) -> Parser a t r
-action = flip ($>)
-
--- optional parse (EXPORTED)
---
-opt :: Token t => Parser a t r -> r -> Parser a t r
-p `opt` r = p <|> empty r
-
--- sequential composition, where the result of the rhs is discarded (EXPORTED)
---
-(*->) :: Token t => Parser a t r -> Parser a t s -> Parser a t r
-p *-> q = const $> p *$> q
-
--- sequential composition, where the result of the lhs is discarded (EXPORTED)
---
-(-*>) :: Token t => Parser a t s -> Parser a t r -> Parser a t r
-p -*> q = flip const $> p *$> q
-
--- accept a sequence of productions from a nonterminal (EXPORTED)
---
--- * Uses a graphical structure to require only constant space, but this
--- behaviour is destroyed if the replicated parser is a `skip c'.
---
-many :: Token t => (r -> s -> s) -> s -> Parser a t r -> Parser a t s
---
--- * we need to build a cycle, to avoid building the parser structure over and [_$_]
--- over again
---
-many f e p = let me = (f $> p *$> me) `opt` e
- in me
-
--- return the results of a sequence of productions from a nonterminal in a
--- list (EXPORTED) [_$_]
---
-list :: Token t => Parser a t r -> Parser a t [r]
-list = many (:) [] [_$_]
-
--- accept a sequence consisting of at least one production from a nonterminal
--- (EXPORTED) [_$_]
---
-many1 :: Token t => (r -> r -> r) -> Parser a t r -> Parser a t r
---many1 f p = p <|> (f <$> p <*> many1 f p)
-many1 f p = let me = p <|> (f $> p *$> me)
- in me
-
--- accept a sequence consisting of at least one production from a nonterminal
--- and return a list of results (EXPORTED) [_$_]
---
-list1 :: Token t => Parser a t r -> Parser a t [r]
-list1 p = let me = (\x -> [x]) $> p [_$_]
- <|> ((:) $> p *$> me)
- in me
-
--- accept a sequence of productions from a nonterminal, which are seperated by [_$_]
--- productions of another nonterminal (EXPORTED)
---
-sep :: Token t [_$_]
- => (r -> u -> s -> s) [_$_]
- -> (r -> s) [_$_]
- -> s [_$_]
- -> Parser a t u [_$_]
- -> Parser a t r [_$_]
- -> Parser a t s
-sep f g e sepp p = let me = g $> p <|> (f $> p *$> sepp *$> me)
- in me `opt` e
-
--- return the results of a sequence of productions from a nonterminal, which
--- are seperated by productions of another nonterminal, in a list (EXPORTED)
---
-seplist :: Token t => Parser a t s -> Parser a t r -> Parser a t [r]
-seplist = sep (\h _ l -> h:l) (\x -> [x]) [] [_$_]
-
--- accept a sequence of productions from a nonterminal, which are seperated by [_$_]
--- productions of another nonterminal (EXPORTED)
---
-sep1 :: Token t [_$_]
- => (r -> s -> r -> r) -> Parser a t s -> Parser a t r -> Parser a t r
-sep1 f sepp p = let me = p <|> (f $> p *$> sepp *$> me)
- in me
-
--- accept a sequence consisting of at least one production from a nonterminal, [_$_]
--- which are separated by the productions of another nonterminal; the list of
--- results is returned (EXPORTED)
---
-seplist1 :: Token t => Parser a t s -> Parser a t r -> Parser a t [r]
-seplist1 sepp p = p *> list (sepp -*> p) `action` uncurry (:)
-{- Is the above also space save? Should be. Contributed by Roman.
-seplist1 sepp p = let me = (\x -> [x]) $> p [_$_]
- <|> ((:) $> p *-> sepp *$> me)
- in me
--}
-
-
--- execution of a parser
--- ---------------------
-
--- apply a parser to a token sequence (EXPORTED)
---
--- * The token mapping is applied to every token just before consumption. It
--- is useful if a processing phase needs to be put between scanner and
--- lexer, where only the tokens actually consumed are to be processed (and
--- the rest returned in their original form).
---
--- * Trailing tokens are returned in the third component of the result (the
--- longest match is found).
---
--- * Currently, all errors are fatal; thus, the result (first component of the [_$_]
--- returned pair) is undefined in case of an error (this changes when error
--- correction is added).
---
-execParser :: Token t [_$_]
- => Parser a t r -- parser specification
- -> a -- initial state
- -> (t -> t) -- token mapping
- -> [t] -- token stream
- -> (r, [Error], [t]) -- result with errors and rest tokens
---
--- * Regarding the case cascade in the second equation, note that laziness is
--- not our friend here. The root of the parse tree will be constructed at
--- the very end of parsing; so, there is no way, we can have any pipelining
--- with following stages here (and then there are the error messages, which
--- also spoil pipelining).
---
-execParser (Parser (Action m con) c) a _ [] = -- eof
- case c of [_$_]
- Empty x _ -> (con (snd . m $ a) errtoken x, [], [])
- _ -> (errresult, [makeError FatalErr nopos eofErr], [])
-execParser (Parser (Action m con) c) a f ts = -- eat one token
- case m a of -- execute meta action
- (a', x') -> case cont c a' f ts of -- process next input token
--- !!! (t, (x, errs, ts')) -> ((((con $! x') $ t) $!x), errs, ts')
- (t, (x, errs, ts')) -> ((((con $ x') $ t) $ x), errs, ts')
- where
- cont :: Token t [_$_]
- => Cont a t r -> a -> (t -> t) -> [t] -> (t, (r, [Error], [t]))
- cont Done _ f (t:_) = makeErr (posOf (f t)) trailErr
- cont (Alts alts) a f (t:ts) = let t' = f t
- in case Map.lookup t' alts of
- Nothing -> makeErr (posOf t') (illErr t')
- Just p -> (t', execParser p a f ts)
- cont (Empty x p) a f ts =
- case p of
- Parser _ Done -> (errtoken, (x, [], ts))
- _ -> (errtoken, (execParser p a f ts))
-
-makeErr pos err = (errtoken, (errresult, [makeError FatalErr pos err], []))
-
-eofErr = ["Unexpected end of input!",
- "The code at the end of the file seems truncated."]
-trailErr = ["Trailing garbage!",
- "There seem to be characters behind the valid end of input."]
-illErr t = ["Syntax error!",
- "The symbol `" ++ show t ++ "' does not fit here."]
-
-errresult = interr "Parsers.errresult: Touched undefined result!"
-errtoken = interr "Parsers.errtoken: Touched undefined token!"
-
-
--- for debugging
--- -------------
-
--- first set of the given parser (prefixed by a `*' if this is an epsilon
--- parser) [_$_]
---
-first :: Token t => Parser a t r -> String
-first (Parser _ (Empty _ p)) = "*" ++ first p
-first (Parser _ (Alts alts)) = show [_$_]
- . sort [_$_]
- . map show [_$_]
- . map fst [_$_]
- . Map.toList
- $ alts
-
---instance Token t => Show (Parser a t r) where
--- showsPrec _ (Parser a c) = shows c
-
---instance Token t => Show (Cont a t r) where
--- showsPrec _ (Empty r p ) = showString "*" . shows p
--- showsPrec _ (Alts alts) = shows alts
rmfile ./tools/c2hs/base/syntax/Parsers.hs
hunk ./tools/c2hs/base/syntax/Pretty.hs 1
--- Compiler Toolkit: pretty-printer combinators
---
--- Author : Manuel M. T. Chakravarty
--- Created: 16 February 95
---
--- Copyright (c) [1995..2000] Manuel M. T. Chakravarty
---
--- This file is free software; you can redistribute it and/or modify
--- it under the terms of the GNU General Public License as published by
--- the Free Software Foundation; either version 2 of the License, or
--- (at your option) any later version.
---
--- This file 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 General Public License for more details.
---
---- DESCRIPTION ---------------------------------------------------------------
---
--- This module provides combinators for pretty-printing, following the ideas
--- in ``Pretty-printing: An Exercise in Functional Programming (DRAFT)'' by
--- John Hughes. Subsequently, partially brought in line with Simon Peyton
--- Jones' version of John Hughes' combinators.
---
---- DOCU ----------------------------------------------------------------------
---
--- language: Haskell 98
---
--- * In a revision of the module, the names of the exported functions where
--- brought in line with SimonPJs variant. The old names are still exported
--- as to maintain compatibility to older code. They will disappear
--- somewhere down the road.
---
--- * The type of `fullRender' is different from the one in SimonPJ's variant.
---
--- * `toDoc' is not supported by SimonPJ's variant.
---
--- * The combinators `($+$)', `fcat', and `fsep' are not supported.
---
---- TODO ----------------------------------------------------------------------
---
--- * currently `$|$' imposes a n^2 cost when building a text from top to
--- bottom
---
- [_$_]
-module Pretty (
- Doc, -- instance Show
- empty, isEmpty, char, text, nest, ($$), (<>), cat, sep, fullRender,
- --
- -- derived combinators
- --
- semi, comma, colon, dot, space, equals, lparen, rparen, lbrack, rbrack,
- lbrace, rbrace, toDoc, int, integer, float, double, rational, parens,
- brackets, braces, quotes, doubleQuotes, (<+>), hcat, hsep, vcat, hang,
- punctuate, render,
- --
- -- pretty-printing type class & precedences
- --
- Pretty(pretty, prettyPrec), usedWhen, Assoc(..), infixOp,
- --
- -- the following routines are part of the legacy interface that should not
- -- be used anymore - it will disappear in due course
- --
- textDoc, nestDoc, ($|$), (<^>), sepDocs, bestDoc,
- --
- -- *** for debugging ONLY ***
- --
- dumpDoc
-) where
-
-
-infixl 6 <>, <+> -- vertical composition
-infixl 5 $$ -- horizontal composition
-
-
--- default parameters
--- ------------------
-
-dftWidth :: Int
-dftWidth = 79
-
-dftRibbonRatio :: Float
-dftRibbonRatio = 1.5
-
-
--- representation of documents
--- ---------------------------
-
--- a document is a compact representation (tree shaped) of a set of layouts [_$_]
--- for a given text (EXPORTED ABSTRACTLY)
---
-data Doc = Nest Int [DocAlt] -- set of layouts, indented as given
-data DocAlt = Text String -- one row
- | TextAbove String Doc -- row of text above the remaining doc
-
--- render with defaults
---
-instance Show Doc where
- showsPrec _ = showString . render
-
--- empty document (EXPORTED)
---
-empty :: Doc
-empty = Nest 0 []
-
--- test for emptiness (EXPORTED)
---
-isEmpty :: Doc -> Bool
-isEmpty (Nest _ []) = True
-isEmpty _ = False
-
--- single character (EXPORTED)
---
-char :: Char -> Doc
-char c = text [c]
-
--- single line of text (EXPORTED)
---
-text :: String -> Doc
-text s = Nest 0 [Text s]
-
--- increase nesting of given document (EXPORTED)
---
-nest :: Int -> Doc -> Doc
-nest k (Nest m alts) = Nest (k + m) alts
-
--- vertical composition of documents (EXPORTED)
---
-($$) :: Doc -> Doc -> Doc
-(Nest _ [] ) $$ doc = doc
-(Nest m alts) $$ doc = Nest m [below a | a <- alts]
- where
- below :: DocAlt -> DocAlt
- below (Text s) = let
- doc' = nestDoc (-m) doc
- in
- TextAbove s doc'
- below (TextAbove s rest) = let
- doc' = rest [_$_]
- $$ [_$_]
- nestDoc (-m) doc
- in
- TextAbove s doc'
-
--- horizontal composition of documents (EXPORTED)
---
-(<>) :: Doc -> Doc -> Doc
-(Nest _ [] ) <> doc = doc
-doc <> (Nest _ [] ) = doc
-(Nest m alts) <> doc = Nest m (concat [nextTo a | a <- alts])
- where
- nextTo :: DocAlt -> [DocAlt]
- nextTo (Text s) = let
- Nest _ bs = doc
- in
- [s `inFrontOf` b | b <- bs]
- nextTo (TextAbove s rest) = [TextAbove s (rest <> doc)]
-
- inFrontOf :: String -> DocAlt -> DocAlt
- s `inFrontOf` (Text t) = Text (s ++ t)
- s `inFrontOf` (TextAbove t doc') = let [_$_]
- l = length s
- in
- TextAbove (s ++ t) [_$_]
- (nestDoc l doc')
-
--- given a list of sub-documents, generate a composite document where the [_$_]
--- sub-documents are placed next to each other (EXPORTED)
---
--- * when generating a layout a horizontal layout is only chosen
--- when the given collection of sub-documents fits on a single line
---
-cat :: [Doc] -> Doc
-cat docs = catsep (<>) docs
-
--- given a list of sub-documents, generate a composite document where the [_$_]
--- sub-documents are placed next to each other with some seperation between
--- each of them (EXPORTED)
---
--- * when generating a layout a horizontal layout is only chosen
--- when the given collection of sub-documents fits on a single line
---
-sep :: [Doc] -> Doc
-sep docs = catsep (<+>) docs
-
--- generalise `cat' and `sep'
---
-catsep :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
-catsep _ [] = textDoc ""
-catsep hcomb docs = fitunion (foldr hcomb empty docs) [_$_]
- (foldr ($$) empty docs)
- where
- --
- -- given two documents, where the first one is a horizontal
- -- composition, we only choose a single line alternative (if at
- -- all present) from the first document
- --
- fitunion :: Doc -> Doc -> Doc
- fitunion (Nest m (Text s : _)) (Nest _ alts) = Nest m (Text s : alts)
- fitunion _ doc = doc
-
--- select the best layout from a document and return it in string form
--- (EXPORTED)
---
--- * given are the overall width and the ribbon ration, ie, the number of
--- times the ribbon fits into a line (the ribbon is the number of
--- characters on a line excluding leading and trailing white spaces)
---
-fullRender :: Int -> Float -> Doc -> String
-fullRender width ribbonRatio = [_$_]
- let
- ribbon = round (fromIntegral width / ribbonRatio)
- in
- dropWhile (== '\n') . nestbest 0 width ribbon
- where
- --
- -- like `best', but with explicit nesting
- --
- nestbest :: Int -> Int -> Int -> Doc -> String
- nestbest k w r (Nest _ [] ) = ""
- nestbest k w r (Nest m alts) = [_$_]
- case foldr1 (choose (w - m) r) alts [_$_]
- of
- Text s -> indent (k + m) s
- TextAbove s bs -> indent (k + m) s [_$_]
- ++ nestbest (k + m) (w - m) r bs
- --
- -- indent the given string by the given amount
- --
- indent :: Int -> String -> String
- indent k s = "\n" ++ copy k ' ' ++ s
- where
- copy :: Int -> a -> [a]
- copy n = take n . repeat[_^I_] [_$_]
-
- -- given the remaining width and ribbon together with two possible
- -- documents, choose the first one if its first line is nice; otherwise,
- -- take the second
- --
- choose :: Int -> Int -> DocAlt -> DocAlt -> DocAlt
- choose w r alts1 alts2 = if (nice w r (firstline alts1))
- then alts1
- else alts2
- where
- firstline (Text s) = s
- firstline (TextAbove s _) = s
-
- -- given remaining width and ribbon width decide whether a line
- -- is nice or not
- --
- nice :: Int -> Int -> String -> Bool
- nice w r s = (l <= w) && (l <= r)
- where
- l = length s
-
-
--- derived combinators
--- -------------------
-
--- punctuation characters (EXPORTED)
---
-semi, comma, colon, dot :: Doc
-semi = char ';'
-comma = char ','
-colon = char ':'
-dot = char '.'
-
--- separators (EXPORTED)
---
-space, equals :: Doc
-space = char ' '
-equals = char '='
-
--- round parenthesis (EXPORTED)
---
-lparen, rparen :: Doc
-lparen = char '('
-rparen = char ')'
-
--- square brackets (EXPORTED)
---
-lbrack, rbrack :: Doc
-lbrack = char '['
-rbrack = char ']'
-
--- curly braces (EXPORTED)
---
-lbrace, rbrace :: Doc
-lbrace = char '{'
-rbrace = char '}'
-
--- any value that has a textual representation (EXPORTED)
---
-toDoc :: Show a => a -> Doc
-toDoc = text . show
-
--- ints (EXPORTED)
---
--- * these are only for compatibility with SimonPJ's `Pretty' module as `toDoc'
--- is more general
---
-int :: Int -> Doc
-int = toDoc
-integer :: Integer -> Doc
-integer = toDoc
-float :: Float -> Doc
-float = toDoc
-double :: Double -> Doc
-double = toDoc
-rational :: Rational -> Doc
-rational = toDoc
-
--- wrap a document into various forms of brackets
---
-parens, brackets, braces :: Doc -> Doc [_$_]
-parens doc = lparen <> doc <> rparen
-brackets doc = lbrack <> doc <> rbrack
-braces doc = lbrace <> doc <> rbrace
-
--- wrap a document into quotes
---
-quotes, doubleQuotes :: Doc -> Doc
-quotes doc = char '`' <> doc <> char '\''
-doubleQuotes doc = char '"' <> doc <> char '"'
-
--- horizontal composition including a space if none of the documents is empty
--- (EXPORTED)
---
-(<+>) :: Doc -> Doc -> Doc
-d1 <+> d2 | isEmpty d1 = d2
- | isEmpty d2 = d1
- | otherwise = d1 <> space <> d2
-
--- list version of horizontal composition (EXPORTED)
---
-hcat :: [Doc] -> Doc
-hcat = foldr (<>) empty
-
--- list version of horizontal composition including a space (EXPORTED)
---
-hsep :: [Doc] -> Doc
-hsep = foldr (<+>) empty
-
--- list version of vertical composition (EXPORTED)
---
-vcat :: [Doc] -> Doc
-vcat = foldr ($$) empty
-
--- hang the second document of the first, where the second one is indented
--- (EXPORTED)
---
-hang :: Doc -> Int -> Doc -> Doc
-hang doc1 n doc2 = sep [doc1, nest n doc2]
-
--- add a punctuation document to every document in a list, but the last
--- (EXPORTED)
---
-punctuate :: Doc -> [Doc] -> [Doc]
-punctuate _ [] = []
-punctuate p ds = map (<> p) (init ds) ++ [last ds]
-
--- render a document using the default settings
---
-render :: Doc -> String
-render = fullRender dftWidth dftRibbonRatio
-
-
--- type class and precedence
--- -------------------------
-
--- overloaded pretty-printing function (EXPORTED)
---
-class Pretty a where
- pretty :: a -> Doc
- prettyPrec :: Int -> a -> Doc
-
- pretty = prettyPrec 0
- prettyPrec _ = pretty
-
--- useful to keep the interface simple and general
---
-instance Pretty Doc where
- pretty = id
-
--- conditionally apply a document transformer (EXPORTED)
---
--- * typically a function like `parens' is applied when the precedences require
--- this
---
-usedWhen :: (Doc -> Doc) -> Bool -> Doc -> Doc
-usedWhen wrap c doc | c = wrap doc
- | otherwise = doc
-
--- associativity of an infix operator (EXPORTED)
---
-data Assoc = LeftAssoc | RightAssoc | NoAssoc
- deriving (Eq)
-
--- pretty print an infix operator given its precedence, lexeme, and its two
--- arguments (EXPORTED)
---
-infixOp :: (Pretty a, Pretty b) [_$_]
- => Assoc -- associativity of operator
- -> Int -- precedence of operator
- -> String -- lexeme of operator
- -> a -- left argument
- -> b -- right argument
- -> Int -- precedence of context
- -> Doc
-infixOp assoc opp lexeme arg1 arg2 p = parens `usedWhen` (p > opp) $ [_$_]
- hsep [
- prettyPrec leftOpp arg1,
- text lexeme,
- prettyPrec rightOpp arg2
- ]
- where
- leftOpp = if (assoc == RightAssoc) then opp + 1 else opp
- rightOpp = if (assoc == LeftAssoc ) then opp + 1 else opp
-
-
--- the legacy interface (this is only kept for compatibility)
--- --------------------
-
-infixr 1 $|$ -- vertical composition
-infixr 1 <^> -- horizontal composition
-
-
-textDoc :: String -> Doc
-textDoc = text
-
-nestDoc :: Int -> Doc -> Doc
-nestDoc = nest
-
-($|$) :: Doc -> Doc -> Doc
-($|$) = ($$)
-
-(<^>) :: Doc -> Doc -> Doc
-(<^>) = (<>)
-
-sepDocs :: [Doc] -> Doc
-sepDocs = sep
-
-bestDoc :: Int -> Int -> Doc -> String
-bestDoc width ribbon = fullRender width [_$_]
- (fromIntegral width / fromIntegral ribbon)
-
-
--- debugging support
--- -----------------
-
-dumpDoc :: Doc -> String
-dumpDoc (Nest _ [] ) = "<empty>"
-dumpDoc (Nest m alts) = unlines . map (++ "\n--") . map outline $ alts
- where
- outline (Text str ) = str
- outline (TextAbove str _) = str ++ "\n..."
rmfile ./tools/c2hs/base/syntax/Pretty.hs
hunk ./tools/c2hs/base/sysdep/Makefile 1
-# Compiler Toolkit: makefile for the system dependent modules
-#
-# Author : Manuel M T Chakravarty
-# Created: 24 October 1997
-#
-# Version $Revision: 1.1.1.1 $ from $Date: 2004/11/13 16:42:51 $
-#
-# Copyright (c) [1997..2003] Manuel M T Chakravarty
-#
-# This file is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This file 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 General Public License for more details.
-#
-# = DOCU =====================================================================
-#
-
-# ***************************************
-# !!! This makefile requires GNU make !!!
-# ***************************************
-
-# we need the config info to determine which sources we have to compile
-#
-include ../../mk/config.mk
-
-# info for this part: its package, name, sources and objects files (must be [_$_]
-# before the include due to conditionals etc in `common.mk')
-#
-PACKAGE = base
-PCKNAME = ctk
-PART = sysdep
-SRCS = SysDep.hs SysDepPosix.hs
-#
-# extra sources for nhc
-#
-ifeq ($(SYS),$(findstring $(SYS),nhc1))
- SRCS += IOExtsNHC1.hs
-endif
-#
-OBJS = $(patsubst %.hs,%.o,$(SRCS))
-
-include ../../mk/common.mk
-
-# In case we use a GHC4, GHC5, or GHC6 system, we need some extra options for [_$_]
-# `SysDep.hs'. [_$_]
-#
-# * we currently need `-fvia-C', as the native code generator doesn't grok [_$_]
-# some of the non-standard primitives
-#
-ifeq ($(SYS),$(findstring $(SYS),ghc4 ghc5 ghc6))
- EXTRAHCFLAGS= -fglasgow-exts -fvia-C
-endif
-
-# extra dependencies for nhc
-#
-ifeq ($(SYS),$(findstring $(SYS),nhc1))
-SysDep: IOExtsNHC1
-endif
-
-
-# make all object files
-#
-objs: $(OBJS)
-
-# make all
-#
-all: testconfig objs
-
-
-# Use appropriate system dependent modules
-# ========================================
-#
-.PHONY: config testconfig
-
-# name of the Haskell module containing the system dependend code for
-# system $(SYS) -- "SysDep" ++ $(SYS) ++ ".hs"
-#
-# FIXME: Has anybody a good idea how to convert a string to all upper here
-#
-SYSUPPER = $(subst nhc,NHC,$(subst ghc,GHC,$(SYS)))
-SYSDEPHS = $(addsuffix .hs,$(addprefix SysDep,$(SYSUPPER)))
-AVAIL_SYSDEPHS= $(wildcard SysDep*.hs)
-
-# if the code for the requested system is present, enable it; otherwise, error
-#
-# * in case of success, we also invoke a `config' target in the `syntax' part,
-# as we have to exlude some module for some systems
-#
-# * Then, we check for supports of HSLibs' posix package
-#
-# * SysDepGHC5.hs is an alias of SysDepGHC4.hs
-#
-config:
- @$(RM) SysDepGHC5.hs SysDepGHC6.hs
- @$(LN) -s SysDepGHC4.hs SysDepGHC5.hs
- @$(LN) -s SysDepGHC4.hs SysDepGHC6.hs
-ifeq ($(SYSDEPHS),$(findstring $(SYSDEPHS),$(AVAIL_SYSDEPHS) SysDepGHC5.hs SysDepGHC6.hs))
- $(RM) SysDep.hs
- $(LN) -s $(SYSDEPHS) SysDep.hs
- @echo "*** Configured for compilation system $(SYS)."
- $(MAKE) -C ../syntax $(MFLAGS) $@
-else
- @echo "$(SYSDEPHS) in $(AVAIL_SYSDEPHS) SysDepGHC5.hs SysDepGHC6.hs"
- @echo "*** Unsupported Haskell compiler \`$(SYS)' specified! "
- @exit 1
-endif
- $(RM) SysDepPosix.hs
-# Posix (and hence, `runPiped') support disabled, as `runPiped' (1) isn't
-# really used at the moment, (2) should be rewritten anyway, and (3) breaks [_$_]
-# with GHC 6.3 as the signature of `forkProcess' changed.
-#ifeq (posix,$(findstring posix,$(SYSFEATURES)))
-# $(LN) -s SysDepPosixAVAIL.hs SysDepPosix.hs
-# @echo "*** Configured for use of HSLibs posix package."
-#else
- $(LN) -s SysDepPosixUNAVAIL.hs SysDepPosix.hs
-# @echo "*** Configured WITHOUT HSLibs posix package."
-#endif
-
-# Configured?
-#
-testconfig:
- @if [ ! -f SysDep.hs ]; then \
- echo "*** Configure with \`make config' first! "; \
- exit 1; \
- fi
- @echo "*** Compiling with system specifier $(SYS)."
-
-
-# misc targets
-# ============
-#
-.PHONY: clean cleanhi
-
-clean:
- -$(RM) *.o
- -$(RM) SysDepGHC5.hs SysDepGHC6.hs SysDep.hs SysDepPosix.hs
-
-cleanhi:
- -$(RM) *.hi
rmfile ./tools/c2hs/base/sysdep/Makefile
hunk ./tools/c2hs/base/sysdep/SysDep.hs 1
--- Compiler Toolkit: system dependent stuff (GHC 4.x version; x >= 02)
---
--- Author : Manuel M. T. Chakravarty
--- Derived: 11 March 1999 (from SysDepGHC3.hs)
---
--- Version $Revision: 1.3 $ from $Date: 2004/12/13 21:45:52 $
---
--- Copyright (c) [1996..2000] Manuel M. T. Chakravarty
---
--- This file is free software; you can redistribute it and/or modify
--- it under the terms of the GNU General Public License as published by
--- the Free Software Foundation; either version 2 of the License, or
--- (at your option) any later version.
---
--- This file 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 General Public License for more details.
---
---- DESCRIPTION ---------------------------------------------------------------
---
--- This module provides the system dependent routines for building with the
--- Glasgow Haskell Compiler (GHC) version 4.x, from x >= 02.
---
--- The original definition of `runPiped' is courtesy of Sven Panne [_$_]
--- <Sve...@in...> as distributed on the [_$_]
--- gla...@dc... mailing list as
--- <362...@in...>.
---
---- DOCU ----------------------------------------------------------------------
---
--- language: Haskell 98 (tested with the low-level interfaces of [_$_]
--- GHC 4.0[2..8] and 5.00)
---
--- * may only import `Config'
---
--- * has to be compiled with `-syslib exts'
---
--- Provided Services
--- -----------------
---
--- * IO monad:
--- - fixpoint combinator
---
--- * Mutable variables and arrays:
--- - creation, read & write
--- [_$_]
--- * Process management (if provided by `SysDepPosix'):
--- - creation of child process connected with pipes
---
--- * Tracing primitive
---
--- * Unsafe integer cells
---
--- Currently, the functionality of `SysDepPosix' is always available when
--- compiling with GHC, *except* on cygwin.
---
---- TODO ----------------------------------------------------------------------
---
-
-module SysDep (
- --
- -- for Haskell 1.4/98 compatibility
- --
- ioError,
- --
- -- extra IO functions
- --
- fixIO,
- --
- -- mutable variables and arrays (in IO)
- --
- IORef, newIORef, readIORef, writeIORef,
- IOArray, newIOArray, getBoundsIOArray, readIOArray, writeIOArray,
- --
- -- fork
- --
- module SysDepPosix,
- --
- -- tracing
- --
- trace,
- --
- -- UNSAFE stuff -- *Real* Haskell Hackers only!!!
- --
- unsafeNewIntRef, unsafeReadAndIncIntRef
-) where
-
-import Ix (Ix)
-import Monad (when)
-
-import System.IO (fixIO)
-import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO)
-import Data.IORef (IORef, newIORef, readIORef, writeIORef)
-import Data.Array.IO (IOArray, newArray, readArray, writeArray, unsafeFreeze)
-import Data.Array (bounds)
-import Debug.Trace (trace)
-
--- other system-dependent components
---
-import SysDepPosix
-
--- re-export some things with different names
---
-newIOArray :: Ix i => (i, i) -> e -> IO (IOArray i e)
-newIOArray = newArray
--- NOTE: base-2.0 eliminates the HasBounds class and its instance for IOArray
--- and provides a getBounds function with the signature below instead.
--- The following implementation works for base-1.0 and base-2.0
-getBoundsIOArray :: Ix i => IOArray i e -> IO (i, i)
-getBoundsIOArray a = unsafeFreeze a >>= return . bounds
-readIOArray :: Ix i => IOArray i e -> i -> IO e
-readIOArray = readArray [_$_]
-writeIOArray :: Ix i => IOArray i e -> i -> e -> IO ()
-writeIOArray = writeArray [_$_]
-
--- UNSAFE mutable variables
--- ------------------------
-
--- WARNING: The following does not exist, or at least, it belongs to another
--- world. And if you believe into the lambda calculus, you don't
--- want to know about this other world.
---
--- *** DON'T TOUCH NOR USE THIS STUFF *** [_$_]
--- (unless you really know what you are doing!)
-
--- UNSAFELY create a mutable integer (EXPORTED)
---
-unsafeNewIntRef :: Int -> IORef Int
-unsafeNewIntRef i = unsafePerformIO (newIORef i)
-
--- UNSAFELY increment a mutable integer and yield its value before the
--- increment (EXPORTED)
---
-unsafeReadAndIncIntRef :: IORef Int -> Int
-unsafeReadAndIncIntRef mv = unsafePerformIO $ do
- v <- readIORef mv
- writeIORef mv (v + 1)
- return v
rmfile ./tools/c2hs/base/sysdep/SysDep.hs
hunk ./tools/c2hs/base/sysdep/SysDepPosix.hs 1
--- Compiler Toolkit: posix dependent stuff - EMPTY STUB
---
--- Author : Manuel M. T. Chakravarty
--- Created: 18 August 2000
---
--- Version $Revision: 1.1 $ from $Date: 2004/11/28 21:19:52 $
---
--- Copyright (c) 2000 Manuel M. T. Chakravarty
---
--- This file is free software; you can redistribute it and/or modify
--- it under the terms of the GNU General Public License as published by
--- the Free Software Foundation; either version 2 of the License, or
--- (at your option) any later version.
---
--- This file 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 General Public License for more details.
---
---- DESCRIPTION ---------------------------------------------------------------
---
--- This module provides stub routines for building on a system configuration
--- where the `posix' package from HSLibs is not available.
---
---- DOCU ----------------------------------------------------------------------
---
--- language: Haskell 98
---
--- * may only import `Config'
---
--- Provides the same symbols as `SysDepPosixAVAIL', but without an
--- implementation.
---
---- TODO ----------------------------------------------------------------------
---
-
-module SysDepPosix (
- ProcessID, -- re-exported
- runPiped
-) where
-
-import IO (Handle)
-
--- definition doesn't matter as it isn't used anyway
---
-type ProcessID = ()
-
-
--- Process management
--- ------------------
-
-runPiped :: FilePath -- command
- -> [String] -- arguments
- -> Maybe [(String, String)] -- environment
- -> Maybe FilePath -- working directory [_$_]
- -> IO (ProcessID,Handle,Handle) -- (child pid, fromChild, toChild)
-runPiped _ _ _ _ =
- error "SysDepPosix.runPiped: not supported on this system"
rmfile ./tools/c2hs/base/sysdep/SysDepPosix.hs
rmdir ./tools/c2hs/base/sysdep
hunk ./tools/c2hs/base/graphs/Makefile 1
-# Compiler Toolkit: makefile for the graph/dependency modules
-#
-# Author : Manuel M T Chakravarty
-# Created: 6 December 1999
-#
-# Version $Revision: 1.1.1.1 $ from $Date: 2004/11/13 16:42:49 $
-#
-# Copyright (c) [1999..2002] Manuel M T Chakravarty
-#
-# This file is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This file 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 General Public License for more details.
-#
-# = DOCU =====================================================================
-#
-
-# ***************************************
-# !!! This makefile requires GNU make !!!
-# ***************************************
-
-# info for this part: its package, name, sources and objects files (must be [_$_]
-# before the include due to conditionals etc in `common.mk')
-#
-PACKAGE = base
-PCKNAME = ctk
-PART = graphs
-SRCS = Marks.hs
-OBJS = $(patsubst %.hs,%.o,$(SRCS))
-
-include ../../mk/common.mk
-
-# make all object files
-#
-objs: $(OBJS)
-
-# make all
-#
-all: objs
-
-# State modules test
-#
-.PHONY: test
-test: marks
-
-MarksOBJS = ../syms/Attributes ../admin/Common.o ../admin/BaseVersion.o \
- ../state/CIO.o ../admin/Config.o \
- ../errors/Errors.o ../general/FiniteMaps.o Idents.o \
- ../state/State.o ../state/StateBase.o ../state/StateTrans.o \
- ../sysdep/SysDep.o NameSpaces.o \
- ../general/FileOps.o ../general/FNameOps.o ../general/UNames.o \
- ../general/Utils.o [_$_]
-ifeq ($(SYS),$(findstring $(SYS),nhc1)) # not very nice
- SymsOBJS += ../sysdep/IOExtsNHC1.o
-endif
-
-marks: $(MarksOBJS) tests/Main.hs
- mkdir -p $(TMP)
- $(HC) -o $(TMP)/$@ $(HCFLAGS) $(MarksOBJS) tests/Main.hs
- @echo "*** call $(TMP)/$@"
-
-# misc targets
-#
-.PHONY: clean cleanhi
-
-clean:
- -$(RM) *.o $(TMP)/marks
-cleanhi:
- -$(RM) *.hi
rmfile ./tools/c2hs/base/graphs/Makefile
hunk ./tools/c2hs/base/graphs/Marks.hs 1
--- Compiler Toolkit: efficient marking of attributed entities
---
--- Author : Manuel M. T. Chakravarty
--- Created: 6 December 1999
---
--- Version $Revision: 1.2 $ from $Date: 2004/11/13 17:26:50 $
---
--- Copyright (c) 1999 Manuel M. T. Chakravarty
---
--- This file is free software; you can redistribute it and/or modify
--- it under the terms of the GNU General Public License as published by
--- the Free Software Foundation; either version 2 of the License, or
--- (at your option) any later version.
---
--- This file 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 General Public License for more details.
---
---- DESCRIPTION ---------------------------------------------------------------
---
--- This modules provides an abstract interface to a marking facility for
--- attributed entities. Such a collection of marks can be regarded as a set, [_$_]
--- or as a marks as used when walking graphs.
---
--- This module is based on a suggestion from Roman Lechtchinsky.
---
---- DOCU ----------------------------------------------------------------------
---
--- language: Haskell 98
---
--- * Collections of marks are parametrised to constrain one collection to
--- marks for only one type of entities.
---
--- * Currently, a very simple implementation based on sets is used. The
--- interface can, however, be instantiated with a more efficient (eg,
--- hash-based) implementation if the need arises.
---
---- TODO ----------------------------------------------------------------------
---
-
-module Marks (Marks, newMarks, mark, isMarked) [_$_]
-where
-
-import Set (Set)
-import qualified Set as Set (empty, insert, member)
-import Attributes (Attrs, Attributed(..))
-
-
--- representation of a collection of marks (EXPORTED ABSTRACTLY)
---
-data Attributed a => Marks a = Marks (Set Attrs)
---newtype Attributed a => Marks a = Marks (Set Attrs)
--- should be newtype, but nhc98 chokes on it...
-
--- get a new collection of marks (EXPORTED)
---
-newMarks :: Attributed a => Marks a
-newMarks = Marks Set.empty
-
--- mark an entity in a specific collection of marks (EXPORTED)
---
-mark :: Attributed a => Marks a -> a -> Marks a
-mark (Marks ms) e = Marks $ Set.insert (attrsOf e) ms
-
--- test whether a given entity is marked in a given collection of marks
--- (EXPORTED) [_$_]
---
-isMarked :: Attributed a => Marks a -> a -> Bool
-isMarked (Marks ms) e = (attrsOf e) `Set.member` ms
rmfile ./tools/c2hs/base/graphs/Marks.hs
rmdir ./tools/c2hs/base/graphs
hunk ./Makefile.am 124
-tools_c2hs_c2hsLocal_SOURCESDIRS = \
- tools/c2hs/base/admin tools/c2hs/base/errors \
- tools/c2hs/base/general tools/c2hs/base/graphs \
- tools/c2hs/base/state tools/c2hs/base/syms \
- tools/c2hs/base/syntax tools/c2hs/base/sysdep tools/c2hs/c \
- tools/c2hs/chs tools/c2hs/gen tools/c2hs/state tools/c2hs/toplevel
+tools_c2hs_c2hsLocal_SOURCESDIRS = \
+ tools/c2hs/base/admin tools/c2hs/base/errors \
+ tools/c2hs/base/general tools/c2hs/base/state \
+ tools/c2hs/base/syms tools/c2hs/base/syntax \
+ tools/c2hs/c tools/c2hs/chs tools/c2hs/gen \
+ tools/c2hs/state tools/c2hs/toplevel
hunk ./Makefile.am 133
- tools/c2hs/base/admin/Common.hs \
hunk ./Makefile.am 138
- tools/c2hs/base/general/GetOpt.hs \
hunk ./Makefile.am 139
+ tools/c2hs/base/general/Position.hs \
hunk ./Makefile.am 142
- tools/c2hs/base/general/Utils.hs \
hunk ./Makefile.am 144
- tools/c2hs/base/graphs/Marks.hs \
hunk ./Makefile.am 145
- tools/c2hs/base/state/DynArrays.hs \
hunk ./Makefile.am 152
- tools/c2hs/base/syntax/ParserMonad.hs \
- tools/c2hs/base/syntax/Parsers.hs \
- tools/c2hs/base/syntax/Pretty.hs \
- tools/c2hs/base/sysdep/SysDep.hs \
- tools/c2hs/base/sysdep/SysDepPosix.hs \
hunk ./Makefile.am 159
+ tools/c2hs/c/CParserMonad.hs \
hunk ./Makefile.am 161
+ tools/c2hs/c/CTokens.hs \
hunk ./tools/c2hs/base/Makefile 1
-# Compiler Toolkit: root makefile [_$_]
-#
-# Author : Manuel M T Chakravarty
-# Created: 25 July 1998
-#
-# Version $Revision: 1.1.1.1 $ from $Date: 2004/11/13 16:42:42 $
-#
-# Copyright (c) [1998..2002] Manuel M T Chakravarty
-#
-# This file is free software; you can redistribute it and/or modify
-# it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
-# (at your option) any later version.
-#
-# This file 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 General Public License for more details.
-#
-# = DOCU =====================================================================
-#
-# Essentially, instantiates the generic definitions from `common.mk' and [_$_]
-# includes the Makefiles of all part...
[truncated message content] |
|
From: Duncan C. <dun...@wo...> - 2007-05-02 21:02:05
|
Wed May 2 04:35:10 PDT 2007 Duncan Coutts <du...@co...>
* Update c2hs C parser to latest upstream version
hunk ./tools/c2hs/c/CAST.hs 6
--- Version $Revision: 1.4 $ from $Date: 2005/07/27 16:28:30 $
+-- Version $Revision: 1.10 $ from $Date: 2004/06/11 07:10:16 $
hunk ./tools/c2hs/c/CAST.hs 43
-module CAST (CHeader(..), CExtDecl(..), CFunDef(..), CStat(..), CDecl(..),
- CDeclSpec(..), CStorageSpec(..), CTypeSpec(..), CTypeQual(..),
- CStructUnion(..), CStructTag(..), CEnum(..), CDeclr(..),
- CInit(..), CExpr(..), CAssignOp(..), CBinaryOp(..), CUnaryOp(..),
- CConst (..)) [_$_]
+module CAST (CHeader(..), CExtDecl(..), CFunDef(..), CStat(..), CBlockItem(..),
+ CDecl(..), CDeclSpec(..), CStorageSpec(..), CTypeSpec(..),
+ CTypeQual(..), CStructUnion(..), CStructTag(..), CEnum(..),
+ CDeclr(..), CInit(..), CInitList, CDesignator(..), CExpr(..),
+ CAssignOp(..), CBinaryOp(..), CUnaryOp(..), CConst (..))
hunk ./tools/c2hs/c/CAST.hs 115
+ | CCases CExpr -- case range
+ CExpr -- `case lower .. upper :'
+ CStat
+ Attrs
hunk ./tools/c2hs/c/CAST.hs 123
- | CCompound [CDecl] -- optional declaration list
- [CStat] -- optional statement list
+ | CCompound [CBlockItem] -- list of declarations and statements
hunk ./tools/c2hs/c/CAST.hs 136
- | CFor (Maybe CExpr)
+ | CFor (Either (Maybe CExpr)
+ CDecl)
hunk ./tools/c2hs/c/CAST.hs 144
+ | CGotoPtr CExpr -- computed address
+ Attrs
hunk ./tools/c2hs/c/CAST.hs 156
+ posOf (CCases _ _ _ at) = posOf at
hunk ./tools/c2hs/c/CAST.hs 159
- posOf (CCompound _ _ at) = posOf at
+ posOf (CCompound _ at) = posOf at
hunk ./tools/c2hs/c/CAST.hs 165
+ posOf (CGotoPtr _ at) = posOf at
hunk ./tools/c2hs/c/CAST.hs 174
+ (CCases _ _ _ at1) == (CCases _ _ _ at2) = at1 == at2
hunk ./tools/c2hs/c/CAST.hs 177
- (CCompound _ _ at1) == (CCompound _ _ at2) = at1 == at2
+ (CCompound _ at1) == (CCompound _ at2) = at1 == at2
hunk ./tools/c2hs/c/CAST.hs 183
+ (CGotoPtr _ at1) == (CGotoPtr _ at2) = at1 == at2
hunk ./tools/c2hs/c/CAST.hs 189
+-- C99 Block items, things that may appear in compound statements
+data CBlockItem = CBlockStmt CStat
+ | CBlockDecl CDecl
+ | CNestedFunDef CFunDef -- GNU C has nested functions
+
+instance Pos CBlockItem where
+ posOf (CBlockStmt stmt) = posOf stmt
+ posOf (CBlockDecl decl) = posOf decl
+ posOf (CNestedFunDef fdef) = posOf fdef
+
+instance Eq CBlockItem where
+ CBlockStmt stmt1 == CBlockStmt stmt2 = stmt1 == stmt2
+ CBlockDecl decl1 == CBlockDecl decl2 = decl1 == decl2
+ CNestedFunDef fdef1 == CNestedFunDef fdef2 = fdef1 == fdef2
+
+
hunk ./tools/c2hs/c/CAST.hs 278
+ | CThread Attrs -- GNUC thread local storage
hunk ./tools/c2hs/c/CAST.hs 286
+ posOf (CThread at) = posOf at
hunk ./tools/c2hs/c/CAST.hs 294
+ (CThread at1) == (CThread at2) = at1 == at2
hunk ./tools/c2hs/c/CAST.hs 307
+ | CBoolType Attrs
+ | CComplexType Attrs
hunk ./tools/c2hs/c/CAST.hs 315
- | CTypeofExpr CExpr
+ | CTypeOfExpr CExpr
hunk ./tools/c2hs/c/CAST.hs 317
- | CTypeofType CDecl -- type name
+ | CTypeOfType CDecl
hunk ./tools/c2hs/c/CAST.hs 330
+ posOf (CBoolType at) = posOf at
+ posOf (CComplexType at) = posOf at
hunk ./tools/c2hs/c/CAST.hs 335
- posOf (CTypeofExpr _ at) = posOf at
- posOf (CTypeofType _ at) = posOf at
+ posOf (CTypeOfExpr _ at) = posOf at
+ posOf (CTypeOfType _ at) = posOf at
hunk ./tools/c2hs/c/CAST.hs 348
+ (CBoolType at1) == (CBoolType at2) = at1 == at2
+ (CComplexType at1) == (CComplexType at2) = at1 == at2
hunk ./tools/c2hs/c/CAST.hs 353
- (CTypeofExpr _ at1) == (CTypeofExpr _ at2) = at1 == at2
- (CTypeofType _ at1) == (CTypeofType _ at2) = at1 == at2
+ (CTypeOfExpr _ at1) == (CTypeOfExpr _ at2) = at1 == at2
+ (CTypeOfType _ at1) == (CTypeOfType _ at2) = at1 == at2
hunk ./tools/c2hs/c/CAST.hs 440
- | CPtrDeclr [[CTypeQual]] -- indirections (non-empty)
+ | CPtrDeclr [CTypeQual] -- indirections
hunk ./tools/c2hs/c/CAST.hs 444
+ [CTypeQual]
hunk ./tools/c2hs/c/CAST.hs 455
- posOf (CArrDeclr _ _ at) = posOf at
+ posOf (CArrDeclr _ _ _ at) = posOf at
hunk ./tools/c2hs/c/CAST.hs 461
- (CArrDeclr _ _ at1) == (CArrDeclr _ _ at2) = at1 == at2
+ (CArrDeclr _ _ _ at1) == (CArrDeclr _ _ _ at2) = at1 == at2
hunk ./tools/c2hs/c/CAST.hs 468
- | CInitList [CInit]
+ | CInitList CInitList
hunk ./tools/c2hs/c/CAST.hs 471
+type CInitList = [([CDesignator], CInit)]
+
hunk ./tools/c2hs/c/CAST.hs 481
+-- C initializer designator (EXPORTED)
+--
+data CDesignator = CArrDesig CExpr
+ Attrs
+ | CMemberDesig Ident
+ Attrs
+ | CRangeDesig CExpr -- GNUC array range designator
+ CExpr
+ Attrs
+
+instance Pos CDesignator where
+ posOf (CArrDesig _ at) = posOf at
+ posOf (CMemberDesig _ at) = posOf at
+ posOf (CRangeDesig _ _ at) = posOf at
+
+instance Eq CDesignator where
+ (CArrDesig _ at1) == (CArrDesig _ at2) = at1 == at2
+ (CMemberDesig _ at1) == (CMemberDesig _ at2) = at1 == at2
+ (CRangeDesig _ _ at1) == (CRangeDesig _ _ at2) = at1 == at2
+
hunk ./tools/c2hs/c/CAST.hs 515
- CExpr -- true-expression
+ (Maybe CExpr) -- true-expression (GNU allows omitting)
hunk ./tools/c2hs/c/CAST.hs 550
+ | CCompoundLit CDecl -- C99 compound literal
+ CInitList -- type name & initialiser list
+ Attrs
+ | CStatExpr CStat -- GNUC compound statement as expr
+ Attrs
+ | CLabAddrExpr Ident -- GNUC address of label
+ Attrs
+ | CBuiltinExpr Attrs -- place holder for GNUC builtin exprs
hunk ./tools/c2hs/c/CAST.hs 575
+ posOf (CCompoundLit _ _ at) = posOf at
+ posOf (CStatExpr _ at) = posOf at
+ posOf (CLabAddrExpr _ at) = posOf at
+ posOf (CBuiltinExpr at) = posOf at
hunk ./tools/c2hs/c/CAST.hs 596
+ (CCompoundLit _ _ at1) == (CCompoundLit _ _ at2) = at1 == at2
+ (CStatExpr _ at1) == (CStatExpr _ at2) = at1 == at2
+ (CLabAddrExpr _ at1) == (CLabAddrExpr _ at2) = at1 == at2
+ (CBuiltinExpr at1) == (CBuiltinExpr at2) = at1 == at2
hunk ./tools/c2hs/c/CAST.hs 912
+instance Binary CDesignator where
+ put_ bh (CArrDesig aa ab) = do
+ putByte bh 0
+ put_ bh aa
+ put_ bh ab
+ put_ bh (CMemberDesig ac ad) = do
+ putByte bh 1
+ put_ bh ac
+ put_ bh ad
+ put_ bh (CRangeDesig ae af ag) = do
+ putByte bh 2
+ put_ bh ae
+ put_ bh af
+ put_ bh ag
+ get bh = do
+ h <- getByte bh
+ case h of
+ 0 -> do
+ aa <- get bh
+ ab <- get bh
+ return (CArrDesig aa ab)
+ 1 -> do
+ ac <- get bh
+ ad <- get bh
+ return (CMemberDesig ac ad)
+ 2 -> do
+ ae <- get bh
+ af <- get bh
+ ag <- get bh
+ return (CRangeDesig ae af ag)
+
hunk ./tools/c2hs/c/CAST.hs 953
- put_ bh (CArrDeclr af ag ah) = do
+ put_ bh (CArrDeclr af ag ah ai) = do
hunk ./tools/c2hs/c/CAST.hs 958
+ put_ bh ai
hunk ./tools/c2hs/c/CAST.hs 981
- return (CArrDeclr af ag ah)
+ ai <- get bh
+ return (CArrDeclr af ag ah ai)
hunk ./tools/c2hs/c/CAST.hs 1053
- put_ bh (CTypeofExpr ap aq) = do
+ put_ bh (CTypeOfExpr ap aq) = do
hunk ./tools/c2hs/c/CAST.hs 1057
- put_ bh (CTypeofType ar as) = do
+ put_ bh (CTypeOfType ar as) = do
hunk ./tools/c2hs/c/CAST.hs 1106
- return (CTypeofExpr ap aq)
+ return (CTypeOfExpr ap aq)
hunk ./tools/c2hs/c/CAST.hs 1110
- return (CTypeofType ar as)
+ return (CTypeOfType ar as)
hunk ./tools/c2hs/c/CLexer.x 6
--- Version $Revision: 1.4 $ from $Date: 2005/07/27 16:28:31 $
+-- Version $Revision: 1.1.2.1 $ from $Date: 2005/06/14 00:16:14 $
hunk ./tools/c2hs/c/CLexer.x 67
-module CLexer (CToken(..), GnuCTok(..), lexC,
- P, execParser, parseError, getNewName, addTypedef) where [_$_]
+module CLexer (lexC, parseError) where
hunk ./tools/c2hs/c/CLexer.x 72
-import Common (Position(Position), Pos(posOf))
+import Common (Position(..), Pos(posOf))
hunk ./tools/c2hs/c/CLexer.x 77
-import Set (Set)
-import qualified Set as Set (fromList, insert, member)
+import CTokens
+import CParserMonad
hunk ./tools/c2hs/c/CLexer.x 91
-$inchar = \0-\255 # [ \\ \' \n \f \r \v ]
-$instr = \0-\255 # [ \\ \" \n \f \r \v ]
+$inchar = \0-\255 # [ \\ \' \n \r ]
+$instr = \0-\255 # [ \\ \" \n \r ]
hunk ./tools/c2hs/c/CLexer.x 104
-@charesc = \\([ntvbrfa\\\?\'\"]|$octdigit{1,3}|x$hexdigit+)
+@charesc = \\([ntvbrfae\\\?\'\"]|$octdigit{1,3}|x$hexdigit+)
hunk ./tools/c2hs/c/CLexer.x 112
-@exppart = [eE]\-?@digits
+@exppart = [eE][\+\-]?@digits
hunk ./tools/c2hs/c/CLexer.x 161
-0$octdigit*[uUlL]{0,2} { token CTokILit (fst . head . readOct) }
-$digitNZ$digit*[uUlL]{0,2} { token CTokILit (fst . head . readDec) }
-0[xX]$hexdigit*[uUlL]{0,2} { token CTokILit (fst . head . readHex . drop 2) }
+0$octdigit*[uUlL]{0,3} { token CTokILit (fst . head . readOct) }
+$digitNZ$digit*[uUlL]{0,3} { token CTokILit (fst . head . readDec) }
+0[xX]$hexdigit*[uUlL]{0,3} { token CTokILit (fst . head . readHex . drop 2) }
hunk ./tools/c2hs/c/CLexer.x 167
-\'($inchar|@charesc)\' { token CTokCLit (fst . oneChar . tail) }
+\'($inchar|@charesc)\' { token CTokCLit (fst . oneChar . tail) }
+L\'($inchar|@charesc)\' { token CTokCLit (fst . oneChar . tail . tail) }
hunk ./tools/c2hs/c/CLexer.x 177
+L\"($instr|@charesc)*\" { token CTokSLit (normalizeEscapes . tail) }
hunk ./tools/c2hs/c/CLexer.x 232
--- token definition
--- ----------------
-
--- possible tokens (EXPORTED)
---
-data CToken = CTokLParen Position -- `('
- | CTokRParen Position -- `)'
- | CTokLBracket Position -- `['
- | CTokRBracket Position -- `]'
- | CTokArrow Position -- `->'
- | CTokDot Position -- `.'
- | CTokExclam Position -- `!'
- | CTokTilde Position -- `~'
- | CTokInc Position -- `++'
- | CTokDec Position -- `--'
- | CTokPlus Position -- `+'
- | CTokMinus Position -- `-'
- | CTokStar Position -- `*'
- | CTokSlash Position -- `/'
- | CTokPercent Position -- `%'
- | CTokAmper Position -- `&'
- | CTokShiftL Position -- `<<'
- | CTokShiftR Position -- `>>'
- | CTokLess Position -- `<'
- | CTokLessEq Position -- `<='
- | CTokHigh Position -- `>'
- | CTokHighEq Position -- `>='
- | CTokEqual Position -- `=='
- | CTokUnequal Position -- `!='
- | CTokHat Position -- `^'
- | CTokBar Position -- `|'
- | CTokAnd Position -- `&&'
- | CTokOr Position -- `||'
- | CTokQuest Position -- `?'
- | CTokColon Position -- `:'
- | CTokAssign Position -- `='
- | CTokPlusAss Position -- `+='
- | CTokMinusAss Position -- `-='
- | CTokStarAss Position -- `*='
- | CTokSlashAss Position -- `/='
- | CTokPercAss Position -- `%='
- | CTokAmpAss Position -- `&='
- | CTokHatAss Position -- `^='
- | CTokBarAss Position -- `|='
- | CTokSLAss Position -- `<<='
- | CTokSRAss Position -- `>>='
- | CTokComma Position -- `,'
- | CTokSemic Position -- `;'
- | CTokLBrace Position -- `{'
- | CTokRBrace Position --
- | CTokEllipsis Position -- `...'
- | CTokAlignof Position -- `alignof' [_$_]
- -- (or `__alignof', [_$_]
- -- `__alignof__')
- | CTokAsm Position -- `asm'
- -- (or `__asm',
- -- `__asm__')
- | CTokAuto Position -- `auto'
- | CTokBreak Position -- `break'
- | CTokCase Position -- `case'
- | CTokChar Position -- `char'
- | CTokConst Position -- `const' [_$_]
- -- (or `__const', `__const__')
- | CTokContinue Position -- `continue' [_$_]
- | CTokDefault Position -- `default'
- | CTokDo Position -- `do'
- | CTokDouble Position -- `double'
- | CTokElse Position -- `else'
- | CTokEnum Position -- `enum'
- | CTokExtern Position -- `extern'
- | CTokFloat Position -- `float'
- | CTokFor Position -- `for'
- | CTokGoto Position -- `goto'
- | CTokIf Position -- `if'
- | CTokInline Position -- `inline'
- -- (or `__inline', [_$_]
- -- `__inline__')
- | CTokInt Position -- `int'
- | CTokLong Position -- `long'
- | CTokRegister Position -- `register'
- | CTokRestrict Position -- `restrict'
- -- (or `__restrict', [_$_]
- -- `__restrict__')
- | CTokReturn Position -- `return'
- | CTokShort Position -- `short'
- | CTokSigned Position -- `signed'
- -- (or `__signed', [_$_]
- -- `__signed__')
- | CTokSizeof Position -- `sizeof'
- | CTokStatic Position -- `static'
- | CTokStruct Position -- `struct'
- | CTokSwitch Position -- `switch'
- | CTokTypedef Position -- `typedef'
- | CTokUnion Position -- `union'
- | CTokUnsigned Position -- `unsigned'
- | CTokVoid Position -- `void'
- | CTokTypeof Position -- `typeof'
- -- (or `__typeof',
- -- `__typeof__')
- | CTokVolatile Position -- `volatile'
- -- (or `__volatile', [_$_]
- -- `__volatile__')
- | CTokWhile Position -- `while'
- | CTokCLit Position Char -- character constant
- | CTokILit Position Integer -- integer constant
- | CTokFLit Position String -- float constant
- | CTokSLit Position String -- string constant (no escapes)
- | CTokIdent Position Ident -- identifier
-
- -- not generated here, but in `CParser.parseCHeader'
- | CTokTyIdent Position Ident -- `typedef-name' identifier
- | CTokGnuC GnuCTok Position -- special GNU C tokens
- | CTokEof -- end of file
-
--- special tokens used in GNU C extensions to ANSI C
---
-data GnuCTok = GnuCAttrTok -- `__attribute__'
- | GnuCExtTok -- `__extension__'
-
-instance Pos CToken where
- posOf (CTokLParen pos ) = pos
- posOf (CTokRParen pos ) = pos
- posOf (CTokLBracket pos ) = pos
- posOf (CTokRBracket pos ) = pos
- posOf (CTokArrow pos ) = pos
- posOf (CTokDot pos ) = pos
- posOf (CTokExclam pos ) = pos
- posOf (CTokTilde pos ) = pos
- posOf (CTokInc pos ) = pos
- posOf (CTokDec pos ) = pos
- posOf (CTokPlus pos ) = pos
- posOf (CTokMinus pos ) = pos
- posOf (CTokStar pos ) = pos
- posOf (CTokSlash pos ) = pos
- posOf (CTokPercent pos ) = pos
- posOf (CTokAmper pos ) = pos
- posOf (CTokShiftL pos ) = pos
- posOf (CTokShiftR pos ) = pos
- posOf (CTokLess pos ) = pos
- posOf (CTokLessEq pos ) = pos
- posOf (CTokHigh pos ) = pos
- posOf (CTokHighEq pos ) = pos
- posOf (CTokEqual pos ) = pos
- posOf (CTokUnequal pos ) = pos
- posOf (CTokHat pos ) = pos
- posOf (CTokBar pos ) = pos
- posOf (CTokAnd pos ) = pos
- posOf (CTokOr pos ) = pos
- posOf (CTokQuest pos ) = pos
- posOf (CTokColon pos ) = pos
- posOf (CTokAssign pos ) = pos
- posOf (CTokPlusAss pos ) = pos
- posOf (CTokMinusAss pos ) = pos
- posOf (CTokStarAss pos ) = pos
- posOf (CTokSlashAss pos ) = pos
- posOf (CTokPercAss pos ) = pos
- posOf (CTokAmpAss pos ) = pos
- posOf (CTokHatAss pos ) = pos
- posOf (CTokBarAss pos ) = pos
- posOf (CTokSLAss pos ) = pos
- posOf (CTokSRAss pos ) = pos
- posOf (CTokComma pos ) = pos
- posOf (CTokSemic pos ) = pos
- posOf (CTokLBrace pos ) = pos
- posOf (CTokRBrace pos ) = pos
- posOf (CTokEllipsis pos ) = pos
- posOf (CTokAlignof pos ) = pos
- posOf (CTokAsm pos ) = pos
- posOf (CTokAuto pos ) = pos
- posOf (CTokBreak pos ) = pos
- posOf (CTokCase pos ) = pos
- posOf (CTokChar pos ) = pos
- posOf (CTokConst pos ) = pos
- posOf (CTokContinue pos ) = pos
- posOf (CTokDefault pos ) = pos
- posOf (CTokDo pos ) = pos
- posOf (CTokDouble pos ) = pos
- posOf (CTokElse pos ) = pos
- posOf (CTokEnum pos ) = pos
- posOf (CTokExtern pos ) = pos
- posOf (CTokFloat pos ) = pos
- posOf (CTokFor pos ) = pos
- posOf (CTokGoto pos ) = pos
- posOf (CTokInt pos ) = pos
- posOf (CTokInline pos ) = pos
- posOf (CTokIf pos ) = pos
- posOf (CTokLong pos ) = pos
- posOf (CTokRegister pos ) = pos
- posOf (CTokRestrict pos ) = pos
- posOf (CTokReturn pos ) = pos
- posOf (CTokShort pos ) = pos
- posOf (CTokSigned pos ) = pos
- posOf (CTokSizeof pos ) = pos
- posOf (CTokStatic pos ) = pos
- posOf (CTokStruct pos ) = pos
- posOf (CTokSwitch pos ) = pos
- posOf (CTokTypedef pos ) = pos
- posOf (CTokUnion pos ) = pos
- posOf (CTokUnsigned pos ) = pos
- posOf (CTokVoid pos ) = pos
- posOf (CTokTypeof pos ) = pos
- posOf (CTokVolatile pos ) = pos
- posOf (CTokWhile pos ) = pos
- posOf (CTokCLit pos _) = pos
- posOf (CTokILit pos _) = pos
- posOf (CTokFLit pos _) = pos
- posOf (CTokSLit pos _) = pos
- posOf (CTokIdent pos _) = pos
- posOf (CTokTyIdent pos _) = pos
- posOf (CTokGnuC _ pos ) = pos
-
-instance Show CToken where
- showsPrec _ (CTokLParen _ ) = showString "("
- showsPrec _ (CTokRParen _ ) = showString ")"
- showsPrec _ (CTokLBracket _ ) = showString "["
- showsPrec _ (CTokRBracket _ ) = showString "]"
- showsPrec _ (CTokArrow _ ) = showString "->"
- showsPrec _ (CTokDot _ ) = showString "."
- showsPrec _ (CTokExclam _ ) = showString "!"
- showsPrec _ (CTokTilde _ ) = showString "~"
- showsPrec _ (CTokInc _ ) = showString "++"
- showsPrec _ (CTokDec _ ) = showString "--"
- showsPrec _ (CTokPlus _ ) = showString "+"
- showsPrec _ (CTokMinus _ ) = showString "-"
- showsPrec _ (CTokStar _ ) = showString "*"
- showsPrec _ (CTokSlash _ ) = showString "/"
- showsPrec _ (CTokPercent _ ) = showString "%"
- showsPrec _ (CTokAmper _ ) = showString "&"
- showsPrec _ (CTokShiftL _ ) = showString "<<"
- showsPrec _ (CTokShiftR _ ) = showString ">>"
- showsPrec _ (CTokLess _ ) = showString "<"
- showsPrec _ (CTokLessEq _ ) = showString "<="
- showsPrec _ (CTokHigh _ ) = showString ">"
- showsPrec _ (CTokHighEq _ ) = showString ">="
- showsPrec _ (CTokEqual _ ) = showString "=="
- showsPrec _ (CTokUnequal _ ) = showString "!="
- showsPrec _ (CTokHat _ ) = showString "^"
- showsPrec _ (CTokBar _ ) = showString "|"
- showsPrec _ (CTokAnd _ ) = showString "&&"
- showsPrec _ (CTokOr _ ) = showString "||"
- showsPrec _ (CTokQuest _ ) = showString "?"
- showsPrec _ (CTokColon _ ) = showString ":"
- showsPrec _ (CTokAssign _ ) = showString "="
- showsPrec _ (CTokPlusAss _ ) = showString "+="
- showsPrec _ (CTokMinusAss _ ) = showString "-="
- showsPrec _ (CTokStarAss _ ) = showString "*="
- showsPrec _ (CTokSlashAss _ ) = showString "/="
- showsPrec _ (CTokPercAss _ ) = showString "%="
- showsPrec _ (CTokAmpAss _ ) = showString "&="
- showsPrec _ (CTokHatAss _ ) = showString "^="
- showsPrec _ (CTokBarAss _ ) = showString "|="
- showsPrec _ (CTokSLAss _ ) = showString "<<="
- showsPrec _ (CTokSRAss _ ) = showString ">>="
- showsPrec _ (CTokComma _ ) = showString ","
- showsPrec _ (CTokSemic _ ) = showString ";"
- showsPrec _ (CTokLBrace _ ) = showString "{"
- showsPrec _ (CTokRBrace _ ) = showString "}"
- showsPrec _ (CTokEllipsis _ ) = showString "..."
- showsPrec _ (CTokAlignof _ ) = showString "alignof"
- showsPrec _ (CTokAsm _ ) = showString "asm"
- showsPrec _ (CTokAuto _ ) = showString "auto"
- showsPrec _ (CTokBreak _ ) = showString "break"
- showsPrec _ (CTokCase _ ) = showString "case"
- showsPrec _ (CTokChar _ ) = showString "char"
- showsPrec _ (CTokConst _ ) = showString "const"
- showsPrec _ (CTokContinue _ ) = showString "continue"
- showsPrec _ (CTokDefault _ ) = showString "default"
- showsPrec _ (CTokDouble _ ) = showString "double"
- showsPrec _ (CTokDo _ ) = showString "do"
- showsPrec _ (CTokElse _ ) = showString "else"
- showsPrec _ (CTokEnum _ ) = showString "enum"
- showsPrec _ (CTokExtern _ ) = showString "extern"
- showsPrec _ (CTokFloat _ ) = showString "float"
- showsPrec _ (CTokFor _ ) = showString "for"
- showsPrec _ (CTokGoto _ ) = showString "goto"
- showsPrec _ (CTokIf _ ) = showString "if"
- showsPrec _ (CTokInline _ ) = showString "inline"
- showsPrec _ (CTokInt _ ) = showString "int"
- showsPrec _ (CTokLong _ ) = showString "long"
- showsPrec _ (CTokRegister _ ) = showString "register"
- showsPrec _ (CTokRestrict _ ) = showString "restrict"
- showsPrec _ (CTokReturn _ ) = showString "return"
- showsPrec _ (CTokShort _ ) = showString "short"
- showsPrec _ (CTokSigned _ ) = showString "signed"
- showsPrec _ (CTokSizeof _ ) = showString "sizeof"
- showsPrec _ (CTokStatic _ ) = showString "static"
- showsPrec _ (CTokStruct _ ) = showString "struct"
- showsPrec _ (CTokSwitch _ ) = showString "switch"
- showsPrec _ (CTokTypedef _ ) = showString "typedef"
- showsPrec _ (CTokUnion _ ) = showString "union"
- showsPrec _ (CTokUnsigned _ ) = showString "unsigned"
- showsPrec _ (CTokVoid _ ) = showString "void"
- showsPrec _ (CTokTypeof _ ) = showString "typeof"
- showsPrec _ (CTokVolatile _ ) = showString "volatile"
- showsPrec _ (CTokWhile _ ) = showString "while"
- showsPrec _ (CTokCLit _ c) = showChar c
- showsPrec _ (CTokILit _ i) = (showString . show) i
- showsPrec _ (CTokFLit _ s) = showString s
- showsPrec _ (CTokSLit _ s) = showString s
- showsPrec _ (CTokIdent _ i) = (showString . identToLexeme) i
- showsPrec _ (CTokTyIdent _ i) = (showString . identToLexeme) i
- showsPrec _ (CTokGnuC GnuCAttrTok _) = showString "__attribute__"
- showsPrec _ (CTokGnuC GnuCExtTok _) = showString "__extension__"
-
hunk ./tools/c2hs/c/CLexer.x 247
+idkwtok ('_':'B':'o':'o':'l':[]) = tok CTokBool
hunk ./tools/c2hs/c/CLexer.x 254
+idkwtok ('_':'C':'o':'m':'p':'l':'e':'x':[]) = tok CTokComplex
hunk ./tools/c2hs/c/CLexer.x 284
-idkwtok ('u':'n':'i':'o':'n':[]) = tok CTokUnion
-idkwtok ('u':'n':'s':'i':'g':'n':'e':'d':[]) = tok CTokUnsigned
-idkwtok ('v':'o':'i':'d':[]) = tok CTokVoid
hunk ./tools/c2hs/c/CLexer.x 287
+idkwtok ('_':'_':'t':'h':'r':'e':'a':'d':[]) = tok CTokThread
+idkwtok ('u':'n':'i':'o':'n':[]) = tok CTokUnion
+idkwtok ('u':'n':'s':'i':'g':'n':'e':'d':[]) = tok CTokUnsigned
+idkwtok ('v':'o':'i':'d':[]) = tok CTokVoid
hunk ./tools/c2hs/c/CLexer.x 295
-idkwtok ('_':'_':'a':'t':'t':'r':'i':'b':'u':'t':'e':'_':'_':[]) =
- tok (CTokGnuC GnuCAttrTok)
+idkwtok ('_':'_':'l':'a':'b':'e':'l':'_':'_':[]) = tok CTokLabel
+idkwtok ('_':'_':'a':'t':'t':'r':'i':'b':'u':'t':'e':[]) = tok (CTokGnuC GnuCAttrTok)
+-- ignoreAttribute >> lexToken
+idkwtok ('_':'_':'a':'t':'t':'r':'i':'b':'u':'t':'e':'_':'_':[]) = tok (CTokGnuC GnuCAttrTok)
+-- ignoreAttribute >> lexToken
hunk ./tools/c2hs/c/CLexer.x 302
+idkwtok ('_':'_':'b':'u':'i':'l':'t':'i':'n':'_':rest)
+ | rest == "va_arg" = tok (CTokGnuC GnuCVaArg)
+ | rest == "offsetof" = tok (CTokGnuC GnuCOffsetof)
+ | rest == "types_compatible_p" = tok (CTokGnuC GnuCTyCompat)
+
hunk ./tools/c2hs/c/CLexer.x 309
- tdefs <- getTypedefs
hunk ./tools/c2hs/c/CLexer.x 310
- if ident `Set.member` tdefs
+ tyident <- isTypeIdent ident
+ if tyident
hunk ./tools/c2hs/c/CLexer.x 315
+ignoreAttribute :: P ()
+ignoreAttribute = skipTokens 0
+ where skipTokens n = do
+ tok <- lexToken
+ case tok of
+ CTokRParen _ | n == 1 -> return ()
+ | otherwise -> skipTokens (n-1)
+ CTokLParen _ -> skipTokens (n+1)
+ _ -> skipTokens n
+
hunk ./tools/c2hs/c/CLexer.x 340
+ 'e' -> ('\ESC', cs) --GNU C extension
hunk ./tools/c2hs/c/CLexer.x 356
-adjustPos str (Position fname row _) = (Position fname' row' 0)
+adjustPos str (Position fname row _) = Position fname' row' 0
hunk ./tools/c2hs/c/CLexer.x 397
-alexMove (Position f l c) '\t' = Position f l (((c+7) `div` 8)*8+1)
-alexMove (Position f l c) '\n' = Position f (l+1) 1
-alexMove (Position f l c) _ = Position f l (c+1)
-
-
--- -----------------------------------------------------------------------------
--- The lexer & parser monad
-
-data ParseResult a
- = POk !PState a
- | PFailed [String] Position -- The error message and position
-
-data PState = PState { [_$_]
- alex_pos :: !Position, -- position at current input location
- alex_inp :: String, -- the current input
- alex_last :: CToken, -- the previous token
- alex_names :: [Name], -- the name unique supply
- alex_tdefs :: Set Ident -- the set of typedef'ed identifiers
- }
-
-newtype P a = P { unP :: PState -> ParseResult a }
-
-instance Monad P where
- return = returnP
- (>>=) = thenP
- fail m = getPos >>= \pos -> failP pos [m]
-
-execParser :: P a -> String -> Position -> [Ident] -> [Name]
- -> Either a ([String], Position)
-execParser (P parser) input pos builtins names =
- case parser initialState of
- POk _ result -> Left result
- PFailed message pos -> Right (message, pos)
- where initialState = PState {
- alex_pos = pos,
- alex_inp = input,
- alex_last = interr "CLexer.execParser: Touched undefined token!",
- alex_names = names,
- alex_tdefs = Set.fromList builtins
- }
-
-{-# INLINE returnP #-}
-returnP :: a -> P a
-returnP a = P $ \s -> POk s a
-
-{-# INLINE thenP #-}
-thenP :: P a -> (a -> P b) -> P b
-(P m) `thenP` k = P $ \s ->
- case m s of
- POk s' a -> (unP (k a)) s'
- PFailed err pos -> PFailed err pos
-
-failP :: Position -> [String] -> P a
-failP pos msg = P $ \_ -> PFailed msg pos
+alexMove (Position f l c) '\t' = Position f l (((c+7) `div` 8)*8+1)
+alexMove (Position f l c) '\n' = Position f (l+1) 1
+alexMove (Position f l c) _ = Position f l (c+1)
hunk ./tools/c2hs/c/CLexer.x 403
- (pos, (c:cs)) <- getInput
+ pos <- getPos
+ (c:cs) <- getInput
hunk ./tools/c2hs/c/CLexer.x 416
-getNewName :: P Name
-getNewName = P $ \s@PState{alex_names=(n:ns)} -> POk s{alex_names=ns} n
-
-setPos :: Position -> P ()
-setPos pos = P $ \s -> POk s{alex_pos=pos} ()
-
-getPos :: P Position
-getPos = P $ \s@PState{alex_pos=pos} -> POk s pos
-
-getTypedefs :: P (Set Ident)
-getTypedefs = P $ \s@PState{alex_tdefs=tdefs} -> POk s tdefs
-
-addTypedef :: Ident -> P ()
-addTypedef ident = (P $ \s@PState{alex_tdefs=tdefs} ->
- POk s{alex_tdefs = Set.insert ident tdefs} ())
-
-getInput :: P AlexInput
-getInput = P $ \s@PState{alex_pos=p, alex_inp=i} -> POk s (p,i)
-
-setInput :: AlexInput -> P ()
-setInput (p,i) = P $ \s -> POk s{alex_pos=p, alex_inp=i} ()
-
-getLastToken :: P CToken
-getLastToken = P $ \s@PState{alex_last=tok} -> POk s tok
-
-setLastToken :: CToken -> P ()
-setLastToken tok = P $ \s -> POk s{alex_last=tok} ()
-
hunk ./tools/c2hs/c/CLexer.x 418
- inp@(pos, str) <- getInput
- case alexScan inp 0 of
+ pos <- getPos
+ inp <- getInput
+ case alexScan (pos, inp) 0 of
hunk ./tools/c2hs/c/CLexer.x 423
- AlexSkip inp' len -> do
- setInput inp'
+ AlexSkip (pos', inp') len -> do
+ setPos pos'
+ setInput inp'
hunk ./tools/c2hs/c/CLexer.x 427
- AlexToken inp' len action -> do
- setInput inp'
- tok <- action pos len str
- setLastToken tok
- return tok
+ AlexToken (pos', inp') len action -> do
+ setPos pos'
+ setInput inp'
+ tok <- action pos len inp
+ setLastToken tok
+ return tok
hunk ./tools/c2hs/c/CNames.hs 147
-naCDeclr obj (CArrDeclr declr oexpr _ ) =
+naCDeclr obj (CArrDeclr declr _ oexpr _ ) =
hunk ./tools/c2hs/c/CNames.hs 160
-naCInit (CInitList inits _) = mapM_ naCInit inits
+naCInit (CInitList inits _) = mapM_ (naCInit . snd) inits
hunk ./tools/c2hs/c/CNames.hs 165
-naCExpr (CCond expr1 expr2 expr3 _) = naCExpr expr1 >> naCExpr expr2
+naCExpr (CCond expr1 expr2 expr3 _) = naCExpr expr1 >> mapMaybeM_ naCExpr expr2
hunk ./tools/c2hs/c/CNames.hs 181
+naCExpr (CCompoundLit _ inits _) = mapM_ (naCInit . snd) inits
hunk ./tools/c2hs/c/CParser.y 3
--- Author : Manuel M T Chakravarty, Duncan Coutts
+-- Author : Duncan Coutts, Manuel M T Chakravarty
hunk ./tools/c2hs/c/CParser.y 6
--- Version $Revision: 1.4 $ from $Date: 2005/07/27 16:28:47 $
---
+-- Copyright (c) 2005-2007 Duncan Coutts
hunk ./tools/c2hs/c/CParser.y 8
--- Copyright (c) 2005 Duncan Coutts
+-- Portions Copyright (c) 1989, 1990 James A. Roskind
hunk ./tools/c2hs/c/CParser.y 22
--- Parser for C header files, which have already been run through the C
+-- Parser for C translation units, which have already been run through the C
hunk ./tools/c2hs/c/CParser.y 29
--- The parser recognizes all of ANCI C. The parser combinators follow K&R
--- Appendix A, but we make use of the richer grammar constructs provided by
--- `Parsers'. It supports the C99 `restrict' extension and `inline'. The
--- parser is rather permissive with respect to the formation of declarators
--- in function definitions (it doesn't enforce strict function syntax).
--- Non-complying definitions need to be detected by subsequent passes if
--- strict checking is required.
+-- The parser recognizes all of ISO C 99 and most common GNU C extensions.
hunk ./tools/c2hs/c/CParser.y 31
--- Comments:
+-- With C99 we refer to the ISO C99 standard, specifically the section numbers
+-- used below refer to this report:
hunk ./tools/c2hs/c/CParser.y 34
--- * Subtrees representing empty declarators of the form `CVarDeclr Nothing
--- at' have *no* valid attribute handle in `at' (only a `newAttrsOnlyPos
--- nopos').
+-- http://www.open-std.org/jtc1/sc22/wg14/www/docs/n1124.pdf
+--
+--
+-- Since some of the grammar productions are quite difficult to read
+-- (especially those involved with the decleration syntax) we document them
+-- with an extended syntax that allows a more consise representation:
+--
+-- Ordinary rules
+--
+-- foo named terminal or non-terminal
+--
+-- 'c' terminal, literal character token
+--
+-- A B concatenation
hunk ./tools/c2hs/c/CParser.y 49
--- * Details on the C99 restrict extension are at:
--- <http://www.lysator.liu.se/c/restrict.html>.
+-- A | B alternation
hunk ./tools/c2hs/c/CParser.y 51
--- With K&R we refer to ``The C Programming Language'', second edition, Brain
--- W. Kernighan and Dennis M. Ritchie, Prentice Hall, 1988.
+-- (A) grouping
hunk ./tools/c2hs/c/CParser.y 53
--- Supported GNU C extensions:
+-- Extended rules
hunk ./tools/c2hs/c/CParser.y 55
--- * We also recognize GNU C `__attribute__' annotations (however, they are
--- not entered into the structure tree, but ignored). More specifically, [_$_]
+-- A? optional, short hand for (A|) or [A]{ 0==A || 1==A }
hunk ./tools/c2hs/c/CParser.y 57
--- '__attribute__' '(' '(' attr ')' ')'
+-- ... stands for some part of the grammar omitted for clarity
hunk ./tools/c2hs/c/CParser.y 59
--- may occur after declarator specifiers or after a declarator itself (only
--- meaningful if it is a typedef), where `attr' is either just an [_$_]
--- identifier or an identifier followed by a comma-separated list of
--- constant expressions as follows:
+-- [A] represents sequences, 0 or more.
hunk ./tools/c2hs/c/CParser.y 61
--- attr -> id ['(' const_1 ',' ... ',' const_n ')']
--- | 'const'
--- const -> <constant expression>
+-- [A]{C} sequences with some constraint, usually on the number of
+-- terminals or non-terminals appearing in the sequence.
hunk ./tools/c2hs/c/CParser.y 64
--- * We also recognize GNU C `__extension__' annotations (however, they are
--- not entered into the structure tree, but ignored). More specifically, [_$_]
+-- Constraints on sequences
hunk ./tools/c2hs/c/CParser.y 66
--- __extension__
+-- n==t terminal or non-terminal t must appear exactly n times
hunk ./tools/c2hs/c/CParser.y 68
--- may occur in a specifier list.
+-- n>=t terminal or non-terminal t must appear at least n times
hunk ./tools/c2hs/c/CParser.y 70
--- * There may be a `,' behind the last element of a enum.
+-- C1 && C1 conjunction of constraints
hunk ./tools/c2hs/c/CParser.y 72
--- * Structs and unions may lack any declarations; eg, `struct { } foo;' is
--- valid. [_$_]
+-- C1 || C2 disjunction of constraints
+--
+-- C1 |x| C2 exclusive disjunction of constraints
+--
+--
+-- Comments:
+--
+-- * Subtrees representing empty declarators of the form `CVarDeclr Nothing
+-- at' have *no* valid attribute handle in `at' (only a `newAttrsOnlyPos
+-- nopos').
hunk ./tools/c2hs/c/CParser.y 87
+-- * GNUC __attribute__s should be enetered into the parse tree since they
+-- contain useful api/abi information.
+--
+-- * Some other extensions are currently recognised by the parser but not
+-- entered into the parse tree.
+--
hunk ./tools/c2hs/c/CParser.y 97
-import Monad (when)
-import Maybe (catMaybes)
+import Prelude hiding (reverse)
+import qualified Data.List as List
hunk ./tools/c2hs/c/CParser.y 101
-import Utils (Tag(tag))
-import UNames (Name, NameSupply, names)
+import UNames (names)
hunk ./tools/c2hs/c/CParser.y 105
-import C2HSState (CST, raiseFatal, getNameSupply)
-import CLexer (CToken(..), GnuCTok(..), lexC,
- P, execParser, parseError, getNewName, addTypedef)
+import State (PreCST, raiseFatal, getNameSupply)
+import CLexer (lexC, parseError)
hunk ./tools/c2hs/c/CParser.y 108
- CDecl(..), CDeclSpec(..), CStorageSpec(..), CTypeSpec(..),
- CTypeQual(..), CStructUnion(..), CStructTag(..), CEnum(..),
- CDeclr(..), CInit(..), CExpr(..), CAssignOp(..),
- CBinaryOp(..), CUnaryOp(..), CConst (..))
+ CBlockItem(..), CDecl(..), CDeclSpec(..), CStorageSpec(..),
+ CTypeSpec(..), CTypeQual(..), CStructUnion(..),
+ CStructTag(..), CEnum(..), CDeclr(..), CInit(..), CInitList,
+ CDesignator(..), CExpr(..), CAssignOp(..), CBinaryOp(..),
+ CUnaryOp(..), CConst (..))
hunk ./tools/c2hs/c/CParser.y 114
+import CTokens (CToken(..), GnuCTok(..))
+import CParserMonad (P, execParser, getNewName, addTypedef, shadowTypedef,
+ enterScope, leaveScope )
hunk ./tools/c2hs/c/CParser.y 119
-%name parseCHeader header
+%name header header
hunk ./tools/c2hs/c/CParser.y 125
--- we have 1 shift/reduce confilict because of the "if then else" syntax.
hunk ./tools/c2hs/c/CParser.y 129
-'(' { CTokLParen _ } -- 1
-')' { CTokRParen _ } -- 2
-'[' { CTokLBracket _ } -- 3
-']' { CTokRBracket _ } -- 4
-"->" { CTokArrow _ } -- 5
-'.' { CTokDot _ } -- 6
-'!' { CTokExclam _ } -- 7
-'~' { CTokTilde _ } -- 8
-"++" { CTokInc _ } -- 9
-"--" { CTokDec _ } -- 10
-'+' { CTokPlus _ } -- 11
-'-' { CTokMinus _ } -- 12
-'*' { CTokStar _ } -- 13
-'/' { CTokSlash _ } -- 14
-'%' { CTokPercent _ } -- 15
-'&' { CTokAmper _ } -- 16
-"<<" { CTokShiftL _ } -- 17
-">>" { CTokShiftR _ } -- 18
-'<' { CTokLess _ } -- 19
-"<=" { CTokLessEq _ } -- 20
-'>' { CTokHigh _ } -- 21
-">=" { CTokHighEq _ } -- 22
-"==" { CTokEqual _ } -- 23
-"!=" { CTokUnequal _ } -- 24
-'^' { CTokHat _ } -- 25
-'|' { CTokBar _ } -- 26
-"&&" { CTokAnd _ } -- 27
-"||" { CTokOr _ } -- 28
-'?' { CTokQuest _ } -- 29
-':' { CTokColon _ } -- 30
-'=' { CTokAssign _ } -- 31
-"+=" { CTokPlusAss _ } -- 32
-"-=" { CTokMinusAss _ } -- 33
-"*=" { CTokStarAss _ } -- 34
-"/=" { CTokSlashAss _ } -- 35
-"%=" { CTokPercAss _ } -- 36
-"&=" { CTokAmpAss _ } -- 37
-"^=" { CTokHatAss _ } -- 38
-"|=" { CTokBarAss _ } -- 39
-"<<=" { CTokSLAss _ } -- 40
-">>=" { CTokSRAss _ } -- 41
-',' { CTokComma _ } -- 42
-';' { CTokSemic _ } -- 43
-'{' { CTokLBrace _ } -- 44
-'}' { CTokRBrace _ } -- 45
-"..." { CTokEllipsis _ } -- 46
-alignof { CTokAlignof _ } -- 47
+'(' { CTokLParen _ }
+')' { CTokRParen _ }
+'[' { CTokLBracket _ }
+']' { CTokRBracket _ }
+"->" { CTokArrow _ }
+'.' { CTokDot _ }
+'!' { CTokExclam _ }
+'~' { CTokTilde _ }
+"++" { CTokInc _ }
+"--" { CTokDec _ }
+'+' { CTokPlus _ }
+'-' { CTokMinus _ }
+'*' { CTokStar _ }
+'/' { CTokSlash _ }
+'%' { CTokPercent _ }
+'&' { CTokAmper _ }
+"<<" { CTokShiftL _ }
+">>" { CTokShiftR _ }
+'<' { CTokLess _ }
+"<=" { CTokLessEq _ }
+'>' { CTokHigh _ }
+">=" { CTokHighEq _ }
+"==" { CTokEqual _ }
+"!=" { CTokUnequal _ }
+'^' { CTokHat _ }
+'|' { CTokBar _ }
+"&&" { CTokAnd _ }
+"||" { CTokOr _ }
+'?' { CTokQuest _ }
+':' { CTokColon _ }
+'=' { CTokAssign _ }
+"+=" { CTokPlusAss _ }
+"-=" { CTokMinusAss _ }
+"*=" { CTokStarAss _ }
+"/=" { CTokSlashAss _ }
+"%=" { CTokPercAss _ }
+"&=" { CTokAmpAss _ }
+"^=" { CTokHatAss _ }
+"|=" { CTokBarAss _ }
+"<<=" { CTokSLAss _ }
+">>=" { CTokSRAss _ }
+',' { CTokComma _ }
+';' { CTokSemic _ }
+'{' { CTokLBrace _ }
+'}' { CTokRBrace _ }
+"..." { CTokEllipsis _ }
+alignof { CTokAlignof _ }
hunk ./tools/c2hs/c/CParser.y 177
-auto { CTokAuto _ } -- 48
-break { CTokBreak _ } -- 49
-case { CTokCase _ } -- 50
-char { CTokChar _ } -- 51
-const { CTokConst _ } -- 52
-continue { CTokContinue _ } -- 53
-default { CTokDefault _ } -- 54
-do { CTokDo _ } -- 55
-double { CTokDouble _ } -- 56
-else { CTokElse _ } -- 57
-enum { CTokEnum _ } -- 58
-extern { CTokExtern _ } -- 59
-float { CTokFloat _ } -- 60
-for { CTokFor _ } -- 61
-goto { CTokGoto _ } -- 62
-if { CTokIf _ } -- 63
-inline { CTokInline _ } -- 64
-int { CTokInt _ } -- 65
-long { CTokLong _ } -- 66
-register { CTokRegister _ } -- 67
-restrict { CTokRestrict _ } -- 68
-return { CTokReturn _ } -- 69
-short { CTokShort _ } -- 70
-signed { CTokSigned _ } -- 71
-sizeof { CTokSizeof _ } -- 72
-static { CTokStatic _ } -- 73
-struct { CTokStruct _ } -- 74
-switch { CTokSwitch _ } -- 75
-typedef { CTokTypedef _ } -- 76
-typeof { CTokTypeof _ }
-union { CTokUnion _ } -- 77
-unsigned { CTokUnsigned _ } -- 78
-void { CTokVoid _ } -- 79
-volatile { CTokVolatile _ } -- 80
-while { CTokWhile _ } -- 81
-cchar { CTokCLit _ _ } -- 82 -- character constant
-cint { CTokILit _ _ } -- 83 -- integer constant
-cfloat { CTokFLit _ _ } -- 84 -- float constant
-cstr { CTokSLit _ _ } -- 85 -- string constant (no escapes)
-ident { CTokIdent _ $$ } -- 86 -- identifier
-tyident { CTokTyIdent _ $$ } -- 87 -- `typedef-name' identifier
-attribute { CTokGnuC GnuCAttrTok _ } -- special GNU C tokens
-extension { CTokGnuC GnuCExtTok _ } -- special GNU C tokens
+auto { CTokAuto _ }
+break { CTokBreak _ }
+"_Bool" { CTokBool _ }
+case { CTokCase _ }
+char { CTokChar _ }
+const { CTokConst _ }
+continue { CTokContinue _ }
+"_Complex" { CTokComplex _ }
+default { CTokDefault _ }
+do { CTokDo _ }
+double { CTokDouble _ }
+else { CTokElse _ }
+enum { CTokEnum _ }
+extern { CTokExtern _ }
+float { CTokFloat _ }
+for { CTokFor _ }
+goto { CTokGoto _ }
+if { CTokIf _ }
+inline { CTokInline _ }
+int { CTokInt _ }
+long { CTokLong _ }
+"__label__" { CTokLabel _ }
+register { CTokRegister _ }
+restrict { CTokRestrict _ }
+return { CTokReturn _ }
+short { CTokShort _ }
+signed { CTokSigned _ }
+sizeof { CTokSizeof _ }
+static { CTokStatic _ }
+struct { CTokStruct _ }
+switch { CTokSwitch _ }
+typedef { CTokTypedef _ }
+typeof { CTokTypeof _ }
+"__thread" { CTokThread _ }
+union { CTokUnion _ }
+unsigned { CTokUnsigned _ }
+void { CTokVoid _ }
+volatile { CTokVolatile _ }
+while { CTokWhile _ }
+cchar { CTokCLit _ _ } -- character constant
+cint { CTokILit _ _ } -- integer constant
+cfloat { CTokFLit _ _ } -- float constant
+cstr { CTokSLit _ _ } -- string constant (no escapes)
+ident { CTokIdent _ $$ } -- identifier
+tyident { CTokTyIdent _ $$ } -- `typedef-name' identifier
+"__attribute__" { CTokGnuC GnuCAttrTok _ } -- special GNU C tokens
+"__extension__" { CTokGnuC GnuCExtTok _ } -- special GNU C tokens
+
+-- special GNU C builtin 'functions' that actually take types as parameters:
+"__builtin_va_arg" { CTokGnuC GnuCVaArg _ }
+"__builtin_offsetof" { CTokGnuC GnuCOffsetof _ }
+"__builtin_types_compatible_p" { CTokGnuC GnuCTyCompat _ }
hunk ./tools/c2hs/c/CParser.y 233
--- parse a complete C header file (K&R A10)
+-- parse a complete C header file
hunk ./tools/c2hs/c/CParser.y 235
--- * we supply the attr externally for exact compatability with the old parser
--- in terms of use of the unique name supply.
---
-header :: { Attrs -> CHeader }
+header :: { CHeader }
hunk ./tools/c2hs/c/CParser.y 237
- : translation_unit { CHeader (reverse $1) }
+ : translation_unit {% withAttrs $1 $ CHeader (reverse $1) }
hunk ./tools/c2hs/c/CParser.y 240
-translation_unit :: { [CExtDecl] }
+-- parse a complete C translation unit (C99 6.9)
+--
+-- * GNU extensions:
+-- allow empty translation_unit
+-- allow redundant ';'
+--
+translation_unit :: { Reversed [CExtDecl] }
hunk ./tools/c2hs/c/CParser.y 248
- : {- empty -} { [] }
- | translation_unit external_declaration { $2 : $1 }
- | translation_unit asm '(' expression ')' ';'
- {% withAttrs $2 $ \at -> CAsmExt at : $1 }
+ : {- empty -} { empty }
+ | translation_unit ';' { $1 }
+ | translation_unit external_declaration { $1 `snoc` $2 }
hunk ./tools/c2hs/c/CParser.y 253
--- parse external C declaration (K&R A10)
+-- parse external C declaration (C99 6.9)
+--
+-- * GNU extensions:
+-- allow extension keyword before external declaration
+-- asm definitions
hunk ./tools/c2hs/c/CParser.y 261
- : function_definition { CFDefExt $1 }
- | declaration ';' { CDeclExt $1 }
+ : attrs_opt function_definition { CFDefExt $2 }
+ | attrs_opt declaration { CDeclExt $2 }
+ | "__extension__" external_declaration { $2 }
+ | asm '(' string_literal ')' ';' {% withAttrs $2 CAsmExt }
hunk ./tools/c2hs/c/CParser.y 267
--- parse C function definition (K&R A10.1)
+-- parse C function definition (C99 6.9.1)
hunk ./tools/c2hs/c/CParser.y 271
- : declaration_specifiers declarator declaration_list compound_statement
- {% withAttrs $1 $ CFunDef $1 $2 (reverse $3) $4 }
+ : function_declarator compound_statement
+ {% leaveScope >> (withAttrs $1 $ CFunDef [] $1 [] $2) }
+
+ | declaration_specifier function_declarator compound_statement
+ {% leaveScope >> (withAttrs $1 $ CFunDef $1 $2 [] $3) }
+
+ | type_specifier function_declarator compound_statement
+ {% leaveScope >> (withAttrs $1 $ CFunDef $1 $2 [] $3) }
hunk ./tools/c2hs/c/CParser.y 280
- | declarator declaration_list compound_statement
+ | declaration_qualifier_list function_declarator compound_statement
+ {% leaveScope >> (withAttrs $1 $ CFunDef (reverse $1) $2 [] $3) }
+
+ | type_qualifier_list function_declarator compound_statement
+ {% leaveScope >> (withAttrs $1 $ CFunDef (liftTypeQuals $1) $2 [] $3) }
+
+ | old_function_declarator declaration_list compound_statement
hunk ./tools/c2hs/c/CParser.y 289
+ | declaration_specifier old_function_declarator declaration_list compound_statement
+ {% withAttrs $1 $ CFunDef $1 $2 (reverse $3) $4 }
+
+ | type_specifier old_function_declarator declaration_list compound_statement
+ {% withAttrs $1 $ CFunDef $1 $2 (reverse $3) $4 }
+
+ | declaration_qualifier_list old_function_declarator declaration_list compound_statement
+ {% withAttrs $1 $ CFunDef (reverse $1) $2 (reverse $3) $4 }
+
+ | type_qualifier_list old_function_declarator declaration_list compound_statement
+ {% withAttrs $1 $ CFunDef (liftTypeQuals $1) $2 (reverse $3) $4 }
hunk ./tools/c2hs/c/CParser.y 301
--- parse C statement (K&R A9)
+
+function_declarator :: { CDeclr }
+function_declarator
+ : identifier_declarator
+ {% enterScope >> doFuncParamDeclIdent $1 >> return $1 }
+
+
+declaration_list :: { Reversed [CDecl] }
+declaration_list
+ : {- empty -} { empty }
+ | declaration_list declaration { $1 `snoc` $2 }
+
+
+-- parse C statement (C99 6.8)
+--
+-- * GNU extension: ' __asm__ (...); ' statements
hunk ./tools/c2hs/c/CParser.y 329
-statement_list :: { [CStat] }
-statement_list
- : {- empty -} { [] }
- | statement_list statement { $2 : $1 }
-
-
--- parse C labeled statement (K&R A9.1)
+-- parse C labeled statement (C99 6.8.1)
+--
+-- * GNU extension: case ranges
hunk ./tools/c2hs/c/CParser.y 335
- : ident ':' statement {% withAttrs $2 $ CLabel $1 $3}
+ : identifier ':' attrs_opt statement {% withAttrs $2 $ CLabel $1 $4}
hunk ./tools/c2hs/c/CParser.y 338
+ | case constant_expression "..." constant_expression ':' statement
+ {% withAttrs $1 $ CCases $2 $4 $6 }
hunk ./tools/c2hs/c/CParser.y 342
--- parse C expression statement (K&R A9.2)
+-- parse C compound statement (C99 6.8.2)
+--
+-- * GNU extension: '__label__ ident;' declarations
+--
+compound_statement :: { CStat }
+compound_statement
+ : '{' enter_scope block_item_list leave_scope '}'
+ {% withAttrs $1 $ CCompound (reverse $3) }
+
+ | '{' enter_scope label_declarations block_item_list leave_scope '}'
+ {% withAttrs $1 $ CCompound (reverse $4) }
+
+
+-- No syntax for these, just side effecting semantic actions.
+--
+enter_scope :: { () }
+enter_scope : {% enterScope }
+leave_scope :: { () }
+leave_scope : {% leaveScope }
+
+
+block_item_list :: { Reversed [CBlockItem] }
+block_item_list
+ : {- empty -} { empty }
+ | block_item_list block_item { $1 `snoc` $2 }
+
+
+block_item :: { CBlockItem }
+block_item
+ : statement { CBlockStmt $1 }
+ | nested_declaration { $1 }
+
+
+nested_declaration :: { CBlockItem }
+nested_declaration
+ : declaration { CBlockDecl $1 }
+ | attrs declaration { CBlockDecl $2 }
+ | nested_function_definition { CNestedFunDef $1 }
+ | attrs nested_function_definition { CNestedFunDef $2 }
+ | "__extension__" nested_declaration { $2 }
+
+
+nested_function_definition :: { CFunDef }
+nested_function_definition
+ : declaration_specifier function_declarator compound_statement
+ {% leaveScope >> (withAttrs $1 $ CFunDef $1 $2 [] $3) }
+
+ | type_specifier function_declarator compound_statement
+ {% leaveScope >> (withAttrs $1 $ CFunDef $1 $2 [] $3) }
+
+ | declaration_qualifier_list function_declarator compound_statement
+ {% leaveScope >> (withAttrs $1 $ CFunDef (reverse $1) $2 [] $3) }
+
+ | type_qualifier_list function_declarator compound_statement
+ {% leaveScope >> (withAttrs $1 $ CFunDef (liftTypeQuals $1) $2 [] $3) }
+
+
+label_declarations :: { () }
+label_declarations
+ : "__label__" identifier_list ';' { () }
+ | label_declarations "__label__" identifier_list ';' { () }
+
+
+-- parse C expression statement (C99 6.8.3)
hunk ./tools/c2hs/c/CParser.y 413
--- parse C compound statement (K&R A9.3)
---
-compound_statement :: { CStat }
-compound_statement
- : '{' declaration_list statement_list '}'
- {% withAttrs $1 $ CCompound (reverse $2) (reverse $3) }
-
-
--- parse C selection statement (K&R A9.4)
+-- parse C selection statement (C99 6.8.4)
hunk ./tools/c2hs/c/CParser.y 427
--- parse C iteration statement (K&R A9.5)
+-- parse C iteration statement (C99 6.8.5)
hunk ./tools/c2hs/c/CParser.y 437
- | for '(' expression_statement expression_statement ')' statement
- {% withAttrs $1 $ case $3 of
- CExpr e3 _ ->
- case $4 of
- CExpr e4 _ -> CFor e3 e4 Nothing $6 }
+ | for '(' expression_opt ';' expression_opt ';' expression_opt ')' statement
+ {% withAttrs $1 $ CFor (Left $3) $5 $7 $9 }
hunk ./tools/c2hs/c/CParser.y 440
- | for '(' expression_statement expression_statement expression ')' statement
- {% withAttrs $1 $ case $3 of
- CExpr e3 _ ->
- case $4 of
- CExpr e4 _ -> CFor e3 e4 (Just $5) $7 }
+ | for '(' enter_scope declaration expression_opt ';' expression_opt ')' statement leave_scope
+ {% withAttrs $1 $ CFor (Right $4) $5 $7 $9 }
hunk ./tools/c2hs/c/CParser.y 444
--- parse C jump statement (K&R A9.6)
+-- parse C jump statement (C99 6.8.6)
+--
+-- * GNU extension: computed gotos
hunk ./tools/c2hs/c/CParser.y 450
- : goto ident ';' {% withAttrs $1 $ CGoto $2 }
+ : goto identifier ';' {% withAttrs $1 $ CGoto $2 }
+ | goto '*' expression ';' {% withAttrs $1 $ CGotoPtr $3 }
hunk ./tools/c2hs/c/CParser.y 454
- | return ';' {% withAttrs $1 $ CReturn Nothing }
- | return expression ';' {% withAttrs $1 $ CReturn (Just $2) }
+ | return expression_opt ';' {% withAttrs $1 $ CReturn $2 }
hunk ./tools/c2hs/c/CParser.y 463
+
hunk ./tools/c2hs/c/CParser.y 466
+
hunk ./tools/c2hs/c/CParser.y 474
+
hunk ./tools/c2hs/c/CParser.y 495
- : string '(' expression ')' { () }
- | '[' ident ']' string '(' expression ')' { () }
- | '[' tyident ']' string '(' expression ')' { () }
+ : string_literal '(' expression ')' { () }
+ | '[' ident ']' string_literal '(' expression ')' { () }
+ | '[' tyident ']' string_literal '(' expression ')' { () }
hunk ./tools/c2hs/c/CParser.y 502
- : string { () }
- | asm_clobbers ',' string { () }
+ : string_literal { () }
+ | asm_clobbers ',' string_literal { () }
hunk ./tools/c2hs/c/CParser.y 506
--- parse C declaration (K&R A8)
---
--- * We allow the GNU C extension keyword before a declaration and GNU C
--- attribute annotations after declaration specifiers, but they are not
--- entered into the structure tree.
+-- parse C declaration (C99 6.7)
hunk ./tools/c2hs/c/CParser.y 510
- : declaration_specifiers
- {% withAttrs $1 $ CDecl $1 [] }
+ : sue_declaration_specifier ';'
+ {% withAttrs $1 $ CDecl (reverse $1) [] }
hunk ./tools/c2hs/c/CParser.y 513
- | declaration_specifiers init_declarator_list
- {% let declrs = reverse $2
- in when (isTypeDef $1)
- (mapM_ addTypedef (getTypeDefIdents (map fst declrs)))
- >> getNewName >>= \name ->
- let attrs = newAttrs (posOf $1) name
- declrs' = [ (Just d, i, Nothing) | (d, i) <- declrs ]
- in attrs `seq`
- return (CDecl $1 declrs' attrs) }
+ | sue_type_specifier ';'
+ {% withAttrs $1 $ CDecl (reverse $1) [] }
hunk ./tools/c2hs/c/CParser.y 516
+ | declaring_list ';'
+ { case $1 of
+ CDecl declspecs dies attr ->
+ CDecl declspecs (List.reverse dies) attr }
hunk ./tools/c2hs/c/CParser.y 521
-declaration_list :: { [CDecl] }
-declaration_list
- : {- empty -} { [] }
- | declaration_list declaration ';' { $2 : $1 }
+ | default_declaring_list ';'
+ { case $1 of
+ CDecl declspecs dies attr ->
+ CDecl declspecs (List.reverse dies) attr }
hunk ./tools/c2hs/c/CParser.y 527
--- parse C declaration specifiers (K&R A8)
+-- Note that if a typedef were redeclared, then a declaration
+-- specifier must be supplied
+--
+-- Can't redeclare typedef names
hunk ./tools/c2hs/c/CParser.y 532
-declaration_specifiers :: { [CDeclSpec] }
-declaration_specifiers
- : ignore_extension declaration_specifiers_ { $2 }
+default_declaring_list :: { CDecl }
+default_declaring_list
+ : declaration_qualifier_list identifier_declarator asm_opt attrs_opt {-{}-} initializer_opt
+ {% let declspecs = reverse $1 in
+ doDeclIdent declspecs $2
+ >> (withAttrs $1 $ CDecl declspecs [(Just $2, $5, Nothing)]) }
hunk ./tools/c2hs/c/CParser.y 539
+ | type_qualifier_list identifier_declarator asm_opt attrs_opt {-{}-} initializer_opt
+ {% let declspecs = liftTypeQuals $1 in
+ doDeclIdent declspecs $2
+ >> (withAttrs $1 $ CDecl declspecs [(Just $2, $5, Nothing)]) }
hunk ./tools/c2hs/c/CParser.y 544
-declaration_specifiers_ :: { [CDeclSpec] }
-declaration_specifiers_
- : storage_class_specifier gnuc_attrs
- { [CStorageSpec $1] }
+ | default_declaring_list ',' identifier_declarator asm_opt attrs_opt {-{}-} initializer_opt
+ {% case $1 of
+ CDecl declspecs dies attr -> do
+ doDeclIdent declspecs $3
+ return (CDecl declspecs ((Just $3, $6, Nothing) : dies) attr) }
hunk ./tools/c2hs/c/CParser.y 550
- | storage_class_specifier gnuc_attrs declaration_specifiers_
- { CStorageSpec $1 : $3 }
hunk ./tools/c2hs/c/CParser.y 551
- | type_specifier gnuc_attrs
- { [CTypeSpec $1] }
+declaring_list :: { CDecl }
+declaring_list
+ : declaration_specifier declarator asm_opt attrs_opt {-{}-} initializer_opt
+ {% doDeclIdent $1 $2
+ >> (withAttrs $1 $ CDecl $1 [(Just $2, $5, Nothing)]) }
hunk ./tools/c2hs/c/CParser.y 557
- | type_specifier gnuc_attrs declaration_specifiers_
- { CTypeSpec $1 : $3 }
+ | type_specifier declarator asm_opt attrs_opt {-{}-} initializer_opt
+ {% doDeclIdent $1 $2
+ >> (withAttrs $1 $ CDecl $1 [(Just $2, $5, Nothing)]) }
hunk ./tools/c2hs/c/CParser.y 561
- | type_qualifier gnuc_attrs
- { [CTypeQual $1] }
+ | declaring_list ',' declarator asm_opt attrs_opt {-{}-} initializer_opt
+ {% case $1 of
+ CDecl declspecs dies attr -> do
+ doDeclIdent declspecs $3
+ return (CDecl declspecs ((Just $3, $6, Nothing) : dies) attr) }
hunk ./tools/c2hs/c/CParser.y 567
- | type_qualifier gnuc_attrs declaration_specifiers_
- { CTypeQual $1 : $3 }
+
+-- parse C declaration specifiers (C99 6.7)
+--
+-- * summary:
+-- [ type_qualifier | storage_class
+-- | basic_type_name | elaborated_type_name | tyident ]{
+-- ( 1 >= basic_type_name
+-- |x| 1 == elaborated_type_name
+-- |x| 1 == tyident
+-- ) && 1 >= storage_class
+-- }
+--
+declaration_specifier :: { [CDeclSpec] }
+declaration_specifier
+ : basic_declaration_specifier { reverse $1 } -- Arithmetic or void
+ | sue_declaration_specifier { reverse $1 } -- Struct/Union/Enum
+ | typedef_declaration_specifier { reverse $1 } -- Typedef
hunk ./tools/c2hs/c/CParser.y 586
--- parse C init declarator (K&R A8)
+-- A mixture of type qualifiers and storage class specifiers in any order, but
+-- containing at least one storage ...
[truncated message content] |
|
From: Duncan C. <dun...@wo...> - 2007-05-02 21:02:03
|
Wed May 2 09:27:04 PDT 2007 Duncan Coutts <du...@co...>
* Port one more c2hs fix from upstream.
hunk ./tools/c2hs/c/CTrav.hs 559
-dropPtrDeclr (CPtrDeclr qs declr@(CVarDeclr _ _) ats) [_$_]
- | length qs == 1 = declr
- | otherwise =
- CPtrDeclr (init qs) declr ats
-dropPtrDeclr (CPtrDeclr qs declr ats) = [_$_]
+dropPtrDeclr (CPtrDeclr qs declr@(CVarDeclr _ _) ats) = declr
+dropPtrDeclr (CPtrDeclr qs declr ats) = [_$_]
|
|
From: Axel S. <A....@ke...> - 2007-04-19 09:22:23
|
Thu Apr 19 02:20:04 PDT 2007 A....@ke...
* Add drag and drop support.
hunk ./Makefile.am 567
- gtk/Graphics/UI/Gtk/Pango/Markup.hs \
- gtk/Graphics/UI/Gtk/Cairo.chs.pp
+ gtk/Graphics/UI/Gtk/Pango/Markup.hs \
+ gtk/Graphics/UI/Gtk/Cairo.chs.pp \
+ gtk/Graphics/UI/Gtk/General/Selection.chs.pp \
+ gtk/Graphics/UI/Gtk/General/Drag.chs.pp \
+ gtk/Graphics/UI/Gtk/General/DNDTypes.chs
hunk ./Makefile.am 591
- gtk/Graphics/UI/Gtk/Abstract/ContainerChildProperties.hs
+ gtk/Graphics/UI/Gtk/Abstract/ContainerChildProperties.hs \
+ gtk/Graphics/UI/Gtk/General/DNDTypes.chs
hunk ./gtk/Graphics/UI/Gtk.hs 48
+ module Graphics.UI.Gtk.General.Selection,
+ module Graphics.UI.Gtk.General.Drag,
hunk ./gtk/Graphics/UI/Gtk.hs 52
- -- * Drawing
+ -- * Drawing and other Low-Level Operations
hunk ./gtk/Graphics/UI/Gtk.hs 222
+import Graphics.UI.Gtk.General.Selection
+import Graphics.UI.Gtk.General.Drag
hunk ./gtk/Graphics/UI/Gtk/Gdk/Enums.chs 33
+ DragProtocol(..),
hunk ./gtk/Graphics/UI/Gtk/Gdk/Enums.chs 63
+-- | Used in 'Graphics.UI.Gtk.Gdk.Drag.DragContext' to indicate the protocol according to which DND is done.
+--
+{#enum DragProtocol {underscoreToCase} deriving (Bounded)#}
+
addfile ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs
addfile ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp
hunk ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp 1
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) Drag-and-Drop functionality
+--
+-- Author : Axel Simon
+--
+-- Created: 26 March 2007
+--
+-- Copyright (C) 2007 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.
+--
+--
+-- functions not bound:
+-- dragBegin : necessary to implement custom widgets that may be the source of
+-- drags. Would need to pass an event and an array of targets. The event needs
+-- to have the following information: Motion {
+-- eventTime :: TimeStamp,
+-- eventModifier :: [Modifier],
+-- eventIsHint (this needs to be True in order to avoid gdk_event_get_screen to be called (which causes havoc))
+-- eventXRoot,
+-- eventYRoot :: Double } [_$_]
+-- Button {
+-- eventClick :: Click,
+-- eventTime :: TimeStamp,
+-- eventModifier :: [Modifier],
+-- Key {
+-- eventTime :: TimeStamp,
+-- eventModifier :: [Modifier],
+-- Crossing {
+-- eventTime :: TimeStamp,
+-- eventModifier :: [Modifier]}
+--
+-- drag_set_icon_pixmap : colormaps are a pain, they migth be useful here
+-- drag_set_default_icon : obsolete drag_source_set_icon : colormap problem
+--
+-- |
+-- Maintainer : gtk...@li... Stability : provisional
+-- Portability : portable (depends on GHC)
+--
+-- Drag-and-Drop functionality.
+--
+-- GTK+ has a rich set of functions for doing inter-process communication via
+-- the drag-and-drop metaphor. GTK+ can do drag-and-drop (DND) via multiple
+-- protocols. The currently supported protocols are the Xdnd and Motif
+-- protocols. As well as the functions listed here, applications may need to
+-- use some facilities provided for 'Selection's. Also, the Drag and Drop API
+-- makes use of signals in the 'Widget' class.
+--
+module Graphics.UI.Gtk.General.Drag (
+
+-- * Types
+ DragContext,
+ DragContextClass,
+ castToDragContext,
+ toDragContext,
+ [_$_]
+-- * Methods
+ dragContextActions,
+ dragContextSuggestedAction,
+ dragContextAction,
+ [_$_]
+ dragDestSet,
+ dragDestSetProxy,
+ dragDestUnset,
+ dragDestFindTarget,
+ dragDestGetTargetList,
+ dragDestSetTargetList,
+#if GTK_CHECK_VERSION(2,6,0)
+ dragDestAddTextTargets,
+ dragDestAddImageTargets,
+ dragDestAddURITargets,
+#endif
+ dragFinish,
+ dragGetData,
+ dragGetSourceWidget,
+ dragHighlight,
+ dragUnhighlight,
+ dragSetIconWidget,
+ dragSetIconPixbuf,
+ dragSetIconStock,
+#if GTK_CHECK_VERSION(2,8,0)
+ dragSetIconName,
+#endif
+ dragSetIconDefault,
+ dragCheckThreshold,
+ dragSourceSet,
+ dragSourceSetIconPixbuf,
+ dragSourceSetIconStock,
+#if GTK_CHECK_VERSION(2,8,0)
+ dragSourceSetIconName,
+#endif
+ dragSourceUnset,
+#if GTK_CHECK_VERSION(2,8,0)
+ dragSourceSetTargetList,
+ dragSourceGetTargetList,
+#endif
+#if GTK_CHECK_VERSION(2,6,0)
+ dragSourceAddTextTargets,
+ dragSourceAddImageTargets,
+ dragSourceAddURITargets,
+#endif
+
+ -- * Signals
+ dragBegin,
+ dragDataDelete,
+ dragDataGet,
+ dragDataReceived,
+ dragDrop,
+ dragEnd,
+#if GTK_CHECK_VERSION(2,12,0)
+ dragFailed,
+#endif
+ dragLeave,
+ dragMotion
+ ) where
+
+import Monad (liftM)
+
+import System.Glib.FFI
+import System.Glib.Flags
+import System.Glib.UTFString ( peekUTFString, withUTFString )
+import System.Glib.GObject (constructNewGObject, makeNewGObject)
+import System.Glib.Attributes ( Attr, newAttr )
+import Graphics.UI.Gtk.General.StockItems ( StockId )
+{#import Graphics.UI.Gtk.Types#}
+{#import Graphics.UI.Gtk.General.DNDTypes#}
+{#import Graphics.UI.Gtk.General.Selection#} ( TargetList )
+import Graphics.UI.Gtk.General.Enums ( TargetFlags(..), DestDefaults(..),
+ DragProtocol(..) )
+import Graphics.UI.Gtk.Gdk.Events ( TimeStamp, Modifier )
+import Graphics.UI.Gtk.General.Structs ( Point, [_$_]
+ dragContextGetActions, dragContextSetActions,
+ dragContextGetSuggestedAction, dragContextSetSuggestedAction,
+ dragContextGetAction, dragContextSetAction )
+import Graphics.UI.Gtk.Signals
+import Control.Monad.Reader (runReaderT, ask)
+
+{# context lib="gtk" prefix="gtk" #}
+
+--------------------
+-- Types
+
+-- | Used in 'DragContext' to indicate what the destination should do with the
+-- dropped data.
+--
+-- * 'ActionDefault': Initialisation value, should not be used.
+-- * 'ActionCopy': Copy the data.
+-- * 'ActionMove': Move the data, i.e. first copy it, then delete it from the source using
+-- the DELETE target of the X selection protocol.
+-- * 'ActionLink': Add a link to the data. Note that this is only useful if source and
+-- destination agree on what it means.
+-- * 'ActionPrivate': Special action which tells the source that the destination will do
+-- something that the source doesn't understand.
+-- * 'ActionAsk': Ask the user what to do with the data.
+
+{#enum GdkDragAction as DragAction {underscoreToCase} deriving (Bounded) #} [_$_]
+
+instance Flags DragAction
+ [_$_]
+--------------------
+-- Methods
+
+-- | A set of actions that the source recommends to be taken. Only valid if
+-- 'dragContextSugestedAction' is set to 'ActionAsk'.
+--
+dragContextActions :: Attr DragContext [DragAction]
+dragContextActions = newAttr (liftM toFlags . dragContextGetActions)
+ (\o -> dragContextSetActions o . fromFlags)
+
+-- | The action suggested by the source.
+dragContextSuggestedAction :: Attr DragContext DragAction
+dragContextSuggestedAction = newAttr (liftM toEnum . dragContextGetSuggestedAction)
+ (\o -> dragContextSetSuggestedAction o . fromEnum)
+
+-- | The action chosen by the destination.
+dragContextAction :: Attr DragContext DragAction
+dragContextAction = newAttr (liftM toEnum . dragContextGetAction)
+ (\o -> dragContextSetAction o . fromEnum)
+
+-- %hash c:4ff5 d:af3f
+-- | Sets a widget as a potential drop destination.
+--
+-- * The 'DestDefaults' flags specify what actions GTK+ should take on behalf
+-- of a widget for drops onto that widget. The given actions and any targets
+-- set through 'dragDestSetTargetList' only are used if 'DestDefaultMotion'
+-- or 'DestDefaultDrop' are given.
+--
+dragDestSet :: WidgetClass widget => widget -> [DestDefaults] -> [DragAction] -> IO ()
+dragDestSet widget flags actions =
+ {# call gtk_drag_dest_set #}
+ (toWidget widget)
+ ((fromIntegral . fromFlags) flags)
+ nullPtr 0
+ ((fromIntegral . fromFlags) actions)
+
+-- %hash c:89d2 d:af3f
+-- | Sets this widget as a proxy for drops to another window.
+--
+dragDestSetProxy :: WidgetClass widget => widget
+ -> DrawWindow -- ^ The window to which to forward drag events.
+ -> DragProtocol -- ^ The drag protocol which the 'DrawWindow' accepts.
+ -> Bool -- ^ If @True@, send the same coordinates to the destination,
+ -- because it is an embedded subwindow.
+ -> IO ()
+dragDestSetProxy widget proxyWindow protocol useCoordinates =
+ {# call gtk_drag_dest_set_proxy #}
+ (toWidget widget)
+ proxyWindow
+ ((fromIntegral . fromEnum) protocol)
+ (fromBool useCoordinates)
+
+-- %hash c:f319 d:af3f
+-- | Clears information about a drop destination set with 'dragDestSet'. The
+-- widget will no longer receive notification of drags.
+--
+dragDestUnset :: WidgetClass widget => widget -> IO ()
+dragDestUnset widget =
+ {# call gtk_drag_dest_unset #}
+ (toWidget widget)
+
+-- %hash c:db53 d:af3f
+-- | Looks for a match between the targets mentioned in the context and the
+-- 'TargetList', returning the first matching target, otherwise returning
+-- @Nothing@. If @Nothing@ is given as target list, use the value from
+-- 'destGetTargetList'. Some widgets may have different valid targets for
+-- different parts of the widget; in that case, they will have to implement a
+-- 'dragMotion' handler that passes the correct target list to this
+-- function.
+--
+dragDestFindTarget :: (WidgetClass widget, DragContextClass context) =>
+ widget -> context -> Maybe TargetList -> IO (Maybe TargetTag)
+dragDestFindTarget widget context (Just targetList) = do
+ ttPtr <-
+ {# call gtk_drag_dest_find_target #}
+ (toWidget widget)
+ (toDragContext context)
+ targetList
+ if ttPtr==nullPtr then return Nothing else return (Just (TargetTag ttPtr))
+-- %hash c:41c7 d:af3f
+-- | Returns the list of targets this widget can accept from drag-and-drop.
+--
+dragDestGetTargetList :: WidgetClass widget => widget -> IO (Maybe TargetList)
+dragDestGetTargetList widget = do
+ tlPtr <- {# call gtk_drag_dest_get_target_list #} (toWidget widget)
+ if tlPtr==nullPtr then return Nothing else liftM Just (mkTargetList tlPtr)
+ [_$_]
+-- %hash c:5c89 d:af3f
+-- | Sets the target types that this widget can accept from drag-and-drop. The
+-- widget must first be made into a drag destination with 'dragDestSet'.
+--
+dragDestSetTargetList :: WidgetClass widget => widget -> TargetList -> IO ()
+dragDestSetTargetList widget targetList =
+ {# call gtk_drag_dest_set_target_list #}
+ (toWidget widget)
+ targetList
+
+#if GTK_CHECK_VERSION(2,6,0)
+-- %hash c:36c2 d:af3f
+-- | Add the text targets supported by the selection mechanism to the target
+-- list of the drag source. The targets are added with an 'InfoId' of 0. If
+-- you need another value, use 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and
+-- 'dragSourceSetTargetList'.
+--
+dragDestAddTextTargets :: WidgetClass widget => widget -> IO ()
+dragDestAddTextTargets widget =
+ {# call gtk_drag_dest_add_text_targets #}
+ (toWidget widget)
+
+-- %hash c:691c d:af3f
+-- | Add image targets supported by the selection mechanism to the target
+-- list of the drag source. The targets are added with an 'InfoId' of 0. If
+-- you need another value, use 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and
+-- 'dragSourceSetTargetList'.
+--
+dragDestAddImageTargets :: WidgetClass widget => widget -> IO ()
+dragDestAddImageTargets widget =
+ {# call gtk_drag_dest_add_image_targets #}
+ (toWidget widget)
+
+-- %hash c:6f83 d:af3f
+-- | Add URI targets supported by the selection mechanism to the target
+-- list of the drag source. The targets are added with an 'InfoId' of 0. If
+-- you need another value, use 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and
+-- 'dragSourceSetTargetList'.
+--
+dragDestAddURITargets :: WidgetClass widget => widget -> IO ()
+dragDestAddURITargets widget =
+ {# call gtk_drag_dest_add_uri_targets #}
+ (toWidget widget)
+
+#endif
+
+-- %hash c:a91 d:af3f
+-- | Informs the drag source that the drop is finished, and that the data of
+-- the drag will no longer be required.
+--
+dragFinish :: DragContextClass context => context
+ -> Bool -- ^ a flag indicating whether the drop was successful
+ -> Bool -- ^ a flag indicating whether the source should delete the original data.
+ -- (This should be @True@ for a move)
+ -> TimeStamp -- ^ the timestamp from the 'dragDrop' signal.
+ -> IO ()
+dragFinish context success del time =
+ {# call gtk_drag_finish #}
+ (toDragContext context)
+ (fromBool success)
+ (fromBool del)
+ (fromIntegral time)
+
+-- %hash c:a37d d:af3f
+-- | Gets the data associated with a drag. When the data is received or the
+-- retrieval fails, GTK+ will emit a 'dragDataReceived' signal. Failure of
+-- the retrieval is indicated by passing @Nothing@ in the 'selectionData' signal.
+-- However, when 'dragGetData' is called
+-- implicitely because the 'DestDefaultDrop' was set, then the widget will
+-- not receive notification of failed drops.
+--
+dragGetData :: (WidgetClass widget, DragContextClass context) [_$_]
+ => widget -- ^ The widget that will receive the 'dragDataReceived' signal.
+ -> context [_$_]
+ -> TargetTag -- ^ The target (form of the data) to retrieve.
+ -> TimeStamp -- ^ A timestamp for retrieving the data. This will generally be
+ -- the time received in a 'dragMotion' or 'dragDrop' signal.
+ -> IO ()
+dragGetData widget context (TargetTag target) time =
+ {# call gtk_drag_get_data #}
+ (toWidget widget)
+ (toDragContext context)
+ target
+ (fromIntegral time)
+
+-- %hash c:8c18 d:af3f
+-- | Queries he source widget for a drag.
+--
+-- * If the drag is occurring within a single application, a pointer to the
+-- source widget is returned. Otherwise the return value is @Nothing@.
+--
+dragGetSourceWidget :: DragContextClass context => context -> IO (Maybe Widget)
+dragGetSourceWidget context =
+ maybeNull (makeNewGObject mkWidget) $
+ {# call gtk_drag_get_source_widget #}
+ (toDragContext context)
+
+-- %hash c:1765 d:af3f
+-- | Draws a highlight around a widget. This will attach handlers to
+-- the expose handlers, so the highlight will continue to be displayed
+-- until 'dragUnhighlight' is called.
+--
+dragHighlight :: WidgetClass widget => widget -> IO ()
+dragHighlight widget =
+ {# call gtk_drag_highlight #}
+ (toWidget widget)
+
+-- %hash c:f00e d:af3f
+-- | Removes a highlight set by 'dragHighlight' from a widget.
+--
+dragUnhighlight :: WidgetClass widget => widget -> IO ()
+dragUnhighlight widget =
+ {# call gtk_drag_unhighlight #}
+ (toWidget widget)
+
+-- %hash c:f20 d:af3f
+-- | Changes the icon for a drag to a given widget. GTK+ will not destroy
+-- the widget, so if you don't want it to persist, you should connect to the
+-- 'dragEnd' signal and destroy it yourself.
+--
+-- * The function must be called with the context of the source side.
+--
+dragSetIconWidget :: (DragContextClass context, WidgetClass widget) =>
+ context -> widget
+ -> Int -- ^ x hot-spot
+ -> Int -- ^ y hot-spot
+ -> IO ()
+dragSetIconWidget context widget hotX hotY =
+ {# call gtk_drag_set_icon_widget #}
+ (toDragContext context)
+ (toWidget widget)
+ (fromIntegral hotX)
+ (fromIntegral hotY)
+
+-- %hash c:69 d:af3f
+-- | Set the given 'Pixbuf' as the icon for the given drag.
+--
+dragSetIconPixbuf :: DragContextClass context => context -> Pixbuf
+ -> Int -- ^ x hot-spot
+ -> Int -- ^ y hot-spot
+ -> IO ()
+dragSetIconPixbuf context pixbuf hotX hotY =
+ {# call gtk_drag_set_icon_pixbuf #}
+ (toDragContext context)
+ pixbuf
+ (fromIntegral hotX)
+ (fromIntegral hotY)
+
+-- %hash c:f73f d:af3f
+-- | Sets the icon for a given drag from a stock ID.
+--
+dragSetIconStock :: DragContextClass context => context -> StockId [_$_]
+ -> Int -- ^ x hot-spot
+ -> Int -- ^ y hot-spot
+ -> IO ()
+dragSetIconStock context stockId hotX hotY =
+ withUTFString stockId $ \stockIdPtr ->
+ {# call gtk_drag_set_icon_stock #}
+ (toDragContext context)
+ stockIdPtr
+ (fromIntegral hotX)
+ (fromIntegral hotY)
+
+#if GTK_CHECK_VERSION(2,8,0)
+-- %hash c:1eba d:af3f
+-- | Sets the icon for a given drag from a named themed icon. See the docs for
+-- 'IconTheme' for more details. Note that the size of the icon depends on the
+-- icon theme (the icon is loaded at the DND size), thus x and y hot-spots
+-- have to be used with care. Since Gtk 2.8.
+--
+dragSetIconName :: DragContextClass context => context [_$_]
+ -> String
+ -> Int -- ^ x hot-spot
+ -> Int -- ^ y hot-spot
+ -> IO ()
+dragSetIconName context iconName hotX hotY =
+ withUTFString iconName $ \iconNamePtr ->
+ {# call gtk_drag_set_icon_name #}
+ (toDragContext context)
+ iconNamePtr
+ (fromIntegral hotX)
+ (fromIntegral hotY)
+#endif
+
+-- %hash c:2beb d:af3f
+-- | Sets the icon for a particular drag to the default icon. This function
+-- must be called with a context for the source side of a drag
+--
+dragSetIconDefault :: DragContextClass context => context -> IO ()
+dragSetIconDefault context =
+ {# call gtk_drag_set_icon_default #}
+ (toDragContext context)
+
+-- %hash c:5785 d:af3f
+-- | Checks to see if a mouse drag starting at @(startX, startY)@ and ending
+-- at @(currentX, currenty)@ has passed the GTK+ drag threshold, and thus
+-- should trigger the beginning of a drag-and-drop operation.
+--
+dragCheckThreshold :: WidgetClass widget => widget
+ -> Int -- ^ @startX@
+ -> Int -- ^ @startY@
+ -> Int -- ^ @currentX@
+ -> Int -- ^ @currentY@
+ -> IO Bool
+dragCheckThreshold widget startX startY currentX currentY =
+ liftM toBool $
+ {# call gtk_drag_check_threshold #}
+ (toWidget widget)
+ (fromIntegral startX)
+ (fromIntegral startY)
+ (fromIntegral currentX)
+ (fromIntegral currentY)
+
+-- %hash c:ce13 d:af3f
+-- | Sets up a widget so that GTK+ will start a drag operation when the user
+-- clicks and drags on the widget. The widget must have a window. Note that a
+-- set of possible targets have to be set for a drag to be successful.
+--
+dragSourceSet :: WidgetClass widget => widget -> [Modifier] -> [DragAction] -> IO ()
+dragSourceSet widget startButtonMask actions =
+ {# call gtk_drag_source_set #}
+ (toWidget widget)
+ ((fromIntegral . fromFlags) startButtonMask)
+ nullPtr
+ 0
+ ((fromIntegral . fromFlags) actions)
+
+-- %hash c:63f5 d:af3f
+-- | Sets the icon that will be used for drags from a particular widget from a
+-- 'Pixbuf'. [_$_]
+--
+dragSourceSetIconPixbuf :: WidgetClass widget => widget -> Pixbuf -> IO ()
+dragSourceSetIconPixbuf widget pixbuf =
+ {# call gtk_drag_source_set_icon_pixbuf #}
+ (toWidget widget)
+ pixbuf
+
+-- %hash c:b38b d:af3f
+-- | Sets the icon that will be used for drags from a particular source to a
+-- stock icon.
+--
+dragSourceSetIconStock :: WidgetClass widget => widget -> StockId -> IO ()
+dragSourceSetIconStock widget stockId =
+ withUTFString stockId $ \stockIdPtr ->
+ {# call gtk_drag_source_set_icon_stock #}
+ (toWidget widget)
+ stockIdPtr
+
+#if GTK_CHECK_VERSION(2,8,0)
+-- %hash c:1786 d:af3f
+-- | Sets the icon that will be used for drags from a particular source to a
+-- themed icon. See the docs for 'IconTheme' for more details.
+--
+dragSourceSetIconName :: WidgetClass widget => widget -> String -> IO ()
+dragSourceSetIconName widget iconName =
+ withUTFString iconName $ \iconNamePtr ->
+ {# call gtk_drag_source_set_icon_name #}
+ (toWidget widget)
+ iconNamePtr
+#endif
+
+-- %hash c:653c d:af3f
+-- | Undoes the effects of 'dragSourceSet'.
+--
+dragSourceUnset :: WidgetClass widget => widget -> IO ()
+dragSourceUnset widget =
+ {# call gtk_drag_source_unset #}
+ (toWidget widget)
+
+#if GTK_CHECK_VERSION(2,8,0)
+-- %hash c:facc d:af3f
+-- | Changes the target types that this widget offers for drag-and-drop. The
+-- widget must first be made into a drag source with 'dragSourceSet'.
+--
+-- * Since Gtk 2.4.
+--
+dragSourceSetTargetList :: WidgetClass widget => widget -> TargetList -> IO ()
+dragSourceSetTargetList widget targetList =
+ {# call gtk_drag_source_set_target_list #}
+ (toWidget widget)
+ targetList
+
+-- %hash c:e9aa d:af3f
+-- | Gets the list of targets this widget can provide for drag-and-drop.
+--
+-- * Since Gtk 2.4.
+--
+dragSourceGetTargetList :: WidgetClass widget => widget -> IO (Maybe TargetList)
+dragSourceGetTargetList widget = do
+ tlPtr <- {# call gtk_drag_source_get_target_list #} (toWidget widget)
+ if tlPtr==nullPtr then return Nothing else liftM Just (mkTargetList tlPtr)
+#endif
+
+#if GTK_CHECK_VERSION(2,6,0)
+-- %hash c:1f25 d:af3f
+-- | Add the text targets supported by 'Selection' to the target list of the
+-- drag source. The targets are added with @info = 0@. If you need another
+-- value, use 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and 'dragSourceSetTargetList'.
+--
+-- * Since Gtk 2.6.
+--
+dragSourceAddTextTargets :: WidgetClass widget => widget -> IO ()
+dragSourceAddTextTargets widget =
+ {# call gtk_drag_source_add_text_targets #}
+ (toWidget widget)
+
+-- %hash c:44bf d:af3f
+-- | Add the image targets supported by 'Selection' to the target list of the
+-- drag source. The targets are added with @info = 0@. If you need another
+-- value, use 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and 'dragSourceSetTargetList'.
+--
+-- * Since Gtk 2.6.
+--
+dragSourceAddImageTargets :: WidgetClass widget => widget -> IO ()
+dragSourceAddImageTargets widget =
+ {# call gtk_drag_source_add_image_targets #}
+ (toWidget widget)
+
+-- %hash c:4766 d:af3f
+-- | Add the URI targets supported by 'Selection' to the target list of the
+-- drag source. The targets are added with @info = 0@. If you need another
+-- value, use 'Graphics.UI.Gtk.General.Selection.targetListAddTextTargets' and 'dragSourceSetTargetList'.
+--
+-- * Since Gtk 2.6.
+--
+dragSourceAddURITargets :: WidgetClass widget => widget -> IO ()
+dragSourceAddURITargets widget =
+ {# call gtk_drag_source_add_uri_targets #}
+ (toWidget widget)
+#endif
+
+-- %hash c:fcf8 d:b945
+-- | The 'dragBegin' signal is emitted on the drag source when a drag is
+-- started. A typical reason to connect to this signal is to set up a custom
+-- drag icon with 'dragSourceSetIcon'.
+--
+dragBegin :: WidgetClass self => Signal self (DragContext -> IO ())
+dragBegin = Signal (connect_OBJECT__NONE "drag_begin")
+
+-- %hash c:bfef d:a2ff
+-- | The 'dragDataDelete' signal is emitted on the drag source when a drag
+-- with the action 'ActionMove' is successfully completed. The signal handler
+-- is responsible for deleting the data that has been dropped. What \"delete\"
+-- means, depends on the context of the drag operation.
+--
+dragDataDelete :: WidgetClass self => Signal self (DragContext -> IO ())
+dragDataDelete = Signal (connect_OBJECT__NONE "drag_data_delete")
+
+-- %hash c:eb9c d:844c
+-- | The ::drag-data-get signal is emitted on the drag source when the drop
+-- site requests the data which is dragged. It is the responsibility of the
+-- signal handler to set the selection data in the format which is indicated
+-- by 'InfoId'. See 'selectionDataSet' and 'selectionDataSetText'.
+--
+dragDataGet :: WidgetClass self =>
+ Signal self (DragContext -> InfoId -> TimeStamp -> SelectionDataM ())
+dragDataGet = Signal (\after object handler -> do
+ connect_OBJECT_PTR_WORD_WORD__NONE "drag_data_get" after object $
+ \ctxt dataPtr info time -> do
+ runReaderT (handler ctxt (fromIntegral info) (fromIntegral time)) dataPtr >> [_$_]
+ return ())
+
+-- %hash c:9251 d:a6d8
+-- | The 'dragDataReceived' signal is emitted on the drop site when the
+-- dragged data has been received. If the data was received in order to
+-- determine whether the drop will be accepted, the handler is expected to call
+-- 'dragStatus' and /not/ finish the drag. If the data was received in response
+-- to a 'dragDrop' signal (and this is the last target to be received), the
+-- handler for this signal is expected to process the received data and then
+-- call 'dragFinish', setting the @success@ parameter depending on whether the
+-- data was processed successfully.
+--
+-- The handler may inspect and modify 'dragContextAction' before calling
+-- 'dragFinish', e.g. to implement 'ActionAsk' as shown in the following
+-- example:
+--
+dragDataReceived :: WidgetClass self =>
+ Signal self (DragContext -> Point -> InfoId -> TimeStamp -> SelectionDataM ())
+dragDataReceived = Signal (\after object handler -> do
+ connect_OBJECT_INT_INT_PTR_WORD_WORD__NONE "drag_data_received" after object $
+ \ctxt x y dataPtr info time -> do
+ runReaderT (handler ctxt (fromIntegral x, fromIntegral y) (fromIntegral info)
+ (fromIntegral time)) dataPtr >> return ())
+
+-- %hash c:4ef4 d:f4b8
+-- | The 'dragDrop' signal is emitted on the drop site when the user drops
+-- the data onto the widget. The signal handler must determine whether the
+-- cursor position is in a drop zone or not. If it is not in a drop zone, it
+-- returns @False@ and no further processing is necessary. Otherwise, the
+-- handler returns @True@. In this case, the handler must ensure that
+-- 'dragFinish' is called to let the source know that the drop is done. The
+-- call to 'dragFinish' can be done either directly or in a
+-- 'dragDataReceived' handler which gets triggered by calling 'dropGetData'
+-- to receive the data for one or more of the supported targets.
+--
+dragDrop :: WidgetClass self =>
+ Signal self (DragContext -> Point -> TimeStamp -> IO Bool)
+dragDrop = Signal (\after object handler ->
+ connect_OBJECT_INT_INT_WORD__BOOL "drag_drop" after object $ \ctxt x y time ->
+ handler ctxt (fromIntegral x, fromIntegral y) (fromIntegral time))
+
+-- %hash c:9d4e d:a5ac
+-- | The 'dragEnd' signal is emitted on the drag source when a drag is
+-- finished. A typical reason to connect to this signal is to undo things done
+-- in 'dragBegin'.
+--
+dragEnd :: WidgetClass self => Signal self (DragContext -> IO ())
+dragEnd = Signal (connect_OBJECT__NONE "drag_end")
+
+#if GTK_CHECK_VERSION(2,12,0)
+dragFailed = error "dragFailed: not defined yet"
+#endif
+
+-- %hash c:4a85 d:6122
+-- | The 'dragLeave' signal is emitted on the drop site when the cursor
+-- leaves the widget. A typical reason to connect to this signal is to undo
+-- things done in 'dragMotion', e.g. undo highlighting with 'dragUnhighlight'
+--
+dragLeave :: WidgetClass self => Signal self (DragContext -> TimeStamp -> IO ())
+dragLeave = Signal (\after object handler ->
+ connect_OBJECT_WORD__NONE "drag_leave" after object $ \ctxt time ->
+ handler ctxt (fromIntegral time))
+
+-- %hash c:53f7 d:176d
+-- | The 'dragMotion' signal is emitted on the drop site when the user moves
+-- the cursor over the widget during a drag. The signal handler must determine
+-- whether the cursor position is in a drop zone or not. If it is not in a drop
+-- zone, it returns @False@ and no further processing is necessary. Otherwise,
+-- the handler returns @True@. In this case, the handler is responsible for
+-- providing the necessary information for displaying feedback to the user, by
+-- calling 'dragStatus'. If the decision whether the drop will be accepted or
+-- rejected can't be made based solely on the cursor position and the type of
+-- the data, the handler may inspect the dragged data by calling 'dragGetData'
+-- and defer the 'dragStatus' call to the 'dragDataReceived' handler.
+--
+-- Note that there is no 'dragEnter' signal. The drag receiver has to keep
+-- track of whether he has received any 'dragMotion' signals since the last
+-- 'dragLeave' and if not, treat the 'dragMotion' signal as an \"enter\"
+-- signal. Upon an \"enter\", the handler will typically highlight the drop
+-- site with 'dragHighlight'.
+--
+dragMotion :: WidgetClass self =>
+ Signal self (DragContext -> Point -> TimeStamp -> IO Bool)
+dragMotion = Signal (\after object handler -> do
+ connect_OBJECT_INT_INT_WORD__BOOL "drag_motion" after object $ \ctxt x y time ->
+ handler ctxt (fromIntegral x, fromIntegral y) (fromIntegral time))
+
hunk ./gtk/Graphics/UI/Gtk/General/Enums.chs.pp 39
+ DestDefaults(..),
hunk ./gtk/Graphics/UI/Gtk/General/Enums.chs.pp 69
+ TargetFlags(..),
hunk ./gtk/Graphics/UI/Gtk/General/Enums.chs.pp 147
+-- | The 'DestDefaults' enumeration specifies the various types of action that
+-- will be taken on behalf of the user for a drag destination site.
+--
+-- * 'DestDefaultMotion': If set for a widget, GTK+, during a drag over this
+-- widget will check if the drag matches this widget's list of possible
+-- targets and actions. GTK+ will then call
+-- 'Graphics.UI.Gtk.Gdk.Drag.dragStatus' as appropriate.
+-- * 'DestDefaultHightlight': If set for a widget, GTK+ will draw a
+-- highlight on this widget as long as a drag is over this widget and the
+-- widget drag format and action are acceptable.
+-- * 'DestDefaultDrop': If set for a widget, when a drop occurs, GTK+ will
+-- will check if the drag matches this widget's list of possible targets and
+-- actions. If so, GTK+ will call 'Graphics.UI.Gtk.Gdk.Drag.dragGetData' on
+-- behalf of the widget. Whether or not the drop is successful, GTK+ will
+-- call 'Graphics.UI.Gtk.Gdk.Drag.dragFinish'. If the action was a move,
+-- then if the drag was successful, then @True@ will be passed for the
+-- delete parameter to 'Graphics.UI.Gtk.Gdk.Drag.dragFinish'
+-- * 'DestDefaultAll': If set, specifies that all default actions should be
+-- taken.
+--
+{#enum DestDefaults {underscoreToCase} deriving (Bounded,Eq)#}
+
+instance Flags DestDefaults
+
hunk ./gtk/Graphics/UI/Gtk/General/Enums.chs.pp 327
+-- | The 'TargetFlags' enumeration is used to specify constraints on an entry
+-- in a 'Graphics.UI.Gtk.Gdk.Selection.TargetList'. These flags are only
+-- used for drag and drop.
+--
+-- * If the 'TargetSameApp' flag is set, the target will only be selected for
+-- drags within a single application.
+--
+-- * If the 'TargetSameWidget' flag is set, the target will only be selected
+-- for drags within a single widget.
+--
+{#enum TargetFlags {underscoreToCase} deriving(Bounded) #}
+
+instance Flags TargetFlags
+
addfile ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp
hunk ./gtk/Graphics/UI/Gtk/General/Selection.chs.pp 1
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) Selection support
+--
+-- Author : Axel Simon
+--
+-- Created: 26 March 2007
+--
+-- Copyright (C) 2007 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.
+--
+-- functions that seem to be internal: gtk_selection_convert
+-- functions that relate to target tables are not bound since they seem
+-- superfluous: targets_*, selection_data_copy, selection_data_free
+--
+-- |
+-- Maintainer : gtk...@li...
+-- Stability : provisional
+-- Portability : portable (depends on GHC)
+--
+-- Functions for handling inter-process communication via selections.
+--
+module Graphics.UI.Gtk.General.Selection (
+
+-- * Types
+ InfoId,
+ TargetTag,
+ SelectionTag,
+ TargetList,
+ SelectionDataM,
+ [_$_]
+-- * Constructors
+ targetTagNew,
+ selectionTagNew,
+ targetListNew,
+ [_$_]
+-- * Methods
+#if GTK_CHECK_VERSION(2,6,0)
+ targetListAddTextTargets,
+ targetListAddImageTargets,
+ targetListAddUriTargets,
+#endif
+#if GTK_CHECK_VERSION(2,10,0)
+ targetListAddRichTextTargets,
+#endif
+ targetListRemove,
+
+ selectionAddTarget,
+ selectionClearTargets,
+ selectionOwnerSet,
+-- selectionOwnerSetForDisplay,
+ selectionRemoveAll,
+
+ selectionDataSet,
+ selectionDataGet,
+ selectionDataSetText,
+ selectionDataGetText,
+#if GTK_CHECK_VERSION(2,6,0)
+ selectionDataSetPixbuf,
+ selectionDataGetPixbuf,
+ selectionDataSetURIs,
+ selectionDataGetURIs,
+ selectionDataTargetsIncludeImage,
+#endif
+ selectionDataTargetsIncludeText,
+#if GTK_CHECK_VERSION(2,10,0)
+ selectionDataTargetsIncludeUri,
+ selectionDataTargetsIncludeRichText,
+#endif
+
+-- * Signals
+ selectionGet,
+ selectionReceived
+
+ ) where
+
+import System.Glib.FFI
+import System.Glib.Flags
+import System.Glib.Signals
+import System.Glib.GObject
+{#import Graphics.UI.Gtk.Types#}
+{#import Graphics.UI.Gtk.General.DNDTypes#}
+import Graphics.UI.Gtk.Gdk.Events (TimeStamp)
+import Graphics.UI.Gtk.General.Enums (TargetFlags)
+import Graphics.UI.Gtk.Signals
+import System.Glib.UTFString ( peekUTFString, withUTFString, withUTFStringLen,
+ withUTFStringArray0, peekUTFStringArray0 )
+import Control.Monad ( liftM )
+import Control.Monad.Trans ( liftIO )
+import Control.Monad.Reader (runReaderT, ask)
+
+{# context lib="gtk" prefix="gtk" #}
+
+
+--------------------
+-- Methods
+
+-- | Append anoter target to the given 'TargetList'.
+--
+-- * Note that the 'TargetFlags' are only used for drag and drop, not in normal
+-- selection handling.
+--
+targetListAdd :: TargetList -> TargetTag -> [TargetFlags] -> InfoId -> IO ()
+targetListAdd tl (TargetTag tagPtr) flags info = do
+ {#call unsafe target_list_add#} tl tagPtr (fromIntegral (fromFlags flags)) info
+
+#if GTK_CHECK_VERSION(2,6,0)
+
+-- | Append all text targets supported by the selection mechanism to the
+-- target list. All targets are added with the same 'InfoId'.
+--
+-- * Since Gtk 2.6.
+--
+targetListAddTextTargets :: TargetList -> InfoId -> IO ()
+targetListAddTextTargets = {#call unsafe target_list_add_text_targets#}
+
+-- | Append all image targets supported by the selection mechanism to the
+-- target list. All targets are added with the same 'InfoId'. If the boolean
+-- flag is set, only targets will be added which Gtk+ knows how to convert
+-- into a 'Graphics.UI.Gtk.Pixbuf.Pixbuf'.
+--
+-- * Since Gtk 2.6.
+--
+targetListAddImageTargets :: TargetList -> InfoId -> Bool -> IO ()
+targetListAddImageTargets tl info writable =
+ {#call unsafe target_list_add_image_targets#} tl info (fromBool writable)
+
+-- | Append all URI (universal resource indicator, fomerly URL) targets
+-- supported by the selection mechanism to the target list. All targets are
+-- added with the same 'InfoId'.
+--
+-- * Since Gtk 2.6.
+--
+targetListAddUriTargets :: TargetList -> InfoId -> IO ()
+targetListAddUriTargets = {#call unsafe target_list_add_uri_targets#}
+
+#endif
+#if GTK_CHECK_VERSION(2,10,0)
+
+-- | Append all rich text targets registered with
+-- 'Graphics.UI.Gtk.TextBuffer.textBufferRegisterSerializeFormat' to the
+-- target list. All targets are added with the same 'InfoId'. If the boolean
+-- flag is @True@ then serializable rich text formats will be added,
+-- serializable formats otherwise.
+--
+-- * Since Gtk 2.10.
+--
+targetListAddRichTextTargets :: TextBufferClass tb =>
+ TargetList -> InfoId -> Bool -> tb -> IO ()
+targetListAddRichTextTargets tl info deser tb =
+ {#call unsafe target_list_add_rich_text_targets#} tl info
+ (fromBool deser) (toTextBuffer tb)
+
+#endif
+
+-- | Remove a target from a target list.
+--
+targetListRemove :: TargetList -> TargetTag -> IO ()
+targetListRemove tl (TargetTag t)= {#call unsafe target_list_remove#} tl t
+
+
+-- %hash c:9971 d:af3f
+-- | Appends a specified target to the list of supported targets for a given
+-- widget and selection.
+--
+selectionAddTarget :: WidgetClass widget => widget -> SelectionTag ->
+ TargetTag -> InfoId -> IO ()
+selectionAddTarget widget (SelectionTag selection) (TargetTag target) info =
+ {#call unsafe gtk_selection_add_target #}
+ (toWidget widget)
+ selection
+ target
+ (fromIntegral info)
+
+-- %hash c:d523 d:af3f
+-- | Remove all targets registered for the given selection for the widget.
+--
+selectionClearTargets :: WidgetClass widget => widget -> SelectionTag -> IO ()
+selectionClearTargets widget (SelectionTag selection) =
+ {#call unsafe gtk_selection_clear_targets #}
+ (toWidget widget)
+ selection
+
+-- %hash c:85a8 d:af3f
+-- | Claims ownership of a given selection for a particular widget, or, if
+-- widget is 'Nothing', release ownership of the selection.
+--
+selectionOwnerSet :: WidgetClass widget => Maybe widget -> SelectionTag ->
+ TimeStamp -> IO Bool
+selectionOwnerSet widget (SelectionTag selection) time =
+ liftM toBool $
+ {#call unsafe gtk_selection_owner_set #}
+ (maybe (mkWidget nullForeignPtr) toWidget widget)
+ selection
+ (fromIntegral time)
+
+-- %hash c:174 d:af3f
+-- |
+--
+--selectionOwnerSetForDisplay :: WidgetClass widget => Display -> widget -> {-GdkAtom-} -> Word32 -> IO Bool
+--selectionOwnerSetForDisplay display widget selection time =
+-- liftM toBool $
+-- {#call unsafe gtk_selection_owner_set_for_display #}
+-- display
+-- (toWidget widget)
+-- {-selection-}
+-- (fromIntegral time)
+
+-- %hash c:c29 d:af3f
+-- | Removes all handlers and unsets ownership of all selections for a widget.
+-- Called when widget is being destroyed. This function will not generally be
+-- called by applications.
+--
+selectionRemoveAll :: WidgetClass widget => widget -> IO ()
+selectionRemoveAll widget =
+ {#call unsafe gtk_selection_remove_all #}
+ (toWidget widget)
+
+-- %hash c:7662 d:af3f
+-- | Stores new data in the 'SelectionDataM' monad. The stored data may only
+-- be an array of integer types that are no larger than 32 bits.
+--
+selectionDataSet :: (Integral a, Storable a) => SelectionTag -> [a] ->
+ SelectionDataM ()
+selectionDataSet (SelectionTag tagPtr) values@(~(v:_)) = ask >>= \selPtr ->
+ liftIO $ withArrayLen values $ \arrayLen arrayPtr ->
+ {#call unsafe gtk_selection_data_set #} selPtr tagPtr (fromIntegral (8*sizeOf v))
+ (castPtr arrayPtr) (fromIntegral arrayLen)
+
+-- | Retreives the data in the 'SelectionDataM' monad. The returned array
+-- must have elements of the size that were used to set this data. If
+-- the size does not match, @Nothing@ is returned.
+--
+selectionDataGet :: (Integral a, Storable a) => SelectionDataM (Maybe [a])
+selectionDataGet = do
+ selPtr <- ask
+ liftIO $ do
+ bitSize <- liftM fromIntegral $ {#get SelectionData -> format#} selPtr
+ lenUnits <- {#get SelectionData -> length#} selPtr
+ dataPtr <- liftM castPtr $ {#get SelectionData -> data#} selPtr
+ if lenUnits<0 || bitSize/=sizeOf (unsafePerformIO (peek dataPtr))*8
+ then return Nothing
+ else liftM Just $ do
+ peekArray (fromIntegral lenUnits) dataPtr
+ [_$_]
+-- %hash c:9bdf d:af3f
+-- | Sets the contents of the selection from a string. The
+-- string is converted to the form determined by the allowed targets of the
+-- selection.
+--
+-- * Returns @True@ if setting the text was successful.
+--
+selectionDataSetText :: String -> SelectionDataM Bool
+selectionDataSetText str = do
+ selPtr <- ask
+ liftM toBool $ liftIO $ withUTFStringLen str $ \(strPtr,len) ->
+ {#call unsafe gtk_selection_data_set_text #} selPtr strPtr (fromIntegral len)
+
+-- %hash c:90e0 d:af3f
+-- | Gets the contents of the selection data as a string.
+--
+selectionDataGetText :: SelectionDataM (Maybe String)
+selectionDataGetText = do
+ selPtr <- ask
+ liftIO $ do
+ strPtr <- {#call unsafe gtk_selection_data_get_text #} selPtr
+ if strPtr==nullPtr then return Nothing else do
+ str <- peekUTFString (castPtr strPtr)
+ {#call unsafe g_free#} (castPtr strPtr)
+ return (Just str)
+
+#if GTK_CHECK_VERSION(2,6,0)
+-- %hash c:ed8d d:af3f
+-- | Sets the contents of the selection from a 'Pixbuf'. The pixbuf is
+-- converted to the form determined by the allowed targets of the selection.
+--
+-- * Returns @True@ if setting the 'Pixbuf' was successful. Since Gtk 2.6.
+--
+selectionDataSetPixbuf :: Pixbuf -> SelectionDataM Bool
+selectionDataSetPixbuf pixbuf = do
+ selPtr <- ask
+ liftM toBool $ liftIO $
+ {#call unsafe gtk_selection_data_set_pixbuf #} selPtr pixbuf
+
+-- %hash c:52cd d:af3f
+-- | Gets the contents of the selection data as a 'Pixbuf'.
+--
+-- * Since Gtk 2.6.
+--
+selectionDataGetPixbuf :: SelectionDataM (Maybe Pixbuf)
+selectionDataGetPixbuf = do
+ selPtr <- ask
+ liftIO $ maybeNull (constructNewGObject mkPixbuf) $
+ {#call unsafe gtk_selection_data_get_pixbuf #} selPtr
+
+-- %hash c:d222 d:af3f
+-- | Sets the contents of the selection from a list of URIs. The string is
+-- converted to the form determined by the possible targets of the selection.
+--
+-- * Returns @True@ if setting the URIs was successful. Since Gtk 2.6.
+--
+selectionDataSetURIs :: [String] -> SelectionDataM Bool
+selectionDataSetURIs uris = do
+ selPtr <- ask
+ liftIO $ liftM toBool $ withUTFStringArray0 uris $ \strPtrPtr ->
+ {#call unsafe gtk_selection_data_set_uris #} selPtr strPtrPtr
+ [_$_]
+-- %hash c:472f d:af3f
+-- | Gets the contents of the selection data as list of URIs. Returns
+-- @Nothing@ if the selection did not contain any URIs.
+--
+-- * Since Gtk 2.6.
+--
+selectionDataGetURIs :: SelectionDataM (Maybe [String])
+selectionDataGetURIs = do
+ selPtr <- ask
+ liftIO $ do
+ strPtrPtr <- {#call unsafe gtk_selection_data_get_uris #} selPtr
+ if strPtrPtr==nullPtr then return Nothing else do
+ uris <- peekUTFStringArray0 strPtrPtr
+ {#call unsafe g_strfreev#} strPtrPtr
+ return (Just uris)
+#endif
+
+-- %hash c:e659 d:af3f
+-- | Queries the content type of the selection by extracting the targets that
+-- the contained data can be converted into.
+--
+selectionDataGetTargets :: SelectionDataM [TargetTag]
+selectionDataGetTargets = do
+ selPtr <- ask
+ liftIO $ alloca $ \nAtomsPtr -> alloca $ \targetPtrPtr -> do
+ valid <- liftM toBool $ [_$_]
+ {#call unsafe gtk_selection_data_get_targets #} selPtr targetPtrPtr nAtomsPtr
+ if not valid then return [] else do
+ len <- peek nAtomsPtr
+ targetPtr <- peek targetPtrPtr
+ targetPtrs <- peekArray (fromIntegral len) targetPtr
+ {#call unsafe g_free#} (castPtr targetPtr)
+ return (map TargetTag targetPtrs)
+ [_$_]
+#if GTK_CHECK_VERSION(2,6,0)
+-- %hash c:5a8 d:af3f
+-- | Given a 'SelectionDataM' holding a list of targets, determines if any of
+-- the targets in targets can be used to provide a 'Pixbuf'.
+--
+-- * Since Gtk 2.6
+--
+selectionDataTargetsIncludeImage ::
+ Bool -- ^ whether to accept only targets for which GTK+ knows how to convert a
+ -- pixbuf into the format
+ -> SelectionDataM Bool
+selectionDataTargetsIncludeImage writable = do
+ selPtr <- ask
+ liftM toBool $ liftIO $
+ {#call unsafe gtk_selection_data_targets_include_image #}
+ selPtr
+ (fromBool writable)
+#endif [_$_]
+
+-- %hash c:abe8 d:af3f
+-- | Given a 'SelectionDataM' holding a list of targets, determines if any of
+-- the targets in targets can be used to provide text.
+--
+selectionDataTargetsIncludeText :: SelectionDataM Bool
+selectionDataTargetsIncludeText = do
+ selPtr <- ask
+ liftM toBool $ liftIO $
+ {#call unsafe gtk_selection_data_targets_include_text #}
+ selPtr
+
+#if GTK_CHECK_VERSION(2,10,0)
+-- | Given a 'SelectionDataM' holding a list of targets, determines if any of
+-- the targets in targets can be used to provide URIs.
+--
+-- * Since Gtk 2.10
+--
+selectionDataTargetsIncludeUri :: SelectionDataM Bool
+selectionDataTargetsIncludeUri = do
+ selPtr <- ask
+ liftM toBool $ liftIO $
+ {#call unsafe gtk_selection_data_targets_include_uri #}
+ selPtr
+
+-- | Given a 'SelectionDataM' holding a list of targets, check if,
+-- well, dunno really. FIXME: what does the 'TextBuffer' do?
+--
+-- * Since Gtk 2.10
+--
+selectionDataTargetsIncludeRichText :: TextBufferClass tb => tb ->
+ SelectionDataM Bool
+selectionDataTargetsIncludeRichText tb = do
+ selPtr <- ask
+ liftM toBool $ liftIO $
+ {#call unsafe gtk_selection_data_targets_include_rich_text #}
+ selPtr (toTextBuffer tb)
+#endif
+
+--------------------
+-- Signals
+
+-- %hash c:f7c3 d:af3f
+-- | Pass the supplied selection data to the application. The application is
+-- expected to read the data using 'selectionDataGet' or one of its
+-- derivatives.
+--
+selectionReceived :: WidgetClass self => Signal self (TimeStamp -> SelectionDataM ())
+selectionReceived = Signal (\after object handler -> do
+ connect_PTR_WORD__NONE "selection_received" after object $ \dataPtr time -> do
+ runReaderT (handler (fromIntegral time)) dataPtr >> return ())
+
+-- %hash c:c3 d:af3f
+-- | Emitted in order to ask the application for selection data. Within the
+-- handler the function 'selectionDataSet' or one of its derivatives should be
+-- called.
+--
+selectionGet :: WidgetClass self =>
+ Signal self (InfoId -> TimeStamp -> SelectionDataM ())
+selectionGet = Signal (\after object handler -> do
+ connect_PTR_WORD_WORD__NONE "selection_get" after object $
+ \dataPtr info time -> do
+ runReaderT (handler (fromIntegral info) (fromIntegral time)) dataPtr >> [_$_]
+ return ())
hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 89
+ dragContextGetActions,
+ dragContextSetActions,
+ dragContextGetSuggestedAction,
+ dragContextSetSuggestedAction,
+ dragContextGetAction,
+ dragContextSetAction
hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 916
+dragContextGetActions :: DragContext -> IO Int
+dragContextGetActions dc = liftM (fromIntegral :: #{type int} -> Int) $
+ withForeignPtr (unDragContext dc) #{peek GdkDragContext, actions}
+
+dragContextSetActions :: DragContext -> Int -> IO ()
+dragContextSetActions dc val = withForeignPtr (unDragContext dc) $ \ptr ->
+ #{poke GdkDragContext, actions} ptr (fromIntegral val :: #{type int})
+
+dragContextGetAction :: DragContext -> IO Int
+dragContextGetAction dc = liftM (fromIntegral :: #{type int} -> Int) $
+ withForeignPtr (unDragContext dc) #{peek GdkDragContext, action}
+
+dragContextSetAction :: DragContext -> Int -> IO ()
+dragContextSetAction dc val = withForeignPtr (unDragContext dc) $ \ptr ->
+ #{poke GdkDragContext, action} ptr (fromIntegral val :: #{type int})
+
+dragContextGetSuggestedAction :: DragContext -> IO Int
+dragContextGetSuggestedAction dc = liftM (fromIntegral :: #{type int} -> Int) $
+ withForeignPtr (unDragContext dc) #{peek GdkDragContext, suggested_action}
+
+dragContextSetSuggestedAction :: DragContext -> Int -> IO ()
+dragContextSetSuggestedAction dc val = withForeignPtr (unDragContext dc) $ \ptr ->
+ #{poke GdkDragContext, suggested_action} ptr (fromIntegral val :: #{type int})
+
hunk ./tools/callbackGen/gtkmarshal.list 89
-#VOID:POINTER,UINT
+VOID:POINTER,UINT
hunk ./tools/callbackGen/gtkmarshal.list 114
+# For SelectionData
+VOID:POINTER,UINT,UINT
+VOID:OBJECT,POINTER,UINT,UINT
+VOID:OBJECT,INT,INT,POINTER,UINT,UINT
+BOOLEAN:OBJECT,INT,INT,UINT
+VOID:OBJECT,UINT
+BOOLEAN:OBJECT,INT,INT,UINT
{
hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 1
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) Type declarations for DND and Selections
+--
+-- Author : Axel Simon
+--
+-- Created: 11 April 2007
+--
+-- Copyright (C) 2007 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.
+--
+-- functions that seem to be internal: gtk_selection_convert
+-- functions that relate to target tables are not bound since they seem
+-- superfluous
+--
+-- Type declarations for DND and Selections
+-- #hide
+module Graphics.UI.Gtk.General.DNDTypes (
hunk ./gtk/Graphics/UI/Gtk/General/DNDTypes.chs 28
+-- * Types
+ InfoId,
+ TargetTag(TargetTag),
+ SelectionTag(SelectionTag),
+ TargetList(TargetList),
+ SelectionData,
+ SelectionDataM,
+ [_$_]
+-- * Constructors
+ targetTagNew,
+ selectionTagNew,
+ targetListNew,
+ mkTargetList [_$_]
+ ) where
+
+import Monad (liftM)
+
+import System.Glib.FFI
+import System.Glib.Flags
+{#import Graphics.UI.Gtk.Types#}
+import System.Glib.UTFString ( peekUTFString, withUTFString )
+import Control.Monad ( liftM )
+import Control.Monad.Reader ( ReaderT )
+
+{# context lib="gtk" prefix="gtk" #}
+
+-- | A number that the application can use to differentiate between different
+-- data types or application states.
+type InfoId = {#type guint#}
+
+-- | A tag that uniquely identifies a target.
+newtype TargetTag = TargetTag (Ptr ()) deriving Eq
+
+instance Show TargetTag where
+ show (TargetTag ptr) = atomToString ptr
+
+-- | A tag that uniquely identifies a selection.
+newtype SelectionTag = SelectionTag (Ptr ()) deriving Eq
+
+instance Show SelectionTag where
+ show (SelectionTag ptr) = atomToString ptr
+
+atomToString ptr = unsafePerformIO $ do
+ strPtr <- {#call unsafe gdk_atom_name#} ptr
+ str <- peekUTFString strPtr
+ {#call unsafe g_free#} (castPtr strPtr)
+ return str
+
+-- | A 'TargetList' contains information about all possible formats
+-- (represented as 'TargetTag') that a widget can create or receive in form of
+-- a selection.
+--
+{#pointer *GtkTargetList as TargetList foreign newtype#}
+
+--------------------
+-- Constructors
+
+
+-- | Create a new 'TargetTag'. Note that creating two target tags with the
+-- same name will yield two different tags. The name is merely meant to
+-- ease application development.
+--
+targetTagNew :: String -> IO TargetTag
+targetTagNew name = withUTFString name $ \strPtr ->
+ liftM TargetTag $ {#call unsafe gdk_atom_intern#} strPtr 0
+
+-- | Create a new 'SelectionTag'. Note that creating two selection tags with the
+-- same name will yield two different tags. The name is merely meant to
+-- ease application development.
+--
+selectionTagNew :: String -> IO SelectionTag
+selectionTagNew name = withUTFString name $ \strPtr ->
+ liftM SelectionTag $ {#call unsafe gdk_atom_intern#} strPtr 0
+
+-- | Create a new, empty 'TargetList'.
+--
+targetListNew :: IO TargetList
+targetListNew = do
+ tlPtr <- {#call unsafe target_list_new#} nullPtr 0
+ liftM TargetList $ newForeignPtr tlPtr target_list_unref
+
+foreign import ccall unsafe ">k_target_list_unref"
+ target_list_unref :: FinalizerPtr TargetList
+
+-- Wrap a 'TargetList' pointer.
+mkTargetList :: Ptr TargetList -> IO TargetList
+mkTargetList tlPtr = do
+ tl <- liftM TargetList $ newForeignPtr tlPtr target_list_unref
+ {#call unsafe target_list_ref#} tl
+ return tl
+
+-- | A pointer to selection data.
+{#pointer *SelectionData #}
+
+-- | A monad providing access to selection data.
+--
+type SelectionDataM a = ReaderT (Ptr ()) IO a
}
|
|
From: Axel S. <A....@ke...> - 2007-04-19 09:22:22
|
Wed Mar 14 08:26:26 PDT 2007 A....@ke...
* Make constructor safe since it may trigger a signal on the given Adjustment.
hunk ./gtk/Graphics/UI/Gtk/Entry/SpinButton.chs 139
- {# call unsafe spin_button_new #}
+ {# call spin_button_new #}
|
|
From: Axel S. <A....@ke...> - 2007-04-19 09:22:22
|
Wed Mar 14 07:18:33 PDT 2007 A....@ke...
* Fix swapped fields in FontMetrics.
hunk ./gtk/Graphics/UI/Gtk/Pango/Context.chs.pp 126
- (intToPu underline_position)
hunk ./gtk/Graphics/UI/Gtk/Pango/Context.chs.pp 127
- (intToPu strikethrough_position)
+ (intToPu underline_position)
hunk ./gtk/Graphics/UI/Gtk/Pango/Context.chs.pp 129
+ (intToPu strikethrough_position)
|
|
From: Duncan C. <dun...@wo...> - 2007-04-18 10:07:06
|
Wed Apr 18 03:05:39 PDT 2007 Duncan Coutts <du...@co...>
* Remove literal tab char from string literal
GHC HEAD was recently fixed to follow the H98 spec in this regard.
hunk ./tools/callbackGen/HookGenerator.hs 433
- " <outFile> is the name and path of the output file.\n"++
+ " <outFile> is the name and path of the output file.\n"++
|
|
From: Axel S. <A....@ke...> - 2007-04-10 15:30:02
|
Tue Apr 10 08:27:07 PDT 2007 A....@ke...
* Handle the leave event correctly.
hunk ./gtk/Graphics/UI/Gtk/Gdk/Events.hsc 148
--- ** The 'eventSent' attribute is @True@ if the event was not created by the
+-- * The 'eventSent' attribute is @True@ if the event was not created by the
hunk ./gtk/Graphics/UI/Gtk/Gdk/Events.hsc 151
--- ** The 'eventTime' attribute contains a time in milliseconds when the event
+-- * The 'eventTime' attribute contains a time in milliseconds when the event
hunk ./gtk/Graphics/UI/Gtk/Gdk/Events.hsc 154
--- ** The 'eventX' and 'eventY' attributes contain the coordinates relative
+-- * The 'eventX' and 'eventY' attributes contain the coordinates relative
hunk ./gtk/Graphics/UI/Gtk/Gdk/Events.hsc 159
--- ** The 'eventModifier' attribute denotes what modifier key was pressed
+-- * The 'eventModifier' attribute denotes what modifier key was pressed
hunk ./gtk/Graphics/UI/Gtk/Gdk/Events.hsc 289
+ -- | This flag is false if the widget was entered, it is true when the
+ -- widget the mouse cursor left the widget.
+ eventLeaves :: Bool,
hunk ./gtk/Graphics/UI/Gtk/Gdk/Events.hsc 380
- #{const GDK_ENTER_NOTIFY} -> marshCrossing
+ #{const GDK_ENTER_NOTIFY} -> marshCrossing False
+ #{const GDK_LEAVE_NOTIFY} -> marshCrossing True
hunk ./gtk/Graphics/UI/Gtk/Gdk/Events.hsc 487
-marshCrossing ptr = do
+marshCrossing leave ptr = do
hunk ./gtk/Graphics/UI/Gtk/Gdk/Events.hsc 507
+ eventLeaves = leave,
|
|
From: Duncan C. <dun...@wo...> - 2007-03-30 00:49:26
|
Thu Mar 29 17:11:20 PDT 2007 Duncan Coutts <du...@co...>
* Add a few TODO items
hunk ./TODO 2
+
+30/3/2007 Duncan Coutts <du...@co...>
+
+ * make the codegen work from .def files rather than the gtk# xml files
+
+ * make the codegen generate enum bindings (but not structs yet) and
+ have them get put in the appropriate module if they're only used in
+ that module. Also make them all instances of Eq, and Show, and
+ in some cases also bounded.
+
+24/1/2007 Duncan Coutts <du...@co...>
+
+ * eliminate checkGErrorWithCont, it's ugly
+
+ * Make sure the dirlist demo works on win32.
+
+ * make SOE give an error in GHCi since it uses threads.
+
+15/10/2006 Duncan Coutts <du...@co...>
+
+ * Add a mechanism to the code generator to add exceptions for when
+ to use constructNewObject vs makeNewGObject in non-constructors.
|
|
From: Duncan C. <dun...@wo...> - 2007-03-24 03:30:42
|
Fri Mar 23 20:26:35 PDT 2007 Duncan Coutts <du...@co...>
* Remove duplicate instance
We had instance TreeModelClass TreeModelSort in both the old and new
imlementations. This caused overlapping instances for users since they
can't hide the instance from the old impl. So comment out in the instance
in the new impl for now.
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModelSort.chs.pp 84
-instance TreeModelClass TreeModelSort
+--instance TreeModelClass TreeModelSort
+--TODO: this is only commented out because the old version also defines this
+-- instance. When we delete the old api, re-enable this instance. (That is
+-- if we keep this module at all)
|
2 messages has been excluded from this view by a project administrator.
