Browse Source

Make ~/.xmonad/xmonad-$arch-$os handle args like /usr/bin/xmonad

master
Adam Vogt 4 years ago
parent
commit
307b82a53d
5 changed files with 119 additions and 79 deletions
  1. 1
    69
      Main.hs
  2. 3
    0
      src/XMonad/Config.hs
  3. 2
    0
      src/XMonad/Core.hs
  4. 112
    10
      src/XMonad/Main.hs
  5. 1
    0
      xmonad.cabal

+ 1
- 69
Main.hs View File

@@ -16,84 +16,5 @@ module Main (main) where
16 16
 
17 17
 import XMonad
18 18
 
19
-import Control.Monad (unless)
20
-import System.Info
21
-import System.Environment
22
-import System.Posix.Process (executeFile)
23
-import System.Exit (exitFailure)
24
-
25
-import Paths_xmonad (version)
26
-import Data.Version (showVersion)
27
-
28
-import Graphics.X11.Xinerama (compiledWithXinerama)
29
-
30 19
 main :: IO ()
31
-main = do
32
-    installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
33
-    args <- getArgs
34
-    let launch = catchIO buildLaunch >> xmonad def
35
-    case args of
36
-        []                    -> launch
37
-        ("--resume":_)        -> launch
38
-        ["--help"]            -> usage
39
-        ["--recompile"]       -> recompile True >>= flip unless exitFailure
40
-        ["--replace"]         -> launch
41
-        ["--restart"]         -> sendRestart >> return ()
42
-        ["--version"]         -> putStrLn $ unwords shortVersion
43
-        ["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion
44
-        _                     -> fail "unrecognized flags"
45
- where
46
-    shortVersion = ["xmonad", showVersion version]
47
-    longVersion  = [ "compiled by", compilerName, showVersion compilerVersion
48
-                   , "for",  arch ++ "-" ++ os
49
-                   , "\nXinerama:", show compiledWithXinerama ]
50
-
51
-usage :: IO ()
52
-usage = do
53
-    self <- getProgName
54
-    putStr . unlines $
55
-        concat ["Usage: ", self, " [OPTION]"] :
56
-        "Options:" :
57
-        "  --help                       Print this message" :
58
-        "  --version                    Print the version number" :
59
-        "  --recompile                  Recompile your ~/.xmonad/xmonad.hs" :
60
-        "  --replace                    Replace the running window manager with xmonad" :
61
-        "  --restart                    Request a running xmonad process to restart" :
62
-        []
63
-
64
---
65
---
66
---
67
---
68
---
69
---
70
---
71
-buildLaunch ::  IO ()
72
-buildLaunch = do
73
-    recompile False
74
-    dir  <- getXMonadDir
75
-    args <- getArgs
76
-    executeFile (dir ++ "/xmonad-"++arch++"-"++os) False args Nothing
77
-    return ()
78
-
79
-sendRestart :: IO ()
80
-sendRestart = do
81
-    dpy <- openDisplay ""
82
-    rw <- rootWindow dpy $ defaultScreen dpy
83
-    xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
84
-    allocaXEvent $ \e -> do
85
-        setEventType e clientMessage
86
-        setClientMessageEvent e rw xmonad_restart 32 0 currentTime
87
-        sendEvent dpy rw False structureNotifyMask e
88
-    sync dpy False
20
+main = xmonad def

+ 3
- 0
src/XMonad/Config.hs View File

@@ -271,6 +271,9 @@ instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) wh
271 271
     , XMonad.clickJustFocuses       = clickJustFocuses
272 272
     , XMonad.clientMask         = clientMask
273 273
     , XMonad.rootMask           = rootMask
274
+    , XMonad.handleExtraArgs = \ xs theConf -> case xs of
275
+                [] -> return theConf
276
+                _ -> fail ("unrecognized flags:" ++ show xs)
274 277
     }
275 278
 
276 279
 -- | The default set of configuration values itself

+ 2
- 0
src/XMonad/Core.hs View File

@@ -114,6 +114,8 @@ data XConfig l = XConfig
114 114
     , clickJustFocuses   :: !Bool                -- ^ False to make a click which changes focus to be additionally passed to the window
115 115
     , clientMask         :: !EventMask           -- ^ The client events that xmonad is interested in
116 116
     , rootMask           :: !EventMask           -- ^ The root events that xmonad is interested in
117
+    , handleExtraArgs    :: !([String] -> XConfig Layout -> IO (XConfig Layout))
118
+                                                 -- ^ Modify the configuration, complain about extra arguments etc. with arguments that are not handled by default
117 119
     }
118 120
 
119 121
 

+ 112
- 10
src/XMonad/Main.hs View File

@@ -27,8 +27,6 @@ import Control.Monad.State
27 27
 import Data.Maybe (fromMaybe)
28 28
 import Data.Monoid (getAll)
29 29
 
30
-import System.Environment (getArgs)
31
-
32 30
 import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
33 31
 import Graphics.X11.Xlib.Extras
34 32
 
@@ -40,13 +38,121 @@ import XMonad.Operations
40 38
 
41 39
 import System.IO
42 40
 
41
+import System.Info
42
+import System.Environment
43
+import System.Posix.Process (executeFile)
44
+import System.Exit (exitFailure)
45
+import System.FilePath
46
+
47
+import Paths_xmonad (version)
48
+import Data.Version (showVersion)
49
+
50
+import Graphics.X11.Xinerama (compiledWithXinerama)
51
+
43 52
 ------------------------------------------------------------------------
44 53
 
54
+
55
+-- |
56
+-- | The entry point into xmonad. Attempts to compile any custom main
57
+-- for xmonad, and if it doesn't find one, just launches the default.
58
+xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
59
+xmonad conf = do
60
+    installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
61
+
62
+    let launch serializedWinset serializedExtState args = do
63
+              catchIO buildLaunch
64
+              conf' @ XConfig { layoutHook = Layout l }
65
+                  <- handleExtraArgs conf args conf{ layoutHook = Layout (layoutHook conf) }
66
+              withArgs [] $
67
+                xmonadNoargs (conf' { layoutHook = l })
68
+                              serializedWinset
69
+                              serializedExtState
70
+
71
+    args <- getArgs
72
+    case args of
73
+        ("--resume": ws : xs : args') -> launch (Just ws) (Just xs) args'
74
+        ["--help"]            -> usage
75
+        ["--recompile"]       -> recompile True >>= flip unless exitFailure
76
+        ["--restart"]         -> sendRestart
77
+        ["--version"]         -> putStrLn $ unwords shortVersion
78
+        ["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion
79
+        "--replace" : args'   -> do
80
+                                  sendReplace
81
+                                  launch Nothing Nothing args'
82
+        _                     -> launch Nothing Nothing args
83
+ where
84
+    shortVersion = ["xmonad", showVersion version]
85
+    longVersion  = [ "compiled by", compilerName, showVersion compilerVersion
86
+                   , "for",  arch ++ "-" ++ os
87
+                   , "\nXinerama:", show compiledWithXinerama ]
88
+
89
+usage :: IO ()
90
+usage = do
91
+    self <- getProgName
92
+    putStr . unlines $
93
+        concat ["Usage: ", self, " [OPTION]"] :
94
+        "Options:" :
95
+        "  --help                       Print this message" :
96
+        "  --version                    Print the version number" :
97
+        "  --recompile                  Recompile your ~/.xmonad/xmonad.hs" :
98
+        "  --replace                    Replace the running window manager with xmonad" :
99
+        "  --restart                    Request a running xmonad process to restart" :
100
+        []
101
+
102
+-- | Build "~\/.xmonad\/xmonad.hs" with ghc, then execute it.  If there are no
103
+-- errors, this function does not return.  An exception is raised in any of
104
+-- these cases:
105
+--
106
+--   * ghc missing
107
+--
108
+--   * both "~\/.xmonad\/xmonad.hs" and "~\/.xmonad\/xmonad-$arch-$os" missing
109
+--
110
+--   * xmonad.hs fails to compile
111
+--
112
+--      ** wrong ghc in path (fails to compile)
113
+--
114
+--      ** type error, syntax error, ..
115
+--
116
+--   * Missing XMonad\/XMonadContrib modules due to ghc upgrade
117
+--
118
+buildLaunch ::  IO ()
119
+buildLaunch = do
120
+    recompile False
121
+    dir  <- getXMonadDir
122
+    args <- getArgs
123
+    whoami <- getProgName
124
+    let compiledConfig = "xmonad-"++arch++"-"++os
125
+    unless (whoami == compiledConfig) $
126
+      executeFile (dir </> compiledConfig) False args Nothing
127
+
128
+sendRestart :: IO ()
129
+sendRestart = do
130
+    dpy <- openDisplay ""
131
+    rw <- rootWindow dpy $ defaultScreen dpy
132
+    xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
133
+    allocaXEvent $ \e -> do
134
+        setEventType e clientMessage
135
+        setClientMessageEvent e rw xmonad_restart 32 0 currentTime
136
+        sendEvent dpy rw False structureNotifyMask e
137
+    sync dpy False
138
+
139
+-- | a wrapper for 'replace'
140
+sendReplace :: IO ()
141
+sendReplace = do
142
+    dpy <- openDisplay ""
143
+    let dflt = defaultScreen dpy
144
+    rootw  <- rootWindow dpy dflt
145
+    replace dpy dflt rootw
146
+
147
+
45 148
 -- |
46 149
 -- The main entry point
47 150
 --
48
-xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
49
-xmonad initxmc = do
151
+xmonadNoargs :: (LayoutClass l Window, Read (l Window)) => XConfig l
152
+    -> Maybe String -- ^ serialized windowset
153
+    -> Maybe String -- ^ serialized extensible state
154
+    -> IO ()
155
+xmonadNoargs initxmc serializedWinset serializedExtstate = do
50 156
     -- setup locale information from environment
51 157
     setLocale LC_ALL (Just "")
52 158
     -- ignore SIGPIPE and SIGCHLD
@@ -58,10 +164,6 @@ xmonad initxmc = do
58 164
 
59 165
     rootw  <- rootWindow dpy dflt
60 166
 
61
-    args <- getArgs
62
-
63
-    when ("--replace" `elem` args) $ replace dpy dflt rootw
64
-
65 167
     -- If another WM is running, a BadAccess error will be returned.  The
66 168
     -- default error handler will write the exception to stderr and exit with
67 169
     -- an error.
@@ -93,12 +195,12 @@ xmonad initxmc = do
93 195
                                 _         -> Nothing
94 196
 
95 197
         winset = fromMaybe initialWinset $ do
96
-                    ("--resume" : s : _) <- return args
198
+                    s                    <- serializedWinset
97 199
                     ws                   <- maybeRead reads s
98 200
                     return . W.ensureTags layout (workspaces xmc)
99 201
                            $ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
100 202
         extState = fromMaybe M.empty $ do
101
-                     ("--resume" : _ : dyns : _) <- return args
203
+                     dyns                        <- serializedExtstate
102 204
                      vals                        <- maybeRead reads dyns
103 205
                      return . M.fromList . map (second Left) $ vals
104 206
 

+ 1
- 0
xmonad.cabal View File

@@ -52,6 +52,7 @@ library
52 52
                         XMonad.ManageHook
53 53
                         XMonad.Operations
54 54
                         XMonad.StackSet
55
+    other-modules:      Paths_xmonad
55 56
 
56 57
     build-depends: base < 5 && >=3,
57 58
                    containers,

Loading…
Cancel
Save