InputEditorF

{-# 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

{-
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.







  
-}

inputEditorF = inputEditorF' standard

inputEditorF' pm =
    mapFilterSP change >^^=< editorF' pm >=^^< concatMapSP loadEditor
  where
    change (EditChange inputmsg) = Just inputmsg
    change _ = Nothing

editorF = editorF' standard

editorF' customiser = oldEditorF font
  where
    font = fromMaybe (fontSpec defaultFont) $ getFontSpecMaybe ps
    ps = (customiser::(Customiser EditorF))  (Pars [])

newtype EditorF = Pars [Pars]

data Pars
  = FontSpec FontSpec

instance HasFontSpec (EditorF) where {  setFontSpec p (Pars ps) = Pars (FontSpec p:ps);   getFontSpecMaybe (Pars ps) = getparMaybe (\x->case x of FontSpec p -> Just p; _-> Nothing) ps }