Menu
▾
▴
[Gtk2hs-commit] (main branch): Finish two more functions in VTE.
|
From: Axel S. <si...@co...> - 2009-09-26 15:13:05
|
Sat Sep 26 09:56:54 EDT 2009 Axe...@en...
* Finish two more functions in VTE.
hunk ./Makefile.am 44
+ vte/Graphics/UI/Gtk/Vte/VteCharAttrFields.h \
hunk ./Makefile.am 51
- mkdir $(distdir)/vte/Graphics/UI/Gtk/Vte
- touch $(distdir)/vte/Graphics/UI/Gtk/Vte/.keep
hunk ./Makefile.am 1152
- vte/Graphics/UI/Gtk/Vte/Vte.chs
+ vte/Graphics/UI/Gtk/Vte/VteCharAttrFields.c \
+ vte/Graphics/UI/Gtk/Vte/Structs.hsc \
+ vte/Graphics/UI/Gtk/Vte/Vte.chs
addfile ./vte/Graphics/UI/Gtk/Vte/Structs.hsc
hunk ./vte/Graphics/UI/Gtk/Vte/Structs.hsc 1
+{-# OPTIONS_HADDOCK hide #-}
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) marshalling of structures for VTE
+--
+-- Author : Axel Simon
+--
+-- Created: 26 Sep 2009
+--
+-- Copyright (C) 2009 Andy Stewart <laz...@gm...>
+--
+-- 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 : gtk...@li...
+-- Stability : provisional
+-- Portability : portable (depends on GHC)
+--
+-- Structures for the VTE terminal widget
+-- [_$_]
+-----------------------------------------------------------------------------
+-- [_$_]
+module Graphics.UI.Gtk.Vte.Structs (
+-- * Types
+ VteAttributes(..),
+ [_$_]
+-- * Functions
+ gArrayContent
+ ) where
+
+import Data.Char
+import Data.Word
+
+import System.Glib.FFI
+import Graphics.UI.Gtk.General.Structs ( Color(..) )
+
+#include "VteCharAttrFields.h"
+
+data VteAttributes = VteAttributes {
+ vaRow :: Int,
+ vaCol :: Int,
+ vaFore :: Color,
+ vaBack :: Color,
+ vaUnderline :: Bool,
+ vaStrikethrough :: Bool
+ }
+
+-- these fields are declard as bit fields which we cannot access portably from
+-- Haskell, thus, we define two C helper functions that read these fields
+foreign import ccall "getVteCharAttrUnderline"
+ getVteCharAttrUnderline :: Ptr VteAttributes -> IO #{type gboolean}
+
+foreign import ccall "getVteCharAttrStrikethrough"
+ getVteCharAttrStrikethrough :: Ptr VteAttributes -> IO #{type gboolean}
+
+instance Storable VteAttributes where
+ sizeOf _ = #{const sizeof(VteCharAttributes)}
+ alignment _ = alignment (undefined :: #{type long})
+ peek ptr = do
+ row <- #{peek VteCharAttributes, row} ptr :: IO #{type long}
+ col <- #{peek VteCharAttributes, column} ptr :: IO #{type long}
+ fore <- #{peek VteCharAttributes, fore} ptr
+ back <- #{peek VteCharAttributes, back} ptr
+ under <- getVteCharAttrUnderline ptr
+ strike <- getVteCharAttrStrikethrough ptr
+ return VteAttributes {
+ vaRow = fromIntegral row,
+ vaCol = fromIntegral col,
+ vaFore = fore,
+ vaBack = back,
+ vaUnderline = toBool (fromIntegral under),
+ vaStrikethrough = toBool (fromIntegral strike)
+ }
+ poke ptr VteAttributes {} = error "Storable VteAttributes: not implemented"
+
+-- | Retrieve the two fields of the GArray structure.
+--
+gArrayContent :: Ptr garray -> IO (Int, Ptr VteAttributes)
+gArrayContent gaPtr = do
+ len <- #{peek GArray, len} gaPtr :: IO #{type guint}
+ ptr <- #{peek GArray, data} gaPtr
+ return (fromIntegral len, ptr)
hunk ./vte/Graphics/UI/Gtk/Vte/Vte.chs.pp 196
-import Control.Monad (liftM)
+import Control.Monad (liftM, unless)
hunk ./vte/Graphics/UI/Gtk/Vte/Vte.chs.pp 206
-import System.Glib.GError [_$_]
-import Graphics.UI.Gtk.Gdk.GC
+import System.Glib.GError
+import System.Glib.Flags (Flags, fromFlags) [_$_]
+import Graphics.UI.Gtk.General.Structs (Color(..))
hunk ./vte/Graphics/UI/Gtk/Vte/Vte.chs.pp 211
+import Graphics.UI.Gtk.Vte.Structs
hunk ./vte/Graphics/UI/Gtk/Vte/Vte.chs.pp 218
+{#import System.Glib.GError#} (propagateGError)
hunk ./vte/Graphics/UI/Gtk/Vte/Vte.chs.pp 849
- [_$_]
--- | Extracts a view of the visible part of the terminal. If is_selected is not NULL, characters will only be read if is_selected returns TRUE after being passed the column and row, respectively. [_$_]
--- A 'CharAttributes' structure is added to attributes for each byte added to the returned string detailing the character's position, colors, and other characteristics.
--- TODO:
--- terminalGetText
hunk ./vte/Graphics/UI/Gtk/Vte/Vte.chs.pp 850
+-- | A predicate that states which characters are of interest.
+type VteSelect =
+ Int -- ^ the column of the character
+ -> Int -- ^ the row of the character
+ -> Bool -- ^ @True@ if the character should be inspected
+
+-- | A structure describing the individual characters in the visible part of
+-- a terminal window.
+--
+data VteChar = VteChar {
+ vcRow :: Int,
+ vcCol :: Int,
+ vcChar :: Char,
+ vcFore :: Color,
+ vcBack :: Color,
+ vcUnderline :: Bool,
+ vcStrikethrough :: Bool
+ }
+
+attrToChar :: Char -> VteAttributes -> VteChar
+attrToChar ch (VteAttributes r c f b u s) = VteChar r c ch f b u s
+ [_$_]
+-- | Extracts a view of the visible part of the terminal. A selection
+-- predicate may be supplied to restrict the inspected characters. The
+-- return value is a list of 'VteChar' structures, each detailing the
+-- character's position, colors, and other characteristics.
+--
+terminalGetText ::
+ TerminalClass self => self
+ -> Maybe VteSelect -- ^ @Just p@ for a predicate @p@ that determines
+ -- which character should be extracted or @Nothing@
+ -- to select all characters
+ -> IO [VteChar]
+terminalGetText terminal mCB = do
+ cbPtr <- case mCB of
+ Just cb -> mkVteSelectionFunc $ \_ c r _ ->
+ return (fromBool (cb (fromIntegral c) (fromIntegral r)))
+ Nothing -> return nullFunPtr
+ gArrPtr <- {#call unsafe g_array_new#} 0 0
+ (fromIntegral (sizeOf (undefined :: VteAttributes)))
+ strPtr <- {#call terminal_get_text #} (toTerminal terminal) cbPtr nullPtr gArrPtr
+ str <- if strPtr==nullPtr then return "" else peekUTFString strPtr
+ (len,elemPtr) <- gArrayContent (castPtr gArrPtr)
+ attrs <- (flip mapM) [0..len-1] $ peekElemOff elemPtr
+ unless (cbPtr==nullFunPtr) $ freeHaskellFunPtr cbPtr
+ {#call unsafe g_free#} (castPtr strPtr)
+ {#call unsafe g_array_free#} gArrPtr 1
+ return (zipWith attrToChar str attrs)
+
+{#pointer VteSelectionFunc#}
+
+foreign import ccall "wrapper" mkVteSelectionFunc ::
+ (Ptr Terminal -> {#type glong#} -> {#type glong#} -> Ptr () -> IO {#type gboolean#})
+ -> IO VteSelectionFunc
+ [_$_]
+ [_$_]
hunk ./vte/Graphics/UI/Gtk/Vte/Vte.chs.pp 951
- -> IO Int -- ^ return an integer associated with this expression Deprecated: 0.17.1 [_$_]
+ -> IO Int -- ^ return an integer associated with this expression
hunk ./vte/Graphics/UI/Gtk/Vte/Vte.chs.pp 956
+
+-- | Flags determining how the regular expression is to be interpreted.
+{#enum GRegexCompileFlags as RegexCompileFlags {underscoreToCase} deriving (Bounded,Eq,Show) #}
+
+instance Flags RegexCompileFlags
+
+-- | Flags determining how the string is matched against the regular
+-- expression.
+{#enum GRegexMatchFlags as RegexMatchFlags {underscoreToCase} deriving (Bounded,Eq,Show) #}
+
+instance Flags RegexMatchFlags
hunk ./vte/Graphics/UI/Gtk/Vte/Vte.chs.pp 973
--- TODO:
--- terminalMatchAddGregex [_$_]
+terminalMatchAddRegex ::
+ TerminalClass self => self
+ -> String -- ^ @pattern@ - a regular expression
+ -> [RegexCompileFlags] -- ^ @flags@ - specify how to interpret the pattern
+ -> [RegexMatchFlags] -- ^ @flags@ - specify how to match
+ -> IO Int -- ^ return an integer associated with this expression
+terminalMatchAddRegex terminal pattern cFlags mFlags =
+ withUTFString pattern $ \pat -> do
+ regexPtr <- propagateGError $
+ {#call g_regex_new#} pat (fromIntegral (fromFlags cFlags))
+ (fromIntegral (fromFlags mFlags))
+ liftM fromIntegral $ {#call terminal_match_add_gregex#}
+ (toTerminal terminal) regexPtr (fromIntegral (fromFlags mFlags))
addfile ./vte/Graphics/UI/Gtk/Vte/VteCharAttrFields.c
hunk ./vte/Graphics/UI/Gtk/Vte/VteCharAttrFields.c 1
+#include "VteCharAttrFields.h"
+
+gboolean getVteCharAttrUnderline(VteCharAttributes* vca) {
+ return vca->underline;
+}
+
+gboolean getVteCharAttrStrikethrough(VteCharAttributes* vca) {
+ return vca->strikethrough;
+}
+
addfile ./vte/Graphics/UI/Gtk/Vte/VteCharAttrFields.h
hunk ./vte/Graphics/UI/Gtk/Vte/VteCharAttrFields.h 1
+#ifndef VTE_CHAR_ATTR_FIELDS_H
+#define VTE_CHAR_ATTR_FIELDS_H
+
+#include <vte/vte.h>
+
+gboolean getVteCharAttrUnderline(VteCharAttributes* vca);
+
+gboolean getVteCharAttrStrikethrough(VteCharAttributes* vca);
+
+#endif /* VTE_CHAR_ATTR_FIELDS_H */
|
