module QuitButtonF where
import Spacer(marginHVAlignF)
import Alignment
import DButtonF
import FDefaults
import CompOps((>==<))
--import Defaults(buttonFont)
--import Event(Event(..))
--import Fudget
--import PushButtonF
import QuitF
--import AuxTypes(Modifiers(..))
import Defaults(metaKey)
import Graphic( )

quitButtonF :: F Click b
quitButtonF =
    forall {ans} {ho}. F ans ho
quitF forall {a1} {b} {a2}. F a1 b -> F a2 a1 -> F a2 b
>==<
    forall {a} {b}.
Distance -> Alignment -> Alignment -> F a b -> F a b
marginHVAlignF Distance
0 Alignment
aRight Alignment
aBottom
    (forall {lbl}.
Graphic lbl =>
Customiser (ButtonF lbl) -> lbl -> F Click Click
buttonF' (forall xxx. HasKeys xxx => [(ModState, String)] -> Customiser xxx
setKeys [([Modifiers
metaKey], String
"q")]) String
"Quit")