diff options
| -rw-r--r-- | scripts/xmonad-status.hs | 161 |
1 files changed, 0 insertions, 161 deletions
diff --git a/scripts/xmonad-status.hs b/scripts/xmonad-status.hs deleted file mode 100644 index a223204..0000000 --- a/scripts/xmonad-status.hs +++ /dev/null @@ -1,161 +0,0 @@ -{-# OPTIONS -fglasgow-exts #-} ------------------------------------------------------------------------------ --- | --- Module : xmonad-status.hs --- Copyright : (c) Don Stewart 2007 --- License : BSD3-style --- Maintainer : dons@cse.unsw.edu.au --- --- An external statusbar-client for xmonad. --- --- Prints the workspaces in a simple form, read from the logging output --- of xmonad. --- --- An example use: --- --- -{- - -#!/bin/sh -# -# launch xmonad, with a couple of dzens to run the status bar -# send xmonad state over a named pipe -# - -FG='#a8a3f7' -BG='#3f3c6d' -FONT="-xos4-terminus-medium-r-normal--16-160-72-72-c-80-iso8859-1" - -PATH=/home/dons/bin:$PATH - -# simple xmonad use, no interactive status bar. -# -#clock | dzen2 -ta r -fg $FG -bg $BG -fn $FONT & -#exec xmonad - -# -# with a pipe talking to an external program -# -PIPE=$HOME/.xmonad-status -rm -f $PIPE -/sbin/mkfifo -m 600 $PIPE -[ -p $PIPE ] || exit - -# launch the external 60 second clock, and launch the workspace status bar -clock | dzen2 -e '' -x 300 -w 768 -ta r -fg $FG -bg $BG -fn $FONT & -xmonad-status < $PIPE | dzen2 -e '' -w 300 -ta l -fg $FG -bg $BG -fn $FONT & - -# now go for it -xmonad > $PIPE & - -# wait for xmonad -wait $! - -pkill -HUP dzen2 -pkill -HUP ssh-agent -pkill -HUP -f clock -pkill -HUP -f xmonad-status - -# wait for all clients -wait - --} - --- --- Creates a workspace table on the left side of the screen. --- --- A version that perfectly emulates wmii or dwm could be distributed. --- ------------------------------------------------------------------------------ - -import Data.List -import StackSet -import XMonad -import System.IO -import Text.PrettyPrint -import Control.Exception - --- --- parse the StackSet output, and print it in the form: --- --- 1 [2] 4 8 --- --- It's an example of how to write a Haskell script to hack --- the structure defined in StackSet.hs --- - -main :: IO () -main = forever $ do s <- getLine - handle (\e -> throwDyn (show e ++ show s)) - (readIO s >>= draw) - where - forever a = catchDyn (loop a) (debug a) >> forever a - where - loop a = a >> loop a - debug a e = hPutStrLn stderr e >> forever a - --- --- All the magic is in the 'ppr' instances, below. --- -draw :: WS -> IO () -draw s = do putStrLn . render . ppr $ s - hFlush stdout - --- --------------------------------------------------------------------- --- --- A simple recursive descent pretty printer for the StackSet type. --- -class Pretty a where - ppr :: a -> Doc - --- --- And instances for the StackSet layers --- -instance Pretty WS where - ppr (StackSet { current = cws -- the different workspaces - , visible = vws - , hidden = hws }) = ppr (sortBy tags workspaces) - where - -- tag each workspace with its flavour - workspaces = C (workspace cws) : map (V . workspace) vws ++ map H hws - - -- sort them by their tags - tags a b = (tag.unWrap) a `compare` (tag.unWrap) b - --- --- How to print each workspace kind --- -instance Pretty TaggedW where - ppr (C w) = brackets (int (1 + fromIntegral (tag w))) -- [1] - ppr (V w) = parens (ppr w) -- <2> - ppr (H w) = ppr w - --- tags are printed as integers (or map them to strings) -instance Pretty W where --- Just print int tags: - ppr (Workspace i s) = - case s of - Empty -> empty - _ -> char ' ' <> int (1 + fromIntegral i) <> char ' ' - -instance Pretty a => Pretty [a] where - ppr [] = empty - ppr (x:xs) = ppr x <> ppr xs - --- --------------------------------------------------------------------- --- Some type information for the pretty printer - --- We have a fixed workspace type -type W = Workspace WorkspaceId Int -type WS = StackSet WorkspaceId Int ScreenId - --- Introduce a newtype to distinguish different workspace flavours -data TaggedW = C !W -- current - | V !W -- visible - | H !W -- hidden - --- And the ability to unwrap tagged workspaces -unWrap :: TaggedW -> W -unWrap (C w) = w -unWrap (V w) = w -unWrap (H w) = w |