packages feed

gnomevfs (empty) → 0.11.0

raw patch · 28 files changed

+5446/−0 lines, 28 filesdep +arraydep +basedep +containersbuild-type:Customsetup-changed

Dependencies added: array, base, containers, glib, gtk, haskell98, mtl

Files

+ COPYING view
@@ -0,0 +1,504 @@+		  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.++  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.++		  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.++  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.++  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.++  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.++  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.++  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.++  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++           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!++
+ Gtk2HsSetup.hs view
@@ -0,0 +1,486 @@+{-# 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@PackageDescription { library       = Just lib  }+         lbi@LocalBuildInfo     { 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@('-':c:_) <- (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@PD.PackageDescription { 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.PackageDescription {+          PD.library = Just lib@PD.Library {+            PD.exposedModules = expMods,+            PD.libBuildInfo = bi@PD.BuildInfo {+              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@ModDep { mdLocation = Nothing } = return md+extractDeps md@ModDep { mdLocation = Just f } = withFileContents 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)
+ Setup.hs view
@@ -0,0 +1,7 @@+-- 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
+ System/Gnome/VFS.chs view
@@ -0,0 +1,69 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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
+ System/Gnome/VFS/BasicTypes.chs view
@@ -0,0 +1,507 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.++-- #hide++-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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@(GObject 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
+ System/Gnome/VFS/Cancellation.chs view
@@ -0,0 +1,97 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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
+ System/Gnome/VFS/Constants.hsc view
@@ -0,0 +1,112 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.++-- #hide++#include <libgnomevfs/gnome-vfs-file-info.h>++-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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
+ System/Gnome/VFS/Directory.chs view
@@ -0,0 +1,254 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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 ())
+ System/Gnome/VFS/Drive.chs view
@@ -0,0 +1,293 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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@'s+--   @mnt_fsname@ entry.+--   +--   Otherwise, it returns 'Nothing'.+driveGetDevicePath :: DriveClass drive =>+                      drive             -- ^ @drive@ - the drive object to query+                   -> IO (Maybe String) -- ^ the drive's device path+driveGetDevicePath =+    marshalMaybeString {# call drive_get_device_path #}++-- | Returns the 'DeviceType' of a 'Drive' object.+driveGetDeviceType :: DriveClass drive =>+                      drive         -- ^ @drive@ - the drive object to query+                   -> IO DeviceType -- ^ the drive's device type+driveGetDeviceType drive =+    liftM cToEnum $ {# call drive_get_device_type #} (castToDrive drive)++-- | Returns the display name of a 'Drive' object.+driveGetDisplayName :: DriveClass drive =>+                       drive     -- ^ @drive@ - the drive object to query+                    -> IO String -- ^ the drive's display name+driveGetDisplayName =+    marshalString {# call drive_get_display_name #}++#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
+ System/Gnome/VFS/Error.chs view
@@ -0,0 +1,69 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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
+ System/Gnome/VFS/FileInfo.chs view
@@ -0,0 +1,333 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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 ()
+ System/Gnome/VFS/Init.chs view
@@ -0,0 +1,62 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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 #}
+ System/Gnome/VFS/MIME.chs view
@@ -0,0 +1,143 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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 #}
+ System/Gnome/VFS/Marshal.chs view
@@ -0,0 +1,129 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.++-- #hide++-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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 #}
+ System/Gnome/VFS/Monitor.chs view
@@ -0,0 +1,99 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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
+ System/Gnome/VFS/Ops.chs view
@@ -0,0 +1,311 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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
+ System/Gnome/VFS/Signals.chs view
@@ -0,0 +1,77 @@+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- -------------------- automatically generated file - do not edit ------------+--  Callback installers for the GIMP Toolkit (GTK) Binding for Haskell+--+--  Author : Axel Simon+--+--  Created: 1 July 2000+--+--  Copyright (C) 2000-2005 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.+--+-- #hide++-- These functions are used to connect signals to widgets. They are auto-+-- matically created through HookGenerator.hs which takes a list of possible+-- function signatures that are included in the GTK sources (gtkmarshal.list).+--+-- The object system in the second version of GTK is based on GObject from+-- GLIB. This base class is rather primitive in that it only implements+-- ref and unref methods (and others that are not interesting to us). If+-- the marshall list mentions OBJECT it refers to an instance of this +-- GObject which is automatically wrapped with a ref and unref call.+-- Structures which are not derived from GObject have to be passed as+-- BOXED which gives the signal connect function a possibility to do the+-- conversion into a proper ForeignPtr type. In special cases the signal+-- connect function use a PTR type which will then be mangled in the+-- user function directly. The latter is needed if a signal delivers a+-- pointer to a string and its length in a separate integer.+--+module System.Gnome.VFS.Signals (+  module System.Glib.Signals,++  connect_OBJECT__NONE,+  +  ) where++import Control.Monad	(liftM)++import System.Glib.FFI+import System.Glib.UTFString   (peekUTFString)+import System.Glib.GError      (failOnGError)+{#import System.Glib.Signals#}+{#import System.Glib.GObject#} +import Graphics.UI.GtkInternals+++{#context lib="gtk" prefix="gtk" #}+++-- Here are the generators that turn a Haskell function into+-- a C function pointer. The fist Argument is always the widget,+-- the last one is the user g_pointer. Both are ignored.+++connect_OBJECT__NONE :: +  (GObjectClass a', GObjectClass obj) => SignalName ->+  ConnectAfter -> obj ->+  (a' -> IO ()) ->+  IO (ConnectId obj)+connect_OBJECT__NONE signal after obj user =+  connectGeneric signal after obj action+  where action :: Ptr GObject -> Ptr GObject -> IO ()+        action _ obj1 =+          failOnGError $+          makeNewGObject (GObject, objectUnrefFromMainloop) (return obj1) >>= \obj1' ->+          user (unsafeCastGObject obj1')+
+ System/Gnome/VFS/Types.chs view
@@ -0,0 +1,140 @@+{-# OPTIONS_HADDOCK hide #-}+-- -*-haskell-*-+-- -------------------- automatically generated file - do not edit ----------+--  Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell+--+--  Author : Axel Simon+--+--  Copyright (C) 2001-2005 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.+--+-- #hide++-- |+-- Maintainer  : gtk2hs-users@lists.sourceforge.net+-- Stability   : provisional+-- Portability : portable (depends on GHC)+--+-- This file reflects the Gtk+ object hierarchy in terms of Haskell classes.+--+-- Note: the mk... functions were originally meant to simply be an alias+-- for the constructor. However, in order to communicate the destructor+-- of an object to objectNew, the mk... functions are now a tuple containing+-- Haskell constructor and the destructor function pointer. This hack avoids+-- changing all modules that simply pass mk... to objectNew.+--+module System.Gnome.VFS.Types (++  module Graphics.UI.GtkInternals,+  Volume(Volume), VolumeClass,+  toVolume, +  mkVolume, unVolume,+  castToVolume, gTypeVolume,+  Drive(Drive), DriveClass,+  toDrive, +  mkDrive, unDrive,+  castToDrive, gTypeDrive,+  VolumeMonitor(VolumeMonitor), VolumeMonitorClass,+  toVolumeMonitor, +  mkVolumeMonitor, unVolumeMonitor,+  castToVolumeMonitor, gTypeVolumeMonitor+  ) where++import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr)+import Foreign.C.Types    (CULong, CUInt)+import System.Glib.GType	(GType, typeInstanceIsA)+import Graphics.UI.GtkInternals++{# context lib="gtk" prefix="gtk" #}++-- The usage of foreignPtrToPtr should be safe as the evaluation will only be+-- forced if the object is used afterwards+--+castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String+                                                -> (obj -> obj')+castTo gtype objTypeName obj =+  case toGObject obj of+    gobj@(GObject objFPtr)+      | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype+                  -> unsafeCastGObject gobj+      | otherwise -> error $ "Cannot cast object to " ++ objTypeName+++-- ********************************************************************* Volume++{#pointer *GnomeVFSVolume as Volume foreign newtype #} deriving (Eq,Ord)++mkVolume = (Volume, objectUnrefFromMainloop)+unVolume (Volume o) = o++class GObjectClass o => VolumeClass o+toVolume :: VolumeClass o => o -> Volume+toVolume = unsafeCastGObject . toGObject++instance VolumeClass Volume+instance GObjectClass Volume where+  toGObject = GObject . castForeignPtr . unVolume+  unsafeCastGObject = Volume . castForeignPtr . unGObject++castToVolume :: GObjectClass obj => obj -> Volume+castToVolume = castTo gTypeVolume "Volume"++gTypeVolume :: GType+gTypeVolume =+  {# call fun unsafe gnome_vfs_volume_get_type #}++-- ********************************************************************** Drive++{#pointer *GnomeVFSDrive as Drive foreign newtype #} deriving (Eq,Ord)++mkDrive = (Drive, objectUnrefFromMainloop)+unDrive (Drive o) = o++class GObjectClass o => DriveClass o+toDrive :: DriveClass o => o -> Drive+toDrive = unsafeCastGObject . toGObject++instance DriveClass Drive+instance GObjectClass Drive where+  toGObject = GObject . castForeignPtr . unDrive+  unsafeCastGObject = Drive . castForeignPtr . unGObject++castToDrive :: GObjectClass obj => obj -> Drive+castToDrive = castTo gTypeDrive "Drive"++gTypeDrive :: GType+gTypeDrive =+  {# call fun unsafe gnome_vfs_drive_get_type #}++-- ************************************************************** VolumeMonitor++{#pointer *GnomeVFSVolumeMonitor as VolumeMonitor foreign newtype #} deriving (Eq,Ord)++mkVolumeMonitor = (VolumeMonitor, objectUnrefFromMainloop)+unVolumeMonitor (VolumeMonitor o) = o++class GObjectClass o => VolumeMonitorClass o+toVolumeMonitor :: VolumeMonitorClass o => o -> VolumeMonitor+toVolumeMonitor = unsafeCastGObject . toGObject++instance VolumeMonitorClass VolumeMonitor+instance GObjectClass VolumeMonitor where+  toGObject = GObject . castForeignPtr . unVolumeMonitor+  unsafeCastGObject = VolumeMonitor . castForeignPtr . unGObject++castToVolumeMonitor :: GObjectClass obj => obj -> VolumeMonitor+castToVolumeMonitor = castTo gTypeVolumeMonitor "VolumeMonitor"++gTypeVolumeMonitor :: GType+gTypeVolumeMonitor =+  {# call fun unsafe gnome_vfs_volume_monitor_get_type #}+
+ System/Gnome/VFS/URI.chs view
@@ -0,0 +1,403 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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@'s 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@'s 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@'s 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
+ System/Gnome/VFS/Util.chs view
@@ -0,0 +1,329 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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@'s 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
+ System/Gnome/VFS/Volume.chs view
@@ -0,0 +1,322 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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@'s+--   @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
+ System/Gnome/VFS/VolumeMonitor.chs view
@@ -0,0 +1,174 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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
+ System/Gnome/VFS/Xfer.chs view
@@ -0,0 +1,280 @@+{-# 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@stanford.edu>. The+--  documentation is covered by the GNU Free Documentation License,+--  version 1.2.+--  +-- | Maintainer  : gtk2hs-devel@lists.sourceforge.net+--   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)
+ System/Gnome/VFS/hsfileinfo.c view
@@ -0,0 +1,61 @@+/* 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@stanford.edu>. 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; }
+ System/Gnome/VFS/hsfileinfo.h view
@@ -0,0 +1,57 @@+/* 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@stanford.edu>. 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);
+ gnomevfs.cabal view
@@ -0,0 +1,80 @@+Name:           gnomevfs+Version:        0.11.0+License:        GPL+License-file:   COPYING+Copyright:      (c) 2001-2010 The Gtk2Hs Team+Author:         Duncan Coutts+Maintainer:     gtk2hs-users@sourceforge.net+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.+				+Category:       System+Tested-With:    GHC == 6.12.1+Extra-Source-Files: hsgnomevfs-2.14.h+                    System/Gnome/VFS/hsfileinfo.h+                    Gtk2HsSetup.hs+                    marshal.list++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+						+        build-tools:    gtk2hsC2hs, gtk2hsHookGenerator, gtk2hsTypeGen+						+        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+		  +        other-modules:+          System.Gnome.VFS.Types+          System.Gnome.VFS.Signals+          System.Gnome.VFS.BasicTypes+          System.Gnome.VFS.Marshal+          System.Gnome.VFS.Constants		  +		  +        extensions:     ForeignFunctionInterface+        c-sources: System/Gnome/VFS/hsfileinfo.c+		+        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+		+        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
+ hsgnomevfs-2.14.h view
@@ -0,0 +1,3 @@+#include <libgnomevfs/gnome-vfs.h>+#include <libgnomevfs/gnome-vfs-mime.h>+#include <libgnomevfs/gnome-vfs-version.h>
+ marshal.list view
@@ -0,0 +1,45 @@+# 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