module HSP.HJScript where import HSP import HJScript import qualified HSX.XMLGenerator as HSX instance IsXMLs (Block ()) where toXMLs b = toXMLs $ instance IsXMLs (HJScript ()) where toXMLs script = toXMLs . snd $ evalHJScript script 0 instance IsAttrValue (HJScript ()) where toAttrValue script = do let block = snd $ evalHJScript script 0 return . Value $ "javascript:" ++ show block newGlobalVar :: HSP (Var t, Block ()) newGlobalVar = do varName <- newGlobVarName let block = toBlock $ VarDecl varName return (JVar varName, block) newGlobalVarWith :: Exp t -> HSP (Var t, Block ()) newGlobalVarWith e = do varName <- newGlobVarName let block = toBlock $ VarDeclAssign varName e return (JVar varName, block) newGlobVarName :: HSP String newGlobVarName = do r <- getIncNumber return $ "global_" ++ (show r) type ElemRef = String {- -- This should be done Soon (TM), but we -- need to look over things like getElementById, -- so it'll have to wait until the next version. newtype ElemRef = ElemRef String instance IsAttrValue ElemRef where toAttrValue (ElemRef s) = toAttrValue s instance ToAttrNodeValue ElemRef where toAttrNodeValue (ElemRef s) = toAttrValue s -} genId :: HSP ElemRef genId = do r <- getIncNumber return $ "elemId_" ++ (show r) ref :: HSP XML -> HSP (ElemRef, XML) ref xml = do i <- genId xml' <- xml `setId` i return (i, xml') ------------------------------------------------- -- Settting properties ------------------------------------------------- setId :: (HSX.SetAttr m xml, HSX.EmbedAsAttr (Attr String v) (HSX.XMLGenT m (HSX.Attribute m))) => xml -> v -> HSX.XMLGenT m (HSX.XML m) setId x v = x `set` ("id" := v) -- Generel method for adding 'onEvent' attributes to XML elements. --onEvent :: SetAttr xml (Attr String (HJScript ())) => Event -> xml -> HJScript () -> SetResult xml onEvent :: (HSX.SetAttr m xml, HSX.EmbedAsAttr (Attr String (HJScript ())) (HSX.XMLGenT m (HSX.Attribute m))) => Event -> xml -> HJScript () -> HSX.XMLGenT m (HSX.XML m) onEvent event xml script = xml `set` (showEvent event := script) onAbort, onBlur, onChange, onClick, onDblClick, onError, onFocus, onKeyDown, onKeyPress, onKeyUp, onLoad, onMouseDown, onMouseMove, onMouseOut, onMouseOver, onMouseUp, onReset, onResize, onSelect, onSubmit, onUnload :: (HSX.SetAttr m xml, HSX.EmbedAsAttr (Attr String (HJScript ())) (HSX.XMLGenT m (HSX.Attribute m))) => xml -> HJScript () -> HSX.XMLGenT m (HSX.XML m) onAbort = onEvent OnAbort onBlur = onEvent OnBlur onChange = onEvent OnChange onClick = onEvent OnClick onDblClick = onEvent OnDblclick onError = onEvent OnError onFocus = onEvent OnFocus onKeyDown = onEvent OnKeyDown onKeyPress = onEvent OnKeyPress onKeyUp = onEvent OnKeyUp onLoad = onEvent OnLoad onMouseDown = onEvent OnMouseDown onMouseMove = onEvent OnMouseMove onMouseOut = onEvent OnMouseOut onMouseOver = onEvent OnMouseOver onMouseUp = onEvent OnMouseUp onReset = onEvent OnReset onResize = onEvent OnResize onSelect = onEvent OnSelect onSubmit = onEvent OnSubmit onUnload = onEvent OnUnload