{-# LANGUAGE CPP #-}
module DShellF(ShellF,shellF, shellF', shellKF, shellKF',
       setDeleteWindowAction,
       getDeleteWindowActionMaybe', -- for use in titleShellF
       DeleteWindowAction(..),setDeleteQuit,
       HasClickToType(..),setInitPos,setFocusMgr,
       HasVisible(..)) where

import FDefaults
import Dlayout(sF)
import AutoLayout(autoLayoutF',nowait)
import QuitK
import Fudget
import EitherUtils
import CompOps
import Geometry(Point(..))
import Command
import Xcommand
import Xtypes
import Defaults(defaultSep,defaultPosition)
import CmdLineEnv(argFlag)
import FocusMgr(focusMgr)
--import Placer
--import Spacers
import Spacer(marginF)
--import LayoutRequest
import Sizing(Sizing(..))
import NullF
import ParK
--import Maptrace(ctrace) -- debugging
#include "defaults.h"

newtype ShellF = Pars [Pars]
data Pars
  = WinAttr [WindowAttributes]
  | DeleteWindowAction (Maybe DeleteWindowAction)
  | ClickToType Bool
  | FocusMgr Bool -- mainly for internal use
  | Visible Bool
  | Margin Int
  | Sizing Sizing
  | InitPos (Maybe Point)

data DeleteWindowAction = DeleteQuit | DeleteUnmap deriving (DeleteWindowAction -> DeleteWindowAction -> Bool
(DeleteWindowAction -> DeleteWindowAction -> Bool)
-> (DeleteWindowAction -> DeleteWindowAction -> Bool)
-> Eq DeleteWindowAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteWindowAction -> DeleteWindowAction -> Bool
$c/= :: DeleteWindowAction -> DeleteWindowAction -> Bool
== :: DeleteWindowAction -> DeleteWindowAction -> Bool
$c== :: DeleteWindowAction -> DeleteWindowAction -> Bool
Eq,Int -> DeleteWindowAction -> ShowS
[DeleteWindowAction] -> ShowS
DeleteWindowAction -> String
(Int -> DeleteWindowAction -> ShowS)
-> (DeleteWindowAction -> String)
-> ([DeleteWindowAction] -> ShowS)
-> Show DeleteWindowAction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteWindowAction] -> ShowS
$cshowList :: [DeleteWindowAction] -> ShowS
show :: DeleteWindowAction -> String
$cshow :: DeleteWindowAction -> String
showsPrec :: Int -> DeleteWindowAction -> ShowS
$cshowsPrec :: Int -> DeleteWindowAction -> ShowS
Show)

parameter(InitPos)
parameter(FocusMgr)

parameter_instance(WinAttr,ShellF)

parameter(DeleteWindowAction)
getDeleteWindowActionMaybe' :: Customiser ShellF -> Maybe (Maybe DeleteWindowAction)
getDeleteWindowActionMaybe' Customiser ShellF
pm =
  ShellF -> Maybe (Maybe DeleteWindowAction)
getDeleteWindowActionMaybe (Customiser ShellF
pm ([Pars] -> ShellF
Pars []))

-- Backwards compatibility:
setDeleteQuit :: Bool -> Customiser ShellF
setDeleteQuit Bool
b = Maybe DeleteWindowAction -> Customiser ShellF
setDeleteWindowAction (if Bool
b then DeleteWindowAction -> Maybe DeleteWindowAction
forall a. a -> Maybe a
Just DeleteWindowAction
DeleteQuit else Maybe DeleteWindowAction
forall a. Maybe a
Nothing)

parameter_class(ClickToType,Bool)
parameter_instance(ClickToType,ShellF)


parameter_class(Visible,Bool)
parameter_instance(Visible,ShellF)

parameter_instance(Margin,ShellF)
parameter_instance(Sizing,ShellF)

shellF :: String -> F c d -> F c d
shellF = Customiser ShellF -> String -> F c d -> F c d
forall c d. Customiser ShellF -> String -> F c d -> F c d
shellF' Customiser ShellF
forall a. Customiser a
standard
shellF' :: Customiser ShellF -> String -> F c d -> F c d
shellF' Customiser ShellF
pmod String
s F c d
f = Either d d -> d
forall p. Either p p -> p
stripEither (Either d d -> d)
-> F (Either Any c) (Either d d) -> F (Either Any c) d
forall a b e. (a -> b) -> F e a -> F e b
>^=< Customiser ShellF
-> K Any d -> F c d -> F (Either Any c) (Either d d)
forall a b c d.
Customiser ShellF -> K a b -> F c d -> F (Either a c) (Either b d)
shellKF' Customiser ShellF
pmod K Any d
forall i o. K i o
k F c d
f F (Either Any c) d -> (c -> Either Any c) -> F c d
forall c d e. F c d -> (e -> c) -> F e d
>=^< c -> Either Any c
forall a b. b -> Either a b
Right where
	k :: K i o
k = XCommand -> K i o -> K i o
forall i o. XCommand -> K i o -> K i o
xcommandK (String -> XCommand
StoreName String
s) K i o
forall i o. K i o
nullK

shellKF :: K a b -> F c d -> F (Either a c) (Either b d)
shellKF = Customiser ShellF -> K a b -> F c d -> F (Either a c) (Either b d)
forall a b c d.
Customiser ShellF -> K a b -> F c d -> F (Either a c) (Either b d)
shellKF' Customiser ShellF
forall a. Customiser a
standard

shellKF' :: (Customiser ShellF)->K a b -> F c d -> F (Either a c) (Either b d)
shellKF' :: Customiser ShellF -> K a b -> F c d -> F (Either a c) (Either b d)
shellKF' Customiser ShellF
pmod K a b
k F c d
f = Sizing
-> Bool
-> Bool
-> Bool
-> Maybe Point
-> Int
-> [FRequest]
-> K a b
-> F c d
-> F (Either a c) (Either b d)
forall a b c d.
Sizing
-> Bool
-> Bool
-> Bool
-> Maybe Point
-> Int
-> [FRequest]
-> K a b
-> F c d
-> F (Either a c) (Either b d)
genShellF Sizing
siz Bool
clicktt Bool
focusmgr Bool
vis Maybe Point
pos Int
sep [] K a b
kernel F c d
f
 where
   ps :: ShellF
ps = Customiser ShellF
pmod ([Pars] -> ShellF
Pars [[WindowAttributes] -> Pars
WinAttr [],Maybe DeleteWindowAction -> Pars
DeleteWindowAction (DeleteWindowAction -> Maybe DeleteWindowAction
forall a. a -> Maybe a
Just DeleteWindowAction
DeleteQuit),
                    Bool -> Pars
ClickToType Bool
ctt, Bool -> Pars
FocusMgr Bool
defFocusMgr,
                    Maybe Point -> Pars
InitPos Maybe Point
defaultPosition, -- hmm
		    Bool -> Pars
Visible Bool
True,Int -> Pars
Margin Int
forall a. Num a => a
defaultSep,Sizing -> Pars
Sizing Sizing
Dynamic])
						-- !! Change default Sizing?
   d_action :: Maybe DeleteWindowAction
d_action = ShellF -> Maybe DeleteWindowAction
getDeleteWindowAction ShellF
ps
   clicktt :: Bool
clicktt = ShellF -> Bool
forall xxx. HasClickToType xxx => xxx -> Bool
getClickToType ShellF
ps
   focusmgr :: Bool
focusmgr = ShellF -> Bool
getFocusMgr ShellF
ps
   sep :: Int
sep = ShellF -> Int
forall xxx. HasMargin xxx => xxx -> Int
getMargin ShellF
ps
   vis :: Bool
vis = ShellF -> Bool
forall xxx. HasVisible xxx => xxx -> Bool
getVisible ShellF
ps
   wa :: [WindowAttributes]
wa = ShellF -> [WindowAttributes]
forall xxx. HasWinAttr xxx => xxx -> [WindowAttributes]
getWinAttr ShellF
ps
   siz :: Sizing
siz = ShellF -> Sizing
forall xxx. HasSizing xxx => xxx -> Sizing
getSizing ShellF
ps
   pos :: Maybe Point
pos = ShellF -> Maybe Point
getInitPos ShellF
ps
   kernel :: K a b
kernel = XCommand -> K a b -> K a b
forall i o. XCommand -> K i o -> K i o
xcommandK ([WindowAttributes] -> XCommand
ChangeWindowAttributes [WindowAttributes]
wa) (K a b -> K a b) -> K a b -> K a b
forall a b. (a -> b) -> a -> b
$
	    K a b
-> (DeleteWindowAction -> K a b)
-> Maybe DeleteWindowAction
-> K a b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((Atom -> K a b) -> K a b
forall b c. (Atom -> K b c) -> K b c
wmDeleteWindowK (K a b -> Atom -> K a b
forall a b. a -> b -> a
const K a b
k)) -- see (*) in QuitK.hs
		  (\ DeleteWindowAction
a -> (K (Either String Bool) Any -> K (Either String Bool) Any) -> K a b
forall a hi ho.
(K (Either String Bool) a -> K (Either String Bool) a) -> K hi ho
quitK (DeleteWindowAction
-> K (Either String Bool) Any -> K (Either String Bool) Any
forall b ho. DeleteWindowAction -> K b ho -> K b ho
action DeleteWindowAction
a) K a b -> K a b -> K a b
forall a b. K a b -> K a b -> K a b
`parK` K a b
k)
		  Maybe DeleteWindowAction
d_action

   action :: DeleteWindowAction -> K b ho -> K b ho
action DeleteWindowAction
DeleteQuit = K b ho -> K b ho
forall p b ho. p -> K b ho
exitK
   action DeleteWindowAction
DeleteUnmap = K b ho -> K b ho
forall i o. K i o -> K i o
unmapWindowK

genShellF :: Sizing
-> Bool
-> Bool
-> Bool
-> Maybe Point
-> Int
-> [FRequest]
-> K a b
-> F c d
-> F (Either a c) (Either b d)
genShellF Sizing
sizing Bool
ctt Bool
focusmgr Bool
map Maybe Point
pos Int
sep [FRequest]
cmds K a b
k F c d
f = 
       Bool
-> Maybe Point
-> [FRequest]
-> K a b
-> F c d
-> F (Either a c) (Either b d)
forall a b c d.
Bool
-> Maybe Point
-> [FRequest]
-> K a b
-> F c d
-> F (Either a c) (Either b d)
sF (Bool -> Bool
not Bool
map) Maybe Point
pos [FRequest]
cmds K a b
k (F c d -> F c d
forall i o. F i o -> F i o
filter (F c d -> F c d
forall i o. F i o -> F i o
sepf F c d
f)) where
   filter :: F i o -> F i o
filter = if Bool
focusmgr
            then Sizing -> Bool -> F i o -> F i o
forall i o. Sizing -> Bool -> F i o -> F i o
focusMgr Sizing
sizing Bool
ctt
            else Bool -> Sizing -> F i o -> F i o
forall a b. Bool -> Sizing -> F a b -> F a b
autoLayoutF' Bool
nowait Sizing
sizing -- usually sits inside a groupF in focusMgr
   sepf :: F a b -> F a b
sepf = if Int
sep Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then F a b -> F a b
forall a. Customiser a
id else Int -> F a b -> F a b
forall a b. Int -> F a b -> F a b
marginF Int
sep

ctt :: Bool
ctt = String -> Bool -> Bool
argFlag String
"ctt" Bool
True
defFocusMgr :: Bool
defFocusMgr = String -> Bool -> Bool
argFlag String
"focusmgr" Bool
True