{-# LANGUAGE CPP #-}
module InputEditorF(
    EditorF,
    inputEditorF,inputEditorF',
    editorF,editorF')
  where
import Editor(oldEditorF,loadEditor)
import Edit(EditEvt(..))
--import InputMsg(InputMsg(..))
import CompOps
import SpEither(mapFilterSP)
import Spops(concatMapSP)
import ResourceIds() -- synonym FontName, for hbc
import GCAttrs --(FontSpec,fontSpec)
import Defaults(defaultFont)
import FDefaults

#include "defaults.h"

inputEditorF :: F String (InputMsg String)
inputEditorF = (EditorF -> EditorF) -> F String (InputMsg String)
inputEditorF' EditorF -> EditorF
forall a. Customiser a
standard

inputEditorF' :: (EditorF -> EditorF) -> F String (InputMsg String)
inputEditorF' EditorF -> EditorF
pm =
    (EditEvt -> Maybe (InputMsg String))
-> SP EditEvt (InputMsg String)
forall t b. (t -> Maybe b) -> SP t b
mapFilterSP EditEvt -> Maybe (InputMsg String)
change SP EditEvt (InputMsg String)
-> F EditCmd EditEvt -> F EditCmd (InputMsg String)
forall a b e. SP a b -> F e a -> F e b
>^^=< (EditorF -> EditorF) -> F EditCmd EditEvt
editorF' EditorF -> EditorF
pm F EditCmd (InputMsg String)
-> SP String EditCmd -> F String (InputMsg String)
forall c d e. F c d -> SP e c -> F e d
>=^^< (String -> [EditCmd]) -> SP String EditCmd
forall t b. (t -> [b]) -> SP t b
concatMapSP String -> [EditCmd]
loadEditor
  where
    change :: EditEvt -> Maybe (InputMsg String)
change (EditChange InputMsg String
inputmsg) = InputMsg String -> Maybe (InputMsg String)
forall a. a -> Maybe a
Just InputMsg String
inputmsg
    change EditEvt
_ = Maybe (InputMsg String)
forall a. Maybe a
Nothing

editorF :: F EditCmd EditEvt
editorF = (EditorF -> EditorF) -> F EditCmd EditEvt
editorF' EditorF -> EditorF
forall a. Customiser a
standard

editorF' :: (EditorF -> EditorF) -> F EditCmd EditEvt
editorF' EditorF -> EditorF
customiser = FontSpec -> F EditCmd EditEvt
oldEditorF FontSpec
font
  where
    font :: FontSpec
font = FontSpec -> Maybe FontSpec -> FontSpec
forall a. a -> Maybe a -> a
fromMaybe (String -> FontSpec
forall a. (Show a, FontGen a) => a -> FontSpec
fontSpec String
defaultFont) (Maybe FontSpec -> FontSpec) -> Maybe FontSpec -> FontSpec
forall a b. (a -> b) -> a -> b
$ EditorF -> Maybe FontSpec
forall xxx. HasFontSpec xxx => xxx -> Maybe FontSpec
getFontSpecMaybe EditorF
ps
    ps :: EditorF
ps = (EditorF -> EditorF
customiser::(Customiser EditorF))  ([Pars] -> EditorF
Pars [])

newtype EditorF = Pars [Pars]

data Pars
  = FontSpec FontSpec

parameter_instance(FontSpec,EditorF)