; NAME:
;	SINGLE procedure set
;
; VERSION:
;	1.0
;
; PURPOSE:
;	Create Singleton variable (pointer that is globally visible in IDL session)
;	Can be used to keep state structures or other globally visible objects.
;
; AUTHOR:
;	Pavel A. Romashkin, Ph. D.
;
; CATEGORY:
;	Utilities.
;
; CALLING SEQUENCE:
;	SINGLE_SET, 'My_name', My_value
;	My_value = SINGLE_GET, 'My_name'
;
; INPUTS:
;	VALUE: any variable.
;	NAME: a string used to uniquely identify this globally visible variable.
;
; KEYWORD PARAMETERS:
;	NO_COPY: use to improve efficiency of data transfer to and from variable.
;	GET_HANDLE: set to a named variable that will contain a globally visible pointer.
;
; OBJECT METHODS:
;
; COMMON BLOCKS:
;	None. Purpose of Singleton variable is to help avoid using Common blocks.
;
; SIDE EFFECTS:
;	One disk read-write access per IDL newly defined Singleton variable name.
;
; RESTRICTIONS:
;	None.
;
; EXAMPLE:
;	
; PROCEDURE:
;
; EXPANDABILITY:
;
; MODIFICATION HISTORY:
;	Written: P. A. Romashkin, 09-2000
;-
; *************************************************************************
pro single_help
compile_opt IDL2, obsolete, hidden
buffer = ['Usage:', $
	'SINGLE_SET, "My_name", My_value[, get_handle=My_name_handle[, /No_copy]] - store the value.', $
	'My_value = SINGLE_GET("My_name"[, get_handle=My_name_handle]) - retrieve the value.', $
	'SINGLE_KILL, "My_name" - destroy the globally visible variable.', $
	'Keywords:', $
	'NO_COPY will help improve efficiency of data transfers but undefine the My_value variable.', $
	'GET_HANDLE allows to keep an internal reference to globally visible poiter.']
junk = dialog_message(transpose(buffer), title='Usage of SOBJ_NEW')
end
;*************************************************************************
pro single_kill, name
compile_opt IDL2, obsolete, hidden
ptr_free, call_function(name+'_validate')
end
;*************************************************************************
function single_get, name, no_copy=no_copy, get_handle=handle, help=help
compile_opt IDL2, obsolete, hidden
Catch, Err_code ; Provide error handling.
if (Err_code ne 0) then begin
	print, 'ERROR: Global variable named '+strupcase(name)+' was never created.'
	catch, /cancel
	return, 0b
endif
if keyword_set(help) then begin & single_help & return, 0 & endif
handle = call_function(name+'_validate')
if ptr_valid(handle) eq 0 then message, 'Global variable named '+strupcase(name)+' does not exist.'
if keyword_set(no_copy) then return, temporary(*handle) else return, *handle
end
;*************************************************************************
pro single_set, name, value, no_copy=no_copy, get_handle=handle, help=help, force=force
compile_opt IDL2, obsolete, hidden
if keyword_set(help) then begin & single_help & return & endif
if (where(routine_info(/functions) eq strupcase(name)+'_VALIDATE'))[0] eq -1 $
or keyword_set(force) then begin
		if n_elements(value) eq 0 then handle = ptr_new(/allocate) $
			else handle = ptr_new(value, no_copy=no_copy)
		openw, unit, name+'_validate.pro', /get_lun
		printf, unit, 'function '+name+'_validate'
		printf, unit, 'compile_opt IDL2, obsolete, hidden'
		printf, unit, 'tmp = "', format='(a, $)'
		printf, unit, handle
		printf, unit, 'tmp = strmid(tmp, 11, strpos(tmp, ">")-11)'
		printf, unit, 'return, ptr_valid(tmp, /cast)'
		printf, unit, 'end'
		free_lun, unit
		resolve_routine, name+'_validate', /is_function
		file_delete, name+'_validate.pro'
endif else begin
	handle = call_function(name+'_validate')
	if ptr_valid(handle) eq 0 then begin
		single_set, name, value, no_copy=no_copy, get_handle=handle, help=help, /force
	endif else if n_elements(value) ne 0 then $
		if keyword_set(no_copy) then *handle = temporary(value) else *handle = value
endelse
end
;*************************************************************************