DShellF

{-# 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
{-
HBC uses "cpp -C -traditional" which causes all the  to be left behind
when the macro definitions are processed. That is why the definitions
are inside a comment.







  
-}

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 (Eq,Show)

setInitPos p = cust (\ (Pars ps) -> Pars (InitPos p:ps)); getInitPos (Pars ps) = getpar (\x->case x of InitPos p -> Just p; _-> Nothing) ps; getInitPosMaybe (Pars ps) = getparMaybe (\x->case x of InitPos p -> Just p; _-> Nothing) ps
setFocusMgr p = cust (\ (Pars ps) -> Pars (FocusMgr p:ps)); getFocusMgr (Pars ps) = getpar (\x->case x of FocusMgr p -> Just p; _-> Nothing) ps; getFocusMgrMaybe (Pars ps) = getparMaybe (\x->case x of FocusMgr p -> Just p; _-> Nothing) ps

instance HasWinAttr (ShellF) where {  setWinAttr p (Pars ps) = Pars (WinAttr p:ps);   getWinAttrMaybe (Pars ps) = getparMaybe (\x->case x of WinAttr p -> Just p; _-> Nothing) ps }

setDeleteWindowAction p = cust (\ (Pars ps) -> Pars (DeleteWindowAction p:ps)); getDeleteWindowAction (Pars ps) = getpar (\x->case x of DeleteWindowAction p -> Just p; _-> Nothing) ps; getDeleteWindowActionMaybe (Pars ps) = getparMaybe (\x->case x of DeleteWindowAction p -> Just p; _-> Nothing) ps
getDeleteWindowActionMaybe' pm =
  getDeleteWindowActionMaybe (pm (Pars []))

-- Backwards compatibility:
setDeleteQuit b = setDeleteWindowAction (if b then Just DeleteQuit else Nothing)

class HasClickToType xxx where {    setClickToType :: (Bool) -> Customiser xxx;     getClickToType :: xxx -> (Bool);     getClickToTypeMaybe :: xxx -> Maybe (Bool);     getClickToType = fromMaybe (error "get ClickToType: missing default") . getClickToTypeMaybe }
instance HasClickToType (ShellF) where {  setClickToType p (Pars ps) = Pars (ClickToType p:ps);   getClickToTypeMaybe (Pars ps) = getparMaybe (\x->case x of ClickToType p -> Just p; _-> Nothing) ps }


class HasVisible xxx where {    setVisible :: (Bool) -> Customiser xxx;     getVisible :: xxx -> (Bool);     getVisibleMaybe :: xxx -> Maybe (Bool);     getVisible = fromMaybe (error "get Visible: missing default") . getVisibleMaybe }
instance HasVisible (ShellF) where {  setVisible p (Pars ps) = Pars (Visible p:ps);   getVisibleMaybe (Pars ps) = getparMaybe (\x->case x of Visible p -> Just p; _-> Nothing) ps }

instance HasMargin (ShellF) where {  setMargin p (Pars ps) = Pars (Margin p:ps);   getMarginMaybe (Pars ps) = getparMaybe (\x->case x of Margin p -> Just p; _-> Nothing) ps }
instance HasSizing (ShellF) where {  setSizing p (Pars ps) = Pars (Sizing p:ps);   getSizingMaybe (Pars ps) = getparMaybe (\x->case x of Sizing p -> Just p; _-> Nothing) ps }

shellF = shellF' standard
shellF' pmod s f = stripEither >^=< shellKF' pmod k f >=^< Right where
	k = xcommandK (StoreName s) nullK

shellKF = shellKF' standard

shellKF' :: (Customiser ShellF)->K a b -> F c d -> F (Either a c) (Either b d)
shellKF' pmod k f = genShellF siz clicktt focusmgr vis pos sep [] kernel f
 where
   ps = pmod (Pars [WinAttr [],DeleteWindowAction (Just DeleteQuit),
                    ClickToType ctt, FocusMgr defFocusMgr,
                    InitPos defaultPosition, -- hmm
		    Visible True,Margin defaultSep,Sizing Dynamic])
						-- !! Change default Sizing?
   d_action = getDeleteWindowAction ps
   clicktt = getClickToType ps
   focusmgr = getFocusMgr ps
   sep = getMargin ps
   vis = getVisible ps
   wa = getWinAttr ps
   siz = getSizing ps
   pos = getInitPos ps
   kernel = xcommandK (ChangeWindowAttributes wa) $
	    maybe (wmDeleteWindowK (const k)) -- see (*) in QuitK.hs
		  (\ a -> quitK (action a) `parK` k)
		  d_action

   action DeleteQuit = exitK
   action DeleteUnmap = unmapWindowK

genShellF sizing ctt focusmgr map pos sep cmds k f = 
       sF (not map) pos cmds k (filter (sepf f)) where
   filter = if focusmgr
            then focusMgr sizing ctt
            else autoLayoutF' nowait sizing -- usually sits inside a groupF in focusMgr
   sepf = if sep == 0 then id else marginF sep

ctt = argFlag "ctt" True
defFocusMgr = argFlag "focusmgr" True