>From 113ae256b9b010dc9159cac24d1348438fce863a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Antoine=20Beaupr=C3=A9?= <anarcat@debian.org>
Date: Thu, 13 Apr 2017 21:25:25 -0400
Subject: [PATCH] hook writeroom mode into sticky xmonad desktops

this allows me to not only write in fullscreen, but also make the
emacs window hide any other virtual desktop, because then the windows
shows up, in fullscreen, on all desktops.

this is a horrible hack, but it works. it sends a custom X message
arbitarily chosen ("XMONAD_COPY_TO_ALL_SELF") to the X server which
gets caught by Xmonad in a event hook.

wrote a copyToAllToggle function that should probably be merged
upstream, and also reuse it in the keybinding because it's so
convenient.

this would be better served by the standard "_NET_WM_STATE_STICKY"
flag, but I leave that as an exercise to the reader (AKA I have no
idea how to deal with those flags).

writeroom-mode probably already sets that flag and sends the message,
we would just need to figure out how to parse the message and find the
state properly. because it's a "toggle" message, we don't actually
know the state directly from the message (presumably) so we need to
look at the state of the focused window. we may also need to manually
update the state of the window as well.
---
 .emacs            |  6 +++++-
 .emacs-custom     |  2 +-
 .xmonad/xmonad.hs | 51 ++++++++++++++++++++++++++++++++++++++++++++++-----
 3 files changed, 52 insertions(+), 7 deletions(-)

diff --git a/.emacs b/.emacs
index f25f299..2f717b0 100644
--- a/.emacs
+++ b/.emacs
@@ -526,7 +526,11 @@ also does so and we don't bother doing excursions around.
   :init
   (defun wm-toggle-fullscreen (_)
     (x-send-client-message nil 0 nil "_NET_WM_STATE" 32
-                           '(2 "_NET_WM_STATE_FULLSCREEN" 0))))
+                           '(2 "_NET_WM_STATE_FULLSCREEN" 0)))
+  (defun xmonad-toggle-sticky (_)
+    ;; this requires a special piece of code on the xmonad side to
+    ;; handle that event and do a copyToAllToggle
+    (x-send-client-message nil 0 nil "XMONAD_COPY_ALL_SELF" 8 '(0))))
 
 ;; 800ms
 ;; for notmuch org-mode links
diff --git a/.emacs-custom b/.emacs-custom
index 64ffd23..9d34b17 100644
--- a/.emacs-custom
+++ b/.emacs-custom
@@ -217,7 +217,7 @@
  '(word-wrap t)
  '(writeroom-global-effects
    (quote
-    (writeroom-set-alpha writeroom-set-menu-bar-lines writeroom-set-tool-bar-lines writeroom-set-vertical-scroll-bars writeroom-set-sticky wm-toggle-fullscreen)))
+    (writeroom-set-alpha writeroom-set-menu-bar-lines writeroom-set-tool-bar-lines writeroom-set-vertical-scroll-bars writeroom-set-sticky wm-toggle-fullscreen xmonad-toggle-sticky)))
  '(writeroom-restore-window-config t)
  '(x-stretch-cursor t))
 (custom-set-faces
diff --git a/.xmonad/xmonad.hs b/.xmonad/xmonad.hs
index 57338b2..43d296e 100644
--- a/.xmonad/xmonad.hs
+++ b/.xmonad/xmonad.hs
@@ -104,7 +104,7 @@ import XMonad.Prompt.Window (windowPromptBringCopy)
 import XMonad.Prompt.XMonad (xmonadPrompt)
 
 -- to make windows "sticky" on all desktops (mod-v/V)
-import XMonad.Actions.CopyWindow (copyToAll,killAllOtherCopies,kill1)
+import XMonad.Actions.CopyWindow (wsContainingCopies,copyToAll,killAllOtherCopies,kill1)
 -- to toggle between workspaces
 import XMonad.Actions.CycleWS
 
@@ -119,6 +119,9 @@ import XMonad.Hooks.ManageHelpers
 import System.IO
 import System.Exit
 
+-- for "All"
+import Data.Monoid
+
 -- float some windows by default
 myManageHook = composeAll
     [ manageDocks
@@ -208,6 +211,46 @@ killsoft = do ss <- gets windowset
               whenJust (W.peek ss) $ \w -> when (W.member w $ delete'' w ss) $ windows $ delete'' w
        where delete'' w = W.modify Nothing (W.filter (/= w))
 
+-- | handle X client messages that tell Xmonad to make a window appear
+-- on all workspaces
+--
+-- this should really be using _NET_WM_STATE and
+-- _NET_WM_STATE_STICKY. but that's more complicated: then we'd need
+-- to inspect a window and figure out the current state and act
+-- accordingly. I am not good enough with Xmonad to figure out that
+-- part yet.
+--
+-- Instead, just check for the relevant message and check if the
+-- focused window is already on all workspaces and toggle based on
+-- that.
+--
+-- this is designed to interoperate with Emacs's writeroom-mode module
+-- and called be called from elisp with:
+--
+-- (x-send-client-message nil 0 nil "XMONAD_COPY_ALL_SELF" 8 '(0))
+toggleStickyEventHook :: Event -> X All
+toggleStickyEventHook (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
+  dpy <- asks display
+  -- the client message we're expecting
+  copyAllMsg <- io $ internAtom dpy "XMONAD_COPY_ALL_SELF" False
+  -- if the event matches the message we expect, toggle sticky state
+  when (mt == copyAllMsg && dt /= []) $ do
+    copyToAllToggle
+  -- we processed the event completely
+  return $ All True
+
+-- | Toggle between "copyToAll" or "killAllOtherCopies". Copies to all
+-- workspaces, or remove from all other workspaces, depending on
+-- previous state (checked with "wsContainingCopies").
+copyToAllToggle :: X ()
+copyToAllToggle = do
+    -- check which workspaces have copies
+    copies <- wsContainingCopies
+    if null copies
+      then windows copyToAll -- no workspaces, make sticky
+      else killAllOtherCopies -- already other workspaces, unstick
+
+
 -- main config declaration
 myConfig = defaultConfig {
          modMask = modm
@@ -215,7 +258,7 @@ myConfig = defaultConfig {
        , focusedBorderColor = "#333333"
        , manageHook = myManageHook
        , terminal = "x-terminal-emulator"
-       , handleEventHook = handleEventHook defaultConfig <+> fullscreenEventHook
+       , handleEventHook = handleEventHook defaultConfig <+> fullscreenEventHook <+> toggleStickyEventHook
        , layoutHook = myLayoutHook
     } `additionalKeys` [
     ((noModMask         , xK_Pause), spawn "xscreensaver-command -lock")
@@ -243,9 +286,7 @@ myConfig = defaultConfig {
   , ((modm              , xK_f     ), toggleFloat                           )
   , ((modm              , xK_m     ), withFocused $ sendMessage . maximizeRestore )
   -- Make focused window always visible
-  , ((modm              , xK_v     ), windows copyToAll                     )
-  -- Toggle window state back
-  , ((modm .|. shiftMask, xK_v     ),  killAllOtherCopies                   )
+  , ((modm              , xK_v     ), copyToAllToggle                       )
   -- used to banish a window from the current workspace, if it's also elsewhere
   , ((modm              , xK_c     ), killsoft                                 )
   -- kill even if it's on multiple workspaces
-- 
2.11.0

