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-07-25 15:10:22
|
Wed Jul 25 07:49:24 PDT 2007 Duncan Coutts <du...@ha...> * Build the statusicon demo hunk ./Makefile.am 1929 +endif +if HAVE_GTK_VERSION_2_10 +DEMOS += demo/statusicon |
From: Duncan C. <dun...@wo...> - 2007-07-23 15:04:09
|
Mon Jul 23 07:56:41 PDT 2007 Duncan Coutts <du...@ha...> * Must not use _static version of pango_font_description_set_family Since the string buffer is only kept around temporarily, not forever like pango_font_description_set_family_static requires. hunk ./gtk/Graphics/UI/Gtk/Pango/Description.chs 90 - {#call unsafe set_family_static#} fd strPtr + {#call unsafe set_family#} fd strPtr |
From: Duncan C. <dun...@wo...> - 2007-07-23 15:01:56
|
Mon Jul 23 07:56:41 PDT 2007 Duncan Coutts <du...@ha...> * Must not use _static version of pango_font_description_set_family Since the string buffer is only kept around temporarily, not forever like pango_font_description_set_family_static requires. hunk ./gtk/Graphics/UI/Gtk/Pango/Description.chs 90 - {#call unsafe set_family_static#} fd strPtr + {#call unsafe set_family#} fd strPtr |
From: Axel S. <A....@ke...> - 2007-07-16 12:39:50
|
Mon Jul 16 05:37:08 PDT 2007 A....@ke... * Fix bug in TreeStore on empty stores. This fixes a bug when running e.g. treeModelIterNChildren store Nothing when store is an empty TreeStore. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 322 -checkSuccess depth iter cache = (cmp cur iter && not (null sibs), cache') +checkSuccess depth iter cache = case advanceCache depth iter cache of + cache'@((cur,sibs):_) -> (cmp cur iter && not (null sibs), cache') + [] -> (False, []) |
From: Axel S. <A....@ke...> - 2007-07-16 12:39:48
|
Mon Jul 16 05:35:09 PDT 2007 A....@ke... * Rename the local cairo.h to something less ambiguous. I can't recall where this became a problem, but I guess it can't hurt to have this name distinct from the real header file. move ./cairo/cairo.h ./cairo/cairo-gtk2hs.h hunk ./Makefile.am 1236 -libHScairo_a_HEADER = cairo/cairo.h +libHScairo_a_HEADER = cairo/cairo-gtk2hs.h |
From: Axel S. <A....@ke...> - 2007-07-16 10:50:46
|
Mon Jul 16 03:49:09 PDT 2007 Peter Gavin <pg...@gm...> * glib: import GDateTime instead of GDate Brainfart. hunk ./glib/System/Glib.hs 10 - module System.Glib.GDate + module System.Glib.GDateTime hunk ./glib/System/Glib.hs 20 -import System.Glib.GDate +import System.Glib.GDateTime hunk ./glib/System/Glib/GDateTime.chs 6 --- Created: 19 March 2002 +-- Created: July 2007 hunk ./glib/System/Glib/GDateTime.chs 8 --- Copyright (C) 2002 Axel Simon +-- Copyright (C) 2007 Peter Gavin [_$_] |
From: Axel S. <A....@ke...> - 2007-07-16 10:50:43
|
Fri Jul 13 13:54:16 PDT 2007 Peter Gavin <pg...@gm...> * glib: add GSource support hunk ./glib/System/Glib/MainLoop.chs.pp 52 + Source, + sourceAttach, + sourceSetPriority, + sourceGetPriority hunk ./glib/System/Glib/MainLoop.chs.pp 298 +{# pointer *GSource as Source foreign newtype #} +newSource :: Ptr Source + -> IO Source +newSource sourcePtr = + liftM Source $ newForeignPtr sourcePtr sourceFinalizer +foreign import ccall unsafe "&g_source_unref" + sourceFinalizer :: FunPtr (Ptr Source -> IO ()) + +sourceAttach :: Source + -> MainContext + -> IO Word +sourceAttach source context = + liftM fromIntegral $ {# call source_attach #} source context + +sourceSetPriority :: Source + -> Priority + -> IO () +sourceSetPriority source priority = + {# call source_set_priority #} source $ fromIntegral priority + +sourceGetPriority :: Source + -> IO Priority +sourceGetPriority source = + liftM fromIntegral $ {# call source_get_priority #} source + + |
From: Axel S. <A....@ke...> - 2007-07-16 10:50:42
|
Fri Jul 13 10:56:25 PDT 2007 Peter Gavin <pg...@gm...> * glib: add GDate to exports in Glib.hs hunk ./glib/System/Glib.hs 9 - module System.Glib.GList + module System.Glib.GList, + module System.Glib.GDate hunk ./glib/System/Glib.hs 20 +import System.Glib.GDate |
From: Axel S. <A....@ke...> - 2007-07-16 10:50:39
|
Wed Jul 11 18:32:00 PDT 2007 Peter Gavin <pg...@gm...> * glib: make module name for GDateTime the same as the filename :) hunk ./glib/System/Glib/GDateTime.chs 25 -module System.Glib.GDate ( +module System.Glib.GDateTime ( |
From: Axel S. <A....@ke...> - 2007-07-16 10:50:37
|
Tue Jul 10 20:58:13 PDT 2007 Peter Gavin <pg...@gm...> * glib: added support for GDate/GTimeVal hunk ./Makefile.am 263 - glib/System/Glib/MainLoop.chs.pp + glib/System/Glib/MainLoop.chs.pp \ + glib/System/Glib/GDateTime.chs addfile ./glib/System/Glib/GDateTime.chs hunk ./glib/System/Glib/GDateTime.chs 1 +-- -*-haskell-*- +-- GIMP Toolkit (GTK) +-- +-- Author : Peter Gavin +-- +-- Created: 19 March 2002 +-- +-- Copyright (C) 2002 Axel Simon +-- +-- This library is free software; you can redistribute it and/or +-- modify it under the terms of the GNU Lesser General Public +-- License as published by the Free Software Foundation; either +-- version 2.1 of the License, or (at your option) any later version. +-- +-- This library is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +-- Lesser General Public License for more details. +-- +-- | +-- Maintainer : gtk...@li... +-- Stability : provisional +-- Portability : portable (depends on GHC) +-- +module System.Glib.GDate ( + GTimeValPart, + GTimeVal(..), + gGetCurrentTime, + gUSleep, + gTimeValAdd, + gTimeValFromISO8601, + gTimeValToISO8601, + GDate(..), + GDateDay, + GDateMonth, + GDateYear, + GDateJulianDay, + GDateWeekday, + gDateValidJulian, + gDateValidDMY, + gDateNewJulian, + gDateNewDMY, + gDateSetDay, + gDateSetMonth, + gDateSetYear, + gDateNewTimeVal, + gDateParse, + gDateAddDays, + gDateSubtractDays, + gDateAddMonths, + gDateSubtractMonths, + gDateAddYears, + gDateSubtractYears, + gDateDaysBetween, + gDateCompare, + gDateClamp, + gDateDay, + gDateMonth, + gDateYear, + gDateWeekday + ) where + +import Control.Monad (liftM) +import System.Glib.FFI +import System.Glib.UTFString + +type GTimeValPart = {# type glong #} +data GTimeVal = GTimeVal { gTimeValSec :: GTimeValPart + , gTimeValUSec :: GTimeValPart } + deriving (Eq, Ord) +instance Storable GTimeVal where + sizeOf _ = {# sizeof GTimeVal #} + alignment _ = alignment (undefined :: CString) + peek ptr = + do sec <- {# get GTimeVal->tv_sec #} ptr + uSec <- {# get GTimeVal->tv_usec #} ptr + return $ GTimeVal sec uSec + poke ptr (GTimeVal sec uSec) = + do {# set GTimeVal->tv_sec #} ptr sec + {# set GTimeVal->tv_usec #} ptr uSec + +gGetCurrentTime :: IO GTimeVal +gGetCurrentTime = + alloca $ \ptr -> + do {# call g_get_current_time #} $ castPtr ptr + peek ptr + +gUSleep :: GTimeValPart + -> IO () +gUSleep microseconds = + {# call g_usleep #} $ fromIntegral microseconds + +gTimeValAdd :: GTimeVal + -> GTimeValPart + -> GTimeVal +gTimeValAdd time microseconds = + unsafePerformIO $ with time $ \ptr -> + do {# call g_time_val_add #} (castPtr ptr) microseconds + peek ptr + +gTimeValFromISO8601 :: String + -> Maybe GTimeVal +gTimeValFromISO8601 isoDate = + unsafePerformIO $ withUTFString isoDate $ \cISODate -> + alloca $ \ptr -> + do success <- liftM toBool $ {# call g_time_val_from_iso8601 #} cISODate $ castPtr ptr + if success + then liftM Just $ peek ptr + else return Nothing + +gTimeValToISO8601 :: GTimeVal + -> String +gTimeValToISO8601 time = + unsafePerformIO $ with time $ \ptr -> + {# call g_time_val_to_iso8601 #} (castPtr ptr) >>= readUTFString + +newtype GDateDay = GDateDay {# type GDateDay #} + deriving (Eq, Ord) +instance Bounded GDateDay where + minBound = GDateDay 1 + maxBound = GDateDay 31 + +{# enum GDateMonth {underscoreToCase} deriving (Eq, Ord) #} +instance Bounded GDateMonth where + minBound = GDateJanuary + maxBound = GDateDecember + +newtype GDateYear = GDateYear {# type GDateYear #} + deriving (Eq, Ord) +instance Bounded GDateYear where + minBound = GDateYear 1 + maxBound = GDateYear (maxBound :: {# type guint16 #}) + +type GDateJulianDay = {# type guint32 #} +newtype GDate = GDate { gDateJulianDay :: GDateJulianDay } + deriving (Eq) +instance Storable GDate where + sizeOf _ = {# sizeof GDate #} + alignment _ = alignment (undefined :: CString) + peek = + (liftM (GDate . fromIntegral)) . {# call g_date_get_julian #} . castPtr + poke ptr val = + {# call g_date_set_julian #} (castPtr ptr) $ gDateJulianDay val + +{# enum GDateWeekday {underscoreToCase} deriving (Eq, Ord) #} +instance Bounded GDateWeekday where + minBound = GDateMonday + maxBound = GDateSunday + +gDateValidJulian :: GDateJulianDay + -> Bool +gDateValidJulian = + toBool . {# call fun g_date_valid_julian #} + +gDateValidDMY :: GDateDay + -> GDateMonth + -> GDateYear + -> Bool +gDateValidDMY (GDateDay day) month (GDateYear year) = + toBool $ {# call fun g_date_valid_dmy #} day + (fromIntegral $ fromEnum month) + year + +gDateNewJulian :: GDateJulianDay + -> Maybe GDate +gDateNewJulian julian = + if gDateValidJulian julian + then Just $ GDate julian + else Nothing + +gDateNewDMY :: GDateDay + -> GDateMonth + -> GDateYear + -> Maybe GDate +gDateNewDMY day month year = + if gDateValidDMY day month year + then Just $ unsafePerformIO $ alloca $ \ptr -> + do let GDateDay day' = day + GDateYear year' = year + {# call g_date_set_dmy #} (castPtr ptr) + day' + (fromIntegral $ fromEnum month) + year' + peek ptr + else Nothing + +gDateSetDay :: GDate + -> GDateDay + -> Maybe GDate +gDateSetDay date (GDateDay day) = + unsafePerformIO $ with date $ \ptr -> + do {# call g_date_set_day #} (castPtr ptr) day + valid <- liftM toBool $ {# call g_date_valid #} $ castPtr ptr + if valid + then liftM Just $ peek ptr + else return Nothing + +gDateSetMonth :: GDate + -> GDateMonth + -> Maybe GDate +gDateSetMonth date month = + unsafePerformIO $ with date $ \ptr -> + do {# call g_date_set_month #} (castPtr ptr) $ fromIntegral $ fromEnum month + valid <- liftM toBool $ {# call g_date_valid #} $ castPtr ptr + if valid + then liftM Just $ peek ptr + else return Nothing + +gDateSetYear :: GDate + -> GDateYear + -> Maybe GDate +gDateSetYear date (GDateYear year) = + unsafePerformIO $ with date $ \ptr -> + do {# call g_date_set_year #} (castPtr ptr) year + valid <- liftM toBool $ {# call g_date_valid #} $ castPtr ptr + if valid + then liftM Just $ peek ptr + else return Nothing + +gDateNewTimeVal :: GTimeVal + -> GDate +gDateNewTimeVal timeVal = + unsafePerformIO $ alloca $ \ptr -> + with timeVal $ \timeValPtr -> + do {# call g_date_set_time_val #} (castPtr ptr) $ castPtr timeValPtr + peek ptr + +gDateParse :: String + -> IO (Maybe GDate) +gDateParse str = + alloca $ \ptr -> + do withUTFString str $ {# call g_date_set_parse #} $ castPtr ptr + valid <- liftM toBool $ {# call g_date_valid #} $ castPtr ptr + if valid + then liftM Just $ peek ptr + else return Nothing + +gDateAddDays :: GDate + -> Word + -> GDate +gDateAddDays date nDays = + unsafePerformIO $ with date $ \ptr -> + do {# call g_date_add_days #} (castPtr ptr) $ fromIntegral nDays + peek ptr + +gDateSubtractDays :: GDate + -> Word + -> GDate +gDateSubtractDays date nDays = + unsafePerformIO $ with date $ \ptr -> + do {# call g_date_subtract_days #} (castPtr ptr) $ fromIntegral nDays + peek ptr + +gDateAddMonths :: GDate + -> Word + -> GDate +gDateAddMonths date nMonths = + unsafePerformIO $ with date $ \ptr -> + do {# call g_date_add_months #} (castPtr ptr) $ fromIntegral nMonths + peek ptr + +gDateSubtractMonths :: GDate + -> Word + -> GDate +gDateSubtractMonths date nMonths = + unsafePerformIO $ with date $ \ptr -> + do {# call g_date_subtract_months #} (castPtr ptr) $ fromIntegral nMonths + peek ptr + +gDateAddYears :: GDate + -> Word + -> GDate +gDateAddYears date nYears = + unsafePerformIO $ with date $ \ptr -> + do {# call g_date_add_years #} (castPtr ptr) $ fromIntegral nYears + peek ptr + +gDateSubtractYears :: GDate + -> Word + -> GDate +gDateSubtractYears date nYears = + unsafePerformIO $ with date $ \ptr -> + do {# call g_date_subtract_years #} (castPtr ptr) $ fromIntegral nYears + peek ptr + +gDateDaysBetween :: GDate + -> GDate + -> Int +gDateDaysBetween date1 date2 = + fromIntegral $ unsafePerformIO $ with date1 $ \ptr1 -> + with date2 $ \ptr2 -> + {# call g_date_days_between #} (castPtr ptr1) $ castPtr ptr2 + +gDateCompare :: GDate + -> GDate + -> Ordering +gDateCompare date1 date2 = + let result = fromIntegral $ unsafePerformIO $ with date1 $ \ptr1 -> + with date2 $ \ptr2 -> + {# call g_date_compare #} (castPtr ptr1) $ castPtr ptr2 + ordering | result < 0 = LT + | result > 0 = GT + | otherwise = EQ + in ordering + +instance Ord GDate where + compare = gDateCompare + +gDateClamp :: GDate + -> GDate + -> GDate + -> GDate +gDateClamp date minDate maxDate = + unsafePerformIO $ with date $ \ptr -> + with minDate $ \minPtr -> + with maxDate $ \maxPtr -> + do {# call g_date_clamp #} (castPtr ptr) (castPtr minPtr) $ castPtr maxPtr + peek ptr + +gDateDay :: GDate + -> GDateDay +gDateDay date = + GDateDay $ unsafePerformIO $ with date $ {# call g_date_get_day #} . castPtr + +gDateMonth :: GDate + -> GDateMonth +gDateMonth date = + toEnum $ fromIntegral $ unsafePerformIO $ with date $ {# call g_date_get_month #} . castPtr + +gDateYear :: GDate + -> GDateYear +gDateYear date = + GDateYear $ unsafePerformIO $ with date $ {# call g_date_get_year #} . castPtr + +gDateWeekday :: GDate + -> GDateWeekday +gDateWeekday date = + toEnum $ fromIntegral $ unsafePerformIO $ with date $ {# call g_date_get_weekday #} . castPtr |
From: Axel S. <A....@ke...> - 2007-07-16 10:33:32
|
Mon Jul 16 03:27:22 PDT 2007 A....@ke... * Make the new ModelView interface self contained. This patch moves a few model functions from CustomStore to TreeModel. Also, it duplicates the TreeIter and TreePath definitions by copying them into the ModelView.Types file. The TreeModel module is now complete. However, another step would be to re-export all functions from CustomStore via TreeModel and hide CustomStore. The user would then be able to define a new store by just importing TreeModel. move ./gtk/Graphics/UI/Gtk/TreeList/TreeRowReference.chs.pp ./gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp hunk ./Makefile.am 515 - gtk/Graphics/UI/Gtk/TreeList/TreeRowReference.chs.pp \ hunk ./Makefile.am 542 + gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp \ hunk ./Makefile.am 590 - gtk/Graphics/UI/Gtk/TreeList/TreeRowReference.hs \ - gtk/Graphics/UI/Gtk/ModelView/TreePath.hs \ - gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.hs \ hunk ./gtk/Graphics/UI/Gtk/ModelView.hs 49 + module Graphics.UI.Gtk.ModelView.TreeRowReference, hunk ./gtk/Graphics/UI/Gtk/ModelView.hs 53 - module Graphics.UI.Gtk.ModelView.TreeViewColumn, - module Graphics.UI.Gtk.ModelView.Types, + module Graphics.UI.Gtk.ModelView.TreeViewColumn hunk ./gtk/Graphics/UI/Gtk/ModelView.hs 72 +import Graphics.UI.Gtk.ModelView.TreeRowReference hunk ./gtk/Graphics/UI/Gtk/ModelView.hs 77 -import Graphics.UI.Gtk.ModelView.Types hunk ./gtk/Graphics/UI/Gtk/ModelView/CellLayout.chs.pp 71 -{#import Graphics.UI.Gtk.TreeList.TreeIter#} hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererPixbuf.chs.pp 29 --- [_$_] +-- hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 208 --- | The ::toggled signal is emitted when the cell is toggled. +-- | The 'toggled' signal is emitted when the cell is toggled. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 144 -import Graphics.UI.Gtk.ModelView.Types (TypedTreeModelClass) +{#import Graphics.UI.Gtk.ModelView.Types#} (TypedTreeModelClass, + TreeIter, + receiveTreeIter) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 148 -{#import Graphics.UI.Gtk.TreeList.TreeIter#} (TreeIter(..), receiveTreeIter) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 648 -popupShownNotify = Signal (Connect_NONE__NONE "notify::popup-shown") +popupShownNotify = Signal (connect_NONE__NONE "notify::popup-shown") hunk ./gtk/Graphics/UI/Gtk/ModelView/CustomStore.chs 28 + TreeModelFlags(..), + [_$_] hunk ./gtk/Graphics/UI/Gtk/ModelView/CustomStore.chs 43 - - -- * View notification functions - treeModelRowChanged, - treeModelRowInserted, - treeModelRowHasChildToggled, - treeModelRowDeleted, - treeModelRowsReordered, hunk ./gtk/Graphics/UI/Gtk/ModelView/CustomStore.chs 48 -import System.Glib.Flags (fromFlags) +import System.Glib.Flags (Flags, fromFlags) hunk ./gtk/Graphics/UI/Gtk/ModelView/CustomStore.chs 52 -{#import Graphics.UI.Gtk.ModelView.TreeModel#} -{#import Graphics.UI.Gtk.TreeList.TreeIter#} -{#import Graphics.UI.Gtk.TreeList.TreePath#} - hunk ./gtk/Graphics/UI/Gtk/ModelView/CustomStore.chs 63 +-- | These flags indicate various properties of a 'TreeModel'. +-- +-- * If a model has "TreeModelItersPersist" set, iterators remain valid +-- after a "TreeModel" signal was emitted. +-- +-- * The "TreeModelListOnly" flag is set if the rows are arranged in a +-- simple flat list. This is set in the "ListStore" implementation. +-- +{#enum TreeModelFlags {underscoreToCase} deriving(Bounded)#} + +instance Flags TreeModelFlags + hunk ./gtk/Graphics/UI/Gtk/ModelView/CustomStore.chs 367 - hunk ./gtk/Graphics/UI/Gtk/ModelView/CustomStore.chs 370 --- | Emits the \"row_changed\" signal on the 'CustomTreeModel'. --- -treeModelRowChanged :: - CustomTreeModel private row - -> TreePath -- ^ @path@ - A 'TreePath' pointing to the changed row - -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the changed row - -> IO () -treeModelRowChanged model path iter = - withTreePath path $ \pathPtr -> - customTreeModelGetStamp model >>= \stamp -> - with (iterSetStamp stamp iter) $ \iterPtr -> - {# call gtk_tree_model_row_changed #} - (toTreeModel model) - pathPtr - iterPtr - --- | Emits the \"row_inserted\" signal on the 'CustomTreeModel' --- -treeModelRowInserted :: - CustomTreeModel private row - -> TreePath -- ^ @path@ - A 'TreePath' pointing to the inserted row - -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the inserted row - -> IO () -treeModelRowInserted model path iter = - withTreePath path $ \pathPtr -> - customTreeModelGetStamp model >>= \stamp -> - with (iterSetStamp stamp iter) $ \iterPtr -> - {# call gtk_tree_model_row_inserted #} - (toTreeModel model) - pathPtr - iterPtr - --- | Emits the \"row_has_child_toggled\" signal on the 'CustomTreeModel'. This should --- be called by models after a node went from having no children to having --- at least one child or vice versa. --- -treeModelRowHasChildToggled :: - CustomTreeModel private row - -> TreePath -- ^ @path@ - A 'TreePath' pointing to the changed row - -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the changed row - -> IO () -treeModelRowHasChildToggled model path iter = - withTreePath path $ \pathPtr -> - customTreeModelGetStamp model >>= \stamp -> - with (iterSetStamp stamp iter) $ \iterPtr -> - {# call gtk_tree_model_row_has_child_toggled #} - (toTreeModel model) - pathPtr - iterPtr - --- | Emits the \"row_deleted\" signal the 'CustomTreeModel'. This should be called by --- models after a row has been removed. The location pointed to by @path@ --- should be the location that the row previously was at. It may not be a valid --- location anymore. --- -treeModelRowDeleted :: - CustomTreeModel private row - -> TreePath -- ^ @path@ - A 'TreePath' pointing to the previous location of - -- the deleted row. - -> IO () -treeModelRowDeleted model path = - withTreePath path $ \pathPtr -> - {# call gtk_tree_model_row_deleted #} - (toTreeModel model) - pathPtr - --- | Emits the \"rows_reordered\" signal on the 'CustomTreeModel'. This should be --- called by models when their rows have been reordered. --- -treeModelRowsReordered :: - CustomTreeModel private row - -> TreePath -- ^ @path@ - A 'TreePath' pointing to the tree node whose - -- children have been reordered - -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the node whose - -- children have been reordered, or {@NULL@, FIXME: this should - -- probably be converted to a Maybe data type} if the depth of - -- @path@ is 0. - -> [Int] -- ^ @newOrder@ - an array of integers mapping the current - -- position of each child to its old position before the - -- re-ordering, i.e. @newOrder@@[newpos] = oldpos@. - -> IO () -treeModelRowsReordered model path iter newOrder = - withTreePath path $ \pathPtr -> - customTreeModelGetStamp model >>= \stamp -> - with (iterSetStamp stamp iter) $ \iterPtr -> - withArrayLen (map fromIntegral newOrder) $ \newLength newOrderArrPtr -> do - --check newOrder is the right length or it'll overrun - curLength <- treeModelIterNChildren model (Just iter) - when (curLength /= newLength) - (fail "treeModelRowsReordered: mapping wrong length for store") - {# call gtk_tree_model_rows_reordered #} - (toTreeModel model) - pathPtr - iterPtr - newOrderArrPtr hunk ./gtk/Graphics/UI/Gtk/ModelView/EntryCompletion.chs.pp 133 -{#import Graphics.UI.Gtk.TreeList.TreeIter#} (TreeIter) hunk ./gtk/Graphics/UI/Gtk/ModelView/IconView.chs.pp 148 -{#import Graphics.UI.Gtk.TreeList.TreePath#} hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 60 -import Graphics.UI.Gtk.ModelView.Types (TypedTreeModelClass) -import Graphics.UI.Gtk.ModelView.TreeModel (TreeModelFlags(TreeModelListOnly)) +import Graphics.UI.Gtk.ModelView.Types (TypedTreeModelClass, TreeIter(..)) hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 62 -import Graphics.UI.Gtk.TreeList.TreeIter +import Graphics.UI.Gtk.ModelView.TreeModel hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 8 --- Copyright (C) 1999-2005 Axel Simon +-- Copyright (C) 1999-2007 Axel Simon hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 25 --- The tree interface used by 'TreeView' +-- The tree interface used by 'TreeView'. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 29 --- [_$_] +-- [_$_] hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 31 --- 'TreeView' widget. It is purely abstract, concrete implementations that --- store data for a list or tree are 'ListStore' and 'TreeStore'. +-- 'TreeView' widget. In other words, this module exposes the C interface that +-- Gtk uses to populate the 'TreeView' widget. While this module is an +-- interface from the perspective of Gtk, this module provides a skeleton to +-- create an object that implements this interface. Two implementations that +-- come with Gtk2Hs are 'ListStore' and 'TreeStore'. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 37 --- The model is represented as a hierarchical tree of strongly-typed, --- columned data. In other words, the model can be seen as a tree where every --- node has different values depending on which column is being queried. The --- type of data found in a column can be arbitrary, ranging from basic --- types like 'String's or 'Int' to user specific types. The types are --- homogeneous per column across all nodes. It is important to note that this --- interface only provides a way of examining a model and observing changes. --- The implementation of each individual model decides how and if changes are --- made. +-- The model is represented as a hierarchical tree of values. It is important +-- to note that this interface only provides a way of examining a model and +-- observing changes. The implementation of each individual model decides how +-- and if changes are made. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 43 --- the --- 'TreeStore' and the 'ListStore'. To use these, the developer simply pushes --- data into these models as necessary. These models provide the data [_$_] +-- the 'TreeStore' and the 'ListStore'. To use these, the developer simply +-- inserts data into these models as necessary. These models provide the data hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 46 --- other interfaces making drag --- and drop, sorting, and storing data trivial. +-- other interfaces making drag and drop and storing data trivial. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 48 --- Models are accessed on a node\/column level of granularity. One can query --- for the value of a model at a certain node and a certain column on that --- node. There are two structures used to reference a particular node in a --- model. They are the 'TreePath' and the 'TreeIter' Most of the interface --- consists of operations on a 'TreeIter'. +-- Models are accessed on a node level of granularity. There are two index +-- types used to reference a particular node in a model. They are the +-- 'TreePath' and the 'TreeIter'. Most of the interface consists of operations +-- on a 'TreeIter'. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 55 --- 'TreePath' is in fact just a list of 'Int's and hence are easy to --- manipulate. Each number refers to the offset at that level. Thus, the [_$_] --- path @[0]@ refers to the --- root node and the path @[2,4]@ refers to the fifth child of the third node. +-- 'TreePath' is in fact a synonym for a list of 'Int's and hence are easy to +-- manipulate. Each number refers to the offset at that level. Thus, the path +-- @[0]@ refers to the root node and the path @[2,4]@ refers to the fifth +-- child of the third node. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 61 --- model. It is an abstract data type filled in by the model. One can convert a --- path to an iterator by calling 'treeModelGetIter'. These iterators are the --- primary way of accessing a model and are similar to the iterators used by --- 'TextBuffer'. The model interface defines a set of operations using --- them for navigating the model. --- --- The lifecycle of an iterator can be a little confusing at first. --- Iterators are expected to always be valid for as long as the model is --- unchanged (and doesn't emit a signal). [_$_] --- Additionally, the 'TreeStore' and 'ListStore' models guarantee that [_$_] --- an iterator is valid for as long as the node it refers to is valid. --- Although generally uninteresting, as one --- always has to allow for the case where iterators do not persist beyond a --- signal, some very important performance enhancements were made in the sort --- model. As a result, the 'TreeModelItersPersist' flag was added to indicate --- this behavior. +-- model. It is an abstract data type filled in by the model. One can convert +-- a path to an iterator by calling 'treeModelGetIter'. These iterators are +-- the primary way of accessing a model and are similar to the iterators used +-- by 'TextBuffer'. The model interface defines a set of operations using them +-- for navigating the model. Iterators are expected to always be valid for as +-- long as the model is unchanged (and doesn't emit a signal). hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 74 +-- | +--------TypedTreeModel hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 82 + + TypedTreeModel, + TypedTreeModelClass, + toTypedTreeModel, + [_$_] hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 88 + TreeIter(..), hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 90 - TreeRowReference, - TreeIter, hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 92 + stringToTreePath, hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 94 - treeModelGetNColumns, - treeModelGetColumnType, - treeModelGetValue, - treeRowReferenceNew, - treeRowReferenceGetPath, - treeRowReferenceValid, hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 96 - gtk_tree_model_get_iter_from_string, -- internal hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 103 - treeModelIterParent + treeModelIterParent, + treeModelForeach, +#if GTK_CHECK_VERSION(2,2,0) + treeModelGetStringFromIter, +#endif + treeModelRefNode, + treeModelUnrefNode, + treeModelRowChanged, + treeModelRowInserted, + treeModelRowHasChildToggled, + treeModelRowDeleted, + treeModelRowsReordered, + +-- * Signals + rowChanged, + rowInserted, + rowHasChildToggled, + rowDeleted, + rowsReordered, + hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 128 -import System.Glib.Flags (Flags, toFlags) +import System.Glib.Flags (toFlags) hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 130 +{#import Graphics.UI.Gtk.Signals#} hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 135 -{#import Graphics.UI.Gtk.TreeList.TreeIter#} -{#import Graphics.UI.Gtk.TreeList.TreePath#} -{#import Graphics.UI.Gtk.TreeList.TreeRowReference#} +{#import Graphics.UI.Gtk.ModelView.CustomStore#} (TreeModelFlags(..), + treeModelGetRow) +{#import Graphics.UI.Gtk.ModelView.Types#} (TypedTreeModel, + TypedTreeModelClass, + toTypedTreeModel, + TreeIter(..), + receiveTreeIter, + peekTreeIter, + TreePath, + NativeTreePath(..), + withTreePath, + fromTreePath, + peekTreePath, + stringToTreePath) hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 152 --- | These flags indicate various properties of a 'TreeModel'. --- --- * If a model has "TreeModelItersPersist" set, iterators remain valid --- after a "TreeModel" signal was emitted. --- --- * The "TreeModelListOnly" flag is set if the rows are arranged in a --- simple flat list. This is set in the "ListStore" implementation. --- -{#enum TreeModelFlags {underscoreToCase} deriving(Bounded)#} - -instance Flags TreeModelFlags hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 156 +-- %hash d:35ea hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 168 --- | Returns the number of columns supported by the tree model. --- -treeModelGetNColumns :: TreeModelClass self => self - -> IO Int -- ^ returns The number of columns. -treeModelGetNColumns self = - liftM fromIntegral $ - {# call gtk_tree_model_get_n_columns #} - (toTreeModel self) - --- | Returns the type of the column. --- -treeModelGetColumnType :: TreeModelClass self => self - -> Int -- ^ @index@ - The column index. - -> IO TMType -treeModelGetColumnType self index = - liftM (toEnum.fromIntegral) $ - {# call tree_model_get_column_type #} - (toTreeModel self) - (fromIntegral index) - --- | Read the value of at a specific column and 'TreeIter'. --- -treeModelGetValue :: TreeModelClass self => self - -> TreeIter - -> Int -- ^ @column@ - The column to lookup the value at. - -> IO GenericValue -treeModelGetValue self iter column = - allocaGValue $ \vaPtr -> - with iter $ \iterPtr -> do - {# call tree_model_get_value #} - (toTreeModel self) - iterPtr - (fromIntegral column) - vaPtr - valueGetGenericValue vaPtr - --- | Maps a function over each node in model in a depth-first fashion. If it --- returns @True@, then the tree ceases to be walked, and 'treeModelForeach' --- returns. --- -treeModelForeach :: TreeModelClass self => self -> (TreeIter -> IO Bool) -> IO () -treeModelForeach self fun = do - fPtr <- mkTreeModelForeachFunc (\_ _ iterPtr _ -> do - -- make a deep copy of the iterator. This makes it possible to store this - -- iterator in Haskell land somewhere. The TreeModel parameter is not - -- passed to the function due to performance reasons. But since it is - -- a constant this does not matter. - iter <- peek iterPtr - liftM (fromIntegral.fromBool) $ fun iter - ) - {# call tree_model_foreach #} - (toTreeModel self) - fPtr - nullPtr - freeHaskellFunPtr fPtr - -{#pointer TreeModelForeachFunc#} - -foreign import ccall "wrapper" mkTreeModelForeachFunc :: - (Ptr () -> Ptr () -> Ptr TreeIter -> Ptr () -> IO CInt) -> IO TreeModelForeachFunc - +-- %hash c:35a1 d:49a2 hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 185 +-- %hash c:4cd2 d:ad96 hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 204 +-- %hash c:103f d:8041 hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 217 +-- %hash c:ec20 d:d43e hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 231 --- | Retrieve an iterator to the next child. +-- %hash c:5c12 d:d7db +-- | Retrieve an iterator to the node following it at the current level. If +-- there is no next node, @Nothing@ is returned. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 243 --- | Retrieve an iterator to the first child. +-- %hash c:7eba d:27e8 +-- | Retrieve an iterator to the first child of @parent@. If @parent@ has no +-- children, @Nothing@. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 248 - -> TreeIter + -> TreeIter -- ^ @parent@ - a pointer to the parent hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 258 +-- %hash c:dcc3 hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 271 +-- %hash c:eed hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 285 --- | Retrieve the @n@th child. --- --- If @Nothing@ is specified for the @self@ argument, the function will work --- on toplevel elements. +-- %hash c:6950 d:6f4d +-- | Retrieve the @n@th child of @parent@, counting from zero. If @n@ is too +-- big or @parent@ has no children, @Nothing@ is returned. If @Nothing@ is +-- specified for the @parent@ argument, the function will return the @n@th +-- root node. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 305 +-- %hash c:8f01 d:70ff hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModel.chs.pp 319 +-- %hash c:154f d:a6d +-- | Maps a function over each node in model in a depth-first fashion. If it +-- returns @True@, then the tree ceases to be walked, and 'treeModelForeach' +-- returns. +-- +treeModelForeach :: TreeModelClass self => self -> (TreeIter -> IO Bool) -> IO () +treeModelForeach self fun = do + fPtr <- mkTreeModelForeachFunc (\_ _ iterPtr _ -> do + -- make a deep copy of the iterator. This makes it possible to store this + -- iterator in Haskell land somewhere. The TreeModel parameter is not + -- passed to the function due to performance reasons. But since it is + -- a constant this does not matter. + iter <- peek iterPtr + liftM (fromIntegral.fromBool) $ fun iter + ) + {# call tree_model_foreach #} + (toTreeModel self) + fPtr + nullPtr + freeHaskellFunPtr fPtr + +{#pointer TreeModelForeachFunc#} + +foreign import ccall "wrapper" mkTreeModelForeachFunc :: + (Ptr () -> Ptr () -> Ptr TreeIter -> Ptr () -> IO CInt) -> + IO TreeModelForeachFunc + +#if GTK_CHECK_VERSION(2,2,0) +-- %hash c:f04a d:94fd +-- | Generates a string representation of the iter. This string is a \':\' +-- separated list of numbers. For example, \"4:10:0:3\" would be an acceptable +-- return value for this string. +-- +-- * Available since Gtk+ version 2.2 +-- +treeModelGetStringFromIter :: TreeModelClass self => self + -> TreeIter -- ^ @iter@ - An 'TreeIter'. + -> IO String -- ^ returns A newly-allocated string. Must be freed with + -- 'gFree'. +treeModelGetStringFromIter self iter = with iter $ \iter -> + {# call gtk_tree_model_get_string_from_iter #} + (toTreeModel self) + iter + >>= readUTFString +#endif + +-- %hash c:228e d:304e +-- | Lets the tree ref the node. This is an optional method for models to +-- implement. To be more specific, models may ignore this call as it exists +-- primarily for performance reasons. +-- +-- This function is primarily meant as a way for views to let caching model +-- know when nodes are being displayed (and hence, whether or not to cache that +-- node.) For example, a file-system based model would not want to keep the +-- entire file-hierarchy in memory, just the sections that are currently being +-- displayed by every current view. +-- +-- A model should be expected to be able to get an iter independent of its +-- reffed state. +-- +treeModelRefNode :: TreeModelClass self => self + -> TreeIter -- ^ @iter@ - The 'TreeIter'. + -> IO () +treeModelRefNode self iter = with iter $ \iter -> + {# call gtk_tree_model_ref_node #} + (toTreeModel self) + iter + +-- %hash c:f5d7 d:22a6 +-- | Lets the tree unref the node. This is an optional method for models to +-- implement. To be more specific, models may ignore this call as it exists +-- primarily for performance reasons. +-- +-- For more information on what this means, see 'treeModelRefNode'. Please +-- note that nodes that are deleted are not unreffed. +-- +treeModelUnrefNode :: TreeModelClass self => self + -> TreeIter -- ^ @iter@ - The 'TreeIter'. + -> IO () +treeModelUnrefNode self iter = with iter $ \iter -> + {# call gtk_tree_model_unref_node #} + (toTreeModel self) + iter + +-- %hash c:8d25 d:a7c9 +-- | Emits the 'rowChanged' signal on the model. +-- +-- * This function is only necessary to implement a custom tree model. When +-- using 'Graphics.UI.Gtk.ModelView.ListStore' or +-- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called +-- automatically. +-- +treeModelRowChanged :: TreeModelClass self => self + -> TreePath -- ^ @path@ - A 'TreePath' pointing to the changed row + -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the changed row + -> IO () +treeModelRowChanged self path iter = + with iter $ \iter -> + withTreePath path $ \path -> + {# call gtk_tree_model_row_changed #} + (toTreeModel self) + path + iter + +-- %hash c:f809 d:57af +-- | Emits the 'rowInserted' signal on the model. +-- +-- * This function is only necessary to implement a custom tree model. When +-- using 'Graphics.UI.Gtk.ModelView.ListStore' or +-- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called +-- automatically. +-- +treeModelRowInserted :: TreeModelClass self => self + -> TreePath -- ^ @path@ - A 'TreePath' pointing to the inserted row + -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the inserted row + -> IO () +treeModelRowInserted self path iter = + with iter $ \iter -> + withTreePath path $ \path -> + {# call gtk_tree_model_row_inserted #} + (toTreeModel self) + path + iter + +-- %hash c:e917 d:6534 +-- | Emits the 'rowHasChildToggled' signal on the model. This should be +-- called by models after the child state of a node changes. +-- +-- * This function is only necessary to implement a custom tree model. When +-- using 'Graphics.UI.Gtk.ModelView.ListStore' or +-- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called +-- automatically. +-- +treeModelRowHasChildToggled :: TreeModelClass self => self + -> TreePath -- ^ @path@ - A 'TreePath' pointing to the changed row + -> TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the changed row + -> IO () +treeModelRowHasChildToggled self path iter = + with iter $ \iter -> + withTreePath path $ \path -> + {# call gtk_tree_model_row_has_child_toggled #} + (toTreeModel self) + path + iter + +-- %hash c:c0a2 d:7ca6 +-- | Emits the 'rowDeleted' signal on the model. This should be called by +-- models after a row has been removed. The location pointed to by @path@ +-- should be the location that the row previously was at. It may not be a +-- valid location anymore. +-- +-- * This function is only necessary to implement a custom tree model. When +-- using 'Graphics.UI.Gtk.ModelView.ListStore' or +-- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called +-- automatically. +-- +treeModelRowDeleted :: TreeModelClass self => self + -> TreePath -- ^ @path@ - A 'TreePath' pointing to the previous location of + -- the deleted row. + -> IO () +treeModelRowDeleted self path = + withTreePath path $ \path -> + {# call gtk_tree_model_row_deleted #} + (toTreeModel self) + path + +-- %hash c:f0f3 d:a8c5 +-- | Emits the 'rowsReordered' signal on the model. This should be called by +-- models when their rows have been reordered. The length of @newOrder@ must +-- be equal to the value returned by @treeModelIterNChildren self iter@. +-- +-- * This function is only necessary to implement a custom tree model. When +-- using 'Graphics.UI.Gtk.ModelView.ListStore' or +-- 'Graphics.UI.Gtk.ModelView.TreeStore', this function is called +-- automatically. +-- +treeModelRowsReordered :: TreeModelClass self => self + -> TreePath -- ^ @path@ - A 'TreePath' pointing to the tree node whose + -- children have been reordered + -> Maybe TreeIter -- ^ @iter@ - A valid 'TreeIter' pointing to the node whose + -- children have been reordered, or @Nothing@ if [_$_] + -- @path@ is @[]@. + -> [Int] -- ^ @newOrder@ - a list of integers giving the previous position + -- of each node at this hierarchy level. + [_$_] + -> IO () +treeModelRowsReordered self path iter array = do + n <- treeModelIterNChildren self iter + let l = length array + if n/=l then error ("treeModelRowsReordered: passed-in array is of size " + ++show l++" but there are "++show n++ + " children at path "++show path) else + withTreePath path $ \path -> + maybeWith with iter $ \iter -> + withArray (map fromIntegral array) $ \newOrderPtr -> + {# call gtk_tree_model_rows_reordered #} + (toTreeModel self) + path + iter + newOrderPtr + +-------------------- +-- Signals + +-- %hash c:50c7 d:8da5 +-- | This signal is emitted when a row in the model has changed. +-- +rowChanged :: TreeModelClass self => Signal self (TreePath -> TreeIter -> IO ()) +rowChanged = Signal (connect_BOXED_BOXED__NONE "row_changed" peekTreePath peekTreeIter) + +-- %hash c:f31a d:3c6b +-- | This signal is emitted when a new row has been inserted in the model. +-- +-- +rowInserted :: TreeModelClass self => Signal self (TreePath -> TreeIter -> IO ()) +rowInserted = Signal (connect_BOXED_BOXED__NONE "row_inserted" peekTreePath peekTreeIter) + +-- %hash c:7279 d:5ef +-- | This signal is emitted when a row has gotten the first child row or lost +-- its last child row. +-- +rowHasChildToggled :: TreeModelClass self => Signal self (TreePath -> TreeIter -> IO ()) +rowHasChildToggled = Signal (connect_BOXED_BOXED__NONE "row_has_child_toggled" peekTreePath peekTreeIter) + +-- %hash c:f669 d:367f +-- | This signal is emitted when a row has been deleted. +-- +-- Note that no iterator is passed to the signal handler, since the row is +-- already deleted. +-- +-- Implementations of 'TreeModel' must emit row-deleted /before/ removing the +-- node from its internal data structures. This is because models and views +-- which access and monitor this model might have references on the node which +-- need to be released in the 'rowDeleted' handler. +-- +rowDeleted :: TreeModelClass self => Signal self (TreePath -> IO ()) +rowDeleted = Signal (connect_BOXED__NONE "row_deleted" peekTreePath) + +-- %hash c:46dd d:b2e5 +-- | This signal is emitted when the children of a node in the 'TreeModel' +-- have been reordered. See 'treeModelRowsReordered' for more information +-- about the parameters that this signal carries. +-- +-- Note that this signal is /not/ emitted when rows are reordered by DND, +-- since this is implemented by removing and then reinserting the row. +-- +rowsReordered :: TreeModelClass self => + Signal self (TreePath -> Maybe TreeIter -> [Int] -> IO ()) +rowsReordered = Signal $ \after model user -> + connect_BOXED_BOXED_PTR__NONE "rows_reordered" peekTreePath + (maybePeek peekTreeIter) after model $ \path iter arrayPtr -> do + n <- treeModelIterNChildren model iter + -- hopefully the model is never buggy, otherwise this can segfault + newOrder <- peekArray n arrayPtr + user path iter (map fromIntegral (newOrder :: [{#type gint#}])) hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModelSort.chs.pp 73 -{#import Graphics.UI.Gtk.TreeList.TreePath#} -{#import Graphics.UI.Gtk.TreeList.TreeIter#} +{#import Graphics.UI.Gtk.ModelView.Types#} hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp 20 --- #hide - hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp 25 --- [_$_] +-- A persistent index into a tree model. +-- +module Graphics.UI.Gtk.ModelView.TreeRowReference ( +-- * Detail +-- +-- | A 'RowReference' is an index into a +-- 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel' that is persistent even if +-- rows are inserted, deleted or reordered. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp 34 -module Graphics.UI.Gtk.TreeList.TreeRowReference ( hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp 50 -{#import Graphics.UI.Gtk.TreeList.TreePath#} +{#import Graphics.UI.Gtk.ModelView.Types#} hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp 64 --- to the node pointed to by the given path, so long as it exists. +-- to the node pointed to by the given path, so long as it exists. Returns @Nothing@ if there is no node at the given path. hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp 67 - -> NativeTreePath - -> IO TreeRowReference -treeRowReferenceNew self path = do - rowRefPtr <- throwIfNull "treeRowReferenceNew: invalid path given" $ + -> TreePath + -> IO (Maybe TreeRowReference) +treeRowReferenceNew self path = withTreePath path $ \path -> do + rowRefPtr <- [_$_] hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp 72 - liftM TreeRowReference $ + if rowRefPtr==nullPtr then return Nothing else + liftM (Just . TreeRowReference) $ hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeRowReference.chs.pp 86 - >>= fromTreePath + >>= fromTreePath -- path must be freed hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSelection.chs.pp 112 -{#import Graphics.UI.Gtk.TreeList.TreePath#} -{#import Graphics.UI.Gtk.TreeList.TreeIter#} +{#import Graphics.UI.Gtk.ModelView.Types#} hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 58 -import Graphics.UI.Gtk.TreeList.TreePath (TreePath) hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeStore.hs 59 -import Graphics.UI.Gtk.TreeList.TreeIter +import Graphics.UI.Gtk.ModelView.TreeModel hunk ./gtk/Graphics/UI/Gtk/ModelView/Types.chs 8 --- Copyright (C) 2006 Duncan Coutts +-- Copyright (C) 2006-2007 Duncan Coutts, Axel Simon hunk ./gtk/Graphics/UI/Gtk/ModelView/Types.chs 20 +-- #hide + hunk ./gtk/Graphics/UI/Gtk/ModelView/Types.chs 32 - toTypedTreeModel + toTypedTreeModel, + [_$_] + -- TreeIter + TreeIter(..), + receiveTreeIter, + peekTreeIter, + [_$_] + -- TreePath + TreePath, + NativeTreePath(..), + newTreePath, + withTreePath, + peekTreePath, + fromTreePath, + stringToTreePath [_$_] hunk ./gtk/Graphics/UI/Gtk/ModelView/Types.chs 53 +import Data.Char ( isDigit ) +import Control.Monad ( liftM ) hunk ./gtk/Graphics/UI/Gtk/ModelView/Types.chs 70 +-- | Tree Iterator: a pointer to an entry in a +-- 'Graphics.UI.Gtk.ModelView.TreeModel'. The constructor of this structure is +-- public for the sake of creating custom tree models. The first value is a +-- time stamp that is handled by the functions that interface with Gtk. The +-- time stamps are used to print warnings if programmers use an iter to a +-- model that has changed meanwhile. The other three fields are used by the +-- custom model implementation to implement an indexing scheme. The precise +-- use of the three words is therefore implementation specific. See also +-- 'TreePath'. +-- +data TreeIter = TreeIter {-# UNPACK #-} !CInt !Word !Word !Word + deriving Show + +{#pointer *TreeIter as TreeIterPtr -> TreeIter #} + +instance Storable TreeIter where + sizeOf _ = {# sizeof TreeIter #} + alignment _ = alignment (undefined :: CInt) + peek ptr = do + stamp <- {# get TreeIter->stamp #} ptr + user_data <- {# get TreeIter->user_data #} ptr + user_data2 <- {# get TreeIter->user_data2 #} ptr + user_data3 <- {# get TreeIter->user_data3 #} ptr + return (TreeIter stamp (ptrToWord user_data) + (ptrToWord user_data2) + (ptrToWord user_data3)) + + where ptrToWord :: Ptr a -> Word + ptrToWord ptr = fromIntegral (ptr `minusPtr` nullPtr) + + poke ptr (TreeIter stamp user_data user_data2 user_data3) = do + {# set TreeIter->stamp #} ptr stamp + {# set TreeIter->user_data #} ptr (wordToPtr user_data) + {# set TreeIter->user_data2 #} ptr (wordToPtr user_data2) + {# set TreeIter->user_data3 #} ptr (wordToPtr user_data3) + + where wordToPtr :: Word -> Ptr a + wordToPtr word = nullPtr `plusPtr` fromIntegral word + +-- Pass a pointer to a structure large enough to hold a GtkTreeIter +-- structure. If the function returns true, read the tree iter and +-- return it. +receiveTreeIter :: (Ptr TreeIter -> IO CInt) -> IO (Maybe TreeIter) +receiveTreeIter body = + alloca $ \iterPtr -> do + result <- body iterPtr + if toBool result + then liftM Just (peek iterPtr) + else return Nothing + +-- Note that this function does throw an error if the pointer is NULL rather +-- than returning some random tree iterator. +peekTreeIter :: Ptr TreeIter -> IO TreeIter +peekTreeIter ptr + | ptr==nullPtr = fail "peekTreeIter: ptr is NULL, tree iterator is invalid" + | otherwise = peek ptr + +-- | TreePath : a list of indices to specify a subtree or node in a +-- 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel'. The node that correspond +-- to a given 'TreePath' might change if nodes are removed or added and a +-- 'TreePath' may refer to a different or even non-existent node after a +-- modification of the model. In contrast, a 'TreeIter' is a more compact +-- representation of a 'TreePath' which becomes invalid after each +-- modification of the underlying model. An intelligent index that is adjusted +-- with each update of the model to point to the same node (whenever possible) +-- is 'Graphics.UI.Gtk.ModelView.TreeRowReference.TreeRowReference'. +-- +type TreePath = [Int] + +{#pointer * TreePath as NativeTreePath newtype#} + +nativeTreePathFree :: NativeTreePath -> IO () +nativeTreePathFree = + {# call unsafe tree_path_free #} + +newTreePath :: TreePath -> IO NativeTreePath +newTreePath path = do + nativePath <- liftM NativeTreePath {# call unsafe tree_path_new #} + mapM_ ({#call unsafe tree_path_append_index#} nativePath . fromIntegral) path + return nativePath + +withTreePath :: TreePath -> (NativeTreePath -> IO a) -> IO a +withTreePath tp act = do + nativePath <- newTreePath tp + res <- act nativePath + nativeTreePathFree nativePath + return res + +nativeTreePathGetIndices :: NativeTreePath -> IO [Int] +nativeTreePathGetIndices tp = do + depth <- liftM fromIntegral $ {# call unsafe tree_path_get_depth #} tp + arrayPtr <- {# call unsafe tree_path_get_indices #} tp + if (depth==0 || arrayPtr==nullPtr) + then return [] + else liftM (map fromIntegral) $ peekArray depth arrayPtr + +-- | Convert the given pointer to a tree path. +peekTreePath :: Ptr NativeTreePath -> IO TreePath +peekTreePath tpPtr | tpPtr==nullPtr = return [] + | otherwise = + nativeTreePathGetIndices (NativeTreePath tpPtr) + +-- | Convert the given pointer to a tree path. Frees the pointer. +fromTreePath :: Ptr NativeTreePath -> IO TreePath +fromTreePath tpPtr | tpPtr==nullPtr = return [] + | otherwise = do + path <- nativeTreePathGetIndices (NativeTreePath tpPtr) + nativeTreePathFree (NativeTreePath tpPtr) + return path + +-- | Convert a comma or colon separated string into a 'TreePath'. Any +-- non-digit characters are assumed to separate indices, thus, the function +-- always is always successful. +stringToTreePath :: String -> TreePath +stringToTreePath "" = [] +stringToTreePath path = getNum 0 (dropWhile (not . isDigit) path) + where + getNum acc ('0':xs) = getNum (10*acc) xs + getNum acc ('1':xs) = getNum (10*acc+1) xs + getNum acc ('2':xs) = getNum (10*acc+2) xs + getNum acc ('3':xs) = getNum (10*acc+3) xs + getNum acc ('4':xs) = getNum (10*acc+4) xs + getNum acc ('5':xs) = getNum (10*acc+5) xs + getNum acc ('6':xs) = getNum (10*acc+6) xs + getNum acc ('7':xs) = getNum (10*acc+7) xs + getNum acc ('8':xs) = getNum (10*acc+8) xs + getNum acc ('9':xs) = getNum (10*acc+9) xs + getNum acc xs = acc:stringToTreePath (dropWhile (not . isDigit) xs) hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeModel.chs.pp 98 - TreeRowReference, hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeModel.chs.pp 105 - treeRowReferenceNew, - treeRowReferenceGetPath, - treeRowReferenceValid, hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeModel.chs.pp 129 -{#import Graphics.UI.Gtk.TreeList.TreeRowReference#} hunk ./tools/callbackGen/gtkmarshal.list 58 -#VOID:BOXED,BOXED,POINTER +VOID:BOXED,BOXED,POINTER |
From: Axel S. <A....@ke...> - 2007-07-16 10:33:32
|
Sun Jul 15 09:35:52 PDT 2007 A....@ke... * Add missing case in Drag. Fix documentation. hunk ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp 246 +dragDestFindTarget widget context Nothing = do + ttPtr <- + {# call gtk_drag_dest_find_target #} + (toWidget widget) + (toDragContext context) + (TargetList nullForeignPtr) + if ttPtr==nullPtr then return Nothing else return (Just (TargetTag ttPtr)) +[_^I_][_$_] hunk ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp 285 --- | 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 +-- | 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 hunk ./gtk/Graphics/UI/Gtk/General/Drag.chs.pp 297 --- | 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 +-- | 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 |
From: Axel S. <A....@ke...> - 2007-07-16 10:33:32
|
Sun Jul 15 09:22:32 PDT 2007 A....@ke... * Add columns to our Haskell tree model. This patch adds the ability to lookup values from TreeStore and ListStore in terms of columns. Some information in e.g. ComboBox have properties that are not shown by CellRenderers directly. These properties can therefore not be set by using function in CellLayout and the only way to connect them to the model is by pretending they access a certain column in the model. Hence this patch adds the ability to access a Haskell model using a column number. The idea is that these column numbers are opaque to the user of Gtk2Hs. Functions that use columns are called widgetSetBlahSource where wiget is the widget and Blah is the property. move ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp hunk ./Makefile.am 527 - gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs \ + gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp \ hunk ./glib/System/Glib/GValueTypes.chs 58 + valueSetMaybeGObject, hunk ./glib/System/Glib/GValueTypes.chs 203 +valueSetMaybeGObject :: GObjectClass gobj => GValue -> (Maybe gobj) -> IO () +valueSetMaybeGObject gvalue (Just obj) = valueSetGObject gvalue obj +valueSetMaybeGObject gvalue Nothing = + {# call unsafe g_value_set_object #} gvalue nullPtr + hunk ./glib/System/Glib/Properties.chs 63 + readAttrFromBoolProperty, hunk ./glib/System/Glib/Properties.chs 229 +readAttrFromBoolProperty :: GObjectClass gobj => String -> ReadAttr gobj Bool +readAttrFromBoolProperty propName = + readAttr (objectGetPropertyBool propName) + hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 25 --- A 'CellRenderer' is an object that determines how the cell of a --- 'TreeView' widget is displayed. [_$_] +-- An object for rendering a cell in a list, icon or combo box widget. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 27 --- * Each 'TreeViewColumn' has one or more accociated 'CellRenderer's. --- The data supply for a cell is contained in a 'TreeStore' or a --- 'ListStore' (both subclasses of 'TreeModel'). Each 'CellRenderer' --- may have several attributes. Each attribute is associated with [_$_] --- one column of the 'TreeModel' database. Thus, several columns of a [_$_] --- 'TreeModel' may be the supply for one 'TreeViewColumn'. --- - hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 29 --- [_$_] +--[_^I_] [_$_] hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 37 --- cells on the screen. To this extent, it isn't expected that a CellRenderer --- keep any permanent state around. Instead, any state is set just prior to use --- by changing the 'System.Glib.Attributes'. Then, the cell is measured and rendered --- in the correct location +-- cells on the screen. To this extent, it isn't expected that a +-- 'CellRenderer' keep any permanent state around. Instead, any state is set +-- just prior to use by changing the attributes of the cell. Then, the cell is +-- measured and rendered in the correct location. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 44 --- 'CellRendererToggle', which toggles when it gets activated by a mouse click, --- or it can be editable like 'CellRendererText', which allows the user to edit --- the text using a 'Entry'. +-- 'Graphics.UI.Gtk.ModelView.CellRendererToggle', which toggles when it gets +-- activated by a mouse click, or it can be editable like +-- 'Graphics.UI.Gtk.ModelView.CellRendererText', which allows the user to edit +-- the text using a 'Graphics.UI.Gtk.Entry.Entry'. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 67 + CellRendererMode, + +-- * Methods +#if GTK_CHECK_VERSION(2,6,0) + cellRendererStopEditing, +#endif + cellRendererGetFixedSize, + cellRendererSetFixedSize, hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 92 -#if GTK_CHECK_VERSION(2,4,0) hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 93 +#if GTK_CHECK_VERSION(2,6,0) + editingStarted, +#endif +#if GTK_CHECK_VERSION(2,4,0) + editingCanceled, +#endif + +-- * Deprecated +#ifndef DISABLE_DEPRECATED +#if GTK_CHECK_VERSION(2,6,0) hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 104 - afterEditingStarted + afterEditingStarted, +#endif +#if GTK_CHECK_VERSION(2,4,0) + onEditingCanceled, + afterEditingCanceled, +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 125 + +#if GTK_CHECK_VERSION(2,6,0) +-- %hash c:75b3 d:45ca +-- | Informs the cell renderer that the editing is stopped. If @canceled@ is +-- @True@, the cell renderer will emit the 'editingCanceled' signal. +-- +-- * Available since Gtk+ version 2.6 +-- +cellRendererStopEditing :: CellRendererClass self => self + -> Bool -- ^ @canceled@ - @True@ if the editing has been canceled + -> IO () +cellRendererStopEditing self canceled = + {# call gtk_cell_renderer_stop_editing #} + (toCellRenderer self) + (fromBool canceled) +#endif + +-- %hash c:6d51 d:dc3e +-- | Returns @(width, height)@ denoting the size of the fixed size of +-- @cell@. If no fixed size is set, returns @-1@ for that value. +-- +cellRendererGetFixedSize :: CellRendererClass self => self + -> IO (Int, Int) -- ^ @(width, height)@ +cellRendererGetFixedSize self = + alloca $ \widthPtr -> + alloca $ \heightPtr -> + {# call gtk_cell_renderer_get_fixed_size #} + (toCellRenderer self) + widthPtr + heightPtr >> + peek widthPtr >>= \width -> + peek heightPtr >>= \height -> + return (fromIntegral width, fromIntegral height) + +-- %hash c:85dc d:5fd4 +-- | Sets the renderer size to be explicit, independent of the properties set. +-- +cellRendererSetFixedSize :: CellRendererClass self => self + -> Int -- ^ @width@ - the width of the cell renderer, or -1 + -> Int -- ^ @height@ - the height of the cell renderer, or -1 + -> IO () +cellRendererSetFixedSize self width height = + {# call gtk_cell_renderer_set_fixed_size #} + (toCellRenderer self) + (fromIntegral width) + (fromIntegral height) + hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 283 + +-------------------- +-- Signals + hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 288 --- | This signal gets emitted when a cell starts to be edited. +-- %hash c:eff4 d:fc12 +-- | This signal gets emitted when the user cancels the process of editing a +-- cell. For example, an editable cell renderer could be written to cancel +-- editing when the user presses Escape. +-- +-- * Available since Gtk+ version 2.4 +-- +editingCanceled :: CellRendererClass self => Signal self (IO ()) +editingCanceled = Signal (connect_NONE__NONE "editing-canceled") + +#if GTK_CHECK_VERSION(2,6,0) +-- %hash c:41f0 d:49f +-- | This signal gets emitted when a cell starts to be edited. The indended +-- use of this signal is to do special setup on @editable@, e.g. adding a +-- 'EntryCompletion' or setting up additional columns in a 'ComboBox'. +-- +-- * The widget that is passed to the handler contains the widget that is used +-- by the 'CellRenderer' to interact with the user. The widget must be +-- casted to the appropriate widget. For instance, a +-- 'Graphics.UI.Gtk.ModelView.CellRendererText' uses an +-- 'Graphics.UI.Gtk.Entry.Entry' widget, while a +-- 'Graphics.UI.Gtk.ModelView.CellRendererCombo' uses a +-- 'Graphics.UI.Gtk.ModelView.ComboBox.ComboBox' (if +-- 'Graphics.UI.Gtk.ModelView.CellRendererCombo.cellComboHasEntry' is +-- @False@) or a 'Graphics.UI.Gtk.ModelView.ComboBoxEntry.ComboBoxEntry' (if +-- 'Graphics.UI.Gtk.ModelView.CellRendererCombo.cellComboHasEntry' is +-- @True@). hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 316 --- * The indended --- use of this signal is to do special setup on the widget that is created --- to allow the editing process. For example, the 'CellRendererText' uses --- an 'Entry' widget which has an 'EntryCompletion' interface. On reception --- of this signal, the program can set the model from which to retrieve the --- completions. +-- * Available since Gtk+ version 2.6 hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 318 -onEditingStarted, afterEditingStarted :: CellRendererClass self => self - -> (CellEditable -> TreePath -> IO ()) +editingStarted :: CellRendererClass self => + Signal self (Widget -> TreePath -> IO ()) +editingStarted = Signal editingStartedInternal + +editingStartedInternal after cr act = + connect_OBJECT_STRING__NONE "editing-started" after cr + $ \ce path -> act ce (stringToTreePath path) +#endif +#endif + +-------------------- +-- Deprecated Signals + +#ifndef DISABLE_DEPRECATED + +#if GTK_CHECK_VERSION(2,4,0) +-- %hash c:b10f +onEditingCanceled :: CellRendererClass self => self + -> IO () hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRenderer.chs.pp 338 -onEditingStarted cr act = - connect_OBJECT_STRING__NONE "editing-started" False cr - $ \ce path -> act ce (stringToTreePath path) -afterEditingStarted cr act = - connect_OBJECT_STRING__NONE "editing-started" True cr - $ \ce path -> act ce (stringToTreePath path) +onEditingCanceled = connect_NONE__NONE "editing-canceled" False +{-# DEPRECATED onEditingCanceled "instead of 'onEditingCanceled obj' use 'on obj editingCanceled'" #-} + +-- %hash c:808e +afterEditingCanceled :: CellRendererClass self => self + -> IO () + -> IO (ConnectId self) +afterEditingCanceled = connect_NONE__NONE "editing-canceled" True +{-# DEPRECATED afterEditingCanceled "instead of 'afterEditingCanceled obj' use 'after obj editingCanceled'" #-} + +#if GTK_CHECK_VERSION(2,6,0) +-- %hash c:6d9c +onEditingStarted :: CellRendererClass self => self + -> (Widget -> TreePath -> IO ()) + -> IO (ConnectId self) +onEditingStarted = editingStartedInternal False +{-# DEPRECATED onEditingStarted "instead of 'onEditingStarted obj' use 'on obj editingStarted'" #-} + +-- %hash c:ef1b +afterEditingStarted :: CellRendererClass self => self + -> (Widget -> TreePath -> IO ()) + -> IO (ConnectId self) +afterEditingStarted = editingStartedInternal True +{-# DEPRECATED afterEditingStarted "instead of 'afterEditingStarted obj' use 'after obj editingStarted'" #-} +#endif +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 31 --- [_$_] --- | 'CellRendererCombo' renders text in a cell like 'CellRendererText' from --- which it is derived. But while 'CellRendererText' offers a simple entry to --- edit the text, 'CellRendererCombo' offers a 'ComboBox' or 'ComboBoxEntry' --- widget to edit the text. The values to display in the combo box are taken --- from the tree model specified in the model property. +--[_^I_] [_$_] +-- | 'CellRendererCombo' renders text in a cell like +-- 'Graphics.UI.Gtk.ModelView.CellRendererText' from which it is derived. But +-- while 'Graphics.UI.Gtk.ModelView.CellRendererText' offers a simple entry to +-- edit the text, 'CellRendererCombo' offers a +-- 'Graphics.UI.Gtk.ModelView.ComboBox' or +-- 'Graphics.UI.Gtk.ModelView.ComboBoxEntry' widget to edit the text. The +-- values to display in the combo box are taken from the tree model specified +-- in the model property. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 42 --- combo box and sets it to display the column specified by its text-column --- property. Further cell renderers can be added in a handler for the --- editing-started signal. +-- combo box and sets it to display the column specified by its +-- 'cellTextModel' property. Further cell renderers can be added in a handler +-- for the 'Graphics.UI.Gtk.ModelView.CellRenderer.editingStarted' signal. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 62 + TextModel, hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 66 + textModelNew, + +-- * Methods + textModelGetModel, hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 73 - + cellComboTextModel hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 80 -import System.Glib.Attributes (Attr) +import System.Glib.Attributes (Attr, WriteAttr, writeAttr) hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 86 +{#import Graphics.UI.Gtk.ModelView.Types#} +{#import Graphics.UI.Gtk.ModelView.CustomStore#} hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 96 --- a fixed set of options the user can choose from, or, using --- 'cellComboHasEntry', allows the user to add new elements. [_$_] +-- a fixed set of options the user can choose from. [_$_] hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 100 - ren <- makeNewObject mkCellRendererCombo $ + makeNewObject mkCellRendererCombo $ hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 103 - -- Create a fake model with one string column in it. The model itself is - -- never used. - mod <- constructNewGObject mkListStore $ - withArray [fromIntegral (fromEnum TMstring)] $ \typesArr -> - {# call unsafe list_store_newv #} 1 typesArr - objectSetPropertyGObject {# call pure unsafe gtk_tree_model_get_type #} - "model" ren mod - objectSetPropertyInt "text-column" ren 0 [_$_] - return ren + + +-- | An opaque value containing a tree model and a function extracting +-- a string from it. This value is used to set the 'cellComboTextModel' +-- property. +data TreeModelClass model => TextModel model = TextModel model ColumnId + +-- Implementation note: it seems from the API that it might be possible to set +-- the model and the attributes of the combo box when the 'editingStarted' +-- signal of the 'CellRenderer'. However, this is not possible since the +-- 'CellRendererCombo' subbornly refuses to populate the cell with a combox +-- box if either the model or the text-column isn't set. Thus, unfortunately, +-- we always need to have a text in the combo box, even though it would be +-- perfectly reasonable to have, say, only icons. As a result of this stupid +-- behaviour, it is necessary to use the clumsy 'TextModel' machinery. +[_^I_][_$_] +-- | Create an opaque value containing a tree model and a function extracting +-- a string from it. This value is used to set the 'cellComboTextModel' +-- property. +-- +textModelNew :: (TreeModelClass (model row), + TypedTreeModelClass model) + => model row -- ^ the model which is to be used to fill the + -- 'CellRendererCombo' + -> (row -> String) -- ^ a function to extract + -> IO (TextModel (model row)) +textModelNew model extract = do + col <- treeModelUpdateColumn model (-1) (CAString extract) + return (TextModel model col) + +-- | Extact the model from the 'TextModel' value. +textModelGetModel :: TreeModelClass model => TextModel model -> model +textModelGetModel (TextModel m _) = m + hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererCombo.chs.pp 149 +-- | The 'TextModel', that is, a tree model with a function that extracts a +-- string from which the options of the combo box are drawn. Note that this +-- tree model can be a datum in the tree model that is used to populate the +-- view in which the 'CellRendererCombo' is part of. In other words, it is +-- possible that every 'CellRendererCombo' can show a different set of options +-- on each row. [_$_] +-- +cellComboTextModel :: ( TreeModelClass model, + CellRendererComboClass self) => + WriteAttr self (TextModel model) +cellComboTextModel = writeAttr $ \cr (TextModel model row) -> do + objectSetPropertyInt "text-column" cr row + objectSetPropertyGObject {# call fun unsafe gtk_tree_model_get_type #} + "model" cr model + hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererPixbuf.chs.pp 31 --- allows to render either a given 'Pixbuf' (set via the pixbuf property) or a --- stock icon (set via the stock-id property). +-- allows to render either a given 'Pixbuf' (set via the 'cellPixbuf' +-- property) or a stock icon (set via the 'cellPixbufStockId' property). hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererPixbuf.chs.pp 34 --- To support the tree view, 'CellRendererPixbuf' also supports rendering --- two alternative pixbufs, when the is-expander property is @True@. If the --- is-expanded property is @True@ and the pixbuf-expander-open property is set --- to a pixbuf, it renders that pixbuf, if the is-expanded property is @False@ --- and the pixbuf-expander-closed property is set to a pixbuf, it renders that --- one. +-- To support the tree view, 'CellRendererPixbuf' also supports rendering two +-- alternative pixbufs, when the +-- 'Graphics.UI.Gtk.ModelView.CellRenderer.cellIsExpander' property is @True@. +-- If the this property is @True@ and the 'cellPixbufExpanderOpen' property is +-- set to a pixbuf, it renders that pixbuf, if the +-- 'Graphics.UI.Gtk.ModelView.CellRenderer.cellIsExpanded' property is @False@ +-- and the 'cellPixbufExpanderClosed' property is set to a pixbuf, it renders +-- that one. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererPixbuf.chs.pp 60 + hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererProgress.chs.pp 30 +-- * Detail +-- +-- | 'CellRendererProgress' renders a numeric value as a progress par in a +-- cell. Additionally, it can display a text on top of the progress bar. +-- hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 36 --- + hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 60 + cellText, + cellTextMarkup, + --cellTextAttributes, + cellTextSingleParagraphMode, hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 67 - cellEditable, - cellEditableSet, -#if GTK_CHECK_VERSION(2,6,0) - cellEllipsize, - cellEllipsizeSet, -#endif - cellFamily, - cellFamilySet, - cellFont, - cellFontDesc, hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 70 - cellLanguage, - cellLanguageSet, - cellMarkup, - cellRise, - cellRiseSet, - cellScale, - cellScaleSet, - cellSingleParagraphMode, - cellSize, - cellStretch, - cellStretchSet, - cellStrikethrough, - cellStrikethroughSet, - cellStyle, - cellStyleSet, - cellText, - cellUnderline, - cellUnderlineSet, - cellVariant, - cellVariantSet, - cellWeight, - cellWeightSet, + cellTextEditable, + cellTextEditableSet, + cellTextFont, + cellTextFontDesc, + cellTextFamily, + cellTextFamilySet, + cellTextStyle, + cellTextStyleSet, + cellTextVariant, + cellTextVariantSet, + cellTextWeight, + cellTextWeightSet, + cellTextStretch, + cellTextStretchSet, + cellTextSize, + cellTextSizePoints, + cellTextSizeSet, + cellTextScale, + cellTextScaleSet, + cellTextRise, + cellTextRiseSet, + cellTextStrikethrough, + cellTextStrikethroughSet, + cellTextUnderline, + cellTextUnderlineSet, + cellTextLanguage, + cellTextLanguageSet, hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 98 - cellWidthChars, + cellTextEllipsize, + cellTextEllipsizeSet, + cellTextWidthChars, hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 103 - cellWrapMode, - cellWrapWidth, + cellTextWrapMode, + cellTextWrapWidth, +#endif +#if GTK_CHECK_VERSION(2,10,0) + cellTextAlignment, hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 111 + edited, + +-- * Deprecated +#ifndef DISABLE_DEPRECATED hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 117 +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 133 -import Graphics.UI.Gtk.Pango.Layout ( LayoutWrapMode ) +{#import Graphics.UI.Gtk.Pango.Layout#} ( LayoutAlignment, LayoutWrapMode ) hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 152 --- 'cellTextFont' and 'cellYPad' attribute set on it. Further changes in these --- properties do not --- affect the height, so they must be accompanied by a subsequent call to this --- function. Using this function is unflexible, and should really only be used --- if calculating the size of a cell is too slow (ie, a massive number of cells --- displayed). If @numberOfRows@ is -1, then the fixed height is unset, and the --- height is determined by the properties again. +-- 'cellTextFont' and 'Graphics.UI.Gtk.ModelView.CellRenderer.cellYPad' +-- attribute set on it. Further changes in these properties do not affect the +-- height, so they must be accompanied by a subsequent call to this function. +-- Using this function is unflexible, and should really only be used if +-- calculating the size of a cell is too slow (ie, a massive number of cells +-- displayed). If @numberOfRows@ is -1, then the fixed height is unset, and +-- the height is determined by the properties again. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 195 -cellEditable :: CellRendererTextClass self => Attr self Bool -cellEditable = newAttrFromBoolProperty "editable" +cellTextEditable :: CellRendererTextClass self => Attr self Bool +cellTextEditable = newAttrFromBoolProperty "editable" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 198 --- | Whether the 'cellEditable' flag affects text editability. +-- | Whether the 'cellTextEditable' flag affects text editability. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 200 -cellEditableSet :: CellRendererTextClass self => Attr self Bool -cellEditableSet = newAttrFromBoolProperty "editable-set" +cellTextEditableSet :: CellRendererTextClass self => Attr self Bool +cellTextEditableSet = newAttrFromBoolProperty "editable-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 207 --- ellipsizing. See the 'cellWrapWidth' property for another way of +-- ellipsizing. See the 'cellTextWrapWidth' property for another way of hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 212 -cellEllipsize :: CellRendererTextClass self => Attr self EllipsizeMode -cellEllipsize = newAttrFromEnumProperty "ellipsize" +cellTextEllipsize :: CellRendererTextClass self => Attr self EllipsizeMode +cellTextEllipsize = newAttrFromEnumProperty "ellipsize" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 216 --- | Whether the 'cellEllipsize' tag affects the ellipsize mode. +-- | Whether the 'cellTextEllipsize' tag affects the ellipsize mode. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 220 -cellEllipsizeSet :: CellRendererTextClass self => Attr self Bool -cellEllipsizeSet = newAttrFromBoolProperty "ellipsize-set" +cellTextEllipsizeSet :: CellRendererTextClass self => Attr self Bool +cellTextEllipsizeSet = newAttrFromBoolProperty "ellipsize-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 226 -cellFamily :: CellRendererTextClass self => Attr self String -cellFamily = newAttrFromStringProperty "family" +cellTextFamily :: CellRendererTextClass self => Attr self String +cellTextFamily = newAttrFromStringProperty "family" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 229 --- | Determines if 'cellFamily' has an effect. +-- | Determines if 'cellTextFamily' has an effect. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 231 -cellFamilySet :: CellRendererTextClass self => Attr self Bool -cellFamilySet = newAttrFromBoolProperty "family-set" +cellTextFamilySet :: CellRendererTextClass self => Attr self Bool +cellTextFamilySet = newAttrFromBoolProperty "family-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 236 -cellFont :: CellRendererTextClass self => Attr self String -cellFont = newAttrFromStringProperty "font" +cellTextFont :: CellRendererTextClass self => Attr self String +cellTextFont = newAttrFromStringProperty "font" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 241 -cellFontDesc :: CellRendererTextClass self => Attr self FontDescription -cellFontDesc = newAttrFromBoxedOpaqueProperty makeNewFontDescription +cellTextFontDesc :: CellRendererTextClass self => Attr self FontDescription +cellTextFontDesc = newAttrFromBoxedOpaqueProperty makeNewFontDescription hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 270 -cellLanguage :: CellRendererTextClass self => Attr self (Maybe String) -cellLanguage = newAttrFromMaybeStringProperty "language" +cellTextLanguage :: CellRendererTextClass self => Attr self (Maybe String) +cellTextLanguage = newAttrFromMaybeStringProperty "language" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 273 --- | Whether the 'cellLanguage' tag is used, default is @False@. +-- | Whether the 'cellTextLanguage' tag is used, default is @False@. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 275 -cellLanguageSet :: CellRendererTextClass self => Attr self Bool -cellLanguageSet = newAttrFromBoolProperty "language-set" +cellTextLanguageSet :: CellRendererTextClass self => Attr self Bool +cellTextLanguageSet = newAttrFromBoolProperty "language-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 280 -cellMarkup :: CellRendererTextClass cr => WriteAttr cr (Maybe String) -cellMarkup = writeAttrFromMaybeStringProperty "markup" +cellTextMarkup :: CellRendererTextClass cr => WriteAttr cr (Maybe String) +cellTextMarkup = writeAttrFromMaybeStringProperty "markup" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 283 +-- %hash c:4e25 d:f7c6 hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 287 -cellRise :: CellRendererTextClass self => Attr self Int -cellRise = newAttrFromIntProperty "rise" +-- Allowed values: >= -2147483647 +-- +-- Default value: 0 +-- +cellTextRise :: CellRendererTextClass self => Attr self Int +cellTextRise = newAttrFromIntProperty "rise" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 294 --- | Whether the 'cellRise' tag is used, default is @False@. +-- | Whether the 'cellTextRise' tag is used, default is @False@. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 296 -cellRiseSet :: CellRendererTextClass self => Attr self Bool -cellRiseSet = newAttrFromBoolProperty "rise-set" +cellTextRiseSet :: CellRendererTextClass self => Attr self Bool +cellTextRiseSet = newAttrFromBoolProperty "rise-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 301 -cellScale :: CellRendererTextClass self => Attr self Double -cellScale = newAttrFromDoubleProperty "scale" +cellTextScale :: CellRendererTextClass self => Attr self Double +cellTextScale = newAttrFromDoubleProperty "scale" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 304 --- | Whether the 'cellScale' tag is used, default is @False@. +-- | Whether the 'cellTextScale' tag is used, default is @False@. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 306 -cellScaleSet :: CellRendererTextClass self => Attr self Bool -cellScaleSet = newAttrFromBoolProperty "scale-set" +cellTextScaleSet :: CellRendererTextClass self => Attr self Bool +cellTextScaleSet = newAttrFromBoolProperty "scale-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 309 +-- %hash c:d85f d:9cfb hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 312 -cellSingleParagraphMode :: CellRendererTextClass self => Attr self Bool -cellSingleParagraphMode = newAttrFromBoolProperty "single-paragraph-mode" +-- Default value: @False@ +-- +cellTextSingleParagraphMode :: CellRendererTextClass self => Attr self Bool +cellTextSingleParagraphMode = newAttrFromBoolProperty "single-paragraph-mode" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 319 -cellSize :: CellRendererTextClass self => Attr self Double -cellSize = newAttrFromDoubleProperty "size-points" +cellTextSize :: CellRendererTextClass self => Attr self Double +cellTextSize = newAttrFromDoubleProperty "size-points" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 322 --- | Whether the 'cellSize' tag is used, default is @False@. +-- %hash c:d281 d:3b0c +-- | Font size in points. +-- +-- Allowed values: >= 0 hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 327 -cellSizeSet :: CellRendererTextClass self => Attr self Bool -cellSizeSet = newAttrFromBoolProperty "size-set" +-- Default value: 0 +-- +cellTextSizePoints :: CellRendererTextClass self => Attr self Double +cellTextSizePoints = newAttrFromDoubleProperty "size-points" + +-- | Whether the 'cellTextSize' tag is used, default is @False@. +-- +cellTextSizeSet :: CellRendererTextClass self => Attr self Bool +cellTextSizeSet = newAttrFromBoolProperty "size-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 339 -cellStretch :: CellRendererTextClass self => Attr self Stretch -cellStretch = newAttrFromEnumProperty "stretch" +cellTextStretch :: CellRendererTextClass self => Attr self Stretch +cellTextStretch = newAttrFromEnumProperty "stretch" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 343 --- | Whether the 'cellStretch' tag is used, default is @False@. +-- | Whether the 'cellTextStretch' tag is used, default is @False@. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 345 -cellStretchSet :: CellRendererTextClass self => Attr self Bool -cellStretchSet = newAttrFromBoolProperty "stretch-set" +cellTextStretchSet :: CellRendererTextClass self => Attr self Bool +cellTextStretchSet = newAttrFromBoolProperty "stretch-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 350 -cellStrikethrough :: CellRendererTextClass self => Attr self Bool -cellStrikethrough = newAttrFromBoolProperty "strikethrough" +cellTextStrikethrough :: CellRendererTextClass self => Attr self Bool +cellTextStrikethrough = newAttrFromBoolProperty "strikethrough" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 353 --- | Whether the 'cellStrikethrough' tag is used, default is @False@. +-- | Whether the 'cellTextStrikethrough' tag is used, default is @False@. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 355 -cellStrikethroughSet :: CellRendererTextClass self => Attr self Bool -cellStrikethroughSet = newAttrFromBoolProperty "strikethrough-set" +cellTextStrikethroughSet :: CellRendererTextClass self => Attr self Bool +cellTextStrikethroughSet = newAttrFromBoolProperty "strikethrough-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 360 -cellStyle :: CellRendererTextClass self => Attr self FontStyle -cellStyle = newAttrFromEnumProperty "style" +cellTextStyle :: CellRendererTextClass self => Attr self FontStyle +cellTextStyle = newAttrFromEnumProperty "style" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 364 --- | Whether the 'cellStyle' tag is used, default is @False@. +-- | Whether the 'cellTextStyle' tag is used, default is @False@. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 366 -cellStyleSet :: CellRendererTextClass self => Attr self Bool -cellStyleSet = newAttrFromBoolProperty "style-set" +cellTextStyleSet :: CellRendererTextClass self => Attr self Bool +cellTextStyleSet = newAttrFromBoolProperty "style-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 370 --- also 'cellMarkup'. +-- also 'cellTextMarkup'. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 377 -cellUnderline :: CellRendererTextClass self => Attr self Underline -cellUnderline = newAttrFromEnumProperty "underline" +cellTextUnderline :: CellRendererTextClass self => Attr self Underline +cellTextUnderline = newAttrFromEnumProperty "underline" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 381 --- | Whether the 'cellUnderline' tag is used, default is @False@. +-- | Whether the 'cellTextUnderline' tag is used, default is @False@. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 383 -cellUnderlineSet :: CellRendererTextClass self => Attr self Bool -cellUnderlineSet = newAttrFromBoolProperty "underline-set" +cellTextUnderlineSet :: CellRendererTextClass self => Attr self Bool +cellTextUnderlineSet = newAttrFromBoolProperty "underline-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 388 -cellVariant :: CellRendererTextClass self => Attr self Variant -cellVariant = newAttrFromEnumProperty "variant" +cellTextVariant :: CellRendererTextClass self => Attr self Variant +cellTextVariant = newAttrFromEnumProperty "variant" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 392 --- | Whether the 'cellVariant' tag is used, default is @False@. +-- | Whether the 'cellTextVariant' tag is used, default is @False@. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 394 -cellVariantSet :: CellRendererTextClass self => Attr self Bool -cellVariantSet = newAttrFromBoolProperty "variant-set" +cellTextVariantSet :: CellRendererTextClass self => Attr self Bool +cellTextVariantSet = newAttrFromBoolProperty "variant-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 399 -cellWeight :: CellRendererTextClass self => Attr self Int -cellWeight = newAttrFromIntProperty "weight" +cellTextWeight :: CellRendererTextClass self => Attr self Int +cellTextWeight = newAttrFromIntProperty "weight" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 402 --- | Whether the 'cellWeight' tag is used, default is @False@. +-- | Whether the 'cellTextWeight' tag is used, default is @False@. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 404 -cellWeightSet :: CellRendererTextClass self => Attr self Bool -cellWeightSet = newAttrFromBoolProperty "weight-set" +cellTextWeightSet :: CellRendererTextClass self => Attr self Bool +cellTextWeightSet = newAttrFromBoolProperty "weight-set" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 416 -cellWidthChars :: CellRendererTextClass self => Attr self Int -cellWidthChars = newAttrFromIntProperty "width-chars" +cellTextWidthChars :: CellRendererTextClass self => Attr self Int +cellTextWidthChars = newAttrFromIntProperty "width-chars" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 425 --- This property has no effect unless the 'cellWrapWidth' property is set. +-- This property has no effect unless the 'cellTextWrapWidth' property is set. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 429 -cellWrapMode :: CellRendererTextClass self => Attr self LayoutWrapMode -cellWrapMode = newAttrFromEnumProperty "wrap-mode" +cellTextWrapMode :: CellRendererTextClass self => Attr self LayoutWrapMode +cellTextWrapMode = newAttrFromEnumProperty "wrap-mode" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 439 -cellWrapWidth :: CellRendererTextClass self => Attr self Int -cellWrapWidth = newAttrFromIntProperty "wrap-width" +cellTextWrapWidth :: CellRendererTextClass self => Attr self Int +cellTextWrapWidth = newAttrFromIntProperty "wrap-width" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 444 --- | Emitted when the user finished editing a cell. + +#if GTK_CHECK_VERSION(2,10,0) +-- %hash c:a59c d:a84a +-- | Specifies how to align the lines of text with respect to each other. +-- +-- Note that this property describes how to align the lines of text in case +-- there are several of them. The +-- 'Graphics.UI.Gtk.ModelView.CellRenderer.cellXAlign' property of +-- 'CellRenderer', on the other hand, sets the horizontal alignment of the +-- whole text. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 455 --- * Whenever editing is finished successfully, this signal is emitted which --- indicates that the model should be updated with the supplied value. --- The value is always a string which matches 'CellRendererText' renderers --- and 'CellRendererCombo' when the combo box accepts additional entries. --- If the combo box has a predefined set of possible selections, the --- string that this handler receives is always empty. In this case the --- handler --- of this signal needs to query the currently selected index of the combo --- box and store that index in the model of this cell renderer. The only --- time this combo box is passed to the user program is in the --- 'onEditingStarted' signal of the 'CellRenderer' base class. Hence, --- when this handler is run, the handler to store the resulting value --- needs to be installed using this function. See the --- user manual for an example of this. +-- Default value: 'Graphics.UI.Gtk.Pango.Layout.AlignLeft' +-- +-- * Available since Gtk+ version 2.10 +-- +cellTextAlignment :: CellRendererTextClass self => Attr self LayoutAlignment +cellTextAlignment = newAttrFromEnumProperty "alignment" + {# call pure unsafe pango_alignment_get_type #} +#endif + +-------------------- +-- Signals + +-- %hash c:a541 d:18f9 +-- | Emitted when the user finished editing a cell. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 470 +-- Whenever editing is finished successfully, this signal is emitted which +-- indicates that the model should be updated with the supplied value. +-- The value is always a string which matches the 'cellText' attribute of +-- 'CellRendererText' (and its derivates like 'CellRendererCombo'). +-- [_$_] hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 476 --- 'cellEditable') or when the user aborts editing. +-- 'cellTextEditable') or when the user aborts editing. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 478 -onEdited, afterEdited :: CellRendererTextClass cr => - cr -> (TreePath -> String -> IO ()) -> - IO (ConnectId cr) +edited :: CellRendererTextClass self => + Signal self (TreePath -> String -> IO ()) +edited = Signal internalEdited + +-------------------- +-- Deprecated Signals + +#ifndef DISABLE_DEPRECATED +-- %hash c:76ed +onEdited :: CellRendererTextClass self => self + -> (TreePath -> String -> IO ()) + -> IO (ConnectId self) hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 491 +{-# DEPRECATED onEdited "instead of 'onEdited obj' use 'on obj edited'" #-} + +-- %hash c:f70c +afterEdited :: CellRendererTextClass self => self + -> (TreePath -> String -> IO ()) + -> IO (ConnectId self) hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererText.chs.pp 498 +{-# DEPRECATED afterEdited "instead of 'afterEdited obj' use 'after obj edited'" #-} +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 59 - cellActive, - cellInconsistent, - cellActivatable, - cellRadio, + cellToggleActive, + cellToggleInconsistent, + cellToggleActivatable, + cellToggleRadio, + cellToggleIndicatorSize, + +-- * Signals + toggled, + +-- * Deprecated +#ifndef DISABLE_DEPRECATED + onToggled, + afterToggled +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 79 -import System.Glib.Properties (newAttrFromBoolProperty) +import System.Glib.Properties (newAttrFromBoolProperty, + newAttrFromIntProperty) hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 83 +{#import Graphics.UI.Gtk.Signals#} hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 90 --- | Create a new 'CellRenderer' that displays a 'ToggleButton'. +-- %hash c:bafb d:640f +-- | Creates a new 'CellRendererToggle'. Adjust rendering parameters using +-- object properties. Object properties can be set globally (with +-- 'System.Glib.Attributes.set'). Also, within a +-- 'Graphics.UI.Gtk.ModelView.TreeViewColumn', you can bind a property to a +-- value in a 'Graphics.UI.Gtk.ModelView.TreeModel.TreeModel' using +-- 'Graphics.UI.Gtk.ModelView.CellLayout.cellLayoutSetAttributes'. For +-- example, you can bind the 'cellToggleActive' property on the cell renderer +-- to a boolean value in the model, thus causing the check button to reflect +-- the state of the model. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 110 --- | Determine whether the button is drawn as 'RadioButton' or not. +-- %hash c:133b d:c428 +-- | If @radio@ is @True@, the cell renderer renders a radio toggle (i.e. a +-- toggle in a group of mutually-exclusive toggles). If @False@, it renders a +-- check toggle (a standalone boolean option). This can be set globally for +-- the cell renderer, or changed just before rendering each cell in the model +-- (for 'TreeView', you set up a per-row setting using 'TreeViewColumn' to +-- associate model columns with cell renderer properties). hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 119 - -> Bool + -> Bool -- ^ @radio@ - @True@ to make the toggle look like a radio button hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 126 --- | Returns whether the button is drawn as 'RadioButton' or not. +-- %hash c:7f39 d:fe9f +-- | Returns whether we\'re rendering radio toggles rather than checkboxes. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 129 -cellRendererToggleGetRadio :: CellRendererToggleClass self => self -> IO Bool +cellRendererToggleGetRadio :: CellRendererToggleClass self => self + -> IO Bool -- ^ returns @True@ if we\'re rendering radio toggles rather than + -- checkboxes hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 137 --- | Retrieve the current state of the button. +-- %hash c:4974 d:3d45 +-- | Returns whether the cell renderer is active. See +-- 'cellRendererToggleSetActive'. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 141 -cellRendererToggleGetActive :: CellRendererToggleClass self => self -> IO Bool +cellRendererToggleGetActive :: CellRendererToggleClass self => self + -> IO Bool -- ^ returns @True@ if the cell renderer is active. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 148 - --- | Modify the state of the button. +-- %hash c:8420 d:5177 +-- | Activates or deactivates a cell renderer. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 152 - -> Bool + -> Bool -- ^ @setting@ - the value to set. hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 162 +-- %hash c:aed9 d:ab32 hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 167 -cellActive :: CellRendererToggleClass self => Attr self Bool -cellActive = newAttrFromBoolProperty "active" +cellToggleActive :: CellRendererToggleClass self => Attr self Bool +cellToggleActive = newAttrFromBoolProperty "active" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 170 +-- %hash c:85c8 d:8ab1 hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 175 -cellInconsistent :: CellRendererToggleClass self => Attr self Bool -cellInconsistent = newAttrFromBoolProperty "inconsistent" +cellToggleInconsistent :: CellRendererToggleClass self => Attr self Bool +cellToggleInconsistent = newAttrFromBoolProperty "inconsistent" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 178 +-- %hash c:74e5 d:e41e hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 183 -cellActivatable :: CellRendererToggleClass self => Attr self Bool -cellActivatable = newAttrFromBoolProperty "activatable" +cellToggleActivatable :: CellRendererToggleClass self => Attr self Bool +cellToggleActivatable = newAttrFromBoolProperty "activatable" hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 186 +-- %hash c:61f2 d:5449 hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 191 -cellRadio :: CellRendererToggleClass self => Attr self Bool -cellRadio = newAttrFromBoolProperty "radio" +cellToggleRadio :: CellRendererToggleClass self => Attr self Bool +cellToggleRadio = newAttrFromBoolProperty "radio" + +-- %hash c:698 d:47b4 +-- | Size of check or radio indicator. +-- +-- Allowed values: >= 0 +-- +-- Default value: 12 +-- +cellToggleIndicatorSize :: CellRendererToggleClass self => Attr self Int +cellToggleIndicatorSize = newAttrFromIntProperty "indicator-size" + +-------------------- +-- Signals + +-- %hash c:33ab d:1ba3 +-- | The ::toggled signal is emitted when the cell is toggled. +-- +toggled :: CellRendererToggleClass self => Signal self (String -> IO ()) +toggled = Signal (connect_STRING__NONE "toggled") + +-------------------- +-- Deprecated Signals + +#ifndef DISABLE_DEPRECATED +-- %hash c:21f7 +onToggled :: CellRendererToggleClass self => self + -> (String -> IO ()) + -> IO (ConnectId self) +onToggled = connect_STRING__NONE "toggled" False +{-# DEPRECATED onToggled "instead of 'onToggled obj' use 'on obj toggled'" #-} + +-- %hash c:82f6 +afterToggled :: CellRendererToggleClass self => self + -> (String -> IO ()) + -> IO (ConnectId self) +afterToggled = connect_STRING__NONE "toggled" True +{-# DEPRECATED afterToggled "instead of 'afterToggled obj' use 'after obj toggled'" #-} +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 8 --- Copyright (C) 2004-2005 Duncan Coutts +-- Copyright (C) 2004-2007 Duncan Coutts, Axel Simon hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 30 + hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 32 --- [_$_] +-- hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 42 --- tree model, and the display of the choices can be adapted to the data in the --- model by using cell renderers, as you would in a tree view. This is possible --- since 'ComboBox' implements the 'CellLayout' interface. The tree model --- holding the valid choices is not restricted to a flat list, it can be a real --- tree, and the popup will reflect the tree structure. +-- tree model, and the display of the choices can be adapted to the data in +-- the model by using cell renderers, as you would in a tree view. This is +-- possible since 'ComboBox' implements the 'CellLayout' interface. The tree +-- model holding the valid choices is not restricted to a flat list, it can be +-- a real tree, and the popup will reflect the tree structure. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 48 --- In addition to the model-view API, 'ComboBox' offers a simple API which --- is suitable for text-only combo boxes, and hides the complexity of managing --- the data in a model. It consists of the functions 'comboBoxNewText', --- 'comboBoxAppendText', 'comboBoxInsertText', 'comboBoxPrependText', --- 'comboBoxRemoveText' and 'comboBoxGetActiveText'. +-- In addition to the general model-view API, 'ComboBox' offers the function +-- 'comboBoxNewText' which creates a text-only combo box. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 52 +-- hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 78 - comboBoxSetRowSpanColumn, - comboBoxSetColumnSpanColumn, + comboBoxSetRowSpanSource, +#if GTK_CHECK_VERSION(2,6,0) + comboBoxSetColumnSpanSource, +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 88 - comboBoxAppendText, - comboBoxInsertText, - comboBoxPrependText, - comboBoxRemoveText, hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 92 - comboBoxGetRowSpanColumn, - comboBoxGetColumnSpanColumn, - comboBoxGetActiveText, hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 93 +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 95 +#if GTK_CHECK_VERSION(2,6,0) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 98 + comboBoxSetRowSeparatorSource, +#if GTK_CHECK_VERSION(2,10,0) + comboBoxSetTitle, + comboBoxGetTitle, +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 106 -#if GTK_CHECK_VERSION(2,6,0) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 110 + comboBoxActive, +#if GTK_CHECK_VERSION(2,6,0) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 115 +#if GTK_CHECK_VERSION(2,10,0) + comboBoxTearoffTitle, + comboBoxPopupShown, +#endif + comboBoxTitle, hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 123 + changed, + popupShownNotify, + [_$_] +-- * Deprecated +#ifndef DISABLE_DEPRECATED hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 131 +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 141 -import System.Glib.GObject (makeNewGObject) -{#import Graphics.UI.Gtk.Types#} +import System.Glib.GObject (makeNewGObject, + mkFunPtrDestroyNotify) +{#import Graphics.UI.Gtk.Types#} hiding (ListStore) +import Graphics.UI.Gtk.ModelView.Types (TypedTreeModelClass) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 147 -{#import Graphics.UI.Gtk.ModelView.CustomStore#} () - +{#import Graphics.UI.Gtk.ModelView.CustomStore#} (treeModelUpdateColumn, + treeModelGetRow, + ColumnAccess(CAInt)) +import Graphics.UI.Gtk.ModelView.ListStore ( ListStore, listStoreNew ) +import Graphics.UI.Gtk.ModelView.CellLayout ( cellLayoutSetAttributes, + cellLayoutPackStart ) +import Graphics.UI.Gtk.ModelView.CellRendererText ( cellRendererTextNew, [_$_] + cellText) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 171 --- text combo box, you should only manipulate its data source with the --- following convenience functions: 'comboBoxAppendText', 'comboBoxInsertText', --- 'comboBoxPrependText' and 'comboBoxRemoveText'. +-- text combo box, you can supply the @id@ function as first argument. In this +-- case 'comboBoxNewText' will return a @'Graphics.UI.Gtk.ModelView.ListStore' +-- String@ containing the initial list of strings. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 175 -comboBoxNewText :: IO ComboBox -comboBoxNewText = - makeNewObject mkComboBox $ - liftM (castPtr :: Ptr Widget -> Ptr ComboBox) $ - {# call gtk_combo_box_new_text #} +comboBoxNewText :: + (a -> String) -- ^ a function to extract elements from a the store + -> [a] -- ^ the initial contents of the store + -> IO (ComboBox, ListStore a) -- the resulting combo box and the store +comboBoxNewText extract initial = do + store <- listStoreNew initial + combo <- comboBoxNewWithModel store + ren <- cellRendererTextNew + cellLayoutPackStart combo ren True + cellLayoutSetAttributes combo ren store (\a -> [cellText := extract a]) + return (combo, store) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 187 +-- %hash c:2570 hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 190 -comboBoxNewWithModel :: TreeModelClass model => [_$_] - model -- ^ @model@ - A 'TreeModel'. +comboBoxNewWithModel :: TreeModelClass model => + model -- ^ @model@ - A 'TreeModel'. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 196 - {# call gtk_combo_box_new_with_model #} (toTreeModel model) + {# call gtk_combo_box_new_with_model #} + (toTreeModel model) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 202 +-- %hash d:566e +-- | Sets the wrap width of @comboBox@ to be @width@. The wrap width is +#if GTK_CHECK_VERSION(2,6,0) +-- | Returns the wrap width which is used to determine the number of columns +-- for the popup menu. If the wrap width is larger than 1, the combo box is in +-- table mode. +-- +-- * Available since Gtk+ version 2.6 +-- +comboBoxGetWrapWidth :: ComboBoxClass self => self -> IO Int +comboBoxGetWrapWidth self = + liftM fromIntegral $ + {# call gtk_combo_box_get_wrap_width #} + (toComboBox self) + hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 219 --- layed out in a table. +-- laid out in a table. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 227 --- | Sets the column with row span information for the combo box to be @rowSpan@. --- The row span column contains integers which indicate how many rows an item --- should span. +-- %hash d:f80b +-- | Sets the source of the row span information for the combo box. The +-- row span source contains integers which indicate how many rows an +-- item should span. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 232 -comboBoxSetRowSpanColumn :: ComboBoxClass self => self -> Int -> IO () -comboBoxSetRowSpanColumn self rowSpan = +comboBoxSetRowSpanSource :: (ComboBoxClass self, + TreeModelClass (model row), + TypedTreeModelClass model) + => self -- ^ the 'ComboBox' widget + -> Maybe (model row, row -> Int) + -- ^ The model and a function to extract the number of rows + -- from the model. If set to @Nothing@, the mapping is reset. + -> IO () +comboBoxSetRowSpanSource self Nothing = hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 242 - (toComboBox self) - (fromIntegral rowSpan) + (toComboBox self) (-1) +comboBoxSetRowSpanSource self (Just (model, extract)) = do + modelPtr <- {#call unsafe gtk_combo_box_get_model#} (toComboBox self) + let (TreeModel modelFPtr) = toTreeModel model + if modelPtr/=unsafeForeignPtrToPtr modelFPtr then + error ("comboBoxSetRowSpanSource: given model is different from what "++ + "comboBoxGetModel returns") else do + col <- {# call gtk_combo_box_get_row_span_column #} (toComboBox self) + col <- treeModelUpdateColumn model (fromIntegral col) (CAInt extract) + {#call gtk_combo_box_set_row_span_column #} (toComboBox self) + (fromIntegral col) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 254 --- | Sets the column with column span information for the combo box to be --- @columnSpan@. The column span column contains integers which indicate how --- many columns an item should span. +#if GTK_CHECK_VERSION(2,6,0) +-- %hash d:4303 +-- | Sets the source of the column span information for the combo box. The +-- column span source contains integers which indicate how many columns an +-- item should span. +-- +-- * Available since Gtk+ version 2.6 hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 262 -comboBoxSetColumnSpanColumn :: ComboBoxClass self => self -> Int -> IO () -comboBoxSetColumnSpanColumn self columnSpan = +comboBoxSetColumnSpanSource :: (ComboBoxClass self, + TreeModelClass (model row), + TypedTreeModelClass model) + => self -- ^ the 'ComboBox' widget + -> Maybe (model row, row -> Int) + -- ^ The model and a function to extract the number of rows + -- from the model. If set to @Nothing@, the mapping is reset. + -> IO () +comboBoxSetColumnSpanSource self Nothing = hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 272 - (toComboBox self) - (fromIntegral columnSpan) + (toComboBox self) (-1) +comboBoxSetColumnSpanSource self (Just (model, extract)) = do + modelPtr <- {#call unsafe gtk_combo_box_get_model#} (toComboBox self) + let (TreeModel modelFPtr) = toTreeModel model + if modelPtr/=unsafeForeignPtrToPtr modelFPtr then + error ("comboBoxSetRowSpanSource: given model is different from what "++ + "comboBoxGetModel returns") else do + col <- {# call gtk_combo_box_get_column_span_column #} (toComboBox self) + col <- treeModelUpdateColumn model (fromIntegral col) (CAInt extract) + {#call gtk_combo_box_set_column_span_column #} (toComboBox self) + (fromIntegral col) +#endif hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 285 --- | Returns the index of the currently active item, or @Nothing@ if there's no +-- %hash c:e719 d:e6a +-- | Returns the index of the currently active item, or -1 if there's no hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 293 - -> IO (Maybe Int) -- ^ returns An integer which is the index of the currently - -- active item, or @Nothing@ if there's no active item. + -> IO Int -- ^ returns An integer which is the index of the currently active + -- item, or -1 if there's no active item. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 296 + liftM fromIntegral $ hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 299 - >>= \index -> if index == -1 - then return Nothing - else return (Just $ fromIntegral index) hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 300 --- | Sets the active item of the combo box to be the item at @index@. +-- %hash c:3572 d:fbed +-- | Sets the active item of @comboBox@ to be the item at @index@. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 304 - -> Int -- ^ @index@ - An index in the model passed during construction, or - -- -1 to have no active item. + -> Int -- ^ @index@ - An index in the model passed during construction, or -1 + -- to have no active item. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 312 --- | Returns a 'TreeIter' that points to the current active item, if it exists, --- or @Nothing@ if there is no current active item. +-- %hash c:744a d:e897 +-- | Returns a 'TreeIter' that points to the current active item, if it +-- exists, or @Nothing@ if there is no current active item. hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 323 +-- %hash c:9a70 hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 336 +-- %hash c:2460 hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 345 - {# call gtk_combo_box_get_model #} + {# call unsafe gtk_combo_box_get_model #} hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 348 +-- %hash c:f5d0 hunk ./gtk/Graphics/UI/Gtk/ModelView/ComboBox.chs.pp 353 --- No... [truncated message content] |
From: Axel S. <A....@ke...> - 2007-07-16 10:33:27
|
Sun Jul 15 09:35:12 PDT 2007 A....@ke... * Add a new function to Pixbuf. Correct documentation. hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 321 -pixbufNewFromFileAtScale :: String -> Int -> Int -> Bool -> IO Pixbuf +pixbufNewFromFileAtScale :: [_$_] + String -- ^ the name of the file + -> Int -- ^ target width + -> Int -- ^ target height + -> Bool -- ^ whether to preserve the aspect ratio + -> IO Pixbuf hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 526 -pixbufScaleSimple :: Pixbuf -> Int -> Int -> InterpType -> IO Pixbuf +pixbufScaleSimple :: [_$_] + Pixbuf -- ^ @src@ - the source image + -> Int -- ^ @width@ - the target width + -> Int -- ^ @height@ the target height + -> InterpType -- ^ interpolation type + -> IO Pixbuf hunk ./gtk/Graphics/UI/Gtk/Gdk/Pixbuf.chs.pp 582 -pixbufComposite :: Pixbuf -> Pixbuf -> Int -> Int -> Int -> Int -> - Double -> Double -> Double -> Double -> InterpType -> - Word8 -> IO () +pixbufComposite :: + Pixbuf -- ^ @src@ - the source pixbuf + -> Pixbuf -- ^ @dest@ - the pixbuf into which to render the results + -> Int -- ^ @destX@ - the left coordinate for region to render + -> Int -- ^ @destY@ - the top coordinate for region to render [_$_] + -> Int -- ^ @destWidth@ - the width of the region to render + -> Int -- ^ @destHeight@ - the height of the region to render + -> Double -- ^ @offsetX@ - the offset in the X direction (currently + -- rounded to an integer) + -> Double -- ^ @offsetY@ - the offset in the Y direction [_$_] + -- (currently rounded to an integer) + -> Double -- ^ @scaleX@ - the scale factor in the X direction + -> Double -- ^ @scaleY@ - the scale factor in the Y direction + -> InterpType -- ^ the interpolation type for the transformation. + -> Word8 -- ^ @alpha@ - the transparency + -> IO () hunk ./gtk/Graphics/UI/Gtk/Gdk/PixbufData.hs.pp 48 --- * See 'pixbufGetPixels'. +-- * See 'Graphics.UI.Gtk.Gdk.Pixbuf.pixbufGetPixels'. |
From: Duncan C. <dun...@wo...> - 2007-07-08 13:45:52
|
Sat Jul 7 14:23:33 PDT 2007 pg...@gm... * gnomevfs: fix demos to work again, new demo TestVolumeMonitor hunk ./demo/gnomevfs/Makefile 2 -PROGS = test-sync test-dir test-xfer test-drive-volume -SOURCES = TestSync.hs TestDir.hs TestXfer.hs TestDriveVolume.hs +PROGS = test-sync test-dir test-xfer test-drive-volume test-volume-monitor +SOURCES = TestSync.hs TestDir.hs TestXfer.hs TestDriveVolume.hs TestVolumeMonitor.hs hunk ./demo/gnomevfs/Makefile 15 +test-volume-monitor : TestVolumeMonitor.hs + $(HC_RULE) hunk ./demo/gnomevfs/TestDriveVolume.hs 33 - VFS.volumeGetDevicePath volume >>= printf "\t\tDevice Path: %s\n" - VFS.volumeGetFilesystemType volume >>= printf "\t\tFilesystem Type: %s\n" + VFS.volumeGetDevicePath volume >>= (printf "\t\tDevice Path: %s\n") . show + VFS.volumeGetFilesystemType volume >>= (printf "\t\tFilesystem Type: %s\n") . show addfile ./demo/gnomevfs/TestVolumeMonitor.hs hunk ./demo/gnomevfs/TestVolumeMonitor.hs 1 +module Main where + +import qualified System.Gnome.VFS as VFS +import Control.Exception ( handleJust ) +import Control.Monad ( when + , liftM ) +import Data.Maybe ( fromMaybe ) +import Text.Printf ( printf ) +import System.Glib.MainLoop ( mainLoopNew + , mainLoopRun ) +import System.IO +import System.Exit +import System.Environment + +main :: IO () +main = + do VFS.init >>= (\success -> + when (not success) $ + do hPutStrLn stderr $ "could not initialize GnomeVFS" + exitFailure) + [_$_] + mainLoop <- mainLoopNew Nothing True + [_$_] + putStrLn "Waiting for Volume mount/unmount events..." + VFS.onVolumeMonitorVolumeMounted VFS.volumeMonitor $ \volume -> + do VFS.volumeGetDisplayName volume >>= printf "volume-mounted: %s\n" + return () + VFS.onVolumeMonitorVolumePreUnmount VFS.volumeMonitor $ \volume -> + do VFS.volumeGetDisplayName volume >>= printf "volume-pre-unmount: %s\n" + return () + VFS.onVolumeMonitorVolumeUnmounted VFS.volumeMonitor $ \volume -> + do VFS.volumeGetDisplayName volume >>= printf "volume-unmounted: %s\n" + return () + [_$_] + mainLoopRun mainLoop + [_$_] + return () hunk ./demo/gnomevfs/TestXfer.hs 83 - VFS.XferErrorModeQuery VFS.XferOverwriteModeQuery hunk ./demo/gnomevfs/TestXfer.hs 84 - (Just xferOverwriteCallback) Nothing + (Right xferOverwriteCallback) Nothing |
From: Duncan C. <dun...@wo...> - 2007-07-08 13:45:51
|
Sat Jul 7 14:22:28 PDT 2007 pg...@gm... * gnomevfs: use actual Volume type instead of VolumeClass volume => ... for signal handler argument type hunk ./gnomevfs/System/Gnome/VFS/Drive.chs 259 - :: (DriveClass drive, VolumeClass volume) => + :: (DriveClass drive) => hunk ./gnomevfs/System/Gnome/VFS/Drive.chs 261 - -> (volume -> IO ()) -- ^ @handler@ - the signal handling function + -> (Volume -> IO ()) -- ^ @handler@ - the signal handling function hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 143 - :: (VolumeMonitorClass volumeMonitor, VolumeClass volume) => + :: (VolumeMonitorClass volumeMonitor) => hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 145 - -> (volume -> IO ()) -- ^ @handler@ - the signal handling function + -> (Volume -> IO ()) -- ^ @handler@ - the signal handling function |
From: Duncan C. <dun...@wo...> - 2007-07-08 13:45:50
|
Sat Jul 7 14:08:48 PDT 2007 Peter Gavin <pg...@gm...> * glib: add support for GMainLoop/GMainContext hunk ./glib/System/Glib/MainLoop.chs.pp 43 + MainLoop, + mainLoopNew, + mainLoopRun, + mainLoopQuit, + mainLoopIsRunning, + MainContext, + mainContextNew, + mainContextDefault, + mainContextIteration, hunk ./glib/System/Glib/MainLoop.chs.pp 213 +-- | A main event loop abstraction. +{# pointer *GMainLoop as MainLoop foreign newtype #} + +-- | An opaque datatype representing a set of sources to be handled in +-- a main loop. +{# pointer *GMainContext as MainContext foreign newtype #} + +-- | Create a new 'MainLoop'. +mainLoopNew :: Maybe MainContext -- ^ @context@ - the context to use, or 'Nothing' to use the default context + -> Bool -- ^ @isRunning@ - 'True' to indicate that the loop is running; 'False' otherwise + -> IO MainLoop -- ^ the new 'MainLoop' +mainLoopNew context isRunning = + do let context' = maybe (MainContext nullForeignPtr) id context + loopPtr <- {# call main_loop_new #} context' $ fromBool isRunning + liftM MainLoop $ newForeignPtr loopPtr mainLoopFinalizer +foreign import ccall unsafe "&g_main_loop_unref" + mainLoopFinalizer :: FunPtr (Ptr MainLoop -> IO ()) + +-- | Runs a main loop until 'mainLoopQuit' is called on the +-- loop. If this is called for the thread of the loop's +-- 'MainContext', it will process events from the loop, otherwise it +-- will simply wait. +mainLoopRun :: MainLoop + -> IO () +mainLoopRun loop = + {# call main_loop_run #} loop + +-- | Stops a 'MainLoop' from running. Any calls to mainLoopRun for the +-- loop will return. +mainLoopQuit :: MainLoop + -> IO () +mainLoopQuit loop = + {# call main_loop_quit #} loop + +-- | Checks to see if the main loop is currently being run via mainLoopRun. +mainLoopIsRunning :: MainLoop + -> IO Bool +mainLoopIsRunning loop = + liftM toBool $ {# call main_loop_is_running #} loop + +-- | Gets a 'MainLoop's context. +mainLoopGetContext :: MainLoop + -> MainContext +mainLoopGetContext loop = + MainContext $ unsafePerformIO $ + {# call main_loop_get_context #} loop >>= + flip newForeignPtr mainContextFinalizer + +foreign import ccall unsafe "&g_main_context_unref" + mainContextFinalizer :: FunPtr (Ptr MainContext -> IO ()) + +-- | Creates a new 'MainContext'. +mainContextNew :: IO MainContext +mainContextNew = + newContextMarshal {# call main_context_new #} + +-- | The default 'MainContext'. This is the main context used for main +-- loop functions when a main loop is not explicitly specified. +mainContextDefault :: MainContext +mainContextDefault = + unsafePerformIO $ newContextMarshal {# call main_context_default #} + +newContextMarshal action = + do ptr <- action + liftM MainContext $ newForeignPtr ptr mainContextFinalizer + +-- | Runs a single iteration for the given main loop. This involves +-- checking to see if any event sources are ready to be processed, +-- then if no events sources are ready and @mayBlock@ is 'True', +-- waiting for a source to become ready, then dispatching the +-- highest priority events sources that are ready. Note that even +-- when @mayBlock@ is 'True', it is still possible for +-- 'mainContextIteration' to return FALSE, since the the wait +-- may be interrupted for other reasons than an event source +-- becoming ready. +mainContextIteration :: MainContext + -> Bool + -> IO Bool +mainContextIteration context mayBlock = + liftM toBool $ {# call main_context_iteration #} context (fromBool mayBlock) + |
From: Duncan C. <dun...@wo...> - 2007-07-08 13:45:50
|
Thu Jul 5 20:20:48 PDT 2007 pg...@gm... * gnomevfs: small fixes in cabal/package.conf files hunk ./gnomevfs/gnomevfs.cabal.in 8 -category: Graphics +category: System hunk ./gnomevfs/gnomevfs.package.conf.in 17 -ld-options: @GTK_LIBEXTRA_CQ@ +ld-options: @GNOMEVFS_LIBEXTRA_CQ@ |
From: Duncan C. <dun...@wo...> - 2007-07-08 13:45:50
|
Fri Jul 6 12:59:20 PDT 2007 pg...@gm... * gnomevfs: more documentation, type fixes, etc. in Volume/Drive/VolumeMonitor hunk ./gnomevfs/System/Gnome/VFS/Drive.chs 27 + DriveID, hunk ./gnomevfs/System/Gnome/VFS/Drive.chs 195 - drive -- ^ @drive@ - a drive object - -> IO Word -- ^ a unique identifier for the drive + drive -- ^ @drive@ - a drive object + -> IO DriveID -- ^ a unique identifier for the drive hunk ./gnomevfs/System/Gnome/VFS/Drive.chs 198 - liftM fromIntegral $ {# call drive_get_id #} (castToDrive drive) + {# call drive_get_id #} (castToDrive drive) hunk ./gnomevfs/System/Gnome/VFS/Drive.chs 260 - drive - -> (volume -> IO ()) - -> IO (ConnectId drive) + drive -- ^ @drive@ - the drive to connect the signal handler to + -> (volume -> IO ()) -- ^ @handler@ - the signal handling function + -> IO (ConnectId drive) -- ^ the identifier for the connection hunk ./gnomevfs/System/Gnome/VFS/Types.chs 97 + DriveID, hunk ./gnomevfs/System/Gnome/VFS/Types.chs 101 + VolumeID, hunk ./gnomevfs/System/Gnome/VFS/Types.chs 499 +-- | Identifies a 'Drive' +type DriveID = {# type gulong #} + hunk ./gnomevfs/System/Gnome/VFS/Types.chs 512 +-- | Identifies a 'Volume'. +type VolumeID = {# type gulong #} + hunk ./gnomevfs/System/Gnome/VFS/Volume.chs 27 + VolumeID, hunk ./gnomevfs/System/Gnome/VFS/Volume.chs 91 - -> IO Int + -> IO Ordering hunk ./gnomevfs/System/Gnome/VFS/Volume.chs 93 - liftM fromIntegral $ {# call volume_compare #} (castToVolume a) (castToVolume b) + do result <- liftM fromIntegral $ {# call volume_compare #} (castToVolume a) (castToVolume b) + let ordering | result < 0 = LT + | result > 0 = GT + | otherwise = EQ + return ordering hunk ./gnomevfs/System/Gnome/VFS/Volume.chs 221 - volume -- ^ @volume@ - a volume object - -> IO Word -- ^ a unique identifier for the volume + volume -- ^ @volume@ - a volume object + -> IO VolumeID -- ^ a unique identifier for the volume hunk ./gnomevfs/System/Gnome/VFS/Volume.chs 224 - liftM fromIntegral $ {# call volume_get_id #} (castToVolume volume) + {# call volume_get_id #} (castToVolume volume) hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 64 --- | [_$_] +-- | Returns a list of all drives connected to the machine. hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 66 - volumeMonitor - -> IO [Drive] + volumeMonitor -- ^ @volumeMonitor@ - the volume monitor + -> IO [Drive] -- ^ the drives connected to the machine hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 72 +-- | Try to find the 'Drive' with ID @id@. hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 74 - volumeMonitor - -> Word - -> IO Drive + volumeMonitor -- ^ @volumeMonitor@ - the volume monitor + -> DriveID -- ^ @id@ - the drive ID + -> IO (Maybe Drive) -- ^ the requested + -- drive, or 'Nothing' + -- if no drive with + -- that ID could be + -- found hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 82 - {# call volume_monitor_get_drive_by_id #} (castToVolumeMonitor volumeMonitor) (fromIntegral id) >>= - newDrive + {# call volume_monitor_get_drive_by_id #} (castToVolumeMonitor volumeMonitor) id >>= + maybePeek newDrive hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 85 +-- | Returns a list of all volumes currently mounted on the machine. hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 87 - volumeMonitor - -> IO [Volume] + volumeMonitor -- ^ @volumeMonitor@ - the volume monitor + -> IO [Volume] -- ^ the volumes + -- currently mounted + -- on the machine hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 95 +-- | Try to find the 'Volume' with ID @id@. hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 97 - volumeMonitor - -> Word - -> IO Drive + volumeMonitor -- ^ @volumeMonitor@ - the volume monitor + -> VolumeID -- ^ @id@ - the volume ID + -> IO (Maybe Volume) -- ^ the requested + -- volume, or + -- 'Nothing' if no + -- volume with that + -- ID could be found hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 105 - {# call volume_monitor_get_drive_by_id #} (castToVolumeMonitor volumeMonitor) (fromIntegral id) >>= - newDrive + {# call volume_monitor_get_volume_by_id #} (castToVolumeMonitor volumeMonitor) id >>= + maybePeek newVolume hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 108 +-- | Returns the 'Volume' corresponding to path, or 'Nothing'. +-- [_$_] +-- The volume referring to path is found by calling @stat@ on path, +-- and then iterating through the list of volumes that refer to +-- currently mounted local file systems. The first volume in this +-- list maching the path's UNIX device is returned. +-- [_$_] +-- If the @stat@ on path was not successful, or no volume matches +-- path, 'Nothing' is returned. hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 118 - volumeMonitor - -> FilePath - -> IO Volume + volumeMonitor -- ^ @volumeMonitor@ - the volume monitor + -> FilePath -- ^ the path to + -- find the volume + -- for + -> IO (Maybe Volume) -- ^ the volume the + -- path resides + -- on, or + -- 'Nothing' if + -- the volume + -- could not be + -- determined hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 131 - newVolume + maybePeek newVolume hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 143 - :: (VolumeMonitorClass drive, VolumeClass volume) => - drive - -> (volume -> IO ()) - -> IO (ConnectId drive) + :: (VolumeMonitorClass volumeMonitor, VolumeClass volume) => + volumeMonitor -- ^ @volumeMonitor@ - the volume monitor + -> (volume -> IO ()) -- ^ @handler@ - the signal handling function + -> IO (ConnectId volumeMonitor) -- ^ the identifier for the connection |
From: Duncan C. <dun...@wo...> - 2007-07-05 19:28:27
|
Thu Jul 5 02:42:00 PDT 2007 pg...@gm... * gnomevfs: initial import adddir ./demo/gnomevfs adddir ./gnomevfs adddir ./gnomevfs/System adddir ./gnomevfs/System/Gnome adddir ./gnomevfs/System/Gnome/VFS hunk ./Makefile.am 22 - gtk/Graphics/UI/Gtk/ModelView/Gtk2HsStore.h + gtk/Graphics/UI/Gtk/ModelView/Gtk2HsStore.h \ + gnomevfs/System/Gnome/VFS/hsfileinfo.h \ + gnomevfs/marshal.list hunk ./Makefile.am 62 +if ENABLE_GNOMEVFS +pkglib_LIBRARIES += libHSgnomevfs.a +endif hunk ./Makefile.am 1653 +# +# gnomevfs package +# +################################################################################ + +if ENABLE_GNOMEVFS + +gnomevfs_PKGNAME = libHSgnomevfs_a + +libHSgnomevfs_a_NAME = gnomevfs +libHSgnomevfs_a_CONFIG = gnomevfs/gnomevfs.$(PKGEXT) +libHSgnomevfs_a_EXTERNALDEPS = base haskell98 mtl +libHSgnomevfs_a_INTERNALDEPS = glib +libHSgnomevfs_a_HEADER = libgnomevfs/gnome-vfs.h +libHSgnomevfs_a_PRECOMP = gnomevfs/gnomevfs.precomp +libHSgnomevfs_a_LIBS = $(GLIB_LIBS) $(GNOMEVFS_LIBS) $(GCONF_LIBS) +libHSgnomevfs_a_HCFLAGS = -fffi +libHSgnomevfs_a_CFLAGS = $(filter-out -I% -D%,$(GLIB_CFLAGS) $(GNOMEVFS_CFLAGS)) +libHSgnomevfs_a_CPPFLAGS = $(filter -I% -D%,$(GLIB_CFLAGS) $(GNOMEVFS_CFLAGS)) + +libHSgnomevfs_a_SOURCESDIRS = gnomevfs + +libHSgnomevfs_a_LIBADD = \ + gnomevfs/System/Gnome/VFS/Directory_stub.o \ + gnomevfs/System/Gnome/VFS/Marshal_stub.o \ + gnomevfs/System/Gnome/VFS/Monitor_stub.o \ + gnomevfs/System/Gnome/VFS/Xfer_stub.o + +if !USE_GCLOSUE_SIGNALS_IMPL +libHSgnomevfs_a_LIBADD += gnomevfs/System/Gnome/VFS/Signals_stub.o +endif + +gnomevfs/libHSgnomevfs_a.deps : glib/libHSglib_a.deps + +libHSgnomevfs_a_GENERATEDSOURCES = \ + gnomevfs/System/Gnome/VFS/Signals.chs \ + gnomevfs/System/Gnome/VFS/Hierarchy.chs + +nodist_libHSgnomevfs_a_SOURCES = $(libHSgnomevfs_a_GENERATEDSOURCES) + +libHSgnomevfs_a_SOURCES = \ + gnomevfs/System/Gnome/VFS/Types.chs \ + gnomevfs/System/Gnome/VFS/Error.hs \ + gnomevfs/System/Gnome/VFS/Marshal.chs \ + gnomevfs/System/Gnome/VFS/Init.chs \ + gnomevfs/System/Gnome/VFS/hsfileinfo.c \ + gnomevfs/System/Gnome/VFS/FileInfo.chs \ + gnomevfs/System/Gnome/VFS/Monitor.chs \ + gnomevfs/System/Gnome/VFS/Ops.chs \ + gnomevfs/System/Gnome/VFS/Directory.chs \ + gnomevfs/System/Gnome/VFS/URI.chs \ + gnomevfs/System/Gnome/VFS/Util.chs \ + gnomevfs/System/Gnome/VFS/Xfer.chs \ + gnomevfs/System/Gnome/VFS/Cancellation.chs \ + gnomevfs/System/Gnome/VFS/Volume.chs \ + gnomevfs/System/Gnome/VFS/Drive.chs \ + gnomevfs/System/Gnome/VFS/VolumeMonitor.chs \ + gnomevfs/System/Gnome/VFS/MIME.chs \ + gnomevfs/System/Gnome/VFS.hs + +htmldoc_HSFILES_HIDDEN += \ + $(libHSgnomevfs_a_GENERATEDSOURCES:.chs=.hs) \ + gnomevfs/System/Gnome/VFS/Types.hs \ + gnomevfs/System/Gnome/VFS/Marshal.hs + +gnomevfs_System_Gnome_VFS_FileInfo_hs_HCFLAGS = '-\#include "hsfileinfo.h"' +gnomevfs_System_Gnome_VFS_MIME_hs_HCFLAGS = '-\#include "libgnomevfs/gnome-vfs-mime.h"' +gnomevfs_System_Gnome_VFS_Types_hs_HCFLAGS = -fglasgow-exts +gnomevfs_System_Gnome_VFS_Directory_hs_HCFLAGS = -fglasgow-exts + +libHSgnomevfs_a_ALLSOURCES = $(libHSgnomevfs_a_SOURCES) $(nodist_libHSgnomevfs_a_SOURCES) + +gnomevfs/System/Gnome/VFS/Hierarchy.chs : \ + $(srcdir)/tools/hierarchyGen/hierarchy.list \ + $(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT) \ + $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template + $(strip $(srcdir)/tools/hierarchyGen/TypeGenerator$(EXEEXT) \ + $(srcdir)/tools/hierarchyGen/hierarchy.list \ + $(srcdir)/tools/hierarchyGen/Hierarchy.chs.template \ + $@ --tag=gnomevfs --lib=gnomevfs --prefix=gnome_vfs \ + --modname=System.Gnome.VFS.Hierarchy --parentname=System.Glib.GObject) + +gnomevfs/System/Gnome/VFS/Signals.chs : \ + $(srcdir)/tools/callbackGen/Signal.chs.template \ + $(srcdir)/gnomevfs/marshal.list \ + $(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT) + $(strip $(srcdir)/tools/callbackGen/HookGenerator$(EXEEXT) \ + $(srcdir)/gnomevfs/marshal.list \ + $(srcdir)/tools/callbackGen/Signal.chs.template $@ \ + System.Gnome.VFS.Signals) + +am_libHSgnomevfs_a_OBJECTS = \ + $(addsuffix .$(OBJEXT),$(basename $(basename $(libHSgnomevfs_a_ALLSOURCES)))) + +libHSgnomevfs_a_HSPPFILES = $(filter %.hs.pp, $(libHSgnomevfs_a_ALLSOURCES)) +libHSgnomevfs_a_CHSPPFILES = $(filter %.chs.pp,$(libHSgnomevfs_a_ALLSOURCES)) +libHSgnomevfs_a_CHSFILES = \ + $(filter %.chs,$(libHSgnomevfs_a_ALLSOURCES:.chs.pp=.chs)) +libHSgnomevfs_a_CHSFILES_HS = $(libHSgnomevfs_a_CHSFILES:.chs=.hs) +libHSgnomevfs_a_HSCFILES = $(filter %.hsc, $(libHSgnomevfs_a_ALLSOURCES)) +libHSgnomevfs_a_HSCFILES_HS = $(libHSgnomevfs_a_HSCFILES:.hsc=.hs) +libHSgnomevfs_a_BUILDSOURCES = \ + $(libHSgnomevfs_a_HSPPFILES:.hs.pp=.hs) \ + $(libHSgnomevfs_a_CHSPPFILES:.chs.pp=.chs) \ + $(libHSgnomevfs_a_CHSFILES_HS) \ + $(libHSgnomevfs_a_HSCFILES_HS) \ + $(libHSgnomevfs_a_GENERATEDSOURCES) +libHSgnomevfs_a_HSFILES = \ + $(filter %.hs,$(libHSgnomevfs_a_BUILDSOURCES)) \ + $(filter %.hs,$(libHSgnomevfs_a_ALLSOURCES)) +libHSgnomevfs_a_CFILES = $(filter %.c,$(libHSgnomevfs_a_ALLSOURCES)) + +nobase_hi_DATA += $(libHSgnomevfs_a_HSFILES:.hs=.hi) + +gnomevfs_MOSTLYCLEANFILES = $(am_libHSgnomevfs_a_OBJECTS) +gnomevfs_MOSTLYCLEANFILES += $(libHSgnomevfs_a_HSFILES:.hs=.hi) +gnomevfs_MOSTLYCLEANFILES += $(libHSgnomevfs_a_CHSFILES:.chs=.chi) +gnomevfs_MOSTLYCLEANFILES += $(libHSgnomevfs_a_CHSFILES:.chs=.h) +gnomevfs_MOSTLYCLEANFILES += $(libHSgnomevfs_a_CHSFILES:.chs=_stub.h) +gnomevfs_MOSTLYCLEANFILES += $(libHSgnomevfs_a_CHSFILES:.chs=_stub.o) +gnomevfs_MOSTLYCLEANFILES += $(libHSgnomevfs_a_CHSFILES:.chs=_stub.c) +gnomevfs_CLEANFILES = $(libHSgnomevfs_a_BUILDSOURCES) +gnomevfs_CLEANFILES += $(libHSgnomevfs_a_CHSFILES_HS:.hs=.dep) + +$(libHSgnomevfs_a_CHSFILES:.chs=.dep) : \ + $(libHSgnomevfs_a_GENERATEDSOURCES) + +ifeq (,$(findstring clean,$(MAKECMDGOALS))) +-include $(libHSgnomevfs_a_CHSFILES:.chs=.dep) gnomevfs/libHSgnomevfs_a.deps + endif + +if ENABLE_SPLITOBJS +libHSgnomevfs_a_AR = $(srcdir)/mk/link-splitobjs.sh +else +libHSgnomevfs_a_AR = $(AR) $(ARFLAGS) +endif + +libHSgnomevfs_a_DEPENDENCIES = HSgnomevfs.o +pkglib_DATA += HSgnomevfs.o +HSgnomevfs.o : $(libHSgnomevfs_a_OBJECTS) + $(LD) -r $(LD_X) -o $@ $(libHSgnomevfs_a_OBJECTS) $(libHSgnomevfs_a_LIBADD) + +if ENABLE_PROFILING +libHSgnomevfs_a_DEPENDENCIES += libHSgnomevfs_p.a +pkglib_DATA += libHSgnomevfs_p.a +libHSgnomevfs_p.a : $(libHSgnomevfs_a_HSFILES:.hs=.p_o) \ + $(libHSgnomevfs_a_LIBADD:.o=.p_o) + $(AR) $(ARFLAGS) $@ $^ + +ifeq (,$(findstring clean,$(MAKECMDGOALS))) +-include gnomevfs/libHSgnomevfs_a.p_deps + endif + +nobase_hi_DATA += $(libHSgnomevfs_a_HSFILES:.hs=.p_hi) +gnomevfs_MOSTLYCLEANFILES += $(libHSgnomevfs_a_HSFILES:.hs=.p_hi) +gnomevfs_MOSTLYCLEANFILES += $(libHSgnomevfs_a_HSFILES:.hs=.p_o) +gnomevfs_MOSTLYCLEANFILES += $(libHSgnomevfs_a_LIBADD:.o=.p_o) + +endif + +endif + hunk ./Makefile.am 2135 + rm -f $(gnomevfs_MOSTLYCLEANFILES) hunk ./Makefile.am 2150 + rm -f $(gnomevfs_CLEANFILES) hunk ./configure.ac 343 +GTKHS_PKG_CHECK(gnomevfs, gnomevfs, GNOMEVFS, [gnome-vfs-2.0 >= 2.0.0], + [build gnome-vfs package (default=auto)], + [gnomevfs library requirement not met. Perhaps you need to install libgnomevfs or libgnomevfs-devel]) hunk ./configure.ac 629 +GTKHS_REFORMAT_PACKAGE_CFLAGS(GNOMEVFS_CFLAGS, GNOMEVFS_CFLAGS_CQ) +GTKHS_REFORMAT_PACKAGE_LIBS(GNOMEVFS_LIBS, GNOMEVFS_LIBS_CQ, GNOMEVFS_LIBDIR_CQ, GNOMEVFS_LIBEXTRA_CQ) +AC_SUBST(GNOMEVFS_CFLAGS_CQ) +AC_SUBST(GNOMEVFS_LIBS_CQ) +AC_SUBST(GNOMEVFS_LIBDIR_CQ) +AC_SUBST(GNOMEVFS_LIBEXTRA_CQ) + hunk ./configure.ac 863 + + gnomevfs/gnomevfs.pkg + gnomevfs/gnomevfs.package.conf + gnomevfs/gnomevfs.cabal hunk ./configure.ac 887 +echo "* gnomevfs : ${ENABLE_GNOMEVFS} " addfile ./demo/gnomevfs/Makefile hunk ./demo/gnomevfs/Makefile 1 + +PROGS = test-sync test-dir test-xfer test-drive-volume +SOURCES = TestSync.hs TestDir.hs TestXfer.hs TestDriveVolume.hs + +all: $(PROGS) + +test-sync : TestSync.hs + $(HC_RULE) +test-dir : TestDir.hs + $(HC_RULE) +test-xfer : TestXfer.hs + $(HC_RULE) +test-drive-volume : TestDriveVolume.hs + $(HC_RULE) + +HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS) + +clean: + rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS) + +HC=ghc addfile ./demo/gnomevfs/TestDir.hs hunk ./demo/gnomevfs/TestDir.hs 1 +module Main where + +import qualified System.Gnome.VFS as VFS +import Control.Exception ( handleJust ) +import Control.Monad ( when + , liftM ) +import Data.Maybe ( fromMaybe ) +import Text.Printf ( printf ) +import System.Time ( ClockTime(..) + , calendarTimeToString + , toCalendarTime ) +import System.IO +import System.Exit +import System.Environment + +handleVFSError vfsError = + let VFS.Error result = vfsError + in do hPutStrLn stderr $ "VFS error: " ++ show result + exitFailure + +directoryVisitCallback :: String + -> VFS.FileInfo + -> Bool + -> IO VFS.DirectoryVisitResult +directoryVisitCallback name fileInfo recursingWillLoop = + do mTimeStr <- case VFS.fileInfoMTime fileInfo of + Just mTime -> liftM calendarTimeToString $ + toCalendarTime $ TOD (fromIntegral $ fromEnum mTime) 0 + Nothing -> return "unknown" + let name = fromMaybe "unknown" (VFS.fileInfoName fileInfo) + size = VFS.formatFileSizeForDisplay (fromMaybe 0 (VFS.fileInfoSize fileInfo)) + [_$_] + printf "%20s %20s %s\n" size mTimeStr name + return VFS.DirectoryVisitContinue + +main :: IO () +main = + handleJust VFS.errors handleVFSError $ + do progName <- getProgName + args <- getArgs + [_$_] + when (length args /= 1) $ + do hPutStrLn stderr $ "Usage: " ++ progName ++ " <uri>" + exitFailure + [_$_] + VFS.init >>= (\success -> + when (not success) $ + do hPutStrLn stderr $ "could not initialize GnomeVFS" + exitFailure) + [_$_] + let textURI = head args + uri <- case VFS.uriFromString textURI of + Nothing -> do hPutStrLn stderr $ "Invalid URI: " ++ textURI + exitFailure + Just uri -> return uri + [_$_] + VFS.directoryVisit textURI [] [] directoryVisitCallback addfile ./demo/gnomevfs/TestDriveVolume.hs hunk ./demo/gnomevfs/TestDriveVolume.hs 1 +module Main where + +import qualified System.Gnome.VFS as VFS +import Control.Exception ( handleJust ) +import Control.Monad ( when + , liftM ) +import Data.Maybe ( fromMaybe ) +import Text.Printf ( printf ) +import System.IO +import System.Exit + +handleVFSError vfsError = + let VFS.Error result = vfsError + in do hPutStrLn stderr $ "VFS error: " ++ show result + exitFailure + +main :: IO () +main = + handleJust VFS.errors handleVFSError $ + do VFS.init >>= (\success -> + when (not success) $ + do hPutStrLn stderr $ "could not initialize GnomeVFS" + exitFailure) + [_$_] + drives <- VFS.volumeMonitorGetConnectedDrives VFS.volumeMonitor + flip mapM_ drives $ \drive -> + do VFS.driveGetDisplayName drive >>= printf "Drive %s:\n" + VFS.driveGetDeviceType drive >>= (printf "\tDevice Type: %s\n") . show + VFS.driveGetDevicePath drive >>= (printf "\tDevice Path: %s\n") . show + volumes <- VFS.driveGetMountedVolumes drive + flip mapM_ volumes $ \volume -> + do VFS.volumeGetDisplayName volume >>= printf "\tVolume %s:\n" + VFS.volumeGetDevicePath volume >>= printf "\t\tDevice Path: %s\n" + VFS.volumeGetFilesystemType volume >>= printf "\t\tFilesystem Type: %s\n" + [_$_] + return () addfile ./demo/gnomevfs/TestSync.hs hunk ./demo/gnomevfs/TestSync.hs 1 +module Main where + +import qualified System.Gnome.VFS as VFS +import Control.Exception +import Control.Monad (when) +import Data.Maybe (fromMaybe) +import System.IO +import System.Exit +import System.Environment +import qualified Data.ByteString as BS + +handleVFSError vfsError = + let VFS.Error result = vfsError + in do hPutStrLn stderr $ "VFS error: " ++ show result + exitFailure + +main :: IO () +main = [_$_] + handleJust VFS.errors handleVFSError $ + do progName <- getProgName + args <- getArgs + [_$_] + when (length args /= 1) $ + do hPutStrLn stderr $ "Usage: " ++ progName ++ " <uri>" + exitFailure + [_$_] + VFS.init >>= (\success -> + when (not success) $ + do hPutStrLn stderr $ "could not initialize GnomeVFS" + exitFailure) + [_$_] + let textURI = head args + uri <- case VFS.uriFromString textURI of + Nothing -> do hPutStrLn stderr $ "Invalid URI: " ++ textURI + exitFailure + Just uri -> return uri + [_$_] + handle <- VFS.openURI uri VFS.OpenRead + fileInfo <- VFS.getFileInfoFromHandle handle [] + let blockSize = fromMaybe 4096 $ VFS.fileInfoIOBlockSize fileInfo + [_$_] + let loop = handleJust VFS.errors + (\(VFS.Error result) -> + case result of + VFS.ErrorEof -> return () + _ -> handleVFSError $ VFS.Error result) $ + do bytes <- VFS.read handle blockSize + BS.putStr bytes + loop + loop + [_$_] + VFS.close handle addfile ./demo/gnomevfs/TestXfer.hs hunk ./demo/gnomevfs/TestXfer.hs 1 +module Main where + +import qualified System.Gnome.VFS as VFS +import Control.Exception ( handleJust ) +import Control.Monad ( when + , liftM ) +import Data.Maybe ( fromMaybe ) +import Text.Printf ( printf ) +import System.IO +import System.Exit +import System.Environment + +handleVFSError vfsError = + let VFS.Error result = vfsError + in do hPutStrLn stderr $ "VFS error: " ++ show result + exitFailure + +xferProgressCallback :: VFS.XferProgressCallback +xferProgressCallback info = + do printf "Status: %s\tPhase: %s\n" + (show $ VFS.xferProgressInfoVFSStatus info) + (show $ VFS.xferProgressInfoPhase info) + printf "\tSource: %s\n\tTarget: %s\n" + (show $ VFS.xferProgressInfoSourceName info) + (show $ VFS.xferProgressInfoTargetName info) + printf "\t%d of %d files\n" + (toInteger $ VFS.xferProgressInfoFileIndex info) + (toInteger $ VFS.xferProgressInfoFilesTotal info) + printf "\t%s of %s\n" + (VFS.formatFileSizeForDisplay $ VFS.xferProgressInfoBytesCopied info) + (VFS.formatFileSizeForDisplay $ VFS.xferProgressInfoFileSize info) + printf "\t%s of %s total\n" + (VFS.formatFileSizeForDisplay $ VFS.xferProgressInfoTotalBytesCopied info) + (VFS.formatFileSizeForDisplay $ VFS.xferProgressInfoBytesTotal info) + return True + +xferErrorCallback :: VFS.XferErrorCallback +xferErrorCallback info = + do printf "error: %s; aborting transfer\n" $ show $ VFS.xferProgressInfoVFSStatus info + return VFS.XferErrorActionAbort + +xferOverwriteCallback :: VFS.XferOverwriteCallback +xferOverwriteCallback info = + do printf "skipping file %s as it already exists\n" $ fromMaybe "unknown" $ VFS.xferProgressInfoSourceName info + return VFS.XferOverwriteActionSkip + +main :: IO () +main = + handleJust VFS.errors handleVFSError $ + do progName <- getProgName + args <- getArgs + [_$_] + when (length args /= 2) $ + do hPutStrLn stderr $ "Usage: " ++ progName ++ " source target" + exitFailure + [_$_] + VFS.init >>= (\success -> + when (not success) $ + do hPutStrLn stderr $ "could not initialize GnomeVFS" + exitFailure) + [_$_] + hPutStrLn stderr "vfs initialized" + [_$_] + let [source, target] = args + [_$_] + hPutStrLn stderr "parsing source URI" + [_$_] + sourceURI <- case VFS.uriFromString source of + Just sourceURI -> return sourceURI + Nothing -> do hPutStrLn stderr $ "invalid source URI" + exitFailure + [_$_] + hPutStrLn stderr "parsing target URI" + [_$_] + targetURI <- case VFS.uriFromString target of + Just targetURI -> return targetURI + Nothing -> do hPutStrLn stderr $ "invalid target URI" + exitFailure + [_$_] + hPutStrLn stderr "executing transfer" + [_$_] + VFS.xferURI sourceURI targetURI [] + VFS.XferErrorModeQuery VFS.XferOverwriteModeQuery + (Just xferProgressCallback) (Just xferErrorCallback) + (Just xferOverwriteCallback) Nothing + [_$_] + return () addfile ./gnomevfs/System/Gnome/VFS.hs hunk ./gnomevfs/System/Gnome/VFS.hs 1 +-- GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*- +-- +-- Author : Peter Gavin +-- Created: 1-Apr-2007 +-- +-- Copyright (c) 2007 Peter Gavin +-- +-- 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. +-- +-- | Maintainer : gtk...@li... +-- Stability : alpha +-- Portability : portable (depends on GHC) +module System.Gnome.VFS ( + [_$_] + module System.Gnome.VFS.Cancellation, + module System.Gnome.VFS.Directory, + module System.Gnome.VFS.Drive, + module System.Gnome.VFS.Error, + module System.Gnome.VFS.FileInfo, + module System.Gnome.VFS.Init, + module System.Gnome.VFS.MIME, + module System.Gnome.VFS.Monitor, + module System.Gnome.VFS.Ops, + module System.Gnome.VFS.URI, + module System.Gnome.VFS.Util, + module System.Gnome.VFS.Volume, + module System.Gnome.VFS.VolumeMonitor, + module System.Gnome.VFS.Xfer + + ) where + +import System.Gnome.VFS.Cancellation +import System.Gnome.VFS.Directory +import System.Gnome.VFS.Drive +import System.Gnome.VFS.Error +import System.Gnome.VFS.FileInfo +import System.Gnome.VFS.Init +import System.Gnome.VFS.MIME +import System.Gnome.VFS.Monitor +import System.Gnome.VFS.Ops +import System.Gnome.VFS.URI +import System.Gnome.VFS.Util +import System.Gnome.VFS.Volume +import System.Gnome.VFS.VolumeMonitor +import System.Gnome.VFS.Xfer addfile ./gnomevfs/System/Gnome/VFS/Cancellation.chs hunk ./gnomevfs/System/Gnome/VFS/Cancellation.chs 1 +-- GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*- +-- +-- Author : Peter Gavin +-- Created: 1-Apr-2007 +-- +-- Copyright (c) 2007 Peter Gavin +-- +-- 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. +-- +-- | Maintainer : gtk...@li... +-- Stability : alpha +-- Portability : portable (depends on GHC) +module System.Gnome.VFS.Cancellation ( + [_$_] +-- * Types + Cancellation, + +-- * Cancellation creation + cancellationNew, + +-- * Cancellation notification + cancellationCancel, + cancellationCheck, + cancellationAck, + +-- * Other Operations + cancellationGetFD + [_$_] + ) where + +import Control.Monad (liftM) +import System.Glib.FFI +{#import System.Gnome.VFS.Types#} +import System.Posix.Types (Fd) + +{# context lib = "gnomevfs" prefix = "gnome_vfs" #} + +-- | Create a new 'Cancellation' object for reporting +-- cancellation to a gnome-vfs module. +cancellationNew :: IO Cancellation -- ^ a new 'Cancellation' object +cancellationNew = + {# call cancellation_new #} >>= newCancellation + +-- | Send a cancellation request through a 'Cancellation' object. +cancellationCancel :: Cancellation -- ^ @cancellation@ - the object to request cancellation through + -> IO () +cancellationCancel cancellation = + {# call cancellation_cancel #} cancellation + +-- | Check for pending cancellation. +cancellationCheck :: Cancellation -- ^ @cancellation@ - the object to check for cancellation + -> IO Bool -- ^ 'True' if cancellation has been requested, 'False' otherwise +cancellationCheck cancellation = + liftM toBool $ {# call cancellation_check #} cancellation + +-- | Acknowledge a cancellation. This should be called if +-- 'cancellationCheck' returns 'True'. +cancellationAck :: Cancellation -- ^ @cancellation@ - the object to achnowledge cancellation + -> IO () +cancellationAck cancellation = + {# call cancellation_ack #} cancellation + +-- | Get a file descriptor-based notificator for cancellation. When +-- cancellation receives a cancellation request, a character will be +-- made available on the returned file descriptor for input. +-- [_$_] +-- This is very useful for detecting cancellation during I\/O +-- operations: you can use the select() call to check for available +-- input\/output on the file you are reading\/writing, and on the +-- notificator's file descriptor at the same time. If a data is +-- available on the notificator's file descriptor, you know you have +-- to cancel the read\/write operation. +cancellationGetFD :: Cancellation -- ^ @cancellation@ - the object to get a file descriptor for + -> IO Fd -- ^ the file descriptor +cancellationGetFD cancellation = + liftM fromIntegral $ {# call cancellation_get_fd #} cancellation addfile ./gnomevfs/System/Gnome/VFS/Directory.chs hunk ./gnomevfs/System/Gnome/VFS/Directory.chs 1 +-- GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*- +-- +-- Author : Peter Gavin +-- Created: 1-Apr-2007 +-- +-- Copyright (c) 2007 Peter Gavin +-- +-- 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. +-- +-- | Maintainer : gtk...@li... +-- Stability : alpha +-- Portability : portable (depends on GHC) +-- [_$_] +-- Functions for creating, removing, and accessing directories and +-- their contents. +-- [_$_] +module System.Gnome.VFS.Directory ( + +-- * Types + DirectoryHandle, + DirectoryVisitOptions(..), + DirectoryVisitResult(..), + [_$_] +-- * Directory Creation + makeDirectory, + makeDirectoryForURI, + +-- * Directory Removal + removeDirectory, + removeDirectoryFromURI, + +-- * Directory Access + directoryOpen, + directoryOpenFromURI, + directoryReadNext, + directoryClose, + directoryListLoad, + +-- * Directory Traversal + directoryVisit, + directoryVisitURI, + directoryVisitFiles, + directoryVisitFilesAtURI + [_$_] + ) where + +import Control.Exception ( assert + , bracket ) +import Control.Monad ( liftM ) +import System.Glib.GList ( GList() + , toGList + , readGList ) +import System.Glib.UTFString ( withUTFString + , peekUTFString + , newUTFString ) +import System.Glib.FFI +{#import System.Gnome.VFS.FileInfo#} +{#import System.Gnome.VFS.Types#} +{#import System.Gnome.VFS.Marshal#} + +{# context lib = "gnomevfs" prefix = "gnome_vfs" #} + +-- | Create @textURI@ as a directory. Only succeeds if a file or +-- directory does not already exist at @textURI@. +makeDirectory :: TextURI -- ^ @textURI@ - String representation of the URI of the directory to create + -> [FilePermissions] -- ^ @perm@ - 'FilePermissions' for the newly created directory + -> IO () +makeDirectory textURI perm = + let cPerm = cFromFlags perm + in withUTFString textURI $ \cTextURI -> + voidResultMarshal $ {# call make_directory #} cTextURI cPerm + +-- | Create @uri@ as a directory. Only succeeds if a file or +-- directory does not already exist at @uri@. +makeDirectoryForURI :: URI -- ^ @uri@ - 'URI' of the directory to be created + -> [FilePermissions] -- ^ @perm@ - 'FilePermissions' for the newly created directory + -> IO () +makeDirectoryForURI uri perm = + let cPerm = cFromFlags perm + in voidResultMarshal $ {# call make_directory_for_uri #} uri cPerm + +-- | Remove the directory at @textURI@. The object at @textURI@ must be an empty directory. +removeDirectory :: TextURI -- ^ @textURI@ - URI of the directory to be removed + -> IO () +removeDirectory textURI = + withUTFString textURI $ voidResultMarshal . {# call remove_directory #} + +-- | Remove the directory at @uri@. The object at @uri@ must be an empty directory. +removeDirectoryFromURI :: URI -- ^ @uri@ - 'URI' of the directory to be removed + -> IO () +removeDirectoryFromURI uri = + voidResultMarshal $ {# call remove_directory_from_uri #} uri + +-- | Open directory textURI for reading. Returns a 'DirectoryHandle' +-- which can be used to read directory entries one by one. +directoryOpen :: TextURI -- ^ @textURI@ - String representation of the URI of the directory to open + -> [FileInfoOptions] -- ^ @fileInfoOptions@ - options for reading file information + -> IO DirectoryHandle -- ^ handle to the opened directory +directoryOpen textURI fileInfoOptions = + let cFileInfoOptions = cFromFlags fileInfoOptions + in withUTFString textURI $ \cTextURI -> + newObjectResultMarshal DirectoryHandle $ \cHandlePtr -> + {# call directory_open #} (castPtr cHandlePtr) cTextURI cFileInfoOptions + +-- | Open directory textURI for reading. Returns a 'DirectoryHandle' +-- which can be used to read directory entries one by one. +directoryOpenFromURI :: URI -- ^ @uri@ - 'URI' of the directory to open + -> [FileInfoOptions] -- ^ @fileInfoOptions@ - options for reading file information + -> IO DirectoryHandle -- ^ handle to the opened directory +directoryOpenFromURI uri fileInfoOptions = + let cFileInfoOptions = cFromFlags fileInfoOptions + in newObjectResultMarshal DirectoryHandle $ \cHandlePtr -> + {# call directory_open_from_uri #} (castPtr cHandlePtr) uri cFileInfoOptions + +-- | Read the next directory entry from a 'DirectoryHandle'. +directoryReadNext :: DirectoryHandle -- ^ @handle@ - a directory handle + -> IO FileInfo -- ^ file information for the next directory entry +directoryReadNext handle = + alloca $ \(cFileInfoPtr :: Ptr FileInfo) -> + genericResultMarshal ({# call directory_read_next #} handle $ castPtr cFileInfoPtr) + (peek cFileInfoPtr) + (return ()) + +-- | Close a 'DirectoryHandle'. +directoryClose :: DirectoryHandle -- ^ @handle@ - a directory handle + -> IO () +directoryClose handle = + voidResultMarshal $ {# call directory_close #} handle + +type CDirectoryVisitFunc = CString -- rel_path + -> Ptr FileInfo -- info + -> {# type gboolean #} -- recursing_will_loop + -> {# type gpointer #} -- user_data + -> Ptr {# type gboolean #} -- recurse + -> IO {# type gboolean #} +directoryVisitCallbackMarshal :: DirectoryVisitCallback + -> IO {# type GnomeVFSDirectoryVisitFunc #} +directoryVisitCallbackMarshal callback = + let cCallback :: CDirectoryVisitFunc + cCallback cRelPath cInfo cRecursingWillLoop cUserData cRecursePtr = + do relPath <- peekUTFString cRelPath + info <- peek cInfo + let recursingWillLoop = toBool cRecursingWillLoop + result <- callback relPath info recursingWillLoop + case result of + DirectoryVisitStop -> return $ fromBool False + DirectoryVisitContinue -> return $ fromBool True + DirectoryVisitRecurse -> do poke cRecursePtr $ fromBool True + return $ fromBool True + in makeDirectoryVisitFunc cCallback +foreign import ccall safe "wrapper" + makeDirectoryVisitFunc :: CDirectoryVisitFunc + -> IO {# type GnomeVFSDirectoryVisitFunc #} + +type DirectoryVisit = [FileInfoOptions] + -> [DirectoryVisitOptions] + -> DirectoryVisitCallback + -> IO () +type CDirectoryVisit = {# type GnomeVFSFileInfoOptions #} + -> {# type GnomeVFSDirectoryVisitOptions #} + -> {# type GnomeVFSDirectoryVisitFunc #} + -> {# type gpointer #} + -> IO {# type GnomeVFSResult #} + +directoryVisitMarshal :: CDirectoryVisit + -> DirectoryVisit +directoryVisitMarshal cVisitAction infoOptions visitOptions callback = + let cInfoOptions = cFromFlags infoOptions + cVisitOptions = cFromFlags visitOptions + in bracket (directoryVisitCallbackMarshal callback) + freeHaskellFunPtr + (\cDirectoryVisitFunc -> + voidResultMarshal $ cVisitAction cInfoOptions cVisitOptions cDirectoryVisitFunc nullPtr) + +-- | Visit each entry in a directory at a 'TextURI', calling a +-- 'DirectoryVisitCallback' for each one. +directoryVisit :: String -- ^ @textURI@ - string representation of the URI of the directory to visit + -> [FileInfoOptions] -- ^ @infoOptions@ - options for reading file information + -> [DirectoryVisitOptions] -- ^ @visitOptions@ - options for visiting the directory + -> DirectoryVisitCallback -- ^ @callback@ - a function to be called for each entry + -> IO () +directoryVisit textURI infoOptions visitOptions callback = + withUTFString textURI $ \cTextURI -> + directoryVisitMarshal ({# call directory_visit #} cTextURI) infoOptions visitOptions callback + +-- | Visit each entry in a directory at a 'URI', calling a +-- 'DirectoryVisitCallback' for each one. +directoryVisitURI :: URI -- ^ @uri@ - the URI of the directory to visit + -> [FileInfoOptions] -- ^ @infoOptions@ - options for reading file information + -> [DirectoryVisitOptions] -- ^ @visitOptions@ - options for visiting the directory + -> DirectoryVisitCallback -- ^ @callback@ - a function to be called for each entry + -> IO () +directoryVisitURI uri = + directoryVisitMarshal ({# call directory_visit_uri #} uri) + +-- | Visit each file in a list contained with a directory at a +-- 'TextURI', calling a 'DirectoryVisitCallback' for each one. +directoryVisitFiles :: TextURI -- ^ @textURI@ - string representation of the URI of the directory to visit + -> [String] -- ^ @files@ - the files contained in @textURI@ to be visited + -> [FileInfoOptions] -- ^ @infoOptions@ - options for reading file information + -> [DirectoryVisitOptions] -- ^ @visitOptions@ - options for visiting the directory + -> DirectoryVisitCallback -- ^ @callback@ - a function to be called for each entry + -> IO () +directoryVisitFiles textURI files infoOptions visitOptions callback = + do cFiles <- mapM newUTFString files >>= toGList + withUTFString textURI $ \cTextURI -> + directoryVisitMarshal ({# call directory_visit_files #} cTextURI cFiles) infoOptions visitOptions callback + +-- | Visit each file in a list contained with a directory at a +-- 'URI', calling a 'DirectoryVisitCallback' for each one. +directoryVisitFilesAtURI :: URI -- ^ @uri@ - the 'URI' of the directory to visit + -> [String] -- ^ @files@ - the files contained in @textURI@ to be visited + -> [FileInfoOptions] -- ^ @infoOptions@ - options for reading file information + -> [DirectoryVisitOptions] -- ^ @visitOptions@ - options for visiting the directory + -> DirectoryVisitCallback -- ^ @callback@ - a function to be called for each entry + -> IO () +directoryVisitFilesAtURI uri files infoOptions visitOptions callback = + do cFiles <- mapM newUTFString files >>= toGList + directoryVisitMarshal ({# call directory_visit_files_at_uri #} uri cFiles) infoOptions visitOptions callback + +-- | Create a list of 'FileInfo' objects representing each entry in the +-- directory at @textURI@, using options @options@. +directoryListLoad :: TextURI -- ^ @textURI@ - String representation of the URI of the directory to load + -> [FileInfoOptions] -- ^ @options@ - options for reading file information + -> IO [FileInfo] -- ^ the entries contined in the directory +directoryListLoad textURI options = + let cOptions = cFromFlags options + in withUTFString textURI $ \cTextURI -> + alloca $ \cListPtr -> + genericResultMarshal ({# call directory_list_load #} cListPtr cTextURI cOptions) + (peek cListPtr >>= readGList >>= mapM peek) + (do cList <- peek cListPtr + assert (cList == nullPtr) $ return ()) addfile ./gnomevfs/System/Gnome/VFS/Drive.chs hunk ./gnomevfs/System/Gnome/VFS/Drive.chs 1 +-- GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*- +-- +-- Author : Peter Gavin +-- Created: 1-Apr-2007 +-- +-- Copyright (c) 2007 Peter Gavin +-- +-- 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. +-- +-- | Maintainer : gtk...@li... +-- Stability : alpha +-- Portability : portable (depends on GHC) +module System.Gnome.VFS.Drive ( + +-- * Types + -- | A container for 'Volume's. + Drive, + DriveClass, + DeviceType, + +-- * Type Conversion + castToDrive, + +-- * Drive Comparison + driveCompare, + +-- * Drive Properties + driveGetActivationURI, + driveGetDevicePath, + driveGetDeviceType, + driveGetDisplayName, + driveGetHalUDI, + driveGetIcon, + driveGetID, + +-- * Drive State + driveIsConnected, + driveIsMounted, + driveIsUserVisible, + driveGetMountedVolumes, + +-- * Drive Operations + driveEject, + driveMount, + [_$_] +-- * Drive Signals + onDriveVolumeMounted, + afterDriveVolumeMounted, + onDriveVolumePreUnmount, + afterDriveVolumePreUnmount, + onDriveVolumeUnmounted, + afterDriveVolumeUnmounted + [_$_] + ) where + +import Control.Exception +import Control.Monad ( liftM ) +import System.Glib.UTFString +import System.Glib.FFI +import System.Glib.GList ( fromGList ) +{#import System.Glib.Signals#} +{#import System.Gnome.VFS.Marshal#} +{#import System.Gnome.VFS.Types#} +{#import System.Gnome.VFS.Signals#} + +{# context lib = "gnomevfs" prefix = "gnome_vfs" #} + +-- | Compares two 'DriveClass' objects @a@ and @b@. Two 'DriveClass' +-- objects referring to different drives are guaranteed to not +-- return 'EQ' when comparing them. If they refer to the same drive 'EQ' +-- is returned. +-- [_$_] +-- The resulting gint should be used to determine the order in which +-- @a@ and @b@ are displayed in graphical user interfaces. +-- [_$_] +-- The comparison algorithm first of all peeks the device type of +-- @a@ and @b@, they will be sorted in the following order: +-- [_$_] +-- * Magnetic and opto-magnetic drives (ZIP, floppy) +-- [_$_] +-- * Optical drives (CD, DVD) +-- [_$_] +-- * External drives (USB sticks, music players) +-- [_$_] +-- * Mounted hard disks +-- [_$_] +-- * Other drives +-- [_$_] +-- Afterwards, the display name of @a@ and @b@ is compared using a +-- locale-sensitive sorting algorithm. +-- [_$_] +-- If two drives have the same display name, their unique ID is +-- compared which can be queried using 'driveGetID'. +driveCompare :: DriveClass drive => + drive -- ^ @a@ - the first drive + -> drive -- ^ @b@ - the second drive + -> IO Ordering -- ^ the ordering relationship between the drives +driveCompare a b = + do result <- liftM fromIntegral $ {# call drive_compare #} (castToDrive a) (castToDrive b) + let ordering | result < 0 = LT + | result > 0 = GT + | otherwise = EQ + return ordering + +-- | If drive has associated 'Volume' objects, all of them will +-- be unmounted by calling 'volumeUnmount' for each volume in +-- 'driveGetMountedVolumes', except for the last one, for which +-- 'volumeEject' is called to ensure that the drive's media is +-- ejected. +driveEject :: DriveClass drive => + drive -- ^ @drive@ - the drive to be ejected + -> VolumeOpSuccessCallback -- ^ @successCallback@ - the + -- action to be performed on + -- successful ejection + -> VolumeOpFailureCallback -- ^ @failureCallback@ - the + -- action to be performed on + -- failure + -> IO () +driveEject drive successCallback failureCallback = + do cCallback <- volumeOpCallbackMarshal successCallback failureCallback + {# call drive_eject #} (castToDrive drive) cCallback $ castFunPtrToPtr cCallback + +marshalString cAction drive = + cAction (castToDrive drive) >>= readUTFString +marshalMaybeString cAction drive = + cAction (castToDrive drive) >>= (maybePeek readUTFString) + +-- | Returns the activation URI of @drive@. +-- [_$_] +-- The returned URI usually refers to a valid location. You can +-- check the validity of the location by calling 'uriFromString' +-- with the URI, and checking whether the return value is not +-- 'Nothing'. +driveGetActivationURI :: DriveClass drive + => drive -- ^ @drive@ - the drive object to query + -> IO String -- ^ the drive's activation URI +driveGetActivationURI = + marshalString {# call drive_get_activation_uri #} + +-- | Returns the device path of a 'Drive' object. +-- [_$_] +-- For HAL drives, this returns the value of the drive's +-- @block.device@ key. For UNIX mounts, it returns the @mntent@'s +-- @mnt_fsname@ entry. +-- [_$_] +-- Otherwise, it returns 'Nothing'. +driveGetDevicePath :: DriveClass drive => + drive -- ^ @drive@ - the drive object to query + -> IO (Maybe String) -- ^ the drive's device path +driveGetDevicePath = + marshalMaybeString {# call drive_get_device_path #} + +-- | Returns the 'DeviceType' of a 'Drive' object. +driveGetDeviceType :: DriveClass drive => + drive -- ^ @drive@ - the drive object to query + -> IO DeviceType -- ^ the drive's device type +driveGetDeviceType drive = + liftM cToEnum $ {# call drive_get_device_type #} (castToDrive drive) + +-- | Returns the display name of a 'Drive' object. +driveGetDisplayName :: DriveClass drive => + drive -- ^ @drive@ - the drive object to query + -> IO String -- ^ the drive's display name +driveGetDisplayName = + marshalString {# call drive_get_display_name #} + +-- | Returns the HAL UDI of a 'Drive' object. +-- [_$_] +-- For HAL drives, this matches the value of the @info.udi@ key, +-- for other drives it is 'Nothing'. +driveGetHalUDI :: DriveClass drive => + drive -- ^ @drive@ - the drive object to query + -> IO (Maybe String) -- ^ the drive's HAL UDI +driveGetHalUDI = + marshalMaybeString {# call drive_get_hal_udi #} + +-- | Returns the icon filename for a 'Drive' object. +driveGetIcon :: DriveClass drive => + drive -- ^ @drive@ - a drive object + -> IO FilePath -- ^ the icon that should be used for this drive +driveGetIcon = + marshalString {# call drive_get_icon #} + +-- | Returns a unique identifier for a 'Drive' object. +driveGetID :: DriveClass drive => + drive -- ^ @drive@ - a drive object + -> IO Word -- ^ a unique identifier for the drive +driveGetID drive = + liftM fromIntegral $ {# call drive_get_id #} (castToDrive drive) + +-- | Returns a list of mounted volumes for a 'Drive' object. +driveGetMountedVolumes :: DriveClass drive => + drive -- ^ @drive@ - a drive object + -> IO [Volume] -- ^ the 'Volume's currently + -- mounted on the drive +driveGetMountedVolumes drive = + {# call drive_get_mounted_volumes #} (castToDrive drive) >>= + fromGList >>= + mapM newVolume + +marshalBool cAction drive = + liftM toBool $ cAction (castToDrive drive) + +-- | Returns a 'Bool' for whether a drive is connected. +driveIsConnected :: DriveClass drive => + drive -- ^ @drive@ - a drive object + -> IO Bool -- ^ 'True' if the drive is connected, + -- 'False' otherwise +driveIsConnected = + marshalBool {# call drive_is_connected #} + +-- | Returns a 'Bool' for whether a drive is mounted. +driveIsMounted :: DriveClass drive => + drive -- ^ @drive@ - a drive object + -> IO Bool -- ^ 'True' if the drive is mounted, + -- 'False' otherwise +driveIsMounted = + marshalBool {# call drive_is_mounted #} + +-- | Returns a 'Bool' for whether a drive is user-visible. This should +-- be used by applications to determine whether the drive should be +-- listed in user interfaces listing available drives. +driveIsUserVisible :: DriveClass drive => + drive -- ^ @drive@ - a drive object + -> IO Bool -- ^ 'True' if the drive is + -- user-visible, 'False' otherwise +driveIsUserVisible = + marshalBool {# call drive_is_user_visible #} + +-- | Mounts a 'Drive' object. +driveMount :: DriveClass drive => + drive -- ^ @drive@ - a drive object + -> VolumeOpSuccessCallback -- ^ @successCallback@ - the + -- action to be performed on + -- successful mount + -> VolumeOpFailureCallback -- ^ @failureCallback@ - the + -- action to be performed on + -- failure + -> IO () +driveMount drive successCallback failureCallback = + do cCallback <- volumeOpCallbackMarshal successCallback failureCallback + {# call drive_eject #} (castToDrive drive) cCallback $ castFunPtrToPtr cCallback + +onDriveVolumeMounted, + afterDriveVolumeMounted, + onDriveVolumePreUnmount, + afterDriveVolumePreUnmount, + onDriveVolumeUnmounted, + afterDriveVolumeUnmounted + :: (DriveClass drive, VolumeClass volume) => + drive + -> (volume -> IO ()) + -> IO (ConnectId drive) + +onDriveVolumeMounted = connect_OBJECT__NONE "volume-mounted" False +afterDriveVolumeMounted = connect_OBJECT__NONE "volume-mounted" True + +onDriveVolumePreUnmount = connect_OBJECT__NONE "volume-pre-unmount" False +afterDriveVolumePreUnmount = connect_OBJECT__NONE "volume-pre-unmount" True + +onDriveVolumeUnmounted = connect_OBJECT__NONE "volume-unmounted" False +afterDriveVolumeUnmounted = connect_OBJECT__NONE "volume-unmounted" True addfile ./gnomevfs/System/Gnome/VFS/Error.hs hunk ./gnomevfs/System/Gnome/VFS/Error.hs 1 +-- GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*- +-- +-- Author : Peter Gavin +-- Created: 1-Apr-2007 +-- +-- Copyright (c) 2007 Peter Gavin +-- +-- 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. +-- +-- | Maintainer : gtk...@li... +-- Stability : alpha +-- Portability : portable (depends on GHC) +module System.Gnome.VFS.Error ( + [_$_] + Error(..), + [_$_] + error, + errors, + eofErrors, + [_$_] + ) where + +import Control.Monad (join) +import qualified Control.Exception as E +import Data.Dynamic +import System.Gnome.VFS.Types +import Prelude hiding (error) + +error :: Result + -> IO a +error = E.throwDyn . Error + +errors :: E.Exception + -> Maybe Error +errors = + join . (fmap fromDynamic) . E.dynExceptions + +eofErrors :: E.Exception + -> Maybe Error +eofErrors exception = + let vfsError = errors exception in + case vfsError of + Just (Error ErrorEof) -> vfsError + _ -> Nothing addfile ./gnomevfs/System/Gnome/VFS/FileInfo.chs hunk ./gnomevfs/System/Gnome/VFS/FileInfo.chs 1 +-- GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*- +-- +-- Author : Peter Gavin +-- Created: 1-Apr-2007 +-- +-- Copyright (c) 2007 Peter Gavin +-- +-- 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. +-- +-- | Maintainer : gtk...@li... +-- Stability : alpha +-- Portability : portable (depends on GHC) +module System.Gnome.VFS.FileInfo ( + [_$_] + -- * Types + FileInfo(..), + FileFlags(..), + FileType(..), + InodeNumber, + IDs, + [_$_] + ) where + +import Control.Monad (liftM) +import Data.Maybe (catMaybes) +import System.Glib.Flags +import System.Glib.FFI +import System.Glib.UTFString +{#import System.Gnome.VFS.Marshal#} +{#import System.Gnome.VFS.Types#} +import System.Posix.Types (DeviceID, EpochTime) + +{# context lib = "gnomevfs" prefix = "gnome_vfs" #} + +{- typedef struct { + - char *name; + - GnomeVFSFileInfoFields valid_fields; + - GnomeVFSFileType type; + - GnomeVFSFilePermissions permissions; + - GnomeVFSFileFlags flags; + - dev_t device; + - GnomeVFSInodeNumber inode; + - guint link_count; + - guint uid; + - guint gid; + - GnomeVFSFileSize size; + - GnomeVFSFileSize block_count; + - guint io_block_size; + - time_t atime; + - time_t mtime; + - time_t ctime; + - char *symlink_name; + - char *mime_type; + - guint refcount; + - GnomeVFSACL *acl; + - char* selinux_context; + - } GnomeVFSFileInfo; + -} + +instance Storable FileInfo where + sizeOf _ = {# sizeof GnomeVFSFileInfo #} + alignment _ = alignment (undefined :: CString) + peek ptr = + do name <- {# get GnomeVFSFileInfo->name #} ptr >>= maybePeek peekUTFString + [_$_] + validFields <- liftM cToFlags $ {# get GnomeVFSFileInfo->valid_fields #} ptr + [_$_] + let maybeField field result = if elem field validFields + then liftM Just result + else return Nothing + [_$_] + fileType <- maybeField FileInfoFieldsType $ + liftM cToEnum $ cFileInfoGetType ptr + permissions <- maybeField FileInfoFieldsPermissions $ + liftM cToFlags $ {# get GnomeVFSFileInfo->permissions #} ptr + fileFlags <- maybeField FileInfoFieldsFlags $ + liftM cToFlags $ {# get GnomeVFSFileInfo->flags #} ptr + [_$_] + device <- maybeField FileInfoFieldsDevice $ + liftM cToEnum $ {# get GnomeVFSFileInfo->device #} ptr + [_$_] + inode <- maybeField FileInfoFieldsInode $ + liftM fromIntegral $ cFileInfoGetInode ptr + linkCount <- maybeField FileInfoFieldsLinkCount $ + liftM fromIntegral $ {# get GnomeVFSFileInfo->link_count #} ptr + [_$_] + ids <- maybeField FileInfoFieldsIds $ + do uid <- liftM fromIntegral $ {# get GnomeVFSFileInfo->uid #} ptr + gid <- liftM fromIntegral $ {# get GnomeVFSFileInfo->gid #} ptr + return $ (uid, gid) + [_$_] + size <- maybeField FileInfoFieldsSize $ + liftM fromIntegral $ cFileInfoGetSize ptr + blockCount <- maybeField FileInfoFieldsBlockCount $ + liftM fromIntegral $ {# get GnomeVFSFileInfo->block_count #} ptr + [_$_] + ioBlockSize <- maybeField FileInfoFieldsIoBlockSize $ + liftM fromIntegral $ {# get GnomeVFSFileInfo->io_block_size #} ptr + [_$_] + aTime <- maybeField FileInfoFieldsAtime $ + liftM cToEnum $ {# get GnomeVFSFileInfo->atime #} ptr + mTime <- maybeField FileInfoFieldsMtime $ + liftM cToEnum $ {# get GnomeVFSFileInfo->mtime #} ptr + cTime <- maybeField FileInfoFieldsCtime $ + liftM cToEnum $ {# get GnomeVFSFileInfo->ctime #} ptr + symlinkName <- maybeField FileInfoFieldsSymlinkName $ + {# get GnomeVFSFileInfo->symlink_name #} ptr >>= peekUTFString + mimeType <- maybeField FileInfoFieldsMimeType $ + {# call file_info_get_mime_type #} (castPtr ptr) >>= peekUTFString + return $ FileInfo name + fileType + permissions + fileFlags + device + inode + linkCount + ids + size + blockCount + ioBlockSize + aTime + mTime + cTime + symlinkName + mimeType + poke ptr (FileInfo name + fileType + permissions + fileFlags + device + inode + linkCount + ids + size + blockCount + ioBlockSize + aTime + mTime + cTime + symlinkName + mimeType) = + do let marshaller :: FileInfoFields + -> Maybe a + -> b + -> (a -> IO b) + -> (Ptr FileInfo -> b -> IO ()) + -> IO (Maybe FileInfoFields) + marshaller field Nothing dflt _ action = + do action ptr dflt + return Nothing + marshaller field (Just value) _ cast action = + do cast value >>= action ptr + return $ Just field + [_$_] + case name of + Just name' -> newUTFString name' >>= {# set GnomeVFSFileInfo->name #} ptr + Nothing -> return () + [_$_] + validFields <- liftM catMaybes $ sequence $ [_$_] + [ marshaller FileInfoFieldsType + fileType + ... [truncated message content] |
From: Duncan C. <dun...@wo...> - 2007-07-05 19:28:26
|
Thu Jul 5 12:11:42 PDT 2007 Duncan Coutts <du...@ha...> * Use a local .h file that includes both gnomefvs headers So we don't have to locally include extra headers for particular .chs files. This is the same system we use for sourceview, cairo and svgcairo. hunk ./Makefile.am 1666 -libHSgnomevfs_a_HEADER = libgnomevfs/gnome-vfs.h +libHSgnomevfs_a_HEADER = gnomevfs/gnomevfs.h hunk ./Makefile.am 1719 -gnomevfs_System_Gnome_VFS_MIME_hs_HCFLAGS = '-\#include "libgnomevfs/gnome-vfs-mime.h"' hunk ./gnomevfs/System/Gnome/VFS/MIME.chs 44 - -#c -#include <libgnomevfs/gnome-vfs-mime.h> -#endc addfile ./gnomevfs/gnomevfs.h hunk ./gnomevfs/gnomevfs.h 1 +#include <libgnomevfs/gnome-vfs.h> +#include <libgnomevfs/gnome-vfs-mime.h> hunk ./mk/common.mk 216 - -C "$(filter -I%,$(AM_CPPFLAGS) $(CPPFLAGS)) $($(PKG)_CPPFLAGS)" \ |
From: Duncan C. <dun...@wo...> - 2007-07-05 16:47:25
|
Thu Jul 5 09:45:41 PDT 2007 Duncan Coutts <du...@ha...> * Use .NOTPARALLEL make directive to prevent parallel builds So we don't have to give users special instructions not to use -jN hunk ./Makefile.am 70 + +# Sadly the generated Makefile is not safe for parallel builds +# so prevent people from shooting themselves in the foot: +.NOTPARALLEL: |
From: Duncan C. <dun...@wo...> - 2007-07-05 16:47:22
|
Thu Jul 5 07:47:00 PDT 2007 Duncan Coutts <du...@ha...> UNDO: Note that parallel make does not work. hunk ./INSTALL 122 - -Note: using make -j2 will *not* work. Our makefiles are not safe for - use with parallel make unfortunately. - |
From: Duncan C. <dun...@wo...> - 2007-07-05 16:47:21
|
Thu Jul 5 09:45:41 PDT 2007 Duncan Coutts <du...@ha...> * Use .NOTPARALLEL make directive to prevent parallel builds So we don't have to give users special instructions not to use -jN hunk ./Makefile.am 70 + +# Sadly the generated Makefile is not safe for parallel builds +# so prevent people from shooting themselves in the foot: +.NOTPARALLEL: |
From: Duncan C. <dun...@wo...> - 2007-07-05 16:47:19
|
Thu Jul 5 07:47:00 PDT 2007 Duncan Coutts <du...@ha...> UNDO: Note that parallel make does not work. hunk ./INSTALL 122 - -Note: using make -j2 will *not* work. Our makefiles are not safe for - use with parallel make unfortunately. - |