; NAME:
;	SOBJ_NEW
;
; VERSION:
;	1.0
;
; PURPOSE:
;	Create Singleton object (object that can only have one globally visible instance in IDL session)
;
; AUTHOR:
;	Pavel A. Romashkin, Ph. D.
;
; CATEGORY:
;	Utilities.
;
; CALLING SEQUENCE:
;	My_Object = SOBJ_NEW()
;
; INPUTS:
;
; KEYWORD PARAMETERS:
;
; OBJECT METHODS:
;	INIT.
;
; COMMON BLOCKS:
;	None. Purpose of Singleton object is to help avoid using Common blocks.
;
; SIDE EFFECTS:
;	One disk read-write access per IDL session.
;
; RESTRICTIONS:
;	None.
;
; EXAMPLE:
;	
; PROCEDURE:
;
; EXPANDABILITY:
;	Can be used as a parent to subclasses of globally visible objects.
;
; MODIFICATION HISTORY:
;	Written: P. A. Romashkin, 09-2000
;-
; *************************************************************************
pro sobj_help
compile_opt IDL2, obsolete, hidden
buffer = ['Usage: My_Singleton = Sobj_new() or My_Singleton = Sobj_new(store=Value, /No_kill).', $
	'Keywords:', $
	'NO_KILL will prevent accidental deleteion of object contents via OBJ_DESTROY *once*.', $
	'Then, NO_KILL needs to be set in the Singleton object again, if desired.', $
	'Methods:', $
	'STORE method sets the contents and NO_KILL property of the object:', $
	'My_Singleton -> Store, My_Object_Tree, /No_kill.', $
	"Using My_Singleton -> Store with no arguments will print Help on object's contents.", $
	'GET method will retrieve the contents of the object:', $
	'My_Object_Tree = My_Singleton -> Get().', $
	'Notes: SOBJ_NEW will NOT create any objects if one already exists, avoiding the OBJ_NEW overhead.', $
	'Singleton object can be retrieved in the normal fashion even if there is no reference to it anywhere.', $
	'Using HEAP_GC will destroy an *unreferenced* Singleton object even with NO_KILL property set.']
junk = dialog_message(transpose(buffer), title='Usage of SOBJ_NEW')
end
;*************************************************************************
function sobj::init, from_verify=from_verify, no_kill=no_kill, store=store, old_self=old_self
compile_opt IDL2, obsolete, hidden
if keyword_set(from_verify) then begin
	if obj_valid(old_self) then self.other = old_self.other else $
	if n_elements(store) ne 0 then self.other = ptr_new(store) else self.other = ptr_new(/allocate)
	if keyword_set(no_kill) then self.no_kill = 1b
	return, 1
endif
print, 'Use SOBJ_NEW to create a reference to Singleton object'
return, 0
end
;*************************************************************************
pro sobj::cleanup
compile_opt IDL2, obsolete, hidden ; Do not set NO_KILL, or HEAP_GC gets in an infinite loop.
if self.no_kill then junk = sobj_verify(/revalidate, old_self=self) else ptr_free, self.other
end
;*************************************************************************
function sobj::Get
compile_opt IDL2, obsolete, hidden
if n_elements(*self.other) ne 0 then return, *self.other else message, 'Contents of Singleton not defined'
end
;*************************************************************************
pro sobj::store, data, no_kill=no_kill
compile_opt IDL2, obsolete, hidden
if n_elements(data) ne 0 then *self.other = data
if n_elements(no_kill) ne 0 then self.no_kill = keyword_set(no_kill)
if (n_elements(data) + n_elements(no_kill)) eq 0 then help, *self.other, self.no_kill
end
;*************************************************************************
pro sobj__define ; This is for pure Singleton definition.
compile_opt IDL2, obsolete, hidden
ret = {sobj, no_kill : 0b, other : ptr_new()}
end
;*************************************************************************
function sobj_verify, revalidate=revalidate, _extra=_extra
compile_opt IDL2, obsolete, hidden
if keyword_set(revalidate) then begin
		self = obj_new('SOBJ', /from_verify, _extra=_extra)
		openw, unit, 'sobj_validate.pro', /get_lun
		printf, unit, 'function sobj_validate'
		printf, unit, 'compile_opt hidden'
		printf, unit, 'tmp = "', format='(a, $)'
		printf, unit, self
		printf, unit, 'tmp = strmid(tmp, 11, strpos(tmp, "(")-11)'
		printf, unit, 'return, obj_valid(tmp, /cast)'
		printf, unit, 'end'
		free_lun, unit
		resolve_routine, 'sobj_validate', /is_function
		file_delete, 'sobj_validate.pro'
endif
return, sobj_validate()
end
;*************************************************************************
function sobj_validate
compile_opt IDL2, obsolete, hidden
return, obj_new()
end
;*************************************************************************
function sobj_new, help=help, _extra=_extra
compile_opt IDL2, obsolete, hidden
if keyword_set(help) then begin & sobj_help & return, 0b & endif
self = sobj_verify()
if obj_valid(self) then return, self else return, sobj_verify(/revalidate, _extra=_extra)
end
;*************************************************************************