diffing dir...
Thu May 27 08:47:28 EDT 2010 Andy Stewart <lazycat.manatee@...>
* Remove gnomevfs sourceview mozembed since those packages has deprecated.
Ignore-this: a1dfda3669b7417a7b09c3b4acfaa2d
Below are backup repositories for those deprecated packages:
* gnomevfs : http://www2.in.tum.de/~simona/gnomevfs/
* sourceview : http://www2.in.tum.de/~simona/sourceview/
* mozembed : http://www2.in.tum.de/~simona/mozembed/
{
hunk ./sourceview/Graphics/UI/Gtk/SourceView.hs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) Widget SourceView
---
--- Author : Duncan Coutts
--- derived from GtkTextView bindings by Axel Simon
---
--- Created: 14 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView (
- module Graphics.UI.Gtk.SourceView.SourceView,
- module Graphics.UI.Gtk.SourceView.SourceBuffer,
- module Graphics.UI.Gtk.SourceView.SourceLanguage,
- module Graphics.UI.Gtk.SourceView.SourceLanguagesManager,
- module Graphics.UI.Gtk.SourceView.SourceTag,
- module Graphics.UI.Gtk.SourceView.SourceTagTable,
- module Graphics.UI.Gtk.SourceView.SourceTagStyle,
- module Graphics.UI.Gtk.SourceView.SourceStyleScheme,
- module Graphics.UI.Gtk.SourceView.SourceIter
-) where
-
-import Graphics.UI.Gtk.SourceView.SourceView
-import Graphics.UI.Gtk.SourceView.SourceBuffer
-import Graphics.UI.Gtk.SourceView.SourceLanguage
-import Graphics.UI.Gtk.SourceView.SourceLanguagesManager
-import Graphics.UI.Gtk.SourceView.SourceStyleScheme
-import Graphics.UI.Gtk.SourceView.SourceTag
-import Graphics.UI.Gtk.SourceView.SourceTagTable
-import Graphics.UI.Gtk.SourceView.SourceTagStyle
-import Graphics.UI.Gtk.SourceView.SourceIter
rmfile ./sourceview/Graphics/UI/Gtk/SourceView.hs
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceBuffer.chs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) SourceBuffer
---
--- Author : Duncan Coutts
--- derived from GtkTextView bindings by Axel Simon
---
--- Created: 15 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView.SourceBuffer (
- SourceBuffer,
- SourceBufferClass,
- castToSourceBuffer,
- sourceBufferNew,
- sourceBufferNewWithLanguage,
- sourceBufferSetCheckBrackets,
- sourceBufferGetCheckBrackets,
- sourceBufferSetBracketsMatchStyle,
- sourceBufferSetHighlight,
- sourceBufferGetHighlight,
- sourceBufferSetMaxUndoLevels,
- sourceBufferGetMaxUndoLevels,
- sourceBufferSetLanguage,
- sourceBufferGetLanguage,
- sourceBufferSetEscapeChar,
- sourceBufferGetEscapeChar,
- sourceBufferCanUndo,
- sourceBufferCanRedo,
- sourceBufferUndo,
- sourceBufferRedo,
- sourceBufferBeginNotUndoableAction,
- sourceBufferEndNotUndoableAction,
- sourceBufferCreateMarker,
- sourceBufferMoveMarker,
- sourceBufferDeleteMarker,
- sourceBufferGetMarker,
- sourceBufferGetMarkersInRegion,
- sourceBufferGetFirstMarker,
- sourceBufferGetLastMarker,
- sourceBufferGetIterAtMarker,
- sourceBufferGetNextMarker,
- sourceBufferGetPrevMarker
-) where
-
-import Control.Monad (liftM)
-import Data.Maybe (fromMaybe)
-
-import System.Glib.FFI
-import System.Glib.GList (fromGSList)
-import System.Glib.GObject (constructNewGObject,
- makeNewGObject)
-import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
-{#import Graphics.UI.Gtk.Types#}
-{#import Graphics.UI.Gtk.SourceView.Types#}
-{#import Graphics.UI.Gtk.Signals#}
-import Graphics.UI.Gtk.SourceView.SourceTagStyle
-import Graphics.UI.Gtk.SourceView.SourceMarker
-{#import Graphics.UI.Gtk.Multiline.Types#}
-{#import Graphics.UI.Gtk.Multiline.TextIter#}
-
-{# context lib="gtk" prefix="gtk" #}
-
--- methods
-
--- | Create a new 'SourceBuffer', possibly
--- taking a 'SourceTagTable'.
---
-sourceBufferNew :: Maybe SourceTagTable -> IO SourceBuffer
-sourceBufferNew tt = constructNewGObject mkSourceBuffer $
- {#call unsafe source_buffer_new#} [_$_]
- (fromMaybe (SourceTagTable nullForeignPtr) tt)
-
--- | Create a new 'SourceBuffer'
--- with a 'SourceLanguage'.
---
-sourceBufferNewWithLanguage :: SourceLanguage -> IO SourceBuffer
-sourceBufferNewWithLanguage lang = constructNewGObject mkSourceBuffer $
- {#call unsafe source_buffer_new_with_language#} lang
-
--- | [_$_]
---
-sourceBufferSetCheckBrackets :: SourceBuffer -> Bool -> IO ()
-sourceBufferSetCheckBrackets sb newVal =
- {#call unsafe source_buffer_set_check_brackets#} sb (fromBool newVal)
- [_$_]
--- | [_$_]
---
-sourceBufferGetCheckBrackets :: SourceBuffer -> IO Bool [_$_]
-sourceBufferGetCheckBrackets sb = liftM toBool $
- {#call unsafe source_buffer_get_check_brackets#} sb
-
--- | [_$_]
---
-sourceBufferSetBracketsMatchStyle :: SourceBuffer -> SourceTagStyle -> IO () [_$_]
-sourceBufferSetBracketsMatchStyle sb ts =
- alloca $ \tsPtr -> do
- poke tsPtr ts
- {#call unsafe source_buffer_set_bracket_match_style#} sb (castPtr tsPtr)
-
--- | [_$_]
---
-sourceBufferSetHighlight :: SourceBuffer -> Bool -> IO ()
-sourceBufferSetHighlight sb newVal =
- {#call unsafe source_buffer_set_highlight#} sb (fromBool newVal)
- [_$_]
--- | [_$_]
---
-sourceBufferGetHighlight :: SourceBuffer -> IO Bool [_$_]
-sourceBufferGetHighlight sb = liftM toBool $
- {#call unsafe source_buffer_get_highlight#} sb
-
--- | [_$_]
---
-sourceBufferSetMaxUndoLevels :: SourceBuffer -> Int -> IO ()
-sourceBufferSetMaxUndoLevels sb newVal =
- {#call unsafe source_buffer_set_max_undo_levels#} sb (fromIntegral newVal)
- [_$_]
--- | [_$_]
---
-sourceBufferGetMaxUndoLevels :: SourceBuffer -> IO Int
-sourceBufferGetMaxUndoLevels sb = liftM fromIntegral $
- {#call unsafe source_buffer_get_max_undo_levels#} sb
-
--- | [_$_]
---
-sourceBufferSetLanguage :: SourceBuffer -> SourceLanguage -> IO ()
-sourceBufferSetLanguage sb lang =
- {#call unsafe source_buffer_set_language#} sb lang
- [_$_]
--- | [_$_]
---
-sourceBufferGetLanguage :: SourceBuffer -> IO SourceLanguage
-sourceBufferGetLanguage sb = makeNewGObject mkSourceLanguage $
- {#call unsafe source_buffer_get_language#} sb
-
--- | [_$_]
---
-sourceBufferSetEscapeChar :: SourceBuffer -> Char -> IO ()
-sourceBufferSetEscapeChar sb char =
- {#call unsafe source_buffer_set_escape_char#} sb ((toEnum . fromEnum) char)
- [_$_]
--- | [_$_]
---
-sourceBufferGetEscapeChar :: SourceBuffer -> IO Char
-sourceBufferGetEscapeChar sb = liftM (toEnum . fromEnum) $
- {#call unsafe source_buffer_get_escape_char#} sb
-
--- | [_$_]
---
-sourceBufferCanUndo :: SourceBuffer -> IO Bool
-sourceBufferCanUndo sb = liftM toBool $
- {#call unsafe source_buffer_can_undo#} sb
- [_$_]
--- | [_$_]
---
-sourceBufferCanRedo :: SourceBuffer -> IO Bool
-sourceBufferCanRedo sb = liftM toBool $
- {#call unsafe source_buffer_can_redo#} sb
-
--- | [_$_]
---
-sourceBufferUndo :: SourceBuffer -> IO ()
-sourceBufferUndo sb =
- {#call source_buffer_undo#} sb
- [_$_]
--- | [_$_]
---
-sourceBufferRedo :: SourceBuffer -> IO ()
-sourceBufferRedo sb =
- {#call source_buffer_redo#} sb
-
--- | [_$_]
---
-sourceBufferBeginNotUndoableAction :: SourceBuffer -> IO ()
-sourceBufferBeginNotUndoableAction sb =
- {#call source_buffer_begin_not_undoable_action#} sb
- [_$_]
--- | [_$_]
---
-sourceBufferEndNotUndoableAction :: SourceBuffer -> IO ()
-sourceBufferEndNotUndoableAction sb =
- {#call source_buffer_end_not_undoable_action#} sb
-
--- | Creates a marker in the buffer of the given type.
---
--- * A marker is
--- semantically very similar to a 'Graphics.UI.Gtk.Multiline.TextMark',
--- except it has a type
--- which is used by the 'SourceView' displaying the buffer to show a
--- pixmap on the left margin, at the line the marker is in. Because
--- of this, a marker is generally associated to a line and not a
--- character position. Markers are also accessible through a position
--- or range in the buffer.
---
--- * Markers are implemented using 'Graphics.UI.Gtk.Multiline.TextMark',
--- so all characteristics
--- and restrictions to marks apply to markers too. These includes
--- life cycle issues and 'Graphics.UI.Gtk.Multiline.TextMark.onMarkSet'
--- and 'Graphics.UI.Gtk.Multiline.TextMark.onMarkDeleted' signal
--- emissions.
---
--- * Like a 'Graphics.UI.Gtk.Multiline.TextMark', a 'SourceMarker'
--- can be anonymous if the
--- passed name is @Nothing@. Also, the buffer owns the markers so you
--- shouldn't unreference it.
-
-sourceBufferCreateMarker :: SourceBuffer -- the buffer
- -> Maybe String -- the name of the marker
- -> String -- the type of the marker
- -> TextIter -> IO SourceMarker
-sourceBufferCreateMarker sb name markerType iter =
- makeNewGObject mkSourceMarker $
- maybeWith withCString name $ \strPtr1 ->
- withCString markerType $ \strPtr2 ->
- {#call source_buffer_create_marker#} sb strPtr1 strPtr2 iter
-
--- | [_$_]
---
-sourceBufferMoveMarker :: SourceBuffer -> SourceMarker -> TextIter -> IO ()
-sourceBufferMoveMarker sb mark iter =
- {#call source_buffer_move_marker#} sb mark iter
-
--- | [_$_]
---
-sourceBufferDeleteMarker :: SourceBuffer -> SourceMarker -> IO ()
-sourceBufferDeleteMarker sb mark =
- {#call source_buffer_delete_marker#} sb mark
-
--- | [_$_]
---
-sourceBufferGetMarker :: SourceBuffer -> String -> IO (Maybe SourceMarker)
-sourceBufferGetMarker sb name =
- maybeNull (makeNewGObject mkSourceMarker) $
- withCString name $ \strPtr1 ->
- {#call unsafe source_buffer_get_marker#} sb strPtr1
-
--- | Returns an /ordered/ (by position) list of 'SourceMarker's inside the
--- region delimited by the two 'TextIter's. The iterators may be in any
--- order.
---
-sourceBufferGetMarkersInRegion :: SourceBuffer -> TextIter -> TextIter -> IO [SourceMarker]
-sourceBufferGetMarkersInRegion sb begin end = do
- gList <- {#call unsafe source_buffer_get_markers_in_region#} sb begin end
- wList <- fromGSList gList
- mapM (makeNewGObject mkSourceMarker) (map return wList)
-
--- | Returns the first (nearest to the top of the buffer) marker.
---
-sourceBufferGetFirstMarker :: SourceBuffer -> IO (Maybe SourceMarker)
-sourceBufferGetFirstMarker sb =
- maybeNull (makeNewGObject mkSourceMarker) $
- {#call unsafe source_buffer_get_first_marker#} sb
-
--- | Returns the last (nearest to the bottom of the buffer) marker.
---
-sourceBufferGetLastMarker :: SourceBuffer -> IO (Maybe SourceMarker)
-sourceBufferGetLastMarker sb =
- maybeNull (makeNewGObject mkSourceMarker) $
- {#call unsafe source_buffer_get_last_marker#} sb
-
--- | [_$_]
---
-sourceBufferGetIterAtMarker :: SourceBuffer -> SourceMarker -> IO TextIter
-sourceBufferGetIterAtMarker sb mark = do
- iter <- makeEmptyTextIter
- {#call unsafe source_buffer_get_iter_at_marker#} sb iter mark
- return iter
-
--- | Returns the nearest marker to the right of the given iterator.
--- If there are
--- multiple markers at the same position, this function will always
--- return the first one (from the internal linked list), even if
--- starting the search exactly at its location. You can get the
--- others using 'sourceMarkerNext'.
---
-sourceBufferGetNextMarker :: SourceBuffer -> TextIter -> IO (Maybe SourceMarker)
-sourceBufferGetNextMarker sb iter = maybeNull (makeNewGObject mkSourceMarker) $
- {#call unsafe source_buffer_get_next_marker#} sb iter
-
--- | Returns the nearest marker to the left of the given iterator.
--- If there are
--- multiple markers at the same position, this function will always
--- return the last one (from the internal linked list), even if
--- starting the search exactly at its location. You can get the
--- others using 'sourceMarkerPrev'.
---
-sourceBufferGetPrevMarker :: SourceBuffer -> TextIter -> IO (Maybe SourceMarker)
-sourceBufferGetPrevMarker sb iter = maybeNull (makeNewGObject mkSourceMarker) $
- {#call unsafe source_buffer_get_prev_marker#} sb iter
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceBuffer.chs
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceIter.chs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) SourceIter
---
--- Author : Duncan Coutts
---
--- Created: 15 April 2004
---
--- Copyright (C) 2004-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
--- Adds extra useful methods for "TextIter" for searching forwards and
--- backwards within a region in the buffer and matching brackets.
---
--- * There is no SourceIter object, just extra methods for "TextIter"
---
-module Graphics.UI.Gtk.SourceView.SourceIter (
-
- sourceIterForwardSearch,
- sourceIterBackwardSearch,
- sourceIterFindMatchingBracket
-) where
-
-import Control.Monad (liftM)
-import Data.Maybe (fromMaybe)
-
-import System.Glib.FFI
-import System.Glib.Flags (Flags, fromFlags)
-import System.Glib.UTFString
-import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
-{#import Graphics.UI.Gtk.Types#}
-{#import Graphics.UI.Gtk.SourceView.Types#}
-{#import Graphics.UI.Gtk.Multiline.Types#}
-{#import Graphics.UI.Gtk.Multiline.TextIter#}
-
-{# context lib="gtk" prefix="gtk" #}
-
-{# enum SourceSearchFlags {underscoreToCase} deriving(Bounded) #}
-
-instance Flags SourceSearchFlags
-
--- methods
-
--- | same as 'textIterForwardSearch' but allows
--- case insensitive search and possibly in the future regular expressions.
---
-sourceIterForwardSearch :: TextIter -> String -> [SourceSearchFlags] -> [_$_]
- Maybe TextIter -> IO (Maybe (TextIter, TextIter))
-sourceIterForwardSearch ti str flags limit = do
- start <- makeEmptyTextIter
- end <- makeEmptyTextIter
- found <- liftM toBool $ withUTFString str $ \cStr ->
- {#call unsafe source_iter_forward_search#} ti cStr
- ((fromIntegral.fromFlags) flags) start end
- (fromMaybe (TextIter nullForeignPtr) limit)
- return $ if found then Just (start,end) else Nothing
-
--- | same as 'textIterForwardSearch' but allows
--- case insensitive search and possibly in the future regular expressions.
---
-sourceIterBackwardSearch :: TextIter -> String -> [SourceSearchFlags] -> [_$_]
- Maybe TextIter -> IO (Maybe (TextIter, TextIter))
-sourceIterBackwardSearch ti str flags limit = do
- start <- makeEmptyTextIter
- end <- makeEmptyTextIter
- found <- liftM toBool $ withUTFString str $ \cStr ->
- {#call unsafe source_iter_backward_search#} ti cStr
- ((fromIntegral.fromFlags) flags) start end
- (fromMaybe (TextIter nullForeignPtr) limit)
- return $ if found then Just (start,end) else Nothing
-
--- | Tries to match the bracket character
--- currently at the given iter with its opening\/closing counterpart, and if
--- found moves iter to the position where it was found.
---
--- * the 'TextIter' must belong to a 'SourceBuffer'
---
-sourceIterFindMatchingBracket :: TextIter -> IO Bool
-sourceIterFindMatchingBracket ti =
- liftM toBool $ {# call unsafe source_iter_find_matching_bracket #} ti
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceIter.chs
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceLanguage.chs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) Widget SourceView
---
--- Author : Duncan Coutts
--- derived from GtkTextView bindings by Axel Simon
---
--- Created: 14 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView.SourceLanguage (
- SourceLanguage,
- castToSourceLanguage,
- sourceLanguageGetName,
- sourceLanguageGetSection,
- sourceLanguageGetTags,
- sourceLanguageGetEscapeChar,
- sourceLanguageGetMimeTypes,
- sourceLanguageSetMimeTypes,
- sourceLanguageGetStyleScheme,
- sourceLanguageSetStyleScheme,
- sourceLanguageGetTagStyle,
- sourceLanguageSetTagStyle,
- sourceLanguageGetTagDefaultStyle
-) where
-
-import Control.Monad (liftM)
-
-import System.Glib.FFI
-import System.Glib.UTFString
-import System.Glib.GList (fromGSList, toGSList)
-import System.Glib.GObject (makeNewGObject)
-import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
-{#import Graphics.UI.Gtk.Types#}
-{#import Graphics.UI.Gtk.SourceView.Types#}
-{#import Graphics.UI.Gtk.Signals#}
-import Graphics.UI.Gtk.SourceView.SourceStyleScheme
-import Graphics.UI.Gtk.SourceView.SourceTagStyle
-
-{# context lib="gtk" prefix="gtk" #}
-
-
--- methods
-
--- | [_$_]
---
-sourceLanguageGetName :: SourceLanguage -> IO String
-sourceLanguageGetName sl =
- {#call unsafe source_language_get_name#} sl >>= peekUTFString
-
--- | [_$_]
---
-sourceLanguageGetSection :: SourceLanguage -> IO String
-sourceLanguageGetSection sl =
- {#call unsafe source_language_get_section#} sl >>= peekUTFString
-
--- | [_$_]
---
-sourceLanguageGetTags :: SourceLanguage -> IO [SourceTag]
-sourceLanguageGetTags sl = do
- gList <- {#call unsafe source_language_get_tags#} sl
- wList <- fromGSList gList
- mapM (makeNewGObject mkSourceTag) (map return wList)
-
--- | [_$_]
---
-sourceLanguageGetEscapeChar :: SourceLanguage -> IO Char
-sourceLanguageGetEscapeChar sl = liftM (toEnum . fromEnum) $
- {#call unsafe source_language_get_escape_char#} sl
-
-sourceLanguageGetMimeTypes :: SourceLanguage -> IO [String]
-sourceLanguageGetMimeTypes sl = do
- mimeTypesList <- {#call unsafe source_language_get_mime_types#} sl
- mimeTypesPtrs <- fromGSList mimeTypesList
- mapM peekUTFString mimeTypesPtrs
-
-sourceLanguageSetMimeTypes :: SourceLanguage -> [String] -> IO ()
-sourceLanguageSetMimeTypes sl mimeTypes = do
- mimeTypesPtrs <- mapM newUTFString mimeTypes
- mimeTypesList <- toGSList mimeTypesPtrs
- {#call unsafe source_language_set_mime_types#} sl mimeTypesList
- {#call unsafe g_slist_free#} mimeTypesList
-
--- | [_$_]
---
-sourceLanguageGetStyleScheme :: SourceLanguage -> IO SourceStyleScheme
-sourceLanguageGetStyleScheme sl = makeNewGObject mkSourceStyleScheme $
- {#call unsafe source_language_get_style_scheme#} sl
-
--- | [_$_]
---
-sourceLanguageSetStyleScheme :: SourceLanguage -> SourceStyleScheme -> IO ()
-sourceLanguageSetStyleScheme sl ss =
- {#call unsafe source_language_set_style_scheme#} sl ss
-
--- | [_$_]
---
-sourceLanguageGetTagStyle :: SourceLanguage -> String -> IO SourceTagStyle
-sourceLanguageGetTagStyle sl tag =
- withCString tag $ \strPtr1 -> do
- sts <- {#call unsafe source_language_get_tag_style#} sl strPtr1
- peek (castPtr sts)
-
--- | [_$_]
---
-sourceLanguageSetTagStyle :: SourceLanguage -> String -> SourceTagStyle -> IO ()
-sourceLanguageSetTagStyle sl tag sts = [_$_]
- withCString tag $ \strPtr1 ->
- alloca $ \sts' -> do
- poke sts' sts
- {#call unsafe source_language_set_tag_style#} sl strPtr1 (castPtr sts')
-
--- | [_$_]
---
-sourceLanguageGetTagDefaultStyle :: SourceLanguage -> String -> IO SourceTagStyle
-sourceLanguageGetTagDefaultStyle sl tag =
- withCString tag $ \strPtr1 -> do
- sts <- {#call unsafe source_language_get_tag_default_style#} sl strPtr1
- peek (castPtr sts)
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceLanguage.chs
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceLanguagesManager.chs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) SourceLanguagesManager
---
--- Author : Duncan Coutts
--- derived from GtkTextView bindings by Axel Simon
---
--- Created: 14 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView.SourceLanguagesManager (
- SourceLanguagesManager,
- castToSourceLanguagesManager,
- sourceLanguagesManagerNew,
- sourceLanguagesManagerGetAvailableLanguages,
- sourceLanguagesManagerGetLanguageFromMimeType,
- sourceLanguagesManagerGetLangFilesDirs
- ) where
-
-import Control.Monad (liftM, mapM)
-
-import System.Glib.FFI
-import System.Glib.UTFString
-import System.Glib.GList (readGSList)
-import System.Glib.GObject (makeNewGObject, constructNewGObject)
-{#import Graphics.UI.Gtk.Types#}
-{#import Graphics.UI.Gtk.SourceView.Types#}
-{#import Graphics.UI.Gtk.Signals#}
-
-{# context lib="gtk" prefix="gtk" #}
-
-
--- methods
-
--- | Create a new 'SourceLanguagesManager'.
---
-sourceLanguagesManagerNew :: IO SourceLanguagesManager
-sourceLanguagesManagerNew = constructNewGObject mkSourceLanguagesManager
- {#call source_languages_manager_new#} [_$_]
-
--- | Gets a list of available languages for the given language manager.
--- [_$_]
-sourceLanguagesManagerGetAvailableLanguages :: SourceLanguagesManager -> [_$_]
- IO [SourceLanguage]
-sourceLanguagesManagerGetAvailableLanguages lm = do
- gList <- {#call source_languages_manager_get_available_languages#} lm
- wList <- readGSList gList
- mapM (makeNewGObject mkSourceLanguage) (map return wList)
-
--- | Gets the 'SourceLanguage' which is associated with the given mime type
--- in the language manager.
--- [_$_]
-sourceLanguagesManagerGetLanguageFromMimeType :: SourceLanguagesManager -> String -> IO (Maybe SourceLanguage)
-sourceLanguagesManagerGetLanguageFromMimeType lm mimeType = do
- langPtr <- withCString mimeType $ \strPtr ->
- {#call source_languages_manager_get_language_from_mime_type#} lm strPtr
- if langPtr==nullPtr then return Nothing else liftM Just $
- makeNewGObject mkSourceLanguage (return langPtr)
-
--- | Retrieve filenames with language specifications.
--- [_$_]
-sourceLanguagesManagerGetLangFilesDirs :: SourceLanguagesManager -> [_$_]
- IO [FilePath]
-sourceLanguagesManagerGetLangFilesDirs lm = do
- gsList <- {#call source_languages_manager_get_lang_files_dirs#} lm
- -- The returned structure is private and nothing is to be freed.
- dirList <- readGSList gsList
- mapM peekUTFString dirList
-
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceLanguagesManager.chs
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceMarker.chs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) SourceMarker
---
--- Author : Duncan Coutts
--- derived from GtkTextView bindings by Axel Simon
---
--- Created: 26 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView.SourceMarker (
- SourceMarker,
- castToSourceMarker,
- sourceMarkerSetMarkerType,
- sourceMarkerGetMarkerType,
- sourceMarkerGetLine,
- sourceMarkerGetName,
- sourceMarkerGetBuffer,
- sourceMarkerNext,
- sourceMarkerPrev
-) where
-
-import Control.Monad (liftM)
-
-import System.Glib.FFI
-import System.Glib.UTFString
-import System.Glib.GObject (makeNewGObject)
-{#import Graphics.UI.Gtk.Types#}
-{#import Graphics.UI.Gtk.SourceView.Types#}
-
-{# context lib="gtk" prefix="gtk" #}
-
--- methods
-
--- | [_$_]
--- [_$_]
-sourceMarkerSetMarkerType :: SourceMarker -> String -> IO ()
-sourceMarkerSetMarkerType mark markType =
- withCString markType $ \strPtr1 ->
- {#call unsafe source_marker_set_marker_type#} mark strPtr1
-
--- | [_$_]
--- [_$_]
-sourceMarkerGetMarkerType :: SourceMarker -> IO String
-sourceMarkerGetMarkerType mark = do
- strPtr <- {#call unsafe source_marker_get_marker_type#} mark
- markType <- peekUTFString strPtr
- {#call unsafe g_free#} (castPtr strPtr)
- return markType
-
--- | [_$_]
--- [_$_]
-sourceMarkerGetLine :: SourceMarker -> IO Int
-sourceMarkerGetLine mark = liftM fromIntegral $
- {#call unsafe source_marker_get_line#} mark
-
--- | [_$_]
--- [_$_]
-sourceMarkerGetName :: SourceMarker -> IO String
-sourceMarkerGetName mark =
- {#call unsafe source_marker_get_name#} mark >>= peekUTFString
-
--- | [_$_]
--- [_$_]
-sourceMarkerGetBuffer :: SourceMarker -> IO SourceBuffer
-sourceMarkerGetBuffer mark = makeNewGObject mkSourceBuffer $
- {#call unsafe source_marker_get_buffer#} mark
-
--- | [_$_]
--- [_$_]
-sourceMarkerNext :: SourceMarker -> IO SourceMarker
-sourceMarkerNext mark = makeNewGObject mkSourceMarker $
- {#call unsafe source_marker_next#} mark
-
--- | [_$_]
--- [_$_]
-sourceMarkerPrev :: SourceMarker -> IO SourceMarker
-sourceMarkerPrev mark = makeNewGObject mkSourceMarker $
- {#call unsafe source_marker_prev#} mark
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceMarker.chs
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceStyleScheme.chs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) SourceStyleScheme
---
--- Author : Duncan Coutts
--- derived from the GtkTextView bindings by Axel Simon
---
--- Created: 22 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView.SourceStyleScheme (
- SourceStyleScheme,
- castToSourceStyleScheme,
- sourceStyleSchemeGetTagStyle,
- sourceStyleSchemeGetName,
- sourceStyleSchemeGetDefault
-) where
-
-import Control.Monad (liftM)
-
-import System.Glib.FFI
-import System.Glib.UTFString
-import System.Glib.GObject (constructNewGObject)
-{#import Graphics.UI.Gtk.Types#}
-{#import Graphics.UI.Gtk.SourceView.Types#}
-import Graphics.UI.Gtk.SourceView.SourceTagStyle
-
-{# context lib="gtk" prefix="gtk" #}
-
--- methods
-
--- | [_$_]
--- [_$_]
-sourceStyleSchemeGetTagStyle :: SourceStyleScheme -> String -> IO SourceTagStyle
-sourceStyleSchemeGetTagStyle ss styleName =
- withCString styleName $ \strPtr -> do
- tsPtr <- {#call source_style_scheme_get_tag_style#} ss strPtr
- ts <- peek (castPtr tsPtr)
- {#call unsafe g_free#} tsPtr
- return ts
-
--- | [_$_]
--- [_$_]
-sourceStyleSchemeGetName :: SourceStyleScheme -> IO String
-sourceStyleSchemeGetName ss =
- {#call source_style_scheme_get_name#} ss >>= peekUTFString
-
--- | [_$_]
--- [_$_]
-sourceStyleSchemeGetDefault :: IO SourceStyleScheme
-sourceStyleSchemeGetDefault =
- constructNewGObject mkSourceStyleScheme $ liftM castPtr $
- {#call source_style_scheme_get_default#}
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceStyleScheme.chs
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceTag.chs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) SourceTag
---
--- Author : Duncan Coutts
--- derived from GtkTextView bindings by Axel Simon
---
--- Created: 22 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView.SourceTag (
- SourceTag,
- castToSourceTag,
- syntaxTagNew,
- patternTagNew,
- keywordListTagNew,
- blockCommentTagNew,
- lineCommentTagNew,
- stringTagNew,
- sourceTagGetStyle,
- sourceTagSetStyle
- ) where
-
-import Control.Monad (liftM)
-
-import System.Glib.FFI
-import System.Glib.UTFString
-import System.Glib.GList (withGSList)
-import System.Glib.GObject (constructNewGObject)
-{#import Graphics.UI.Gtk.Types#}
-{#import Graphics.UI.Gtk.SourceView.Types#}
-import Graphics.UI.Gtk.SourceView.SourceTagStyle
-
-{# context lib="gtk" prefix="gtk" #}
-
--- methods
-
--- | Create a new 'SourceTag'
---
-syntaxTagNew :: String -> String -> String -> String -> IO SourceTag
-syntaxTagNew id name patternStart patternEnd =
- constructNewGObject mkSourceTag $ liftM castPtr $
- withCString id $ \strPtr1 -> [_$_]
- withCString name $ \strPtr2 -> [_$_]
- withCString patternStart $ \strPtr3 -> [_$_]
- withCString patternEnd $ \strPtr4 -> [_$_]
- {#call syntax_tag_new#} strPtr1 strPtr2 strPtr3 strPtr4
-
--- | Create a new 'SourceTag'
---
-patternTagNew :: String -> String -> String -> IO SourceTag
-patternTagNew id name pattern =
- constructNewGObject mkSourceTag $ liftM castPtr $
- withCString id $ \strPtr1 -> [_$_]
- withCString name $ \strPtr2 -> [_$_]
- withCString pattern $ \strPtr3 -> [_$_]
- {#call unsafe pattern_tag_new#} strPtr1 strPtr2 strPtr3
-
-
--- | Create a new 'SourceTag'.
---
-keywordListTagNew :: String -> String -> [String] -> Bool -> Bool -> Bool ->
- String -> String -> IO SourceTag
-keywordListTagNew id name keywords
- caseSensitive
- matchEmptyStringAtBeginning
- matchEmptyStringAtEnd
- beginningRegex
- endRegex =
- withUTFStrings keywords $ \keywordPtrs ->
- withGSList keywordPtrs $ \keywordList ->
- constructNewGObject mkSourceTag $ liftM castPtr $
- withCString id $ \idPtr -> [_$_]
- withCString name $ \namePtr -> [_$_]
- withCString beginningRegex $ \beginPtr -> [_$_]
- withCString endRegex $ \endPtr ->
- {# call unsafe keyword_list_tag_new #}
- idPtr namePtr keywordList (fromBool caseSensitive)
- (fromBool matchEmptyStringAtBeginning) (fromBool matchEmptyStringAtEnd)
- beginPtr endPtr
-
--- | Create a new 'SourceTag'
---
-blockCommentTagNew :: String -> String -> String -> String -> IO SourceTag
-blockCommentTagNew = syntaxTagNew --in the C header this is just a macro
-
--- | Create a new 'SourceTag'
---
-lineCommentTagNew :: String -> String -> String -> IO SourceTag
-lineCommentTagNew id name pattern =
- constructNewGObject mkSourceTag $ liftM castPtr $
- withCString id $ \strPtr1 ->
- withCString name $ \strPtr2 ->
- withCString pattern $ \strPtr3 ->
- {#call unsafe line_comment_tag_new#} strPtr1 strPtr2 strPtr3
-
--- | Create a new 'SourceTag'
---
-stringTagNew :: String -> String -> String -> String -> Bool -> IO SourceTag
-stringTagNew id name patternStart patternEnd endAtLineEnd =
- constructNewGObject mkSourceTag $ liftM castPtr $
- withCString id $ \strPtr1 -> [_$_]
- withCString name $ \strPtr2 -> [_$_]
- withCString patternStart $ \strPtr3 -> [_$_]
- withCString patternEnd $ \strPtr4 -> [_$_]
- {#call unsafe string_tag_new#} strPtr1 strPtr2 strPtr3 strPtr4 (fromBool endAtLineEnd)
-
-
--- | [_$_]
--- [_$_]
-sourceTagGetStyle :: SourceTag -> IO SourceTagStyle
-sourceTagGetStyle tag = do
- tsPtr <- {#call unsafe source_tag_get_style#} tag
- ts <- peek (castPtr tsPtr)
- {#call unsafe g_free#} tsPtr
- return ts
-
--- | [_$_]
--- [_$_]
-sourceTagSetStyle :: SourceTag -> SourceTagStyle -> IO ()
-sourceTagSetStyle tag ts = alloca $ \tsPtr -> do
- poke tsPtr ts
- {#call unsafe source_tag_set_style#} tag (castPtr tsPtr)
-
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceTag.chs
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceTagStyle.hsc 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) SourceTagStyle
---
--- Author : Duncan Coutts
--- derived from GtkTextView bindings by Axel Simon
---
--- Created: 20 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView.SourceTagStyle (
- SourceTagStyle(..),
-) where
-
-import Data.Maybe (isJust, fromMaybe)
-import Data.Bits (testBit, bit, (.|.))
-
-import System.Glib.FFI
-import Graphics.UI.Gtk.General.Structs (Color(..))
-
-#include <gtksourceview/gtksourcetagstyle.h>
-
-data SourceTagStyleMask = SourceTagStyleUseBackground
- | SourceTagStyleUseForeground
- deriving (Eq)
-
-instance Enum SourceTagStyleMask where
- fromEnum SourceTagStyleUseBackground = 1
- fromEnum SourceTagStyleUseForeground = 2
- [_$_]
- toEnum 1 = SourceTagStyleUseBackground
- toEnum 2 = SourceTagStyleUseForeground
- toEnum unmatched = error ("SourceTagStyleMask.toEnum: Cannot match " ++ show unmatched)
- [_$_]
-data SourceTagStyle = SourceTagStyle {
- isDefault :: Bool, -- readonly
- foreground :: Maybe Color,
- background :: Maybe Color,
- italic :: Bool,
- bold :: Bool,
- underline :: Bool,
- strikethrough :: Bool
- }
-
-instance Storable SourceTagStyle where
- sizeOf _ = #{const sizeof(GtkSourceTagStyle)}
- alignment _ = alignment (undefined::#type gboolean)
- peek ptr = do
- (isDefault'::#type gboolean) <- #{peek GtkSourceTagStyle, is_default} ptr
- (mask::#type guint) <- #{peek GtkSourceTagStyle, mask} ptr
- foreground' <- peek (#{ptr GtkSourceTagStyle, foreground} ptr)
- background' <- peek (#{ptr GtkSourceTagStyle, background} ptr)
- (italic'::#type gboolean) <- #{peek GtkSourceTagStyle, italic} ptr
- (bold'::#type gboolean) <- #{peek GtkSourceTagStyle, bold} ptr
- (underline'::#type gboolean) <- #{peek GtkSourceTagStyle, underline} ptr
- (strikethrough'::#type gboolean) <- #{peek GtkSourceTagStyle, strikethrough} ptr
- return SourceTagStyle {
- isDefault = toBool isDefault',
- foreground = if mask `testBit` (fromEnum SourceTagStyleUseForeground) then Just foreground' else Nothing,
- background = if mask `testBit` (fromEnum SourceTagStyleUseBackground) then Just background' else Nothing,
- italic = toBool italic',
- bold = toBool bold',
- underline = toBool underline',
- strikethrough = toBool strikethrough'
- }
- poke ptr tag = do
- #{poke GtkSourceTagStyle, is_default} ptr (fromBool $ isDefault tag ::#type gboolean)
- #{poke GtkSourceTagStyle, mask} ptr ((if isJust (foreground tag) then bit (fromEnum SourceTagStyleUseForeground) else 0)
- .|.(if isJust (background tag) then bit (fromEnum SourceTagStyleUseBackground) else 0) ::#type guint)
- poke (#{ptr GtkSourceTagStyle, foreground} ptr) (fromMaybe (Color 0 0 0) (foreground tag))
- poke (#{ptr GtkSourceTagStyle, background} ptr) (fromMaybe (Color 0 0 0) (background tag))
- #{poke GtkSourceTagStyle, italic} ptr (fromBool $ italic tag ::#type gboolean)
- #{poke GtkSourceTagStyle, bold} ptr (fromBool $ bold tag ::#type gboolean)
- #{poke GtkSourceTagStyle, underline} ptr (fromBool $ underline tag ::#type gboolean)
- #{poke GtkSourceTagStyle, strikethrough} ptr (fromBool $ strikethrough tag ::#type gboolean)
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceTagStyle.hsc
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceTagTable.chs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) SourceTagTable
---
--- Author : Duncan Coutts
--- derived from GtkTextView bindings by Axel Simon
---
--- Created: 22 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView.SourceTagTable (
- SourceTagTable,
- SourceTagTableClass,
- castToSourceTagTable,
- sourceTagTableNew,
- sourceTagTableAddTags,
- sourceTagTableRemoveSourceTags
-) where
-
-import Control.Monad (liftM)
-
-import System.Glib.FFI
-import System.Glib.GList (fromGSList, toGSList)
-import System.Glib.GObject (constructNewGObject)
-{#import Graphics.UI.Gtk.Types#}
-{#import Graphics.UI.Gtk.SourceView.Types#}
-{#import Graphics.UI.Gtk.Signals#}
-import Graphics.UI.Gtk.SourceView.SourceTag
-
-{# context lib="gtk" prefix="gtk" #}
-
--- methods
-
--- | Create a new 'SourceTagTable'
---
-sourceTagTableNew :: IO SourceTagTable
-sourceTagTableNew = constructNewGObject mkSourceTagTable
- {#call unsafe source_tag_table_new#} [_$_]
-
-
--- | Add a list of tag to the table.
--- [_$_]
--- * The added tags are assigned the highest priority in the table. If a tag is
--- already present in table or has the same name as an already-added tag, then
--- it is not added to the table.
--- [_$_]
-sourceTagTableAddTags :: SourceTagTable -> [SourceTag] -> IO ()
-sourceTagTableAddTags tt tags = do
- let tagForeignPtrs = map unSourceTag tags
- tagList <- toGSList (map unsafeForeignPtrToPtr tagForeignPtrs)
- {#call source_tag_table_add_tags#} tt tagList
- -- destroy the list
- fromGSList tagList
- -- make sure the ForeignPtrs are not gc'd while we are still using the Ptrs
- mapM_ touchForeignPtr tagForeignPtrs
-
--- | [_$_]
--- [_$_]
-sourceTagTableRemoveSourceTags :: SourceTagTable -> IO ()
-sourceTagTableRemoveSourceTags tt =
- {#call source_tag_table_remove_source_tags#} tt [_$_]
-
--- | The source tag table has changed.
---
-onTagChanged, afterTagChanged :: [_$_]
- SourceTagTableClass stt => stt -> IO () -> IO (ConnectId stt)
-onTagChanged = connect_NONE__NONE "changed" False
-afterTagChanged = connect_NONE__NONE "changed" True
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceTagTable.chs
hunk ./sourceview/Graphics/UI/Gtk/SourceView/SourceView.chs 1
--- -*-haskell-*-
--- GIMP Toolkit (GTK) Widget SourceView
---
--- Author : Duncan Coutts
--- derived from GtkTextView bindings by Axel Simon
---
--- Created: 14 October 2003
---
--- Copyright (C) 2003-2005 Duncan Coutts, 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 : gtk2hs-users@...
--- Stability : provisional
--- Portability : portable (depends on GHC)
---
-module Graphics.UI.Gtk.SourceView.SourceView (
- SourceView,
- SourceViewClass,
- castToSourceView,
- sourceViewNew,
- sourceViewNewWithBuffer,
- sourceViewSetShowLineNumbers,
- sourceViewGetShowLineNumbers,
- sourceViewSetShowLineMarkers,
- sourceViewGetShowLineMarkers,
- sourceViewSetTabsWidth,
- sourceViewGetTabsWidth,
- sourceViewSetAutoIndent,
- sourceViewGetAutoIndent,
- sourceViewSetInsertSpacesInsteadOfTabs,
- sourceViewGetInsertSpacesInsteadOfTabs,
- sourceViewSetShowMargin,
- sourceViewGetShowMargin,
- sourceViewSetMargin,
- sourceViewGetMargin,
- sourceViewSetMarkerPixbuf,
- sourceViewGetMarkerPixbuf,
- sourceViewSetSmartHomeEnd,
- sourceViewGetSmartHomeEnd,
-) where
-
-import Control.Monad (liftM)
-
-import System.Glib.FFI
-import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
-import System.Glib.GObject (constructNewGObject)
-{#import Graphics.UI.Gtk.Types#}
-{#import Graphics.UI.Gtk.SourceView.Types#}
-{#import Graphics.UI.Gtk.Signals#}
-import Graphics.UI.Gtk.SourceView.SourceBuffer
-
-{# context lib="gtk" prefix="gtk" #}
-
-
--- methods
-
--- | Create a new 'SourceView' widget with a default 'SourceBuffer'.
---
-sourceViewNew :: IO SourceView
-sourceViewNew = makeNewObject mkSourceView $ liftM castPtr [_$_]
- {#call unsafe source_view_new#}
-
--- | Create a new 'SourceView'
--- widget with the given 'SourceBuffer'.
---
-sourceViewNewWithBuffer :: SourceBuffer -> IO SourceView
-sourceViewNewWithBuffer sb = makeNewObject mkSourceView $ liftM castPtr $
- {#call source_view_new_with_buffer#} sb
-
--- | [_$_]
---
-sourceViewSetShowLineNumbers :: SourceViewClass sv => sv -> Bool -> IO ()
-sourceViewSetShowLineNumbers sv newVal =
- {#call source_view_set_show_line_numbers#} (toSourceView sv) (fromBool newVal)
- [_$_]
--- | [_$_]
---
-sourceViewGetShowLineNumbers :: SourceViewClass sv => sv -> IO Bool [_$_]
-sourceViewGetShowLineNumbers sv = liftM toBool $
- {#call unsafe source_view_get_show_line_numbers#} (toSourceView sv)
-
--- | [_$_]
---
-sourceViewSetShowLineMarkers :: SourceViewClass sv => sv -> Bool -> IO ()
-sourceViewSetShowLineMarkers sv newVal =
- {#call source_view_set_show_line_markers#} (toSourceView sv) (fromBool newVal)
- [_$_]
--- | [_$_]
---
-sourceViewGetShowLineMarkers :: SourceViewClass sv => sv -> IO Bool [_$_]
-sourceViewGetShowLineMarkers sv = liftM toBool $
- {#call unsafe source_view_get_show_line_markers#} (toSourceView sv)
-
--- | [_$_]
---
-sourceViewSetTabsWidth :: SourceViewClass sv => sv -> Int -> IO ()
-sourceViewSetTabsWidth sv width =
- {#call source_view_set_tabs_width#} (toSourceView sv) (fromIntegral width)
- [_$_]
--- | [_$_]
---
-sourceViewGetTabsWidth :: SourceViewClass sv => sv -> IO Int [_$_]
-sourceViewGetTabsWidth sv = liftM fromIntegral $
- {#call unsafe source_view_get_tabs_width#} (toSourceView sv)
-
--- | [_$_]
---
-sourceViewSetAutoIndent :: SourceViewClass sv => sv -> Bool -> IO ()
-sourceViewSetAutoIndent sv newVal =
- {#call source_view_set_auto_indent#} (toSourceView sv) (fromBool newVal)
- [_$_]
--- | [_$_]
---
-sourceViewGetAutoIndent :: SourceViewClass sv => sv -> IO Bool [_$_]
-sourceViewGetAutoIndent sv = liftM toBool $
- {#call unsafe source_view_get_auto_indent#} (toSourceView sv)
-
--- | [_$_]
---
-sourceViewSetInsertSpacesInsteadOfTabs :: SourceViewClass sv => sv -> Bool -> IO ()
-sourceViewSetInsertSpacesInsteadOfTabs sv newVal =
- {#call source_view_set_insert_spaces_instead_of_tabs#} (toSourceView sv) (fromBool newVal)
- [_$_]
--- | [_$_]
---
-sourceViewGetInsertSpacesInsteadOfTabs :: SourceViewClass sv => sv -> IO Bool [_$_]
-sourceViewGetInsertSpacesInsteadOfTabs sv = liftM toBool $
- {#call unsafe source_view_get_insert_spaces_instead_of_tabs#} (toSourceView sv)
-
--- | [_$_]
---
-sourceViewSetShowMargin :: SourceViewClass sv => sv -> Bool -> IO ()
-sourceViewSetShowMargin sv newVal =
- {#call source_view_set_show_margin#} (toSourceView sv) (fromBool newVal)
- [_$_]
--- | [_$_]
---
-sourceViewGetShowMargin :: SourceViewClass sv => sv -> IO Bool [_$_]
-sourceViewGetShowMargin sv = liftM toBool $
- {#call unsafe source_view_get_show_margin#} (toSourceView sv)
-
--- | [_$_]
---
-sourceViewSetMargin :: SourceViewClass sv => sv -> Int -> IO ()
-sourceViewSetMargin sv margin =
- {#call source_view_set_margin#} (toSourceView sv) (fromIntegral margin)
- [_$_]
--- | [_$_]
---
-sourceViewGetMargin :: SourceViewClass sv => sv -> IO Int [_$_]
-sourceViewGetMargin sv = liftM fromIntegral $
- {#call unsafe source_view_get_margin#} (toSourceView sv)
-
--- | [_$_]
---
-sourceViewSetMarkerPixbuf :: SourceViewClass sv => sv -> String -> Pixbuf -> IO ()
-sourceViewSetMarkerPixbuf sv markerType marker = withCString markerType $ \strPtr ->
- {#call source_view_set_marker_pixbuf#} (toSourceView sv) strPtr marker
- [_$_]
--- | [_$_]
---
-sourceViewGetMarkerPixbuf :: SourceViewClass sv => sv -> String -> IO Pixbuf [_$_]
-sourceViewGetMarkerPixbuf sv markerType = withCString markerType $ \strPtr ->
- constructNewGObject mkPixbuf $
- {#call unsafe source_view_get_marker_pixbuf#} (toSourceView sv) strPtr
-
--- | [_$_]
---
-sourceViewSetSmartHomeEnd :: SourceViewClass sv => sv -> Bool -> IO ()
-sourceViewSetSmartHomeEnd sv newVal =
- {#call source_view_set_smart_home_end#} (toSourceView sv) (fromBool newVal)
- [_$_]
--- | [_$_]
---
-sourceViewGetSmartHomeEnd :: SourceViewClass sv => sv -> IO Bool [_$_]
-sourceViewGetSmartHomeEnd sv = liftM toBool $
- {#call unsafe source_view_get_smart_home_end#} (toSourceView sv)
rmfile ./sourceview/Graphics/UI/Gtk/SourceView/SourceView.chs
rmdir ./sourceview/Graphics/UI/Gtk/SourceView
rmdir ./sourceview/Graphics/UI/Gtk
rmdir ./sourceview/Graphics/UI
rmdir ./sourceview/Graphics
hunk ./sourceview/sourceview.cabal.in 1
-name: sourceview
-version: @PACKAGE_VERSION@
-license: LGPL
-license-file: COPYING.LIB
-maintainer: gtk2hs-users@...
-stability: provisional
-homepage: http://haskell.org/gtk2hs/
-category: Graphics
-build-depends: base-@...@ gtk==@PACKAGE_VERSION@
-exposed-modules: ${modules}
rmfile ./sourceview/sourceview.cabal.in
hunk ./sourceview/sourceview.h 1
-#include <gtksourceview/gtksourceview.h>
-#include <gtksourceview/gtksourcelanguagesmanager.h>
-#include <gtksourceview/gtksourcetag.h>
-#include <gtksourceview/gtksourceiter.h>
rmfile ./sourceview/sourceview.h
hunk ./sourceview/sourceview.package.conf.in 1
-name: sourceview
-version: @PACKAGE_VERSION@
-id: sourceview-@...@
-license: LGPL
-license-file: COPYING.LIB
-maintainer: gtk2hs-users@...
-stability: provisional
-homepage: http://haskell.org/gtk2hs/
-exposed: True
-exposed-modules: ${modules}
-import-dirs: "${pkglibdir}/imports/sourceview"
-library-dirs: @SOURCEVIEW_LIBDIR_CQ@
-hs-libraries: HSsourceview
-extra-libraries: @SOURCEVIEW_LIBS_CQ@
-include-dirs: @SOURCEVIEW_CFLAGS_CQ@
-includes: gtksourceview/gtksourcelanguagesmanager.h,
- gtksourceview/gtksourcetag.h,
- gtksourceview/gtksourceiter.h,
- gtksourceview/gtksourceview.h
-depends: @PKG_BASE_ID@ gtk-@...@
-ld-options: @SOURCEVIEW_LIBEXTRA_CQ@
rmfile ./sourceview/sourceview.package.conf.in
rmdir ./sourceview
hunk ./mozembed/demo/Makefile 1
-
-PROG = testembedmoz
-SOURCES = TestEmbedMoz.hs
-
-$(PROG) : $(SOURCES)
- $(HC) --make $< -o $@ $(HCFLAGS)
-
-clean:
- rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG)
-
-HC=ghc
rmfile ./mozembed/demo/Makefile
hunk ./mozembed/demo/TestEmbedMoz.hs 1
--- A Test Program for the Gtk2 Mozilla Widget
---
-
-import Graphics.UI.Gtk
-import Graphics.UI.Gtk.MozEmbed
-import System (getArgs, getEnv, getProgName)
-
-
-main :: IO ()
-main = do
- initGUI
- w <- windowNew
- onDestroy w mainQuit
- mozEmbedSetCompPath mozEmbedDefaultCompPath
-
- moz <- mozEmbedNew
- widgetShow moz
-
- containerAdd w moz
-
- windowSetTitle w "TestEmbedMoz"
- containerSetBorderWidth w 2
- widgetSetSizeRequest w 640 480
- widgetShowAll w
-
- onOpenConnectID <- onOpenURI moz
- (\ s -> do putStrLn ("onOpenURI: " ++ s)
- return False)
-
- args <- getArgs
- case args of
- file@...:_) : _ -> let
- (fr,dr) = span ('/' /=) $ reverse file
- dir = reverse dr
- in do
- dir <- if c == '/' then return dir
- else do pwd <- getEnv "PWD"
- return (pwd ++ '/' : dir)
- let dirSlash = case last dir of
- '/' -> dir
- _ -> dir ++ "/"
- baseURI = "file://" ++ dirSlash
- mozdata <- readFile file
- mozEmbedRenderData moz mozdata baseURI mimeType
- mainGUI
- _ -> do p <- getProgName
- putStrLn ("Usage: " ++ p ++ " <htmlfile>")
-
-mimeType = "text/html"
-
rmfile ./mozembed/demo/TestEmbedMoz.hs
rmdir ./mozembed/demo
hunk ./mozembed/Graphics/UI/Gtk/MozEmbed.chs 1
-{-# LANGUAGE CPP #-}
--- -*-haskell-*-
--- GIMP Toolkit (GTK) Widget embedding the Mozilla browser engine (Gecko)
---
--- Author : Jonas Svensson
---
--- Created: 26 February 2002
---
--- Copyright (c) 2002 Jonas Svensson
---
--- 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.
---
--- Modified 2004 by Scott West for basic use in gtk2hs
---
--- Further modified 2004 by Wolfram Kahl:
--- * ported to gtk2hs/c2hs
--- * added additional interface functions
--- * circumvented render_data problem
-
--- cpp defines unix=1 which gets in the way here so we must undefine it [_$_]
-#undef unix
-
--- | This widgets embeds Mozilla's browser engine (Gecko) into a Gtk+ widget.
---
--- See <http://www.mozilla.org/unix/gtk-embedding.html> for a more detailed API
--- reference.
---
-module Graphics.UI.Gtk.MozEmbed (
--- * Types
- MozEmbed,
-
--- * Constructors
- mozEmbedNew,
- mozEmbedSetCompPath,
- mozEmbedDefaultCompPath,
- mozEmbedSetProfilePath,
- mozEmbedPushStartup,
- mozEmbedPopStartup,
-
--- * Methods
- mozEmbedLoadUrl,
- mozEmbedStopLoad,
- [_$_]
- mozEmbedRenderData,
- mozEmbedOpenStream,
- mozEmbedAppendData,
- mozEmbedCloseStream,
-
- mozEmbedGoBack,
- mozEmbedGoForward,
- mozEmbedCanGoBack,
- mozEmbedCanGoForward,
- mozEmbedGetTitle,
- mozEmbedGetLocation,
- mozEmbedGetLinkMessage,
- mozEmbedGetJsStatus,
-
--- * Signals
- onOpenURI,
- onKeyDown,
- onKeyPress,
- onKeyUp,
- onMouseDown,
- onMouseUp,
- onMouseClick,
- onMouseDoubleClick,
- onMouseOver,
- onMouseOut,
-) where
-
-import Control.Monad (liftM)
-
-import System.Glib.FFI
-import System.Glib.UTFString
-{#import Graphics.UI.Gtk.Abstract.Object#} (makeNewObject)
-{#import Graphics.UI.Gtk.Signals#} (ConnectId,
- connect_STRING__BOOL,
- connect_PTR__INT)
-{#import Graphics.UI.Gtk.MozEmbed.Types#}
-import Graphics.UI.Gtk.Abstract.Widget (Widget)
-
-{#context lib="gtkembedmoz" prefix ="gtk"#}
-
--- operations
--- ----------
-
--- | Create a new MozEmbed.
---
--- Note that the mozembed system must be initialised first using
--- 'mozEmbedSetCompPath'.
---
-mozEmbedNew :: IO MozEmbed
-mozEmbedNew = makeNewObject mkMozEmbed $ liftM castPtr {#call moz_embed_new#}
-
--- | This function must be called before the first widget is created.
---
--- It allows you to set the path to the mozilla components, however unless
--- you really know what you are doing, you should just use:
---
--- > mozEmbedSetCompPath mozEmbedDefaultCompPath
---
-mozEmbedSetCompPath :: String -> IO ()
-mozEmbedSetCompPath str =
- withCString str $ \strPtr ->
- {#call moz_embed_set_comp_path#}
- strPtr
-
--- | The directory containing the mozilla embedding libraries. Its actual value
--- will depend on whether these bindings were built against the mozilla or
--- firefox libraries and where these are installed in the build platform.
---
-mozEmbedDefaultCompPath :: String
-mozEmbedDefaultCompPath = MOZEMBED_LIBDIR
-
-mozEmbedSetProfilePath ::
- FilePath -- ^ profile directory
- -> String -- ^ profile name
- -> IO ()
-mozEmbedSetProfilePath dir name =
- withCString dir $ \dirPtr ->
- withCString name $ \namePtr ->
- {#call moz_embed_set_profile_path#} dirPtr namePtr
-
--- | This function starts loading a url in the embedding widget. All loads are
--- asynchronous. The url argument should be in the form of
--- @\"http:\/\/www.haskell.org\"@.
---
-mozEmbedLoadUrl :: MozEmbed -> String -> IO ()
-mozEmbedLoadUrl moz url =
- withCString url $ \urlPtr ->
- {#call moz_embed_load_url#}
- moz
- urlPtr
-
--- | This function will allow you to stop the load of a document that is being
--- loaded in the widget.
---
-mozEmbedStopLoad :: MozEmbed -> IO ()
-mozEmbedStopLoad moz = [_$_]
- {#call moz_embed_stop_load#} moz
-
--- | This function will go backwards one step in the document's navigation
--- history.
---
-mozEmbedGoBack :: MozEmbed -> IO ()
-mozEmbedGoBack moz =
- {#call moz_embed_go_back#} moz
-
--- | This function will go forward one step in the document's navigation
--- history.
---
-mozEmbedGoForward :: MozEmbed -> IO ()
-mozEmbedGoForward moz =
- {#call moz_embed_go_forward#} moz
-
--- | This function returns the current link message of the document if there is
--- one.
---
-mozEmbedGetLinkMessage :: MozEmbed -> IO String
-mozEmbedGetLinkMessage moz = do
- str <- {#call moz_embed_get_link_message#} moz
- readCString str
-
--- | This function returns the \"js_status\" message if there is one.
---
-mozEmbedGetJsStatus :: MozEmbed -> IO String
-mozEmbedGetJsStatus moz = do
- str <- {#call moz_embed_get_js_status#} moz
- readCString str
-
--- | This function will get the current title for a document.
---
-mozEmbedGetTitle :: MozEmbed -> IO String
-mozEmbedGetTitle moz = do
- str <- {#call moz_embed_get_title#} moz
- readCString str
-
--- | This function will return the current location of the document.
---
-mozEmbedGetLocation :: MozEmbed -> IO String
-mozEmbedGetLocation moz = do
- str <- {#call moz_embed_get_location#} moz
- readCString str
-
--- | This function will return whether or not you can go backwards in the
--- document's navigation history. It will return @True@ if it can go backwards,
--- @False@ if it can't.
--- [_$_]
-mozEmbedCanGoBack :: MozEmbed -> IO Bool
-mozEmbedCanGoBack moz =
- liftM toBool $ [_$_]
- {#call moz_embed_can_go_back#} moz
-
--- | This function will return whether or not you can go forwards in the
--- document's navigation history. It will return @True@ if it can go forwards,
--- @False@ if it can't.
---
-mozEmbedCanGoForward :: MozEmbed -> IO Bool
-mozEmbedCanGoForward moz =
- liftM toBool $ [_$_]
- {#call moz_embed_can_go_forward#} moz
-
--- | Sadly undocumented
---
-mozEmbedPushStartup :: IO ()
-mozEmbedPushStartup =
- {#call moz_embed_push_startup#}
-
--- | Sadly undocumented
---
-mozEmbedPopStartup :: IO ()
-mozEmbedPopStartup =
- {#call moz_embed_pop_startup#}
-
-{-
-void gtk_moz_embed_open_stream (GtkMozEmbed *embed,
- const char *base_uri,
- const char *mime_type);
-void gtk_moz_embed_append_data (GtkMozEmbed *embed,
- const char *data, guint32 len);
-void gtk_moz_embed_close_stream (GtkMozEmbed *embed);
--}
-
--- | This function is used to start loading a document from an external source
--- into the embedding widget. You need to pass in the base URI for resolving
--- internal links and and the mime type of the document.
---
-mozEmbedOpenStream ::
- MozEmbed
- -> String -- ^ base URL
- -> String -- ^ mime type
- -> IO ()
-mozEmbedOpenStream moz baseURI mimeType =
- withCString baseURI $ \ basePtr ->
- withCString mimeType $ \ mtPtr ->
- {#call gtk_moz_embed_open_stream#} moz basePtr mtPtr
-
-mozEmbedAppendDataInternal :: MozEmbed -> String -> IO ()
-mozEmbedAppendDataInternal moz contents =
- withUTFStringLen contents $ \(dataPtr,len) ->
- {#call gtk_moz_embed_append_data#} moz dataPtr (fromIntegral len)
-
--- | This function closes the stream that you have been using to append data
--- manually to the embedding widget.
---
-mozEmbedCloseStream :: MozEmbed -> IO ()
-mozEmbedCloseStream moz =
- {#call gtk_moz_embed_close_stream#} moz
-
--- | This function allows you to append data to an already opened stream in the
--- widget. You need to pass in the data that you want to append to the document
--- and its length.
---
-mozEmbedAppendData :: MozEmbed -> String -> IO ()
-mozEmbedAppendData moz contents =
- mapM_ (mozEmbedAppendDataInternal moz) (chunks 32768 contents)
-
--- | This function will allow you to take a chunk of random data and render it
--- into the document. You need to pass in the data and the length of the data.
--- The base URI is used to resolve internal references in the document and the
--- mime type is used to determine how to render the document internally.
---
-mozEmbedRenderData :: [_$_]
- MozEmbed
- -> String -- ^ content
- -> String -- ^ base URI
- -> String -- ^ mime type
- -> IO ()
-mozEmbedRenderData moz contents baseURI mimeType = do
- mozEmbedOpenStream moz baseURI mimeType
- mozEmbedAppendData moz contents
- mozEmbedCloseStream moz
-
-
-chunks :: Int -> [a] -> [[a]]
-chunks n [] = []
-chunks n xs = let (ys, zs) = splitAt n xs in ys : chunks n zs
-
-{-
-void gtk_moz_embed_render_data (GtkMozEmbed *embed, [_$_]
- const char *data,
- guint32 len,
- const char *base_uri, [_$_]
- const char *mime_type)
--}
-
--- mozEmbedRenderDataInternal does not work for len' > 2^16
-mozEmbedRenderDataInternal :: MozEmbed -> String -> String -> String -> IO ()
-mozEmbedRenderDataInternal moz contents baseURI mimeType =
- withUTFStringLen contents $ \ (dataPtr,len) -> -- alloca discouraged
- withCString baseURI $ \ basePrt ->
- withCString mimeType $ \ mtPtr ->
- {#call gtk_moz_embed_render_data#} moz dataPtr (fromIntegral len) basePrt mtPtr
-
-{-
-struct _GtkMozEmbedClass
-{
- [...]
- gint (* open_uri) (GtkMozEmbed *embed, const char *aURI);
- [...]
-}
--}
-
-onOpenURI :: MozEmbed -> (String -> IO Bool) -> IO (ConnectId MozEmbed)
-onOpenURI = connect_STRING__BOOL "open_uri" after
- where
--- Specify if the handler is to run before (False) or after (True) the
--- default handler.
- after = False
-
-
-{-
-More signals to investigate:
-
- gint (* dom_key_down) (GtkMozEmbed *embed, gpointer dom_event);
- gint (* dom_key_press) (GtkMozEmbed *embed, gpointer dom_event);
- gint (* dom_key_up) (GtkMozEmbed *embed, gpointer dom_event);
- gint (* dom_mouse_down) (GtkMozEmbed *embed, gpointer dom_event);
- gint (* dom_mouse_up) (GtkMozEmbed *embed, gpointer dom_event);
- gint (* dom_mouse_click) (GtkMozEmbed *embed, gpointer dom_event);
- gint (* dom_mouse_dbl_click) (GtkMozEmbed *embed, gpointer dom_event);
- gint (* dom_mouse_over) (GtkMozEmbed *embed, gpointer dom_event);
- gint (* dom_mouse_out) (GtkMozEmbed *embed, gpointer dom_event);
-
-Unfortunateley these are not documented on
-
-http://www.mozilla.org/unix/gtk-embedding.html
-
--}
-
-onKeyDown, onKeyPress, onKeyUp,
- onMouseDown, onMouseUp, onMouseClick, onMouseDoubleClick,
- onMouseOver, onMouseOut
- :: MozEmbed
- -> (Ptr a -> IO Int)
- -> IO (ConnectId MozEmbed)
-onKeyDown = connect_PTR__INT "dom_key_down" False
-onKeyPress = connect_PTR__INT "dom_key_press" False
-onKeyUp = connect_PTR__INT "dom_key_up" False
-onMouseDown = connect_PTR__INT "dom_mouse_down" False
-onMouseUp = connect_PTR__INT "dom_mouse_up" False
-onMouseClick = connect_PTR__INT "dom_mouse_click" False
-onMouseDoubleClick = connect_PTR__INT "dom_mouse_dbl_click" False
-onMouseOver = connect_PTR__INT "dom_mouse_over" False
-onMouseOut = connect_PTR__INT "dom_mouse_out" False
rmfile ./mozembed/Graphics/UI/Gtk/MozEmbed.chs
hunk ./mozembed/Graphics/UI/Gtk/MozEmbed/.keep 1
-This file is here just to ensure that cvs creates the directory since
-otherwise it'd be empty and cvs sometimes prunes empty directories.
rmfile ./mozembed/Graphics/UI/Gtk/MozEmbed/.keep
rmdir ./mozembed/Graphics/UI/Gtk/MozEmbed
rmdir ./mozembed/Graphics/UI/Gtk
rmdir ./mozembed/Graphics/UI
rmdir ./mozembed/Graphics
hunk ./mozembed/mozembed.cabal.in 1
-name: mozembed
-version: @PACKAGE_VERSION@
-license: LGPL
-license-file: COPYING.LIB
-maintainer: gtk2hs-users@...
-stability: provisional
-homepage: http://haskell.org/gtk2hs/
-category: Graphics
-build-depends: base-@...@ gtk==@PACKAGE_VERSION@
-exposed-modules: ${modules}
rmfile ./mozembed/mozembed.cabal.in
hunk ./mozembed/mozembed.package.conf.in 1
-name: mozembed
-version: @PACKAGE_VERSION@
-id: mozembed-@...@
-license: LGPL
-license-file: COPYING.LIB
-maintainer: gtk2hs-users@...
-stability: provisional
-homepage: http://haskell.org/gtk2hs/
-exposed: True
-exposed-modules: ${modules}
-import-dirs: "${pkglibdir}/imports/mozembed"
-library-dirs: @MOZEMBED_LIBDIR_CQ@
-hs-libraries: HSmozembed
-extra-libraries: @MOZEMBED_LIBS_CQ@
-include-dirs: @MOZEMBED_CFLAGS_CQ@
-includes: gtkmozembed.h
-depends: @PKG_BASE_ID@ gtk-@...@
-ld-options: @MOZEMBED_LIBEXTRA_CQ@
rmfile ./mozembed/mozembed.package.conf.in
rmdir ./mozembed
hunk ./gnomevfs/demo/Makefile 1
-
-PROGS = test-sync test-dir test-xfer test-drive-volume test-volume-monitor
-SOURCES = TestSync.hs TestDir.hs TestXfer.hs TestDriveVolume.hs TestVolumeMonitor.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)
-test-volume-monitor : TestVolumeMonitor.hs
- $(HC_RULE)
-
-HC_RULE = $(HC) --make $< -o $@ $(HCFLAGS)
-
-clean:
- rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROGS)
-
-HC=ghc
rmfile ./gnomevfs/demo/Makefile
hunk ./gnomevfs/demo/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
rmfile ./gnomevfs/demo/TestDir.hs
hunk ./gnomevfs/demo/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") . show
- VFS.volumeGetFilesystemType volume >>= (printf "\t\tFilesystem Type: %s\n") . show
- [_$_]
- return ()
rmfile ./gnomevfs/demo/TestDriveVolume.hs
hunk ./gnomevfs/demo/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
rmfile ./gnomevfs/demo/TestSync.hs
hunk ./gnomevfs/demo/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 ()
rmfile ./gnomevfs/demo/TestVolumeMonitor.hs
hunk ./gnomevfs/demo/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 []
- (Just xferProgressCallback) (Just xferErrorCallback)
- (Right xferOverwriteCallback) Nothing
- [_$_]
- return ()
rmfile ./gnomevfs/demo/TestXfer.hs
rmdir ./gnomevfs/demo
hunk ./gnomevfs/System/Gnome/VFS.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- 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,
-#if GNOME_VFS_CHECK_VERSION(2,14,0)
- module System.Gnome.VFS.MIME,
-#endif
- 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
-#if GNOME_VFS_CHECK_VERSION(2,14,0)
-import System.Gnome.VFS.MIME
-#endif
-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
rmfile ./gnomevfs/System/Gnome/VFS.chs
hunk ./gnomevfs/System/Gnome/VFS/BasicTypes.chs 1
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
-{-# OPTIONS_HADDOCK hide #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
-
--- #hide
-
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.BasicTypes (
- [_$_]
- module System.Gnome.VFS.Constants,
- [_$_]
- Handle(..),
- withHandle,
- [_$_]
- Result(..),
- Error(..),
- [_$_]
- OpenMode(..),
- SeekPosition(..),
- [_$_]
- FileInfo(..),
- FileFlags(..),
- FileInfoFields(..),
- SetFileInfoMask(..),
- FileInfoOptions(..),
- FileSize,
- FileOffset,
- FileType(..),
- InodeNumber,
- IDs,
- [_$_]
- MonitorHandle(..),
- withMonitorHandle,
- MonitorCallback,
- MonitorType,
- MonitorEventType,
- [_$_]
- URI(..),
- TextURI,
- newURI,
- withURI,
- ToplevelURI(..),
- newToplevelURI,
- withToplevelURI,
- URIHideOptions(..),
- [_$_]
- DirectoryHandle(..),
- withDirectoryHandle,
- [_$_]
- MakeURIDirs(..),
- DirectoryVisitOptions(..),
- DirectoryVisitCallback,
- DirectoryVisitResult(..),
- FindDirectoryKind(..),
- [_$_]
- XferOptions(..),
- XferProgressStatus(..),
- XferOverwriteMode(..),
- XferOverwriteAction(..),
- XferErrorMode(..),
- XferErrorAction(..),
- XferPhase(..),
- XferProgressInfo(..),
- XferProgressCallback,
- XferErrorCallback,
- XferOverwriteCallback,
- XferDuplicateCallback,
- [_$_]
- Cancellation(..),
- newCancellation,
- withCancellation,
- [_$_]
- VolumeOpSuccessCallback,
- VolumeOpFailureCallback,
- CVolumeOpCallback,
- VolumeType(..),
- DeviceType(..),
- [_$_]
-#if GNOME_VFS_CHECK_VERSION(2,14,0)
- MIMEType,
-#endif
- [_$_]
- -- module System.Gnome.VFS.Hierarchy,
- [_$_]
- DriveID,
- newDrive,
- withDrive,
- [_$_]
- VolumeID,
- newVolume,
- withVolume,
- [_$_]
- wrapVolumeMonitor,
- withVolumeMonitor
- [_$_]
- ) where
-
-import Control.Exception (assert)
-import Control.Monad
-import Control.Monad.Reader
-import Data.Typeable
-import Data.Word (Word64)
-import System.Glib.FFI
-import System.Glib.Flags
-{#import System.Glib.GObject#} (GObject(..),
- GObjectClass,
- toGObject,
- unsafeCastGObject)
-{#import System.Glib.GType#} (GType,
- typeInstanceIsA)
--- {#import System.Gnome.VFS.Hierarchy#}
-{#import System.Gnome.VFS.Types#}
-import System.Gnome.VFS.Constants
-
-import System.Posix.Types (DeviceID, EpochTime)
-
---------------------------------------------------------------------
-
-gTypeCast :: (GObjectClass obj, GObjectClass obj') => GType -> String
- -> (obj -> obj')
--- The usage of foreignPtrToPtr should be safe as the evaluation will only be
--- forced if the object is used afterwards
-gTypeCast gtype objTypeName obj =
- case toGObject obj of
- gobj@... objFPtr)
- | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype
- -> unsafeCastGObject gobj
- | otherwise -> error $ "Cannot cast object to " ++ objTypeName
-
---------------------------------------------------------------------
-
--- | The result of a file operation.
-{# enum GnomeVFSResult as Result {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show, Typeable) #}
-
-newtype Error = Error Result
- deriving (Show, Typeable)
-
--- | A handle to an open file
-{# pointer *GnomeVFSHandle as Handle foreign newtype #}
-withHandle (Handle cHandle) = withForeignPtr cHandle
-
--- | Specifies the start position for a seek operation.
-{# enum GnomeVFSSeekPosition as SeekPosition {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-{# enum GnomeVFSOpenMode as OpenMode {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-
---------------------------------------------------------------------
-
--- | A record type containing information about a file.
-data FileInfo = FileInfo {
- fileInfoName :: Maybe String, -- ^ the name of the file,
- -- without the path
- fileInfoType :: Maybe FileType, -- ^ the type of the file;
- -- i.e. regular, directory,
- -- block-device, etc.
- fileInfoPermissions :: Maybe [FilePermissions], -- ^ the permissions for the
- -- file
- fileInfoFlags :: Maybe [FileFlags], -- ^ flags providing
- -- additional information
- -- about the file
- fileInfoDevice :: Maybe DeviceID, -- ^ the device the file
- -- resides on
- fileInfoInode :: Maybe InodeNumber, -- ^ the inode number of the
- -- file
- fileInfoLinkCount :: Maybe Int, -- ^ the total number of
- -- hard links to the file
- fileInfoIDs :: Maybe IDs, -- ^ the user and group IDs
- -- owning the file
- fileInfoSize :: Maybe FileSize, -- ^ the size of the file in
- -- bytes
- fileInfoBlockCount :: Maybe FileSize, -- ^ the size of the file in
- -- filesystem blocks
- fileInfoIOBlockSize :: Maybe FileSize, -- ^ the optimal buffer size
- -- for reading from and
- -- writing to the file
- fileInfoATime :: Maybe EpochTime, -- ^ the time of last access
- fileInfoMTime :: Maybe EpochTime, -- ^ the time of last modification
- fileInfoCTime :: Maybe EpochTime, -- ^ the time of last attribute modification
- fileInfoSymlinkName :: Maybe String -- ^ the location this
- -- symlink points to, if
- -- @fileInfoFlags@ contains 'FileFlagsSymlink'
-#if GNOME_VFS_CHECK_VERSION(2,14,0)
- ,
- fileInfoMIMEType :: Maybe MIMEType -- ^ the MIME-type of the
- -- file
-#endif
- } deriving (Eq, Show)
-
-{# enum GnomeVFSFileInfoFields as FileInfoFields {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-
--- | Options for reading information from a file.
-{# enum GnomeVFSFileInfoOptions as FileInfoOptions {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-
--- | Flags specifying additional information about a file.
-{# enum GnomeVFSFileFlags as FileFlags {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-
--- | Flags specifying the attributes of a file that should be changed.
-{# enum GnomeVFSSetFileInfoMask as SetFileInfoMask {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-
--- | Identifies the type of a file.
-{# enum GnomeVFSFileType as FileType {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
-
-instance Flags FileInfoOptions
-instance Flags FileInfoFields
-instance Flags FileFlags
-instance Flags SetFileInfoMask
-
--- | An integral type wide enough to hold the size of a file.
-type FileSize = Word64
-
--- | An integral type wide enough to hold an offset into a file.
-type FileOffset = Word64
-
--- | An integral type wide enough to hold the inode number of a file.
-type InodeNumber = Word64
-
--- | A pair holding the user ID and group ID of a file owner.
-type IDs = (Int, Int)
-
---------------------------------------------------------------------
-
--- | A 'URI' is a semi-textual representation of a uniform
--- resource identifier. It contains the information about a resource
--- location encoded as canononicalized text, but also holds extra
--- information about the context in which the URI is used.
-{# pointer *GnomeVFSURI as URI foreign newtype #}
-
-newURI :: Ptr URI
- -> IO URI
-newURI cURI | cURI /= nullPtr =
- liftM URI $ newForeignPtr cURI cURIFinalizer
-wrapURI :: Ptr URI
- -> IO URI
-wrapURI cURI | cURI /= nullPtr =
- liftM URI $ newForeignPtr_ cURI
-foreign import ccall "&gnome_vfs_uri_unref"
- cURIFinalizer :: FunPtr (Ptr URI -> IO ())
-
-withURI (URI cURI) = withForeignPtr cURI
-
--- | The toplevel URI element used to access resources stored on a
--- remote server.
-{# pointer *GnomeVFSToplevelURI as ToplevelURI foreign newtype #}
-withToplevelURI (ToplevelURI cToplevelURI) = withForeignPtr cToplevelURI
-newToplevelURI :: Ptr ToplevelURI
- -> IO ToplevelURI
-newToplevelURI cToplevelURI = liftM ToplevelURI $ newForeignPtr_ cToplevelURI
-
--- | Flags specifying which fields of a 'URI' should be hidden when
--- converted to a string using 'uriToString'.
-{# enum GnomeVFSURIHideOptions as URIHideOptions {
- GNOME_VFS_URI_HIDE_NONE as URIHideNone,
- GNOME_VFS_URI_HIDE_USER_NAME as URIHideUserName,
- GNOME_VFS_URI_HIDE_PASSWORD as URIHidePassword,
- GNOME_VFS_URI_HIDE_HOST_NAME as URIHideHostName,
- GNOME_VFS_URI_HIDE_HOST_PORT as URIHideHostPort,
- GNOME_VFS_URI_HIDE_TOPLEVEL_METHOD as URIHideToplevelMethod,
- GNOME_VFS_URI_HIDE_FRAGMENT_IDENTIFIER as URIHideFragmentIdentifier
- } deriving (Eq, Bounded, Show) #}
-instance Flags URIHideOptions
-
--- | A string that can be passed to 'uriFromString' to create a valid
--- 'URI'.
-type TextURI = String
-
---------------------------------------------------------------------
-
--- | A handle to an open directory.
-{# pointer *GnomeVFSDirectoryHandle as DirectoryHandle foreign newtype #}
-withDirectoryHandle (DirectoryHandle cDirectoryHandle) = withForeignPtr cDirectoryHandle
-
--- | Options controlling the way in which a directories are visited.
-{# enum GnomeVFSDirectoryVisitOptions as DirectoryVisitOptions {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-instance Flags DirectoryVisitOptions
-
--- | A callback that will be called for each entry when passed to
--- 'directoryVisit', 'directoryVisitURI', 'directoryVisitFiles', or
--- 'directoryVisitFilesAtURI'.
--- [_$_]
--- The parameters, from left to right, are:
--- * the path of the visited file, relative to the base directory,
--- * the 'FileInfo' for the visited file,
--- * 'True' if returning 'DirectoryVisitRecurse' will cause a loop, otherwise 'False'.
--- [_$_]
--- The callback must return the next action to be taken.
-type DirectoryVisitCallback = String
- -> FileInfo
- -> Bool
- -> IO DirectoryVisitResult
-
--- | An enumerated value that must be returned from a
--- 'DirectoryVisitCallback'. The 'directoryVisit' and related
--- functions will perform the action specified.
-data DirectoryVisitResult = DirectoryVisitStop -- ^ stop visiting files
- | DirectoryVisitContinue -- ^ continue as normal
- | DirectoryVisitRecurse -- ^ recursively visit the current entry
- deriving (Eq, Enum)
-
--- | Specifies which kind of directory 'findDirectory' should look for.
-{# enum GnomeVFSFindDirectoryKind as FindDirectoryKind {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
-
---------------------------------------------------------------------
-
--- | Flags that may be passed to 'makeURIFromInputWithDirs'. If the
--- path passed is non-absolute (i.e., a relative path), the
--- directories specified will be searched as well.
-{# enum GnomeVFSMakeURIDirs as MakeURIDirs {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-instance Flags MakeURIDirs
-
---------------------------------------------------------------------
-
--- | A handle to a file-system monitor.
-newtype MonitorHandle = MonitorHandle (ForeignPtr MonitorHandle, {# type GnomeVFSMonitorCallback #})
-withMonitorHandle (MonitorHandle (monitorHandleForeignPtr, _)) = withForeignPtr monitorHandleForeignPtr
-
--- | A callback that must be passed to 'monitorAdd'. It will be
--- called any time a file or directory is changed.
--- [_$_]
--- The parameters, from left to right, are:
--- * the handle to a filesystem monitor,
--- * the URI being monitored,
--- * the actual file that was modified,
--- * the event that occured.
-type MonitorCallback = MonitorHandle
- -> TextURI
- -> TextURI
- -> MonitorEventType
- -> IO ()
-
--- | The type of filesystem object that is to be monitored.
-{# enum GnomeVFSMonitorType as MonitorType {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-
--- | The type of event that caused a 'MonitorCallback' to be called.
-{# enum GnomeVFSMonitorEventType as MonitorEventType {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-wrapMonitorHandle :: (Ptr MonitorHandle, {# type GnomeVFSMonitorCallback #})
- -> IO MonitorHandle
-wrapMonitorHandle (cMonitorHandle, cMonitorCallback) =
- do monitorHandleForeignPtr <- newForeignPtr_ cMonitorHandle
- return $ MonitorHandle (monitorHandleForeignPtr, cMonitorCallback)
-
---------------------------------------------------------------------
-
--- | Options controlling how the 'System.Gnome.VFS.Xfer.xferURI' and related functions behave.
-{# enum GnomeVFSXferOptions as XferOptions {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Bounded, Show) #}
-instance Flags XferOptions
-
-{# enum GnomeVFSXferProgressStatus as XferProgressStatus {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
-{# enum GnomeVFSXferOverwriteMode as XferOverwriteMode {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
-{# enum GnomeVFSXferOverwriteAction as XferOverwriteAction {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
-{# enum GnomeVFSXferErrorMode as XferErrorMode {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
-{# enum GnomeVFSXferErrorAction as XferErrorAction {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
-{# enum GnomeVFSXferPhase as XferPhase {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
-
-data XferProgressInfo = XferProgressInfo {
- xferProgressInfoVFSStatus :: Result, -- ^ current VFS status
- xferProgressInfoPhase :: XferPhase, -- ^ phase of the transfer
- xferProgressInfoSourceName :: Maybe String, -- ^ currently transferring source URI
- xferProgressInfoTargetName :: Maybe String, -- ^ currently transferring target URI
- xferProgressInfoFileIndex :: Word, -- ^ index of the file currently being transferred
- xferProgressInfoFilesTotal :: Word, -- ^ total number of files being transferred
- xferProgressInfoBytesTotal :: FileSize, -- ^ total size of all files in bytes
- xferProgressInfoFileSize :: FileSize, -- ^ size of the file currently being transferred
- xferProgressInfoBytesCopied :: FileSize, -- ^ number of bytes already transferred in the current file
- xferProgressInfoTotalBytesCopied :: FileSize, -- ^ total number of bytes already transferred
- xferProgressInfoTopLevelItem :: Bool -- ^ 'True' if the file being transferred is a top-level item;
- -- 'False' if it is inside a directory
- } deriving (Eq)
-
--- | The type of the first callback that is passed to
--- 'System.Gnome.VFS.Xfer.xferURI' and related functions. This
--- callback will be called periodically during transfers that are
--- progressing normally.
---
--- The callback must return 'Prelude.False' to abort the transfer, or 'Prelude.True' otherwise.
-type XferProgressCallback = XferProgressInfo
- -> IO Bool
-
--- | The type of the second callback that is passed to
--- 'System.Gnome.VFS.Xfer.xferURI'. This callback will be called
--- whenever an error occurs.
---
--- The callback must return the action to be performed in response to the error.
-type XferErrorCallback = XferProgressInfo
- -> IO XferErrorAction
-
--- | The type of the third callback that is passed to
--- 'System.Gnome.VFS.Xfer.xferURI'. This callback will be called
--- when a file would be overwritten.
---
--- The callback must return the action to be performed when the target file already exists.
-type XferOverwriteCallback = XferProgressInfo
- -> IO XferOverwriteAction
-
--- | The type of the fourth callback that is passed to
--- 'System.Gnome.VFS.Xfer.xferURI'. This callback will be called
--- when a duplicate filename is found.
---
--- The parameters, from left to right, are:
--- * @info@ - information about the progress of the current transfer,
--- * @duplicateName@ - the name of the target file,
--- * @duplicateCount@ - the number of duplicates that exist.
---
--- The callback must return the new filename that should be used, or 'Prelude.Nothing' to abort.
-type XferDuplicateCallback = XferProgressInfo
- -> String
- -> Int
- -> IO (Maybe String)
-
---------------------------------------------------------------------
-
--- | An object that can be used for signalling cancellation of an
--- operation.
-{# pointer *GnomeVFSCancellation as Cancellation foreign newtype #}
-
-newCancellation :: Ptr Cancellation
- -> IO Cancellation
-newCancellation cCancellationPtr | cCancellationPtr /= nullPtr =
- liftM Cancellation $ newForeignPtr cCancellationPtr cancellationFinalizer
-foreign import ccall unsafe "&gnome_vfs_cancellation_destroy"
- cancellationFinalizer :: FunPtr (Ptr Cancellation -> IO ())
-withCancellation (Cancellation cCancellation) = withForeignPtr cCancellation
-
---------------------------------------------------------------------
-
-withVolume (Volume cVolume) = withForeignPtr cVolume
-newVolume :: Ptr Volume
- -> IO Volume
-newVolume cVolume | cVolume /= nullPtr =
- liftM Volume $ newForeignPtr cVolume volumeFinalizer
-foreign import ccall unsafe "&gnome_vfs_volume_unref"
- volumeFinalizer :: FunPtr (Ptr Volume -> IO ())
-
--- | An action to be performed when a volume operation completes successfully.
-type VolumeOpSuccessCallback = IO ()
--- | An action to be performed when a volume operation fails.
-type VolumeOpFailureCallback = String
- -> String
- -> IO ()
-
--- | Identifies the device type of a 'Volume' or 'Drive'.
-{#enum GnomeVFSDeviceType as DeviceType {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
--- | Identifies the type of a 'Volume'.
-{#enum GnomeVFSVolumeType as VolumeType {underscoreToCase} with prefix = "GNOME_VFS" deriving (Eq, Show) #}
-
-type CVolumeOpCallback = {# type gboolean #}
- -> CString
- -> CString
- -> Ptr ()
- -> IO ()
-
---------------------------------------------------------------------
-
--- | Identifies a 'Drive'
-type DriveID = {# type gulong #}
-
-withDrive (Drive cDrive) = withForeignPtr cDrive
-newDrive :: Ptr Drive
- -> IO Drive
-newDrive cDrive | cDrive /= nullPtr =
- liftM Drive $ newForeignPtr cDrive driveFinalizer
-foreign import ccall unsafe "&gnome_vfs_drive_unref"
- driveFinalizer :: FunPtr (Ptr Drive -> IO ())
-
---------------------------------------------------------------------
-
--- | Identifies a 'Volume'.
-type VolumeID = {# type gulong #}
-
-withVolumeMonitor (VolumeMonitor cVolumeMonitor) = withForeignPtr cVolumeMonitor
-wrapVolumeMonitor :: Ptr VolumeMonitor
- -> IO VolumeMonitor
-wrapVolumeMonitor cVolumeMonitor | cVolumeMonitor /= nullPtr =
- liftM VolumeMonitor $ newForeignPtr_ cVolumeMonitor
-
---------------------------------------------------------------------
-
-#if GNOME_VFS_CHECK_VERSION(2,14,0)
--- | A string that will be treated as a MIME-type.
-type MIMEType = String
-#endif
rmfile ./gnomevfs/System/Gnome/VFS/BasicTypes.chs
hunk ./gnomevfs/System/Gnome/VFS/Cancellation.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- 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.Gnome.VFS.BasicTypes#}
-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
rmfile ./gnomevfs/System/Gnome/VFS/Cancellation.chs
hunk ./gnomevfs/System/Gnome/VFS/Constants.hsc 1
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_HADDOCK hide #-}
--- GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-haskell-*-
---
--- Author : Peter Gavin
--- Created: 21-Jun-2008
---
--- Copyright (c) 2008 Peter Gavin
---
--- 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 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
-
--- #hide
-
-#include <libgnomevfs/gnome-vfs-file-info.h>
-
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Constants (
-
- FilePermissions (..),
- permUserAll,
- permGroupAll,
- permOtherAll
-
- ) where
-
-import System.Glib.Flags
-
--- | UNIX-like permissions for a file.
-data FilePermissions [_$_]
-#ifndef WIN32
- = PermSUID
- | PermSGID
- | PermSticky
-#else
- = PermSticky
-#endif
- | PermUserRead
- | PermUserWrite
- | PermUserExec
- | PermGroupRead
- | PermGroupWrite
- | PermGroupExec
- | PermOtherRead
- | PermOtherWrite
- | PermOtherExec
- | PermAccessReadable
- | PermAccessWritable
- | PermAccessExecutable
- deriving (Eq, Ord, Bounded, Show, Read)
-instance Flags FilePermissions
-permUserAll, permGroupAll, permOtherAll :: [FilePermissions]
-permUserAll = [ PermUserRead, PermUserWrite, PermUserExec ]
-permGroupAll = [ PermGroupRead, PermGroupWrite, PermGroupExec ]
-permOtherAll = [ PermOtherRead, PermOtherWrite, PermOtherExec ]
-
-instance Enum FilePermissions where
-#ifndef WIN32
- fromEnum PermSUID = #{const GNOME_VFS_PERM_SUID}
- fromEnum PermSGID = #{const GNOME_VFS_PERM_SGID}
-#endif
- fromEnum PermSticky = #{const GNOME_VFS_PERM_STICKY}
- fromEnum PermUserRead = #{const GNOME_VFS_PERM_USER_READ}
- fromEnum PermUserWrite = #{const GNOME_VFS_PERM_USER_WRITE}
- fromEnum PermUserExec = #{const GNOME_VFS_PERM_USER_EXEC}
- fromEnum PermGroupRead = #{const GNOME_VFS_PERM_GROUP_READ}
- fromEnum PermGroupWrite = #{const GNOME_VFS_PERM_GROUP_WRITE}
- fromEnum PermGroupExec = #{const GNOME_VFS_PERM_GROUP_EXEC}
- fromEnum PermOtherRead = #{const GNOME_VFS_PERM_OTHER_READ}
- fromEnum PermOtherWrite = #{const GNOME_VFS_PERM_OTHER_WRITE}
- fromEnum PermOtherExec = #{const GNOME_VFS_PERM_OTHER_EXEC}
- fromEnum PermAccessReadable = #{const GNOME_VFS_PERM_ACCESS_READABLE}
- fromEnum PermAccessWritable = #{const GNOME_VFS_PERM_ACCESS_WRITABLE}
- fromEnum PermAccessExecutable = #{const GNOME_VFS_PERM_ACCESS_EXECUTABLE}
- [_$_]
-#ifndef WIN32
- toEnum #{const GNOME_VFS_PERM_SUID} = PermSUID
- toEnum #{const GNOME_VFS_PERM_SGID} = PermSGID
-#endif
- toEnum #{const GNOME_VFS_PERM_STICKY} = PermSticky
- toEnum #{const GNOME_VFS_PERM_USER_READ} = PermUserRead
- toEnum #{const GNOME_VFS_PERM_USER_WRITE} = PermUserWrite
- toEnum #{const GNOME_VFS_PERM_USER_EXEC} = PermUserExec
- toEnum #{const GNOME_VFS_PERM_GROUP_READ} = PermGroupRead
- toEnum #{const GNOME_VFS_PERM_GROUP_WRITE} = PermGroupWrite
- toEnum #{const GNOME_VFS_PERM_GROUP_EXEC} = PermGroupExec
- toEnum #{const GNOME_VFS_PERM_OTHER_READ} = PermOtherRead
- toEnum #{const GNOME_VFS_PERM_OTHER_WRITE} = PermOtherWrite
- toEnum #{const GNOME_VFS_PERM_OTHER_EXEC} = PermOtherExec
- toEnum #{const GNOME_VFS_PERM_ACCESS_READABLE} = PermAccessReadable
- toEnum #{const GNOME_VFS_PERM_ACCESS_WRITABLE} = PermAccessWritable
- toEnum #{const GNOME_VFS_PERM_ACCESS_EXECUTABLE} = PermAccessExecutable
rmfile ./gnomevfs/System/Gnome/VFS/Constants.hsc
hunk ./gnomevfs/System/Gnome/VFS/Directory.chs 1
-{-# LANGUAGE CPP, ScopedTypeVariables #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- 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.BasicTypes#}
-{#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 ())
rmfile ./gnomevfs/System/Gnome/VFS/Directory.chs
hunk ./gnomevfs/System/Gnome/VFS/Drive.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Drive (
-
--- * Types
- -- | A container for 'Volume's.
- Drive,
- DriveClass,
- DriveID,
- DeviceType,
-
--- * Type Conversion
- castToDrive,
-
--- * Drive Comparison
- driveCompare,
-
--- * Drive Properties
- driveGetActivationURI,
- driveGetDevicePath,
- driveGetDeviceType,
- driveGetDisplayName,
-#if GNOME_VFS_CHECK_VERSION(2,8,0)
- driveGetHalUDI,
-#endif
- driveGetIcon,
- driveGetID,
-
--- * Drive State
- driveIsConnected,
- driveIsMounted,
- driveIsUserVisible,
-#if GNOME_VFS_CHECK_VERSION(2,8,0)
- driveGetMountedVolumes,
-#endif
-
--- * 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#}
-{#import System.Gnome.VFS.BasicTypes#}
-
-{# 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 'System.Gnome.VFS.Volume.volumeUnmount' for
--- each volume in 'driveGetMountedVolumes', except for the last one,
--- for which 'System.Gnome.VFS.Volume.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
--- 'System.Gnome.VFS.URI.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@...
--- @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 #}
-
-#if GNOME_VFS_CHECK_VERSION(2,8,0)
--- | 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 #}
-#endif
-
--- | 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 DriveID -- ^ a unique identifier for the drive
-driveGetID drive =
- {# call drive_get_id #} (castToDrive drive)
-
-
-#if GNOME_VFS_CHECK_VERSION(2,8,0)
--- | 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
-#endif
-
-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) =>
- 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
-
-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
rmfile ./gnomevfs/System/Gnome/VFS/Drive.chs
hunk ./gnomevfs/System/Gnome/VFS/Error.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Error (
- [_$_]
- Error(..),
- [_$_]
- error,
- errors,
- eofErrors,
- [_$_]
- ) where
-
-import Control.Monad (join)
-#ifdef HAVE_NEW_CONTROL_EXCEPTION
-import qualified Control.OldException as E
-#else
-import qualified Control.Exception as E
-#endif
-import Data.Dynamic
--- import System.Gnome.VFS.Types
-import System.Gnome.VFS.BasicTypes
-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
rmfile ./gnomevfs/System/Gnome/VFS/Error.chs
hunk ./gnomevfs/System/Gnome/VFS/FileInfo.chs 1
-{-# LANGUAGE CPP #-}
-
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- 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.Gnome.VFS.BasicTypes#}
-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
-#if GNOME_VFS_CHECK_VERSION(2,14,0) [_$_]
- ids <- maybeField FileInfoFieldsIds $
- do uid <- liftM fromIntegral $ {# get GnomeVFSFileInfo->uid #} ptr
- gid <- liftM fromIntegral $ {# get GnomeVFSFileInfo->gid #} ptr
- return $ (uid, gid)
-#else
- uid <- liftM fromIntegral $ {# get GnomeVFSFileInfo->uid #} ptr
- gid <- liftM fromIntegral $ {# get GnomeVFSFileInfo->gid #} ptr
- let ids = Just (uid, gid)
-#endif
- [_$_]
- 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
-#if GNOME_VFS_CHECK_VERSION(2,14,0)
- mimeType <- maybeField FileInfoFieldsMimeType $
- {# call file_info_get_mime_type #} (castPtr ptr) >>= peekUTFString
-#endif
- return $ FileInfo name
- fileType
- permissions
- fileFlags
- device
- inode
- linkCount
- ids
- size
- blockCount
- ioBlockSize
- aTime
- mTime
- cTime
- symlinkName
-#if GNOME_VFS_CHECK_VERSION(2,14,0)
- mimeType
-#endif
- poke ptr (FileInfo name
- fileType
- permissions
- fileFlags
- device
- inode
- linkCount
- ids
- size
- blockCount
- ioBlockSize
- aTime
- mTime
- cTime
- symlinkName
-#if GNOME_VFS_CHECK_VERSION(2,14,0)
- mimeType
-#endif
- ) =
- 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
- 0
- (return . cFromEnum)
- cFileInfoSetType,
- [_$_]
- marshaller FileInfoFieldsPermissions
- permissions
- 0
- (return . cFromFlags)
- {# set GnomeVFSFileInfo->permissions #},
- [_$_]
- marshaller FileInfoFieldsFlags
- fileFlags
- 0
- (return . cFromFlags)
- {# set GnomeVFSFileInfo->flags #},
- [_$_]
- marshaller FileInfoFieldsDevice
- device
- 0
- (return . cFromEnum)
- {# set GnomeVFSFileInfo->device #},
- [_$_]
- marshaller FileInfoFieldsInode
- inode
- 0
- (return . fromIntegral)
- {# set GnomeVFSFileInfo->inode #},
- [_$_]
- marshaller FileInfoFieldsLinkCount
- linkCount
- 0
- (return . fromIntegral)
- {# set GnomeVFSFileInfo->link_count #},
-
-#if GNOME_VFS_CHECK_VERSION(2,14,0) [_$_]
- marshaller FileInfoFieldsIds
- ids
- (0, 0)
- (\(uid, gid) -> return (fromIntegral uid, fromIntegral gid))
- (\ptr (uid, gid) ->
- do {# set GnomeVFSFileInfo->uid #} ptr uid
- {# set GnomeVFSFileInfo->gid #} ptr gid),
-#endif
- [_$_]
- marshaller FileInfoFieldsSize
- size
- 0
- (return . fromIntegral)
- cFileInfoSetSize,
- [_$_]
- marshaller FileInfoFieldsBlockCount
- blockCount
- 0
- (return . fromIntegral)
- {# set GnomeVFSFileInfo->block_count #},
- [_$_]
- marshaller FileInfoFieldsIoBlockSize
- ioBlockSize
- 0
- (return . fromIntegral)
- {# set GnomeVFSFileInfo->io_block_size #},
- [_$_]
- marshaller FileInfoFieldsAtime
- aTime
- 0
- (return . cFromEnum)
- {# set GnomeVFSFileInfo->atime #},
- [_$_]
- marshaller FileInfoFieldsMtime
- mTime
- 0
- (return . cFromEnum)
- {# set GnomeVFSFileInfo->mtime #},
- [_$_]
- marshaller FileInfoFieldsCtime
- cTime
- 0
- (return . cFromEnum)
- {# set GnomeVFSFileInfo->ctime #},
- [_$_]
- marshaller FileInfoFieldsSymlinkName
- symlinkName
- nullPtr
- newUTFString
- (\ptr str ->
- do {# get GnomeVFSFileInfo->symlink_name #} ptr >>= (gFree . castPtr)
- {# set GnomeVFSFileInfo->symlink_name #} ptr str),
- [_$_]
- marshaller FileInfoFieldsMimeType
- symlinkName
- nullPtr
- newUTFString
- (\ptr str ->
- do {# get GnomeVFSFileInfo->mime_type #} ptr >>= (gFree . castPtr)
- {# set GnomeVFSFileInfo->mime_type #} ptr str) ]
- [_$_]
-#if !GNOME_VFS_CHECK_VERSION(2,14,0)
- case ids of
- Just (uid, gid) ->
- do {# set GnomeVFSFileInfo->uid #} ptr $ fromIntegral uid
- {# set GnomeVFSFileInfo->gid #} ptr $ fromIntegral gid
- Nothing ->
- return ()
-#endif
-
- {# set GnomeVFSFileInfo->valid_fields #} ptr $ cFromFlags validFields
-
-gFree = {# call g_free #}
-
-foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_type"
- cFileInfoGetType :: Ptr FileInfo
- -> IO {# type GnomeVFSFileType #}
-foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_inode"
- cFileInfoGetInode :: Ptr FileInfo
- -> IO CULLong
-foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_size"
- cFileInfoGetSize :: Ptr FileInfo
- -> IO CULLong
-foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_block_count"
- cFileInfoGetBlockCount :: Ptr FileInfo
- -> IO CULLong
-
-foreign import ccall unsafe "_hs_gnome_vfs_file_info_set_type"
- cFileInfoSetType :: Ptr FileInfo
- -> {# type GnomeVFSFileType #}
- -> IO ()
-foreign import ccall unsafe "_hs_gnome_vfs_file_info_get_inode"
- cFileInfoSetInode :: Ptr FileInfo
- -> CULLong
- -> IO ()
-foreign import ccall unsafe "_hs_gnome_vfs_file_info_set_size"
- cFileInfoSetSize :: Ptr FileInfo
- -> {# type GnomeVFSFileSize #}
- -> IO ()
-foreign import ccall unsafe "_hs_gnome_vfs_file_info_set_block_count"
- cFileInfoSetBlockCount :: Ptr FileInfo
- -> CULLong
- -> IO ()
rmfile ./gnomevfs/System/Gnome/VFS/FileInfo.chs
hunk ./gnomevfs/System/Gnome/VFS/Init.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Init (
- [_$_]
--- * Initialization and Shutdown
- init,
- shutdown,
- initialized
- [_$_]
- ) where
-
-import System.Glib.FFI
-import Control.Monad (liftM)
-import Prelude hiding (init)
-
-{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-
--- | If gnome-vfs is not already initialized, initialize it. This must
--- be called prior to performing any other gnome-vfs operations, and
--- may be called multiple times without error.
-init :: IO Bool
-init = liftM toBool {# call gnome_vfs_init #}
-
--- | Cease all active gnome-vfs operations and unload the MIME database
--- from memory.
-shutdown :: IO ()
-shutdown = {# call gnome_vfs_shutdown #}
-
--- | Detects if gnome-vfs has already been initialized (gnome-vfs must
--- be initialized prior to using any methods or operations).
-initialized :: IO Bool
-initialized = liftM toBool {# call gnome_vfs_initialized #}
rmfile ./gnomevfs/System/Gnome/VFS/Init.chs
hunk ./gnomevfs/System/Gnome/VFS/MIME.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.MIME (
- [_$_]
--- * Types
- MIMEType,
-
--- * MIME Type Operations
- mimeTypeFromNameOrDefault,
- getMIMETypeCommon,
- getMIMETypeFromURI,
- getFileMIMETypeFast,
- getFileMIMEType,
- mimeTypeIsSupertype,
- getSupertypeFromMIMEType,
- mimeInfoCacheReload
- [_$_]
- ) where
-
-import Control.Monad (liftM)
-import System.Glib.Flags
-import System.Glib.FFI
-import System.Glib.UTFString
--- {#import System.Gnome.VFS.Types#}
-{#import System.Gnome.VFS.BasicTypes#}
-{#import System.Gnome.VFS.Marshal#}
-
-{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-
--- | Try to determine the MIME-type of the file at @filename@, using
--- only the filename and the Gnome VFS MIME type database. If the
--- MIME-type is not found, return @defaultv@.
-mimeTypeFromNameOrDefault :: FilePath -- ^ @filename@ - the file
- -- to get the MIME-type
- -- for
- -> Maybe MIMEType -- ^ @defaultv@ - the
- -- default MIME-type to
- -- return if no match is
- -- found
- -> Maybe MIMEType -- ^ the MIME-type of the
- -- filename, or @defaultv@
-mimeTypeFromNameOrDefault filename defaultv =
- unsafePerformIO $ maybeWith withUTFString defaultv $ \cDefaultv ->
- withUTFString filename $ \cFilename ->
- {# call mime_type_from_name_or_default #} cFilename cDefaultv >>=
- maybePeek peekUTFString
-
--- | Try to get the MIME-type of the file represented by @uri@. This
--- function favors the contents of the file over the extension of
--- the filename. If the file does not exist, the MIME-type for the
--- extension is returned. If no MIME-type can be found for the file,
--- the function returns \"application\/octet-stream\".
--- [_$_]
--- Note: This function will not necessarily return the same
--- MIME-type as 'System.Gnome.VFS.Ops.getFileInfo'.
-getMIMETypeCommon :: URI -- ^ @uri@ - the URI of the file to examine
- -> IO String -- ^ the guessed MIME-type
-getMIMETypeCommon uri =
- {# call get_mime_type_common #} uri >>= peekUTFString
-
--- | Try to get the MIME-type of the file represented by @uri@. This
--- function looks only at the filename pointed to by @uri@.
-getMIMETypeFromURI :: URI -- ^ @uri@ - the URI to examine
- -> IO String -- ^ the guessed MIME-type
-getMIMETypeFromURI uri =
- {# call get_mime_type_from_uri #} uri >>= peekUTFString
-
-getFileMIMETypeFast :: FilePath -- ^ [_$_]
- -> IO String
-getFileMIMETypeFast path =
- withUTFString path $ \cPath ->
- {# call get_file_mime_type_fast #} cPath nullPtr >>=
- peekUTFString
-
--- | Try to guess the MIME-type of the file represented by @path@. If
--- @suffixOnly@ is 'False', use the MIME-magic based lookup
--- first. Handles non-existant files by returning a type based on
--- the file extension.
-getFileMIMEType :: FilePath
- -> Bool
- -> IO String
-getFileMIMEType path suffixOnly =
- withUTFString path $ \cPath ->
- let cSuffixOnly = fromBool suffixOnly
- in {# call get_file_mime_type #} cPath nullPtr cSuffixOnly >>=
- peekUTFString
-
--- | Returns 'True' if @mimeType@ is of the form @foo\/\*@, and 'False'
--- otherwise.
-mimeTypeIsSupertype :: String
- -> Bool
-mimeTypeIsSupertype mimeType =
- toBool $ unsafePerformIO $
- withUTFString mimeType {# call mime_type_is_supertype #}
-
--- | Returns the supertype for @mimeType@. The supertype of an
--- application is computed by removing its suffix, and replacing it
--- with @\*@. Thus, @foo\/bar@ will be converted to @foo\/\*@.
-getSupertypeFromMIMEType :: String
- -> String
-getSupertypeFromMIMEType mimeType =
- unsafePerformIO $ withUTFString mimeType {# call get_supertype_from_mime_type #} >>=
- readUTFString
-
--- | Reload the MIME information for the specified directory.
-mimeInfoCacheReload :: FilePath
- -> IO ()
-mimeInfoCacheReload dir =
- withUTFString dir {# call mime_info_cache_reload #}
-
--- | Reload the MIME database.
-mimeReload :: IO ()
-mimeReload = {# call mime_reload #}
rmfile ./gnomevfs/System/Gnome/VFS/MIME.chs
hunk ./gnomevfs/System/Gnome/VFS/Marshal.chs 1
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_HADDOCK hide #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
-
--- #hide
-
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Marshal (
- [_$_]
- cToEnum,
- cFromEnum,
- cToBool,
- cFromBool,
- cToFlags,
- cFromFlags,
- genericResultMarshal,
- voidResultMarshal,
- newObjectResultMarshal,
- volumeOpCallbackMarshal
- [_$_]
- ) where
-
-import Control.Exception
-import Control.Monad (liftM)
-import Data.Dynamic
-import System.Glib.FFI
-import System.Glib.Flags (Flags, toFlags, fromFlags)
-import System.Glib.UTFString (peekUTFString)
--- {#import System.Gnome.VFS.Types#}
-{#import System.Gnome.VFS.BasicTypes#}
-import System.Gnome.VFS.Error
-import Prelude hiding (error)
-
-cToEnum :: (Integral a, Enum b) => a -> b
-cToEnum = toEnum . fromIntegral
-
-cFromEnum :: (Enum a, Integral b) => a -> b
-cFromEnum = fromIntegral . fromEnum
-
-cToBool :: Integral a => a -> Bool
-cToBool = toBool . fromIntegral
-
-cFromBool :: Integral a => Bool -> a
-cFromBool = fromIntegral . fromBool
-
-cToFlags :: (Integral a, Flags b) => a -> [b]
-cToFlags = toFlags . fromIntegral
-
-cFromFlags :: (Flags a, Integral b) => [a] -> b
-cFromFlags = fromIntegral . fromFlags
-
-genericResultMarshal :: IO {# type GnomeVFSResult #}
- -> IO a
- -> IO b
- -> IO a
-genericResultMarshal cAction cSuccessAction cFailureAction =
- do result <- liftM cToEnum $ cAction
- case result of
- Ok -> cSuccessAction
- errorCode -> do cFailureAction
- error result
-
-voidResultMarshal :: IO {# type GnomeVFSResult #}
- -> IO ()
-voidResultMarshal cAction =
- genericResultMarshal cAction (return ()) (return ())
-
-newObjectResultMarshal :: (ForeignPtr obj -> obj)
- -> (Ptr (Ptr obj) -> IO {# type GnomeVFSResult #})
- -> IO obj
-newObjectResultMarshal objConstructor cNewObj =
- alloca $ \cObjPtr ->
- do poke cObjPtr nullPtr
- genericResultMarshal (cNewObj cObjPtr)
- (do cObj <- peek cObjPtr
- assert (cObj /= nullPtr) $ return ()
- newObj <- newForeignPtr_ cObj
- return $ objConstructor newObj)
- (do cObj <- peek cObjPtr
- assert (cObj == nullPtr) $ return ())
-
-volumeOpCallbackMarshal :: VolumeOpSuccessCallback
- -> VolumeOpFailureCallback
- -> IO {# type GnomeVFSVolumeOpCallback #}
-volumeOpCallbackMarshal successCallback failureCallback =
- let cCallback :: CVolumeOpCallback
- cCallback cSucceeded cError cDetailedError cUserData =
- let succeeded = cToBool cSucceeded
- cCallbackFunPtr = castPtrToFunPtr cUserData
- in (flip finally) (freeHaskellFunPtr cCallbackFunPtr) $
- if succeeded
- then assert (and [cError == nullPtr, cDetailedError == nullPtr]) $
- successCallback
- else assert (and [cError /= nullPtr, cDetailedError /= nullPtr]) $
- do error <- peekUTFString cError
- detailedError <- peekUTFString cDetailedError
- failureCallback error detailedError
- in makeVolumeOpCallback cCallback
-foreign import ccall safe "wrapper"
- makeVolumeOpCallback :: CVolumeOpCallback
- -> IO {# type GnomeVFSVolumeOpCallback #}
rmfile ./gnomevfs/System/Gnome/VFS/Marshal.chs
hunk ./gnomevfs/System/Gnome/VFS/Monitor.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Monitor (
- [_$_]
--- * Types
- MonitorHandle,
- MonitorCallback,
- [_$_]
--- * Operations
- monitorAdd,
- monitorCancel
- [_$_]
- ) where
-
-import Control.Monad (liftM)
-import System.Glib.FFI
-import System.Glib.UTFString
-{#import System.Gnome.VFS.Marshal#}
--- {#import System.Gnome.VFS.Types#}
-{#import System.Gnome.VFS.BasicTypes#}
-
-{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-
-type CMonitorCallback = Ptr MonitorHandle
- -> CString
- -> CString
- -> {# type GnomeVFSMonitorEventType #}
- -> {# type gpointer #}
- -> IO ()
-
--- | Watch the object at @textURI@ for changes, and call @callback@
--- when a change occurs.
-monitorAdd :: String -- ^ @textURI@ - [_$_]
- -> MonitorType -- ^ @monitorType@ - [_$_]
- -> MonitorCallback -- ^ @callback@ - [_$_]
- -> IO MonitorHandle -- ^ a handle to the new monitor
-monitorAdd textURI monitorType callback =
- do cTestURI <- newUTFString textURI
- let cMonitorType = cFromEnum monitorType
- cCallback <- monitorCallbackMarshal callback
- newObjectResultMarshal
- (\cMonitorHandle ->
- MonitorHandle (cMonitorHandle, cCallback))
- (\cMonitorHandlePtr ->
- {# call monitor_add #} (castPtr cMonitorHandlePtr) cTestURI cMonitorType cCallback nullPtr)
-
-monitorCallbackMarshal :: MonitorCallback
- -> IO {# type GnomeVFSMonitorCallback #}
-monitorCallbackMarshal callback =
- let cCallback :: CMonitorCallback
- cCallback cHandle cMonitorURI cInfoURI cEventType cUserData =
- do handle <- liftM (\cHandle -> MonitorHandle (cHandle, castPtrToFunPtr cUserData)) $
- newForeignPtr_ cHandle
- monitorURI <- peekUTFString cMonitorURI
- infoURI <- peekUTFString cInfoURI
- let eventType = cToEnum cEventType
- callback handle monitorURI infoURI eventType
- in makeMonitorCallback cCallback
-foreign import ccall safe "wrapper"
- makeMonitorCallback :: CMonitorCallback
- -> IO {# type GnomeVFSMonitorCallback #}
-
--- | Cancels the monitor referred to by @monitorHandle@.
-monitorCancel :: MonitorHandle -- ^ @monitorHandle@
- -> IO ()
-monitorCancel (MonitorHandle (cMonitorHandle, cCallback)) =
- do freeHaskellFunPtr cCallback
- withForeignPtr cMonitorHandle $
- voidResultMarshal . {# call monitor_cancel #} . castPtr
rmfile ./gnomevfs/System/Gnome/VFS/Monitor.chs
hunk ./gnomevfs/System/Gnome/VFS/Ops.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Ops (
- [_$_]
--- * Types
- Handle,
- Result(..),
- OpenMode(..),
- SeekPosition(..),
- FilePermissions(..),
- FileSize,
- FileOffset,
- [_$_]
--- * I\/O Operations
- open,
- openURI,
- create,
- createURI,
- close,
-#if __GLASGOW_HASKELL__ >= 606
- read,
- write,
-#endif
- seek,
- tell,
-#if GNOME_VFS_CHECK_VERSION(2,12,0)
- forgetCache,
-#endif
- [_$_]
--- * Truncation
- truncate,
- truncateURI,
- truncateHandle,
-
--- * File Information
- getFileInfo,
- getFileInfoURI,
- getFileInfoFromHandle,
- setFileInfo,
- setFileInfoURI
- [_$_]
- ) where
-
-#if __GLASGOW_HASKELL__ >= 606 && __GLASGOW_HASKELL__ < 608
-#define OLD_BYTESTRING
-#endif
-
-import Control.Exception
-import Control.Monad (liftM)
-#if __GLASGOW_HASKELL__ >= 606
-import qualified Data.ByteString as BS (ByteString, useAsCStringLen)
-#ifdef OLD_BYTESTRING
-import qualified Data.ByteString.Base as BS (fromForeignPtr)
-#else
-import qualified Data.ByteString.Internal as BS (fromForeignPtr)
-#endif
-#endif
-import Prelude hiding (read, truncate)
-import System.Glib.FFI
-import System.Glib.UTFString (withUTFString, peekUTFString)
--- {#import System.Gnome.VFS.Types#}
-{#import System.Gnome.VFS.BasicTypes#}
-{#import System.Gnome.VFS.FileInfo#}
-{#import System.Gnome.VFS.Marshal#}
-
-{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-
--- | Open the file at @textURI@.
-open :: TextURI -- ^ @textURI@ -
- -> OpenMode -- ^ @openMode@ -
- -> IO Handle -- ^ a handle to the opened file
-open textURI openMode =
- let cOpenMode = cFromEnum openMode
- in withUTFString textURI $ \cTextURI ->
- newObjectResultMarshal Handle $ \cHandlePtr ->
- {# call gnome_vfs_open #} (castPtr cHandlePtr) cTextURI cOpenMode
-
--- | Open the file at @uri@.
-openURI :: URI -- ^ @uri@ -
- -> OpenMode -- ^ @openMode@ - [_$_]
- -> IO Handle -- ^ a handle to the opened file
-openURI uri openMode =
- let cOpenMode = cFromEnum openMode
- in newObjectResultMarshal Handle $ \cHandlePtr ->
- {# call open_uri #} (castPtr cHandlePtr) uri cOpenMode
-
--- | Create a file at @textURI@.
-create :: TextURI -- ^ @textURI@ - [_$_]
- -> OpenMode -- ^ @openMode@ - [_$_]
- -> Bool -- ^ @exclusive@ - [_$_]
- -> [FilePermissions] -- ^ @perm@ - [_$_]
- -> IO Handle -- ^ a handle to the created file
-create textURI openMode exclusive perm =
- let cOpenMode = cFromEnum openMode
- cExclusive = fromBool exclusive
- cPerm = cFromFlags perm
- in withUTFString textURI $ \cTextURI ->
- newObjectResultMarshal Handle $ \cHandlePtr ->
- {# call gnome_vfs_create #} (castPtr cHandlePtr) cTextURI cOpenMode cExclusive cPerm
-
--- | Create a file at @uri@.
-createURI :: URI -- ^ @uri@ - [_$_]
- -> OpenMode -- ^ @openMode@ - [_$_]
- -> Bool -- ^ @exclusive@ - [_$_]
- -> [FilePermissions] -- ^ @perm@ - [_$_]
- -> IO Handle -- ^ a handle to the created file
-createURI uri openMode exclusive perm =
- let cOpenMode = cFromEnum openMode
- cExclusive = fromBool exclusive
- cPerm = cFromFlags perm
- in newObjectResultMarshal Handle $ \cHandlePtr ->
- {# call create_uri #} (castPtr cHandlePtr) uri cOpenMode cExclusive cPerm
-
--- | Close a 'Handle'.
-close :: Handle -- ^ @handle@ - [_$_]
- -> IO ()
-close handle =
- voidResultMarshal $ {# call gnome_vfs_close #} handle
-
-#if __GLASGOW_HASKELL__ >= 606
--- | Read data from a file.
-read :: Handle -- ^ @handle@ - [_$_]
- -> FileSize -- ^ @bytes@ - [_$_]
- -> IO BS.ByteString -- ^ the data read from the file
-read handle bytes =
- let cBytes = fromIntegral bytes
- in do buffer <- mallocForeignPtrBytes $ fromIntegral bytes
- withForeignPtr buffer $ \cBuffer ->
- alloca $ \cBytesReadPtr ->
- genericResultMarshal
- (do poke cBytesReadPtr 0
- {# call gnome_vfs_read #} handle cBuffer cBytes cBytesReadPtr)
- (do bytesRead <- liftM fromIntegral $ peek cBytesReadPtr
- assert (bytesRead /= 0 || cBytes == 0) $ return ()
- return $ BS.fromForeignPtr (castForeignPtr buffer)
-#ifndef OLD_BYTESTRING
- 0
-#endif
- (fromIntegral bytes))
- (do bytesRead <- liftM fromIntegral $ peek cBytesReadPtr
- assert (bytesRead == 0) $ return ())
-
--- | Write data to a file.
-write :: Handle -- ^ @handle@ - [_$_]
- -> BS.ByteString -- ^ @byteString@ - [_$_]
- -> IO FileSize -- ^ the number of bytes actually written
-write handle byteString =
- BS.useAsCStringLen byteString $ \(cBuffer, bytes) ->
- let cBytes = fromIntegral bytes
- in alloca $ \cBytesWrittenPtr ->
- genericResultMarshal
- (do poke cBytesWrittenPtr 0
- {# call gnome_vfs_write #} handle (castPtr cBuffer) cBytes cBytesWrittenPtr)
- (do bytesWritten <- liftM fromIntegral $ peek cBytesWrittenPtr
- assert (bytesWritten /= 0 || cBytes == 0) $ return ()
- return bytesWritten)
- (do bytesWritten <- liftM fromIntegral $ peek cBytesWrittenPtr
- assert (bytesWritten == 0) $ return ())
-#endif
-
--- | Seek to a position in a file.
-seek :: Handle -- ^ @handle@ - [_$_]
- -> SeekPosition -- ^ @whence@ - [_$_]
- -> FileOffset -- ^ @offset@ - [_$_]
- -> IO ()
-seek handle whence offset =
- let cWhence = cFromEnum whence
- cOffset = fromIntegral offset
- in voidResultMarshal $ {# call gnome_vfs_seek #} handle cWhence cOffset
-
--- | Return the current position in the file.
-tell :: Handle -- ^ @handle@ - [_$_]
- -> IO FileSize -- ^ the current position in the file
-tell handle =
- alloca $ \cOffsetReturnPtr ->
- genericResultMarshal
- (do poke cOffsetReturnPtr 0
- {# call gnome_vfs_tell #} handle cOffsetReturnPtr)
- (liftM fromIntegral $ peek cOffsetReturnPtr)
- (do cOffsetReturn <- peek cOffsetReturnPtr
- assert (cOffsetReturn == 0) $ return ())
-
-#if GNOME_VFS_CHECK_VERSION(2,12,0)
--- | Free any cache associated with the file opened on @handle@,
--- in the region of @size@ bytes starting at @offset@.
-forgetCache :: Handle
- -> FileOffset
- -> FileSize
- -> IO ()
-forgetCache handle offset size =
- let cOffset = fromIntegral offset
- cSize = fromIntegral size
- in voidResultMarshal $ {# call forget_cache #} handle cOffset cSize
-#endif
-
--- | Truncate the file at @textURI@ to @length@ bytes.
-truncate :: String
- -> FileSize
- -> IO ()
-truncate textURI length =
- let cLength = fromIntegral length
- in withUTFString textURI $ \cTextURI ->
- voidResultMarshal $ {# call gnome_vfs_truncate #} cTextURI cLength
-
--- | Truncate the file at @uri@ to @length@ bytes.
-truncateURI :: URI
- -> FileSize
- -> IO ()
-truncateURI uri length =
- let cLength = fromIntegral length
- in voidResultMarshal $ {# call truncate_uri #} uri cLength
-
--- | Truncate the file opened on @handle@ to @length@ bytes.
-truncateHandle :: Handle
- -> FileSize
- -> IO ()
-truncateHandle handle length =
- let cLength = fromIntegral length
- in voidResultMarshal $ {# call truncate_handle #} handle cLength
-
--- | Get the file information for the file at @textURI@.
-getFileInfo :: String
- -> [FileInfoOptions]
- -> IO FileInfo
-getFileInfo textURI options =
- let cOptions = cFromFlags options
- in withUTFString textURI $ \cTextURI ->
- bracket {# call file_info_new #}
- {# call file_info_unref #}
- (\cFileInfo ->
- genericResultMarshal
- ({# call get_file_info #} cTextURI cFileInfo cOptions)
- (peek $ castPtr cFileInfo)
- (return ()))
-
--- | Get the file information for the file at @uri@.
-getFileInfoURI :: URI
- -> [FileInfoOptions]
- -> IO FileInfo
-getFileInfoURI uri options =
- let cOptions = cFromFlags options
- in bracket {# call file_info_new #}
- {# call file_info_unref #}
- (\cFileInfo ->
- genericResultMarshal
- ({# call get_file_info_uri #} uri cFileInfo cOptions)
- (peek $ castPtr cFileInfo)
- (return ()))
-
--- | Get the file information for the file opened on @handle@.
-getFileInfoFromHandle :: Handle
- -> [FileInfoOptions]
- -> IO FileInfo
-getFileInfoFromHandle handle options =
- let cOptions = cFromFlags options
- in bracket {# call file_info_new #}
- {# call file_info_unref #}
- (\cFileInfo ->
- genericResultMarshal
- ({# call get_file_info_from_handle #} handle cFileInfo cOptions)
- (peek $ castPtr cFileInfo)
- (return ()))
-
--- | Set the file information for the file at @textURI@.
-setFileInfo :: String
- -> FileInfo
- -> [SetFileInfoMask]
- -> IO ()
-setFileInfo textURI info mask =
- withUTFString textURI $ \cTextURI ->
- with info $ \cInfo ->
- voidResultMarshal $ {# call set_file_info #} cTextURI (castPtr cInfo) $ cFromFlags mask
-
--- | Set the file information for the file at @uri@.
-setFileInfoURI :: URI
- -> FileInfo
- -> [SetFileInfoMask]
- -> IO ()
-setFileInfoURI uri info mask =
- with info $ \cInfo ->
- voidResultMarshal $ {# call set_file_info_uri #} uri (castPtr cInfo) $ cFromFlags mask
rmfile ./gnomevfs/System/Gnome/VFS/Ops.chs
hunk ./gnomevfs/System/Gnome/VFS/URI.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.URI (
-
--- * Types [_$_]
- URI,
- ToplevelURI,
- TextURI,
- URIHideOptions(..),
-
--- * Operations
- uriFromString,
- uriResolveRelative,
-#if GNOME_VFS_CHECK_VERSION(2,16,0)
- uriResolveSymbolicLink,
-#endif
- uriAppendString,
- uriAppendPath,
- uriAppendFileName,
- uriToString,
- uriIsLocal,
- uriHasParent,
- uriGetParent,
- uriGetToplevel,
- uriGetHostName,
- uriGetScheme,
- uriGetHostPort,
- uriGetUserName,
- uriGetPassword,
- uriSetHostName,
- uriSetHostPort,
- uriSetUserName,
- uriSetPassword,
- uriEqual,
- uriIsParent,
- uriGetPath,
- uriGetFragmentIdentifier,
- uriExtractDirname,
- uriExtractShortName,
- uriExtractShortPathName,
- uriListParse,
- uriMakeFullFromRelative
- ) where
-
-import Control.Monad (liftM)
-{#import System.Gnome.VFS.Marshal#}
--- {#import System.Gnome.VFS.Types#}
-{#import System.Gnome.VFS.BasicTypes#}
-import System.Glib.FFI
-import System.Glib.UTFString
-{#import System.Glib.GList#}
-import System.IO (FilePath)
-
-{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-
--- | Create a new 'URI' from @textURI@. Unsupported and unsafe
--- methods are not allowed and will result in 'Nothing' being
--- returned. URL transforms are allowed.
-uriFromString :: TextURI
- -> Maybe URI
-uriFromString textURI = [_$_]
- unsafePerformIO $ withUTFString textURI {# call uri_new #} >>= maybePeek newURI
-
--- | Create a new uri from @relativeReference@, relative to
--- @base@. The resolution algorithm in some aspects follows RFC
--- 2396, section 5.2, but is not identical due to some extra
--- assumptions GnomeVFS makes about URIs.
--- [_$_]
--- If relative_reference begins with a valid scheme identifier
--- followed by @\':\'@, it is assumed to refer to an absolute URI, and a
--- 'URI' is created from it using 'uriFromString'.
--- [_$_]
--- Otherwise, depending on its precise syntax, it inherits some
--- aspects of the parent URI, but the parents' fragment and query
--- components are ignored.
--- [_$_]
--- If relative_reference begins with @\"\/\/\"@, it only inherits the
--- base scheme; if it begins with @\'\/\'@ (i.e., it is an absolute
--- path reference), it inherits everything except the base
--- path. Otherwise, it replaces the part of base after the last
--- @\'\/\'@.
--- [_$_]
--- Note: This function should not be used by application authors
--- unless they expect very distinct semantics. Instead, authors
--- should use 'uriAppendFileName', 'uriAppendPath',
--- 'uriAppendString' or 'uriResolveSymbolicLink'.
-uriResolveRelative :: URI -- ^ @base@ - the base URI
- -> String -- ^ @relativeReference@ - a string
- -- representing a possibly relative
- -- URI reference
- -> Maybe URI -- ^ a new URI referring to
- -- @relativeReference@, or 'Nothing'
- -- if @relativeReference@ is
- -- malformed.
-uriResolveRelative base relativeReference =
- unsafePerformIO $ (withUTFString relativeReference $
- {# call uri_resolve_relative #} base) >>= maybePeek newURI
-
-#if GNOME_VFS_CHECK_VERSION(2,16,0)
--- | Create a new uri from @symbolicLink@, relative to @base@.
--- [_$_]
--- If symbolic_link begins with a @\'\/\'@, it replaces the path of base,
--- otherwise it is appended after the last @\'\/\'@ character of base.
-uriResolveSymbolicLink :: URI
- -> String
- -> Maybe URI
-uriResolveSymbolicLink base symbolicLink =
- unsafePerformIO $ (withUTFString symbolicLink $
- {# call uri_resolve_symbolic_link #} base) >>= maybePeek newURI
-#endif
-
--- | Create a new URI obtained by appending @uriFragment@ to @uri@. This
--- will take care of adding an appropriate directory separator
--- between the end of @uri@ and the start of @uriFragment@ if
--- necessary.
--- [_$_]
--- This function will return 'Nothing' if the resulting URI is not
--- valid.
-uriAppendString :: URI -- ^ @uri@ - the base URI
- -> String -- ^ @uriFragment@ - an escaped URI fragment
- -> Maybe URI -- ^ the new URI
-uriAppendString uri uriFragment =
- unsafePerformIO $ (withUTFString uriFragment $
- {# call uri_append_string #} uri) >>= maybePeek newURI
-
--- | Create a new uri obtained by appending @path@ to @uri@. This will
--- take care of adding an appropriate directory separator between
--- the end of @uri@ and the start of @path@ if necessary, as well as
--- escaping @path@ as necessary.
--- [_$_]
--- This function will return 'Nothing' if the resulting URI is not
--- valid.
-uriAppendPath :: URI -- ^ @uri@ - the base URI
- -> FilePath -- ^ @path@ - a non-escaped file path
- -> Maybe URI -- ^ the new URI
-uriAppendPath uri path =
- unsafePerformIO $ (withUTFString path $
- {# call uri_append_path #} uri) >>= maybePeek newURI
-
--- | Create a new URI obtained by appending @fileName@ to @uri@. This
--- will take care of adding an appropriate directory separator
--- between the end of @uri@ and the start of @fileName@ if
--- necessary. @fileName@ might, for instance, be the result of a call
--- to 'System.Posix.Directory.readDirStream'.
--- [_$_]
--- This function will return 'Nothing' if the resulting URI is not
--- valid.
-uriAppendFileName :: URI
- -> FilePath
- -> Maybe URI
-uriAppendFileName uri fileName =
- unsafePerformIO $ (withUTFString fileName $
- {# call uri_append_file_name #} uri) >>= maybePeek newURI
-
--- | Translate @uri@ into a printable string. The string will not
--- contain the URI elements specified by @hideOptions@.
--- [_$_]
--- A @file:@ URI on Win32 might look like
--- @file:\/\/\/x:\/foo\/bar.txt@. Note that the part after
--- @file:\/\/@ is not a legal file name, you need to remove the @\/@
--- in front of the drive letter. This function does that
--- automatically if @hideOptions@ specifies that the toplevel
--- method, user name, password, host name and host port should be
--- hidden.
--- [_$_]
--- On the other hand, a @file:@ URI for a UNC path looks like
--- @file:\/\/\/\/server\/share\/foo\/bar.txt@, and in that case the part
--- after @file:\/\/@ is the correct file name.
-uriToString :: URI -- ^ @uri@ - a URI
- -> URIHideOptions -- ^ @hideOptions@ - the URI elements that should not be included in the resulting string
- -> TextURI -- ^ the resulting string
-uriToString uri hideOptions =
- unsafePerformIO $ ({# call uri_to_string #} uri $
- cFromEnum hideOptions) >>= readUTFString
-
--- | Check if @uri@ is a local URI. Note that the return value of this
--- function entirely depends on the method associated with
--- the URI. It is up to the method author to distinguish between
--- remote URIs and URIs referring to entities on the local computer.
--- [_$_]
--- Warning, this can be slow, as it does I\/O to detect things like
--- NFS mounts.
-uriIsLocal :: URI -- ^ @uri@ - [_$_]
- -> IO Bool -- ^ 'True' if @uri@ is local, 'False' otherwise
-uriIsLocal uri =
- liftM toBool $ {# call uri_is_local #} uri
-
--- | Check whether @uri@ has a parent or not.
-uriHasParent :: URI -- ^ @uri@ - [_$_]
- -> Bool -- ^ 'True' if @uri@ has a parent, 'False' otherwise
-uriHasParent uri =
- unsafePerformIO $ liftM toBool $ {# call uri_has_parent #} uri
-
--- | Retrieve @uri@... parent URI.
-uriGetParent :: URI -- ^ @uri@ - [_$_]
- -> Maybe URI -- ^ the parent URI, or 'Nothing' if @uri@ has no parent
-uriGetParent uri =
- unsafePerformIO $ {# call uri_get_parent #} uri >>= maybePeek newURI
-
--- | Retrieve @uri@... toplevel URI.
-uriGetToplevel :: URI -- ^ @uri@ - [_$_]
- -> ToplevelURI -- ^ the toplevel URI
-uriGetToplevel uri =
- unsafePerformIO $ {# call uri_get_toplevel #} uri >>= newToplevelURI
-
--- | Retrieve the hostname for @uri@.
-uriGetHostName :: URI -- ^ @uri@ -
- -> Maybe String -- ^ the hostname, or 'Nothing' if @uri@ has no hostname
-uriGetHostName uri =
- unsafePerformIO $ {# call uri_get_host_name #} uri >>= (maybePeek peekUTFString)
-
--- | Retrieve the scheme for @uri@.
-uriGetScheme :: URI -- ^ @uri@ - [_$_]
- -> Maybe String -- ^ the scheme, or 'Nothing' if @uri@ has no scheme
-uriGetScheme uri =
- unsafePerformIO $ {# call uri_get_scheme #} uri >>= (maybePeek peekUTFString)
-
--- | Retrieve the host port for @uri@.
-uriGetHostPort :: URI -- ^ @uri@ - [_$_]
- -> Word -- ^ the host port, or @0@ if the default port
- -- value for the specified toplevel access
- -- method is used
-uriGetHostPort uri =
- unsafePerformIO $ liftM cToEnum $ {# call uri_get_host_port #} uri
-
--- | Retrieve the user name for @uri@.
-uriGetUserName :: URI -- ^ @uri@ - [_$_]
- -> Maybe String -- ^ the user name, or 'Nothing' if @uri@ has no user name
-uriGetUserName uri =
- unsafePerformIO $ {# call uri_get_user_name #} uri >>= (maybePeek peekUTFString)
-
--- | Retrieve the password for @uri@.
-uriGetPassword :: URI -- ^ @uri@ - [_$_]
- -> Maybe String -- ^ the password, or 'Nothing' if @uri@ has no password
-uriGetPassword uri =
- unsafePerformIO $ {# call uri_get_password #} uri >>= (maybePeek peekUTFString)
-
-marshalSet :: (URI -> a -> IO ())
- -> URI
- -> a
- -> URI
-marshalSet setAction uri newVal =
- unsafePerformIO $ do uri <- {# call uri_dup #} uri >>= newURI
- setAction uri newVal
- return uri
-
--- | Create a new 'URI' using @uri@, replacing the host name by @hostName@.
-uriSetHostName :: URI -- ^ @uri@ - [_$_]
- -> Maybe String -- ^ @hostName@ - the new hostname
- -> URI -- ^ the resulting URI
-uriSetHostName =
- marshalSet $ \uri hostName ->
- maybeWith withUTFString hostName $ {# call uri_set_host_name #} uri
-
--- | Create a new 'URI' using @uri@, replacing the host port by @hostPort@.
--- [_$_]
--- If @hostPort@ is @0@, use the default port for @uri@... toplevel
--- access method.
-uriSetHostPort :: URI -- ^ @uri@ - [_$_]
- -> Word -- ^ @hostPort@ - the new host port
- -> URI -- ^ the resulting URI
-uriSetHostPort =
- marshalSet $ \uri hostPort ->
- {# call uri_set_host_port #} uri $ cFromEnum hostPort
-
--- | Create a new 'URI' using @uri@, replacing the user name by @userName@.
-uriSetUserName :: URI -- ^ @uri@ - [_$_]
- -> Maybe String -- ^ @userName@ - the new user name
- -> URI -- ^ the resulting URI
-uriSetUserName =
- marshalSet $ \uri userName ->
- maybeWith withUTFString userName $ {# call uri_set_user_name #} uri
-
--- | Create a new 'URI' using @uri@, replacing the password by @password@.
-uriSetPassword :: URI -- ^ @uri@ - [_$_]
- -> Maybe String -- ^ @password@ - the new password
- -> URI -- ^ the resulting URI
-uriSetPassword =
- marshalSet $ \uri password ->
- maybeWith withUTFString password $ {# call uri_set_password #} uri
-
--- | Compare two 'URI's for equality.
-uriEqual :: URI -- ^ @a@ - [_$_]
- -> URI -- ^ @b@ - [_$_]
- -> Bool -- ^ 'True' if the URIs are the same, 'False' otherwise.
-uriEqual a b =
- unsafePerformIO $ liftM toBool $ {# call uri_equal #} a b
-
--- | Check if @possibleChild@ is contained in @possibleParent@. If
--- @recursive@ is 'False', just try the immediate parent; otherwise
--- search up through the heirarchy.
-uriIsParent :: URI -- ^ @possibleParent@ - [_$_]
- -> URI -- ^ @possibleChild@ -
- -> Bool -- ^ @recursive@ - 'True' if parents should be
- -- checked recursively, 'False' otherwise
- -> Bool -- ^ 'True' if @possibleChild@ is contained in
- -- @possibleParent@, otherwise 'False'
-uriIsParent possibleParent possibleChild recursive =
- unsafePerformIO $ liftM toBool $
- {# call uri_is_parent #} possibleParent possibleChild $ fromBool recursive
-
--- | Retrieve the path name for @uri@.
-uriGetPath :: URI -- ^ @uri@ - [_$_]
- -> Maybe FilePath -- ^ the path name, or 'Nothing' if @uri@
- -- has no path name
-uriGetPath uri =
- unsafePerformIO $ {# call uri_get_path #} uri >>= (maybePeek peekUTFString)
-
--- | Retrieve the fragment identifier for @uri@.
-uriGetFragmentIdentifier :: URI -- ^ @uri@ - [_$_]
- -> Maybe String -- ^ the fragment identifier,
- -- or 'Nothing' if @uri@
- -- has no fragment
- -- identifier
-uriGetFragmentIdentifier uri =
- unsafePerformIO $ {# call uri_get_fragment_identifier #} uri >>= (maybePeek peekUTFString)
-
--- | Extract the name of the directory in which the file pointed to by
--- @uri@ is stored as a string. The string will end with a directory
--- separator.
-uriExtractDirname :: URI -- ^ @uri@ - [_$_]
- -> Maybe FilePath -- ^ the directory name, or
- -- 'Nothing' if @uri@ has no
- -- directory name
-uriExtractDirname uri =
- unsafePerformIO $ {# call uri_extract_dirname #} uri >>= (maybePeek readUTFString)
-
-
--- | Retrieve base file name for @uri@, ignoring any trailing path
--- separators. This matches the XPG definition of basename, but not
--- 'System.FilePath.basename'. This is often useful when you want
--- the name of something that's pointed to by a URI, and don't care
--- whether the uri has a directory or file form. If @uri@ points to
--- the root of a domain, returns the host name. If there's no host
--- name, returns the path separator.
--- [_$_]
--- See also: 'uriExtractShortPathName'.
-uriExtractShortName :: URI -- ^ @uri@ - [_$_]
- -> String -- the unescaped short form of the name
-uriExtractShortName uri =
- unsafePerformIO $ {# call uri_extract_short_name #} uri >>= readUTFString
-
--- | Retrieve base file name for @uri@, ignoring any trailing path
--- separators. This matches the XPG definition of basename, but not
--- 'System.FilePath.basename'. This is often useful when you want
--- the name of something that's pointed to by a URI, and don't care
--- whether the uri has a directory or file form. If @uri@ points to
--- the root of any domain, returns the path separator.
--- [_$_]
--- See also: 'uriExtractShortName'.
-uriExtractShortPathName :: URI -- ^ @uri@ - [_$_]
- -> String -- the
-uriExtractShortPathName uri =
- unsafePerformIO $ {# call uri_extract_short_path_name #} uri >>= readUTFString
-
--- | Extracts a list of URIs from a standard @text\/uri-list@, such as
--- one would get on a drop operation.
-uriListParse :: String -- ^ @uriList@ - a list of URIs, separated by newlines
- -> [URI] -- ^ the list of URIs
-uriListParse uriList =
- unsafePerformIO $ do uriList <- withUTFString uriList $ \cURIList ->
- {# call uri_list_parse #} cURIList >>= fromGList
- sequence $ map newURI uriList
-
--- | Returns a full URI given a full base URI, and a secondary URI
--- which may be relative.
-uriMakeFullFromRelative :: String -- ^ @baseURI@ - [_$_]
- -> String -- ^ @relativeURI@ - [_$_]
- -> Maybe String -- ^ the resulting URI
-uriMakeFullFromRelative baseURI relativeURI =
- unsafePerformIO $ (withUTFString baseURI $ \cBaseURI ->
- withUTFString relativeURI $ \cRelativeURI ->
- {# call uri_make_full_from_relative #} cBaseURI cRelativeURI) >>= maybePeek readUTFString
rmfile ./gnomevfs/System/Gnome/VFS/URI.chs
hunk ./gnomevfs/System/Gnome/VFS/Util.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Util (
-
--- * String Formatting Functions
- formatFileSizeForDisplay,
- formatURIForDisplay,
-
--- * External Applications
- urlShow,
- urlShowWithEnv,
- isExecutableCommandString,
- [_$_]
--- * String Escaping Functions
- escapeString,
- escapePathString,
- escapeHostAndPathString,
- escapeSlashes,
- escapeSet,
- unescapeString,
- unescapeStringForDisplay,
-
--- * 'TextURI' and Path Functions
- makeURICanonical,
- makeURICanonicalStripFragment,
- makePathNameCanonical,
- makeURIFromInput,
- makeURIFromInputWithDirs,
- makeURIFromShellArg,
- expandInitialTilde,
- getLocalPathFromURI,
- getURIFromLocalPath,
- iconPathFromFilename,
- getVolumeFreeSpace,
- urisMatch,
- getURIScheme,
-
--- * Miscellaneous Functions
- isPrimaryThread,
- openFD,
- [_$_]
- ) where
-
-import Control.Exception (assert)
-import Control.Monad (liftM)
-import System.Posix.Types (Fd)
-import System.Glib.FFI
-import System.Glib.UTFString
--- {#import System.Gnome.VFS.Types#}
-{#import System.Gnome.VFS.BasicTypes#}
-{#import System.Gnome.VFS.Marshal#}
-
-{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-
--- | Formats @size@ so that it is easy for the user to read. Gives the
--- size in bytes, kilobytes, megabytes or gigabytes, choosing
--- whatever is appropriate.
-formatFileSizeForDisplay :: FileSize -- ^ @size@ - the file size to be formatted
- -> String -- ^ the formatted size ready for display
-formatFileSizeForDisplay size =
- unsafePerformIO $ {# call format_file_size_for_display #} (fromIntegral size) >>= readUTFString
-
--- | Filter, modify, unescape, and change @textURI@ to make it appropriate
--- for display to users.
--- [_$_]
--- Rules: A @file:@ URI without fragments should appear as a local
--- path. A @file:@ URI with fragments should appear as @file:uri@. All
--- other URIs appear as expected.
-formatURIForDisplay :: TextURI -- ^ @textURI@ - the URI to format
- -> Maybe String -- ^ the formatted URI ready for display
-formatURIForDisplay textURI =
- unsafePerformIO $ withUTFString textURI {# call format_uri_for_display #} >>= maybePeek readUTFString
-
--- | Launches the default application or component associated with the
--- given URL.
-urlShow :: String -- ^ @url@ - the URL to launch an application for
- -> IO ()
-urlShow url =
- voidResultMarshal $ withUTFString url {# call url_show #}
-
--- | Like 'urlShow', but using the specified environment variables.
-urlShowWithEnv :: String -- ^ @url@ - the URL to launch an application for
- -> [String] -- ^ @env@ - a list of strings @[\"VARIABLE1=value1\", \"VARIABLE2=value2\", ...]@
- -> IO ()
-urlShowWithEnv url env =
- voidResultMarshal $ withUTFStringArray env $ \cEnv ->
- withUTFString url $ \cURL ->
- {# call url_show_with_env #} cURL cEnv
-
-marshalPureString :: IO CString
- -> String
-marshalPureString cAction =
- unsafePerformIO $ cAction >>= readUTFString
-
-marshalPureMaybeString :: IO CString
- -> Maybe String
-marshalPureMaybeString cAction =
- unsafePerformIO $ cAction >>= maybePeek readUTFString
-
--- | Escapes @string@, replacing any and all special characters with
--- equivalent escape sequences.
-escapeString :: String -- ^ @string@ - the string to be escaped
- -> String -- the escaped string
-escapeString string =
- marshalPureString $ withUTFString string {# call escape_string #}
-
--- | Escapes path, replacing only special characters that would not be
--- found in paths (so @\'\/\'@, @\'&\'@, and @\'=\'@ will not be escaped by this
--- function).
-escapePathString :: FilePath -- ^ @path@ - the path string to be escaped
- -> String -- ^ the escaped string
-escapePathString path =
- marshalPureString $ withUTFString path {# call escape_path_string #}
-
--- | Escapes path, replacing only special characters that would not be
--- found in a path or host name (so @\'\/\'@, @\'&\'@, @\'=\'@, @\':\'@ and @\'\@\'@ will
--- not be escaped by this function).
-escapeHostAndPathString :: FilePath -- ^ @path@ - the path to be escaped
- -> String -- ^ the escaped string
-escapeHostAndPathString path =
- marshalPureString $ withUTFString path {# call escape_host_and_path_string #}
-
--- | Escapes only @\'\/\'@ and @\'%\'@ characters in @string@, replacing
--- them with their escape sequence equivalents.
-escapeSlashes :: String -- ^ @string@ - the string to be escaped
- -> String -- ^ the escaped string
-escapeSlashes string =
- marshalPureString $ withUTFString string {# call escape_slashes #}
-
--- | Escapes the characters listed in @matchSet@ in @string@.
-escapeSet :: String -- ^ @string@ - the string to be escaped
- -> String -- ^ @matchSet@ - the characters to escape
- -> String -- ^ the escaped string
-escapeSet string matchSet =
- marshalPureString $ withUTFString matchSet $ \cMatchSet ->
- withUTFString string $ \cString ->
- {# call escape_set #} cString cMatchSet
-
--- | Decodes escaped characters (i.e., @%xx@ sequences) in
--- @escapedString@. Characters are decoded in @%xx@ form, where
--- @xx@ is the hex code for an ASCII character.
-unescapeString :: String -- @string@ - the string to be unescaped
- -> String -- @illegalCharacters@ - the characters that must not be escaped
- -> String -- ^ the unescaped string
-unescapeString escapedString illegalCharacters =
- marshalPureString $ withUTFString illegalCharacters $ \cIllegalCharacters ->
- withUTFString escapedString $ \cEscapedString ->
- {# call unescape_string #} cEscapedString cIllegalCharacters
-
--- | Standardizes the format of @uri@, so that it can be used later
--- in other functions that expect a canonical URI.
-makeURICanonical :: TextURI -- ^ @textURI@ - an absolute or relative URI; it may have a scheme
- -> Maybe TextURI -- ^ the canonical representation of the URI
-makeURICanonical textURI =
- unsafePerformIO $ withUTFString textURI {# call make_uri_canonical #} >>= maybePeek readUTFString
-
--- | Returns a canonicalized URI. If @uri@ contains a fragment
--- (anything after a @\'#\'@), it is stripped off, and the resulting
--- URI is made canonical.
-makeURICanonicalStripFragment :: TextURI -- ^ @textURI@ - the URI to canonicalize
- -> Maybe TextURI -- ^ the canonical representation of the URI
-makeURICanonicalStripFragment textURI =
- unsafePerformIO $ withUTFString textURI {# call make_uri_canonical_strip_fragment #} >>= maybePeek readUTFString
-
-
--- | Returns a canonicalized path name.
-makePathNameCanonical :: FilePath -- ^ @pathName@ - the path name to canonicalize
- -> Maybe TextURI -- ^ the canonicalized path name
-makePathNameCanonical pathName =
- unsafePerformIO $ withUTFString pathName {# call make_path_name_canonical #} >>= maybePeek readUTFString
-
--- | Takes a user input path\/URI and makes a valid URI out of it.
--- [_$_]
--- This function is the reverse of 'formatURIForDisplay'.
-makeURIFromInput :: String -- ^ @location@ - the input to try to parse
- -> Maybe TextURI -- ^ the resulting URI, or 'Nothing' if @location@ is invalid
-makeURIFromInput location =
- unsafePerformIO $ withUTFString location {# call make_uri_from_input #} >>= maybePeek readUTFString
-
--- | Determine a fully qualified URI from a relative or absolute input
--- path. The directories specified by @dirs@ are searched when the
--- path is relative.
-makeURIFromInputWithDirs :: FilePath -- ^ @location@ - the relative or absolute input path to resolve
- -> [MakeURIDirs] -- ^ @dirs@ - the directories to search
- -> IO TextURI -- ^ the resulting URI
-makeURIFromInputWithDirs location dirs =
- (withUTFString location $ flip {# call make_uri_from_input_with_dirs #} $ cFromFlags dirs) >>= readUTFString
-
--- | Similar to 'makeURIFromInput', except:
--- [_$_]
--- 1. guesses relative paths instead of HTTP domains
--- [_$_]
--- 2. doesn\'t bother stripping leading\/trailing white space
--- [_$_]
--- 3. doesn\'t bother with tilde expansion -- that\'s done by the shell
-makeURIFromShellArg :: String
- -> String
-makeURIFromShellArg uri =
- unsafePerformIO $ withUTFString uri {# call make_uri_from_shell_arg #} >>= readUTFString
-
--- | If @path@ begins with a tilde, representing the user's home
--- directory, expand it to the actual directory.
-expandInitialTilde :: String
- -> IO String
-expandInitialTilde path =
- withUTFString path {# call expand_initial_tilde #} >>= readUTFString
-
--- | Similar to @unescapeString@, but returns something
--- semi-intelligible to the user, even upon receiving traumatic
--- input such as @00@ or URIs in bad form.
--- [_$_]
--- WARNING: You should never use this function on a whole URI! It
--- unescapes reserved characters, and can result in a mangled URI
--- that can not be re-entered. For example, it unescapes @\'#\'@, @\'&\'@ and
--- @\'?\'@, which have special meanings in URI strings.
-unescapeStringForDisplay :: String
- -> String
-unescapeStringForDisplay escaped =
- marshalPureString $ withUTFString escaped {# call unescape_string_for_display #}
-
--- | Create a local path for a uri.
---
--- If @uri@ is not a @file:\/\/\/@ URI, or it contains a fragment
--- identifier or is chained, this function returns 'Nothing'.
-getLocalPathFromURI :: TextURI -- ^ the URI to convert
- -> Maybe FilePath -- ^ the resulting path
-getLocalPathFromURI uri =
- marshalPureMaybeString $ withUTFString uri {# call get_local_path_from_uri #}
-
--- | Returns a @file:\/\/\/@ URI for the local path @localFullPath@,
--- such as a path provided by
--- 'Graphics.UI.Gtk.Selectors.FileChooser.fileChooserGetFilename'. The
--- resulting URI may be provided, for instance, to
--- 'System.Gnome.VFS.URI.uriFromString'.
--- [_$_]
--- On Windows @localFullPath@ should be in the UTF-8 encoding, and
--- can start with a drive letter, but doesn't have to.
-getURIFromLocalPath :: FilePath -- ^ @localFullPath@ - [_$_]
- -> TextURI -- ^ the resulting URI
-getURIFromLocalPath localFullPath =
- marshalPureString $ withUTFString localFullPath {# call get_uri_from_local_path #}
-
--- | Checks if @commandString@ starts with the full path of an
--- executable file or an executable in the system path.
-isExecutableCommandString :: String -- ^ @commandString@ - [_$_]
- -> IO Bool -- 'True' is @commandString@ is an executable command string, otherwise 'False'
-isExecutableCommandString commandString =
- liftM toBool $ withUTFString commandString {# call is_executable_command_string #}
-
--- | Stores the amount of free space in bytes on @uri@... volume in
--- | size.
-getVolumeFreeSpace :: URI -- ^ @uri@ - a URI to a file on a volume
- -> IO FileSize -- ^ the free space in bytes on the volume
-getVolumeFreeSpace uri =
- alloca $ \cFileSizePtr ->
- genericResultMarshal ({# call get_volume_free_space #} uri cFileSizePtr)
- (liftM fromIntegral $ peek cFileSizePtr)
- (do cFileSize <- peek cFileSizePtr
- assert (cFileSize == 0) $ return ())
-
--- | Returns the icon path for @filename@. Example:
--- [_$_]
--- @'iconPathFromFilename' \"nautilus\/nautilus-desktop.png\"@ will
--- return a string forming the full path of the file
--- @nautilus-desktop.png@, i.e.
--- @${prefix}\/share\/pixmaps\/nautilus\/nautilus-desktop.png@.
-iconPathFromFilename :: String -- ^ @filename@ - a relative or absolute pathname
- -> IO String -- ^ the absolute path to the icon file
-iconPathFromFilename filename =
- withUTFString filename {# call icon_path_from_filename #} >>= readUTFString
-
--- | Check if the current thread is the thread with the main glib
--- event loop.
-isPrimaryThread :: IO Bool -- ^ 'True' if the current thread is the
- -- thread with the main glib event loop,
- -- otherwise 'False'
-isPrimaryThread =
- liftM toBool {# call is_primary_thread #}
-
--- | Retrieves the scheme used in @uri@.
-getURIScheme :: TextURI -- ^ @uri@ - [_$_]
- -> Maybe String -- ^ the scheme used in @uri@, or 'Nothing' if @uri@ does not use a scheme
-getURIScheme uri =
- marshalPureMaybeString $ withUTFString uri {# call get_uri_scheme #}
-
--- | Compare two URIs.
-urisMatch :: TextURI -- ^ @uri1@ - [_$_]
- -> TextURI -- ^ @uri2@ - [_$_]
- -> Bool -- ^ 'True' if the URIs are the same, 'False' otherwise.
-urisMatch uri1 uri2 =
- unsafePerformIO $ liftM toBool $ withUTFString uri1 $ \cURI1 ->
- withUTFString uri2 $ {# call uris_match #} cURI1
-
--- | Convert an open unix file descriptor into a 'Handle' object.
-openFD :: Fd -- ^ @filedes@ - the file descriptor to use
- -> IO Handle -- ^ the returned handle
-openFD filedes =
- newObjectResultMarshal Handle $ \cHandlePtr ->
- {# call open_fd #} (castPtr cHandlePtr) $ fromIntegral filedes
rmfile ./gnomevfs/System/Gnome/VFS/Util.chs
hunk ./gnomevfs/System/Gnome/VFS/Volume.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Volume (
- [_$_]
--- * Types
- -- | An abstraction for a mounted filesystem or network location.
- Volume,
- VolumeClass,
- VolumeID,
- -- | Safely cast an object to a 'Volume'.
- castToVolume,
- [_$_]
--- * Volume Operations
- volumeCompare,
- volumeEject,
- volumeGetActivationURI,
- volumeGetDevicePath,
- volumeGetDeviceType,
- volumeGetDisplayName,
- volumeGetDrive,
- volumeGetFilesystemType,
-#if GNOME_VFS_CHECK_VERSION(2,8,0)
- volumeGetHalUDI,
-#endif
- volumeGetIcon,
- volumeGetID,
- volumeGetVolumeType,
- volumeHandlesTrash,
- volumeIsMounted,
- volumeIsReadOnly,
- volumeIsUserVisible,
- volumeUnmount
- [_$_]
- ) where
-
-import Control.Exception
-import Control.Monad (liftM)
-import System.Glib.UTFString
-import System.Glib.FFI
-{#import System.Gnome.VFS.Marshal#}
-{#import System.Gnome.VFS.Types#}
-{#import System.Gnome.VFS.BasicTypes#}
-
-{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-
--- | Compares two 'Volume' objects @a@ and @b@. Two 'Volume'
--- objects referring to different volumes are guaranteed to not
--- return 'EQ' when comparing them. If they refer to the same volume '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 volumes (ZIP, floppy)
--- [_$_]
--- * Optical volumes (CD, DVD)
--- [_$_]
--- * External volumes (USB sticks, music players)
--- [_$_]
--- * Mounted hard disks
--- [_$_]
--- * Network mounts
--- [_$_]
--- * Other volumes
--- [_$_]
--- Afterwards, the display name of @a@ and @b@ is compared using a
--- locale-sensitive sorting algorithm.
--- [_$_]
--- If two volumes have the same display name, their unique ID is
--- compared which can be queried using 'volumeGetID'.
-volumeCompare :: (VolumeClass volume1, VolumeClass volume2)
- => volume1
- -> volume2
- -> IO Ordering
-volumeCompare a b =
- do result <- liftM fromIntegral $ {# call volume_compare #} (castToVolume a) (castToVolume b)
- let ordering | result < 0 = LT
- | result > 0 = GT
- | otherwise = EQ
- return ordering
-
--- Requests ejection of a 'Volume'.
--- [_$_]
--- Before the unmount operation is executed, the
--- 'Volume' object's @pre-unmount@ signal is emitted.
--- [_$_]
--- If the volume is a mount point, i.e. its type is
--- 'VolumeTypeMountpoint', it is unmounted, and if it refers to a
--- disk, it is also ejected.
--- [_$_]
--- If the volume is a special VFS mount, i.e. its type is
--- 'VolumeTypeMount', it is ejected.
--- [_$_]
--- If the volume is a connected server, it is removed from the list of
--- connected servers.
--- [_$_]
--- Otherwise, no further action is done.
-volumeEject :: VolumeClass volume
- => volume -- ^ @volume@ - the volume to eject
- -> VolumeOpSuccessCallback -- ^ @successCallback@ - the
- -- callback to call once
- -- the operation has
- -- completed successfully
- -> VolumeOpFailureCallback -- ^ @failureCallback@ - the
- -- callback to call if the
- -- operation fails
- -> IO ()
-volumeEject volume successCallback failureCallback =
- do cCallback <- volumeOpCallbackMarshal successCallback failureCallback
- {# call volume_eject #} (castToVolume volume) cCallback $ castFunPtrToPtr cCallback
-
-marshalString cAction volume =
- cAction (castToVolume volume) >>= readUTFString
-marshalMaybeString cAction volume =
- cAction (castToVolume volume) >>= maybePeek readUTFString
-
--- | Returns the activation URI of @volume@.
--- [_$_]
--- The returned URI usually refers to a valid location. You can
--- check the validity of the location by calling
--- 'System.Gnome.VFS.URI.uriFromString' with the URI, and checking
--- whether the return value is not 'Nothing'.
-volumeGetActivationURI :: VolumeClass volume
- => volume -- ^ @volume@ - the volume to query
- -> IO TextURI -- ^ the volume's activation URI.
-volumeGetActivationURI =
- marshalString {# call volume_get_activation_uri #}
-
--- | Returns the device path of a 'Volume' object.
--- [_$_]
--- For HAL volumes, this returns the value of the volume's
--- @block.device@ key. For UNIX mounts, it returns the @mntent@...
--- @mnt_fsname@ entry.
--- [_$_]
--- Otherwise, it returns 'Nothing'.
-volumeGetDevicePath :: VolumeClass volume =>
- volume -- ^ @volume@ - the volume object to query
- -> IO String -- ^ the volume's device path
-volumeGetDevicePath =
- marshalString {# call volume_get_device_path #}
-
--- | Returns the 'DeviceType' of a 'Volume' object.
-volumeGetDeviceType :: VolumeClass volume =>
- volume -- ^ @volume@ - the volume object to query
- -> IO DeviceType -- the volume's device type
-volumeGetDeviceType volume =
- liftM cToEnum $ {# call volume_get_device_type #} (castToVolume volume)
-
--- | Returns the display name of a 'Volume' object.
-volumeGetDisplayName :: VolumeClass volume =>
- volume -- ^ @volume@ - the volume object to query
- -> IO String -- ^ the volume's display name
-volumeGetDisplayName =
- marshalString {# call volume_get_display_name #}
-
--- | Returns the 'Drive' that @volume@ is on.
-volumeGetDrive :: VolumeClass volume =>
- volume -- ^ @volume@ - the volume object to query
- -> IO Drive -- ^ the containing drive
-volumeGetDrive volume =
- {# call volume_get_drive #} (castToVolume volume) >>= newDrive
-
--- | Returns a string describing the file system on @volume@, or
--- 'Nothing' if no information on the underlying file system is
--- available.
--- [_$_]
--- The file system may be used to provide special functionality that
--- depends on the file system type, for instance to determine
--- whether trashing is supported (cf. 'volumeHandlesTrash').
--- [_$_]
--- For HAL mounts, this returns the value of the @\"volume.fstype\"@
--- key, for traditional UNIX mounts it is set to the mntent's
--- mnt_type key, for connected servers, 'Nothing' is returned.
-volumeGetFilesystemType :: VolumeClass volume =>
- volume -- ^ @volume@ - the
- -- volume object to query
- -> IO (Maybe String) -- ^ a string describing
- -- the filesystem type,
- -- or 'Nothing' if no
- -- information is
- -- available
-volumeGetFilesystemType =
- marshalMaybeString {# call volume_get_filesystem_type #}
-
-#if GNOME_VFS_CHECK_VERSION(2,8,0)
--- | Returns the HAL UDI of a 'Volume' object.
--- [_$_]
--- For HAL volumes, this matches the value of the @info.udi@ key,
--- for other volumes it is 'Nothing'.
-volumeGetHalUDI :: VolumeClass volume =>
- volume -- ^ @volume@ - the volume object to query
- -> IO (Maybe String) -- ^ the volume's HAL UDI
-volumeGetHalUDI =
- marshalMaybeString {# call volume_get_hal_udi #}
-#endif
-
--- | Returns the icon filename for a 'Volume' object.
-volumeGetIcon :: VolumeClass volume =>
- volume -- ^ @volume@ - a volume object
- -> IO FilePath -- ^ the icon that should be used for this volume
-volumeGetIcon =
- marshalString {# call volume_get_icon #}
-
--- | Returns a unique identifier for a 'Volume' object.
-volumeGetID :: VolumeClass volume =>
- volume -- ^ @volume@ - a volume object
- -> IO VolumeID -- ^ a unique identifier for the volume
-volumeGetID volume =
- {# call volume_get_id #} (castToVolume volume)
-
--- | Returns the volume type of @volume@.
-volumeGetVolumeType :: VolumeClass volume =>
- volume -- ^ @volume@ - the volume object to query
- -> IO VolumeType -- ^ the volume's volume type
-volumeGetVolumeType volume =
- liftM cToEnum $ {# call volume_get_volume_type #} (castToVolume volume)
-
-marshalBool cAction volume =
- liftM toBool $ cAction (castToVolume volume)
-
--- | Returns whether the file system on a volume supports trashing of
--- files.
--- [_$_]
--- If the volume has an AutoFS file system (i.e.,
--- 'volumeGetDeviceType' returns 'DeviceTypeAutofs'), or if the
--- volume is mounted read-only (i.e., 'volumeIsReadOnly' returns
--- 'True'), it is assumed to not support trashing of files.
--- [_$_]
--- Otherwise, if the volume provides file system information, it is
--- determined whether the file system supports trashing of
--- files.
-volumeHandlesTrash :: VolumeClass volume =>
- volume -- ^ @volume@ - [_$_]
- -> IO Bool -- ^ 'True' if the volume handles trash, otherwise 'False'
-volumeHandlesTrash =
- marshalBool {# call volume_handles_trash #}
-
--- | Returns whether the file system on a volume is currently mounted.
--- [_$_]
--- For HAL volumes, this reflects the value of the
--- @\"volume.is_mounted\"@ key, for traditional UNIX mounts and
--- connected servers, 'True' is returned, because their existence
--- implies that they are mounted.
-volumeIsMounted :: VolumeClass volume =>
- volume -- ^ @volume@ - [_$_]
- -> IO Bool -- ^ 'True' if the volume is mounted, otherwise 'False'
-volumeIsMounted =
- marshalBool {# call volume_is_mounted #}
-
--- | Returns whether the file system on a volume is read-only.
--- [_$_]
--- For HAL volumes, the @\"volume.is_mounted_read_only\"@ key is
--- authoritative, for traditional UNIX mounts it returns TRUE if the
--- mount was done with the @\"ro\"@ option. For servers, 'False' is
--- returned.
-volumeIsReadOnly :: VolumeClass volume =>
- volume -- ^ @volume@ - [_$_]
- -> IO Bool -- ^ 'True' if the volume is read-only, otherwise 'False'
-volumeIsReadOnly =
- marshalBool {# call volume_is_read_only #}
-
--- | Returns a 'Bool' for whether a volume is user-visible. This should
--- be used by applications to determine whether the volume should be
--- listed in user interfaces listing available volumes.
-volumeIsUserVisible :: VolumeClass volume =>
- volume -- @volume@ - [_$_]
- -> IO Bool -- ^ 'True' if the volume is user visible, otherwise 'False'
-volumeIsUserVisible =
- marshalBool {# call volume_is_user_visible #}
-
--- Requests unmount of a 'Volume'.
--- [_$_]
--- Note that 'volumeUnmount' may also unvoke 'volumeEject', if
--- @volume@ signals that it should be ejected when it is unmounted.
--- This may be true for CD-ROMs, USB sticks, and other devices,
--- depending on the backend providing the volume.
-volumeUnmount :: VolumeClass volume
- => volume -- ^ @volume@ - the volume to eject
- -> VolumeOpSuccessCallback -- ^ @successCallback@ - the
- -- callback to call once
- -- the operation has
- -- completed successfully
- -> VolumeOpFailureCallback -- ^ @failureCallback@ - the
- -- callback to call if the
- -- operation fails
- -> IO ()
-volumeUnmount volume successCallback failureCallback =
- do cCallback <- volumeOpCallbackMarshal successCallback failureCallback
- {# call volume_unmount #} (castToVolume volume) cCallback $ castFunPtrToPtr cCallback
rmfile ./gnomevfs/System/Gnome/VFS/Volume.chs
hunk ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.VolumeMonitor (
- [_$_]
--- * Types
- [_$_]
- -- | An object that monitors volume mounts and unmounts.
- VolumeMonitor,
- VolumeMonitorClass,
- [_$_]
--- * Values
- volumeMonitor,
- [_$_]
--- * Operations
- volumeMonitorGetConnectedDrives,
- volumeMonitorGetDriveByID,
- volumeMonitorGetMountedVolumes,
- volumeMonitorGetVolumeByID,
- volumeMonitorGetVolumeForPath,
- [_$_]
- onVolumeMonitorVolumeMounted,
- afterVolumeMonitorVolumeMounted,
- onVolumeMonitorVolumePreUnmount,
- afterVolumeMonitorVolumePreUnmount,
- onVolumeMonitorVolumeUnmounted,
- afterVolumeMonitorVolumeUnmounted
- [_$_]
- ) where
-
-import Control.Exception
-import Control.Monad (liftM)
-import System.Glib.FFI
-import System.Glib.GList (readGList)
-import System.Glib.UTFString
-import System.Gnome.VFS.Marshal
-{#import System.Gnome.VFS.Types#}
-{#import System.Gnome.VFS.Signals#}
-{#import System.Gnome.VFS.BasicTypes#}
-import System.IO (FilePath)
-
-{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-
--- | The global volume monitor object.
-volumeMonitor :: VolumeMonitor
-volumeMonitor = unsafePerformIO $ {# call get_volume_monitor #} >>= wrapVolumeMonitor
-
--- | Returns a list of all drives connected to the machine.
-volumeMonitorGetConnectedDrives :: VolumeMonitorClass volumeMonitor =>
- volumeMonitor -- ^ @volumeMonitor@ - the volume monitor
- -> IO [Drive] -- ^ the drives connected to the machine
-volumeMonitorGetConnectedDrives volumeMonitor =
- {# call volume_monitor_get_connected_drives #} (castToVolumeMonitor volumeMonitor) >>=
- readGList >>= mapM newDrive
-
--- | Try to find the 'Drive' with ID @id@.
-volumeMonitorGetDriveByID :: VolumeMonitorClass volumeMonitor =>
- 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
-volumeMonitorGetDriveByID volumeMonitor id =
- {# call volume_monitor_get_drive_by_id #} (castToVolumeMonitor volumeMonitor) id >>=
- maybePeek newDrive
-
--- | Returns a list of all volumes currently mounted on the machine.
-volumeMonitorGetMountedVolumes :: VolumeMonitorClass volumeMonitor =>
- volumeMonitor -- ^ @volumeMonitor@ - the volume monitor
- -> IO [Volume] -- ^ the volumes
- -- currently mounted
- -- on the machine
-volumeMonitorGetMountedVolumes volumeMonitor =
- {# call volume_monitor_get_mounted_volumes #} (castToVolumeMonitor volumeMonitor) >>=
- readGList >>= mapM newVolume
-
--- | Try to find the 'Volume' with ID @id@.
-volumeMonitorGetVolumeByID :: VolumeMonitorClass volumeMonitor =>
- 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
-volumeMonitorGetVolumeByID volumeMonitor id =
- {# call volume_monitor_get_volume_by_id #} (castToVolumeMonitor volumeMonitor) id >>=
- maybePeek newVolume
-
--- | 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.
-volumeMonitorGetVolumeForPath :: VolumeMonitorClass volumeMonitor =>
- 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
-volumeMonitorGetVolumeForPath volumeMonitor path =
- (withUTFString path $ {# call volume_monitor_get_volume_for_path #} (castToVolumeMonitor volumeMonitor)) >>=
- maybePeek newVolume
-
-onVolumeMonitorDriveConnected,
- afterVolumeMonitorDriveConnected,
- onVolumeMonitorDriveDisconnected,
- afterVolumeMonitorDriveDisconnected,
- onVolumeMonitorVolumeMounted,
- afterVolumeMonitorVolumeMounted,
- onVolumeMonitorVolumePreUnmount,
- afterVolumeMonitorVolumePreUnmount,
- onVolumeMonitorVolumeUnmounted,
- afterVolumeMonitorVolumeUnmounted
- :: (VolumeMonitorClass volumeMonitor) =>
- volumeMonitor -- ^ @volumeMonitor@ - the volume monitor
- -> (Volume -> IO ()) -- ^ @handler@ - the signal handling function
- -> IO (ConnectId volumeMonitor) -- ^ the identifier for the connection
-
-onVolumeMonitorDriveConnected = connect_OBJECT__NONE "drive-connected" False
-afterVolumeMonitorDriveConnected = connect_OBJECT__NONE "drive-connected" True
-
-onVolumeMonitorDriveDisconnected = connect_OBJECT__NONE "drive-disconnected" False
-afterVolumeMonitorDriveDisconnected = connect_OBJECT__NONE "drive-disconnected" True
-
-onVolumeMonitorVolumeMounted = connect_OBJECT__NONE "volume-mounted" False
-afterVolumeMonitorVolumeMounted = connect_OBJECT__NONE "volume-mounted" True
-
-onVolumeMonitorVolumePreUnmount = connect_OBJECT__NONE "volume-pre-unmount" False
-afterVolumeMonitorVolumePreUnmount = connect_OBJECT__NONE "volume-pre-unmount" True
-
-onVolumeMonitorVolumeUnmounted = connect_OBJECT__NONE "volume-unmounted" False
-afterVolumeMonitorVolumeUnmounted = connect_OBJECT__NONE "volume-unmounted" True
rmfile ./gnomevfs/System/Gnome/VFS/VolumeMonitor.chs
hunk ./gnomevfs/System/Gnome/VFS/Xfer.chs 1
-{-# LANGUAGE CPP #-}
--- 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 Lesser General Public License
--- as published by the Free Software Foundation, either version 3 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.
--- [_$_]
--- You should have received a copy of the GNU Lesser General Public
--- License along with this program. If not, see
--- <http://www.gnu.org/licenses/>.
--- [_$_]
--- GnomeVFS, the C library which this Haskell library depends on, is
--- available under LGPL Version 2. The documentation included with
--- this library is based on the original GnomeVFS documentation,
--- Copyright (c) 2001 Seth Nickell <snickell@...>. The
--- documentation is covered by the GNU Free Documentation License,
--- version 1.2.
--- [_$_]
--- | Maintainer : gtk2hs-devel@...
--- Stability : alpha
--- Portability : portable (depends on GHC)
-module System.Gnome.VFS.Xfer (
- [_$_]
--- * Types
- XferProgressInfo(..),
- XferOptions ( XferFollowLinks
- , XferRecursive
- , XferSamefs
- , XferDeleteItems
- , XferEmptyDirectories
- , XferNewUniqueDirectory
- , XferRemovesource
- , XferUseUniqueNames
- , XferLinkItems
- , XferFollowLinksRecursive
-#if GNOME_VFS_CHECK_VERSION(2,12,0)
- , XferTargetDefaultPerms [_$_]
-#endif
- ),
- XferOverwriteMode ( XferOverwriteModeAbort
- , XferOverwriteModeReplace
- , XferOverwriteModeSkip ),
- XferErrorAction(..),
- XferOverwriteAction(..),
- XferProgressCallback,
- XferErrorCallback,
- XferOverwriteCallback,
- XferDuplicateCallback,
- [_$_]
--- * Operations
- xferURI,
- xferURIList,
- xferDeleteList
- [_$_]
- ) where
-
-import Control.Monad
-import Data.Maybe (fromMaybe)
-import System.Glib.FFI
-import System.Glib.GList
-import System.Glib.UTFString
-{#import System.Gnome.VFS.Marshal#}
--- {#import System.Gnome.VFS.Types#}
-{#import System.Gnome.VFS.BasicTypes#}
-
-{# context lib = "gnomevfs" prefix = "gnome_vfs" #}
-
-{- typedef struct {
- - GnomeVFSXferProgressStatus status;
- - GnomeVFSResult vfs_status;
- - GnomeVFSXferPhase phase;
- - gchar *source_name;
- - gchar *target_name;
- - gulong file_index;
- - gulong files_total;
- - GnomeVFSFileSize bytes_total;
- - GnomeVFSFileSize file_size;
- - GnomeVFSFileSize bytes_copied;
- - GnomeVFSFileSize total_bytes_copied;
- - gchar *duplicate_name;
- - int duplicate_count;
- - gboolean top_level_item;
- - } GnomeVFSXferProgressInfo;
- -}
-
-instance Storable XferProgressInfo where
- sizeOf _ = {# sizeof GnomeVFSXferProgressInfo #}
- alignment _ = alignment (undefined :: CString)
- peek ptr =
- do vfsStatus <- liftM cToEnum $ {# get GnomeVFSXferProgressInfo->vfs_status #} ptr
- phase <- liftM cToEnum $ {# get GnomeVFSXferProgressInfo->phase #} ptr
- sourceName <- {# get GnomeVFSXferProgressInfo->source_name #} ptr >>= maybePeek peekUTFString
- targetName <- {# get GnomeVFSXferProgressInfo->target_name #} ptr >>= maybePeek peekUTFString
- fileIndex <- liftM fromIntegral $ {# get GnomeVFSXferProgressInfo->file_index #} ptr
- filesTotal <- liftM fromIntegral $ {# get GnomeVFSXferProgressInfo->files_total #} ptr
- bytesTotal <- liftM fromIntegral $ {# get GnomeVFSXferProgressInfo->bytes_total #} ptr
- fileSize <- liftM fromIntegral $ {# get GnomeVFSXferProgressInfo->file_size #} ptr
- bytesCopied <- liftM fromIntegral $ {# get GnomeVFSXferProgressInfo->bytes_copied #} ptr
- totalBytesCopied <- liftM fromIntegral $ {# get GnomeVFSXferProgressInfo->total_bytes_copied #} ptr
- topLevelItem <- liftM toBool $ {# get GnomeVFSXferProgressInfo->top_level_item #} ptr
- [_$_]
- return $ XferProgressInfo vfsStatus
- phase
- sourceName
- targetName
- fileIndex
- filesTotal
- bytesTotal
- fileSize
- bytesCopied
- totalBytesCopied
- topLevelItem
- poke _ = error "XferProgressInfo.poke not implemented"
-
-type CXferProgressCallback = Ptr ()
- -> {# type gpointer #}
- -> IO CInt
-xferProgressCallbackMarshal :: Maybe XferProgressCallback
- -> XferErrorCallback
- -> XferOverwriteCallback
- -> Maybe XferDuplicateCallback
- -> IO (FunPtr CXferProgressCallback)
-xferProgressCallbackMarshal progressCallback
- errorCallback
- overwriteCallback
- duplicateCallback =
- makeXferProgressCallback cCallback
- where cCallback :: CXferProgressCallback
- cCallback cInfo cUserData =
- do status <- liftM cToEnum $ {# get GnomeVFSXferProgressInfo->status #} $ castPtr cInfo
- info <- peek $ castPtr cInfo
- case status of
- XferProgressStatusOk ->
- liftM fromBool $ progressCallback' info
- XferProgressStatusVfserror ->
- liftM cFromEnum $ errorCallback info
- XferProgressStatusOverwrite ->
- liftM cFromEnum $ overwriteCallback info
- XferProgressStatusDuplicate ->
- do duplicateCount <- liftM fromIntegral $ {# get GnomeVFSXferProgressInfo->duplicate_count #} cInfo
- duplicatePtr <- {# get GnomeVFSXferProgressInfo->duplicate_name #} cInfo
- duplicateName <- peekUTFString duplicatePtr
- newDuplicateName <- duplicateCallback' info duplicateName duplicateCount
- case newDuplicateName of
- Just newDuplicateName' ->
- do {# call g_free #} $ castPtr duplicatePtr
- newUTFString newDuplicateName' >>=
- {# set GnomeVFSXferProgressInfo->duplicate_name #} cInfo
- return 1
- Nothing ->
- return 0
- progressCallback' =
- fromMaybe (const $ return True) progressCallback
- duplicateCallback' =
- fromMaybe (\_ name _ -> return Nothing) duplicateCallback
-
-foreign import ccall safe "wrapper"
- makeXferProgressCallback :: CXferProgressCallback
- -> IO (FunPtr CXferProgressCallback)
-
-type CXfer = {# type GnomeVFSXferOptions #}
- -> {# type GnomeVFSXferErrorMode #}
- -> {# type GnomeVFSXferOverwriteMode #}
- -> FunPtr CXferProgressCallback
- -> {# type gpointer #}
- -> IO {# type GnomeVFSResult #}
-type Xfer = [XferOptions]
- -> Maybe XferProgressCallback
- -> Maybe XferErrorCallback
- -> Either XferOverwriteMode XferOverwriteCallback
- -> Maybe XferDuplicateCallback
- -> IO ()
-marshalXfer :: CXfer
- -> Xfer
-marshalXfer cXfer xferOptions progressCallback errorCallback overwriteOpt duplicateCallback =
- voidResultMarshal $ do
- cProgressCallback <- xferProgressCallbackMarshal
- progressCallback
- errorCallback'
- overwriteCallback
- duplicateCallback
- cResult <- cXfer (cFromFlags xferOptions)
- (cFromEnum errorMode)
- (cFromEnum overwriteMode)
- cProgressCallback nullPtr
- freeHaskellFunPtr cProgressCallback
- return cResult
- where [_$_]
- (overwriteMode, overwriteCallback) =
- case overwriteOpt of
- Left overwriteMode ->
- (overwriteMode,
- const $ return $ error "marshalXfer: overwrite callback called unexpectedly")
- Right overwriteCallback ->
- (XferOverwriteModeQuery,
- overwriteCallback)
- (errorMode, errorCallback') =
- case errorCallback of
- Just errorCallback' ->
- (XferErrorModeQuery,
- errorCallback')
- Nothing ->
- (XferErrorModeAbort,
- const $ return $ error "marshalXfer: error callback called unexpectedly")
-
--- | Transfer the file located at @sourceURI@ to @targetURI@, using [_$_]
--- the specified options and callbacks.
-xferURI :: URI -- ^ @sourceURI@ - the source URI
- -> URI -- ^ @targetURI@ - the target URI
- -> [XferOptions] -- ^ @options@ - [_$_]
- -> Maybe XferProgressCallback -- ^ @progressCallback@ - [_$_]
- -> Maybe XferErrorCallback -- ^ @errorCallback@ - [_$_]
- -> Either XferOverwriteMode XferOverwriteCallback -- ^ @overwriteOpt@ - [_$_]
- -> Maybe XferDuplicateCallback -- ^ @duplicateCallback@ - [_$_]
- -> IO ()
-xferURI sourceURI targetURI =
- marshalXfer ({# call xfer_uri #} sourceURI targetURI)
-
-withURIList :: [URI]
- -> (GList -> IO a)
- -> IO a
-withURIList uriList action =
- withMany withURI uriList $ \cURIList ->
- toGList cURIList >>= action
-
--- | For each pair in @sourceTargetURIList@, transfer the file at the
--- first 'URI' to the second 'URI'.
-xferURIList :: [(URI, URI)] -- ^ @sourceTargetURIList@ - [_$_]
- -> [XferOptions] -- ^ @options@ - [_$_]
- -> Maybe XferProgressCallback -- ^ @progressCallback@ - [_$_]
- -> Maybe XferErrorCallback -- ^ @errorCallback@ - [_$_]
- -> Either XferOverwriteMode XferOverwriteCallback -- ^ @overwriteOpt@ - [_$_]
- -> Maybe XferDuplicateCallback -- ^ @duplicateCallback@ - [_$_]
- -> IO ()
-xferURIList sourceTargetURIList xferOptions progressCallback errorCallback overwriteOpt duplicateCallback =
- withURIList sourceURIList $ \cSourceURIList ->
- withURIList targetURIList $ \cTargetURIList ->
- marshalXfer ({# call xfer_uri_list #} cSourceURIList cTargetURIList) [_$_]
- xferOptions progressCallback
- errorCallback overwriteOpt duplicateCallback
- where (sourceURIList, targetURIList) = unzip sourceTargetURIList
-
--- | Delete the files at the 'URI's in @sourceURIList@.
-xferDeleteList :: [URI] -- ^ @sourceURIList@ - [_$_]
- -> [XferOptions] -- ^ @options@ - [_$_]
- -> Maybe XferProgressCallback -- ^ @progressCallback@ - [_$_]
- -> Maybe XferErrorCallback -- ^ @errorCallback@ - [_$_]
- -> IO ()
-xferDeleteList sourceURIList xferOptions progressCallback errorCallback =
- withURIList sourceURIList $ \cSourceURIList ->
- do cProgressCallback <- xferProgressCallbackMarshal progressCallback
- errorCallback'
- (return $ error "xferDeleteList: overwrite callback called unexpectedly")
- (return $ error "xferDeleteList: duplicate callback called unexpectedly")
- voidResultMarshal $
- {# call xfer_delete_list #}
- cSourceURIList
- (cFromEnum errorMode)
- (cFromFlags xferOptions)
- cProgressCallback
- nullPtr
- where (errorMode, errorCallback') =
- case errorCallback of
- Just errorCallback' ->
- (XferErrorModeQuery,
- errorCallback')
- Nothing ->
- (XferErrorModeAbort,
- const $ return XferErrorActionAbort)
rmfile ./gnomevfs/System/Gnome/VFS/Xfer.chs
hunk ./gnomevfs/System/Gnome/VFS/hsfileinfo.c 1
-/* GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-c-*-
- *
- * 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 Lesser General Public License
- * as published by the Free Software Foundation, either version 3 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.
- * [_$_]
- * You should have received a copy of the GNU Lesser General Public
- * License along with this program. If not, see
- * <http://www.gnu.org/licenses/>.
- * [_$_]
- * GnomeVFS, the C library which this Haskell library depends on, is
- * available under LGPL Version 2. The documentation included with
- * this library is based on the original GnomeVFS documentation,
- * Copyright (c) 2001 Seth Nickell <snickell@...>. The
- * documentation is covered by the GNU Free Documentation License,
- * version 1.2.
- */
-
-#include "hsfileinfo.h"
-
-GnomeVFSFileType
-_hs_gnome_vfs_file_info_get_type (const GnomeVFSFileInfo *file_info)
-{ return file_info->type; }
-
-GnomeVFSInodeNumber
-_hs_gnome_vfs_file_info_get_inode (const GnomeVFSFileInfo *file_info)
-{ return file_info->inode; }
-GnomeVFSFileSize
-_hs_gnome_vfs_file_info_get_size (const GnomeVFSFileInfo *file_info)
-{ return file_info->size; }
-GnomeVFSFileSize
-_hs_gnome_vfs_file_info_get_block_count (const GnomeVFSFileInfo *file_info)
-{ return file_info->block_count; }
-
-void
-_hs_gnome_vfs_file_info_set_type (GnomeVFSFileInfo *file_info,
- GnomeVFSFileType type)
-{ file_info->type = type; }
-void
-_hs_gnome_vfs_file_info_set_inode (GnomeVFSFileInfo *file_info,
- GnomeVFSInodeNumber inode)
-{ file_info->inode = inode; }
-void
-_hs_gnome_vfs_file_info_set_size (GnomeVFSFileInfo *file_info,
- GnomeVFSFileSize size)
-{ file_info->size = size; }
-void
-_hs_gnome_vfs_file_info_set_block_count (GnomeVFSFileInfo *file_info,
- GnomeVFSFileSize block_count)
-{ file_info->block_count = block_count; }
rmfile ./gnomevfs/System/Gnome/VFS/hsfileinfo.c
hunk ./gnomevfs/System/Gnome/VFS/hsfileinfo.h 1
-/* GIMP Toolkit (GTK) Binding for Haskell: binding to libgnomevfs -*-c-*-
- *
- * 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 Lesser General Public License
- * as published by the Free Software Foundation, either version 3 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.
- * [_$_]
- * You should have received a copy of the GNU Lesser General Public
- * License along with this program. If not, see
- * <http://www.gnu.org/licenses/>.
- * [_$_]
- * GnomeVFS, the C library which this Haskell library depends on, is
- * available under LGPL Version 2. The documentation included with
- * this library is based on the original GnomeVFS documentation,
- * Copyright (c) 2001 Seth Nickell <snickell@...>. The
- * documentation is covered by the GNU Free Documentation License,
- * version 1.2.
- */
-
-#include <libgnomevfs/gnome-vfs-file-info.h>
-
-/* This is a stub to work around C2HS tripping over "type" as the
- field name. */
-GnomeVFSFileType
-_hs_gnome_vfs_file_info_get_type (const GnomeVFSFileInfo *file_info);
-
-/* C2HS doesn't seem to realize GnomeVFSFileSize should be long long */
-GnomeVFSInodeNumber
-_hs_gnome_vfs_file_info_get_inode (const GnomeVFSFileInfo *file_info);
-GnomeVFSFileSize
-_hs_gnome_vfs_file_info_get_size (const GnomeVFSFileInfo *file_info);
-GnomeVFSFileSize
-_hs_gnome_vfs_file_info_get_block_count (const GnomeVFSFileInfo *file_info);
-
-void
-_hs_gnome_vfs_file_info_set_type (GnomeVFSFileInfo *file_info,
- GnomeVFSFileType type);
-
-void
-_hs_gnome_vfs_file_info_set_inode (GnomeVFSFileInfo *file_info,
- GnomeVFSInodeNumber inode);
-void
-_hs_gnome_vfs_file_info_set_size (GnomeVFSFileInfo *file_info,
- GnomeVFSFileSize size);
-void
-_hs_gnome_vfs_file_info_set_block_count (GnomeVFSFileInfo *file_info,
- GnomeVFSFileSize block_count);
rmfile ./gnomevfs/System/Gnome/VFS/hsfileinfo.h
rmdir ./gnomevfs/System/Gnome/VFS
rmdir ./gnomevfs/System/Gnome
rmdir ./gnomevfs/System
hunk ./gnomevfs/COPYING 1
- GNU LESSER GENERAL PUBLIC LICENSE
- Version 2.1, February 1999
-
- Copyright (C) 1991, 1999 Free Software Foundation, Inc.
- 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
-[This is the first released version of the Lesser GPL. It also counts
- as the successor of the GNU Library Public License, version 2, hence
- the version number 2.1.]
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-Licenses are intended to guarantee your freedom to share and change
-free software--to make sure the software is free for all its users.
-
- This license, the Lesser General Public License, applies to some
-specially designated software packages--typically libraries--of the
-Free Software Foundation and other authors who decide to use it. You
-can use it too, but we suggest you first think carefully about whether
-this license or the ordinary General Public License is the better
-strategy to use in any particular case, based on the explanations below.
-
- When we speak of free software, we are referring to freedom of use,
-not price. Our General Public Licenses are designed to make sure that
-you have the freedom to distribute copies of free software (and charge
-for this service if you wish); that you receive source code or can get
-it if you want it; that you can change the software and use pieces of
-it in new free programs; and that you are informed that you can do
-these things.
-
- To protect your rights, we need to make restrictions that forbid
-distributors to deny you these rights or to ask you to surrender these
-rights. These restrictions translate to certain responsibilities for
-you if you distribute copies of the library or if you modify it.
-
- For example, if you distribute copies of the library, whether gratis
-or for a fee, you must give the recipients all the rights that we gave
-you. You must make sure that they, too, receive or can get the source
-code. If you link other code with the library, you must provide
-complete object files to the recipients, so that they can relink them
-with the library after making changes to the library and recompiling
-it. And you must show them these terms so they know their rights.
-
- We protect your rights with a two-step method: (1) we copyright the
-library, and (2) we offer you this license, which gives you legal
-permission to copy, distribute and/or modify the library.
-
- To protect each distributor, we want to make it very clear that
-there is no warranty for the free library. Also, if the library is
-modified by someone else and passed on, the recipients should know
-that what they have is not the original version, so that the original
-author's reputation will not be affected by problems that might be
-introduced by others.
-[_^L_][_$_]
- Finally, software patents pose a constant threat to the existence of
-any free program. We wish to make sure that a company cannot
-effectively restrict the users of a free program by obtaining a
-restrictive license from a patent holder. Therefore, we insist that
-any patent license obtained for a version of the library must be
-consistent with the full freedom of use specified in this license.
-
- Most GNU software, including some libraries, is covered by the
-ordinary GNU General Public License. This license, the GNU Lesser
-General Public License, applies to certain designated libraries, and
-is quite different from the ordinary General Public License. We use
-this license for certain libraries in order to permit linking those
-libraries into non-free programs.
-
- When a program is linked with a library, whether statically or using
-a shared library, the combination of the two is legally speaking a
-combined work, a derivative of the original library. The ordinary
-General Public License therefore permits such linking only if the
-entire combination fits its criteria of freedom. The Lesser General
-Public License permits more lax criteria for linking other code with
-the library.
-
- We call this license the "Lesser" General Public License because it
-does Less to protect the user's freedom than the ordinary General
-Public License. It also provides other free software developers Less
-of an advantage over competing non-free programs. These disadvantages
-are the reason we use the ordinary General Public License for many
-libraries. However, the Lesser license provides advantages in certain
-special circumstances.
-
- For example, on rare occasions, there may be a special need to
-encourage the widest possible use of a certain library, so that it becomes
-a de-facto standard. To achieve this, non-free programs must be
-allowed to use the library. A more frequent case is that a free
-library does the same job as widely used non-free libraries. In this
-case, there is little to gain by limiting the free library to free
-software only, so we use the Lesser General Public License.
-
- In other cases, permission to use a particular library in non-free
-programs enables a greater number of people to use a large body of
-free software. For example, permission to use the GNU C Library in
-non-free programs enables many more people to use the whole GNU
-operating system, as well as its variant, the GNU/Linux operating
-system.
-
- Although the Lesser General Public License is Less protective of the
-users' freedom, it does ensure that the user of a program that is
-linked with the Library has the freedom and the wherewithal to run
-that program using a modified version of the Library.
-
- The precise terms and conditions for copying, distribution and
-modification follow. Pay close attention to the difference between a
-"work based on the library" and a "work that uses the library". The
-former contains code derived from the library, whereas the latter must
-be combined with the library in order to run.
-[_^L_][_$_]
- GNU LESSER GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License Agreement applies to any software library or other
-program which contains a notice placed by the copyright holder or
-other authorized party saying it may be distributed under the terms of
-this Lesser General Public License (also called "this License").
-Each licensee is addressed as "you".
-
- A "library" means a collection of software functions and/or data
-prepared so as to be conveniently linked with application programs
-(which use some of those functions and data) to form executables.
-
- The "Library", below, refers to any such software library or work
-which has been distributed under these terms. A "work based on the
-Library" means either the Library or any derivative work under
-copyright law: that is to say, a work containing the Library or a
-portion of it, either verbatim or with modifications and/or translated
-straightforwardly into another language. (Hereinafter, translation is
-included without limitation in the term "modification".)
-
- "Source code" for a work means the preferred form of the work for
-making modifications to it. For a library, complete source code means
-all the source code for all modules it contains, plus any associated
-interface definition files, plus the scripts used to control compilation
-and installation of the library.
-
- Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running a program using the Library is not restricted, and output from
-such a program is covered only if its contents constitute a work based
-on the Library (independent of the use of the Library in a tool for
-writing it). Whether that is true depends on what the Library does
-and what the program that uses the Library does.
- [_$_]
- 1. You may copy and distribute verbatim copies of the Library's
-complete source code as you receive it, in any medium, provided that
-you conspicuously and appropriately publish on each copy an
-appropriate copyright notice and disclaimer of warranty; keep intact
-all the notices that refer to this License and to the absence of any
-warranty; and distribute a copy of this License along with the
-Library.
-
- You may charge a fee for the physical act of transferring a copy,
-and you may at your option offer warranty protection in exchange for a
-fee.
-[_^L_][_$_]
- 2. You may modify your copy or copies of the Library or any portion
-of it, thus forming a work based on the Library, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) The modified work must itself be a software library.
-
- b) You must cause the files modified to carry prominent notices
- stating that you changed the files and the date of any change.
-
- c) You must cause the whole of the work to be licensed at no
- charge to all third parties under the terms of this License.
-
- d) If a facility in the modified Library refers to a function or a
- table of data to be supplied by an application program that uses
- the facility, other than as an argument passed when the facility
- is invoked, then you must make a good faith effort to ensure that,
- in the event an application does not supply such function or
- table, the facility still operates, and performs whatever part of
- its purpose remains meaningful.
-
- (For example, a function in a library to compute square roots has
- a purpose that is entirely well-defined independent of the
- application. Therefore, Subsection 2d requires that any
- application-supplied function or table used by this function must
- be optional: if the application does not supply it, the square
- root function must still compute square roots.)
-
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Library,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Library, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote
-it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Library.
-
-In addition, mere aggregation of another work not based on the Library
-with the Library (or with a work based on the Library) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may opt to apply the terms of the ordinary GNU General Public
-License instead of this License to a given copy of the Library. To do
-this, you must alter all the notices that refer to this License, so
-that they refer to the ordinary GNU General Public License, version 2,
-instead of to this License. (If a newer version than version 2 of the
-ordinary GNU General Public License has appeared, then you can specify
-that version instead if you wish.) Do not make any other change in
-these notices.
-[_^L_][_$_]
- Once this change is made in a given copy, it is irreversible for
-that copy, so the ordinary GNU General Public License applies to all
-subsequent copies and derivative works made from that copy.
-
- This option is useful when you wish to copy part of the code of
-the Library into a program that is not a library.
-
- 4. You may copy and distribute the Library (or a portion or
-derivative of it, under Section 2) in object code or executable form
-under the terms of Sections 1 and 2 above provided that you accompany
-it with the complete corresponding machine-readable source code, which
-must be distributed under the terms of Sections 1 and 2 above on a
-medium customarily used for software interchange.
-
- If distribution of object code is made by offering access to copy
-from a designated place, then offering equivalent access to copy the
-source code from the same place satisfies the requirement to
-distribute the source code, even though third parties are not
-compelled to copy the source along with the object code.
-
- 5. A program that contains no derivative of any portion of the
-Library, but is designed to work with the Library by being compiled or
-linked with it, is called a "work that uses the Library". Such a
-work, in isolation, is not a derivative work of the Library, and
-therefore falls outside the scope of this License.
-
- However, linking a "work that uses the Library" with the Library
-creates an executable that is a derivative of the Library (because it
-contains portions of the Library), rather than a "work that uses the
-library". The executable is therefore covered by this License.
-Section 6 states terms for distribution of such executables.
-
- When a "work that uses the Library" uses material from a header file
-that is part of the Library, the object code for the work may be a
-derivative work of the Library even though the source code is not.
-Whether this is true is especially significant if the work can be
-linked without the Library, or if the work is itself a library. The
-threshold for this to be true is not precisely defined by law.
-
- If such an object file uses only numerical parameters, data
-structure layouts and accessors, and small macros and small inline
-functions (ten lines or less in length), then the use of the object
-file is unrestricted, regardless of whether it is legally a derivative
-work. (Executables containing this object code plus portions of the
-Library will still fall under Section 6.)
-
- Otherwise, if the work is a derivative of the Library, you may
-distribute the object code for the work under the terms of Section 6.
-Any executables containing that work also fall under Section 6,
-whether or not they are linked directly with the Library itself.
-[_^L_][_$_]
- 6. As an exception to the Sections above, you may also combine or
-link a "work that uses the Library" with the Library to produce a
-work containing portions of the Library, and distribute that work
-under terms of your choice, provided that the terms permit
-modification of the work for the customer's own use and reverse
-engineering for debugging such modifications.
-
- You must give prominent notice with each copy of the work that the
-Library is used in it and that the Library and its use are covered by
-this License. You must supply a copy of this License. If the work
-during execution displays copyright notices, you must include the
-copyright notice for the Library among them, as well as a reference
-directing the user to the copy of this License. Also, you must do one
-of these things:
-
- a) Accompany the work with the complete corresponding
- machine-readable source code for the Library including whatever
- changes were used in the work (which must be distributed under
- Sections 1 and 2 above); and, if the work is an executable linked
- with the Library, with the complete machine-readable "work that
- uses the Library", as object code and/or source code, so that the
- user can modify the Library and then relink to produce a modified
- executable containing the modified Library. (It is understood
- that the user who changes the contents of definitions files in the
- Library will not necessarily be able to recompile the application
- to use the modified definitions.)
-
- b) Use a suitable shared library mechanism for linking with the
- Library. A suitable mechanism is one that (1) uses at run time a
- copy of the library already present on the user's computer system,
- rather than copying library functions into the executable, and (2)
- will operate properly with a modified version of the library, if
- the user installs one, as long as the modified version is
- interface-compatible with the version that the work was made with.
-
- c) Accompany the work with a written offer, valid for at
- least three years, to give the same user the materials
- specified in Subsection 6a, above, for a charge no more
- than the cost of performing this distribution.
-
- d) If distribution of the work is made by offering access to copy
- from a designated place, offer equivalent access to copy the above
- specified materials from the same place.
-
- e) Verify that the user has already received a copy of these
- materials or that you have already sent this user a copy.
-
- For an executable, the required form of the "work that uses the
-Library" must include any data and utility programs needed for
-reproducing the executable from it. However, as a special exception,
-the materials to be distributed need not include anything that is
-normally distributed (in either source or binary form) with the major
-components (compiler, kernel, and so on) of the operating system on
-which the executable runs, unless that component itself accompanies
-the executable.
-
- It may happen that this requirement contradicts the license
-restrictions of other proprietary libraries that do not normally
-accompany the operating system. Such a contradiction means you cannot
-use both them and the Library together in an executable that you
-distribute.
-[_^L_][_$_]
- 7. You may place library facilities that are a work based on the
-Library side-by-side in a single library together with other library
-facilities not covered by this License, and distribute such a combined
-library, provided that the separate distribution of the work based on
-the Library and of the other library facilities is otherwise
-permitted, and provided that you do these two things:
-
- a) Accompany the combined library with a copy of the same work
- based on the Library, uncombined with any other library
- facilities. This must be distributed under the terms of the
- Sections above.
-
- b) Give prominent notice with the combined library of the fact
- that part of it is a work based on the Library, and explaining
- where to find the accompanying uncombined form of the same work.
-
- 8. You may not copy, modify, sublicense, link with, or distribute
-the Library except as expressly provided under this License. Any
-attempt otherwise to copy, modify, sublicense, link with, or
-distribute the Library is void, and will automatically terminate your
-rights under this License. However, parties who have received copies,
-or rights, from you under this License will not have their licenses
-terminated so long as such parties remain in full compliance.
-
- 9. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Library or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Library (or any work based on the
-Library), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Library or works based on it.
-
- 10. Each time you redistribute the Library (or any work based on the
-Library), the recipient automatically receives a license from the
-original licensor to copy, distribute, link with or modify the Library
-subject to these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties with
-this License.
-[_^L_][_$_]
- 11. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Library at all. For example, if a patent
-license would not permit royalty-free redistribution of the Library by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Library.
-
-If any portion of this section is held invalid or unenforceable under any
-particular circumstance, the balance of the section is intended to apply,
-and the section as a whole is intended to apply in other circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-
- 12. If the distribution and/or use of the Library is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Library under this License may add
-an explicit geographical distribution limitation excluding those countries,
-so that distribution is permitted only in or among countries not thus
-excluded. In such case, this License incorporates the limitation as if
-written in the body of this License.
-
- 13. The Free Software Foundation may publish revised and/or new
-versions of the Lesser General Public License from time to time.
-Such new versions will be similar in spirit to the present version,
-but may differ in detail to address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Library
-specifies a version number of this License which applies to it and
-"any later version", you have the option of following the terms and
-conditions either of that version or of any later version published by
-the Free Software Foundation. If the Library does not specify a
-license version number, you may choose any version ever published by
-the Free Software Foundation.
-[_^L_][_$_]
- 14. If you wish to incorporate parts of the Library into other free
-programs whose distribution conditions are incompatible with these,
-write to the author to ask for permission. For software which is
-copyrighted by the Free Software Foundation, write to the Free
-Software Foundation; we sometimes make exceptions for this. Our
-decision will be guided by the two goals of preserving the free status
-of all derivatives of our free software and of promoting the sharing
-and reuse of software generally.
-
- NO WARRANTY
-
- 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO
-WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW.
-EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR
-OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY
-KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE
-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
-LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME
-THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN
-WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY
-AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU
-FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR
-CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE
-LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
-RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A
-FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF
-SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-DAMAGES.
-
- END OF TERMS AND CONDITIONS
-[_^L_][_$_]
- How to Apply These Terms to Your New Libraries
-
- If you develop a new library, and you want it to be of the greatest
-possible use to the public, we recommend making it free software that
-everyone can redistribute and change. You can do so by permitting
-redistribution under these terms (or, alternatively, under the terms of the
-ordinary General Public License).
-
- To apply these terms, attach the following notices to the library. It is
-safest to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least the
-"copyright" line and a pointer to where the full notice is found.
-
- <one line to give the library's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- 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.
-
- You should have received a copy of the GNU Lesser General Public
- License along with this library; if not, write to the Free Software
- Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA
-
-Also add information on how to contact you by electronic and paper mail.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the library, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the
- library `Frob' (a library for tweaking knobs) written by James Random Hacker.
-
- <signature of Ty Coon>, 1 April 1990
- Ty Coon, President of Vice
-
-That's all there is to it!
-
-
rmfile ./gnomevfs/COPYING
hunk ./gnomevfs/Gtk2HsSetup.hs 1
-{-# LANGUAGE CPP #-}
-
-#define CABAL_VERSION_ENCODE(major, minor, micro) ( \
- ((major) * 10000) \
- + ((minor) * 100) \
- + ((micro) * 1))
-
-#define CABAL_VERSION_CHECK(major,minor,micro) \
- (CABAL_VERSION >= CABAL_VERSION_ENCODE(major,minor,micro))
-
--- now, this is bad, but Cabal doesn't seem to actually pass any information about
--- its version to CPP, so guess the version depending on the version of GHC
-#ifdef CABAL_VERSION_MINOR
-#ifndef CABAL_VERSION_MAJOR
-#define CABAL_VERSION_MAJOR 1
-#endif
-#ifndef CABAL_VERSION_MICRO
-#define CABAL_VERSION_MICRO 0
-#endif
-#define CABAL_VERSION CABAL_VERSION_ENCODE( \
- CABAL_VERSION_MAJOR, \
- CABAL_VERSION_MINOR, \
- CABAL_VERSION_MICRO)
-#else
-#warning Setup.hs is guessing the version of Cabal. If compilation of Setup.hs fails use -DCABAL_VERSION_MINOR=x for Cabal version 1.x.0 when building (prefixed by --ghc-option= when using the 'cabal' command)
-#if (__GLASGOW_HASKELL__ >= 612)
-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,8,0)
-#else
-#define CABAL_VERSION CABAL_VERSION_ENCODE(1,6,0)
-#endif
-#endif
-
--- | Build a Gtk2hs package.
---
-module Gtk2HsSetup ( gtk2hsUserHooks, getPkgConfigPackages ) where
-
-import Distribution.Simple
-import Distribution.Simple.PreProcess
-import Distribution.InstalledPackageInfo ( importDirs,
- showInstalledPackageInfo,
- libraryDirs,
- extraLibraries,
- extraGHCiLibraries )
-import Distribution.Simple.PackageIndex (
-#if CABAL_VERSION_CHECK(1,8,0)
- lookupInstalledPackageId
-#else
- lookupPackageId
-#endif
- )
-import Distribution.PackageDescription as PD ( PackageDescription(..),
- updatePackageDescription,
- BuildInfo(..),
- emptyBuildInfo, allBuildInfo,
- Library(..),
- libModules, hasLibs)
-import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..),
- InstallDirs(..),
-#if CABAL_VERSION_CHECK(1,8,0)
- componentPackageDeps,
-#else
- packageDeps,
-#endif
- absoluteInstallDirs)
-import Distribution.Simple.Compiler ( Compiler(..) )
-import Distribution.Simple.Program (
- Program(..), ConfiguredProgram(..),
- rawSystemProgramConf, rawSystemProgramStdoutConf,
- c2hsProgram, pkgConfigProgram, requireProgram, ghcPkgProgram,
- simpleProgram, lookupProgram, rawSystemProgramStdout, ProgArg)
-import Distribution.ModuleName ( ModuleName, components, toFilePath )
-import Distribution.Simple.Utils
-import Distribution.Simple.Setup (CopyFlags(..), InstallFlags(..), CopyDest(..),
- defaultCopyFlags, ConfigFlags(configVerbosity),
- fromFlag, toFlag, RegisterFlags(..), flagToMaybe,
- fromFlagOrDefault, defaultRegisterFlags)
-import Distribution.Simple.BuildPaths ( autogenModulesDir )
-import Distribution.Simple.Install ( install )
-#if CABAL_VERSION_CHECK(1,8,0)
-import Distribution.Simple.Register ( generateRegistrationInfo, registerPackage )
-#else
-import qualified Distribution.Simple.Register as Register ( register )
-#endif
-import Distribution.Text ( simpleParse, display )
-import System.FilePath
-import System.Directory ( doesFileExist )
-import Distribution.Version (Version(..))
-import Distribution.Verbosity
-import Control.Monad (when, unless, filterM)
-import Data.Maybe ( isJust, isNothing, fromMaybe, maybeToList )
-import Data.List (isPrefixOf, isSuffixOf, nub)
-import Data.Char (isAlpha)
-import qualified Data.Map as M
-import qualified Data.Set as S
-
-import Control.Applicative ((<$>))
-import System.Directory (getDirectoryContents, doesDirectoryExist)
-
--- the name of the c2hs pre-compiled header file
-precompFile = "precompchs.bin"
-
-gtk2hsUserHooks = simpleUserHooks {
- hookedPrograms = [typeGenProgram, signalGenProgram, c2hsLocal],
- hookedPreProcessors = [("chs", ourC2hs)],
- confHook = \pd cf ->
- confHook simpleUserHooks pd cf >>= return . adjustLocalBuildInfo,
- postConf = \args cf pd lbi -> do
- genSynthezisedFiles (fromFlag (configVerbosity cf)) pd lbi
- postConf simpleUserHooks args cf pd lbi,
- buildHook = \pd lbi uh bf -> fixDeps pd >>= \pd ->
- (buildHook simpleUserHooks) pd lbi uh bf,
- copyHook = \pd lbi uh flags -> (copyHook simpleUserHooks) pd lbi uh flags >>
- installCHI pd lbi (fromFlag (copyVerbosity flags)) (fromFlag (copyDest flags)),
- instHook = \pd lbi uh flags ->
-#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
- installHook pd lbi uh flags >>
- installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest,
- regHook = registerHook
-#else
- instHook simpleUserHooks pd lbi uh flags >>
- installCHI pd lbi (fromFlag (installVerbosity flags)) NoCopyDest
-#endif
- }
-
-------------------------------------------------------------------------------
--- Lots of stuff for windows ghci support
-------------------------------------------------------------------------------
-
-getDlls :: [FilePath] -> IO [FilePath]
-getDlls dirs = filter ((== ".dll") . takeExtension) . concat <$>
- mapM getDirectoryContents dirs
-
-fixLibs :: [FilePath] -> [String] -> [String]
-fixLibs dlls = concatMap $ \ lib ->
- case filter (("lib" ++ lib) `isPrefixOf`) dlls of
- dll:_ -> [dropExtension dll]
- _ -> if lib == "z" then [] else [lib]
-
--- The following code is a big copy-and-paste job from the sources of
--- Cabal 1.8 just to be able to fix a field in the package file. Yuck.
-
-#if CABAL_VERSION_CHECK(1,8,0)
- [_$_]
-installHook :: PackageDescription -> LocalBuildInfo
- -> UserHooks -> InstallFlags -> IO ()
-installHook pkg_descr localbuildinfo _ flags = do
- let copyFlags = defaultCopyFlags {
- copyDistPref = installDistPref flags,
- copyDest = toFlag NoCopyDest,
- copyVerbosity = installVerbosity flags
- }
- install pkg_descr localbuildinfo copyFlags
- let registerFlags = defaultRegisterFlags {
- regDistPref = installDistPref flags,
- regInPlace = installInPlace flags,
- regPackageDB = installPackageDB flags,
- regVerbosity = installVerbosity flags
- }
- when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags
-
-registerHook :: PackageDescription -> LocalBuildInfo
- -> UserHooks -> RegisterFlags -> IO ()
-registerHook pkg_descr localbuildinfo _ flags =
- if hasLibs pkg_descr
- then register pkg_descr localbuildinfo flags
- else setupMessage verbosity
- "Package contains no library to register:" (packageId pkg_descr)
- where verbosity = fromFlag (regVerbosity flags)
-
-register :: PackageDescription -> LocalBuildInfo
- -> RegisterFlags -- ^Install in the user's database?; verbose
- -> IO ()
-register pkg@... { library = Just lib }
- lbi@... { libraryConfig = Just clbi } regFlags
- = do
-
- installedPkgInfoRaw <- generateRegistrationInfo
- verbosity pkg lib lbi clbi inplace distPref
-
- dllsInScope <- getSearchPath >>= (filterM doesDirectoryExist) >>= getDlls
- let libs = fixLibs dllsInScope (extraLibraries installedPkgInfoRaw)
- installedPkgInfo = installedPkgInfoRaw {
- extraGHCiLibraries = libs }
-
- -- Three different modes:
- case () of
- _ | modeGenerateRegFile -> die "Generate Reg File not supported"
- | modeGenerateRegScript -> die "Generate Reg Script not supported"
- | otherwise -> registerPackage verbosity
- installedPkgInfo pkg lbi inplace packageDb
-
- where
- modeGenerateRegFile = isJust (flagToMaybe (regGenPkgConf regFlags))
- modeGenerateRegScript = fromFlag (regGenScript regFlags)
- inplace = fromFlag (regInPlace regFlags)
- packageDb = case flagToMaybe (regPackageDB regFlags) of
- Just db -> db
- Nothing -> registrationPackageDB (withPackageDB lbi)
- distPref = fromFlag (regDistPref regFlags)
- verbosity = fromFlag (regVerbosity regFlags)
-
-register _ _ regFlags = notice verbosity "No package to register"
- where
- verbosity = fromFlag (regVerbosity regFlags)
-
-#else
-installHook :: PackageDescription -> LocalBuildInfo
- -> UserHooks -> InstallFlags -> IO ()
-installHook pkg_descr localbuildinfo _ flags = do
- let copyFlags = defaultCopyFlags {
- copyDistPref = installDistPref flags,
- copyInPlace = installInPlace flags,
- copyUseWrapper = installUseWrapper flags,
- copyDest = toFlag NoCopyDest,
- copyVerbosity = installVerbosity flags
- }
- install pkg_descr localbuildinfo copyFlags
- let registerFlags = defaultRegisterFlags {
- regDistPref = installDistPref flags,
- regInPlace = installInPlace flags,
- regPackageDB = installPackageDB flags,
- regVerbosity = installVerbosity flags
- }
- when (hasLibs pkg_descr) $ register pkg_descr localbuildinfo registerFlags
-
-registerHook :: PackageDescription -> LocalBuildInfo
- -> UserHooks -> RegisterFlags -> IO ()
-registerHook pkg_descr localbuildinfo _ flags =
- if hasLibs pkg_descr
- then register pkg_descr localbuildinfo flags
- else setupMessage verbosity
- "Package contains no library to register:" (packageId pkg_descr)
- where verbosity = fromFlag (regVerbosity flags)
-
-register :: PackageDescription -> LocalBuildInfo
- -> RegisterFlags -- ^Install in the user's database?; verbose
- -> IO ()
-register pkg_descr lbi regFlags = do
- let verbosity = fromFlag (regVerbosity regFlags)
- warn verbosity "Cannot register ghci libraries with Cabal 1.6 (need 1.8)."
- Register.register pkg_descr lbi regFlags
- [_$_]
-#endif
-
-------------------------------------------------------------------------------
--- This is a hack for Cabal-1.8, It is not needed in Cabal-1.9.1 or later
-------------------------------------------------------------------------------
-
-adjustLocalBuildInfo :: LocalBuildInfo -> LocalBuildInfo
-adjustLocalBuildInfo lbi =
- let extra = (Just libBi, [])
- libBi = emptyBuildInfo { includeDirs = [ autogenModulesDir lbi
- , buildDir lbi ] }
- in lbi { localPkgDescr = updatePackageDescription extra (localPkgDescr lbi) }
-
-------------------------------------------------------------------------------
--- Processing .chs files with our local c2hs.
-------------------------------------------------------------------------------
-
-ourC2hs :: BuildInfo -> LocalBuildInfo -> PreProcessor
-ourC2hs bi lbi = PreProcessor {
- platformIndependent = False,
- runPreProcessor = runC2HS bi lbi
-}
-
-runC2HS :: BuildInfo -> LocalBuildInfo ->
- (FilePath, FilePath) -> (FilePath, FilePath) -> Verbosity -> IO ()
-runC2HS bi lbi (inDir, inFile) (outDir, outFile) verbosity = do
- -- have the header file name if we don't have the precompiled header yet
- header <- case lookup "x-c2hs-header" (customFieldsBI bi) of
- Just h -> return h
- Nothing -> die ("Need x-c2hs-Header definition in the .cabal Library section "++
- "that sets the C header file to process .chs.pp files.")
-
- -- c2hs will output files in out dir, removing any leading path of the input file.
- -- Thus, append the dir of the input file to the output dir.
- let (outFileDir, newOutFile) = splitFileName outFile
- let newOutDir = outDir </> outFileDir
- -- additional .chi files might be needed that other packages have installed;
- -- we assume that these are installed in the same place as .hi files
- let chiDirs = [ dir |
-#if CABAL_VERSION_CHECK(1,8,0)
- ipi <- maybe [] (map fst . componentPackageDeps) (libraryConfig lbi),
- dir <- maybe [] importDirs (lookupInstalledPackageId (installedPkgs lbi) ipi) ]
-#else
- ipi <- packageDeps lbi,
- dir <- maybe [] importDirs (lookupPackageId (installedPkgs lbi) ipi) ]
-#endif
- rawSystemProgramConf verbosity c2hsLocal (withPrograms lbi) $
- map ("--include=" ++) (outDir:chiDirs)
- ++ ["--cppopts=" ++ opt | opt <- getCppOptions bi lbi]
- ++ ["--output-dir=" ++ newOutDir,
- "--output=" ++ newOutFile,
- "--precomp=" ++ buildDir lbi </> precompFile,
- header, inDir </> inFile]
-
-getCppOptions :: BuildInfo -> LocalBuildInfo -> [String]
-getCppOptions bi lbi
- = nub $
- ["-I" ++ dir | dir <- PD.includeDirs bi]
- ++ [opt | opt@...:_) <- (PD.cppOptions bi ++ PD.ccOptions bi), c `elem` "DIU"]
-
-installCHI :: PackageDescription -- ^information from the .cabal file
- -> LocalBuildInfo -- ^information from the configure step
- -> Verbosity -> CopyDest -- ^flags sent to copy or install
- -> IO ()
-installCHI pkg@... { library = Just lib } lbi verbosity copydest = do
- let InstallDirs { libdir = libPref } = absoluteInstallDirs pkg lbi copydest
- -- cannot use the recommended 'findModuleFiles' since it fails if there exists
- -- a modules that does not have a .chi file
- mFiles <- mapM (findFileWithExtension' ["chi"] [buildDir lbi])
- (map toFilePath
-#if CABAL_VERSION_CHECK(1,8,0)
- (PD.libModules lib)
-#else
- (PD.libModules pkg)
-#endif
- )
- let files = [ f | Just f <- mFiles ]
-#if CABAL_VERSION_CHECK(1,8,0)
- installOrdinaryFiles verbosity libPref files
-#else
- copyFiles verbosity libPref files
-#endif
-
- [_$_]
-installCHI _ _ _ _ = return ()
-
-------------------------------------------------------------------------------
--- Generating the type hierarchy and signal callback .hs files.
-------------------------------------------------------------------------------
-
-typeGenProgram :: Program
-typeGenProgram = (simpleProgram "gtk2hsTypeGen")
-
-signalGenProgram :: Program
-signalGenProgram = (simpleProgram "gtk2hsHookGenerator")
-
-c2hsLocal :: Program
-c2hsLocal = (simpleProgram "gtk2hsC2hs")
-
-genSynthezisedFiles :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()
-genSynthezisedFiles verb pd lbi = do
-
- cPkgs <- getPkgConfigPackages verb lbi pd
-
- let xList = maybe [] (customFieldsBI . libBuildInfo) (library pd)
- ++customFieldsPD pd
- typeOpts :: String -> [ProgArg]
- typeOpts tag = concat [ map (\val -> '-':'-':drop (length tag) field++'=':val) (words content)
- | (field,content) <- xList,
- tag `isPrefixOf` field,
- field /= (tag++"file")]
- ++ [ "--tag=" ++ tag
- | PackageIdentifier name (Version (major:minor:_) _) <- cPkgs
- , let name' = filter isAlpha (display name)
- , tag <- name'
- : [ name' ++ "-" ++ show major ++ "." ++ show digit
- | digit <- [0,2..minor] ]
- ]
-
- signalsOpts :: [ProgArg]
- signalsOpts = concat [ map (\val -> '-':'-':drop 10 field++'=':val) (words content)
- | (field,content) <- xList,
- "x-signals-" `isPrefixOf` field,
- field /= "x-signals-file"]
-
- genFile :: Program -> [ProgArg] -> FilePath -> IO ()
- genFile prog args outFile = do
- res <- rawSystemProgramStdoutConf verb prog (withPrograms lbi) args
- rewriteFile outFile res
-
- (flip mapM_) (filter (\(tag,_) -> "x-types-" `isPrefixOf` tag && "file" `isSuffixOf` tag) xList) $
- \(fileTag, f) -> do
- let tag = reverse (drop 4 (reverse fileTag))
- info verb ("Ensuring that class hierarchy in "++f++" is up-to-date.")
- genFile typeGenProgram (typeOpts tag) f
-
- case lookup "x-signals-file" xList of
- Nothing -> return ()
- Just f -> do
- info verb ("Ensuring that callback hooks in "++f++" are up-to-date.")
- genFile signalGenProgram signalsOpts f
-
---FIXME: Cabal should tell us the selected pkg-config package versions in the
--- LocalBuildInfo or equivalent.
--- In the mean time, ask pkg-config again.
-
-getPkgConfigPackages :: Verbosity -> LocalBuildInfo -> PackageDescription -> IO [PackageId]
-getPkgConfigPackages verbosity lbi pkg =
- sequence
- [ do version <- pkgconfig ["--modversion", display pkgname]
- case simpleParse version of
- Nothing -> die $ "parsing output of pkg-config --modversion failed"
- Just v -> return (PackageIdentifier pkgname v)
- | Dependency pkgname _ <- concatMap pkgconfigDepends (allBuildInfo pkg) ]
- where
- pkgconfig = rawSystemProgramStdoutConf verbosity
- pkgConfigProgram (withPrograms lbi)
-
-------------------------------------------------------------------------------
--- Dependency calculation amongst .chs files.
-------------------------------------------------------------------------------
-
--- Given all files of the package, find those that end in .chs and extract the
--- .chs files they depend upon. Then return the PackageDescription with these
--- files rearranged so that they are built in a sequence that files that are
--- needed by other files are built first.
-fixDeps :: PackageDescription -> IO PackageDescription
-fixDeps pd@... {
- PD.library = Just lib@... {
- PD.exposedModules = expMods,
- PD.libBuildInfo = bi@... {
- PD.hsSourceDirs = srcDirs,
- PD.otherModules = othMods
- }}} = do
- let findModule m = findFileWithExtension [".chs.pp",".chs"] srcDirs
- (joinPath (components m))
- mExpFiles <- mapM findModule expMods
- mOthFiles <- mapM findModule othMods
-
- -- tag all exposed files with True so we throw an error if we need to build
- -- an exposed module before an internal modules (we cannot express this)
- let modDeps = zipWith (ModDep True []) expMods mExpFiles++
- zipWith (ModDep False []) othMods mOthFiles
- modDeps <- mapM extractDeps modDeps
- let (expMods, othMods) = span mdExposed $ sortTopological modDeps
- badOther = map (fromMaybe "<no file>" . mdLocation) $
- filter (not . mdExposed) expMods
- unless (null badOther) $
- die ("internal chs modules "++intercalate "," badOther++
- " depend on exposed chs modules; cabal needs to build internal modules first")
- return pd { PD.library = Just lib {
- PD.exposedModules = map mdOriginal expMods,
- PD.libBuildInfo = bi { PD.otherModules = map mdOriginal othMods }
- }}
-
-data ModDep = ModDep {
- mdExposed :: Bool,
- mdRequires :: [ModuleName],
- mdOriginal :: ModuleName,
- mdLocation :: Maybe FilePath
-}
-
-instance Show ModDep where
- show x = show (mdLocation x)
-
-instance Eq ModDep where
- ModDep { mdOriginal = m1 } == ModDep { mdOriginal = m2 } = m1==m2
-instance Ord ModDep where
- compare ModDep { mdOriginal = m1 } ModDep { mdOriginal = m2 } = compare m1 m2
-
--- Extract the dependencies of this file. This is intentionally rather naive as it
--- ignores CPP conditionals. We just require everything which means that the
--- existance of a .chs module may not depend on some CPP condition. [_$_]
-extractDeps :: ModDep -> IO ModDep
-extractDeps md@... { mdLocation = Nothing } = return md
-extractDeps md@... { mdLocation = Just f } = withUTF8FileContents f $ \con -> do
- let findImports acc (('{':'#':xs):xxs) = case (dropWhile ((==) ' ') xs) of
- ('i':'m':'p':'o':'r':'t':' ':ys) ->
- case simpleParse (takeWhile ((/=) '#') ys) of
- Just m -> findImports (m:acc) xxs [_$_]
- Nothing -> die ("cannot parse chs import in "++f++":\n"++
- "offending line is {#"++xs)
- -- no more imports after the first non-import hook
- _ -> return acc
- findImports acc (_:xxs) = findImports acc xxs
- findImports acc [] = return acc
- mods <- findImports [] (lines con)
- return md { mdRequires = mods }
-
--- Find a total order of the set of modules that are partially sorted by their
--- dependencies on each other. The function returns the sorted list of modules
--- together with a list of modules that are required but not supplied by this
--- in the input set of modules.
-sortTopological :: [ModDep] -> [ModDep]
-sortTopological ms = reverse $ fst $ foldl visit ([], S.empty) (map mdOriginal ms)
- where
- set = M.fromList (map (\m -> (mdOriginal m, m)) ms)
- visit (out,visited) m
- | m `S.member` visited = (out,visited)
- | otherwise = case m `M.lookup` set of
- Nothing -> (out, m `S.insert` visited)
- Just md -> (md:out', visited')
- where
- (out',visited') = foldl visit (out, m `S.insert` visited) (mdRequires md)
rmfile ./gnomevfs/Gtk2HsSetup.hs
hunk ./gnomevfs/Setup.hs 1
--- Setup file for a Gtk2Hs module. Contains only adjustments specific to this module,
--- all Gtk2Hs-specific boilerplate is stored in Gtk2HsSetup.hs which should be kept
--- identical across all modules.
-import Gtk2HsSetup ( gtk2hsUserHooks )
-import Distribution.Simple ( defaultMainWithHooks )
-
-main = defaultMainWithHooks gtk2hsUserHooks
rmfile ./gnomevfs/Setup.hs
hunk ./gnomevfs/gnomevfs.cabal 1
-Name: gnomevfs
-Version: 0.11.0
-License: LGPL-2.1
-License-file: COPYING
-Copyright: (c) 2001-2010 The Gtk2Hs Team
-Author: Duncan Coutts
-Maintainer: gtk2hs-users@...
-Build-Type: Custom
-Cabal-Version: >= 1.6
-Stability: stable
-homepage: http://www.haskell.org/gtk2hs/
-bug-reports: http://hackage.haskell.org/trac/gtk2hs/
-Synopsis: Binding to the GNOME Virtual File System library.
-Description: GNOME VFS is the GNOME virtual file system. It is the foundation of the
- Nautilus file manager. It provides a modular architecture and ships with
- several modules that implement support for local files, http, ftp and others.
- It provides an URI-based API, a backend supporting asynchronous file
- operations, a MIME type manipulation library and other features.
-[_^I_][_^I_][_^I_][_^I_][_$_]
-Category: System
-Tested-With: GHC == 6.12.1
-Extra-Source-Files: hsgnomevfs-2.14.h
- System/Gnome/VFS/hsfileinfo.h
- Gtk2HsSetup.hs
- marshal.list
-
-Data-Dir: demo
-Data-Files: Makefile
- TestDir.hs
- TestDriveVolume.hs
- TestSync.hs
- TestVolumeMonitor.hs
- TestXfer.hs
-[_^I_][_^I_][_^I_][_^I_][_$_]
-x-Types-File: System/Gnome/VFS/Types.chs
-x-Types-Tag: gnomevfs
-x-Types-ModName: System.Gnome.VFS.Types
-x-Types-Forward: Graphics.UI.GtkInternals
-x-Types-Destructor: objectUnrefFromMainloop
-
-Source-Repository head
- type: darcs
- location: http://code.haskell.org/gtk2hs/
- subdir: gnomevfs
-
-Library
- build-depends: base >= 4 && < 5, array, containers, haskell98, mtl,
- glib >= 0.11 && < 0.12,
- gtk >= 0.11 && < 0.12
-[_^I_][_^I_][_^I_][_^I_][_^I_][_^I_][_$_]
- build-tools: gtk2hsC2hs, gtk2hsHookGenerator, gtk2hsTypeGen
-[_^I_][_^I_][_^I_][_^I_][_^I_][_^I_][_$_]
- exposed-modules:
- System.Gnome.VFS
- System.Gnome.VFS.Cancellation [_$_]
- System.Gnome.VFS.Directory
- System.Gnome.VFS.Drive
- System.Gnome.VFS.Error
- System.Gnome.VFS.FileInfo
- System.Gnome.VFS.Init
- System.Gnome.VFS.MIME
- System.Gnome.VFS.Monitor
- System.Gnome.VFS.Ops
- System.Gnome.VFS.URI
- System.Gnome.VFS.Util
- System.Gnome.VFS.Volume
- System.Gnome.VFS.VolumeMonitor
- System.Gnome.VFS.Xfer
-[_^I_][_^I_] [_$_]
- other-modules:
- System.Gnome.VFS.Types
- System.Gnome.VFS.Signals
- System.Gnome.VFS.BasicTypes
- System.Gnome.VFS.Marshal
- System.Gnome.VFS.Constants[_^I_][_^I_] [_$_]
-[_^I_][_^I_] [_$_]
- extensions: ForeignFunctionInterface
- c-sources: System/Gnome/VFS/hsfileinfo.c
-[_^I_][_^I_][_$_]
- x-Signals-File: System/Gnome/VFS/Signals.chs
- x-Signals-Modname: System.Gnome.VFS.Signals
- x-Signals-Types: marshal.list
- x-Signals-Import: Graphics.UI.GtkInternals
-[_^I_][_^I_][_$_]
- x-c2hs-Header: hsgnomevfs-2.14.h
- include-dirs: System/Gnome/VFS/
- cpp-options: -DHAVE_NEW_CONTROL_EXCEPTION
- pkgconfig-depends: gnome-vfs-2.0 >= 2.0.0, gnome-vfs-module-2.0 >= 2.0.0
rmfile ./gnomevfs/gnomevfs.cabal
hunk ./gnomevfs/hsgnomevfs-2.14.h 1
-#include <libgnomevfs/gnome-vfs.h>
-#include <libgnomevfs/gnome-vfs-mime.h>
-#include <libgnomevfs/gnome-vfs-version.h>
rmfile ./gnomevfs/hsgnomevfs-2.14.h
hunk ./gnomevfs/marshal.list 1
-# see glib-genmarshal(1) for a detailed description of the file format,
-# possible parameter types are:
-# VOID indicates no return type, or no extra
-# parameters. if VOID is used as the parameter
-# list, no additional parameters may be present.
-# BOOLEAN for boolean types (gboolean)
-# CHAR for signed char types (gchar)
-# UCHAR for unsigned char types (guchar)
-# INT for signed integer types (gint)
-# UINT for unsigned integer types (guint)
-# LONG for signed long integer types (glong)
-# ULONG for unsigned long integer types (gulong)
-# ENUM for enumeration types (gint)
-# FLAGS for flag enumeration types (guint)
-# FLOAT for single-precision float types (gfloat)
-# DOUBLE for double-precision float types (gdouble)
-# STRING for string types (gchar*)
-# BOXED for boxed (anonymous but reference counted) types (GBoxed*)
-# POINTER for anonymous pointer types (gpointer)
-# NONE deprecated alias for VOID
-# BOOL deprecated alias for BOOLEAN
-
-#
-# One discrepancy from Gtk+ is that for signals that may pass NULL for an object
-# reference, the Haskell signal should be passed a 'Maybe GObject'.
-# We therefore have two variants that are marshalled as a maybe type:
-#
-# OBJECT for GObject or derived types (GObject*)
-# MOBJECT for GObject or derived types (GObject*) that may be NULL
-
-# Furthermore, some objects needs to be destroyed synchronously from the main loop of
-# Gtk rather than during GC. These objects need to be marshalled using TOBJECT (for thread-safe
-# object). It doesn't hurt to use TOBJECT for an object that doesn't need it, except for the
-# some performance. As a rule of thumb, use TOBJECT for all libraries that build on package
-# 'gtk' and use OBJECT for all packages that only need packages 'glib', 'pango', 'cairo',
-# 'gio'. Again both variants exist. Note that the same names will be generated for OBJECT and
-# TOBJECT, so you have to remove the OBJECT handler if you need both.
-#
-# TOBJECT for GObject or derived types (GObject*)
-# MTOBJECT for GObject or derived types (GObject*) that may be NULL
-
-# If you add a new signal type, please check that it actually works!
-# If it is a Boxed type check that the reference counting is right.
-
-NONE:TOBJECT
rmfile ./gnomevfs/marshal.list
rmdir ./gnomevfs
}
|