!  Given "objbase.h", "ole2.h", or "oleauto.h", generate the Dylan
!  declarations needed for the interfaces.

! Copyright: 1996, 1997, 1998 Functional Objects, Inc.  All rights reserved.

! $HopeName: D-lib-com!dinterf.pat(trunk.11) $
! $Date: 2004/03/12 00:09:32 $


@set-switch{t;1}@set-switch{w;1}
@set-syntax{L;\-\.\(\)}
@set-switch{match;1}

ARGV:\N-D\J<I>\=*\n=@define{\\I$1\\I\=@quote{$2}}
ARGV:\N-module <G>\n=@set{module-heading;Module\:  $1\n@copyright{\:}\n\n}

\B=${module-heading;}@set{module-heading;}\N\n\
 \/\* This file is automatically generated from @file\; do not edit. \*\/\n\n

\/\J\/\+--*\n<header>=\n\/\/ Adapted from\:\n$0\n
header:\/\/\L\W\CCopyright*\n=
header:\/\/*\n=$0
header:=@end

\/\* File created by * at *\*\/=$0

@define{@read{@mergepath{@inpath;exports.pat;}}}
@define{@read{@mergepath{@inpath;interfaces.pat;}}}

\N\W\#*\n=

type:struct <I>\W<stars>\W<L0>=@resolve-type{$2$1}@end
type:const <type>= \/\* const \*\/ $1@end
type:int<stars>=\<C-int$1\>@end
type:unsigned long<stars>=\<C-unsigned-long$1\>@end
type:unsigned<stars>=\<C-unsigned-int$1\>@end
type:long int<stars>=\<C-long$1\>@end
type:short int<stars>=\<C-short$1\>@end
type:short<stars>=\<C-short$1\>@end
type:void __RPC_FAR\*<stars>=\<C-void\*$1\>@end
type:void\*<stars>=\<C-void\*$1\>@end
type:PVOID <stars>=\<C-void\*$1\>@end
type:HRESULT<stars>=\<C-HRESULT$1\>@end
type:SCODE<stars>=\<C-HRESULT$1\>@end
type:LPUNKNOWN<stars>=\<IUnknown$1\>@end
type:LPBINDCTX<stars>=\<IBindCtx$1\>@end
type:LPDATAOBJECT<stars>=\<IDataObject$1\>@end
! <byte> would conflict with streams library
type:byte __RPC_FAR\W\*<stars>=\<LPBYTE$1\>@end
type:byte<stars>=\<C-byte$1\>@end
type:I\J<K1>\J<J1>\J<L><d><optstar>=\<Interface$5\>@end
type:IID __RPC_FAR\W\*<stars>=\<REFIID$1\>@end
type:OLECHAR __RPC_FAR\*<stars>=\<C-unicode-string$1\>@end
type:user\J<K><d>=@fail! avoid warning on these unused types
type:<I><stars>=@resolve-type{$2$1}@end
type:=@fail

stars:\W\*=\*
stars:\W__RPC_FAR=
stars:=@end

optstar:\W\*<stars>=$1@end
optstar:\W__RPC_FAR=
optstar:=@end

resolve-type:\A=\<
resolve-type:\Z=\>
resolve-type:\J_\J=-
resolve-type:\*<ptr-type>=$1
resolve-type:\*<space><K><f>=LP$2@map-name{$3}
resolve-type:\*uCLSSPEC\I=LPuCLSSPEC
resolve-type:\*<stars><I>=@map-name{$2}\*$1\
	@err{Warning - possible undefined type\: \<@map-name{$2}\*$1\>\n}
resolve-type:\/\**\*\/=$0
resolve-type:<A>=$1
resolve-type:\S=\S
resolve-type:?<g>=@err{failed resolve-type\{$0\}\n}[$0]@end

ptr-type:\S=\S
ptr-type:\/\**\*\/=$0
ptr-type:ULARGE_INTEGER=PULARGE-INTEGER
ptr-type:\*LOGPALETTE=LPLOGPALETTE\*
ptr-type:=@fail


\/\*\*\*\*\L*\n*\ interface\: <L1><I>=\
	\N\n\n\t\/\*  ----  $3$4  ----  \*\/\n\n


! in 1995 header files:
interface <interface-defn>=$1
! in 1997 header files:
MIDL_INTERFACE(<matchparen>)\W<interface-defn>=$2

! special hack to make <ISequentialStream> inherit from <storage-istream>.
! Is there a better way to do this than duplicating the whole def?
interface-defn:ISequentialStream\W\:\Wpublic <I>\{<members>\}=@export-end{}\
   @out{\N\n\
	define open primary COM-interface @export{\<ISequentialStream\>} ( \<$1\>, \<storage-istream\>\ )\n\
	  end \<ISequentialStream\>\;\n\n\
	define C-address ISequentialStream_DW_vtbl \:\: \<C-COM-vtbl\>\n\
		@wrap{ c-name\: "ISequentialStream_DW_vtbl"\; end\;}\n\
	define C-address @export{\$IID_ISequentialStream} \:\: \<REFIID\>\
		@wrap{ c-name\: "IID_ISequentialStream"\; end\;}\n\n\
	define method initialize ( This \:\: \<ISequentialStream\>, \#rest ignore, \#key )\;\
	\n\ \ next-method()\;\n\
	\ \ This.vtbl \:\= ISequentialStream_DW_vtbl\;\n\
	\ \ add-interface(This, \$IID-ISequentialStream)\;\n\
	end initialize\;\n\
	@set{maybe-export;@maybe-export{ISequentialStream}}@set{N;ISequentialStream}\
	@expand-members{$2}\N@export-end{}\
       }@end
interface-defn:<good-interface>\W\:\Wpublic <I>\{<members>\}=@export-end{}\
   @out{\N\n\
	define open primary COM-interface @export{\<$1\>} ( \<$2\> )\n\
	  end \<$1\>\;\n\n\
	define C-address $1_DW_vtbl \:\: \<C-COM-vtbl\>\n\
		@wrap{ c-name\: "$1_DW_vtbl"\; end\;}\n\
	define C-address @export{\$IID_$1} \:\: \<REFIID\>\
		@wrap{ c-name\: "IID_$1"\; end\;}\n\n\
	define method initialize ( This \:\: \<$1\>, \#rest ignore, \#key )\;\
	\n\ \ next-method()\;\n\
	\ \ This.vtbl \:\= $1_DW_vtbl\;\n\
	\ \ add-interface(This, \$IID-$1)\;\n\
	end initialize\;\n\
	@set{maybe-export;@maybe-export{$1}}@set{N;$1}\
	@expand-members{$3}\N@export-end{}\
       }@end
interface-defn:<use-only-interface>\W\:\Wpublic <I>\{<members>\}=@export-end{}\
   @out{\N\n\
	define C-address @export{\$IID_$1} \:\: \<REFIID\>\
		@wrap{ c-name\: "IID_$1"\; end\;}\n\n\
	@set{N;$1}\
	@expand-use-only-members{$3}\N@export-end{}\
       }@end
! Special case because "_IID_IEnumClass" is not defined in "Uuid.Lib"
! (as of January 1998):
interface-defn:IEnumClass\W\:\Wpublic <I>\{<members>\}=@export-end{}\
   @out{\N\n@set{N;IEnumClass}\
	@expand-use-only-members{$2}\N@export-end{}\
       }@end
interface-defn:<I>\W\:\Wpublic <I>\{<matchparen>\}=! skip omitted interface
interface-defn:=@fail

expand-members:\S=

expand-members:<type>\G\W<I>(\W<args>)\G\;=\N\n\
	define open generic @export{$N\/$2}\
		@wrap{\ \(This}@generic-args{$3}\)\
		@wrap{\ \=\> (@collect-results{$1\;$3})\;}\n\n\
	define C-callable-wrapper@wrap{ of $N\/@map-name{$2}}\n\
	\ \ input parameter This \:\: \<mapped-interface\>\;\n\
	@received-args{$3}\
	@result{$1}${maybe-export}\
	\ \ c-name\: "DW_$N_$2",@wrap{ c-modifiers\: "__stdcall"\;}\n\
	end\;\n\n\
	define inline-only C-function $N_$2\n\
	\ \ input parameter This \:\: \<C-interface\>\;\n$3\
	@result{$1}\
	\ \ c-name\: "C_$N_$2"\;\n\
	end\;\n\n\
	define method $N\/@map-name{$2}\
		(This \:\: \<C-interface\>@typed-args{$3})\
	  @wrap{\ \=\> (@collect-results{$1\;$3})}\n\
	\ \ $N_$2(This@generic-args{$3})\nend\;

expand-use-only-members:\S=

expand-use-only-members:<type>\G\W<I>(\W<args>)\G\;=\N\n\
	define open generic @export{$N\/$2}\
		@wrap{\ \(This}@generic-args{$3}\)\
		@wrap{\ \=\> (@collect-results{$1\;$3})\;}\n\n\
	define inline-only C-function $N_$2\n\
	\ \ input parameter This \:\: \<C-interface\>\;\n$3\
	@result{$1}\
	\ \ c-name\: "C_$N_$2"\;\n\
	end\;\n\n\
	define method $N\/@map-name{$2}\
		(This \:\: \<C-interface\>@typed-args{$3})\
	  @wrap{\ \=\> (@collect-results{$1\;$3})}\n\
	\ \ $N_$2(This@generic-args{$3})\nend\;


! don't instantiate abstract class <Interface>:
received-args:\<Interface\>=\<C-interface\>
received-args:output parameter <I> \:\: \<C-interface\*\>=\
		output parameter $1 \:\: \<Interface\*\>
received-args:?=?

expand-members:*\;=@err{line @line, failed match for expand-members\: *\;\n}\
	@exit-status{1}

result:\<void\>=
result:\<C-HRESULT\>=\ \ result status \:\: \<C-HRESULT\>\;\n
result:*=\ \ result value \:\: $1\;\n

maybe-export:<has-external-subclasses>=\ \ export\: \#t\,\n@end
maybe-export:=@end
has-external-subclasses:IUnknown=@end
has-external-subclasses:IAdviseSink=@end
has-external-subclasses:IClassFactory=@end
has-external-subclasses:IPersist=@end
has-external-subclasses:IOleInPlaceObject=@end
has-external-subclasses:IOleInPlaceSite=@end
has-external-subclasses:IOleWindow=@end
has-external-subclasses:IViewObject2=@end
has-external-subclasses:IViewObject=@end
has-external-subclasses:IDispatch=@end
has-external-subclasses:=@fail

collect-results:\A\<void\>\;=@set{comma;}
collect-results:\A\<C-HRESULT\>\;=status \:\: \<HRESULT\>@set{comma;\,}
collect-results:\A\<<G>\>\;=value@dtypespec{\<$1\>\;}@set{comma;\,}
collect-results:\Aparameter <I> \:\: <G>\;=$1 \:\: $2@set{comma;\,}
collect-results:output parameter <I> \:\: <G>\;=\
	${comma}@wrap{\ @without-p{$1}@drefouttype{$2}}@set{comma;\,}
collect-results:\S=
collect-results:*\;=

! Dylan result type corresponding to output parameter C FFI type:
drefouttype:\<C-interface\*\>=\ \:\:\ \<Interface\>
drefouttype:\<LPLP\J<I>\>=\ \:\:\ \<LP$1\>
drefouttype:\<LPBOOL\>=\ \:\:\ \<boolean\>
drefouttype:\<LPSHORT\>=\ \:\:\ \<integer\>
drefouttype:\<LPWORD\>=\ \:\:\ \<integer\>
drefouttype:\<LPBSTR\>=\ \:\:\ \<BSTR\>
drefouttype:\<C-<F>\*\*\>=\ \:\:\ \<C-$1\*\>
drefouttype:\<*=@end
drefouttype:*=@err{line @line, failed match for drefouttype\: $1\n}\
	@exit-status{1}@end


! This first pattern is a special case for IMoniker::Reduce which has an
! incorrect "[in]" comment:
args:\/\*[unique][out][in]\*\/ IMoniker __RPC_FAR\*__RPC_FAR\*ppmkToLeft=\
	\ \ output parameter pmkToLeft \:\: \<C-interface\*\>\;\n

! And another incorrect comment for ICreateTypeInfo::AddRefTypeInfo:
args:\/\*\ [in] \*\/ HREFTYPE __RPC_FAR \*\Cphreftype=\
	\ \ output parameter phreftype \:\: \<LPHREFTYPE\>\;\n

args:\/\*\W[in]\W\*\/\W<I>(<link>\*<I>)(<args>)=\
	\ \ input parameter $3 \:\: \
	\<C-function-pointer\>\;\n
! Above line really should be the following when supported:
!	function-pointer-type(result-type\: @type{$1})\;\n
args:\/\*\W<direction>\W\*\/\W<type>\G\W<I><maybe-array>=\
	\ \ @arg2{@adjust-direction{$4$1} parameter $3 \:\: @adjust-type{$4$2}\;}\n
args:,=;\S=
args:<type>\W<I>=\ \ input parameter $2 \:\: $1\;\n
args:void\P\W)=@end
args:<P1>*\,=@err{line @line, failed match for args\: $0\n}@exit-status{1}
args:<P1>*\P\)=@err{line @line, failed match for args\: $0\n}@exit-status{1}

maybe-array:\[\W\]=$0@end
maybe-array:=@end
adjust-type:\[\]<space>\<<G>\>=$1@resolve-type{\*$2}
adjust-type:*=*
adjust-direction:\[\]output=
adjust-direction:\[\]=

link:__stdcall\W=
link:STDMETHODCALLTYPE\W=
link:__RPC_FAR\W=
line:=@end

! arg2 is second-pass processing for C function arguments.
!  special case for CreateInstance:
arg2:\Aoutput parameter ppvObject \:\: \<C-void\*\*\>\;=\
	output parameter Object \:\: \<C-interface\*\>\;
!  special case for GetObjectStorage:
arg2:\Aoutput parameter ppvStorage \:\: \<C-void\*\*\>\;=\
	output parameter Object \:\: \<C-interface\*\>\;
!  not used:
!arg2:\Aoutput input parameter <I> \:\: <output-type>=\
!	input output parameter $1 \:\: $2\;
arg2:\Aoutput parameter <output-arg> \:\: <output-type>=\
	output parameter $1 \:\: $2\;
arg2:\Aoutput parameter*\;=parameter*\;!@err{@line\: disregarding [out] for $1\n}
arg2:\Ainput parameter <I> \:\: \/\* const \*\/ <P>\;=\
	\/\* constant \*\/ input parameter $1 \:\: $2\;

! types of potential output parameters in COM:
!    <C-unicode-string>	OK
!    <C-void*>		OK
!    <CLSID>		no
!    <DWORD>		OK
!    <FILETIME>		no (equivalent to LARGE_INTEGER, but treat as opaque)
!    <FORMATETC>	no
!    <Interface>	OK
!    <STATSTG>		no!
!    <STGMEDIUM>	no
!    <ULARGE_INTEGER>	no
!    <ULONG>		OK
!
! types of potential output parameters in COM:
!    <C-unicode-string>	OK
!    <C-void*>		changed to <Interface>
!    <CLSID>		no
!    <DWORD>		OK
!    <HWND>		OK
!    <Interface>	OK
!    <LOGPALETTE>.pointer-type	OK
!    <SIZEL>		no, it's a structure
!    <ULONG>		OK

! test whether the parameter type is suitable for an `output' parameter.
output-type:\<FILETIME\>=@fail
output-type:\<FORMATETC\>=@fail
output-type:\<STGMEDIUM\>=@fail
output-type:\<STATSTG\>=@fail
output-type:\<ULARGE-INTEGER\>=@fail
output-type:\<LARGE-INTEGER\>=@fail
output-type:\<CLSID\>=@fail
output-type:\<GUID\>=@fail
output-type:\<SIZEL\>=@fail
output-type:\<LPCLSID\>=@fail
output-type:\<C-void\*\>=@fail
output-type:\<LP\J<scalar>\>\;=\<LP$1\>@end
output-type:\C\<Interface\*\>\;=\<C-interface\*\>@end
output-type:\<*\*\>\;=\<*\*\>@end
output-type:=@fail

! scalar data types:
scalar:\JDWORD=$0@end
scalar:\JWORD=$0@end
scalar:\JLONG=$0@end
scalar:\JULONG=$0@end
scalar:\JINT=$0@end
scalar:\JUINT=$0@end
scalar:\JSHORT=$0@end
scalar:\JUSHORT=$0@end
scalar:\JBOOL=$0@end
scalar:\JCOLORREF=$0@end
scalar:\JLRESULT=$0@end
scalar:\JBSTR=$0@end
scalar:\JLP\J<K><d>=$0@end
scalar:\JH\J<K>=$0@end
scalar:\JLPVOID=$0@end
scalar:=@fail

typedef <scalar> <I>\;=@define{scalar\:\\J@hyphenate{$2}\=\$0\@end}
hyphenate:\J\_\J=\-

! Can't use output parameters in IViewObject/GetAdvise because
! the caller can pass a NULL address.  (see Bug 641)
output-arg:pAspects=@fail
output-arg:pAdvf=@fail
output-arg:ppAdvSink=@fail
output-arg:<I>=$1@end
output-arg:=@fail

without-p:\Ap\J<L1>\J<i>=$1$2;\Alp\J<L1>\J<i>=$1$2;*=*

! The comment "[out][in]" is currently only used for structure values, 
! not scalars, so it doesn't ever correspond to an FFI
! "input output parameter".
direction:[out][in]=

direction:[out]=output\s
direction:[in]=input\s
!direction:[in\W,\Wout]=input output
direction:[size_is][out]=! pointer to array to be filled in
direction:[unique]=
direction:[string]=
direction:[async]=
direction:[size_is]=
direction:[length_is]=
direction:[switch_is]=
direction:[iid_is]=
direction:[in][size_is][in]=input\s
direction:[<P>]=@err{line @line, unrecognized attribute\: [$1]\n}
direction:<G>=@err{line @line, failed match for direction\: $1\n}\
	@exit-status{1}
direction:=@end

generic-args:\S=
generic-args:output parameter *\;=
generic-args:<p>parameter <I> \:\: *\;=,@wrap{ $2}
generic-args:<G>=@err{line @line, failed match for generic-args\: $1\n}\
	@exit-status{1}

typed-args:\S=
typed-args:output parameter *\;=
typed-args:<p>parameter <I> \:\: <dtypespec>=,@wrap{\ $2$3}

! Dylan method arg specializer corresponding to C FFI type:
dtypespec:\<Interface\>=\ \:\:\ $0
dtypespec:\<Interface\*\>=\ \:\:\ $0
dtypespec:\<I\J<K1>\J<J1>\J<L>\>=\ \:\:\ $0! <IWhatever>
dtypespec:\<BOOL\>\;=\ \:\:\ \<boolean\>@end
dtypespec:\<DWORD\>\;=\ \:\:\ \<ffi-integer\>@end
dtypespec:\<ULONG\>\;=\ \:\:\ \<ffi-integer\>@end
dtypespec:\<LONG\>\;=\ \:\:\ \<ffi-integer\>@end
dtypespec:\<LCID\>\;=\ \:\:\ \<ffi-integer\>@end
dtypespec:\<PROPID\>\;=\ \:\:\ \<ffi-integer\>@end
dtypespec:\<ULARGE-INTEGER\>\;=\ \:\:\ \<PULARGE-INTEGER\>@end
dtypespec:\<PULARGE-INTEGER\>\;=\ \:\:\ \<PULARGE-INTEGER\>@end
dtypespec:\<LARGE-INTEGER\>\;=\ \:\:\ \<PLARGE-INTEGER\>@end
dtypespec:\<PLARGE-INTEGER\>\;=\ \:\:\ \<PLARGE-INTEGER\>@end
dtypespec:\<QUERYCONTEXT\>\;=\ \:\:\ \<LPQUERYCONTEXT\>@end
dtypespec:\<CSPLATFORM\>\;=\ \:\:\ \<LPCSPLATFORM\>@end
dtypespec:\<C-void*\>\;=\ \:\:\ \<C-pointer\>@end
dtypespec:\<LPVOID\>\;=\ \:\:\ \<C-pointer\>@end
dtypespec:\<C-unicode-string\>=\ \:\:\ $0
dtypespec:\<C-int\>\;=\ \:\:\ \<integer\>@end
dtypespec:\<SNB\>=\ \:\:\ $0
dtypespec:\<REF\J<K>\JID\>=\ \:\:\ $0
dtypespec:\<LPARAM\>\;=@end! this one is not a pointer
dtypespec:\<LP\J<G>\>=\ \:\:\ $0
dtypespec:\<HREFTYPE\>\;=@end! looks like a handle but is really a DWORD
dtypespec:\<H\J<K>\>=\ \:\:\ $0
dtypespec:function-pointer-type(<matchparen>)\;=@end! <C-function-pointer> ???
dtypespec:\<*\;=@end
dtypespec:\;=@end
dtypespec:*\;=@err{line @line, failed match for dtypespec\: $1\n}\
	@exit-status{1}@end

members:public\:=
members:private\:=
members:virtual <fhead>(<matchparen>)=$1($2)\;
members:\/\J\*<comment>\*\J\/=
members:\S=
members:\=0=
members:\;=
members:*\;=@err{"@file" line @line, unrecognized member\: *\n}\
	@exit-status{1}

fhead:\/\J\*<comment>\*\J\/=
fhead:<I>=$1
fhead:\S=\S
fhead:\*=\*
fhead:__stdcall=
fhead:STDMETHODCALLTYPE=
fhead:=@end

@set-wrap{65;\t\t}
wrapped:\s<G>=@wrap{\s$1}


number:<D>\W\<\<\W<number>=ash($1,$2)@end
number:(\W<number>\W)=$1@end
number:-\W<number>=-$1@end
number:0x\J<X><optL>=\#x$1@end
number:0\J<O><optL>=\#o$1@end
number:<D><optL>=$1@end
number:<I>\W\+\W<D>=\$@map-name{$1} + $2@end
number:<I>\W\P\,=\$@map-name{$1}@end
number:=@fail
optL:\C\JL=@end;=@end

\#define <relevant-name>\W<number>\W\n=\
	\Ndefine constant @export{\$$1} @tab{40}\= $2\;\n
relevant-name:OLEIVERB_\J<I>=$0@end
relevant-name:EMBDHLP_\J<I>=$0@end
relevant-name:STGM_\J<I>=$0@end
relevant-name:=@fail

typedef interface <I> $1\;=