From a52c4a076807ae04db67894aebd741924ff9f926 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Wed, 8 Aug 2012 20:24:53 +0200 Subject: Modularize Window handling functions These functions are about creation, positioning and property setting of the xmobar window. An own module does them justice and eases the task of adding functions for revealing/hiding and toggling the window. --- src/Window.hs | 137 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 137 insertions(+) create mode 100644 src/Window.hs (limited to 'src/Window.hs') diff --git a/src/Window.hs b/src/Window.hs new file mode 100644 index 0000000..34ecbf4 --- /dev/null +++ b/src/Window.hs @@ -0,0 +1,137 @@ +module Window where + +import Prelude hiding (catch) +import Graphics.X11.Xlib hiding (textExtents, textWidth) +import Graphics.X11.Xlib.Extras +import Graphics.X11.Xinerama + +import Control.Monad.Reader +import Data.Maybe(fromMaybe) +import System.Posix.Process (getProcessID) + +import Config +import XUtil + +-- $window + +-- | The function to create the initial window +createWin :: Display -> XFont -> Config -> IO (Rectangle,Window) +createWin d fs c = do + let dflt = defaultScreen d + srs <- getScreenInfo d + rootw <- rootWindow d dflt + (as,ds) <- textExtents fs "0" + let ht = as + ds + 4 + (r,o) = setPosition (position c) srs (fi ht) + win <- newWindow d (defaultScreenOfDisplay d) rootw r o + setProperties r c d win srs + when (lowerOnStart c) (lowerWindow d win) + mapWindow d win + return (r,win) + +-- | Updates the size and position of the window +repositionWin :: Display -> Window -> XFont -> Config -> IO Rectangle +repositionWin d win fs c = do + srs <- getScreenInfo d + (as,ds) <- textExtents fs "0" + let ht = as + ds + 4 + (r,_) = setPosition (position c) srs (fi ht) + moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r) + setProperties r c d win srs + return r + +setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool) +setPosition p rs ht = + case p' of + Top -> (Rectangle rx ry rw h, True) + TopW a i -> (Rectangle (ax a i) ry (nw i) h, True) + TopSize a i ch -> (Rectangle (ax a i) ry (nw i) (mh ch), True) + Bottom -> (Rectangle rx ny rw h, True) + BottomW a i -> (Rectangle (ax a i) ny (nw i) h, True) + BottomSize a i ch -> (Rectangle (ax a i) (ny' ch) (nw i) (mh ch), True) + Static cx cy cw ch -> (Rectangle (fi cx) (fi cy) (fi cw) (fi ch), True) + OnScreen _ p'' -> setPosition p'' [scr] ht + where + (scr@(Rectangle rx ry rw rh), p') = + case p of OnScreen i x -> (fromMaybe (head rs) $ safeIndex i rs, x) + _ -> (head rs, p) + ny = ry + fi (rh - ht) + center i = rx + fi (div (remwid i) 2) + right i = rx + fi (remwid i) + remwid i = rw - pw (fi i) + ax L = const rx + ax R = right + ax C = center + pw i = rw * min 100 i `div` 100 + nw = fi . pw . fi + h = fi ht + mh h' = max (fi h') h + ny' h' = ry + fi (rh - mh h') + safeIndex i = lookup i . zip [0..] + +setProperties :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO () +setProperties r c d w srs = do + a1 <- internAtom d "_NET_WM_STRUT_PARTIAL" False + c1 <- internAtom d "CARDINAL" False + a2 <- internAtom d "_NET_WM_WINDOW_TYPE" False + c2 <- internAtom d "ATOM" False + v <- internAtom d "_NET_WM_WINDOW_TYPE_DOCK" False + p <- internAtom d "_NET_WM_PID" False + + setTextProperty d w "xmobar" wM_CLASS + setTextProperty d w "xmobar" wM_NAME + + changeProperty32 d w a1 c1 propModeReplace $ map fi $ + getStrutValues r (position c) (getRootWindowHeight srs) + changeProperty32 d w a2 c2 propModeReplace [fromIntegral v] + + getProcessID >>= changeProperty32 d w p c1 propModeReplace . return . fromIntegral + +getRootWindowHeight :: [Rectangle] -> Int +getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs) + where + getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr) + +getStrutValues :: Rectangle -> XPosition -> Int -> [Int] +getStrutValues r@(Rectangle x y w h) p rwh = + case p of + OnScreen _ p' -> getStrutValues r p' rwh + Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] + TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] + TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] + Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] + BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] + BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] + Static {} -> getStaticStrutValues p rwh + where st = fi y + fi h + sb = rwh - fi y + nx = fi x + nw = fi (x + fi w - 1) + +-- get some reaonable strut values for static placement. +getStaticStrutValues :: XPosition -> Int -> [Int] +getStaticStrutValues (Static cx cy cw ch) rwh + -- if the yPos is in the top half of the screen, then assume a Top + -- placement, otherwise, it's a Bottom placement + | cy < (rwh `div` 2) = [0, 0, st, 0, 0, 0, 0, 0, xs, xe, 0, 0] + | otherwise = [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, xs, xe] + where st = cy + ch + sb = rwh - cy + xs = cx -- a simple calculation for horizontal (x) placement + xe = xs + cw +getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] + +drawBorder :: Border -> Display -> Drawable -> GC -> Pixel + -> Dimension -> Dimension -> IO () +drawBorder b d p gc c wi ht = case b of + NoBorder -> return () + TopB -> drawBorder (TopBM 0) d p gc c w h + BottomB -> drawBorder (BottomBM 0) d p gc c w h + FullB -> drawBorder (FullBM 0) d p gc c w h + TopBM m -> sf >> drawLine d p gc 0 (fi m) (fi w) 0 + BottomBM m -> let rw = fi h - fi m in + sf >> drawLine d p gc 0 rw (fi w) rw + FullBM m -> let pad = 2 * fi m; mp = fi m in + sf >> drawRectangle d p gc mp mp (w - pad) (h - pad) + where sf = setForeground d gc c + (w, h) = (wi - 1, ht - 1) -- cgit v1.2.3 From fa4b999c73067cb55e316b94fe62aebb147cea98 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Thu, 9 Aug 2012 10:12:39 +0200 Subject: Create signal handler in main and pass it down to the start* functions This is necessary for setting up the signal callback (trigger) from the Plugin interface. As another benefit it is now possible to implement the lowerOnStart config option properly by simply sending a Hide signal in startLoop. --- src/Main.hs | 7 +++++-- src/Window.hs | 1 - src/Xmobar.hs | 14 ++++++++------ 3 files changed, 13 insertions(+), 9 deletions(-) (limited to 'src/Window.hs') diff --git a/src/Main.hs b/src/Main.hs index 4c3f351..c7045b5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -36,6 +36,8 @@ import System.Environment import System.Posix.Files import Control.Monad (unless) +import Signal (setupSignalHandler, SignalType(..)) + -- $main -- | The main entry point @@ -55,9 +57,10 @@ main = do conf <- doOpts c o fs <- initFont d (font conf) cls <- mapM (parseTemplate conf) (splitTemplate conf) - vars <- mapM (mapM startCommand) cls + sig <- setupSignalHandler + vars <- mapM (mapM $ startCommand sig) cls (r,w) <- createWin d fs conf - startLoop (XConf d r w fs conf) vars + startLoop (XConf d r w fs conf) sig vars -- | Splits the template in its parts splitTemplate :: Config -> [String] diff --git a/src/Window.hs b/src/Window.hs index 34ecbf4..4917f57 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -25,7 +25,6 @@ createWin d fs c = do (r,o) = setPosition (position c) srs (fi ht) win <- newWindow d (defaultScreenOfDisplay d) rootw r o setProperties r c d win srs - when (lowerOnStart c) (lowerWindow d win) mapWindow d win return (r,win) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 6c2965c..1b58352 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -71,10 +71,10 @@ runX :: XConf -> X () -> IO () runX xc f = runReaderT f xc -- | Starts the main event loop and threads -startLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO () -startLoop xcfg@(XConf _ _ w _ _) vs = do +startLoop :: XConf -> MVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO () +startLoop xcfg@(XConf _ _ w _ conf) sig vs = do tv <- atomically $ newTVar [] - sig <- setupSignalHandler + when (lowerOnStart conf) $ putMVar sig Hide _ <- forkIO (checker tv [] vs sig `catch` \(SomeException _) -> void (putStrLn "Thread checker failed")) #ifdef THREADED_RUNTIME @@ -156,19 +156,21 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do o -> return (ocfg {position = OnScreen 1 o}) - -- $command -- | Runs a command as an independent thread and returns its thread id -- and the TVar the command will be writing to. -startCommand :: (Runnable,String,String) -> IO (Maybe ThreadId, TVar String) -startCommand (com,s,ss) +startCommand :: MVar SignalType + -> (Runnable,String,String) + -> IO (Maybe ThreadId, TVar String) +startCommand sig (com,s,ss) | alias com == "" = do var <- atomically $ newTVar is atomically $ writeTVar var (s ++ ss) return (Nothing,var) | otherwise = do var <- atomically $ newTVar is let cb str = atomically $ writeTVar var (s ++ str ++ ss) h <- forkIO $ start com cb + _ <- forkIO $ trigger com ( maybe (return ()) (putMVar sig) ) return (Just h,var) where is = s ++ "Updating..." ++ ss -- cgit v1.2.3 From cc77b5a7bc8309f694fd0aed4110b92f16316c0b Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Wed, 8 Aug 2012 20:30:40 +0200 Subject: Add functions for {reveal,hid,toggl}ing the window Toggling is based is based on the current window status. If unmapped then reveal else hide. Sync is necessary or delays might occur. The functions are called from the event loop when the according signal is received When mapping (revealing) the window again we need to set the struts property again. The easiest way to do this is to call repositionWin. However, repositionWin needs access to the Config structure which is available in eventLoop. Because decomposition wouldn't be easy and I don't want to pass Config down to showWindow (which would need to return the new Rectangle then) this is done here. --- src/Window.hs | 15 +++++++++++++++ src/Xmobar.hs | 11 +++++++++++ 2 files changed, 26 insertions(+) (limited to 'src/Window.hs') diff --git a/src/Window.hs b/src/Window.hs index 4917f57..e59c5ff 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -134,3 +134,18 @@ drawBorder b d p gc c wi ht = case b of sf >> drawRectangle d p gc mp mp (w - pad) (h - pad) where sf = setForeground d gc c (w, h) = (wi - 1, ht - 1) + +hideWindow :: Display -> Window -> IO () +hideWindow d w = do + a <- internAtom d "_NET_WM_STRUT_PARTIAL" False + c <- internAtom d "CARDINAL" False + changeProperty32 d w a c propModeReplace $ replicate 12 0 + unmapWindow d w + sync d False + +showWindow :: Display -> Window -> IO () +showWindow d w = mapWindow d w >> sync d False + +isMapped :: Display -> Window -> IO Bool +isMapped d w = fmap ism $ getWindowAttributes d w + where ism (WindowAttributes { wa_map_state = wms }) = wms /= waIsUnmapped diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 1b58352..a65a236 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -140,7 +140,18 @@ eventLoop tv xc@(XConf d _ w fs cfg) signal = do ncfg <- updateConfigPosition cfg reposWindow ncfg + Hide -> hide + Reveal -> reveal + Toggle -> toggle + where + hide = hideWindow d w >> eventLoop tv xc signal + reveal = do + r' <- repositionWin d w fs cfg + showWindow d w + eventLoop tv (XConf d r' w fs cfg) signal + toggle = isMapped d w >>= \b -> if b then hide else reveal + reposWindow rcfg = do r' <- repositionWin d w fs rcfg eventLoop tv (XConf d r' w fs rcfg) signal -- cgit v1.2.3 From 58427c76c892334522dfb28ea2d2a858469fc65a Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Thu, 9 Aug 2012 09:43:49 +0200 Subject: Cosmetic surgery Realign methods, remove unnecessary imports and remove clutter --- src/Commands.hs | 16 ++++++++-------- src/Main.hs | 2 +- src/Plugins/BufferedPipeReader.hs | 6 ------ src/Window.hs | 1 - 4 files changed, 9 insertions(+), 16 deletions(-) (limited to 'src/Window.hs') diff --git a/src/Commands.hs b/src/Commands.hs index f31c53c..b501022 100644 --- a/src/Commands.hs +++ b/src/Commands.hs @@ -35,14 +35,14 @@ import Signal import XUtil class Show e => Exec e where - alias :: e -> String - alias e = takeWhile (not . isSpace) $ show e - rate :: e -> Int - rate _ = 10 - run :: e -> IO String - run _ = return "" - start :: e -> (String -> IO ()) -> IO () - start e cb = go + alias :: e -> String + alias e = takeWhile (not . isSpace) $ show e + rate :: e -> Int + rate _ = 10 + run :: e -> IO String + run _ = return "" + start :: e -> (String -> IO ()) -> IO () + start e cb = go where go = run e >>= cb >> tenthSeconds (rate e) >> go trigger :: e -> (Maybe SignalType -> IO ()) -> IO () trigger _ sh = sh Nothing diff --git a/src/Main.hs b/src/Main.hs index c7045b5..5ef5db6 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -36,7 +36,7 @@ import System.Environment import System.Posix.Files import Control.Monad (unless) -import Signal (setupSignalHandler, SignalType(..)) +import Signal (setupSignalHandler) -- $main diff --git a/src/Plugins/BufferedPipeReader.hs b/src/Plugins/BufferedPipeReader.hs index 1fb9dcb..e232916 100644 --- a/src/Plugins/BufferedPipeReader.hs +++ b/src/Plugins/BufferedPipeReader.hs @@ -18,18 +18,12 @@ import Control.Monad(forM_, when) import Control.Concurrent import Control.Concurrent.STM import System.IO --- import System.IO.Unsafe(unsafePerformIO) import Plugins data BufferedPipeReader = BufferedPipeReader String [(Int, String)] deriving (Read, Show) --- pipeState :: MVar String --- pipeState = unsafePerformIO $ newMVar "" - --- pipe :: (String -> IO ()) -> Handle -> IO () --- pipe cb h = hGetLineSafe h >>= cb instance Exec BufferedPipeReader where alias ( BufferedPipeReader a _ ) = a diff --git a/src/Window.hs b/src/Window.hs index e59c5ff..9024fff 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -5,7 +5,6 @@ import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama -import Control.Monad.Reader import Data.Maybe(fromMaybe) import System.Posix.Process (getProcessID) -- cgit v1.2.3 From b8cf77207eb7dfa99f842f5b7e63fee95efe3796 Mon Sep 17 00:00:00 2001 From: Jochen Keil Date: Mon, 13 Aug 2012 07:28:55 +0200 Subject: Revert lowerOnStart to its original behaviour I misunderstood the intention of lowerOnStart and changed the implementation to what I thought it would have to do. This was wrong indeed, so back to original behaviour. --- readme.md | 3 --- src/Window.hs | 1 + src/Xmobar.hs | 1 - 3 files changed, 1 insertion(+), 4 deletions(-) (limited to 'src/Window.hs') diff --git a/readme.md b/readme.md index 1c13d27..7d06087 100644 --- a/readme.md +++ b/readme.md @@ -221,9 +221,6 @@ Other configuration options: : position = Top -`lowerOnStart` -: When True the window is initially hidden (can be toggled) - `persistent` : When True the window status is fixed i.e. hiding or revealing is not possible. This option can be toggled at runtime. diff --git a/src/Window.hs b/src/Window.hs index 9024fff..50bfc56 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -24,6 +24,7 @@ createWin d fs c = do (r,o) = setPosition (position c) srs (fi ht) win <- newWindow d (defaultScreenOfDisplay d) rootw r o setProperties r c d win srs + when (lowerOnStart c) (lowerWindow d win) mapWindow d win return (r,win) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index d758301..5328b6e 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -78,7 +78,6 @@ runX xc f = runReaderT f xc startLoop :: XConf -> MVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO () startLoop xcfg@(XConf _ _ w _ conf) sig vs = do tv <- atomically $ newTVar [] - when (lowerOnStart conf) $ putMVar sig Hide _ <- forkIO (checker tv [] vs sig `catch` \(SomeException _) -> void (putStrLn "Thread checker failed")) #ifdef THREADED_RUNTIME -- cgit v1.2.3 From b3bdd804bda130d1ec0a66192e633ee0e0a476ca Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 13 Aug 2012 14:57:31 +0200 Subject: Missing import for 'when' --- src/Window.hs | 1 + 1 file changed, 1 insertion(+) (limited to 'src/Window.hs') diff --git a/src/Window.hs b/src/Window.hs index 50bfc56..a069f1f 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -1,6 +1,7 @@ module Window where import Prelude hiding (catch) +import Control.Monad (when) import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras import Graphics.X11.Xinerama -- cgit v1.2.3 From bf525097ee78c008f2c96653b3c4eb03f4923246 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 13 Aug 2012 15:09:42 +0200 Subject: Missing file headers and linting --- src/Signal.hs | 16 ++++++++++++++++ src/Window.hs | 15 +++++++++++++++ src/Xmobar.hs | 2 +- 3 files changed, 32 insertions(+), 1 deletion(-) (limited to 'src/Window.hs') diff --git a/src/Signal.hs b/src/Signal.hs index f634c16..3c341f9 100644 --- a/src/Signal.hs +++ b/src/Signal.hs @@ -1,5 +1,21 @@ {-# LANGUAGE DeriveDataTypeable, CPP #-} +----------------------------------------------------------------------------- +-- | +-- Module : Signal +-- Copyright : (c) Andrea Rosatto +-- : (c) Jose A. Ortega Ruiz +-- : (c) Jochen Keil +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- Signal handling, including DBUS when available +-- +----------------------------------------------------------------------------- + module Signal where import Data.Typeable (Typeable) diff --git a/src/Window.hs b/src/Window.hs index a069f1f..0ffa139 100644 --- a/src/Window.hs +++ b/src/Window.hs @@ -1,3 +1,18 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Window +-- Copyright : (c) 2011-12 Jose A. Ortega Ruiz +-- : (c) 2012 Jochen Keil +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Jose A. Ortega Ruiz +-- Stability : unstable +-- Portability : unportable +-- +-- Window manipulation functions +-- +----------------------------------------------------------------------------- + module Window where import Prelude hiding (catch) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 5328b6e..2dbba11 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -76,7 +76,7 @@ runX xc f = runReaderT f xc -- | Starts the main event loop and threads startLoop :: XConf -> MVar SignalType -> [[(Maybe ThreadId, TVar String)]] -> IO () -startLoop xcfg@(XConf _ _ w _ conf) sig vs = do +startLoop xcfg@(XConf _ _ w _ _) sig vs = do tv <- atomically $ newTVar [] _ <- forkIO (checker tv [] vs sig `catch` \(SomeException _) -> void (putStrLn "Thread checker failed")) -- cgit v1.2.3