Ole/Mod/Server.odc

MODULE OleServer;
(**
	project	= "BlackBox"
	organization	= "www.oberon.ch"
	contributors	= "Oberon microsystems"
	version	= "System/Rsrc/About"
	copyright	= "System/Rsrc/About"
	license	= "Docu/BB-License"
	changes	= "
	- YYYYMMDD, nn, ...
	"
	issues	= "
	- ...
	"

**)

	IMPORT
		SYSTEM, COM, WinOle, WinApi,
		OleStorage, OleData, StdDialog,
		Kernel, Files, Services, Ports, Dialog, Stores, Sequencers, Views,
		Controllers, Properties, Converters, Containers, Documents, Windows,
		TextViews, Log, HostPorts, HostDialog, HostWindows, HostMenus;
	
	CONST
		debug = FALSE;
		ObjectID = "{00000001-1000-11cf-adf0-444553540000}";
		streamStr = "CONTENTS";
		cbFormat = 200H;
		obfTag = 6F4F4443H;
		miscStatus = WinOle.OLEMISC_RECOMPOSEONRESIZE
			+ WinOle.OLEMISC_CANTLINKINSIDE
			+ WinOle.OLEMISC_RENDERINGISDEVICEINDEPENDENT;
		oleUnit = Ports.mm DIV 100;
		borderW = 5 * Ports.point;
		fixed = 31;	(* controller option *)
	
	TYPE
		IClassFactory = POINTER TO RECORD (WinOle.IClassFactory) END;
		
		Object = POINTER TO RECORD (COM.IUnknown)
			ioo: IOleObject;
			ido: IDataObject;
			ips: IPersistStorage;
			iipo: IOleInPlaceObject;
			iipao: IOleInPlaceActiveObject;
			ics: WinOle.IOleClientSite;
			iips: WinOle.IOleInPlaceSite;	(* # NIL => in place open *)
			iipf: WinOle.IOleInPlaceFrame;
			iipw: WinOle.IOleInPlaceUIWindow;
			fInfo: WinOle.OLEINPLACEFRAMEINFO;
			idah: WinOle.IDataAdviseHolder;
			ioah: WinOle.IOleAdviseHolder;
			isg: WinOle.IStorage;
			ism: WinOle.IStream;
			rsm: WinOle.IStream;
			menu: WinApi.HMENU;
			oleMenu: WinOle.HOLEMENU;
			menuType: Stores.TypeName;
			w, h: INTEGER;
			view: Views.View;
			seq: Sequencers.Sequencer;
			win: HostWindows.Window;	(* # NIL => open *)
			embedded: BOOLEAN;
			update: BOOLEAN;
			uiActive: BOOLEAN;
			useMenu: BOOLEAN;
			unit: INTEGER	(* scaling when in place open *)
		END;
		IOleObject = POINTER TO RECORD (WinOle.IOleObject)
			obj: Object
		END;
		IDataObject = POINTER TO RECORD (WinOle.IDataObject)
			obj: Object;
			data: OleData.IDataObject
		END;
		IPersistStorage = POINTER TO EXTENSIBLE RECORD (WinOle.IPersistStorage)
			obj: Object
		END;
		IOleInPlaceObject = POINTER TO RECORD (WinOle.IOleInPlaceObject);
			obj: Object
		END;
		IOleInPlaceActiveObject = POINTER TO RECORD (WinOle.IOleInPlaceActiveObject)
			obj: Object
		END;
		
		Window = POINTER TO RECORD (HostWindows.Window)
			obj: Object
		END;
		
		WinDir = POINTER TO RECORD (HostWindows.Directory)
			obj: Object;
			host: WinApi.HWND;
			pos, clip: WinApi.RECT;
		END;
		
		Action = POINTER TO RECORD (Services.Action)
			w: Window
		END;
		
		Verb = POINTER TO RECORD
			verb: INTEGER;
			name: ARRAY 64 OF CHAR;
			disabled, checked: BOOLEAN;
			next: Verb
		END;
		
		IEnumOLEVERB = POINTER TO RECORD (WinOle.IEnumOLEVERB)
			first, cur: Verb
		END;
		
		
	VAR
		factory: IClassFactory;
		token: INTEGER;
		winDir: WinDir;
		
		
	(* ---------- auxiliary ---------- *)
	
	PROCEDURE Max (x, y: INTEGER): INTEGER;
	BEGIN
		IF x > y THEN RETURN x ELSE RETURN y END
	END Max;
	
	PROCEDURE Min (x, y: INTEGER): INTEGER;
	BEGIN
		IF x < y THEN RETURN x ELSE RETURN y END
	END Min;
	
	PROCEDURE GenGlobalMedium (hg: WinApi.HGLOBAL; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
	BEGIN
		sm.tymed := WinOle.TYMED_HGLOBAL;
		sm.u.hGlobal := hg;
		sm.pUnkForRelease := unk
	END GenGlobalMedium;
	
	PROCEDURE MediumGlobal (VAR sm: WinOle.STGMEDIUM): WinApi.HGLOBAL;
	BEGIN
		ASSERT(sm.tymed = WinOle.TYMED_HGLOBAL, 20);
		RETURN sm.u.hGlobal
	END MediumGlobal;
	
	PROCEDURE GenStorageMedium (stg: WinOle.IStorage; unk: COM.IUnknown; VAR sm: WinOle.STGMEDIUM);
		TYPE PS = POINTER TO RECORD t: SET; s: WinOle.IStorage; u: COM.IUnknown END;
		VAR ps: PS;
	BEGIN
		sm.u.hGlobal := 0;
		sm.tymed := WinOle.TYMED_ISTORAGE;
		sm.u.pstg := stg;
		sm.pUnkForRelease := unk
	END GenStorageMedium;
	
	PROCEDURE MediumStorage (VAR sm: WinOle.STGMEDIUM): WinOle.IStorage;
	BEGIN
		ASSERT(sm.tymed = WinOle.TYMED_ISTORAGE, 20);
		RETURN sm.u.pstg
	END MediumStorage;
	
	PROCEDURE NewString (VAR str: ARRAY OF CHAR): WinApi.PtrWSTR;
		VAR n: INTEGER; p: WinApi.PtrWSTR;
	BEGIN
		n := 0; WHILE str[n] # 0X DO INC(n) END;
		p := SYSTEM.VAL(WinApi.PtrWSTR, WinOle.CoTaskMemAlloc(SIZE(CHAR) * (n + 1)));
		p^ := str$;
		RETURN p
	END NewString;
	
	PROCEDURE CheckVerb (v: Views.View; n: INTEGER; VAR pvm: Properties.PollVerbMsg);
	BEGIN
		pvm.verb := SHORT(n);
		pvm.label := "";
		pvm.disabled := FALSE; pvm.checked := FALSE;
		IF v # NIL THEN Views.HandlePropMsg(v, pvm) END
	END CheckVerb;
	

	(* ---------- IClassFactory ---------- *)
	
	PROCEDURE (this: IClassFactory) CreateInstance (outer: COM.IUnknown; IN [iid] iid: COM.GUID;
																				OUT [new] int: COM.IUnknown): COM.RESULT;
		VAR res: COM.RESULT; new: Object;
	BEGIN
		IF debug THEN Log.String("create instance"); Log.Ln END;
		IF outer = NIL THEN
			NEW(new);
			IF new # NIL THEN
				NEW(new.ioo, new); NEW(new.ido, new); NEW(new.ips, new); NEW(new.iipo, new);
				NEW(new.iipao);	(* separate component *)
				IF (new.ioo # NIL) & (new.ido # NIL) & (new.ips # NIL) & (new.iipo # NIL) & (new.iipao # NIL) THEN
					new.ioo.obj := new;
					new.ido.obj := new;
					new.ido.data := OleData.ViewData(NIL, 0, 0, TRUE);
					new.ips.obj := new;
					new.iipo.obj := new;
					new.iipao.obj := new;
					new.embedded := FALSE;
					res := new.QueryInterface(iid, int);
					IF res >= 0 THEN HostMenus.Lock END;
					IF debug THEN Log.String("c lock "); Log.Int(HostMenus.locks); Log.Ln END;
				ELSE res := WinApi.E_OUTOFMEMORY
				END
			ELSE res := WinApi.E_OUTOFMEMORY
			END
		ELSE res := WinApi.CLASS_E_NOAGGREGATION
		END;
		RETURN res
	END CreateInstance;

	PROCEDURE (this: IClassFactory) LockServer (lock: WinApi.BOOL): COM.RESULT;
	BEGIN
		IF lock # 0 THEN HostMenus.Lock ELSE HostMenus.Unlock END;
		IF debug THEN Log.String("lock server "); Log.Int(lock); Log.Int(HostMenus.locks); Log.Ln END;
		RETURN WinApi.S_OK
	END LockServer;
	
	
	(* IEnumOLEVERB  *)
	
	PROCEDURE (this: IEnumOLEVERB) Next (num: INTEGER; OUT elem: ARRAY [untagged] OF WinOle.OLEVERB;
																								OUT [nil] fetched: INTEGER): COM.RESULT;
		VAR n: INTEGER; flags: SET;
	BEGIN
		n := 0;
		IF VALID(fetched) THEN fetched := 0
		ELSIF num # 1 THEN RETURN WinApi.E_POINTER
		END;
		IF this.cur # NIL THEN
			WHILE (this.cur # NIL) & (num > 0) DO
				elem[n].lVerb := this.cur.verb;
				elem[n].lpszVerbName := NewString(this.cur.name);
				flags := {};
				IF this.cur.disabled THEN INCL(flags, 0) END;
				IF this.cur.checked THEN INCL(flags, 3) END;
				elem[n].fuFlags := flags;
				IF this.cur.verb >= 0 THEN
					elem[n].grfAttribs := WinOle.OLEVERBATTRIB_ONCONTAINERMENU
				ELSE
					elem[n].grfAttribs := {}
				END;
				this.cur := this.cur.next; INC(n); DEC(num)
			END;
			IF VALID(fetched) THEN fetched := n END;
			RETURN WinApi.S_OK
		END;
		RETURN WinApi.S_FALSE
	END Next;
	
	PROCEDURE (this: IEnumOLEVERB) Skip (num: INTEGER): COM.RESULT;
	BEGIN
		WHILE (num > 0) & (this.cur # NIL) DO this.cur := this.cur.next; DEC(num) END;
		IF this.cur # NIL THEN RETURN WinApi.S_OK
		ELSE RETURN WinApi.S_FALSE
		END
	END Skip;
	
	PROCEDURE (this: IEnumOLEVERB) Reset (): COM.RESULT;
	BEGIN
		this.cur := this.first;
		RETURN WinApi.S_OK
	END Reset;
	
	PROCEDURE (this: IEnumOLEVERB) Clone (OUT enum: WinOle.IEnumOLEVERB): COM.RESULT;
		VAR new: IEnumOLEVERB;
	BEGIN
		NEW(new);
		IF new # NIL THEN
			new.first := this.first;
			new.cur := this.cur;
			enum := new;
			RETURN WinApi.S_OK
		ELSE RETURN WinApi.E_OUTOFMEMORY
		END
	END Clone;
	
(*	
	(* ---------- Object Release Patch ---------- *)	(* VERY BIG HACK !!!!!!!!! *)
	
	PROCEDURE^ (this: Object) InPlaceDeactivate ();
	
	PROCEDURE ObjectRelease (this: Object): LONGINT;
		VAR n: LONGINT; msg: Sequencers.RemoveMsg;
	BEGIN
		n := Kernel.Release(SYSTEM.VAL(LONGINT, this));
		IF debug THEN Log.String("release "); Log.Int(n); Log.Ln END;
		IF n = 0 THEN
			IF this.iips # NIL THEN this.InPlaceDeactivate END;
			this.ics := NIL; this.idah := NIL; this.ioah := NIL;
			IF this.seq # NIL THEN this.seq.Notify(msg) END;
			HostMenus.Unlock;
			IF debug THEN Log.String("r unlock "); Log.Int(HostMenus.locks); Log.Ln END;
			Kernel.Cleanup
		END;
		RETURN n
	END ObjectRelease;
	
	PROCEDURE PatchObjectRelease;
		CONST releaseMethOff = -4;
	BEGIN
		SYSTEM.PUT(SYSTEM.ADR(Object) + releaseMethOff, SYSTEM.ADR(ObjectRelease))
	END PatchObjectRelease;
*)	
	
	(* ---------- Object ---------- *)
	
	PROCEDURE^ (this: Object) InPlaceDeactivate (), NEW;
	
	PROCEDURE (this: Object) RELEASE;
		VAR msg: Sequencers.RemoveMsg;
	BEGIN
		IF this.iips # NIL THEN this.InPlaceDeactivate END;
		this.ics := NIL; this.idah := NIL; this.ioah := NIL;
		IF this.seq # NIL THEN this.seq.Notify(msg) END;
		HostMenus.Unlock;
		IF debug THEN Log.String("r unlock "); Log.Int(HostMenus.locks); Log.Ln END;
		Kernel.Cleanup
	END RELEASE;
	
	PROCEDURE (this: Object) QueryInterface (IN iid: COM.GUID; OUT int: COM.IUnknown): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("query interface"); Log.Ln END;
		IF COM.QUERY(this, iid, int)
			OR COM.QUERY(this.ioo, iid, int)
			OR COM.QUERY(this.ido, iid, int)
			OR COM.QUERY(this.ips, iid, int)
			OR COM.QUERY(this.iipo, iid, int) THEN RETURN WinApi.S_OK
		ELSE RETURN WinApi.E_NOINTERFACE
		END
	END QueryInterface;
	
	PROCEDURE (this: Object) GetMenuType (VAR changed: BOOLEAN), NEW;
		VAR ops: Controllers.PollOpsMsg;
	BEGIN
		ops.type := ""; this.win.ForwardCtrlMsg(ops);
		IF ops.type # this.menuType THEN
			changed := TRUE;
			this.menuType := ops.type$
		ELSE
			changed := FALSE
		END
	END GetMenuType;
	
	PROCEDURE (this: Object) InPlaceMenuCreate (), NEW;
		VAR menu: WinApi.HMENU; res, i, p, n: INTEGER; widths: WinOle.OLEMENUGROUPWIDTHS;
			m: HostMenus.Menu; ss: ARRAY 256 OF SHORTCHAR;
	BEGIN
		IF debug THEN Log.String("create menu"); Log.Ln END;
		i := 0; WHILE i < 6 DO widths.width[i] := 0; INC(i) END;
		menu := WinApi.CreateMenu();
		res := this.iipf.InsertMenus(menu, widths);
		m := HostMenus.menus; p := 0; i := 0;
		WHILE p < 6 DO
			WHILE (m # NIL) & (m.class <= p) DO m := m.next END;
			INC(i, widths.width[p]); INC(p); n := 0;
			WHILE (m # NIL) & (m.class = p) DO
				IF (m.type = "") OR (m.type = this.menuType) THEN
					ss := SHORT(m.menu$);
					res := WinApi.InsertMenu(menu, i, WinApi.MF_POPUP + WinApi.MF_BYPOSITION, m.menuH, ss);
					INC(n); INC(i)
				END;
				m := m.next;
			END;
			widths.width[p] := n; INC(p)
		END;
		this.menu := menu;
		this.oleMenu := WinOle.OleCreateMenuDescriptor(menu, widths);
		IF debug THEN Log.String("menu created"); Log.Ln END;
	END InPlaceMenuCreate;
	
	PROCEDURE (this: Object) InPlaceMenuDestroy (), NEW;
		VAR res: COM.RESULT; i: INTEGER; m: HostMenus.Menu; sm: WinApi.HMENU;
	BEGIN
		IF debug THEN Log.String("destroy menu"); Log.Ln END;
		res := WinOle.OleDestroyMenuDescriptor(this.oleMenu);
		this.oleMenu := 0;
		i := WinApi.GetMenuItemCount(this.menu);
		WHILE i > 0 DO
			DEC(i); sm := WinApi.GetSubMenu(this.menu, i);
			m := HostMenus.menus;
			WHILE (m # NIL) & (m.menuH # sm) DO m := m.next END;
			IF m # NIL THEN res := WinApi.RemoveMenu(this.menu, i, WinApi.MF_BYPOSITION) END
		END;
		IF this.iipf # NIL THEN res := this.iipf.RemoveMenus(this.menu) END;
		res := WinApi.DestroyMenu(this.menu);
		this.menu := 0;
		IF debug THEN Log.String("menu destroyed"); Log.Ln END;
	END InPlaceMenuDestroy;
	
	PROCEDURE (this: Object) UIActivate (): COM.RESULT, NEW;
		VAR res: COM.RESULT; dumy: BOOLEAN; rect: WinApi.RECT;
	BEGIN
		IF debug THEN Log.String("ui activate"); Log.Ln END;
		IF this.iips # NIL THEN res := this.iips.OnUIActivate() END;
		res := WinApi.SetFocus(this.win.wnd);
		HostWindows.ActivateWindow(this.win, TRUE);
		IF this.iipf # NIL THEN res := this.iipf.SetActiveObject(this.iipao, "") END;
		IF this.iipw # NIL THEN res := this.iipw.SetActiveObject(this.iipao, "") END;
		this.GetMenuType(dumy);
		this.InPlaceMenuCreate;
		res := this.iipf.SetMenu(this.menu, this.oleMenu, HostWindows.main);
		this.useMenu := TRUE;
		HostMenus.isObj := TRUE;
		rect.left := 0; rect.top := 0; rect.right := 0; rect.bottom := 0;
		IF this.iipf # NIL THEN res := this.iipf.SetBorderSpace(rect) END;
		IF this.iipw # NIL THEN res := this.iipw.SetBorderSpace(rect) END;
		this.uiActive := TRUE;
		IF debug THEN Log.String("ui active"); Log.Ln END;
		RETURN WinApi.S_OK
	END UIActivate;
	
	PROCEDURE (this: Object) UIDeactivate (), NEW;
		VAR res: COM.RESULT;
	BEGIN
		IF debug THEN Log.String("ui deactivate"); Log.Ln END;
		IF this.iipf # NIL THEN res := this.iipf.SetMenu(0, 0, 0) END;
		this.useMenu := FALSE;
		this.InPlaceMenuDestroy;
		IF this.win # NIL THEN HostWindows.ActivateWindow(this.win, FALSE) END;
		IF this.iipf # NIL THEN res := this.iipf.SetActiveObject(NIL, NIL) END;
		IF this.iipw # NIL THEN res := this.iipw.SetActiveObject(NIL, NIL) END;
		IF this.iips # NIL THEN res := this.iips.OnUIDeactivate(0) END;
		HostMenus.isObj := FALSE;
		this.uiActive := FALSE;
		IF debug THEN Log.String("ui deactive"); Log.Ln END;
	END UIDeactivate;
	
	PROCEDURE (this: Object) InPlaceActivate (site: WinOle.IOleClientSite; ui: BOOLEAN): COM.RESULT, NEW;
		VAR res: COM.RESULT; host: WinApi.HWND;
			d: Documents.Document; c: Containers.Controller; w: Windows.Window;
	BEGIN
		IF site # NIL THEN
			IF this.iips = NIL THEN
				IF debug THEN Log.String("try in place"); Log.Ln END;
				res := site.QueryInterface(COM.ID(this.iips), this.iips);
				IF res < 0 THEN RETURN res END;
				res := this.iips.CanInPlaceActivate();
				IF res = WinApi.S_OK THEN
					IF debug THEN Log.String("in place activate"); Log.Ln END;
					res := this.iips.OnInPlaceActivate();
					(* undodeactivates := TRUE *)
					res := this.iips.GetWindow(host);
					this.fInfo.cb := SIZE(WinOle.OLEINPLACEFRAMEINFO);
					res := this.iips.GetWindowContext(this.iipf, this.iipw, winDir.pos, winDir.clip, this.fInfo);
					(* open window *)
					this.view := Views.CopyOf(this.view, Views.shallow);
					winDir.obj := this; winDir.host := host;
					Windows.SetDir(winDir);
					d := Documents.dir.New(this.view, this.w, this.h);
					c := d.ThisController();
					c.SetOpts(c.opts - {Documents.pageWidth..Documents.winHeight} + {31});
					StdDialog.Open(d, "", NIL, "", NIL, TRUE, FALSE, FALSE, FALSE, TRUE);
					w := Windows.dir.First();
					this.seq := w.seq;
					this.win := w(Window);
					OleData.SetView(this.ido.data, this.view, this.w, this.h);
					Windows.SetDir(Windows.stdDir);
					IF this.ics # NIL THEN res := this.ics.ShowObject() END;
					IF debug THEN Log.String("in place active"); Log.Ln END;
				ELSE
					this.iips := NIL;
					RETURN WinApi.E_FAIL
				END
			END;
			IF ui THEN res := this.UIActivate() END;
			IF this.iips # NIL THEN	(* minimal undo support *)
				res := this.iips.DiscardUndoState()
			END
		ELSE RETURN WinApi.E_INVALIDARG
		END;
		RETURN WinApi.S_OK
	END InPlaceActivate;
	
	PROCEDURE (this: Object) CheckViewUpdate (), NEW;
		VAR res: COM.RESULT; w, h: INTEGER; v: Views.View; changed: BOOLEAN;
	BEGIN
		IF (this.win # NIL) & (this.win.doc # NIL) THEN
			v := this.win.doc.ThisView();
			v.context.GetSize(w, h);
			IF (v # this.view) OR (w # this.w) OR (h # this.h) THEN
				this.view := v; this.w := w; this.h := h;
				OleData.SetView(this.ido.data, v, w, h);
				this.update := TRUE
			END
		END;
		IF this.update & (this.idah # NIL) & (this.iips = NIL) THEN
			IF debug THEN Log.String("on data change"); Log.Ln END;
			res := this.idah.SendOnDataChange(this.ido, 0, {});
			this.update := FALSE
		END;
		(* check menus *)
		IF (this.win # NIL) & (this.iipf # NIL) & (this.menu # 0) & (Windows.dir.Focus(Controllers.targetPath) = this.win)
		THEN
			this.GetMenuType(changed);
			IF changed THEN
				this.InPlaceMenuDestroy(); this.InPlaceMenuCreate;
				IF this.useMenu THEN
					res := this.iipf.SetMenu(this.menu, this.oleMenu, HostWindows.main)
				END
			END
		END
	END CheckViewUpdate;
	
	PROCEDURE (this: Object) InPlaceDeactivate (), NEW;
		VAR res: COM.RESULT;
	BEGIN
		IF debug THEN Log.String("in place deactivate"); Log.Ln END;
		this.UIDeactivate;
		IF this.win # NIL THEN this.win.Close(); this.win := NIL END;
		IF this.iips # NIL THEN res := this.iips.OnInPlaceDeactivate() END;
		this.iips := NIL; this.iipf := NIL; this.iipw := NIL;
		this.CheckViewUpdate;
		Kernel.Cleanup;
		IF debug THEN Log.String("in place deactive"); Log.Ln END;
	END InPlaceDeactivate;
	
	PROCEDURE (this: Object) Open (), NEW;
		VAR res: COM.RESULT; v: Views.View; d: Documents.Document; c: Containers.Controller; w: Windows.Window;
	BEGIN
		IF this.win = NIL THEN
			IF this.view = NIL THEN
				IF debug THEN Log.String("show new"); Log.Ln END;
				v := TextViews.dir.New(NIL)
			ELSE
				IF debug THEN Log.String("show old"); Log.Ln END;
				v := Views.CopyOf(this.view, Views.shallow);
			END;
			winDir.obj := this;
			Windows.SetDir(winDir);
			d := Documents.dir.New(v, this.w, this.h);
			c := d.ThisController();
			c.SetOpts(c.opts - {Documents.pageWidth..Documents.winHeight});
			Views.OpenAux(d, "BlackBox Object");
			w := Windows.dir.First();
			this.view := v;
			this.seq := w.seq;
			this.win := w(Window);
			OleData.SetView(this.ido.data, this.view, this.w, this.h);
			Windows.SetDir(Windows.stdDir)
		END;
		Windows.dir.Select(this.win, Windows.lazy);
		IF this.ics # NIL THEN res := this.ics.ShowObject() END;
		IF this.ics # NIL THEN res := this.ics.OnShowWindow(1) END;
	END Open;
	
	PROCEDURE (this: Object) CustomVerb (
		verb: INTEGER; IN msg: WinApi.MSG; activeSite: WinOle.IOleClientSite;
		index: INTEGER; parent: WinApi.HWND; IN posRect: WinApi.RECT
	): COM.RESULT, NEW;
		VAR res: COM.RESULT; pvm: Properties.PollVerbMsg; dvm: Properties.DoVerbMsg;
	BEGIN
		CheckVerb(this.view, 0, pvm);
		IF pvm.label = "" THEN
			IF verb = 0 THEN
				RETURN this.ioo.DoVerb(WinOle.OLEIVERB_SHOW, msg, activeSite, index, parent, posRect)
			ELSIF verb = 1 THEN
				RETURN this.ioo.DoVerb(WinOle.OLEIVERB_OPEN, msg, activeSite, index, parent, posRect)
			ELSE
				DEC(verb)
			END
		END;
		CheckVerb(this.view, verb, pvm);
		IF pvm.label = "" THEN
			res := this.ioo.DoVerb(0, msg, activeSite, index, parent, posRect);
			RETURN WinApi.OLEOBJ_S_INVALIDVERB
		END;
		dvm.frame := NIL;
		dvm.verb := SHORT(verb);
		Views.HandlePropMsg(this.view, dvm);
		RETURN WinApi.S_OK
	END CustomVerb;
	
	
	(* ---------- IOleObject ---------- *)
	
	PROCEDURE (this: IOleObject) SetClientSite (site: WinOle.IOleClientSite): COM.RESULT;
	BEGIN
		this.obj.ics := site;
		IF site = NIL THEN Kernel.Cleanup END;
		RETURN WinApi.S_OK
	END SetClientSite;
	
	PROCEDURE (this: IOleObject) GetClientSite (OUT site: WinOle.IOleClientSite): COM.RESULT;
	BEGIN
		site := this.obj.ics;
		RETURN WinApi.S_OK
	END GetClientSite;
	
	PROCEDURE (this: IOleObject) SetHostNames (app, obj: WinApi.PtrWSTR): COM.RESULT;
	BEGIN
		this.obj.embedded := TRUE;
		RETURN WinApi.S_OK
	END SetHostNames;
	
	PROCEDURE (this: IOleObject) Close (saveOption: INTEGER): COM.RESULT;
		VAR res: COM.RESULT; dirty: BOOLEAN; r: INTEGER; q: BOOLEAN;
	BEGIN
		IF (this.obj.view = NIL) OR (this.obj.seq # NIL) & this.obj.seq.Dirty() THEN
			IF saveOption = WinOle.OLECLOSE_SAVEIFDIRTY THEN
				IF this.obj.ics # NIL THEN res := this.obj.ics.SaveObject() END;
				IF this.obj.ioah # NIL THEN res := this.obj.ioah.SendOnSave() END
			ELSIF saveOption = WinOle.OLECLOSE_PROMPTSAVE THEN
				IF this.obj.win # NIL THEN HostDialog.CloseDialog(this.obj.win, q, r)
				ELSE r := HostDialog.save
				END;
				IF r = HostDialog.save THEN
					IF this.obj.ics # NIL THEN res := this.obj.ics.SaveObject() END;
					IF this.obj.ioah # NIL THEN res := this.obj.ioah.SendOnSave() END
				ELSIF r = HostDialog.cancel THEN
					RETURN WinApi.OLE_E_PROMPTSAVECANCELLED
				END
			END
		END;
		IF this.obj.win # NIL THEN Windows.dir.Close(this.obj.win) END;
		Kernel.Cleanup;
		RETURN WinApi.S_OK
	END Close;
	
	PROCEDURE (this: IOleObject) SetMoniker (which: INTEGER; mk: WinOle.IMoniker): COM.RESULT;
	BEGIN
		RETURN WinApi.E_NOTIMPL
	END SetMoniker;
	
	PROCEDURE (this: IOleObject) GetMoniker (assign, which: INTEGER; OUT mk: WinOle.IMoniker): COM.RESULT;
	BEGIN
		RETURN WinApi.E_NOTIMPL
	END GetMoniker;
	
	PROCEDURE (this: IOleObject) InitFromData (obj: WinOle.IDataObject; creation: WinApi.BOOL;
																reserved: INTEGER): COM.RESULT;
	BEGIN
		RETURN WinApi.E_NOTIMPL
	END InitFromData;
	
	PROCEDURE (this: IOleObject) GetClipboardData (reserved: INTEGER; OUT  obj: WinOle.IDataObject
	): COM.RESULT;
	BEGIN
		RETURN WinApi.E_NOTIMPL
	END GetClipboardData;
	
	PROCEDURE (this: IOleObject) DoVerb (
		verb: INTEGER; IN msg: WinApi.MSG; activeSite: WinOle.IOleClientSite;
		index: INTEGER; parent: WinApi.HWND; IN posRect: WinApi.RECT
	): COM.RESULT;
		VAR res: COM.RESULT; v: Views.View; d: Documents.Document; pvm: Properties.PollVerbMsg;
			c: Containers.Controller; w: Windows.Window; vw, vh: INTEGER; dvm: Properties.DoVerbMsg;
	BEGIN
		CASE verb OF
		| WinOle.OLEIVERB_HIDE:
			IF this.obj.iips # NIL THEN
				this.obj.InPlaceDeactivate()
			ELSE
				IF this.obj.win # NIL THEN Windows.dir.Close(this.obj.win) END;
				IF this.obj.ics # NIL THEN res := this.obj.ics.OnShowWindow(0) END;
				Kernel.Cleanup
			END
		| WinOle.OLEIVERB_PRIMARY, WinOle.OLEIVERB_SHOW:
			IF this.obj.win = NIL THEN
				res := this.obj.InPlaceActivate(activeSite, TRUE);
				IF res # WinApi.S_OK THEN this.obj.Open END
			END
		| WinOle.OLEIVERB_OPEN:
			IF this.obj.iips # NIL THEN this.obj.InPlaceDeactivate END;
			this.obj.Open
		| WinOle.OLEIVERB_INPLACEACTIVATE:
			RETURN this.obj.InPlaceActivate(activeSite, FALSE)
		| WinOle.OLEIVERB_UIACTIVATE:
			RETURN this.obj.InPlaceActivate(activeSite, TRUE)
		| WinOle.OLEIVERB_DISCARDUNDOSTATE:
			(* discard undo *)
		ELSE
			IF verb >= 0 THEN RETURN this.obj.CustomVerb(verb, msg, activeSite, index, parent, posRect)
			ELSE RETURN WinApi.E_NOTIMPL
			END
		END;
		RETURN WinApi.S_OK
	END DoVerb;
	
	PROCEDURE (this: IOleObject) EnumVerbs (OUT enum: WinOle.IEnumOLEVERB): COM.RESULT;
		VAR e: IEnumOLEVERB; v, last: Verb; pvm: Properties.PollVerbMsg; i, j: INTEGER;
	BEGIN
		NEW(e);
		IF e # NIL THEN
			NEW(v); v.verb := -3; v.name := "Hide"; e.first := v; last := v;
			NEW(v); v.verb := -2; v.name := "Open"; last.next := v; last := v;
			NEW(v); v.verb := -1; v.name := "Show"; last.next := v; last := v;
			i := 0; j := 0;
			CheckVerb(this.obj.view, 0, pvm);
			IF pvm.label = "" THEN
				NEW(v); v.verb := i; INC(i); last.next := v; last := v;
				Dialog.MapString("#Host:Edit", v.name);
				NEW(v); v.verb := i; INC(i); last.next := v; last := v;
				Dialog.MapString("#Host:Open", v.name);
				INC(j);
				CheckVerb(this.obj.view, j, pvm)
			END;
			WHILE pvm.label # "" DO
				NEW(v); v.verb := i; INC(i); last.next := v; last := v;
				Dialog.MapString(pvm.label, v.name);
				v.disabled := pvm.disabled;
				v.checked := pvm.checked;
				INC(j);
				CheckVerb(this.obj.view, j, pvm)
			END;
			e.cur := e.first; enum := e;
			RETURN WinApi.S_OK
		ELSE RETURN WinApi.E_OUTOFMEMORY
		END
	END EnumVerbs;
	
	PROCEDURE (this: IOleObject) Update (): COM.RESULT;
	BEGIN
		RETURN WinApi.S_OK
	END Update;
	
	PROCEDURE (this: IOleObject) IsUpToDate (): COM.RESULT;
	BEGIN
		RETURN WinApi.S_OK
	END IsUpToDate;
	
	PROCEDURE (this: IOleObject) GetUserClassID (OUT id: COM.GUID): COM.RESULT;
	BEGIN
		id := ObjectID;
		RETURN WinApi.S_OK
	END GetUserClassID;
	
	PROCEDURE (this: IOleObject) GetUserType (form: INTEGER; OUT type: WinApi.PtrWSTR): COM.RESULT;
	BEGIN
		RETURN WinApi.OLE_S_USEREG
	END GetUserType;
	
	PROCEDURE (this: IOleObject) SetExtent (aspect: SET; IN size: WinApi.SIZE): COM.RESULT;
		VAR res: COM.RESULT;
	BEGIN
		IF aspect * WinOle.DVASPECT_CONTENT # {} THEN
			IF debug THEN Log.String("set extent"); Log.Int(size.cx); Log.Int(size.cy); Log.Ln END;
			this.obj.w := size.cx * oleUnit; this.obj.h := size.cy * oleUnit;
			OleData.SetView(this.obj.ido.data, this.obj.view, this.obj.w, this.obj.h);
			IF this.obj.win # NIL THEN
				this.obj.view.context.SetSize(this.obj.w, this.obj.h)
			END;
			IF debug THEN Log.String("on data change (se)"); Log.Ln END;
			IF this.obj.idah # NIL THEN res := this.obj.idah.SendOnDataChange(this.obj.ido, 0, {}) END;
			RETURN WinApi.S_OK
		ELSE RETURN WinApi.E_FAIL
		END
	END SetExtent;
	
	PROCEDURE (this: IOleObject) GetExtent (aspect: SET; OUT size: WinApi.SIZE): COM.RESULT;
	BEGIN
		IF aspect * WinOle.DVASPECT_CONTENT # {} THEN
			this.obj.CheckViewUpdate;
			IF (this.obj.w # 0) & (this.obj.h # 0) THEN
				size.cx := this.obj.w DIV oleUnit; size.cy := this.obj.h DIV oleUnit;
				IF debug THEN Log.String("get extent"); Log.Int(size.cx); Log.Int(size.cy); Log.Ln END;
				RETURN WinApi.S_OK
			END
		END;
		RETURN WinApi.E_FAIL
	END GetExtent;
	
	PROCEDURE (this: IOleObject) Advise (sink: WinOle.IAdviseSink; OUT connection: INTEGER): COM.RESULT;
		VAR res: COM.RESULT;
	BEGIN
		IF this.obj.ioah = NIL THEN
			res := WinOle.CreateOleAdviseHolder(this.obj.ioah);
			IF res < 0 THEN RETURN res END
		END;
		RETURN this.obj.ioah.Advise(sink, connection)
	END Advise;
	
	PROCEDURE (this: IOleObject) Unadvise (connection: INTEGER): COM.RESULT;
	BEGIN
		IF this.obj.ioah # NIL THEN
			RETURN this.obj.ioah.Unadvise(connection)
		ELSE RETURN WinApi.E_FAIL
		END
	END Unadvise;
	
	PROCEDURE (this: IOleObject) EnumAdvise (OUT enum: WinOle.IEnumSTATDATA): COM.RESULT;
	BEGIN
		IF this.obj.ioah # NIL THEN
			RETURN this.obj.ioah.EnumAdvise(enum)
		ELSE RETURN WinApi.E_FAIL
		END
	END EnumAdvise;
	
	PROCEDURE (this: IOleObject) GetMiscStatus (aspect: SET; OUT status: SET): COM.RESULT;
	BEGIN
		status := miscStatus;
		RETURN WinApi.S_OK
	END GetMiscStatus;
	
	PROCEDURE (this: IOleObject) SetColorScheme (IN pal: WinApi.LOGPALETTE): COM.RESULT;
	BEGIN
		RETURN WinApi.E_NOTIMPL
	END SetColorScheme;

	
	(* ---------- IDataObject ---------- *)
	
	PROCEDURE (this: IDataObject) GetData (IN format: WinOle.FORMATETC;
															OUT medium: WinOle.STGMEDIUM): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("get data"); Log.Ln END;
		RETURN this.data.GetData(format, medium)
	END GetData;
	
	PROCEDURE (this: IDataObject) GetDataHere (IN format: WinOle.FORMATETC;
																	VAR medium: WinOle.STGMEDIUM): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("get data here"); Log.Ln END;
		RETURN this.data.GetDataHere(format, medium)
	END GetDataHere;
	
	PROCEDURE (this: IDataObject) QueryGetData (IN format: WinOle.FORMATETC): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("query get data"); Log.Ln END;
		RETURN this.data.QueryGetData(format)
	END QueryGetData;
	
	PROCEDURE (this: IDataObject) GetCanonicalFormatEtc (IN formatIn: WinOle.FORMATETC;
																			OUT formatOut: WinOle.FORMATETC): COM.RESULT;
	BEGIN
		RETURN WinApi.DATA_S_SAMEFORMATETC
	END GetCanonicalFormatEtc;
	
	PROCEDURE (this: IDataObject) SetData (IN format: WinOle.FORMATETC;
															IN medium: WinOle.STGMEDIUM; release: WinApi.BOOL): COM.RESULT;
	BEGIN
		RETURN WinApi.DV_E_FORMATETC
	END SetData;
	
	PROCEDURE (this: IDataObject) EnumFormatEtc (
		direction: SET; OUT enum: WinOle.IEnumFORMATETC
	): COM.RESULT;
	BEGIN
		RETURN this.data.EnumFormatEtc(direction, enum)
	END EnumFormatEtc;
	
	PROCEDURE (this: IDataObject) DAdvise (
		IN format: WinOle.FORMATETC; flags: SET; advSink: WinOle.IAdviseSink; OUT connection: INTEGER
	): COM.RESULT;
		VAR res: COM.RESULT;
	BEGIN
		IF this.obj.idah = NIL THEN
			res := WinOle.CreateDataAdviseHolder(this.obj.idah);
			IF res < 0 THEN RETURN res END
		END;
		RETURN this.obj.idah.Advise(this, format, flags, advSink, connection)
	END DAdvise;
	
	PROCEDURE (this: IDataObject) DUnadvise (connection: INTEGER): COM.RESULT;
	BEGIN
		IF this.obj.idah # NIL THEN
			RETURN this.obj.idah.Unadvise(connection)
		ELSE RETURN WinApi.E_FAIL
		END
	END DUnadvise;
	
	PROCEDURE (this: IDataObject) EnumDAdvise (OUT  enum: WinOle.IEnumSTATDATA): COM.RESULT;
	BEGIN
		IF this.obj.idah # NIL THEN
			RETURN this.obj.idah.EnumAdvise(enum)
		ELSE RETURN WinApi.E_FAIL
		END
	END EnumDAdvise;
	
	
	(* ---------- IPersistStorage ---------- *)
	
	PROCEDURE (this: IPersistStorage) GetClassID* (OUT id: COM.GUID): COM.RESULT, EXTENSIBLE;
	BEGIN
		id := ObjectID;
		RETURN WinApi.S_OK
	END GetClassID;

	PROCEDURE (this: IPersistStorage) IsDirty (): COM.RESULT;
	BEGIN
		IF (this.obj.view = NIL) OR (this.obj.seq # NIL) & this.obj.seq.Dirty() THEN RETURN WinApi.S_OK
		ELSE RETURN WinApi.S_FALSE
		END
	END IsDirty;
	
	PROCEDURE (this: IPersistStorage) InitNew (stg: WinOle.IStorage): COM.RESULT;
		VAR res: COM.RESULT; ps: WinApi.PtrWSTR;
	BEGIN
		IF debug THEN Log.String("init new"); Log.Ln END;
		IF stg # NIL THEN
			res := stg.CreateStream(streamStr,
											WinOle.STGM_DIRECT + WinOle.STGM_CREATE
											+ WinOle.STGM_READWRITE + WinOle.STGM_SHARE_EXCLUSIVE,
											0, 0, this.obj.ism);
			IF res >= 0 THEN
				res := WinOle.OleRegGetUserType(ObjectID, WinOle.USERCLASSTYPE_SHORT, ps);
				res := WinOle.WriteFmtUserTypeStg(stg, cbFormat, ps);
				WinOle.CoTaskMemFree(SYSTEM.VAL(WinApi.PtrVoid, ps));
				this.obj.isg := stg;
				this.obj.w := 60 * Ports.mm;
				this.obj.h := 60 * Ports.mm;
				this.obj.rsm := NIL;
				this.obj.view := TextViews.dir.New(NIL);
				this.obj.seq := NIL;
				this.obj.win := NIL;
				OleData.SetView(this.obj.ido.data, this.obj.view, this.obj.w, this.obj.h);
				RETURN WinApi.S_OK
			ELSE RETURN res
			END
		ELSE RETURN WinApi.E_POINTER
		END
	END InitNew;
	
	PROCEDURE (this: IPersistStorage) Load (stg: WinOle.IStorage): COM.RESULT;
		VAR res: COM.RESULT; tag, version: INTEGER; is: BOOLEAN;
	BEGIN
		IF debug THEN Log.String("load"); Log.Ln END;
		IF stg # NIL THEN
			res := stg.OpenStream(streamStr, 0,
				WinOle.STGM_DIRECT + WinOle.STGM_READWRITE + WinOle.STGM_SHARE_EXCLUSIVE,
				0, this.obj.ism);
			IF res >= 0 THEN
				res := WinOle.CreateStreamOnHGlobal(0, 1, this.obj.rsm);
				res := this.obj.ism.CopyTo(this.obj.rsm, MAX(LONGINT), NIL, NIL);
				OleStorage.ImportFromStream(this.obj.rsm, this.obj.view, this.obj.w, this.obj.h, is);
				IF this.obj.view # NIL THEN
					this.obj.seq := NIL;
					this.obj.win := NIL;
					this.obj.isg := stg;
					OleData.SetView(this.obj.ido.data, this.obj.view, this.obj.w, this.obj.h);
					RETURN WinApi.S_OK
				END
			END;
			RETURN WinApi.STG_E_READFAULT
		ELSE RETURN WinApi.E_POINTER
		END
	END Load;
	
	PROCEDURE (this: IPersistStorage) Save (stg: WinOle.IStorage; sameAsLoad: WinApi.BOOL): COM.RESULT;
		VAR stm: WinOle.IStream; res: COM.RESULT; ps: WinApi.PtrWSTR;
	BEGIN
		IF sameAsLoad # 0 THEN
			IF debug THEN Log.String("save same"); Log.Ln END;
			stm := this.obj.ism;
		ELSIF stg # NIL THEN
			IF debug THEN Log.String("save"); Log.Ln END;
			res := stg.CreateStream(streamStr,
											WinOle.STGM_DIRECT + WinOle.STGM_CREATE
											+ WinOle.STGM_READWRITE + WinOle.STGM_SHARE_EXCLUSIVE,
											0, 0, stm);
			IF res < 0 THEN RETURN res END;
			res := WinOle.OleRegGetUserType(ObjectID, WinOle.USERCLASSTYPE_SHORT, ps);
			res := WinOle.WriteFmtUserTypeStg(stg, cbFormat, ps);
			WinOle.CoTaskMemFree(SYSTEM.VAL(WinApi.PtrVoid, ps));
		ELSE RETURN WinApi.E_POINTER
		END;
		this.obj.CheckViewUpdate;
		OleStorage.ExportToStream(stm, this.obj.view, this.obj.w, this.obj.h, TRUE);
		IF this.obj.seq # NIL THEN
			this.obj.seq.BeginModification(Sequencers.notUndoable, NIL);
			this.obj.seq.EndModification(Sequencers.notUndoable, NIL);	(* clear sequencer *)
			this.obj.seq.SetDirty(FALSE)
		END;
		RETURN WinApi.S_OK
	END Save;
	
	PROCEDURE (this: IPersistStorage) SaveCompleted (new: WinOle.IStorage): COM.RESULT;
		VAR res: COM.RESULT;
	BEGIN
		IF debug THEN Log.String("save completed"); Log.Ln END;
		IF new # NIL THEN
			res := new.OpenStream(streamStr, 0,
				WinOle.STGM_DIRECT + WinOle.STGM_READWRITE + WinOle.STGM_SHARE_EXCLUSIVE,
				0, this.obj.ism);
			IF res >= 0 THEN
				this.obj.isg := new;
			ELSE RETURN res
			END
		END;
		IF this.obj.ioah # NIL THEN res := this.obj.ioah.SendOnSave() END;
		RETURN WinApi.S_OK
	END SaveCompleted;
	
	PROCEDURE (this: IPersistStorage) HandsOffStorage (): COM.RESULT;
		VAR n: INTEGER;
	BEGIN
		this.obj.ism := NIL; this.obj.isg := NIL;
		RETURN WinApi.S_OK
	END HandsOffStorage;
	

	(* ---------- IOleInPlaceObject ---------- *)
	
	PROCEDURE (this: IOleInPlaceObject) GetWindow (OUT wnd: WinApi.HWND): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipo: get window"); Log.Ln END;
		wnd := this.obj.win.wnd;
		ASSERT(wnd # 0, 100);
		RETURN WinApi.S_OK
	END GetWindow;
	
	PROCEDURE (this: IOleInPlaceObject) ContextSensitiveHelp (enter: WinApi.BOOL): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipo: context help"); Log.Ln END;
		RETURN WinApi.S_OK
	END ContextSensitiveHelp;
	
	PROCEDURE (this: IOleInPlaceObject) InPlaceDeactivate (): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipo: ip deactivate"); Log.Ln END;
		this.obj.InPlaceDeactivate;
		RETURN WinApi.S_OK
	END InPlaceDeactivate;
	
	PROCEDURE (this: IOleInPlaceObject) UIDeactivate (): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipo: ui deactivate"); Log.Ln END;
		this.obj.UIDeactivate;
		RETURN WinApi.S_OK
	END UIDeactivate;
	
	PROCEDURE (this: IOleInPlaceObject) SetObjectRects (IN pos, clip: WinApi.RECT): COM.RESULT;
		VAR l, t, r, b, bw, u, res: INTEGER;
	BEGIN
		IF debug THEN Log.String("iipo: set rect"); Log.Ln END;
		u := this.obj.unit;
		bw := borderW DIV HostWindows.unit;
		l := Max(pos.left - bw, clip.left);
		t := Max(pos.top - bw, clip.top);
		r := Min(pos.right + bw, clip.right);
		b := Min(pos.bottom + bw, clip.bottom);
		res := WinApi.SetWindowPos(this.obj.win.wnd, 0, l, t, r - l, b - t, WinApi.SWP_NOZORDER);
		this.obj.win.SetSize(r - l, b - t);
		l := Min(bw, pos.left - clip.left) * u;
		t := Min(bw, pos.top - clip.top) * u;
(*
		r := l + (pos.right - pos.left) * u;
		b := t + (pos.bottom - pos.top) * u;
*)
		r := l + this.obj.w;
		b := t + this.obj.h;
		this.obj.win.doc.SetRect(l, t, r, b);
		RETURN WinApi.S_OK
	END SetObjectRects;
	
	PROCEDURE (this: IOleInPlaceObject) ReactivateAndUndo (): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipo: reactivate & undo"); Log.Ln END;
		RETURN WinApi.S_OK
	END ReactivateAndUndo;
	
	
	(* ---------- IOleInPlaceActiveObject ---------- *)
	
	PROCEDURE (this: IOleInPlaceActiveObject) GetWindow (OUT wnd: WinApi.HWND): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipao: get window"); Log.Ln END;
		wnd := this.obj.win.wnd;
		RETURN WinApi.S_OK
	END GetWindow;
	
	PROCEDURE (this: IOleInPlaceActiveObject) ContextSensitiveHelp (enter: WinApi.BOOL): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipao: context help"); Log.Ln END;
		RETURN WinApi.S_OK
	END ContextSensitiveHelp;
	
	PROCEDURE (this: IOleInPlaceActiveObject) TranslateAccelerator (IN msg: WinApi.MSG): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipao: translate acc"); Log.Ln END;
		RETURN WinApi.S_FALSE
	END TranslateAccelerator;
	
	PROCEDURE (this: IOleInPlaceActiveObject) OnFrameWindowActivate (activate: WinApi.BOOL): COM.RESULT;
		VAR res: COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipao: on frame active "); Log.Int(activate); Log.Ln END;
		IF (this.obj.iipf # NIL) & (this.obj.iipw = NIL) THEN
			IF activate # 0 THEN
				HostWindows.ActivateWindow(this.obj.win, TRUE);
				HostMenus.isObj := TRUE
			ELSE
				HostWindows.ActivateWindow(this.obj.win, FALSE);
				HostMenus.isObj := FALSE
			END
		END;
		RETURN WinApi.S_OK
	END OnFrameWindowActivate;
	
	PROCEDURE (this: IOleInPlaceActiveObject) OnDocWindowActivate (activate: WinApi.BOOL): COM.RESULT;
		VAR res: COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipao: on win active"); Log.Int(activate); Log.Ln END;
		IF this.obj.iipf # NIL THEN
			IF activate # 0 THEN
				IF this.obj.uiActive THEN res := this.obj.iipf.SetActiveObject(this, "") END;
				HostWindows.ActivateWindow(this.obj.win, TRUE);
				HostMenus.isObj := TRUE;
				IF this.obj.menu # 0 THEN
					res := this.obj.iipf.SetMenu(this.obj.menu, this.obj.oleMenu, HostWindows.main);
					this.obj.useMenu := TRUE
				END
			ELSE
				IF this.obj.menu # 0 THEN
					res := this.obj.iipf.SetMenu(0, 0, 0);
					this.obj.useMenu := FALSE
				END;
				HostWindows.ActivateWindow(this.obj.win, FALSE);
				HostMenus.isObj := FALSE;
				IF this.obj.uiActive THEN res := this.obj.iipf.SetActiveObject(NIL, NIL) END
			END
		END;
		RETURN WinApi.S_OK
	END OnDocWindowActivate;
	
	PROCEDURE (this: IOleInPlaceActiveObject) ResizeBorder (IN border: WinApi.RECT;
														win: WinOle.IOleInPlaceUIWindow; frameWin: WinApi.BOOL): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipao: resize border"); Log.Ln END;
		RETURN WinApi.S_OK
	END ResizeBorder;
	
	PROCEDURE (this: IOleInPlaceActiveObject) EnableModeless (enable: WinApi.BOOL): COM.RESULT;
	BEGIN
		IF debug THEN Log.String("iipao: enable modeless"); Log.Ln END;
		RETURN WinApi.S_OK
	END EnableModeless;


	(* ---------- Window ---------- *)
	
	PROCEDURE (w: Window) BroadcastViewMsg (VAR msg: Views.Message);
		VAR res: COM.RESULT;
	BEGIN
		w.BroadcastViewMsg^(msg);
		IF msg.view = w.obj.view THEN w.obj.update := TRUE END
	END BroadcastViewMsg;
	
	PROCEDURE (w: Window) ForwardCtrlMsg (VAR msg: Views.CtrlMessage);
		VAR c, dc: Containers.Controller;
	BEGIN
		w.ForwardCtrlMsg^(msg);
		WITH msg: Controllers.EditMsg DO
			IF (msg.op = Controllers.pasteChar) & (msg.char = 1BX) & (31 IN msg.modifiers) & w.obj.uiActive THEN
				w.obj.InPlaceDeactivate()
			END
		ELSE
		END
	END ForwardCtrlMsg;
	
	PROCEDURE (w: Window) Close;
		VAR res: COM.RESULT;
	BEGIN
		IF w.obj.uiActive THEN
			IF debug THEN Log.String("close -> deactivate"); Log.Ln END;
			w.obj.InPlaceDeactivate()
		ELSE
			IF debug THEN Log.String("close window"); Log.Ln END;
			w.obj.CheckViewUpdate;
			SYSTEM.PUT(SYSTEM.ADR(w.sub), TRUE);	(* don't send remove msg *)
			w.Close^;
			IF (w.obj.ics # NIL) & (w.obj.iips = NIL) THEN res := w.obj.ics.OnShowWindow(0) END;
			IF debug THEN Log.String("close window c"); Log.Ln END;
			w.obj.win := NIL
		END
	END Close;
	

	(* ---------- Action ---------- *)
	
	PROCEDURE (a: Action) Do;
		VAR res: COM.RESULT; w, h: INTEGER;
	BEGIN
		IF a.w.frame # NIL THEN
			a.w.obj.CheckViewUpdate;
			Services.DoLater(a, Services.Ticks() + Services.resolution)
		END
	END Do;
	

	(* ---------- WinDir ---------- *)
	
	PROCEDURE (d: WinDir) New (): HostWindows.Window;
		VAR w: Windows.Window; sw: Window; a: Action;
	BEGIN
		IF d.obj # NIL THEN
			NEW(sw); sw.obj := d.obj;
			NEW(a); a.w := sw; Services.DoLater(a, Services.now);
			RETURN sw
		ELSE
			w := Windows.stdDir.New(); RETURN w(HostWindows.Window)
		END
	END New;
	
	PROCEDURE (d: WinDir) Open (w: Windows.Window; doc: Documents.Document; flags: SET; name: Views.Title;
											loc: Files.Locator; fname: Files.Name; conv: Converters.Converter);
		VAR l, t, r, b, bw, u, u1, res: INTEGER; style: SET; wnd: WinApi.HWND; c: Containers.Controller; dc: WinApi.HDC;
	BEGIN
		IF (d.obj # NIL) & (d.obj.iips # NIL) THEN	(* open in place *)
			WITH w: Window DO
				IF debug THEN Log.String("open window in place"); Log.Ln END;
				flags := flags + {Windows.noHScroll, Windows.noVScroll, Windows.noResize, HostWindows.inPlace};
				u := d.obj.w DIV (d.pos.right - d.pos.left);
				u1 := d.obj.h DIV (d.pos.bottom - d.pos.top);
				IF u1 > u THEN u := u1 END;
				d.unit := u;
				d.Open^(w, doc, flags, name, loc, fname, conv);
(*
				u := HostWindows.unit;
*)
				bw := borderW DIV HostWindows.unit;
				l := Max(d.pos.left - bw, d.clip.left);
				t := Max(d.pos.top - bw, d.clip.top);
				r := Min(d.pos.right + bw, d.clip.right);
				b := Min(d.pos.bottom + bw, d.clip.bottom);
				style := {30};	(* child *)
				wnd := WinApi.CreateWindowEx({}, "Oberon Dlg", "", style, l, t, r - l, b - t,
															d.host, 0, WinApi.GetModuleHandle(NIL), SYSTEM.VAL(INTEGER, w));
				ASSERT(wnd # 0, 100);
				dc := WinApi.GetDC(wnd);
				w.port(HostPorts.Port).SetDC(dc, wnd);
				w.SetSize(r - l, b - t);
				l := Min(bw, d.pos.left - d.clip.left) * u;
				t := Min(bw, d.pos.top - d.clip.top) * u;
(*
				r := l + (d.pos.right - d.pos.left) * u;
				b := t + (d.pos.bottom - d.pos.top) * u;
*)
				IF debug THEN Log.Int(d.obj.w); Log.Int(d.obj.h); Log.Ln END;
				r := l + d.obj.w;
				b := t + d.obj.h;
				w.doc.SetRect(l, t, r, b);
				res := WinApi.ShowWindow(wnd, 1);
				d.obj.unit := u;
				IF debug THEN
					style := SYSTEM.VAL(SET, WinApi.GetWindowLong(wnd, -16));
					Log.Set(style);
					Log.Ln
				END;				
				c := w.doc.ThisController();
				c.SetFocus(w.doc.ThisView())
			END
		ELSE
			d.Open^(w, doc, flags, name, loc, fname, conv)
		END;
		d.obj := NIL
	END Open;
	
	
	(* ---------- import / export ---------- *)
	
	PROCEDURE Export* (v: Views.View; w, h, x, y: INTEGER; isSingle: BOOLEAN; VAR med: WinOle.STGMEDIUM);
		VAR stg: WinOle.IStorage; stm: WinOle.IStream; res: COM.RESULT; ilb: WinOle.ILockBytes; ps: WinApi.PtrWSTR;
	BEGIN
		IF debug THEN Log.String("export"); Log.Ln END;
		IF med.tymed = WinOle.TYMED_ISTORAGE THEN
			stg := MediumStorage(med)
		ELSE
			res := WinOle.CreateILockBytesOnHGlobal(0, 1, ilb);
			ASSERT(res >= 0, 110);
			res := WinOle.StgCreateDocfileOnILockBytes(ilb, WinOle.STGM_CREATE
											+ WinOle.STGM_READWRITE + WinOle.STGM_SHARE_EXCLUSIVE, 0, stg);
			ASSERT(res >= 0, 111);
			GenStorageMedium(stg, NIL, med)
		END;
		res := WinOle.WriteClassStg(stg, ObjectID);
		ASSERT(res >= 0, 112);
		res := stg.CreateStream(streamStr, WinOle.STGM_CREATE
										+ WinOle.STGM_READWRITE + WinOle.STGM_SHARE_EXCLUSIVE, 0, 0, stm);
		ASSERT(res >= 0, 113);
		res := WinOle.OleRegGetUserType(ObjectID, WinOle.USERCLASSTYPE_SHORT, ps);
		res := WinOle.WriteFmtUserTypeStg(stg, cbFormat, ps);
		WinOle.CoTaskMemFree(SYSTEM.VAL(WinApi.PtrVoid, ps));
		ASSERT(res >= 0, 114);
		OleStorage.ExportToStream(stm, v, w, h, isSingle);
		res := stg.Commit({});
		ASSERT(res >= 0, 115)
	END Export;
	
	PROCEDURE Import* (
		VAR med: WinOle.STGMEDIUM; VAR v: Views.View; VAR w, h: INTEGER; VAR isSingle: BOOLEAN
	);
		VAR stg: WinOle.IStorage; res: COM.RESULT; id: COM.GUID; stm, stm2: WinOle.IStream;
	BEGIN
		IF debug THEN Log.String("import"); Log.Ln END;
		stg := MediumStorage(med);
		res := WinOle.ReadClassStg(stg, id);
		IF (res = WinApi.S_OK) & (id = ObjectID) THEN
			res := stg.OpenStream(streamStr, 0,
				WinOle.STGM_DIRECT + WinOle.STGM_READWRITE + WinOle.STGM_SHARE_EXCLUSIVE,
				0, stm);
			ASSERT(res >= 0, 110);
			res := WinOle.CreateStreamOnHGlobal(0, 1, stm2);
			ASSERT(res >= 0, 111);
			res := stm.CopyTo(stm2, MAX(LONGINT), NIL, NIL);
			ASSERT(res >= 0, 112);
			OleStorage.ImportFromStream(stm2, v, w, h, isSingle);
		ELSE
			v := NIL
		END
	END Import;

	(* ---------- commands ---------- *)
	
	PROCEDURE ContextOf* (w: Windows.Window): WinOle.IOleInPlaceSite;
	BEGIN
		WITH w: Window DO
			IF w.obj # NIL THEN RETURN w.obj.iips END
		ELSE RETURN NIL
		END
	END ContextOf;
	
	PROCEDURE RemoveUI* (w: Windows.Window);
		VAR res: COM.RESULT;
	BEGIN
		WITH w: Window DO
			IF (w.obj # NIL) & (w.obj.iips # NIL) & w.obj.uiActive THEN
				IF debug THEN Log.String("remove ui"); Log.Ln END;
				IF w.obj.iipf # NIL THEN res := w.obj.iipf.SetActiveObject(NIL, NIL) END;
				IF w.obj.iipw # NIL THEN res := w.obj.iipw.SetActiveObject(NIL, NIL) END;
				IF (w.obj.iipf # NIL) & (w.obj.menu # 0) THEN
					res := w.obj.iipf.SetMenu(0, 0, 0);
					w.obj.useMenu := FALSE
				END;
(*
				HostWindows.ActivateWindow(w, FALSE);
*)
			END
		ELSE
		END
	END RemoveUI;
	
	PROCEDURE ResetUI* (w: Windows.Window; VAR done: BOOLEAN);
		VAR res: COM.RESULT; rect: WinApi.RECT;
	BEGIN
		done := FALSE;
		WITH w: Window DO
			IF (w.obj # NIL) & (w.obj.iips # NIL) & w.obj.uiActive THEN
				IF debug THEN Log.String("reset ui"); Log.Ln END;
				IF w.obj.iipf # NIL THEN res := w.obj.iipf.SetActiveObject(w.obj.iipao, "") END;
				IF w.obj.iipw # NIL THEN res := w.obj.iipw.SetActiveObject(w.obj.iipao, "") END;
				IF (w.obj.iipf # NIL) & (w.obj.menu # 0) THEN
					res := w.obj.iipf.SetMenu(w.obj.menu, w.obj.oleMenu, HostWindows.main);
					w.obj.useMenu := TRUE
				END;
				rect.left := 0; rect.top := 0; rect.right := 0; rect.bottom := 0;
				IF w.obj.iipf # NIL THEN res := w.obj.iipf.SetBorderSpace(rect) END;
				IF w.obj.iipw # NIL THEN res := w.obj.iipw.SetBorderSpace(rect) END;
(*
				HostWindows.ActivateWindow(w, TRUE);
*)
				done := TRUE
			END
		ELSE
		END
	END ResetUI;
	
	PROCEDURE ShowOleStatus (w: Windows.Window; s: ARRAY OF CHAR);
		VAR res: COM.RESULT;
	BEGIN
		WITH w: Window DO
			IF w.obj.iipf # NIL THEN
				res := w.obj.iipf.SetStatusText(s)
			END
		ELSE
		END
	END ShowOleStatus;
	
	PROCEDURE UpdateOleMenus ();
		VAR w: Windows.Window; res: COM.RESULT;
	BEGIN
		w := Windows.dir.First();
		WHILE w # NIL DO
			WITH w: Window DO
				IF (w.obj.iipf # NIL) & (w.obj.menu # 0) THEN
					w.obj.InPlaceMenuDestroy(); w.obj.InPlaceMenuCreate();
					IF w.obj.useMenu THEN
						res := w.obj.iipf.SetMenu(w.obj.menu, w.obj.oleMenu, HostWindows.main)
					END
				END
			ELSE
			END;
			w := Windows.dir.Next(w)
		END
	END UpdateOleMenus;
	
	PROCEDURE TranslateOleKeys (VAR msg: WinApi.MSG; VAR done: BOOLEAN);
		VAR w: Windows.Window; res: COM.RESULT;
	BEGIN
		w := Windows.dir.First(); done := FALSE;
		IF w # NIL THEN
			WITH w: Window DO
				IF w.obj.iipf # NIL THEN
					res := WinOle.OleTranslateAccelerator(w.obj.iipf, w.obj.fInfo, msg);
					IF res = WinApi.S_OK THEN done := TRUE END
				END
			ELSE
			END
		END
	END TranslateOleKeys;
	
	PROCEDURE Register;
		VAR res: COM.RESULT;
	BEGIN
		NEW(factory);
		res := WinOle.CoRegisterClassObject(ObjectID, factory,
												WinOle.CLSCTX_LOCAL_SERVER, WinOle.REGCLS_MULTIPLEUSE, token);
	END Register;
	
	PROCEDURE Unregister;
		VAR res: COM.RESULT; n: INTEGER; p: Object;
	BEGIN
		IF token # 0 THEN
			res := WinOle.CoRevokeClassObject(token)
		END
	END Unregister;

BEGIN
	NEW(winDir);
	HostDialog.ShowOleStatus := ShowOleStatus;
	HostMenus.UpdateOleMenus := UpdateOleMenus;
	HostMenus.TranslateOleKeys2 := TranslateOleKeys;
	Register
CLOSE
	Unregister
END OleServer.

OleServer.xy	OleServer.Close

DevDecoder.Decode OleServer