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: Axel S. <si...@co...> - 2009-07-23 19:55:31
|
Sun Jul 19 05:36:02 EDT 2009 Hamish Mackenzie <ha...@fi...>
* Jhbuild modules file for use on OSX
Ignore-this: 19f10ea07de49ab9fae269c0a1fcd899
adddir ./tools/osx
addfile ./tools/osx/gtk2hs-osx.modules
hunk ./tools/osx/gtk2hs-osx.modules 1
+<?xml version="1.0"?>
+<!DOCTYPE moduleset SYSTEM "moduleset.dtd">
+<?xml-stylesheet type="text/xsl" href="moduleset.xsl"?>
+<moduleset>
+ <include href="gtk-osx.modules"/>
+
+ <repository type="tarball" name="sourceforge" default="yes" href="http://downloads.sourceforge.net/gtk2hs/"/>
+
+ <autotools id="gtk2hs-osx" autogen-sh="configure" autogenargs="--disable-deprecated-packages --enable-profiling --enable-packager-mode --with-pkgreg --enable-gtk --enable-gio --enable-libglade --enable-gtksourceview2 --enable-cairo CFLAGS='-O2 -std=gnu89'">
+ <branch module="gtk2hs-0.10.1.tar.gz" version="0.10.1" repo="sourceforge" />
+ <dependencies>
+ <dep package="cairo"/>
+ <dep package="glib"/>
+ <dep package="pango"/>
+ <dep package="gtk+"/>
+ <dep package="gtksourceview"/>
+ </dependencies>
+ </autotools>
+
+</moduleset>
|
|
From: Axel S. <si...@co...> - 2009-06-11 07:46:04
|
Thu Jun 11 03:42:38 EDT 2009 Axel Simon <Axe...@en...>
* Add a comment to Notebook's setCurrentPage function.
hunk ./gtk/Graphics/UI/Gtk/Layout/Notebook.chs.pp 493
--- | Switches to the page number @pageNum@.
+-- | Switches to the page number @pageNum@. Page numbers start from @0@.
+-- Use @-1@ to request the last page.
+--
+-- * Note that due to historical reasons, GtkNotebook refuses
+-- to switch to a page unless the child widget is visible. [_$_]
+-- Therefore, it is recommended to show child widgets before
+-- adding them to a notebook.
|
|
From: Peter g. <pg...@co...> - 2009-05-10 18:08:23
|
Sun May 10 14:06:14 EDT 2009 pg...@gm...
* Makefile.am: remove slashes after DESTDIR (fixes trac #1160)
Ignore-this: 5c57aa6375618d627e7568303a36abdd
hunk ./Makefile.am 3025
- > $(DESTDIR)/$(pkglibdir)/$(notdir $(call getVar,$(pkgname),CONFIG)).tmp; \
- mv $(DESTDIR)/$(pkglibdir)/$(notdir $(call getVar,$(pkgname),CONFIG)){.tmp,} ; \
+ > $(DESTDIR)$(pkglibdir)/$(notdir $(call getVar,$(pkgname),CONFIG)).tmp; \
+ mv $(DESTDIR)$(pkglibdir)/$(notdir $(call getVar,$(pkgname),CONFIG)){.tmp,} ; \
hunk ./Makefile.am 3029
- > $(DESTDIR)/$(pkglibdir)/$(notdir $(patsubst %.package.conf,%.cabal,$(call getVar,$(pkgname),CONFIG))).tmp; \
- mv $(DESTDIR)/$(pkglibdir)/$(notdir $(patsubst %.package.conf,%.cabal,$(call getVar,$(pkgname),CONFIG))){.tmp,};)
+ > $(DESTDIR)$(pkglibdir)/$(notdir $(patsubst %.package.conf,%.cabal,$(call getVar,$(pkgname),CONFIG))).tmp; \
+ mv $(DESTDIR)$(pkglibdir)/$(notdir $(patsubst %.package.conf,%.cabal,$(call getVar,$(pkgname),CONFIG))){.tmp,};)
hunk ./Makefile.am 3047
- $(DESTDIR)/$(pkglibdir)/$(notdir $(call getVar,$(pkgname),CONFIG)) \
+ $(DESTDIR)$(pkglibdir)/$(notdir $(call getVar,$(pkgname),CONFIG)) \
|
|
From: Peter g. <pg...@co...> - 2009-05-10 18:08:21
|
Sun May 10 12:02:14 EDT 2009 pg...@gm... tagged 0.10.1 |
|
From: Peter g. <pg...@co...> - 2009-05-10 18:08:17
|
Tue Apr 28 23:21:10 EDT 2009 pg...@gm...
* configure.ac: bump version to 0.10.1
Ignore-this: 682c3f529251a07b3de0761729af5eeb
hunk ./configure.ac 25
-AC_INIT([gtk2hs],[0.10.0])
+AC_INIT([gtk2hs],[0.10.1])
|
|
From: Axel S. <si...@co...> - 2009-05-09 18:49:57
|
Thu Apr 30 11:21:24 EDT 2009 m....@gm...
* Bind GtkObject's destroy signal
Ignore-this: b67612a0e13a5cabc2c3392cb78fadaf
hunk ./demo/carsim/CarSim.hs 252
- on mainWindow destroyEvent $
- liftIO $ mainQuit >> return True
+ on mainWindow objectDestroy mainQuit
hunk ./demo/pango/Layout.hs 3
+import Graphics.UI.Gtk.Gdk.EventM
hunk ./demo/pango/Layout.hs 19
- win `onDestroy` mainQuit
+ on win objectDestroy mainQuit
hunk ./demo/pango/Layout.hs 23
- area `onSizeRequest` return (Requisition 100 100)
+ on area sizeRequest $ return (Requisition 100 100)
hunk ./demo/pango/Layout.hs 32
- area `onSizeAllocate` \(Rectangle _ _ w _) -> do
+ on area sizeAllocate $ \(Rectangle _ _ w _) -> do
hunk ./demo/pango/Layout.hs 36
- area `onExpose` updateArea area lay
+ on area exposeEvent $ updateArea area lay
hunk ./demo/pango/Layout.hs 42
-updateArea :: DrawingArea -> PangoLayout -> Event -> IO Bool
-updateArea area lay Expose {} = do
- win <- widgetGetDrawWindow area
+updateArea :: DrawingArea -> PangoLayout -> EventM EExpose Bool
+updateArea area lay = do
+ win <- eventWindow
+ liftIO $ do
hunk ./gtk/Graphics/UI/Gtk/Abstract/Object.chs.pp 62
+
+-- * Signals
+ objectDestroy
hunk ./gtk/Graphics/UI/Gtk/Abstract/Object.chs.pp 77
+{#import Graphics.UI.Gtk.Signals#}
hunk ./gtk/Graphics/UI/Gtk/Abstract/Object.chs.pp 117
+
+
+--------------------
+-- Signals
+
+-- | Signals that all holders of a reference to the 'Object' should release
+-- the reference that they hold. May result in finalization of the object if
+-- all references are released.
+--
+objectDestroy :: ObjectClass self => Signal self (IO ())
+objectDestroy = Signal (connect_NONE__NONE "destroy")
|
|
From: Axel S. <si...@co...> - 2009-05-09 18:46:57
|
Sat May 9 14:44:14 EDT 2009 Axe...@en...
* Add missing export of Click(..) data type, repoted by Ben Franksen.
hunk ./gtk/Graphics/UI/Gtk/Gdk/EventM.hsc 130
+ Click(..),
|
|
From: Axel S. <si...@co...> - 2009-05-09 18:46:50
|
Mon May 4 15:13:02 EDT 2009 m....@gm...
* Input method bindings
Ignore-this: e8cbd55f0519ab413b24cae7b99d7b3d
hunk ./Makefile.am 626
+ gtk/Graphics/UI/Gtk/Abstract/IMContext.chs \
hunk ./Makefile.am 702
+ gtk/Graphics/UI/Gtk/Misc/IMMulticontext.chs.pp \
adddir ./demo/inputmethod
addfile ./demo/inputmethod/Layout.hs
hunk ./demo/inputmethod/Layout.hs 1
+-- Example of using a PangoLayout
+
+import Data.IORef
+
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.Gdk.EventM
+import Graphics.Rendering.Cairo
+
+loremIpsum = "Lorem ipsum dolor sit amet, consectetur adipisicing elit,\
+ \ sed do eiusmod tempor incididunt ut labore et dolore magna\
+ \ aliqua. Ut enim ad minim veniam, quis nostrud exercitation\
+ \ ullamco laboris nisi ut aliquip ex ea commodo consequat.\
+ \ Duis aute irure dolor in reprehenderit in voluptate\
+ \ velit esse cillum dolore eu fugiat nulla pariatur.\
+ \ Excepteur sint occaecat cupidatat non proident, sunt in culpa\
+ \ qui officia deserunt mollit anim id est laborum."
+
+data Buffer = Buffer String Int
+
+defaultBuffer = Buffer loremIpsum (length loremIpsum)
+
+displayBuffer (Buffer str pos) =
+ before ++ "<CURSOR>" ++ after
+ where (before,after) = splitAt pos str
+
+displayBufferPreedit (Buffer str pos) preeditStr preeditPos =
+ before ++ "[" ++ prebefore ++ "<CURSOR>" ++ preafter ++ "]" ++ after
+ where (before,after) = splitAt pos str
+ (prebefore, preafter) = splitAt preeditPos preeditStr
+
+insertStr new (Buffer str pos) = Buffer (before++new++after) (pos+length new)
+ where (before,after) = splitAt pos str
+
+deleteChar b@(Buffer str 0) = b
+deleteChar (Buffer str pos) = Buffer (init before ++ after) (pos-1)
+ where (before,after) = splitAt pos str
+
+moveLeft b@(Buffer str pos) | pos==0 = b
+ | otherwise = Buffer str (pos-1)
+
+moveRight b@(Buffer str pos) | pos==length str = b
+ | otherwise = Buffer str (pos+1)
+
+main = do
+ initGUI
+ [_$_]
+ -- Create the main window.
+ win <- windowNew
+ on win objectDestroy mainQuit
+ -- Create a drawing area in which we can render text.
+ area <- drawingAreaNew
+ containerAdd win area
+ on area sizeRequest $ return (Requisition 100 100)
+ [_$_]
+ -- Our widget's data
+ buffer <- newIORef defaultBuffer
+
+ preeditRef <- newIORef Nothing
+ [_$_]
+ -- Create a Cairo Context that contains information about the current font,
+ -- etc.
+ ctxt <- cairoCreateContext Nothing
+ lay <- layoutEmpty ctxt
+ layoutSetWrap lay WrapWholeWords
+ [_$_]
+ let relayout = do
+ buffer@(Buffer _ cursor) <- readIORef buffer
+ preedit <- readIORef preeditRef
+ case preedit of
+ Nothing -> do
+ layoutSetText lay (displayBuffer buffer)
+ layoutSetAttributes lay []
+ Just (str,attrs,pos) -> do
+ layoutSetText lay (displayBufferPreedit buffer str pos)
+ layoutSetAttributes lay (map (shiftAttribute (cursor + 1))
+ (concat attrs))
+ widgetQueueDraw area
+ [_$_]
+ relayout
+ [_$_]
+ -- Wrap the layout to a different width each time the window is resized.
+ on area sizeAllocate $ \(Rectangle _ _ w _) ->
+ layoutSetWidth lay (Just (fromIntegral w))
+ [_$_]
+ -- Setup the handler to draw the layout.
+ on area exposeEvent $ updateArea area lay
+ [_$_]
+ -- Set up input method
+ im <- imMulticontextNew
+ [_$_]
+ on im imContextPreeditStart $ do
+ writeIORef preeditRef (Just ("",[],0))
+ relayout
+ on im imContextPreeditEnd $ do
+ writeIORef preeditRef Nothing
+ relayout
+ on im imContextPreeditChanged $ do
+ writeIORef preeditRef . Just =<< imContextGetPreeditString im
+ relayout
+ on im imContextCommit $ \str -> do
+ modifyIORef buffer (insertStr str)
+ relayout
+ on im imContextRetrieveSurrounding $ do
+ Buffer text pos <- readIORef buffer
+ imContextSetSurrounding im text pos
+ return True
+ on im imContextDeleteSurrounding' $ \off nchars -> do
+ putStrLn $ "delete-surrounding("++show off++","++show nchars++")"
+ return False
+ [_$_]
+ on win realize $ do
+ imContextSetClientWindow im . Just =<< widgetGetDrawWindow win
+ on win focusInEvent $ liftIO (imContextFocusIn im) >> return False
+ on win focusOutEvent $ liftIO (imContextFocusOut im) >> return False
+ on win keyReleaseEvent $ imContextFilterKeypress im
+ on win keyPressEvent $ do
+ imHandled <- imContextFilterKeypress im
+ if imHandled then return True else do
+ mod <- interpretKeyPress
+ case mod of
+ Just f -> liftIO $ modifyIORef buffer f >> relayout >> return True
+ Nothing -> return False
+ [_$_]
+ widgetShowAll win
+ mainGUI
+
+updateArea :: DrawingArea -> PangoLayout -> EventM EExpose Bool
+updateArea area lay = do
+ win <- eventWindow
+ liftIO $ do
+ renderWithDrawable win $ do
+ moveTo 0 0
+ showLayout lay
+
+ return True
+
+interpretKeyPress :: EventM EKey (Maybe (Buffer -> Buffer))
+interpretKeyPress = do
+ modifiers <- eventModifier
+ if modifiers /= [] then return Nothing else do
+ keyName <- eventKeyName
+ keyChar <- fmap keyToChar eventKeyVal
+ case keyChar of
+ Just ch -> do
+ -- This does not appear to get called; the IM handles
+ -- unmodified keypresses.
+ liftIO $ putStrLn "Literal character not handled by IM"
+ returnJust (insertStr [ch])
+ Nothing -> do
+ case keyName of
+ "Left" -> returnJust moveLeft
+ "Right" -> returnJust moveRight
+ "BackSpace" -> returnJust deleteChar
+ _ -> return Nothing
+ where returnJust = return . Just
+
+shiftAttribute :: Int -> PangoAttribute -> PangoAttribute
+shiftAttribute x attr = attr { paStart = x + paStart attr,
+ paEnd = x + paEnd attr }
addfile ./demo/inputmethod/Makefile
hunk ./demo/inputmethod/Makefile 1
+
+PROG = layout [_$_]
+SOURCES = Layout.hs
+
+$(PROG) : $(SOURCES)
+ $(HC) --make $< -o $@ $(HCFLAGS)
+
+clean:
+ rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG)
+
+HC=ghc
hunk ./gtk/Graphics/UI/Gtk.hs.pp 192
--- module IMContext,
--- module IMMulticontext,
+ module Graphics.UI.Gtk.Misc.IMMulticontext,
hunk ./gtk/Graphics/UI/Gtk.hs.pp 202
+ module Graphics.UI.Gtk.Abstract.IMContext,
hunk ./gtk/Graphics/UI/Gtk.hs.pp 385
---import IMContext
---import IMContextSimple
---import IMMulitcontext
+import Graphics.UI.Gtk.Misc.IMMulticontext
hunk ./gtk/Graphics/UI/Gtk.hs.pp 396
+import Graphics.UI.Gtk.Abstract.IMContext
addfile ./gtk/Graphics/UI/Gtk/Abstract/IMContext.chs.pp
hunk ./gtk/Graphics/UI/Gtk/Abstract/IMContext.chs.pp 1
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) Widget IMContext
+--
+-- Author : Colin McQuillan
+--
+-- Created: 30 April 2009
+--
+-- Copyright (C) 2009 Colin McQuillan
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU Lesser General Public
+-- License as published by the Free Software Foundation; either
+-- version 2.1 of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- Lesser General Public License for more details.
+--
+-- |
+-- Maintainer : gtk...@li...
+-- Stability : provisional
+-- Portability : portable (depends on GHC)
+--
+-- Base class for input method contexts
+--
+module Graphics.UI.Gtk.Abstract.IMContext (
+
+-- * Class Hierarchy
+--
+-- |
+-- @
+-- | 'GObject'
+-- | +----IMContext
+-- | +----'IMContextSimple'
+-- | +----'IMMulticontext'
+-- @
+
+-- * Types
+ IMContext,
+ IMContextClass,
+ castToIMContext,
+ toIMContext,
+
+-- * Methods
+ imContextSetClientWindow,
+ imContextGetPreeditString,
+ imContextFilterKeypress,
+ imContextFocusIn,
+ imContextFocusOut,
+ imContextReset,
+ imContextSetCursorLocation,
+ imContextSetUsePreedit,
+ imContextSetSurrounding,
+ imContextGetSurrounding,
+ imContextDeleteSurrounding,
+
+-- * Signals
+ imContextPreeditStart,
+ imContextPreeditEnd,
+ imContextPreeditChanged,
+ imContextCommit,
+ imContextRetrieveSurrounding,
+ imContextDeleteSurrounding',
+ ) where
+
+import Control.Monad (liftM)
+import Control.Monad.Reader.Class (ask)
+import Control.Monad.Trans (liftIO)
+import Data.Maybe (fromMaybe)
+
+import System.Glib.FFI
+import System.Glib.UTFString (readUTFString, withUTFString, genUTFOfs,
+ ofsToUTF, ofsFromUTF)
+{#import Graphics.UI.Gtk.Types#}
+{#import Graphics.UI.Gtk.Signals#}
+import Graphics.UI.Gtk.Gdk.EventM (EventM, EKey)
+import Graphics.UI.Gtk.General.Structs (Rectangle)
+import Graphics.UI.Gtk.Pango.Types (PangoAttribute)
+import Graphics.UI.Gtk.Pango.Attributes (readAttrList)
+
+{# context lib="gtk" prefix="gtk" #}
+
+--------------------
+-- Methods
+
+-- | Set the client window for the input context; this is the 'DrawWindow' in
+-- which the input appears. This window is used in order to correctly position
+-- status windows, and may also be used for purposes internal to the input
+-- method.
+--
+imContextSetClientWindow :: IMContextClass self => self
+ -> Maybe DrawWindow -- ^ @window@ - the client window. 'Nothing' indicates
+ -- that the previous client window no longer exists.
+ -> IO ()
+imContextSetClientWindow self window =
+ {# call im_context_set_client_window #}
+ (toIMContext self)
+ (fromMaybe (mkDrawWindow nullForeignPtr) window)
+
+-- | Retrieve the current preedit string for the input context, and a list of
+-- attributes to apply to the string. This string should be displayed inserted
+-- at the insertion point.
+--
+imContextGetPreeditString :: IMContextClass self => self
+ -> IO (String, [[PangoAttribute]], Int)
+ -- ^ @(str, attrs, cursorPos)@ Retrieved string,
+ -- attributes to apply to the string, position of cursor.
+imContextGetPreeditString self =
+ alloca $ \strPtr ->
+ alloca $ \attrListPtr ->
+ alloca $ \cursorPosPtr ->
+ {# call im_context_get_preedit_string #}
+ (toIMContext self)
+ strPtr
+ attrListPtr
+ cursorPosPtr
+ >>
+ peek strPtr >>= readUTFString >>= \str ->
+ peek attrListPtr >>= readAttrList (genUTFOfs str) >>= \attrs ->
+ peek cursorPosPtr >>= \cursorPos ->
+ return (str, attrs, fromIntegral cursorPos)
+
+-- | Allow an input method to internally handle key press and release events.
+-- If this function returns @True@, then no further processing should be done
+-- for this key event.
+--
+imContextFilterKeypress :: IMContextClass self => self
+ -> EventM EKey Bool -- ^ returns @True@ if the input method handled the key
+ -- event.
+imContextFilterKeypress self =
+ liftM toBool $
+ ask >>= \eventPtr ->
+ liftIO $
+ {# call im_context_filter_keypress #}
+ (toIMContext self)
+ (castPtr eventPtr)
+
+-- | Notify the input method that the widget to which this input context
+-- corresponds has gained focus. The input method may, for example, change the
+-- displayed feedback to reflect this change.
+--
+imContextFocusIn :: IMContextClass self => self -> IO ()
+imContextFocusIn self =
+ {# call im_context_focus_in #}
+ (toIMContext self)
+
+-- | Notify the input method that the widget to which this input context
+-- corresponds has lost focus. The input method may, for example, change the
+-- displayed feedback or reset the contexts state to reflect this change.
+--
+imContextFocusOut :: IMContextClass self => self -> IO ()
+imContextFocusOut self =
+ {# call im_context_focus_out #}
+ (toIMContext self)
+
+-- | Notify the input method that a change such as a change in cursor position
+-- has been made. This will typically cause the input method to clear the
+-- preedit state.
+--
+imContextReset :: IMContextClass self => self -> IO ()
+imContextReset self =
+ {# call im_context_reset #}
+ (toIMContext self)
+
+-- | Notify the input method that a change in cursor position has been made.
+-- The location is relative to the client window.
+--
+imContextSetCursorLocation :: IMContextClass self => self
+ -> Rectangle -- ^ @area@ - new location
+ -> IO ()
+imContextSetCursorLocation self area =
+ with area $ \areaPtr ->
+ {# call im_context_set_cursor_location #}
+ (toIMContext self)
+ (castPtr areaPtr)
+
+-- | Sets whether the IM context should use the preedit string to display
+-- feedback. If @usePreedit@ is @False@ (default is @True@), then the IM
+-- context may use some other method to display feedback, such as displaying it
+-- in a child of the root window.
+--
+imContextSetUsePreedit :: IMContextClass self => self
+ -> Bool -- ^ @usePreedit@ - whether the IM context should use the preedit
+ -- string.
+ -> IO ()
+imContextSetUsePreedit self usePreedit =
+ {# call im_context_set_use_preedit #}
+ (toIMContext self)
+ (fromBool usePreedit)
+
+-- | Sets surrounding context around the insertion point and preedit string.
+-- This function is expected to be called in response to the
+-- 'IMContext'::retrieve_surrounding signal, and will likely have no effect if
+-- called at other times.
+--
+imContextSetSurrounding :: IMContextClass self => self
+ -> String -- ^ @text@ - text surrounding the insertion point, as UTF-8. the
+ -- preedit string should not be included within @text@.
+ -> Int -- ^ @cursorIndex@ - the index of the insertion cursor within
+ -- @text@.
+ -> IO ()
+imContextSetSurrounding self text cursorIndex =
+ withUTFString text $ \textPtr ->
+ {# call im_context_set_surrounding #}
+ (toIMContext self)
+ textPtr
+ (-1)
+ (fromIntegral (ofsToUTF cursorIndex (genUTFOfs text)))
+
+-- | Retrieves context around the insertion point. Input methods typically
+-- want context in order to constrain input text based on existing text; this
+-- is important for languages such as Thai where only some sequences of
+-- characters are allowed.
+--
+-- This function is implemented by emitting the
+-- 'imContextRetrieveSurrounding' signal on the input method; in response to
+-- this signal, a widget should provide as much context as is available, up to
+-- an entire paragraph, by calling 'imContextSetSurrounding'. Note that there
+-- is no obligation for a widget to respond to the 'imContextRetrieveSurrounding'
+-- signal, so input methods must be prepared to function without context.
+--
+imContextGetSurrounding :: IMContextClass self => self
+ -> IO (Maybe (String, Int)) -- ^ @Maybe (text,cursorIndex)@ Text holding
+ -- context around the insertion point and the
+ -- index of the insertion cursor within @text@.
+ -- 'Nothing' if no surrounding text was
+ -- provided.
+imContextGetSurrounding self =
+ alloca $ \textPtr ->
+ alloca $ \cursorIndexPtr ->
+ {# call im_context_get_surrounding #}
+ (toIMContext self)
+ textPtr
+ cursorIndexPtr >>= \provided ->
+ if toBool provided then
+ peek textPtr >>= readUTFString >>= \text ->
+ peek cursorIndexPtr >>= \cursorIndex ->
+ return (Just (text, ofsFromUTF (fromIntegral cursorIndex)
+ (genUTFOfs text)))
+ else
+ return Nothing
+
+-- | Asks the widget that the input context is attached to to delete
+-- characters around the cursor position by emitting the
+-- 'imContextDeleteSurrounding' signal.
+--
+-- In order to use this function, you should first call
+-- 'imContextGetSurrounding' to get the current context, and call this function
+-- immediately afterwards to make sure that you know what you are deleting. You
+-- should also account for the fact that even if the signal was handled, the
+-- input context might not have deleted all the characters that were requested
+-- to be deleted.
+--
+-- This function is used by an input method that wants to make substitutions
+-- in the existing text in response to new input. It is not useful for
+-- applications.
+--
+imContextDeleteSurrounding :: IMContextClass self => self
+ -> Int -- ^ @offset@ - offset from cursor position in chars; a negative
+ -- value means start before the cursor.
+ -> Int -- ^ @nChars@ - number of characters to delete.
+ -> IO Bool -- ^ returns @True@ if the signal was handled.
+imContextDeleteSurrounding self offset nChars =
+ liftM toBool $
+ {# call im_context_delete_surrounding #}
+ (toIMContext self)
+ (fromIntegral offset)
+ (fromIntegral nChars)
+
+--------------------
+-- Signals
+
+-- | This signal is emitted when a new preediting sequence starts.
+--
+imContextPreeditStart :: IMContextClass self => Signal self (IO ())
+imContextPreeditStart = Signal (connect_NONE__NONE "preedit_start")
+
+-- | This signal is emitted when a preediting sequence has been completed or
+-- canceled.
+--
+imContextPreeditEnd :: IMContextClass self => Signal self (IO ())
+imContextPreeditEnd = Signal (connect_NONE__NONE "preedit_end")
+
+-- | This signal is emitted whenever the preedit sequence currently being
+-- entered has changed. It is also emitted at the end of a preedit sequence,
+-- in which case 'imContextGetPreeditString' returns the empty string.
+--
+imContextPreeditChanged :: IMContextClass self => Signal self (IO ())
+imContextPreeditChanged = Signal (connect_NONE__NONE "preedit_changed")
+
+-- | This signal is emitted when a complete input sequence has been
+-- entered by the user. This can be a single character immediately after a
+-- key press or the final result of preediting. Parameters:
+--
+-- @str@ - the completed character(s) entered by the user
+imContextCommit :: IMContextClass self => Signal self (String -> IO ())
+imContextCommit = Signal (connect_STRING__NONE "commit")
+
+-- | This signal is emitted when the input method requires the context
+-- surrounding the cursor. The callback should set the input method
+-- surrounding context by calling 'imContextSetSurrounding'.
+--
+-- Returns True if the signal was handled.
+imContextRetrieveSurrounding :: IMContextClass self => Signal self (IO Bool)
+imContextRetrieveSurrounding = Signal (connect_NONE__BOOL "retrieve_surrounding")
+
+-- | This signal is emitted when the input method needs to delete all or part
+-- of the context surrounding the cursor. Parameters:
+--
+-- @offset@ - the character offset from the cursor position of the text to be
+-- deleted. A negative value indicates a position before the cursor.
+--
+-- @n_chars@ - the number of characters to be deleted.
+--
+-- Returns True if the signal was handled.
+imContextDeleteSurrounding' :: IMContextClass self => Signal self (Int -> Int -> IO Bool)
+imContextDeleteSurrounding' = Signal (connect_INT_INT__BOOL "delete_surrounding")
addfile ./gtk/Graphics/UI/Gtk/Misc/IMMulticontext.chs.pp
hunk ./gtk/Graphics/UI/Gtk/Misc/IMMulticontext.chs.pp 1
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) Widget IMMulticontext
+--
+-- Author : Colin McQuillan
+--
+-- Created: 30 April 2009
+--
+-- Copyright (C) 2009 Colin McQuillan
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU Lesser General Public
+-- License as published by the Free Software Foundation; either
+-- version 2.1 of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- Lesser General Public License for more details.
+--
+-- |
+-- Maintainer : gtk...@li...
+-- Stability : provisional
+-- Portability : portable (depends on GHC)
+--
+-- An input method context supporting multiple, loadable input methods
+--
+module Graphics.UI.Gtk.Misc.IMMulticontext (
+
+-- * Class Hierarchy
+--
+-- |
+-- @
+-- | 'GObject'
+-- | +----'IMContext'
+-- | +----IMMulticontext
+-- @
+
+-- * Types
+ IMMulticontext,
+ IMMulticontextClass,
+ castToIMMulticontext,
+ toIMMulticontext,
+
+-- * Constructors
+ imMulticontextNew,
+
+-- * Methods
+ imMulticontextAppendMenuitems,
+ ) where
+
+import Control.Monad (liftM)
+
+import System.Glib.FFI
+{#import Graphics.UI.Gtk.Types#}
+
+{# context lib="gtk" prefix="gtk" #}
+
+--------------------
+-- Constructors
+
+-- | Creates a new 'IMMulticontext'.
+--
+imMulticontextNew :: IO IMContext
+imMulticontextNew =
+ constructNewGObject mkIMContext $
+ {# call im_multicontext_new #}
+
+--------------------
+-- Methods
+
+-- | Add menuitems for various available input methods to a menu; the
+-- menuitems, when selected, will switch the input method for the context and
+-- the global default input method.
+--
+imMulticontextAppendMenuitems :: (IMMulticontextClass self, MenuShellClass menushell) => self
+ -> menushell -- ^ @menushell@ - a 'MenuShell'
+ -> IO ()
+imMulticontextAppendMenuitems self menushell =
+ {# call im_multicontext_append_menuitems #}
+ (toIMMulticontext self)
+ (toMenuShell menushell)
hunk ./gtk/Graphics/UI/Gtk/Pango/Attributes.chs.pp 33
- fromAttrList
+ fromAttrList,
+ readAttrList
hunk ./gtk/Graphics/UI/Gtk/Pango/Attributes.chs.pp 50
+foreign import ccall unsafe "pango_attr_list_unref"
+ pango_attr_list_unref :: PangoAttrList -> IO ()
hunk ./gtk/Graphics/UI/Gtk/Pango/Attributes.chs.pp 65
- {#call unsafe attr_list_unref#} alPtr
+ pango_attr_list_unref alPtr
hunk ./gtk/Graphics/UI/Gtk/Pango/Attributes.chs.pp 212
+
+readAttrList :: UTFCorrection -> PangoAttrList -> IO [[PangoAttribute]]
+readAttrList correct attrListPtr = do
+ elems <- fromAttrList correct attrListPtr
+ pango_attr_list_unref attrListPtr
+ return elems
|
|
From: Axel S. <si...@co...> - 2009-05-09 18:46:47
|
Thu Apr 30 11:22:50 EDT 2009 m....@gm...
* Improve apiGen names, for example hsv instead of hSV
Ignore-this: 89e23bb8809006e40a3708049de9c031
hunk ./tools/apiGen/src/CodeGen.hs 226
- else let typeVar = lowerCaseFirstChar propertyType
+ else let typeVar = lowerCaseFirstWord propertyType
hunk ./tools/apiGen/src/CodeGen.hs 259
- else let typeVar = lowerCaseFirstChar propertyType
+ else let typeVar = lowerCaseFirstWord propertyType
hunk ./tools/apiGen/src/CodeGen.hs 291
- text (lowerCaseFirstChar signalName) <+> text "::" <+> signalType
- $$ text (lowerCaseFirstChar signalName) <+> equals <+> text "Signal" <+> parens (text "connect_" <> connectCall <+> signalCName)
+ text (lowerCaseFirstWord signalName) <+> text "::" <+> signalType
+ $$ text (lowerCaseFirstWord signalName) <+> equals <+> text "Signal" <+> parens (text "connect_" <> connectCall <+> signalCName)
hunk ./tools/apiGen/src/CodeGen.hs 592
- ([(undefined, "import Monad\t(liftM)")]
+ ([(undefined, "import Control.Monad\t(liftM)")]
hunk ./tools/apiGen/src/Module.hs 279
- let objName = lowerCaseFirstChar (Api.object_name object)
+ let objName = lowerCaseFirstWord (Api.object_name object)
hunk ./tools/apiGen/src/Module.hs 301
- let objName = lowerCaseFirstChar (Api.object_name object)
+ let objName = lowerCaseFirstWord (Api.object_name object)
hunk ./tools/apiGen/src/Module.hs 520
- declName = lowerCaseFirstChar (module_name module_) ++ attrName
+ declName = lowerCaseFirstWord (module_name module_) ++ attrName
hunk ./tools/apiGen/src/Names.hs 4
-import Utils (splitBy, lowerCaseFirstChar, upperCaseFirstChar)
+import Utils (splitBy, lowerCaseFirstWord, upperCaseFirstChar)
hunk ./tools/apiGen/src/Names.hs 9
- lowerCaseFirstChar
+ lowerCaseFirstWord
hunk ./tools/apiGen/src/Names.hs 16
- lowerCaseFirstChar
+ lowerCaseFirstWord
hunk ./tools/apiGen/src/Utils.hs 12
- lowerCaseFirstChar,
+ lowerCaseFirstWord,
hunk ./tools/apiGen/src/Utils.hs 25
-import Data.Char (toLower, toUpper)
+import Data.Char (isUpper, toLower, toUpper)
hunk ./tools/apiGen/src/Utils.hs 53
-lowerCaseFirstChar :: String -> String
-lowerCaseFirstChar (c:cs) = toLower c : cs
+lowerCaseFirstWord :: String -> String
+lowerCaseFirstWord s = case span isUpper s of
+ ([],_) -> s
+ ([c],cs) -> toLower c : cs
+ (caps,[]) -> map toLower caps
+ (caps,cs) -> map toLower (init caps) ++ (last caps : cs)
hunk ./tools/callbackGen/gtkmarshal.list 39
-#BOOLEAN:INT,INT
+BOOLEAN:INT,INT
hunk ./tools/callbackGen/gtkmarshal.list 125
+
|
|
From: Axel S. <si...@co...> - 2009-05-07 11:30:17
|
Thu May 7 07:18:48 EDT 2009 Marco T[_\c3_][_\ba_]lio Gontijo e Silva <ma...@ho...>
* gtk/Graphics/UI/Gtk/General/Structs.hsc: Accept responses 0 and smaller than -11.
Ignore-this: f64b69b52a743ac54b404452178b29c0
hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 551
-fromResponse (ResponseUser i) | i > 0 = fromIntegral i
+fromResponse (ResponseUser i) = fromIntegral i
hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 565
-toResponse i | i >= 0 = ResponseUser $ fromIntegral i
+toResponse i = ResponseUser $ fromIntegral i
|
|
From: Axel S. <si...@co...> - 2009-04-29 06:54:06
|
Fri Apr 24 11:24:30 EDT 2009 Axel Simon <Axe...@en...>
* Add a function to insert the current clipboard content at the current cursor.
hunk ./gtk/Graphics/UI/Gtk/Multiline/TextBuffer.chs.pp 141
+ textBufferPasteClipboardAtCursor,
hunk ./gtk/Graphics/UI/Gtk/Multiline/TextBuffer.chs.pp 965
--- | Pastes the contents of a clipboard at the insertion point,
--- or at override_location. (Note: pasting is asynchronous, that is,
+-- | Pastes the contents of a clipboard at the given @location@.
+-- (Note: pasting is asynchronous, that is,
hunk ./gtk/Graphics/UI/Gtk/Multiline/TextBuffer.chs.pp 971
- -> TextIter -- ^ @overrideLocation@ - location to insert pasted text
+ -> TextIter -- ^ @location@ - location to insert pasted text
hunk ./gtk/Graphics/UI/Gtk/Multiline/TextBuffer.chs.pp 980
+
+-- | Pastes the contents of a clipboard at the insertion point.
+-- (Note: pasting is asynchronous, that is,
+-- we'll ask for the paste data and return, and at some point later
+-- after the main loop runs, the paste data will be inserted.)
+textBufferPasteClipboardAtCursor :: TextBufferClass self => self
+ -> Clipboard -- ^ @clipboard@ - the GtkClipboard to paste from
+ -> Bool -- ^ @defaultEditable@ - whether the buffer is editable by default
+ -> IO ()
+textBufferPasteClipboardAtCursor self clipboard defaultEditable =
+ {# call gtk_text_buffer_paste_clipboard #}
+ (toTextBuffer self)
+ clipboard
+ (TextIter nullForeignPtr)
+ (fromBool defaultEditable)
|
|
From: Peter g. <pg...@co...> - 2009-04-29 03:49:09
|
Tue Apr 28 23:48:20 EDT 2009 pg...@gm...
* configure.ac: add bz2 dist tarball
Ignore-this: 5dfb2e2e91ab8b991d6908c7c08a51fe
hunk ./configure.ac 26
-AM_INIT_AUTOMAKE
+AM_INIT_AUTOMAKE([dist-bzip2])
|
|
From: Peter g. <pg...@co...> - 2009-04-29 03:47:29
|
Tue Apr 28 23:21:34 EDT 2009 pg...@gm...
* gtk: OwnerChange event only since gtk 2.6
Ignore-this: 23e3be727b8d43711321accaf35a4bf6
hunk ./gtk/Graphics/UI/Gtk/Gdk/Enums.chs.pp 50
+#if GTK_CHECK_VERSION(2,6,0)
hunk ./gtk/Graphics/UI/Gtk/Gdk/Enums.chs.pp 52
+#endif
hunk ./gtk/Graphics/UI/Gtk/Gdk/Enums.chs.pp 253
+#if GTK_CHECK_VERSION(2,6,0)
hunk ./gtk/Graphics/UI/Gtk/Gdk/Enums.chs.pp 263
-
+#endif
hunk ./gtk/Graphics/UI/Gtk/Gdk/EventM.hsc 178
- OwnerChange(..))
+#if GTK_CHECK_VERSION(2,6,0)
+ OwnerChange(..)
+#endif
+ )
hunk ./gtk/Graphics/UI/Gtk/Gdk/EventM.hsc 402
+#if GTK_CHECK_VERSION(2,6,0)
hunk ./gtk/Graphics/UI/Gtk/Gdk/EventM.hsc 404
+#endif
hunk ./gtk/Graphics/UI/Gtk/Gdk/EventM.hsc 449
+#if GTK_CHECK_VERSION(2,6,0)
hunk ./gtk/Graphics/UI/Gtk/Gdk/EventM.hsc 453
+#endif
|
|
From: Axel S. <si...@co...> - 2009-04-27 19:48:15
|
Mon Apr 27 15:46:38 EDT 2009 Axe...@en...
* Fix drawWindowGetPointer, trac #802.
hunk ./gtk/Graphics/UI/Gtk/Gdk/DrawWindow.chs.pp 75
+ drawWindowGetPointerPos,
hunk ./gtk/Graphics/UI/Gtk/Gdk/DrawWindow.chs.pp 475
-
--- | Obtains the current pointer position and modifier state.
+-- Superseded by 'drawWindowGetPointerPos', won't be removed.
+-- Obtains the current pointer position and modifier state.
hunk ./gtk/Graphics/UI/Gtk/Gdk/DrawWindow.chs.pp 503
+-- | Obtains the current pointer position and modifier state.
+--
+-- * The position is
+-- given in coordinates relative to the given window.
+-- [_$_]
+-- * The return value is @(Just win, x, y, mod)@ where @win@ is the
+-- window over which the mouse currently resides and @mod@ denotes
+-- the keyboard modifiers currently being depressed.
+--
+-- * The return value is @Nothing@ for the window if the mouse cursor is [_$_]
+-- not over a known window.
+--
+drawWindowGetPointerPos :: DrawWindowClass self => self
+ -> IO (Maybe DrawWindow, Int, Int, [Modifier])
+drawWindowGetPointerPos self =
+ alloca $ \xPtr -> alloca $ \yPtr -> alloca $ \mPtr -> do
+ winPtr <- {# call gdk_window_get_pointer #} (toDrawWindow self)
+ xPtr yPtr mPtr
+ x <- peek xPtr
+ y <- peek yPtr
+ m <- peek mPtr
+ mWin <- if winPtr==nullPtr then return Nothing else liftM Just $
+ makeNewGObject mkDrawWindow (return winPtr)
+ return (mWin, fromIntegral x, fromIntegral y, toFlags (fromIntegral m))
+
+
|
|
From: Axel S. <si...@co...> - 2009-04-26 15:37:20
|
Fri Apr 10 19:44:20 EDT 2009 mau...@gm...
* New version of carsim demo
It has been a couple years since I wrote what is now the
'carsim' gtk2hs demo. I realized many of gtk+, gtk2hs and ghc
user library have been deprecated and replaced since then.
As it's in a demo directory, I thought it would be better to
have an updated version using current recomended API. Except
for a 'Pause' button, nothing important has changed in the user
interface. Changes in code include:
- Deprecated code, like System.Time and a few of gtk2hs, has
been replaced.
- Bug fix in about dialog.
- Use of EventM.
- Code is now UTF-8, but that only affects author name.
- Hopefully, better code and documentation.
hunk ./demo/carsim/CarSim.hs 1
--- program: S.A.R.A.H. road simulator
--- author: Maur[_\ed_]cio C. Antunes
+-- program: S.A.R.A.H. jam simulator
+-- author: Maur[_\c3_][_\ad_]cio C. Antunes
hunk ./demo/carsim/CarSim.hs 6
-module Main (Main.main) where
-import Complex
+module Main where
hunk ./demo/carsim/CarSim.hs 8
-import Graphics.UI.Gtk
-import Graphics.UI.Gtk.Abstract.Widget
-import Graphics.Rendering.Cairo hiding (translate)
-import Graphics.Rendering.Cairo.Matrix
+import Graphics.UI.Gtk hiding (fill)
+import Graphics.UI.Gtk.Gdk.EventM
+import Graphics.Rendering.Cairo
hunk ./demo/carsim/CarSim.hs 14
-import Data.Char
-import System.Time
+import Data.Time
+import Data.Complex
hunk ./demo/carsim/CarSim.hs 17
-mod1 :: Double -> Double
-mod1 x = (x -) $ (fromIntegral.floor) x
+-- Constants
hunk ./demo/carsim/CarSim.hs 19
--- car limits
-acceleration = 0.9*carSize :: Double
-desacceleration = 10*acceleration:: Double
-carSize = 0.015 :: Double
--- time one takes to react to a change in the road
+accelerator = 0.7*carSize :: Double
+brake = 10*accelerator:: Double
+carSize = 2*pi/59 :: Double
hunk ./demo/carsim/CarSim.hs 23
-halfMaxCars = 20 :: Integer
+drawSide = 5/2 :: Double
hunk ./demo/carsim/CarSim.hs 25
--- in a car list the last car should try to keep its position
--- before the first car position plus 1.0. The actual position of
--- a car in the road is (mod1 position), i.e., 0 <= actual position
--- < 1
-data Car = Car {position,speed::Double}
-carPositionCompare c1 c2 = compare (position c1) (position c2)
-carSpeedCompare c1 c2 = compare (speed c1) (speed c2)
-newCarList n = map (((flip Car) 0).(1.0/(fromIntegral n) *).fromIntegral) [1..n]
-changeCarListSize :: Int -> [Car] -> [Car]
-changeCarListSize _ [] = []
-changeCarListSize n carList = sortBy carPositionCompare $
- take n $ cycle $ sortBy carSpeedCompare carList
+-- A few conveniences
hunk ./demo/carsim/CarSim.hs 27
--- safe speed according to distance from next car
-distance2speed distance = sqrt (b^2 + 2*d) - b
- where
- d = max 0 (distance*desacceleration)
- b = desacceleration*responseTime
+eventWindowSize = do
+ dr <- eventWindow
+ (w,h) <- liftIO $ drawableGetSize dr
+ return $ if w*h > 1
+ then (fromIntegral w, fromIntegral h)
+ else (1,1)
hunk ./demo/carsim/CarSim.hs 34
--- update cars position and speed with a timestep
--- and maybe a congestion
-updateCarList :: Maybe Double -> Double -> [Car] -> [Car]
-updateCarList _ _ [] = []
-updateCarsList congestion timestep carList = newList
- where
- positions = map position carList
- speeds = map speed carList
- [_$_]
- -- distances considered to calculate speed are always 'responseTime'
- -- in the past, since human brain takes that time to react
- oldDistances = map (subtract carSize) $ zipWith (-) rotatedOldPositions oldPositions
- where
- oldPositions = zipWith (-) positions (map (responseTime *) speeds)
- rotatedOldPositions = (tail oldPositions) ++ [1 + (head oldPositions)]
- distancesToCongestion = congestion >>= \c -> Just $ map (mod1.(c - carSize/2 -)) positions
+eventPolarCoordinates = do
+ (w,h) <- eventWindowSize
+ (x,y) <- eventCoordinates
+ let (origX, origY) = (w/2, h/2)
+ let (scaleX, scaleY) = (drawSide/w, drawSide/h)
+ let (x',y') = (scaleX*(x-origX), scaleY*(y-origY))
+ let (radius,theta) = polar $ x' :+ y'
+ return $ (radius,theta)
+
+getAndSet :: a -> IO (IO a, a -> IO ())
+getAndSet a = do
+ ior <- newIORef a
+ let get = readIORef ior
+ let set = writeIORef ior
+ return (get,set)
+
+diffTime :: UTCTime -> UTCTime -> Double
+diffTime = (realToFrac .) . diffUTCTime
+
+moveToLineTo :: Double -> Double
+ -> Double -> Double -> Render ()
+moveToLineTo a b c d = moveTo a b >> lineTo c d
+
+-- Car list handling
+
+-- Each car is represented by a pair of Doubles. The first
+-- Double is its position in a circular road, represented by
+-- an angle. The second is its angular velocity. The general
+-- idea behind the simulation is that in a list of cars each
+-- one will try to keep a safe speed to avoid a crash in the
+-- event of a sudden brake of the next car.
hunk ./demo/carsim/CarSim.hs 66
- speedFromDistances = map distance2speed oldDistances
- speedFromCongestion = distancesToCongestion >>= \d -> Just $ map distance2speed d
- desiredSpeed = case speedFromCongestion of
- Nothing -> speedFromDistances
- Just d -> zipWith min d speedFromDistances
+newCarList nCars = take nCars $ zip [0,2*pi/nCars'..] (repeat 0)
+ where nCars' = fromIntegral nCars
hunk ./demo/carsim/CarSim.hs 69
- -- never change speeds more than given limits
- upperSpeed = map (+ timestep*acceleration) speeds
- lowerSpeed = map (subtract (timestep*desacceleration)) speeds
- finalSpeed = zipWith3 between lowerSpeed desiredSpeed upperSpeed
- where between x y z = max x (min y z)
+-- This resizes car lists by copying or keeping those
+-- at lower speeds.
hunk ./demo/carsim/CarSim.hs 72
- newList = zipWith updateSpeed carList finalSpeed
- where
- updateSpeed (Car p _) s = Car (p+s*timestep-base) s
- -- base is just to ensure that car positions
- -- do not get too big, since just (mod1 position)
- -- is what actually matter
- base = (fromIntegral . floor . head) positions
+newCarListFromList nCars [] = newCarListFromList nCars [(0,0)]
+newCarListFromList nCars list = sortBy ((. fst).(compare . fst)) $
+ take nCars $ cycle $ sortBy ((. snd).(compare . snd)) list
hunk ./demo/carsim/CarSim.hs 76
--- matrix to transform a coordinate space
--- so that a a circle with radius 1.0 can
--- fit inside window area
-drawingMatrix :: DrawWindow -> IO Matrix
-drawingMatrix dw = do
- (w_,h_) <- drawableGetSize dw
- (w,h) <- return (fromIntegral w_,fromIntegral h_)
- if (w*h)>0
- then do
- s <- return $ 0.85 * (min (w/2) (h/2))
- return $ (translate (w/2) (h/2)) . (scalarMultiply s) $ identity
- else
- return identity
+-- Safe speed for car, given data from itself and the next
+-- and, possibly, a forced (by the user) jam. Speed changes
+-- are limited by accelerator and brake maxima.
+
+newSpeed dt jam (p1,s1) (p2,s2) = min cv $ max bv $ ds - br
+ where
+ pd = (p2-p1-carSize) - responseTime*(s2-s1)
+ pj = maybe pd ((subtract $ carSize/2)
+ . (until (>0) (+2*pi)) . (subtract p1)) jam
+ dd = brake*(max 0 $ min pd pj)
+ br = brake*responseTime
+ ds = sqrt $ br^2 + 2*dd
+ cv = s1 + accelerator*dt
+ bv = s1 - brake*dt
+
+-- Update positions and speeds based on a timestep and maybe
+-- taking a forced congestion into account
+
+updateCarList _ _ [] = []
+updateCarList timestep jam list = zip newPositions' newSpeeds
+ where
+ fakeCar = (p+2*pi,s) where (p,s) = head list
+ newSpeeds = zipWith ns list (tail list ++ [fakeCar])
+ where ns = newSpeed timestep jam
+ newPositions = zipWith3 mean fsts snds newSpeeds
+ where
+ mean a b c = a + timestep*(b+c)/2
+ fsts = map fst list
+ snds = map snd list
+ newPositions' = map (subtract base) newPositions
+ base = (*(2*pi)) $ fromIntegral $ floor $ (/ (2*pi)) $
+ head newPositions
+
+about = do
+ ad <- aboutDialogNew
+ aboutDialogSetName ad "S.A.R.A.H."
+ aboutDialogSetVersion ad "1.0"
+ aboutDialogSetAuthors ad $ ["Maur[_\c3_][_\ad_]cio C. Antunes "
+ ++ "<mau...@gm...>"]
+ aboutDialogSetComments ad $ "Software Automation of "
+ ++ "Road Automobile Headache"
+ dialogRun ad
+ widgetDestroy ad
hunk ./demo/carsim/CarSim.hs 122
- -- GTK stuff
- initGUI
- window <- windowNew
- set window [ containerBorderWidth := 10, windowTitle := "S.A.R.A.H.",
- windowWindowPosition := WinPosCenter]
- onDestroy window mainQuit
- hBox <- hBoxNew False 5
- hSeparator <- hSeparatorNew
- vBox <- vBoxNew False 0
- hButtonBox <- hButtonBoxNew
- scaleCarAmount <- vScaleNewWithRange 1 (fromIntegral (2*halfMaxCars)) 1
- mapM ($ scaleCarAmount) [(`scaleSetDigits` 0),(`scaleSetValuePos` PosTop),
- (`rangeSetUpdatePolicy` UpdateDelayed),(`rangeSetInverted` True)]
- scaleAdjustment <- rangeGetAdjustment scaleCarAmount
- scaleAdjustment `adjustmentSetValue` (fromIntegral halfMaxCars)
- [buttonReset,buttonAbout,buttonQuit] <- mapM buttonNewWithLabel ["Reset","About","Quit"]
- widgetSetCanFocus scaleCarAmount False
- mapM (`widgetSetCanFocus` False) [buttonReset,buttonAbout,buttonQuit]
- desenho <- drawingAreaNew
- desenho `onSizeRequest` return (Requisition 300 300)
hunk ./demo/carsim/CarSim.hs 123
- -- layout
- window `containerAdd` hBox
- boxPackStart hBox scaleCarAmount PackNatural 0
- boxPackStart hBox vBox PackGrow 0
- boxPackStart vBox desenho PackGrow 0
- boxPackStart vBox hSeparator PackNatural 0
- boxPackStart vBox hButtonBox PackNatural 0
- buttonBoxSetLayout hButtonBox ButtonboxSpread
- mapM (boxPackStartDefaults hButtonBox) [buttonReset,buttonAbout,buttonQuit]
+ initGUI
+
+ drawingArea <- drawingAreaNew
+
+ (getTimeStamp,setTimeStamp) <- getCurrentTime >>= getAndSet
+ (getCars,setCars) <- getAndSet $ newCarList 20
+ (getJam,setJam) <- getAndSet Nothing
+ (getTimeoutId,setTimeoutId) <- getAndSet Nothing
+
+ -- If 'resume' is called, 'step' will be called at small
+ -- timesteps to update car data. If 'pause' is called, 'step'
+ -- calls are stoped. 'resume' is called at program startup,
+ -- and then the pause button alternates 'resume' and 'pause'.
+
+ let step = do
+ time <- getCurrentTime
+ dt <- getTimeStamp >>= return . (diffTime time)
+ setTimeStamp time
+ liftM2 (updateCarList dt) getJam getCars >>= setCars
+ let pause = do
+ maybe (return ()) timeoutRemove =<< getTimeoutId
+ setTimeoutId Nothing
+ let resume = do
+ setTimeoutId . Just =<< flip timeoutAdd 33
+ (step >> widgetQueueDraw drawingArea >> return True)
+ getCurrentTime >>= setTimeStamp
+
+ -- The elements of the graphic interface are the set of
+ -- buttons, the scale to set the number of cars and the
+ -- car track. They are named as 'buttons', 'howMany' and
+ -- 'track'. Each of them contains other widgets inside, but
+ -- there's no reason to expose their names to the main IO.
+
+ buttons <- do
+
+ qr <- buttonNewFromStock stockClear
+ onClicked qr $ do
+ (liftM length) getCars >>= setCars . newCarList
+ getCurrentTime >>= setTimeStamp
+ widgetQueueDraw drawingArea
+
+ qp <- toggleButtonNewWithLabel stockMediaPause
+ buttonSetUseStock qp True
+ onToggled qp $ do
+ p <- toggleButtonGetActive qp
+ case p of
+ True -> pause
+ False -> resume
+
+ qa <- buttonNewFromStock stockAbout
+ onClicked qa $ about
+
+ qq <- buttonNewFromStock stockQuit
+ onClicked qq mainQuit
+
+ bb <- hButtonBoxNew
+ containerAdd bb qr
+ containerAdd bb qp
+ containerAdd bb qa
+ containerAdd bb qq
+ return bb
+ [_$_]
+ howMany <- do
+
+ sc <- vScaleNewWithRange 1 40 1
+ afterRangeValueChanged sc $ do
+ v <- liftM floor $ rangeGetValue sc
+ c <- getCars
+ setCars $ newCarListFromList v c
+ widgetQueueDraw drawingArea
+
+ scaleSetValuePos sc PosTop
+ scaleSetDigits sc 0
+ rangeSetUpdatePolicy sc UpdateDiscontinuous
+ rangeSetValue sc =<< liftM (fromIntegral . length) getCars
hunk ./demo/carsim/CarSim.hs 199
- aboutDialog <- aboutDialogNew
- set aboutDialog [aboutDialogName := "S.A.R.A.H.", aboutDialogVersion := "0.95",
- aboutDialogLicense := Just "This small program is public domain. You can do \
- \whatever you want with it.", aboutDialogAuthors :=
- ["Maur"++[chr 237]++"cio C. Antunes (mau...@gm...)"], aboutDialogComments :=
- "Software Automation of Road Automobile Headache"]
+ al <- alignmentNew 0.5 0.5 0 1
+ alignmentSetPadding al 15 15 15 15
+ containerAdd al sc
+ return al
+ [_$_]
+ track <- do
hunk ./demo/carsim/CarSim.hs 206
- -- all variables. 'last_time' is the last time 'cars' has
- -- been updated; used to calculate timestep
- cars <- newIORef (newCarList (fromIntegral halfMaxCars))
- last_time <- (newIORef =<< getClockTime)
+ let dr = drawingArea
+ widgetAddEvents dr [PointerMotionMask]
hunk ./demo/carsim/CarSim.hs 209
- onClicked buttonReset $ do
- nCars <- adjustmentGetValue scaleAdjustment
- writeIORef cars (newCarList (round nCars))
- onClicked buttonAbout $ do
- dialogRun aboutDialog
- return ()
- onClicked buttonQuit $ do
- widgetDestroy window
+ on dr motionNotifyEvent $ do
+ (r,t) <- eventPolarCoordinates
+ liftIO $ if (0.8<r && r<1.2)
+ then setJam (Just t)
+ else setJam Nothing
+ liftIO $ widgetQueueDraw dr
+ return True
hunk ./demo/carsim/CarSim.hs 217
- afterValueChanged scaleAdjustment $ do
- nCars <- adjustmentGetValue scaleAdjustment
- modifyIORef cars (changeCarListSize (round nCars))
+ on dr leaveNotifyEvent $ liftIO $
+ setJam Nothing >> return True
hunk ./demo/carsim/CarSim.hs 220
- -- every 33 milliseconds...
- (flip timeoutAdd) 33 $ do
- (TOD s1 ps1) <- readIORef last_time
- (TOD s2 ps2) <- getClockTime
- writeIORef last_time (TOD s2 ps2)
- -- how much time since last update?
- timestep <- return $ 1e-12 * fromInteger(10^12*(s2-s1)+ps2-ps1)
+ on dr exposeEvent $ do
+ (w,h) <- eventWindowSize
+ dw <- eventWindow
+ liftIO $ do
+ jam <- getJam
+ cars <- getCars
+ renderWithDrawable dw $ do
+ translate (w/2) (h/2)
+ scale (w/drawSide) (h/drawSide)
+ road2render jam cars
+ return True
hunk ./demo/carsim/CarSim.hs 232
- drawWindow <- widgetGetDrawWindow desenho
- coordinateTransformation <- drawingMatrix drawWindow
+ af <- aspectFrameNew 0.5 0.5 (Just 1)
+ frameSetShadowType af ShadowNone
+ containerAdd af dr
+ return af
+ [_$_]
+ -- 'layout' is a widget that contains all interface elements
+ -- properly arranged.
hunk ./demo/carsim/CarSim.hs 240
- -- do we have a congestion, i.e., is mouse
- -- close to the road?
- (mouseFromOrigin,congestionPosition) <- do
- (xI,yI) <- widgetGetPointer desenho
- (xD,yD) <- return (fromIntegral xI, fromIntegral yI)
- (x,y) <- return $ transformPoint (invert coordinateTransformation) (xD,yD)
- return (sqrt(x^2+y^2),(atan2 y x)/(2*pi))
- congestion <- return $ if mouseFromOrigin<0.85 || mouseFromOrigin>1.15
- then Nothing
- else Just congestionPosition
+ layout <- do
+ vb <- vBoxNew False 0
+ hb <- hBoxNew False 0
+ boxPackStart vb track PackGrow 0
+ boxPackStart vb buttons PackNatural 0
+ boxPackStart hb howMany PackNatural 0
+ boxPackStart hb vb PackGrow 0
+ return hb
hunk ./demo/carsim/CarSim.hs 249
- modifyIORef cars (updateCarsList congestion timestep)
+ mainWindow <- windowNew
+ windowSetTitle mainWindow "S.A.R.A.H."
+ windowSetDefaultSize mainWindow 400 400
+ on mainWindow destroyEvent $
+ liftIO $ mainQuit >> return True
+ containerAdd mainWindow layout
+ widgetShowAll mainWindow
hunk ./demo/carsim/CarSim.hs 257
- -- paint
- c <- readIORef cars
- (w,h) <- drawableGetSize drawWindow
- drawWindowBeginPaintRect drawWindow (Rectangle 0 0 w h)
- renderWithDrawable drawWindow $ do
- setMatrix coordinateTransformation
- road2render congestion c
- drawWindowEndPaint drawWindow
- return True
+ resume
hunk ./demo/carsim/CarSim.hs 259
- widgetShowAll window
- mainGUI
+ mainGUI
hunk ./demo/carsim/CarSim.hs 261
-road2render :: Maybe Double -> [Car] -> Render ()
-road2render congestion cars = do
- newPath
- -- road
- setSourceRGB 0.0 0.0 0.0
- s <- return (2*pi/30.0)
- setDash [s,s] 0.0
- setLineWidth 0.01
- arc 0.0 0.0 1.0 0.0 (2*pi)
- stroke
- setDash [0.08,0.02] 0.0
- -- congestion
- case congestion of
- Nothing -> return ()
- Just c -> do
- moveTo 0 0
- lineTo (1.2*(cos(c*2*pi))) (1.2*(sin(c*2*pi)))
- stroke
- -- cars
- setSourceRGBA 0.0 0.0 0.0 0.55
- (flip mapM_) cars $ \(Car p _) -> do
- (x,y) <- return (cos(2*pi*p),sin(2*pi*p))
- arc x y (0.5*carSize*2*pi) 0.0 (2*pi)
- Graphics.Rendering.Cairo.fill
+-- As the name says, this takes road info, in the form of a
+-- possible jam and a list of cars, and make it into a Cairo
+-- render. Road will have radius 1.
hunk ./demo/carsim/CarSim.hs 265
+road2render :: Maybe Double -> [(Double,Double)] -> Render ()
+road2render jam cars = do
+ newPath
+ setSourceRGB 0 0 0
+ drawRoad
+ when (isJust jam) drawJam
+ setSourceRGBA 0 0 0 0.55
+ let cars' = map fst cars
+ let rotations = zipWith subtract (0:cars') cars'
+ sequence_ $ map ((>> drawCar) . rotate) rotations
+ where
+ drawRoad = setLineWidth 0.01 >> setDash [2*pi/34,2*pi/34]
+ (pi/34) >> arc 0.0 0.0 1.0 0.0 (2*pi) >> stroke
+ drawJam = setLineWidth 0.005 >> setDash [0.03,0.02] 0.04 >>
+ save >> rotate (fromJust jam) >> moveToLineTo 0.8 0 1.2
+ 0 >> stroke >> setDash [] 0 >> moveToLineTo 0.8 (-0.015)
+ 0.8 0.015 >> moveToLineTo 1.2 (-0.015) 1.2 0.015 >> stroke
+ >> restore
+ drawCar = arc 1 0 (carSize/2) 0 (2*pi) >> fill
|
|
From: Axel S. <si...@co...> - 2009-04-26 15:37:19
|
Sun Apr 26 11:31:52 EDT 2009 Axe...@en...
* Add an Eq instance for all objects.
This patch makes it possible to use == to compare two objects or, rather,
their pointers. Since for one case an object is merely containing data
and has its own Eq instance, it was necessary to add a 'noEq' flag to
the type generator that, when given, prevents the generation of the
deriving Eq clause. This patch fixes trac #1158.
hunk ./gio/System/GIO/File.chs.pp 161
+-- | Compare two file descriptors for equality. This test is also used to
+-- implement the '(==)' function, that is, comparing two descriptions
+-- will compare their content, not the pointers to the two structures.
+--
hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 152
- Just (model', source) -> return (treeModelEqual model model'),
+ Just (model', source) -> return (toTreeModel model==toTreeModel model'),
hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 158
- if not (treeModelEqual model model') then return False
+ if toTreeModel model/=toTreeModel model' then return False
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeDrag.chs 71
--- | Compare two tree model for equality.
+-- this function is not necessary anymore since the models can be compared
+-- using equality ==
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 199
- Just (model', source) -> return (treeModelEqual model model'),
+ Just (model', source) -> return (toTreeModel model==toTreeModel model'),
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 205
- if not (treeModelEqual model model') then return False
+ if toTreeModel model/=toTreeModel model' then return False
hunk ./tools/hierarchyGen/TypeGen.hs 17
--- b) the GTK blah_get_type function.
-type TypeQuery = (String, (String, Maybe String))
+-- b) the info on this type 'TypeInfo'.
+type TypeQuery = (String, TypeInfo)
+
+-- The information of on the type.
+data TypeInfo = TypeInfo {
+ tiQueryFunction :: String, -- the GTK blah_get_type function
+ tiAlternateName :: Maybe String,
+ tiNoEqualInst :: Bool
+ }
+
hunk ./tools/hierarchyGen/TypeGen.hs 62
- pFreshLine (ps { hierObjs=spec}) (dropWhile ((/=) '\n') rem'')
+ pFreshLine (ps { hierObjs=spec}) (dropWhile ((/=) '\n') rem''')
hunk ./tools/hierarchyGen/TypeGen.hs 69
- (name,specialQuery,rem') = case (dropWhile isBlank rem) of
+ (eqInst,rem') = [_$_]
+ let r = dropWhile isBlank rem in
+ if "noEq" `isPrefixOf` r then (True, drop 4 r) else (False, r)
+ (name,specialQuery,rem'') = case (dropWhile isBlank rem') of
hunk ./tools/hierarchyGen/TypeGen.hs 78
- (tyName, (tyName, (origCName, Just tyQuery)), r')
- r -> (tyName, (tyName, (origCName, Nothing)), r)
- r -> (origHsName, (origHsName, (origCName, Nothing)), r)
+ (tyName, (tyName, TypeInfo origCName (Just tyQuery) eqInst), r')
+ r -> (tyName, (tyName, TypeInfo origCName Nothing eqInst), r)
+ r -> (origHsName, (origHsName, TypeInfo origCName Nothing eqInst), r)
hunk ./tools/hierarchyGen/TypeGen.hs 83
- (readTag, rem'') = case (dropWhile isBlank rem') of
+ (readTag, rem''') = case (dropWhile isBlank rem'') of
hunk ./tools/hierarchyGen/TypeGen.hs 227
- (Just (_, Just get_type_func)) -> get_type_func
- (Just (cname, _)) -> tail $ c2u True cname++"_get_type").
+ (Just TypeInfo { tiAlternateName = Just get_type_func }) ->
+ get_type_func
+ (Just TypeInfo { tiQueryFunction = cname}) ->
+ tail $ c2u True cname++"_get_type").
hunk ./tools/hierarchyGen/TypeGen.hs 261
- (Just (cname, _)) | stripPrefix cname == name -> ss name
- | otherwise -> ss cname.ss " as ".ss name
+ (Just TypeInfo { tiQueryFunction = cname })
+ | stripPrefix cname == name -> ss name
+ | otherwise -> ss cname.ss " as ".ss name
hunk ./tools/hierarchyGen/TypeGen.hs 265
- then drop (length prefix) s
+ then drop (length prefix) s
hunk ./tools/hierarchyGen/TypeGen.hs 268
- ).
+ ).
hunk ./tools/hierarchyGen/TypeGen.hs 270
+ (case lookup name table of
+ (Just (TypeInfo { tiNoEqualInst = False })) -> ss " deriving (Eq,Ord)"
+ _ -> id
+ ).
hunk ./tools/hierarchyGen/hierarchy.list 235
+# Note on all the "as" clauses: the prefix G is unfortunate since it leads
+# to two consecutive upper case letters which are not translated with an
+# underscore each (e.g. GConf -> gconf, GtkHButtonBox -> gtk_hbutton_box).
hunk ./tools/hierarchyGen/hierarchy.list 273
- GFile as File, g_file_get_type if gio
+ GFile noEq as File, g_file_get_type if gio
|
|
From: Peter g. <pg...@co...> - 2009-04-24 15:23:53
|
Fri Apr 24 11:21:36 EDT 2009 pg...@gm...
* gtk: allow zero as argument to toResponse in G.U.G.General.Structs
Ignore-this: 922761ff9383f47f6efc030377241316
hunk ./gtk/Graphics/UI/Gtk/General/Structs.hsc 565
-toResponse i | i > 0 = ResponseUser $ fromIntegral i
+toResponse i | i >= 0 = ResponseUser $ fromIntegral i
|
|
From: Axel S. <si...@co...> - 2009-04-24 14:48:05
|
Fri Apr 24 10:47:10 EDT 2009 Axel Simon <Axe...@en...>
* Unregister packages in reverse order to avoid dependency conflict.
hunk ./Makefile.am 3076
- $(foreach pkgname,$(pkglib_LIBRARIES), \
+ $(foreach pkgname,$(call reverse,$(pkglib_LIBRARIES)), \
hunk ./mk/common.mk 5
+
+# Define a reverse function in pure GNU make
+reverse = $(if $(1),$(call reverse,$(wordlist 2,$(words $(1)),$(1)))) $(firstword $(1))
|
|
From: Peter g. <pg...@co...> - 2009-04-24 02:35:35
|
Thu Apr 23 22:27:57 EDT 2009 pg...@gm...
* Makefile.am: add package dependencies to haddock command line
Ignore-this: 4bbe2fde77816e01e7b8be81863cb234
hunk ./Makefile.am 2852
- $(sort $(foreach HSFILE, $(htmldoc_HSFILES_AM), $($(HSFILE)_HCFLAGS)))) \
+ $(sort $(foreach HSFILE, $(htmldoc_HSFILES_AM), $($(HSFILE)_HCFLAGS))) \
+ $(HIDE_ALL_PACKAGES)) \
+ $(foreach DEP,$(sort $(foreach PACKAGE, $(PACKAGES),$(libHS$(PACKAGE)_a_EXTERNALDEPS))),--optghc='-package $(DEP)') \
|
|
From: Axel S. <si...@co...> - 2009-04-17 15:18:37
|
Fri Apr 17 10:35:11 EDT 2009 Axel Simon <Axe...@en...>
* Correct arguments of a finally statement.
This code has obviously never been tested. Thanks to Bertram Felgenhauer to spot this.
hunk ./gnomevfs/System/Gnome/VFS/Marshal.chs 116
- in finally (freeHaskellFunPtr cCallbackFunPtr) $
+ in (flip finally) (freeHaskellFunPtr cCallbackFunPtr) $
|
|
From: Axel S. <si...@co...> - 2009-04-17 14:26:50
|
Fri Apr 17 10:24:37 EDT 2009 Axel Simon <Axe...@en...>
* Adapt demo to use new Exception module.
hunk ./demo/treeList/DirList.hs 1
+{-# OPTIONS -cpp #-}
hunk ./demo/treeList/DirList.hs 8
-import Control.Exception (handle)
+import Control.Exception
hunk ./demo/treeList/DirList.hs 28
- s <- handle (\_ -> return 0) $
- do h <- openFile f ReadMode
+ s <- handle (\e ->
+#if __GLASGOW_HASKELL__>=610
+ case e :: SomeException of
+ e ->
+#endif
+ return 0) $ do
+ h <- openFile f ReadMode
|
|
From: Axel S. <si...@co...> - 2009-04-11 07:18:10
|
Wed Apr 8 22:41:58 EDT 2009 mau...@gm...
* Add 'clean-all' option to tools/apiGen/Makefile
This adds a 'clean-all' option to apiGen's make
file. It will erase everything not on the original
distribution. This may be usefull if we are
testing different versions of packages, and need
to remove tarballs between tests.
hunk ./tools/apiGen/Makefile 26
+ @echo
+ @echo "make clean"
+ @echo " Removes files from apiGen build."
+ @echo
+ @echo "make clean-all"
+ @echo " Removes all created files, including downloaded tarballs."
hunk ./tools/apiGen/Makefile 430
- rm src/*.o src/*.hi ApiGen gapi_format_xml
- rm *-api.xml *-docs.xml
+ rm src/*.o src/*.hi ApiGen gapi_format_xml || true
+ rm *-api.xml *-docs.xml || true
+clean-all : clean
+ rm -r atk gconf glade gtk glib sourceview pango || true
+ rm -r gtk-modules tars glade-modules pango-modules || true
|
|
From: Axel S. <si...@co...> - 2009-04-07 19:19:49
|
Tue Apr 7 04:46:17 EDT 2009 Bertram Felgenhauer <in...@gm...>
* gio: Avoid calling (freeHaskellFunPtr nullFunPtr).
hunk ./gio/System/GIO/File.chs.pp 657
- freeHaskellFunPtr cProgressCallback
+ when (cProgressCallback /= nullFunPtr) $
+ freeHaskellFunPtr cProgressCallback
hunk ./gio/System/GIO/File.chs.pp 677
- freeHaskellFunPtr cProgressCallback
+ when (cProgressCallback /= nullFunPtr) $
+ freeHaskellFunPtr cProgressCallback
hunk ./gio/System/GIO/File.chs.pp 718
- freeHaskellFunPtr cProgressCallback
+ when (cProgressCallback /= nullFunPtr) $
+ freeHaskellFunPtr cProgressCallback
|
|
From: Axel S. <si...@co...> - 2009-04-03 16:07:03
|
Fri Mar 27 07:06:03 EDT 2009 Axel Simon <Axe...@en...>
* Make explicit use of concurrent finalizers.
This patch acounts for the change of semantics that finalizers undergo with
the release of GHC 6.10.1. Specifcially, finalizers are now by default
run during garbage collection, making it impossible to have them call back
to Haskell land. This patch uses functions that specifically schedule any
finilizers to be run as new threads once the mutator springs back to life.
hunk ./glib/System/Glib/FFI.hs.pp 46
+#if (__GLASGOW_HASKELL__>=610)
+import qualified Foreign.Concurrent
+#endif
hunk ./glib/System/Glib/FFI.hs.pp 53
+#if (__GLASGOW_HASKELL__>=610)
+newForeignPtr :: Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
+newForeignPtr p finalizer
+ = Foreign.Concurrent.newForeignPtr p (mkFinalizer finalizer p)
+
+foreign import ccall "dynamic"
+ mkFinalizer :: FinalizerPtr a -> Ptr a -> IO ()
+#else
+newForeignPtr :: Ptr a -> FinalizerPtr a -> IO (ForeignPtr a)
hunk ./glib/System/Glib/FFI.hs.pp 63
+#endif
|
|
From: Axel S. <si...@co...> - 2009-03-30 18:20:26
|
Sat Mar 7 03:05:30 EST 2009 Hamish Mackenzie <ha...@fi...>
* Add eventClick to EventM
Ignore-this: ff7b605b58d6021248f9951b4c641209
hunk ./gtk/Graphics/UI/Gtk/Gdk/EventM.hsc 130
+ eventClick,
hunk ./gtk/Graphics/UI/Gtk/Gdk/EventM.hsc 473
+--- | Query the mouse click.
+eventClick :: EventM EButton Click
+eventClick = do
+ ptr <- ask
+ liftIO $ do
+ (ty :: #{gtk2hs_type GdkEventType}) <- peek (castPtr ptr)
+ case ty of
+ #{const GDK_BUTTON_PRESS} -> return SingleClick
+ #{const GDK_2BUTTON_PRESS} -> return DoubleClick
+ #{const GDK_3BUTTON_PRESS} -> return TripleClick
+ #{const GDK_BUTTON_RELEASE} -> return ReleaseClick
+ _ -> error ("eventClick: non for event type "++show ty)
+
|
2 messages has been excluded from this view by a project administrator.
