[xmonad] servermode patch for xmonad-contrib
Peter Olson
polson2 at hawk.iit.edu
Mon Dec 16 04:34:06 UTC 2013
Some stuff that I have been working on to generalize
XMonad.Hooks.ServerMode so that it will be more useful. This is my first
time contributing to an open-source project, so sorry if I made any
obvious mistakes.
Peter Olson
-------------- next part --------------
1 patch for repository http://code.haskell.org/XMonadContrib:
Sun Dec 15 20:51:00 CST 2013 polson2 at hawk.iit.edu
* Generalized XMonad.Hooks.ServerMode
New patches:
[Generalized XMonad.Hooks.ServerMode
polson2 at hawk.iit.edu**20131216025100
Ignore-this: e58da3b168a1058f32982833ea25a739
] {
hunk ./XMonad/Hooks/ServerMode.hs 4
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.ServerMode
--- Copyright : (c) Andrea Rossato and David Roundy 2007
+-- Copyright : (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007
-- License : BSD-style (see xmonad/LICENSE)
--
hunk ./XMonad/Hooks/ServerMode.hs 7
--- Maintainer : andrea.rossato at unibz.it
+-- Maintainer : polson2 at hawk.iit.edu
-- Stability : unstable
-- Portability : unportable
--
hunk ./XMonad/Hooks/ServerMode.hs 19
-- > import Graphics.X11.Xlib
-- > import Graphics.X11.Xlib.Extras
-- > import System.Environment
+-- > import System.IO
-- > import Data.Char
hunk ./XMonad/Hooks/ServerMode.hs 21
--- >
--- > usage :: String -> String
--- > usage n = "Usage: " ++ n ++ " command number\nSend a command number to a running instance of XMonad"
--- >
+-- >
-- > main :: IO ()
hunk ./XMonad/Hooks/ServerMode.hs 23
--- > main = do
--- > args <- getArgs
--- > pn <- getProgName
--- > let com = case args of
--- > [] -> error $ usage pn
--- > w -> (w !! 0)
--- > sendCommand com
--- >
--- > sendCommand :: String -> IO ()
--- > sendCommand s = do
+-- > main = parse True "XMONAD_COMMAND" =<< getArgs
+-- >
+-- > parse :: Bool -> String -> [String] -> IO ()
+-- > parse input addr args = case args of
+-- > ["--"] | input -> repl addr
+-- > | otherwise -> return ()
+-- > ("--":xs) -> sendAll addr xs
+-- > ("-a":a:xs) -> parse input a xs
+-- > ("-h":_) -> showHelp
+-- > ("--help":_) -> showHelp
+-- > ("-?":_) -> showHelp
+-- > (a@('-':_):_) -> hPutStrLn stderr ("Unknown option " ++ a)
+-- >
+-- > (x:xs) -> sendCommand addr x >> parse False addr xs
+-- > [] | input -> repl addr
+-- > | otherwise -> return ()
+-- >
+-- >
+-- > repl :: String -> IO ()
+-- > repl addr = do e <- isEOF
+-- > case e of
+-- > True -> return ()
+-- > False -> do l <- getLine
+-- > sendCommand addr l
+-- > repl addr
+-- >
+-- > sendAll :: String -> [String] -> IO ()
+-- > sendAll addr ss = foldr (\a b -> sendCommand addr a >> b) (return ()) ss
+-- >
+-- > sendCommand :: String -> String -> IO ()
+-- > sendCommand addr s = do
-- > d <- openDisplay ""
-- > rw <- rootWindow d $ defaultScreen d
hunk ./XMonad/Hooks/ServerMode.hs 56
--- > a <- internAtom d "XMONAD_COMMAND" False
+-- > a <- internAtom d addr False
+-- > m <- internAtom d s False
-- > allocaXEvent $ \e -> do
-- > setEventType e clientMessage
hunk ./XMonad/Hooks/ServerMode.hs 60
--- > setClientMessageEvent e rw a 32 (fromIntegral (read s)) currentTime
+-- > setClientMessageEvent e rw a 32 m currentTime
-- > sendEvent d rw False structureNotifyMask e
-- > sync d False
hunk ./XMonad/Hooks/ServerMode.hs 63
+-- >
+-- > showHelp :: IO ()
+-- > showHelp = do pn <- getProgName
+-- > putStrLn ("Send commands to a running instance of xmonad. xmonad.hs must be configured with XMonad.Hooks.ServerMode to work.\n-a atomname can be used at any point in the command line arguments to change which atom it is sending on.\nIf sent with no arguments or only -a atom arguments, it will read commands from stdin.\nEx:\n" ++ pn ++ " cmd1 cmd2\n" ++ pn ++ " -a XMONAD_COMMAND cmd1 cmd2 cmd3 -a XMONAD_PRINT hello world\n" ++ pn ++ " -a XMONAD_PRINT # will read data from stdin.\nThe atom defaults to XMONAD_COMMAND.")
--
hunk ./XMonad/Hooks/ServerMode.hs 68
--- compile with: @ghc --make sendCommand.hs@
+--
+-- compile with: @ghc --make xmonadctl.hs@
--
-- run with
--
hunk ./XMonad/Hooks/ServerMode.hs 73
--- > sendCommand command number
+-- > xmonadctl command
+--
+-- or with
--
hunk ./XMonad/Hooks/ServerMode.hs 77
--- For instance:
+-- > $ xmonadctl
+-- > command1
+-- > command2
+-- > .
+-- > .
+-- > .
+-- > ^D
--
hunk ./XMonad/Hooks/ServerMode.hs 85
--- > sendCommand 0
+-- Usage will change depending on which event hook(s) you use. More examples are shown below.
--
hunk ./XMonad/Hooks/ServerMode.hs 87
--- will ask to xmonad to print the list of command numbers in
--- stderr (so you can read it in @~\/.xsession-errors@).
-----------------------------------------------------------------------------
module XMonad.Hooks.ServerMode
hunk ./XMonad/Hooks/ServerMode.hs 92
( -- * Usage
-- $usage
- ServerMode (..)
- , serverModeEventHook
+ serverModeEventHook
, serverModeEventHook'
hunk ./XMonad/Hooks/ServerMode.hs 94
+ , serverModeEventHookCmd
+ , serverModeEventHookCmd'
+ , serverModeEventHookF
) where
import Control.Monad (when)
hunk ./XMonad/Hooks/ServerMode.hs 100
+import Data.Maybe
import Data.Monoid
import System.IO
hunk ./XMonad/Hooks/ServerMode.hs 112
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.ServerMode
--- > import XMonad.Actions.Commands
--
hunk ./XMonad/Hooks/ServerMode.hs 113
--- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':
+-- Then edit your @handleEventHook@ by adding the appropriate event hook from below
+
+-- | Executes a command of the list when receiving its index via a special ClientMessageEvent
+-- (indexing starts at 1). Sending index 0 will ask xmonad to print the list of command numbers
+-- in stderr (so that you can read it in @~\/.xsession-errors@). Uses "XMonad.Actions.Commands#defaultCommands" as the default.
--
-- > main = xmonad def { handleEventHook = serverModeEventHook }
hunk ./XMonad/Hooks/ServerMode.hs 120
+--
+-- > xmonadctl 0 # tells xmonad to output command list
+-- > xmonadctl 1 # tells xmonad to switch to workspace 1
--
hunk ./XMonad/Hooks/ServerMode.hs 124
-
-data ServerMode = ServerMode deriving ( Show, Read )
-
--- | Executes a command of the list when receiving its index via a special ClientMessageEvent
--- (indexing starts at 1)
serverModeEventHook :: Event -> X All
serverModeEventHook = serverModeEventHook' defaultCommands
hunk ./XMonad/Hooks/ServerMode.hs 130
-- | serverModeEventHook' additionally takes an action to generate the list of
-- commands.
serverModeEventHook' :: X [(String,X ())] -> Event -> X All
-serverModeEventHook' cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
+serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
+ where helper cmd = do cl <- cmdAction
+ case lookup cmd (zip (map show [1..]) cl) of
+ Just (_,action) -> action
+ Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
+ listOfCommands cl = map (uncurry (++)) $ zip (map show ([1..] :: [Int])) $ map ((++) " - " . fst) cl
+
+
+-- | Executes a command of the list when receiving its name via a special ClientMessageEvent.
+-- Uses "XMonad.Actions.Commands#defaultCommands" as the default.
+--
+-- > main = xmonad def { handleEventHook = serverModeEventHookCmd }
+--
+-- > xmonadctl run # Tells xmonad to generate a run prompt
+--
+serverModeEventHookCmd :: Event -> X All
+serverModeEventHookCmd = serverModeEventHookCmd' defaultCommands
+
+-- | Additionally takes an action to generate the list of commands
+serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All
+serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
+ where helper cmd = do cl <- cmdAction
+ fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl)
+
+-- | Listens for an atom, then executes a callback function whenever it hears it.
+-- A trivial example that prints everything supplied to it on xmonad's standard out:
+--
+-- > main = xmonad def { handleEventHook = serverModeEventHookF "XMONAD_PRINT" (io . putStrLn) }
+--
+-- > xmonadctl -a XMONAD_PRINT "hello world"
+--
+serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
+serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
d <- asks display
hunk ./XMonad/Hooks/ServerMode.hs 164
- a <- io $ internAtom d "XMONAD_COMMAND" False
+ a <- io $ internAtom d key False
when (mt == a && dt /= []) $ do
hunk ./XMonad/Hooks/ServerMode.hs 166
- cl <- cmdAction
- let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst)
- case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
- Just (_,action) -> action
- Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
+ let atom = fromIntegral $ toInteger $ foldr1 (\a b -> a + (b*2^32)) dt
+ cmd <- io $ getAtomName d atom
+ case cmd of
+ Just command -> func command
+ Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom))
return (All True)
hunk ./XMonad/Hooks/ServerMode.hs 172
-serverModeEventHook' _ _ = return (All True)
+serverModeEventHookF _ _ _ = return (All True)
}
Context:
[fix UrgencyHook and add filterUrgencyHook
Adam Vogt <vogt.adam at gmail.com>**20130924224738
Ignore-this: 3b7c62275701e6758397977c5c09b744
]
[export XMonad.Hooks.UrgencyHook.clearUrgency (issue 533)
Adam Vogt <vogt.adam at gmail.com>**20130923031349
Ignore-this: dafe5763d9abcfa606f5c1a8cf5c57d6
]
[minor documentation fix: manageDocks doesn't do anything with struts, so don't claim it does
Daniel Wagner <daniel at wagner-home.com>**20130814125106
Ignore-this: a2610d6c1318ac0977abfc21d1b91632
]
[don't pretend to be LG3D in X.C.Dmwit because this confuses modern GTK
Daniel Wagner <daniel at wagner-home.com>**20130813211636
Ignore-this: 8f728dc1b4bf5e472d99419cc5920e51
]
[XMonad.Actions.UpdatePointer: generalise updatePointer
Liyang HU <git at liyang.hu>**20130730071007
Ignore-this: 3374a62b6c63dcc152dbf843cd0577f0
]
[XMonad.Actions.UpdatePointer: document TowardsCentre
Liyang HU <git at liyang.hu>**20130730053746
Ignore-this: 2d684b12e4fff0ebec254bea4a4546a3
]
[Haddock formatting in H.Minimize
Adam Vogt <vogt.adam at gmail.com>**20130723155658
Ignore-this: 5db3186a51dec58f78954466ded339cb
]
[Bump version (and xmonad dependency) to 0.12
Adam Vogt <vogt.adam at gmail.com>**20130720205857
Ignore-this: ce165178ca916223501f266339f1de39
This makes a breakage due to missing patches in core a bit more obvious.
Previously you would have a build failure regarding some missing identifiers
(def re-exported by XMonad from Data.Default), while after applying this patch
it will be clear that xmonad-core needs to be updated.
]
[Fix issue 551 by also getting manpath without -g flag.
Adam Vogt <vogt.adam at gmail.com>**20130716030536
Ignore-this: ded2d51eb7b7697c0fdfaa8158d612df
Instead of taking Ondrej's approach of figuring out which man (man-db or
http://primates.ximian.com/~flucifredi/man/) is used by the system, just try
both sets of flags.
]
[Escape dzen markup and remove xmobar tags from window titles by default.
Adam Vogt <vogt.adam at gmail.com>**20130708144813
Ignore-this: cf56bff752fbf78ea06d5c0cb755f615
The issue was that window titles, such as those set by, for example a browser,
could set the window title to display something like
<action=malicious shell command>normal title</action>
Which could be executed by xmobar (or dzen).
This adds a ppTitleSanitize which does the above functions. This way when users
override ppTitle, the benefits are not lost.
Thanks to Raúl Benencia and Joachim Breitner for bringing this to my attention.
]
[DynamicBars-use-ExtensibleState
gopsychonauts at gmail.com**20130618074755
Ignore-this: afacba51af2be8ede65b9bcf9b002a7
Hooks.DynamicBars was previously using an MVar and the unsafePerformIO hack (
http://www.haskell.org/haskellwiki/Top_level_mutable_state ) to store bar
state. Since ExtensibleState exists to solve these sorts of problems, I've
switched the file over to use unsafePerformIO instead.
Some functions' types had to be changed to allow access to XState, but the
public API is unchanged.
]
[Catch exceptions when finding commands on PATH in Prompt.Shell
Thomas Tuegel <ttuegel at gmail.com>**20130616230219
Ignore-this: 5a4d08c80301864bc14ed784f1054c3f
]
[Fix haddock parse error in X.A.LinkWorkspaces
Adam Vogt <vogt.adam at gmail.com>**20130528133448
Ignore-this: 42f05cf8ca9e6d1ffae3bd20666d87ab
]
[use Data.Default wherever possible, and deprecate the things it replaces
Daniel Wagner <daniel at wagner-home.com>**20130528013909
Ignore-this: 898458b1d2868a70dfb09faf473dc7aa
]
[eliminate references to defaultConfig
Daniel Wagner <daniel at wagner-home.com>**20130528005825
Ignore-this: 37ae613e4b943e99c5200915b9d95e58
]
[minimal change needed to get xmonad-contrib to build with xmonad's data-default patch
Daniel Wagner <daniel at wagner-home.com>**20130528001040
Ignore-this: 291e4f6cd74fc2b808062e0369665170
]
[Remove unneeded XSync call in Layout.ShowWName
Francesco Ariis <fa-ml at ariis.it>**20130517153341
Ignore-this: 4d107c680572eff464c8f6ed9fabdd41
]
[Remove misleading comment: we definitely don't support ghc-6.6 anymore
Adam Vogt <vogt.adam at gmail.com>**20130514215851
Ignore-this: 2d071cb05709a16763d039222264b426
]
[Fix module name in comment of X.L.Fullscreen
Adam Vogt <vogt.adam at gmail.com>**20130514215727
Ignore-this: cb5cf18c301c5daf5e1a2527da1ef6bf
]
[Minor update to cabal file (adding modules & maintainership)
Adam Vogt <vogt.adam at gmail.com>**20130514215632
Ignore-this: 82785e02e544e1f797799bed5b5d9be2
]
[Remove trailing whitespace in X.A.LinkWorkspaces
Adam Vogt <vogt.adam at gmail.com>**20130514215421
Ignore-this: 5015ab4468e7931876eb66b019af804c
]
[Update documentation of LinkWorkspaces Module
quesel at informatik.uni-oldenburg.de**20110328072813
Ignore-this: da863534931181f551c9c54bc4076c05
]
[Added a module for linking workspaces
quesel at informatik.uni-oldenburg.de**20110210165018
Ignore-this: 1dba2164cc3387409873d33099596d91
This module provides a way to link certain workspaces in a multihead setup.
That way, when switching to the first one the other heads display the linked
workspaces.
]
[Cache results from calcGap in ManageDocks
Adam Vogt <vogt.adam at gmail.com>**20130425155811
Ignore-this: e5076fdbdfc68bc159424dd4e0f14456
http://www.haskell.org/pipermail/xmonad/2013-April/013670.html
]
[Remove unnecessary contexts from L.MultiToggle
Adam Vogt <vogt.adam at gmail.com>**20130217163356
Ignore-this: 6b0e413d8c3a58f62088c32a96c57c51
]
[Generalises modWorkspace to take any layout-transforming function
gopsychonauts at gmail.com**20130501151425
Ignore-this: 28c7dc1f6216bb1ebdffef5434ccbcbd
modWorkspace already was capable of modifying the layout with an arbitrary
layout -> layout function, but its original type restricted it such that it
could only apply a single LayoutModifier; this was often inconvenient, as for
example it was not possible simply to compose LayoutModifiers for use with
modWorkspace.
This patch also reimplements onWorkspaces in terms of modWorkspaces, since with
the latter's less restrictive type this is now possible.
]
[since XMonad.Config.Dmwit mentions xmobar, we should include the associated .xmobarrc file
Daniel Wagner <daniel at wagner-home.com>**20130503194055
Ignore-this: 2f6d7536df81eb767262b79b60eb1b86
]
[warning police
Daniel Wagner <daniel at wagner-home.com>**20130502012700
Ignore-this: ae7412ac77c57492a7ad6c5f8f50b9eb
]
[XMonad.Config.Dmwit
Daniel Wagner <daniel at wagner-home.com>**20130502012132
Ignore-this: 7402161579fd2e191b60a057d955e5ea
]
[minor fixes to the haddock markup in X.L.IndependentScreens
Daniel Wagner <daniel at wagner-home.com>**20130411193849
Ignore-this: b6a139aa43fdb39fc1b86566c0c34c7a
]
[add whenCurrentOn to X.L.IndependentScreens
Daniel Wagner <daniel at wagner-home.com>**20130408225251
Ignore-this: ceea3d391f270abc9ed8e52ce19fb1ac
]
[Allow to specify the initial gaps' states in X.L.Gaps
Paul Fertser <fercerpav at gmail.com>**20130222072232
Ignore-this: 31596d918d0050e36ce3f64f56205a64
]
[should bump X11 dependency, too, to make sure we have getAtomName
Daniel Wagner <daniel at wagner-home.com>**20130225180527
Ignore-this: 260711f27551f18cc66afeb7b4846b9f
]
[getAtomName is now defined in the X11 library
Daniel Wagner <daniel at wagner-home.com>**20130225180323
Ignore-this: 3b9e17c234679e98752a47c37132ee4e
]
[Allow to limit maximum row count in X.Prompt completion window
Paul Fertser <fercerpav at gmail.com>**20130221122050
Ignore-this: 923656f02996f2de2b1336275392c5f9
On a keyboard-less device (such as a smartphone), where one has to use
an on-screen keyboard, the maximum completion window height must be
limited to avoid overlapping the keyboard.
]
[Note in U.NameActions that xmonad core can list default keys now
Adam Vogt <vogt.adam at gmail.com>**20130217233026
Ignore-this: 937bff636fa88171932d5192fe8e290b
]
[Export U.NamedActions.addDescrKeys per evaryont's request.
Adam Vogt <vogt.adam at gmail.com>**20130217232619
Ignore-this: a694a0a3ece70b52fba6e8f688d86344
]
[Add EWMH DEMANDS_ATTENTION support to UrgencyHook.
Maarten de Vries <maarten at de-vri.es>**20130212181229
Ignore-this: 5a4b314d137676758fad9ec8f85ce422
Add support for the _NET_WM_STATE_DEMANDS_ATTENTION atom
by treating it the same way as the WM_HINTS urgency flag.
]
[Unconditionally set _NET_WORKAREA in ManageDocks
Adam Vogt <vogt.adam at gmail.com>**20130117180851
Ignore-this: 9f57e53fba9573d8a92cf153beb7fe7a
]
[spawn command when no completion is available (if alwaysHighlight is True); changes commandToComplete in Prompt/Shell to complete the whole word instead of using getLastWord
c.lopez at kmels.net**20130209190456
Ignore-this: ca7d354bb301b555b64d5e76e31d10e8
]
[order-unindexed-ws-last
matthewhague at zoho.com**20120703222726
Ignore-this: 4af8162ee8b16a60e8fd62fbc915d3c0
Changes the WorkspaceCompare module's comparison by index to put workspaces without an index last (rather than first).
]
[SpawnOn modification for issue 523
Adam Vogt <vogt.adam at gmail.com>**20130114014642
Ignore-this: 703f7dc0f800366b752f0ec1cecb52e5
This moves the function to help clean up the `Spawner' to the ManageHook
rather than in functions like spawnOn. Probably it makes no difference, the
reason is because there's one manageSpawn function but many different so this
way there are less functions to write.
]
[Update L.TrackFloating.useTransient example code
Adam Vogt <vogt.adam at gmail.com>**20130112041239
Ignore-this: e4e31cf1db742778c1d59d52fdbeed7a
Suggest useTransient goes to the right of trackFloating which is the
configuration actually tested.
]
[Adapt ideas of issue 306 patch to a new modifier in L.TrackFloating
Adam Vogt <vogt.adam at gmail.com>**20130112035701
Ignore-this: d54d27b71b97144ef0660f910fd464aa
]
[Make X.A.CycleWS not rely on hidden WS order
Dmitri Iouchtchenko <johnnyspoon at gmail.com>**20130109023328
Ignore-this: 8717a154b33253c5df4e9a0ada4c2c3e
]
[Add X.H.WorkspaceHistory
Dmitri Iouchtchenko <johnnyspoon at gmail.com>**20130109023307
Ignore-this: c9e7ce33a944facc27481dde52c7cc80
]
[Allow removing arbitrary workspaces
Dmitri Iouchtchenko <johnnyspoon at gmail.com>**20121231214343
Ignore-this: 6fce4bd3d0c5337e5122158583138e74
]
[Remove first-hidden restriction from X.A.DynamicWorkspaces.removeWorkspace'
Dmitri Iouchtchenko <johnnyspoon at gmail.com>**20121231214148
Ignore-this: 55fb0859e9a5f476a834ecbdb774aac8
]
[Add authorspellings file for `darcs show authors'.
Adam Vogt <vogt.adam at gmail.com>**20130101040031
Ignore-this: c3198072ebc6a71d635bec4d8e2c78fd
This authorspellings file includes a couple people who've contributed to xmonad
(not XMonadContrib). When people have multiple addresses, the most recent one
has been picked.
]
[TAG 0.11
Adam Vogt <vogt.adam at gmail.com>**20130101014231
Ignore-this: 57cf32412fd1ce912811cb7fafe930f5
]
Patch bundle hash:
919d364fcdae765b3ad0f330dd518eea9fb16a9e
More information about the xmonad
mailing list