blob: b2c8feaad3a79c77f336d34c509952b10f27d1f2 (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
{-# 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
--
-- # clean up and old status bar pipe
-- rm -f ~/.xmonad.pipe
--
-- # create a new one
-- /sbin/mkfifo -m 600 ~/.xmonad.pipe
--
-- xmonad-status < ~/.xmonad.pipe | dzen2 -ta l -fg $FG -bg $BG -fn $FONT &
-- exec xmonad > ~/.xmonad.pipe
--
-- 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
--
-- parse the StackSet output, and print it in the form:
--
-- *[1] 2 *3 *4 5 6 7 8
--
-- It's an example of how to write a Haskell script to hack
-- the structure defined in StackSet.hs
--
main = forever $ getLine >>= readIO >>= draw
where
forever a = a >> 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
|
