Adjust to patched xhb version
This commit is contained in:
parent
579552b29b
commit
456f9fb6e6
7 changed files with 23 additions and 21 deletions
|
@ -40,6 +40,7 @@ import Graphics.Rendering.Pango.Layout
|
||||||
import Graphics.Rendering.Pango.Font
|
import Graphics.Rendering.Pango.Font
|
||||||
|
|
||||||
import Graphics.XHB
|
import Graphics.XHB
|
||||||
|
import Graphics.XHB.Connection
|
||||||
import Graphics.XHB.Gen.Xproto
|
import Graphics.XHB.Gen.Xproto
|
||||||
|
|
||||||
import Codec.Binary.UTF8.String
|
import Codec.Binary.UTF8.String
|
||||||
|
@ -624,7 +625,7 @@ getWindowGeometry x11 window =
|
||||||
fi :: (Integral a, Num b) => a -> b
|
fi :: (Integral a, Num b) => a -> b
|
||||||
fi = fromIntegral
|
fi = fromIntegral
|
||||||
|
|
||||||
showWindow :: Connection -> Atoms -> WINDOW -> IO Bool
|
showWindow :: ConnectionClass c r => c -> Atoms -> WINDOW -> IO Bool
|
||||||
showWindow conn atoms window = do
|
showWindow conn atoms window = do
|
||||||
states <- liftM (map (fromXid . toXid) . fromMaybe []) $ getProperty32 conn window (atom_NET_WM_STATE atoms)
|
states <- liftM (map (fromXid . toXid) . fromMaybe []) $ getProperty32 conn window (atom_NET_WM_STATE atoms)
|
||||||
transientFor <- liftM (map fromIntegral . fromMaybe []) $ getProperty32 conn window (atomWM_TRANSIENT_FOR atoms)
|
transientFor <- liftM (map fromIntegral . fromMaybe []) $ getProperty32 conn window (atomWM_TRANSIENT_FOR atoms)
|
||||||
|
|
|
@ -9,6 +9,7 @@ module Phi.X11 ( X11(..)
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Graphics.XHB hiding (Window)
|
import Graphics.XHB hiding (Window)
|
||||||
|
import Graphics.XHB.Connection
|
||||||
import qualified Graphics.XHB.Connection.Open as CO
|
import qualified Graphics.XHB.Connection.Open as CO
|
||||||
import Graphics.XHB.Gen.Xinerama
|
import Graphics.XHB.Gen.Xinerama
|
||||||
import Graphics.XHB.Gen.Xproto hiding (Window)
|
import Graphics.XHB.Gen.Xproto hiding (Window)
|
||||||
|
@ -54,10 +55,7 @@ instance Display X11 where
|
||||||
type Window X11 = WINDOW
|
type Window X11 = WINDOW
|
||||||
|
|
||||||
|
|
||||||
newtype XEvent = XEvent SomeEvent deriving Typeable
|
newtype XEvent = XEvent SomeEvent deriving (Show, Typeable)
|
||||||
|
|
||||||
instance Show XEvent where
|
|
||||||
show _ = "XEvent (..)"
|
|
||||||
|
|
||||||
data XMessage = UpdateScreens [(Rectangle, WINDOW)] deriving (Show, Typeable)
|
data XMessage = UpdateScreens [(Rectangle, WINDOW)] deriving (Show, Typeable)
|
||||||
|
|
||||||
|
@ -274,7 +272,8 @@ handleConfigureNotifyEvent MkConfigureNotifyEvent { window_ConfigureNotifyEvent
|
||||||
let rect = panelBounds config screenarea
|
let rect = panelBounds config screenarea
|
||||||
win = panelWindow panel
|
win = panelWindow panel
|
||||||
|
|
||||||
liftIO $ configureWindow conn win $ toValueParam [ (ConfigWindowX, fromIntegral $ rect_x rect)
|
liftIO $ configureWindow conn $ MkConfigureWindow win (toMask [ConfigWindowX, ConfigWindowY, ConfigWindowWidth, ConfigWindowHeight]) $
|
||||||
|
toValueParam [ (ConfigWindowX, fromIntegral $ rect_x rect)
|
||||||
, (ConfigWindowY, fromIntegral $ rect_y rect)
|
, (ConfigWindowY, fromIntegral $ rect_y rect)
|
||||||
, (ConfigWindowWidth, fromIntegral $ rect_width rect)
|
, (ConfigWindowWidth, fromIntegral $ rect_width rect)
|
||||||
, (ConfigWindowHeight, fromIntegral $ rect_height rect)
|
, (ConfigWindowHeight, fromIntegral $ rect_height rect)
|
||||||
|
|
|
@ -6,7 +6,7 @@ module Phi.X11.AtomList ( atoms
|
||||||
|
|
||||||
import Language.Haskell.TH
|
import Language.Haskell.TH
|
||||||
|
|
||||||
import Graphics.XHB
|
import Graphics.XHB.Connection
|
||||||
import Graphics.XHB.Connection.Open
|
import Graphics.XHB.Connection.Open
|
||||||
|
|
||||||
atoms :: [String]
|
atoms :: [String]
|
||||||
|
|
|
@ -10,6 +10,7 @@ import Data.List
|
||||||
|
|
||||||
import Language.Haskell.TH
|
import Language.Haskell.TH
|
||||||
import Graphics.XHB
|
import Graphics.XHB
|
||||||
|
import Graphics.XHB.Connection
|
||||||
import Graphics.XHB.Gen.Xproto
|
import Graphics.XHB.Gen.Xproto
|
||||||
|
|
||||||
import Phi.X11.AtomList
|
import Phi.X11.AtomList
|
||||||
|
|
|
@ -29,7 +29,7 @@ import Graphics.XHB.Gen.Xproto
|
||||||
import System.IO.Unsafe
|
import System.IO.Unsafe
|
||||||
|
|
||||||
|
|
||||||
getReply' :: String -> Receipt a -> IO a
|
getReply' :: ConnectionClass c r => String -> r a -> IO a
|
||||||
getReply' m = getReply >=> return . fromRight
|
getReply' m = getReply >=> return . fromRight
|
||||||
where
|
where
|
||||||
fromRight (Left _) = error m
|
fromRight (Left _) = error m
|
||||||
|
@ -60,17 +60,17 @@ castToCChar input = unsafePerformIO $
|
||||||
with input $ \ptr ->
|
with input $ \ptr ->
|
||||||
peekArray (sizeOf input) (castPtr ptr)
|
peekArray (sizeOf input) (castPtr ptr)
|
||||||
|
|
||||||
changeProperty8 :: Connection -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word8] -> IO ()
|
changeProperty8 :: ConnectionClass c r => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word8] -> IO ()
|
||||||
changeProperty8 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 8 (genericLength propdata) propdata
|
changeProperty8 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 8 (genericLength propdata) propdata
|
||||||
|
|
||||||
changeProperty16 :: Connection -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word16] -> IO ()
|
changeProperty16 :: ConnectionClass c r => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word16] -> IO ()
|
||||||
changeProperty16 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 16 (genericLength propdata) (castWord16to8 propdata)
|
changeProperty16 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 16 (genericLength propdata) (castWord16to8 propdata)
|
||||||
|
|
||||||
changeProperty32 :: Connection -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word32] -> IO ()
|
changeProperty32 :: ConnectionClass c r => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word32] -> IO ()
|
||||||
changeProperty32 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 32 (genericLength propdata) (castWord32to8 propdata)
|
changeProperty32 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 32 (genericLength propdata) (castWord32to8 propdata)
|
||||||
|
|
||||||
|
|
||||||
getProperty' :: Word8 -> Connection -> WINDOW -> ATOM -> IO (Maybe [Word8])
|
getProperty' :: ConnectionClass c r => Word8 -> c -> WINDOW -> ATOM -> IO (Maybe [Word8])
|
||||||
getProperty' format conn win prop = do
|
getProperty' format conn win prop = do
|
||||||
reply <- getProperty conn (MkGetProperty False win prop (fromXid xidNone) 0 4) >>= getReply
|
reply <- getProperty conn (MkGetProperty False win prop (fromXid xidNone) 0 4) >>= getReply
|
||||||
case reply of
|
case reply of
|
||||||
|
@ -84,13 +84,13 @@ getProperty' format conn win prop = do
|
||||||
Right (MkGetPropertyReply {format_GetPropertyReply = format'}) | format' /= format -> return Nothing
|
Right (MkGetPropertyReply {format_GetPropertyReply = format'}) | format' /= format -> return Nothing
|
||||||
Right (MkGetPropertyReply {value_GetPropertyReply = value}) -> return $ Just value
|
Right (MkGetPropertyReply {value_GetPropertyReply = value}) -> return $ Just value
|
||||||
|
|
||||||
getProperty8 :: Connection -> WINDOW -> ATOM -> IO (Maybe [Word8])
|
getProperty8 :: ConnectionClass c r => c -> WINDOW -> ATOM -> IO (Maybe [Word8])
|
||||||
getProperty8 = getProperty' 8
|
getProperty8 = getProperty' 8
|
||||||
|
|
||||||
getProperty16 :: Connection -> WINDOW -> ATOM -> IO (Maybe [Word16])
|
getProperty16 :: ConnectionClass c r => c -> WINDOW -> ATOM -> IO (Maybe [Word16])
|
||||||
getProperty16 conn win prop = getProperty' 16 conn win prop >>= return . fmap castWord8to16
|
getProperty16 conn win prop = getProperty' 16 conn win prop >>= return . fmap castWord8to16
|
||||||
|
|
||||||
getProperty32 :: Connection -> WINDOW -> ATOM -> IO (Maybe [Word32])
|
getProperty32 :: ConnectionClass c r => c -> WINDOW -> ATOM -> IO (Maybe [Word32])
|
||||||
getProperty32 conn win prop = getProperty' 32 conn win prop >>= return . fmap castWord8to32
|
getProperty32 conn win prop = getProperty' 32 conn win prop >>= return . fmap castWord8to32
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -12,7 +12,7 @@ build-type: Simple
|
||||||
|
|
||||||
|
|
||||||
library
|
library
|
||||||
build-depends: base >= 4, template-haskell, stm, array, containers, transformers, mtl, utf8-string, time, old-locale, xhb,
|
build-depends: base >= 4, template-haskell, stm, array, containers, transformers, mtl, utf8-string, time, old-locale, xhb >= 0.5, xhb-native,
|
||||||
cairo, pango, unix, data-accessor, arrows, CacheArrow
|
cairo, pango, unix, data-accessor, arrows, CacheArrow
|
||||||
exposed-modules: Phi.Types, Phi.Phi, Phi.Panel, Phi.Widget, Phi.Border, Phi.X11
|
exposed-modules: Phi.Types, Phi.Phi, Phi.Panel, Phi.Widget, Phi.Border, Phi.X11
|
||||||
Phi.Widgets.AlphaBox, Phi.Widgets.Clock, Phi.Widgets.X11.Taskbar
|
Phi.Widgets.AlphaBox, Phi.Widgets.Clock, Phi.Widgets.X11.Taskbar
|
||||||
|
@ -24,7 +24,7 @@ library
|
||||||
ghc-options: -fspec-constr-count=16 -threaded
|
ghc-options: -fspec-constr-count=16 -threaded
|
||||||
|
|
||||||
executable PhiSystrayHelper
|
executable PhiSystrayHelper
|
||||||
build-depends: base >= 4, template-haskell, xhb
|
build-depends: base >= 4, template-haskell, xhb >= 0.5, xhb-native
|
||||||
hs-source-dirs: src, lib
|
hs-source-dirs: src, lib
|
||||||
main-is: SystrayHelper.hs
|
main-is: SystrayHelper.hs
|
||||||
other-modules: Phi.X11.AtomList, Phi.X11.Atoms, Phi.X11.Util
|
other-modules: Phi.X11.AtomList, Phi.X11.Atoms, Phi.X11.Util
|
||||||
|
|
|
@ -3,6 +3,7 @@ import Control.Monad
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
|
||||||
import Graphics.XHB
|
import Graphics.XHB
|
||||||
|
import Graphics.XHB.Connection
|
||||||
import Graphics.XHB.Gen.Xproto
|
import Graphics.XHB.Gen.Xproto
|
||||||
import qualified Graphics.XHB.Connection.Open as CO
|
import qualified Graphics.XHB.Connection.Open as CO
|
||||||
|
|
||||||
|
|
Reference in a new issue