racket/src/mysterx/htmlutil.cxx

// htmlutil.cxx

#ifdef MYSTERX_3M
// Created by xform.ss:
# include "xsrc/htmlutil3m.cxx"
#else

#include "mysterx_pre.h"

#include <objbase.h>
#include <mshtml.h>
#include <initguid.h>
#include <winnls.h>
#include <exdisp.h>

#include "escheme.h"

#include "bstr.h"
#include "myspage.h"
#include "myssink.h"

#include "mysterx.h"

IHTMLElement *findBodyElement(IHTMLDocument2 *pDocument,
			      LPCTSTR tag, LPCTSTR id,int index) {
  IHTMLElementCollection *pTagCollection;
  IHTMLElement *pBody,*pIHTMLElement,*retval;
  IDispatch *pIDispatch;
  long numElts;
  BSTR idAttribute;
  BSTR idBSTR;
  VARIANT variant;
  int count;
  int i;

  // filter elements by tag

  pDocument->get_body(&pBody);

  if (pBody == NULL) {
    scheme_signal_error("Can't find document BODY");
  }

  retval = NULL;

  // special-handling if body element requested

  if (lstrcmpi(tag,TEXT("BODY")) == 0) {
    idAttribute = SysAllocString(L"id");
    idBSTR = textToBSTR(id,lstrlen(id));

    pBody->getAttribute(idAttribute,FALSE,&variant);

    if (variant.vt == VT_BSTR && variant.bstrVal &&
        _wcsicmp(idBSTR,variant.bstrVal) == 0) {
      retval = pBody;
    }

    SysFreeString(idAttribute);
    SysFreeString(idBSTR);

    return retval;
  }

  pTagCollection = getBodyElementsWithTag(pBody,tag);

  pBody->Release();

  // enumerate until we find id or return NULL

  pTagCollection->get_length(&numElts);

  idAttribute = SysAllocString(L"id");
  idBSTR = stringToBSTR(id,strlen(id));

  count = 0;

  for (i = 0; i < numElts; i++) {

    pIDispatch = getElementInCollection(pTagCollection,i);

    pIDispatch->QueryInterface(IID_IHTMLElement,(void **)&pIHTMLElement);

    pIDispatch->Release();

    if (pIHTMLElement == NULL) {
      continue;
    }

    pIHTMLElement->getAttribute(idAttribute,FALSE,&variant);

    if (variant.vt == VT_BSTR && variant.bstrVal &&
        _wcsicmp(idBSTR,variant.bstrVal) == 0) {
      if (count++ == index) {
	retval = pIHTMLElement;
	break;
      }
    }

    pIHTMLElement->Release();

  }

  SysFreeString(idAttribute);
  SysFreeString(idBSTR);

  pTagCollection->Release();

  return retval;

}

IHTMLElementCollection *getBodyElementsWithTag(IHTMLElement *pBody, LPCTSTR tag) {
  IDispatch *pBodyDispatch;
  IDispatch *pObjectsDispatch;
  IHTMLElementCollection *pBodyEltCollection;
  IHTMLElementCollection *pObjectsCollection;
  long numBodyItems;
  BSTR bstr;
  VARIANT variant;
  VARIANT emptyVariant;

  pBody->get_all(&pBodyDispatch);

  pBodyDispatch->QueryInterface(IID_IHTMLElementCollection,(void **)&pBodyEltCollection);

  pBodyDispatch->Release();

  if (pBodyEltCollection == NULL) {
    scheme_signal_error("Can't get body elements");
  }

  pBodyEltCollection->get_length(&numBodyItems);

  bstr = textToBSTR(tag,lstrlen(tag));

  VariantInit(&variant);
  VariantInit(&emptyVariant);

  variant.vt = VT_BSTR;
  variant.bstrVal = bstr;

  pBodyEltCollection->tags(variant,&pObjectsDispatch);

  pBodyEltCollection->Release();
  SysFreeString(bstr);

  if (pObjectsDispatch == NULL) {
    scheme_signal_error("Can't get body objects");
  }

  pObjectsDispatch->QueryInterface(IID_IHTMLElementCollection,(void **)&pObjectsCollection);

  pObjectsDispatch->Release();

  if (pObjectsCollection == NULL) {
    scheme_signal_error("Can't get body elements");
  }

  return pObjectsCollection;
}

IDispatch *getElementInCollection(IHTMLElementCollection *pEltCollection,int ndx) {
  VARIANT variant,emptyVariant;
  IDispatch *pIDispatch;

  VariantInit(&variant);
  VariantInit(&emptyVariant);

  variant.vt = VT_I2;
  variant.iVal = ndx;

  pEltCollection->item(variant,emptyVariant,&pIDispatch);

  if (pIDispatch == NULL) {
    scheme_signal_error("Unable to find element %d in collection",ndx);
  }

  return pIDispatch;
}

IDispatch *getObjectInCollection(IHTMLElementCollection *pObjectCollection,int ndx) {
  IDispatch *pIDispatch;
  IHTMLObjectElement *pIHTMLObjectElement;

  pIDispatch = getElementInCollection(pObjectCollection,ndx);

  // sometimes pIDispatch is HTML element containing the control
  // sometimes it's the control itself
  // apparent bug in DHTML

  pIDispatch->QueryInterface(IID_IHTMLObjectElement,(void **)&pIHTMLObjectElement);

  if (pIHTMLObjectElement != NULL) {

    pIDispatch->Release();

    pIHTMLObjectElement->get_object(&pIDispatch);

    pIHTMLObjectElement->Release();

    if (pIDispatch == NULL) {
      scheme_signal_error("Unable to get object element interface for object");
    }
  }

  return pIDispatch;
}

Scheme_Object *mx_element_focus(int argc,Scheme_Object **argv) {
  HRESULT hr;
  IHTMLElement *pIHTMLElement;
  IHTMLElement2 *pIHTMLElement2;
  Scheme_Object *v;

  v = GUARANTEE_ELEMENT ("element-focus", 0);
  pIHTMLElement = MX_ELEMENT_VAL (v);

  hr = pIHTMLElement->QueryInterface(IID_IHTMLElement2,
				     (void **)&pIHTMLElement2);

  if (hr != S_OK || pIHTMLElement2 == NULL) {
    codedComError("element-focus: Couldn't find IHTMLElement2 interface",hr);
  }

  pIHTMLElement2->focus();

  pIHTMLElement2->Release();

  return scheme_void;
}

// selections

Scheme_Object *mx_element_selection(int argc,Scheme_Object **argv) {
  HRESULT hr;
  IHTMLElement *pIHTMLElement;
  IHTMLSelectElement *pIHTMLSelectElement;
  BSTR selection;
  Scheme_Object *v;

  v = GUARANTEE_ELEMENT ("element-selection", 0);
  pIHTMLElement = MX_ELEMENT_VAL (v);

  hr = pIHTMLElement->QueryInterface(IID_IHTMLSelectElement,
				     (void **)&pIHTMLSelectElement);

  if (hr != S_OK || pIHTMLSelectElement == NULL) {
    codedComError("element-selection: Couldn't find IHTMLSelectElement interface",hr);
  }

  hr = pIHTMLSelectElement->get_value(&selection);

  pIHTMLSelectElement->Release();

  if (hr != S_OK) {
    codedComError("element-selection: Error getting selection value",hr);
  }

  return unmarshalBSTR (selection);
}

Scheme_Object *mx_element_set_selection(int argc,Scheme_Object **argv) {
  HRESULT hr;
  IHTMLElement *pIHTMLElement;
  IHTMLSelectElement *pIHTMLSelectElement;
  BSTR selection;

  GUARANTEE_ELEMENT ("element-set-selection!", 0);
  GUARANTEE_STRSYM ("element-set-selection!", 1);

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  hr = pIHTMLElement->QueryInterface(IID_IHTMLSelectElement,
				     (void **)&pIHTMLSelectElement);

  if (hr != S_OK || pIHTMLSelectElement == NULL) {
    codedComError("element-set-selection!: Couldn't find IHTMLSelectElement interface",hr);
  }

  selection = schemeToBSTR (argv[1]);

  hr = pIHTMLSelectElement->put_value(selection);

  SysFreeString(selection);

  pIHTMLSelectElement->Release();

  if (hr != S_OK) {
    codedComError("element-selection: Error getting selection value",hr);
  }

  return scheme_void;
}

// IHTMLElement wrappers

Scheme_Object *mx_element_stuff_html(int argc,Scheme_Object **argv,WCHAR *where,char *name) {
  IHTMLElement *pIHTMLElement;
  BSTR whereBSTR,htmlBSTR;

  GUARANTEE_ELEMENT (name, 0);
  GUARANTEE_STRSYM (name, 1);

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  whereBSTR = SysAllocString(where);
  htmlBSTR = schemeToBSTR (argv[1]);

  pIHTMLElement->insertAdjacentHTML(whereBSTR,htmlBSTR);

  SysFreeString(whereBSTR);
  SysFreeString(htmlBSTR);

  return scheme_void;
}

Scheme_Object *mx_element_insert_html(int argc,Scheme_Object **argv) {
  return mx_element_stuff_html(argc,argv,L"BeforeBegin","element-insert-html");
}

Scheme_Object *mx_element_append_html(int argc,Scheme_Object **argv) {
  return mx_element_stuff_html(argc,argv,L"AfterEnd","element-append-html");
}

Scheme_Object *mx_element_stuff_text(int argc,Scheme_Object **argv,WCHAR *where,char *name) {
  IHTMLElement *pIHTMLElement;
  BSTR whereBSTR,textBSTR;

  GUARANTEE_ELEMENT (name, 0);
  GUARANTEE_STRSYM (name, 1);

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  whereBSTR = SysAllocString(where);
  textBSTR = schemeToBSTR (argv[1]);

  pIHTMLElement->insertAdjacentText(whereBSTR,textBSTR);

  SysFreeString(whereBSTR);
  SysFreeString(textBSTR);

  return scheme_void;
}

Scheme_Object *mx_element_insert_text(int argc,Scheme_Object **argv) {
  return mx_element_stuff_html(argc,argv,L"BeforeBegin","element-insert-text");
}

Scheme_Object *mx_element_append_text(int argc,Scheme_Object **argv) {
  return mx_element_stuff_html(argc,argv,L"AfterEnd","element-append-text");
}

Scheme_Object *mx_element_replace_html(int argc,Scheme_Object **argv) {
  IHTMLElement *pIHTMLElement;
  BSTR htmlBSTR;

  GUARANTEE_ELEMENT ("element-replace-html", 0);
  GUARANTEE_STRSYM ("element-replace-html", 1);

  if (MX_ELEMENT_VALIDITY(argv[0]) == FALSE) {
    scheme_signal_error("element-replace-html: Element no longer valid");
  }

  MX_ELEMENT_VALIDITY(argv[0]) = FALSE;

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  htmlBSTR = schemeToBSTR (argv[1]);

  pIHTMLElement->put_outerHTML(htmlBSTR);

  pIHTMLElement->Release();

  SysFreeString(htmlBSTR);

  return scheme_void;
}

Scheme_Object *mx_element_get_html(int argc,Scheme_Object **argv) {
  BSTR bstr;
  IHTMLElement *pIHTMLElement;
  Scheme_Object *retval;

  GUARANTEE_ELEMENT ("get-html", 0);

  if (MX_ELEMENT_VALIDITY(argv[0]) == FALSE) {
    scheme_signal_error("get-html: Element no longer valid");
  }

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  pIHTMLElement->get_innerHTML(&bstr);

  retval = BSTRToSchemeString (bstr);

  SysFreeString(bstr);

  return retval;
}

Scheme_Object *mx_element_get_text(int argc,Scheme_Object **argv) {
  BSTR bstr;
  IHTMLElement *pIHTMLElement;
  Scheme_Object *retval;

  GUARANTEE_ELEMENT ("get-text", 0);

  if (MX_ELEMENT_VALIDITY(argv[0]) == FALSE) {
    scheme_signal_error("get-text}: Element no longer valid");
  }

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  pIHTMLElement->get_innerText(&bstr);

  retval = BSTRToSchemeString(bstr);

  SysFreeString(bstr);

  return retval;
}

Scheme_Object *mx_element_attribute(int argc,Scheme_Object **argv) {
  IHTMLElement *pIHTMLElement;
  BSTR attributeBSTR;
  VARIANT variant;

  GUARANTEE_ELEMENT ("element-attribute", 0);
  GUARANTEE_STRSYM ("element-attribute", 1);

  if (MX_ELEMENT_VALIDITY(argv[0]) == FALSE) {
    scheme_signal_error("Element no longer valid");
  }

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  attributeBSTR = schemeToBSTR (argv[1]);

  pIHTMLElement->getAttribute(attributeBSTR,FALSE,&variant);

  SysFreeString(attributeBSTR);

  return variantToSchemeObject(&variant);

}

Scheme_Object *mx_element_set_attribute(int argc,Scheme_Object **argv) {
  IHTMLElement *pIHTMLElement;
  BSTR attributeBSTR;
  VARIANT variant;

  GUARANTEE_ELEMENT ("element-set-attribute!", 0);
  GUARANTEE_STRSYM ("element-set-attribute!", 1);

  if (SCHEME_STRSYMP (argv[2]) == FALSE && SCHEME_INTP(argv[2]) == FALSE &&
#ifdef MZ_USE_SINGLE_FLOATS
      SCHEME_FLTP(argv[2]) == FALSE &&
#endif
      SCHEME_DBLP(argv[2]) == FALSE &&
      argv[2] != scheme_true && argv[2] != scheme_false) {
    scheme_signal_error("Attribute must have a type in {string,symbol,integer,float,double,{#t,#f}}");
  }

  if (MX_ELEMENT_VALIDITY(argv[0]) == FALSE) {
    scheme_signal_error("Element no longer valid");
  }

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  attributeBSTR = schemeToBSTR (argv[1]);

  marshalSchemeValueToVariant(argv[2],&variant);

  pIHTMLElement->setAttribute(attributeBSTR,variant,FALSE);

  SysFreeString(attributeBSTR);

  return scheme_void;

}

Scheme_Object *mx_element_remove_attribute(int argc,Scheme_Object **argv) {
  IHTMLElement *pIHTMLElement;
  BSTR attributeBSTR;
  VARIANT_BOOL success;

  GUARANTEE_ELEMENT ("element-remove-attribute!", 0);
  GUARANTEE_STRSYM ("element-remove-attribute!", 1);

  if (MX_ELEMENT_VALIDITY(argv[0]) == FALSE) {
    scheme_signal_error("Element no longer valid");
  }

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  attributeBSTR = schemeToBSTR (argv[1]);

  pIHTMLElement->removeAttribute(attributeBSTR,FALSE,&success);

  SysFreeString(attributeBSTR);

  if (success == 0) {
    scheme_signal_error("Failure in removing attribute");
  }

  return scheme_void;

}

Scheme_Object *mx_element_tag(int argc,Scheme_Object **argv) {
  IHTMLElement *pIHTMLElement;
  BSTR tagBSTR;
  Scheme_Object *retval;

  GUARANTEE_ELEMENT ("element-tag", 0);

  if (MX_ELEMENT_VALIDITY(argv[0]) == FALSE) {
    scheme_signal_error("Element no longer valid");
  }

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  pIHTMLElement->get_tagName(&tagBSTR);

  retval = unmarshalBSTR (tagBSTR);

  SysFreeString(tagBSTR);

  return retval;
}

Scheme_Object *mx_element_click(int argc,Scheme_Object **argv) {
  IHTMLElement *pIHTMLElement;

  GUARANTEE_ELEMENT ("element-click", 0);

  if (MX_ELEMENT_VALIDITY(argv[0]) == FALSE) {
    scheme_signal_error("Element no longer valid");
  }

  pIHTMLElement = MX_ELEMENT_VAL(argv[0]);

  pIHTMLElement->click();

  return scheme_void;
}

// IHTMLStyle functions via IHTMLElement

IHTMLStyle *styleInterfaceFromElement(Scheme_Object *o) {
  HRESULT hr;
  IHTMLElement *pIHTMLElement;
  IHTMLStyle *pIHTMLStyle;

  if (MX_ELEMENT_VALIDITY(o) == FALSE) {
    scheme_signal_error("Element no longer valid");
  }

  pIHTMLElement = MX_ELEMENT_VAL(o);

  pIHTMLStyle = NULL;

  hr = pIHTMLElement->get_style(&pIHTMLStyle);

  if (hr != S_OK || pIHTMLStyle == NULL) {
    codedComError("Can't get IHTMLStyle interface from element",hr);
  }

  return pIHTMLStyle;
}

    // strings

#define elt_style_string_getter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  BSTR bstr; \
  Scheme_Object *retval, *v; \
  v = GUARANTEE_ELEMENT (scm_name, 0); \
  pIHTMLStyle = styleInterfaceFromElement (v); \
  hr = pIHTMLStyle->dhtml_name(&bstr); \
  retval = unmarshalBSTR (bstr); \
  SysFreeString(bstr); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return retval; \
}

#define elt_style_string_setter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  BSTR bstr; \
  GUARANTEE_ELEMENT (scm_name, 0); \
  GUARANTEE_STRSYM (scm_name, 1);  \
  pIHTMLStyle = styleInterfaceFromElement(argv[0]); \
  bstr = schemeToBSTR (argv[1]); \
  hr = pIHTMLStyle->dhtml_name(bstr); \
  SysFreeString(bstr); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return scheme_void; \
}

elt_style_string_getter(mx_element_font_family,"element-font-family",
			get_fontFamily)
elt_style_string_setter(mx_element_set_font_family,"element-set-font-family!",
			put_fontFamily)

elt_style_string_getter(mx_element_font_style,"element-font-style",
			get_fontStyle)
elt_style_string_setter(mx_element_set_font_style,"element-set-font-style!",
			put_fontStyle)

elt_style_string_getter(mx_element_font_variant,"element-font-variant",
			get_fontVariant)
elt_style_string_setter(mx_element_set_font_variant,"element-set-font-variant!",
			put_fontVariant)

elt_style_string_getter(mx_element_font_weight,"element-font-weight",
			get_fontWeight)
elt_style_string_setter(mx_element_set_font_weight,"element-set-font-weight!",
			put_fontWeight)

elt_style_string_getter(mx_element_font,"element-font",
			get_font)
elt_style_string_setter(mx_element_set_font,"element-set-font!",
			put_font)

elt_style_string_getter(mx_element_background,"element-background",
			get_background)
elt_style_string_setter(mx_element_set_background,"element-set-background!",
			put_background)

elt_style_string_getter(mx_element_background_image,
			"element-background-image",
			get_backgroundImage)
elt_style_string_setter(mx_element_set_background_image,
			"element-set-background-image!",
			put_backgroundImage)

elt_style_string_getter(mx_element_background_repeat,
			"element-background-repeat",
			get_backgroundRepeat)
elt_style_string_setter(mx_element_set_background_repeat,
			"element-set-background-repeat!",
			put_backgroundRepeat)

elt_style_string_getter(mx_element_background_attachment,
			"element-background-attachment",
			get_backgroundAttachment)
elt_style_string_setter(mx_element_set_background_attachment,
			"element-set-background-attachment!",
			put_backgroundAttachment)

elt_style_string_getter(mx_element_background_position,
			"element-background-position",
			get_backgroundPosition)
elt_style_string_setter(mx_element_set_background_position,
			"element-set-background-position!",
			put_backgroundPosition)

elt_style_string_getter(mx_element_text_decoration,
			"element-text-decoration",
			get_textDecoration)
elt_style_string_setter(mx_element_set_text_decoration,
			"element-set-text-decoration!",
			put_textDecoration)

elt_style_string_getter(mx_element_text_transform,
			"element-text-transform",
			get_textTransform)
elt_style_string_setter(mx_element_set_text_transform,
			"element-set-text-transform!",
			put_textTransform)

elt_style_string_getter(mx_element_text_align,
			"element-text-align",
			get_textAlign)
elt_style_string_setter(mx_element_set_text_align,
			"element-set-text-align!",
			put_textAlign)

elt_style_string_getter(mx_element_margin,
			"element-margin",
			get_margin)
elt_style_string_setter(mx_element_set_margin,
			"element-set-margin!",
			put_margin)

elt_style_string_getter(mx_element_padding,
			"element-padding",
			get_padding)
elt_style_string_setter(mx_element_set_padding,
			"element-set-padding!",
			put_padding)

elt_style_string_getter(mx_element_border,
			"element-border",
			get_border)
elt_style_string_setter(mx_element_set_border,
			"element-set-border!",
			put_border)

elt_style_string_getter(mx_element_border_top,
			"element-border-top",
			get_borderTop)
elt_style_string_setter(mx_element_set_border_top,
			"element-set-border-top!",
			put_borderTop)

elt_style_string_getter(mx_element_border_left,
			"element-border-left",
			get_borderLeft)
elt_style_string_setter(mx_element_set_border_left,
			"element-set-border-left!",
			put_borderLeft)

elt_style_string_getter(mx_element_border_right,
			"element-border-right",
			get_borderRight)
elt_style_string_setter(mx_element_set_border_right,
			"element-set-border-right!",
			put_borderRight)

elt_style_string_getter(mx_element_border_bottom,
			"element-border-bottom",
			get_borderBottom)
elt_style_string_setter(mx_element_set_border_bottom,
			"element-set-border-bottom!",
			put_borderBottom)

elt_style_string_getter(mx_element_border_color,
			"element-border-color",
			get_borderColor)
elt_style_string_setter(mx_element_set_border_color,
			"element-set-border-color!",
			put_borderColor)

elt_style_string_getter(mx_element_border_width,
			"element-border-width",
			get_borderWidth)
elt_style_string_setter(mx_element_set_border_width,
			"element-set-border-width!",
			put_borderWidth)

elt_style_string_getter(mx_element_border_style,
			"element-border-style",
			get_borderStyle)
elt_style_string_setter(mx_element_set_border_style,
			"element-set-border-style!",
			put_borderStyle)

elt_style_string_getter(mx_element_border_top_style,
			"element-border-top-style",
			get_borderTopStyle)
elt_style_string_setter(mx_element_set_border_top_style,
			"element-set-border-top-style!",
			put_borderTopStyle)

elt_style_string_getter(mx_element_border_bottom_style,
			"element-border-bottom-style",
			get_borderBottomStyle)
elt_style_string_setter(mx_element_set_border_bottom_style,
			"element-set-border-bottom-style!",
			put_borderBottomStyle)

elt_style_string_getter(mx_element_border_left_style,
			"element-border-left-style",
			get_borderLeftStyle)
elt_style_string_setter(mx_element_set_border_left_style,
			"element-set-border-left-style!",
			put_borderLeftStyle)

elt_style_string_getter(mx_element_border_right_style,
			"element-border-right-style",
			get_borderRightStyle)
elt_style_string_setter(mx_element_set_border_right_style,
			"element-set-border-right-style!",
			put_borderRightStyle)

elt_style_string_getter(mx_element_style_float,
			"element-style-float",
			get_styleFloat)
elt_style_string_setter(mx_element_set_style_float,
			"element-set-style-float!",
			put_styleFloat)

elt_style_string_getter(mx_element_clear,
			"element-clear",
			get_clear)
elt_style_string_setter(mx_element_set_clear,
			"element-set-clear!",
			put_clear)

elt_style_string_getter(mx_element_display,
			"element-display",
			get_display)
elt_style_string_setter(mx_element_set_display,
			"element-set-display!",
			put_display)

elt_style_string_getter(mx_element_visibility,
			"element-visibility",
			get_visibility)
elt_style_string_setter(mx_element_set_visibility,
			"element-set-visibility!",
			put_visibility)

elt_style_string_getter(mx_element_list_style_type,
			"element-list-style-type",
			get_listStyleType)
elt_style_string_setter(mx_element_set_list_style_type,
			"element-set-list-style-type!",
			put_listStyleType)

elt_style_string_getter(mx_element_list_style_position,
			"element-list-style-position",
			get_listStylePosition)
elt_style_string_setter(mx_element_set_list_style_position,
			"element-set-list-style-position!",
			put_listStylePosition)

elt_style_string_getter(mx_element_list_style_image,
			"element-list-style-image",
			get_listStyleImage)
elt_style_string_setter(mx_element_set_list_style_image,
			"element-set-list-style-image!",
			put_listStyleImage)

elt_style_string_getter(mx_element_list_style,
			"element-list-style",
			get_listStyle)
elt_style_string_setter(mx_element_set_list_style,
			"element-set-list-style!",
			put_listStyle)

// note: no setter here
elt_style_string_getter(mx_element_position,
			"element-position",
			get_position)

elt_style_string_getter(mx_element_overflow,
			"element-overflow",
			get_overflow)
elt_style_string_setter(mx_element_set_overflow,
			"element-set-overflow!",
			put_overflow)

elt_style_string_getter(mx_element_pagebreak_before,
			"element-pagebreak-before",
			get_pageBreakBefore)
elt_style_string_setter(mx_element_set_pagebreak_before,
			"element-set-pagebreak-before!",
			put_pageBreakBefore)

elt_style_string_getter(mx_element_pagebreak_after,
			"element-pagebreak-after",
			get_pageBreakAfter)
elt_style_string_setter(mx_element_set_pagebreak_after,
			"element-set-pagebreak-after!",
			put_pageBreakAfter)

elt_style_string_getter(mx_element_css_text,
			"element-css-text",
			get_cssText)
elt_style_string_setter(mx_element_set_css_text,
			"element-set-css_text!",
			put_cssText)

elt_style_string_getter(mx_element_cursor,
			"element-cursor",
			get_cursor)
elt_style_string_setter(mx_element_set_cursor,
			"element-set-cursor!",
			put_cursor)

elt_style_string_getter(mx_element_clip,
			"element-clip",
			get_clip)
elt_style_string_setter(mx_element_set_clip,
			"element-set-clip!",
			put_clip)

elt_style_string_getter(mx_element_filter,
			"element-filter",
			get_filter)
elt_style_string_setter(mx_element_set_filter,
			"element-set-filter!",
			put_filter)

// note: no setter here
elt_style_string_getter(mx_element_style_string,
			"element-style-string",
			toString)

  // bools

#define elt_style_bool_getter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  VARIANT_BOOL boolVal; \
  Scheme_Object *v; \
  v = GUARANTEE_ELEMENT (scm_name, 0); \
  pIHTMLStyle = styleInterfaceFromElement (v); \
  hr = pIHTMLStyle->dhtml_name(&boolVal); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return (boolVal == 0) ? scheme_false : scheme_true; \
}

#define elt_style_bool_setter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  VARIANT_BOOL boolVal;	\
  Scheme_Object *v; \
  v = GUARANTEE_ELEMENT (scm_name, 0);\
  pIHTMLStyle = styleInterfaceFromElement (v); \
  boolVal = (argv[1] == scheme_false) ? 0 : -1; \
  hr = pIHTMLStyle->dhtml_name(boolVal); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return scheme_void; \
}

elt_style_bool_getter(mx_element_text_decoration_none,
		      "element-text-decoration-none",
		      get_textDecorationNone)
elt_style_bool_setter(mx_element_set_text_decoration_none,
		      "element-set-text-decoration-none!",
		      put_textDecorationNone)

elt_style_bool_getter(mx_element_text_decoration_underline,
		      "element-text-decoration-underline",
		      get_textDecorationUnderline)
elt_style_bool_setter(mx_element_set_text_decoration_underline,
		      "element-set-text-decoration-underline!",
		      put_textDecorationUnderline)

elt_style_bool_getter(mx_element_text_decoration_overline,
		      "element-text-decoration-overline",
		      get_textDecorationOverline)
elt_style_bool_setter(mx_element_set_text_decoration_overline,
		      "element-set-text-decoration-overline!",
		      put_textDecorationOverline)

elt_style_bool_getter(mx_element_text_decoration_linethrough,
		      "element-text-decoration-linethrough",
		      get_textDecorationLineThrough)
elt_style_bool_setter(mx_element_set_text_decoration_linethrough,
		      "element-set-text-decoration-linethrough!",
		      put_textDecorationLineThrough)

elt_style_bool_getter(mx_element_text_decoration_blink,
		      "element-text-decoration-blink",
		      get_textDecorationBlink)
elt_style_bool_setter(mx_element_set_text_decoration_blink,
		      "element-set-text-decoration-blink!",
		      put_textDecorationBlink)

  // longs

#define elt_style_long_getter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  long val; \
  Scheme_Object *v; \
  v = GUARANTEE_ELEMENT (scm_name, 0); \
  pIHTMLStyle = styleInterfaceFromElement (v); \
  hr = pIHTMLStyle->dhtml_name(&val); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return scheme_make_integer(val); \
}

#define elt_style_long_setter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  long val; \
  GUARANTEE_ELEMENT (scm_name, 0); \
  GUARANTEE_INTEGER (scm_name, 1); \
  pIHTMLStyle = styleInterfaceFromElement(argv[0]); \
  if (scheme_get_int_val(argv[1],&val) == 0) { \
      scheme_signal_error("Integer argument won't fit in a long"); \
  } \
  hr = pIHTMLStyle->dhtml_name(val); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return scheme_void; \
}

elt_style_long_getter(mx_element_pixel_top,
		      "element-pixel-top",
		      get_pixelTop)
elt_style_long_setter(mx_element_set_pixel_top,
		      "element-set-pixel-top!",
		      put_pixelTop)

elt_style_long_getter(mx_element_pixel_left,
		      "element-pixel-left",
		      get_pixelLeft)
elt_style_long_setter(mx_element_set_pixel_left,
		      "element-set-pixel-left!",
		      put_pixelLeft)

elt_style_long_getter(mx_element_pixel_width,
		      "element-pixel-width",
		      get_pixelWidth)
elt_style_long_setter(mx_element_set_pixel_width,
		      "element-set-pixel-width!",
		      put_pixelWidth)

elt_style_long_getter(mx_element_pixel_height,
		      "element-pixel-height",
		      get_pixelHeight)
elt_style_long_setter(mx_element_set_pixel_height,
		      "element-set-pixel-height!",
		      put_pixelHeight)

  // floats

#ifdef MZ_USE_SINGLE_FLOATS
#define elt_style_float_getter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  float val; \
  Scheme_Object *v; \
  v = GUARANTEE_ELEMENT (scm_name, 0); \
  pIHTMLStyle = styleInterfaceFromElement (v); \
  hr = pIHTMLStyle->dhtml_name(&val); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return scheme_make_float(val); \
}

#define elt_style_float_setter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  GUARANTEE_ELEMENT (scm_name, 0); \
  GUARANTEE_TYPE (scm_name, 1, SCHEME_FLTP, "float"); \
  pIHTMLStyle = styleInterfaceFromElement(argv[0]); \
  hr = pIHTMLStyle->dhtml_name(SCHEME_FLT_VAL(argv[1]); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return scheme_void; \
}
#else
#define elt_style_float_getter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  float val; \
  Scheme_Object *v; \
  v = GUARANTEE_ELEMENT (scm_name, 0); \
  pIHTMLStyle = styleInterfaceFromElement(v); \
  hr = pIHTMLStyle->dhtml_name(&val); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return scheme_make_double((double)val); \
}

#define elt_style_float_setter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  GUARANTEE_ELEMENT (scm_name, 0); \
  GUARANTEE_TYPE (scm_name, 1, SCHEME_DBLP, "double"); \
  pIHTMLStyle = styleInterfaceFromElement(argv[0]); \
  hr = pIHTMLStyle->dhtml_name((float)SCHEME_DBL_VAL(argv[1])); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return scheme_void; \
}
#endif

elt_style_float_getter(mx_element_pos_top,
		       "element-pos-top",
		       get_posTop)
elt_style_float_setter(mx_element_set_pos_top,
		       "element-set-pos-top!",
		       put_posTop)

elt_style_float_getter(mx_element_pos_left,
		       "element-pos-left",
		       get_posLeft)
elt_style_float_setter(mx_element_set_pos_left,
		       "element-set-pos-left!",
		       put_posLeft)

elt_style_float_getter(mx_element_pos_width,
		       "element-pos-width",
		       get_posWidth)
elt_style_float_setter(mx_element_set_pos_width,
		       "element-set-pos-width!",
		       put_posWidth)

elt_style_float_getter(mx_element_pos_height,
		       "element-pos-height",
		       get_posHeight)
elt_style_float_setter(mx_element_set_pos_height,
		       "element-set-pos-height!",
		       put_posHeight)

  // variants

#define elt_style_variant_getter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  VARIANT variant; \
  Scheme_Object *v; \
  v = GUARANTEE_ELEMENT (scm_name, 0); \
  pIHTMLStyle = styleInterfaceFromElement (v); \
  hr = pIHTMLStyle->dhtml_name(&variant); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return variantToSchemeObject(&variant); \
}

#define elt_style_variant_setter(fun_name,scm_name,dhtml_name) \
Scheme_Object *fun_name(int argc,Scheme_Object **argv) { \
  HRESULT hr; \
  IHTMLStyle *pIHTMLStyle; \
  VARIANT variant; \
  Scheme_Object *v; \
  v = GUARANTEE_ELEMENT (scm_name, 0); \
  pIHTMLStyle = styleInterfaceFromElement(v); \
  marshalSchemeValueToVariant(argv[1],&variant); \
  hr = pIHTMLStyle->dhtml_name(variant); \
  pIHTMLStyle->Release(); \
  if (FAILED(hr)) { \
    scheme_signal_error(#dhtml_name " failed with code %X",hr); \
  } \
  return scheme_void; \
}

elt_style_variant_getter(mx_element_font_size,
			 "element-font-size",
			 get_fontSize)
elt_style_variant_setter(mx_element_set_font_size,
			 "element-set-font-size!",
			 put_fontSize)

elt_style_variant_getter(mx_element_color,
			 "element-color",
			 get_color)
elt_style_variant_setter(mx_element_set_color,
			 "element-set-color!",
			 put_color)

elt_style_variant_getter(mx_element_background_color,
			 "element-background-color",
			 get_backgroundColor)
elt_style_variant_setter(mx_element_set_background_color,
			 "element-set-background-color!",
			 put_backgroundColor)

elt_style_variant_getter(mx_element_background_position_x,
			 "element-background-position-x",
			 get_backgroundPositionX)
elt_style_variant_setter(mx_element_set_background_position_x,
			 "element-set-background_position-x!",
			 put_backgroundPositionX)

elt_style_variant_getter(mx_element_background_position_y,
			 "element-background-position-y",
			 get_backgroundPositionY)
elt_style_variant_setter(mx_element_set_background_position_y,
			 "element-set-background_position-y!",
			 put_backgroundPositionY)

elt_style_variant_getter(mx_element_letter_spacing,
			 "element-letter-spacing",
			 get_letterSpacing)
elt_style_variant_setter(mx_element_set_letter_spacing,
			 "element-set-letter-spacing",
			 put_letterSpacing)

elt_style_variant_getter(mx_element_vertical_align,
			 "element-vertical-align",
			 get_verticalAlign)
elt_style_variant_setter(mx_element_set_vertical_align,
			 "element-set-vertical-align",
			 put_verticalAlign)

elt_style_variant_getter(mx_element_text_indent,
			 "element-text-indent",
			 get_textIndent)
elt_style_variant_setter(mx_element_set_text_indent,
			 "element-set-text-indent",
			 put_textIndent)

elt_style_variant_getter(mx_element_line_height,
			 "element-line-height",
			 get_lineHeight)
elt_style_variant_setter(mx_element_set_line_height,
			 "element-set-line-height",
			 put_lineHeight)

elt_style_variant_getter(mx_element_margin_top,
			 "element-margin-top",
			 get_marginTop)
elt_style_variant_setter(mx_element_set_margin_top,
			 "element-set-margin-top",
			 put_marginTop)

elt_style_variant_getter(mx_element_margin_bottom,
			 "element-margin-bottom",
			 get_marginBottom)
elt_style_variant_setter(mx_element_set_margin_bottom,
			 "element-set-margin-bottom",
			 put_marginBottom)

elt_style_variant_getter(mx_element_margin_left,
			 "element-margin-left",
			 get_marginLeft)
elt_style_variant_setter(mx_element_set_margin_left,
			 "element-set-margin-left",
			 put_marginLeft)

elt_style_variant_getter(mx_element_margin_right,
			 "element-margin-right",
			 get_marginRight)
elt_style_variant_setter(mx_element_set_margin_right,
			 "element-set-margin-right",
			 put_marginRight)

elt_style_variant_getter(mx_element_padding_top,
			 "element-padding-top",
			 get_paddingTop)
elt_style_variant_setter(mx_element_set_padding_top,
			 "element-set-padding-top",
			 put_paddingTop)

elt_style_variant_getter(mx_element_padding_bottom,
			 "element-padding-bottom",
			 get_paddingBottom)
elt_style_variant_setter(mx_element_set_padding_bottom,
			 "element-set-padding-bottom",
			 put_paddingBottom)

elt_style_variant_getter(mx_element_padding_left,
			 "element-padding-left",
			 get_paddingLeft)
elt_style_variant_setter(mx_element_set_padding_left,
			 "element-set-padding-left",
			 put_paddingLeft)

elt_style_variant_getter(mx_element_padding_right,
			 "element-padding-right",
			 get_paddingRight)
elt_style_variant_setter(mx_element_set_padding_right,
			 "element-set-padding-right",
			 put_paddingRight)

elt_style_variant_getter(mx_element_border_top_color,
			 "element-border-top-color",
			 get_borderTopColor)
elt_style_variant_setter(mx_element_set_border_top_color,
			 "element-set-border-top-color",
			 put_borderTopColor)

elt_style_variant_getter(mx_element_border_bottom_color,
			 "element-border-bottom-color",
			 get_borderBottomColor)
elt_style_variant_setter(mx_element_set_border_bottom_color,
			 "element-set-border-bottom-color",
			 put_borderBottomColor)

elt_style_variant_getter(mx_element_border_left_color,
			 "element-border-left-color",
			 get_borderLeftColor)
elt_style_variant_setter(mx_element_set_border_left_color,
			 "element-set-border-left-color",
			 put_borderLeftColor)

elt_style_variant_getter(mx_element_border_right_color,
			 "element-border-right-color",
			 get_borderRightColor)
elt_style_variant_setter(mx_element_set_border_right_color,
			 "element-set-border-right-color",
			 put_borderRightColor)

elt_style_variant_getter(mx_element_border_top_width,
			 "element-border-top-width",
			 get_borderTopWidth)
elt_style_variant_setter(mx_element_set_border_top_width,
			 "element-set-border-top-width",
			 put_borderTopWidth)

elt_style_variant_getter(mx_element_border_bottom_width,
			 "element-border-bottom-width",
			 get_borderBottomWidth)
elt_style_variant_setter(mx_element_set_border_bottom_width,
			 "element-set-border-bottom-width",
			 put_borderBottomWidth)

elt_style_variant_getter(mx_element_border_left_width,
			 "element-border-left-width",
			 get_borderLeftWidth)
elt_style_variant_setter(mx_element_set_border_left_width,
			 "element-set-border-left-width",
			 put_borderLeftWidth)

elt_style_variant_getter(mx_element_border_right_width,
			 "element-border-right-width",
			 get_borderRightWidth)
elt_style_variant_setter(mx_element_set_border_right_width,
			 "element-set-border-right-width",
			 put_borderRightWidth)

elt_style_variant_getter(mx_element_width,
			 "element-width",
			 get_width)
elt_style_variant_setter(mx_element_set_width,
			 "element-set-width",
			 put_width)

elt_style_variant_getter(mx_element_height,
			 "element-height",
			 get_height)
elt_style_variant_setter(mx_element_set_height,
			 "element-set-height",
			 put_height)

elt_style_variant_getter(mx_element_top,
			 "element-top",
			 get_top)
elt_style_variant_setter(mx_element_set_top,
			 "element-set-top",
			 put_top)

elt_style_variant_getter(mx_element_left,
			 "element-left",
			 get_left)
elt_style_variant_setter(mx_element_set_left,
			 "element-set-left",
			 put_left)

elt_style_variant_getter(mx_element_z_index,
			 "element-z-index",
			 get_zIndex)
elt_style_variant_setter(mx_element_set_z_index,
			 "element-set-z-index",
			 put_zIndex)

#endif //MYSTERX_3M