neocturne/phi
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Renamed binaries to lowercase

Browse source
This commit is contained in:
Matthias Schiffer 2011-10-17 21:16:01 +02:00
parent 33cd402ae9
commit 3e1ca80912
5 changed files with 62 additions and 19 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lib/Phi/X11.hs
View file

@ -167,12 +167,14 @@ runPhi xconfig config widget = do
forM_ panels $ liftIO . mapWindow conn . panelWindow
liftIO $ forkIO $ receiveEvents phi conn
liftIO $ do
forkIO $ receiveEvents phi conn
forkIO $ receiveErrors phi conn
forever $ do
available <- messageAvailable phi
repaint <- gets phiRepaint
when (not available && repaint) $ liftIO $ threadDelay 30000
when (not available && repaint) $ liftIO $ threadDelay 20000
available <- messageAvailable phi
when (not available && repaint) $ do
@ -311,6 +313,10 @@ receiveEvents :: Phi -> Connection -> IO ()
receiveEvents phi conn =
forever $ receiveEvents' conn >>= sendMessages phi
receiveErrors :: Phi -> Connection -> IO ()
receiveErrors phi conn =
forever $ waitForError conn >>= putStrLn . ("XHB error: " ++) . show
updatePanels :: (Widget w s c X11) => PhiX w s c ()
updatePanels = do
X11 conn _ screen <- asks phiX11

1
lib/Phi/X11/AtomList.hs
View file

@ -48,6 +48,7 @@ atoms = [ "ATOM"
, "_XEMBED"
, "_XROOTPMAP_ID"
, "_XROOTMAP_ID"
, "PHI_SYSTRAY_HELPER"
]
-- the expression must have the type (ConnectionClass c => c -> String)

8
phi.cabal
View file

@ -20,17 +20,17 @@ library
other-modules: Phi.X11.AtomList, Phi.Bindings.Cairo, Phi.X11.Atoms, Phi.X11.Util
include-dirs: include
hs-source-dirs: lib
pkgconfig-depends: xcb, cairo >= 1.2.0, cairo-xcb
pkgconfig-depends: cairo >= 1.2.0, cairo-xcb
ghc-options: -fspec-constr-count=16 -threaded
executable PhiSystrayHelper
build-depends: base >= 4, template-haskell, xhb >= 0.5, xhb-xcb
executable phi-systray-helper
build-depends: base >= 4, template-haskell, mtl, xhb >= 0.5, xhb-xcb
hs-source-dirs: src, lib
main-is: SystrayHelper.hs
other-modules: Phi.X11.AtomList, Phi.X11.Atoms, Phi.X11.Util
ghc-options: -threaded
executable Phi
executable phi
build-depends: base >= 4, phi
hs-source-dirs: src
main-is: Phi.hs

6
src/Phi.hs
View file

@ -48,9 +48,9 @@ main = do
--theSystray = systray
theClock = clock defaultClockConfig { clockFormat = "<span font='Sans 8'>%R</span>\n<span font='Sans 6'>%a, %b %d</span>"
, lineSpacing = (-3)
, clockSize = 60
theClock = clock defaultClockConfig { clockFormat = "<span font='Sans 7'>%R</span>\n<span font='Sans 6'>%a, %b %d</span>"
, lineSpacing = (-1)
, clockSize = 55
}
brightBorder :: (Widget w s c d) => w -> Border w s c d
brightBorder = border normalDesktopBorder

56
src/SystrayHelper.hs
View file

@ -1,5 +1,8 @@
import Control.Concurrent
import Control.Monad
import Control.Monad.State.Strict
import Data.Word
import Data.Maybe
import Graphics.XHB
@ -12,36 +15,53 @@ import Phi.X11.Atoms
import Phi.X11.Util
{-sYSTEM_TRAY_REQUEST_DOCK :: CInt
sYSTEM_TRAY_REQUEST_DOCK :: Word32
sYSTEM_TRAY_REQUEST_DOCK = 0
sYSTEM_TRAY_BEGIN_MESSAGE :: CInt
sYSTEM_TRAY_BEGIN_MESSAGE :: Word32
sYSTEM_TRAY_BEGIN_MESSAGE = 1
sYSTEM_TRAY_CANCEL_MESSAGE :: CInt
sYSTEM_TRAY_CANCEL_MESSAGE :: Word32
sYSTEM_TRAY_CANCEL_MESSAGE = 2
xEMBED_EMBEDDED_NOTIFY :: CInt
xEMBED_EMBEDDED_NOTIFY = 0-}
xEMBED_EMBEDDED_NOTIFY :: Word32
xEMBED_EMBEDDED_NOTIFY = 0
data SystrayState = SystrayState
{ systrayIcons :: [(WINDOW, WINDOW)]
}
main :: IO ()
main = do
conn <- liftM fromJust connect
forkIO $ receiveErrors conn
atoms <- initAtoms conn
let screen = (roots_Setup . connectionSetup $ conn) !! connectionScreen conn
xembedWindow <- initSystray conn atoms screen
(xembedWin, systrayWin) <- initSystray conn atoms screen
execStateT (runSystray xembedWin systrayWin) $ SystrayState []
return ()
receiveErrors :: Connection -> IO ()
receiveErrors conn =
forever $ waitForError conn >>= putStrLn . ("XHB error: " ++) . show
initSystray :: Connection -> Atoms -> SCREEN -> IO WINDOW
initSystray :: Connection -> Atoms -> SCREEN -> IO (WINDOW, WINDOW)
initSystray conn atoms screen = do
currentSystrayWin <- getSelectionOwner conn (atom_NET_SYSTEM_TRAY_SCREEN atoms) >>= getReply' "initSystray: getSelectionOwner failed"
when (currentSystrayWin /= fromXid xidNone) $ do
putStrLn "PhiSystrayHelper: another systray is running."
putStrLn "phi-systray-helper: another systray is running."
exitFailure
currentSystrayHelperWin <- getSelectionOwner conn (atomPHI_SYSTRAY_HELPER atoms) >>= getReply' "initSystray: getSelectionOwner failed"
when (currentSystrayHelperWin /= fromXid xidNone) $ do
putStrLn "phi-systray-helper: another systray helper is running."
exitFailure
let rootwin = root_SCREEN screen
@ -60,11 +80,27 @@ initSystray conn atoms screen = do
systrayWin <- getSelectionOwner conn (atom_NET_SYSTEM_TRAY_SCREEN atoms) >>= getReply' "initSystray: getSelectionOwner failed"
when (systrayWin /= xembedWin) $ do
destroyWindow conn xembedWin
putStrLn $ "PhiSystrayHelper: can't initialize systray."
putStrLn $ "phi-systray-helper: can't initialize systray."
exitFailure
systrayWin <- newResource conn
createWindow conn $ MkCreateWindow depth systrayWin rootwin (-1) (-1) 1 1 0 WindowClassInputOutput visual emptyValueParam
setSelectionOwner conn $ MkSetSelectionOwner systrayWin (atomPHI_SYSTRAY_HELPER atoms) 0
systrayHelperWin <- getSelectionOwner conn (atomPHI_SYSTRAY_HELPER atoms) >>= getReply' "initSystray: getSelectionOwner failed"
when (systrayHelperWin /= systrayWin) $ do
destroyWindow conn systrayHelperWin
destroyWindow conn xembedWin
putStrLn $ "phi-systray-helper: can't initialize systray helper."
exitFailure
sendEvent conn $ MkSendEvent False rootwin [EventMaskStructureNotify] $
serializeClientMessage $ MkClientMessageEvent 32 rootwin (atomMANAGER atoms) $
ClientData32 [0, fromXid . toXid $ atom_NET_SYSTEM_TRAY_SCREEN atoms, fromXid . toXid $ xembedWin, 0, 0]
return xembedWin
return (xembedWin, systrayWin)
runSystray :: WINDOW -> WINDOW -> StateT SystrayState IO ()
runSystray xembedWin systrayWin = do
return ()