diff options
Diffstat (limited to 'lib/Phi/X11')
| -rw-r--r-- | lib/Phi/X11/AtomList.hs | 19 | ||||
| -rw-r--r-- | lib/Phi/X11/Atoms.hs | 13 |
2 files changed, 27 insertions, 5 deletions
diff --git a/lib/Phi/X11/AtomList.hs b/lib/Phi/X11/AtomList.hs index d18be71..b91ae3e 100644 --- a/lib/Phi/X11/AtomList.hs +++ b/lib/Phi/X11/AtomList.hs @@ -1,8 +1,16 @@ +{-# LANGUAGE TemplateHaskell #-} + module Phi.X11.AtomList ( atoms + , specialAtoms ) where +import Language.Haskell.TH + +import Graphics.X11.Xlib + +atoms :: [String] atoms = [ "UTF8_STRING" - , "WM_NAME" + , "MANAGER" , "_NET_WM_NAME" , "_NET_WM_WINDOW_TYPE" , "_NET_WM_WINDOW_TYPE_NORMAL" @@ -20,6 +28,10 @@ atoms = [ "UTF8_STRING" , "_NET_WM_STATE_BELOW" , "_NET_WM_STRUT" , "_NET_WM_STRUT_PARTIAL" + , "_NET_WM_PID" + , "_NET_SYSTEM_TRAY_OPCODE" + , "_NET_SYSTEM_TRAY_ORIENTATION" + , "_NET_SYSTEM_TRAY_VISUAL" , "_NET_ACTIVE_WINDOW" , "_NET_NUMBER_OF_DESKTOPS" , "_NET_CURRENT_DESKTOP" @@ -28,3 +40,8 @@ atoms = [ "UTF8_STRING" , "_XROOTPMAP_ID" , "_XROOTMAP_ID" ] + +-- the expression must have the type (Display -> String) +specialAtoms :: [(String, Q Exp)] +specialAtoms = [ ("_NET_SYSTEM_TRAY_SCREEN", [|("_NET_SYSTEM_TRAY_S" ++) . show . defaultScreen|]) + ]
\ No newline at end of file diff --git a/lib/Phi/X11/Atoms.hs b/lib/Phi/X11/Atoms.hs index 38f8f3c..acbae64 100644 --- a/lib/Phi/X11/Atoms.hs +++ b/lib/Phi/X11/Atoms.hs @@ -12,7 +12,7 @@ import Phi.X11.AtomList $(let atomsName = mkName "Atoms" - atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) atoms + atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) $ atoms ++ (map fst specialAtoms) fields = map (\(_, name) -> (name, IsStrict, ConT ''Atom)) atomNames in return [DataD [] atomsName [] [RecC atomsName fields] []] ) @@ -20,12 +20,17 @@ $(let atomsName = mkName "Atoms" initAtoms :: Display -> IO Atoms initAtoms display = $(do - atomNames <- mapM (\atom -> do + normalAtomNames <- mapM (\atom -> do varName <- newName ('_':atom) - return (atom, mkName ("atom" ++ atom), varName) + return ([|const atom|], mkName ("atom" ++ atom), varName) ) atoms + specialAtomNames <- mapM (\(name, atomgen) -> do + varName <- newName ('_':name) + return (atomgen, mkName ("atom" ++ name), varName) + ) specialAtoms + let atomNames = normalAtomNames ++ specialAtomNames atomInitializers <- forM atomNames $ - \(atom, _, varName) -> liftM (BindS (VarP varName)) [| internAtom display atom False |] + \(atomgen, _, varName) -> liftM (BindS (VarP varName)) [| internAtom display ($atomgen display) False |] let atomFieldExps = map (\(_, atomName, varName) -> (atomName, VarE varName)) atomNames atomsName = mkName "Atoms" |