/* This code is unpacked. It could be read easily by the beginner (i hope !) */

typeof ctWin = ObjWin;;
typeof ctTfile = ObjText;;
typeof ctLtables = ObjList;;
typeof ctLcolumns = ObjList;;
typeof ctLfields = ObjList;;
typeof ctTstatus = ObjText;;
typeof ctDb = ObjSqlite;;
var ctDBok = 0;;
typeof tempColonne = [S S S S S S];; // id name type notnull default_value primary_key
typeof tempColonne2 = [I S S I S I];;
typeof listColumns = [[I S S I S I] r1];;


fun ctLineText (list)=
	if list == nil then
		""
	else
		strcat hd list strcat " " ctLineText tl list;;



/* reset all listboxes */
fun ctRSTlist (n)=
	if n == 3 then
	(
		_RSTlist ctLtables;
		_RSTlist ctLcolumns;
		_RSTlist ctLfields;
	)
	else if n == 2 then
	(
		_RSTlist ctLcolumns;
		_RSTlist ctLfields;
	)
	else if n == 1 then
		_RSTlist ctLfields
	else
		nil;
	0;;
	
/*
	Display to the listbox each name of table returned by 'createTool_refreshTables'
	col always equal at "name" (cf structure of sqlite_master)
	value = the name of the table
*/
fun ctCBdbTables (db, u, col, value)=
	_ADDlist ctLtables 0 value;
	0;;
	
fun ctCBdbColumns (db, u, col, value)=
	if (!strcmp col "cid") then
	(
		if tempColonne != nil then
			let tempColonne -> [id name type notnull default pkey] in
			let ctLineText name :: type :: notnull :: default :: pkey :: nil -> s in
			
			_ADDlist ctLcolumns atoi id s
		else
			nil;
		set tempColonne = [value nil nil nil nil nil]
	)
	else if (!strcmp col "name") then
		let tempColonne -> [id name type notnull default pkey] in
		set tempColonne = [id value type notnull default pkey]
	else if (!strcmp col "type") then
		let tempColonne -> [id name type notnull default pkey] in
		set tempColonne = [id name value notnull default pkey]
	else if (!strcmp col "notnull") then
		let tempColonne -> [id name type notnull default pkey] in
		set tempColonne = [id name type value default pkey]
	else if (!strcmp col "dflt_value") then
		let tempColonne -> [id name type notnull default pkey] in
		set tempColonne = [id name type notnull value pkey]
	else if (!strcmp col "pk") then
		let tempColonne -> [id name type notnull default pkey] in
		set tempColonne = [id name type notnull default value]
	else
		nil;
	0;;
	
fun ctCBdbListColumns (db, u, col, value)=
	if (!strcmp col "cid") then
	(
		set listColumns = tempColonne2 :: listColumns;
		set tempColonne2 = [atoi value nil nil nil nil nil]
	)
	else if (!strcmp col "name") then
		let tempColonne2 -> [id name type notnull default pkey] in
		set tempColonne2 = [id value type notnull default pkey]
	else if (!strcmp col "type") then
		let tempColonne2 -> [id name type notnull default pkey] in
		set tempColonne2 = [id name value notnull default pkey]
	else if (!strcmp col "notnull") then
		let tempColonne2 -> [id name type notnull default pkey] in
		set tempColonne2 = [id name type atoi value default pkey]
	else if (!strcmp col "dflt_value") then
		let tempColonne2 -> [id name type notnull default pkey] in
		set tempColonne2 = [id name type notnull value pkey]
	else if (!strcmp col "pk") then
		let tempColonne2 -> [id name type notnull default pkey] in
		set tempColonne2 = [id name type notnull default atoi value]
	else
		nil;
	0;;


fun createTool_exec (sql)=
	_sqliteExec ctDb sql nil;;
	
fun createTool_reflex (cbfun, param)=
	_sqliteCallbackExec ctDb cbfun param;;
	
fun createTool_disconnect ()=
	if ctDBok then
		let _sqliteClose ctDb -> res in
		if res == 0 then
		(
			_DSwindow ctWin;
			set ctDBok = 0
		)
		else
		(
			_SETtext ctTstatus "Process not finished. Please wait ...";
			0
		)
	else
	(
		_DSwindow ctWin;
		0
	);;

fun createTool_connect ()=
	if ((ctDb == nil) && (ctDBok == 0)) then
		set ctDb = _sqliteOpenFile _channel _checkpack _GETtext ctTfile
	else
		nil;
	if ctDb == nil then
	(
		_SETtext ctTstatus _locEditor "test_connection_failed" nil;
		set ctDBok = 0;
	)
	else
	(
		_SETtext ctTstatus _locEditor "test_connection_ok" nil;
		set ctDBok = 1;
	);
	0;;
	
/* fun [S] I
 * Get the list of column names
 */
fun createTool_listColumns (table)=
	set listColumns = nil;
	createTool_reflex @ctCBdbListColumns 0;
	let strcatn "PRAGMA table_info(" :: table :: ");" :: nil -> sql in
	let createTool_exec sql -> res in
	res;;	
	
fun createTool_refreshTables ()=
	createTool_reflex @ctCBdbTables 0;
	ctRSTlist 3;
	if ctDBok then
		let "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name;" -> sql in
		let createTool_exec sql -> res in
		if (res != 0) then
			_SETtext ctTstatus strcat "ERROR : an error occurs, error number : " itoa res
		else
			_SETtext ctTstatus "Tables listed !"
	else
		_SETtext ctTstatus "ERROR : Database is not connected";
	0;;
	
fun createTool_refreshColumns ()=
	createTool_reflex @ctCBdbColumns 0;
	ctRSTlist 2;
	let _GETlist ctLtables -> [_ table] in
	if ctDBok then
		if table != nil then
			// let "SELECT name FROM sqlite_master WHERE type='table' ORDER BY name;" -> sql in
			// select sql from sqlite_master where type = 'table' and name = 'job';
			/* let strcatn "SELECT sql FROM sqlite_master WHERE type = 'tbl_name' and name = '" ::
					table ::
					"';" :: nil -> sql in*/
			/* let "SELECT * FROM sqlite_master WHERE type='table';" -> sql in */
			// let strcatn "select sql from sqlite_master where type = 'table' and tbl_name = '" :: table :: "';" :: nil -> sql in
			let strcatn "PRAGMA table_info(" :: table :: ");" :: nil -> sql in
			let createTool_exec sql -> res in
			if (res != 0) then
				_SETtext ctTstatus strcat "ERROR : an error occurs, error number : " itoa res
			else
				_SETtext ctTstatus "Tables listed !"
		else
			_SETtext ctTstatus "ERROR : No table selected !"
	else
		_SETtext ctTstatus "ERROR : Database is not connected";
	0;;
	
fun createTool_addTable (name)=
	if ctDBok then
		let strcatn "CREATE TABLE " :: name :: " (scol_default char(1));" :: nil -> sql in
		let createTool_exec sql -> res in
		if (res != 0) then
			_SETtext ctTstatus strcat "ERROR : Table not created, error number : " itoa res
		else
			_SETtext ctTstatus "Table added !"
	else
		_SETtext ctTstatus "ERROR : Database is not connected";
	0;;
	
fun createTool_removeTable (name) =
	if ctDBok then
		let strcatn "DROP TABLE " :: name :: ";" :: nil -> sql in
		let createTool_exec sql -> res in
		if (res != 0) then
			_SETtext ctTstatus strcat "ERROR : Table not removed, error number : " itoa res
		else
		(
			createTool_refreshTables;
			_SETtext ctTstatus "Table removed !"
		)
	else
		_SETtext ctTstatus "ERROR : Database is not connected";
	0;;

/* fun [S S S S I I] I 
 * add a column with few restrictions from sql to sqlite.
 * See http://www.sqlite.org/lang_altertable.html
 */	
fun createTool_addColumn (name, type, length, default, notnull, pk)=
	let _GETlist ctLtables -> [_ table] in
	if ctDBok then
		if table != nil then
			if (table == nil) then
				_SETtext ctTstatus "ERROR : No table selected !"
			else if ((!strcmp name "") || (!strcmp type "")) then
				_SETtext ctTstatus "ERROR : Name or type is incorrect !"
			else
				let strcatn "ALTER TABLE " ::
						table ::
						" ADD " ::
						name ::
						" " ::
						type ::
						(if ((length != nil) && (strcmp length "")) then
							strcatn "(" :: length :: ")" :: nil
						else
							"") ::
						" default '" ::
						default ::
						"'" ::
						(if notnull then
							" NOT NULL"
						else
							"") ::
						nil
					-> sql in
				let createTool_exec sql -> res in
				if (res != 0) then
					_SETtext ctTstatus strcat "ERROR : Column not added, error number : " itoa res
				else
					_SETtext ctTstatus "Column added !"
		else
			_SETtext ctTstatus "ERROR : No table selected !"
	else
		_SETtext ctTstatus "ERROR : Database is not connected";
	0;;
	
fun createTool_removeColumn (name)=
	let _GETlist ctLtables -> [_ table] in
	if ctDBok then
		if table != nil then
			if ((name != nil) && (strcmp name "")) then
			let nil -> keptColumns in
			let 0 -> error in
			(
				set tempColonne2 = nil; // groumpf
				createTool_listColumns table;
				createTool_reflex nil 0;
				while (listColumns != nil) do
				(
					let hd listColumns -> [_ cname type notnull default pk] in
					if (strcmp name cname) then
						set keptColumns = strcatn "(" ::
												cname :: " " ::
												type :: " " ::
												default :: " " ::
												(if notnull then
													"NOT NULL "
												else
													"") ::
												(if pk then
													"PRIMARY KEY "
												else
													"") ::
												")," :: keptColumns :: nil
					else
						nil;
					set listColumns = tl listColumns
				);
				set keptColumns = substr keptColumns 0 (strlen keptColumns) - 1;
				let strcatn "CREATE TEMPORARY TABLE " :: 
							table ::
							"_tmp(" ::
							keptColumns ::
							");" :: nil
					-> sql in
				let _fooS strcat "SQL >>>>>>>>>>>> " sql -> _ in
				set error = createTool_exec sql;
				if error != 0 then
					_SETtext ctTstatus strcat "ERROR : create temporary table, error number : " itoa error
				else
				(
					let strcatn "INSERT INTO "::
							table ::
							"_tmp SELECT " ::
							keptColumns ::
							" FROM " ::
							table ::
							";" :: nil
						-> sql in
					set error = createTool_exec sql;
					if error != 0 then
						_SETtext ctTstatus strcat "ERROR : copy table, error number : " itoa error
					else
					(
						let strcatn "DROP TABLE " :: table :: ";" :: nil -> sql in
						set error = createTool_exec sql;
						if error != 0 then
							_SETtext ctTstatus strcat "ERROR : drop table, error number : " itoa error
						else
						(
							let strcatn "CREATE TABLE " ::
									table ::
									"(" ::
									keptColumns ::
									");" :: nil
								-> sql in
							set error = createTool_exec sql;
							if error != 0 then
								_SETtext ctTstatus strcat "ERROR : recreate table, error number : " itoa error
							else
							(
								let strcatn "INSERT INTO " ::
										table ::
										" SELECT " ::
										keptColumns ::
										" FROM " ::
										table ::
										"_tmp;" :: nil
									-> sql in
								set error = createTool_exec sql;
								if error != 0 then
									_SETtext ctTstatus strcat "ERROR : recopy table, error number : " itoa error
								else
								(
									let strcatn "DROP TABLE " ::
											table ::
											"_tmp;" :: nil
										-> sql in
									set error = createTool_exec sql;
									if error != 0 then
										_SETtext ctTstatus strcat "ERROR : remove temporary table, error number : " itoa error
									else
										_SETtext ctTstatus "Column removed !"
								)
							)
						)
					)
				)
			)
			else
				_SETtext ctTstatus "No column selected"
		else
			_SETtext ctTstatus "No table selected !"
	else
		_SETtext ctTstatus "ERROR : Database is not connected";
	0;;

fun createTool_removeField (nameTable, nameColumn, nameField)=
	if ctDBok then
		let strcatn "DELETEFROM " ::
						nameTable ::
						"WHERE " ::
						nameColumn ::
						" = \"" ::
						nameField ::
						"\"" ::
						nil
			-> sql in
		let createTool_exec sql -> res in
		if (res != 0) then
			_SETtext ctTstatus strcat "ERROR : Field not removed, error number : " itoa res
		else
			_SETtext ctTstatus "Field removed !"
	else
		_SETtext ctTstatus "ERROR : Database is not connected";
	0;;
	
	
fun ctCBaddColumnOk (obj, u)=
	let u -> [ctAFwin tname ttype tlen tdflt cnull cpk] in
	(
		createTool_addColumn _GETtext tname _GETtext ttype _GETtext tlen
							_GETtext tdflt _GETcheck cnull _GETcheck cpk;
		_DSwindow ctAFwin;
		0
	);;
	
fun ctCBaddColumn (obj, u)=
	let [300 130] -> [w h] in
	let _CRwindow _channel ctWin 5 5 w h WN_MENU "add a column" -> ctAFwin in
	let (
			_CRtext _channel ctAFwin 5 5 (w/3)-10 20 ET_ALIGN_CENTER "name";
			_CReditLine _channel ctAFwin 5 30 (w/3)-10 20 ET_DOWN|ET_ALIGN_CENTER "";
		) -> tname in
	let (
			_CRtext _channel ctAFwin (w/3)+5 5 (w/3)-10 20 ET_ALIGN_CENTER "type";
			_CReditLine _channel ctAFwin (w/3)+5 30 (w/3)-10 20 ET_DOWN|ET_ALIGN_CENTER "";
		) -> ttype in
	let (
			_CRtext _channel ctAFwin w-(w/3)+5 5 (w/3)-10 20 ET_ALIGN_CENTER "length";
			_CReditLine _channel ctAFwin w-(w/3)+5 30 (w/3)-10 20 ET_DOWN|ET_ALIGN_CENTER|ET_NUMBER "";
		) -> tlen in
	let (
			_CRtext _channel ctAFwin 5 60 (w/3)-10 20 ET_ALIGN_CENTER "default value";
			_CReditLine _channel ctAFwin 5 85 (w/3)-10 20 ET_DOWN|ET_ALIGN_CENTER "";
		) -> tdflt in
	let _CRcheck _channel ctAFwin (w/3)+5 60 (w/3)-10 20 CT_LEFT "not null" -> cnull in
	let _ENcheck
			_CRcheck _channel ctAFwin w-(w/3)+5 60 (w/3)-10 20 CT_LEFT "primary key"
			0
		-> cpk in
	_CBbutton
		_CRbutton _channel ctAFwin 5 h-25 w-10 20 0 "Add immediately"
		@ctCBaddColumnOk
		[ctAFwin tname ttype tlen tdflt cnull cpk];
	0;;
	
fun ctCBaddTableOk (obj, u)=
	let u -> [ctATwin tname] in
	(
		createTool_addTable _GETtext tname;
		createTool_refreshTables;
		_DSwindow ctATwin;
		0
	);;
	
fun ctCBaddTable (obj, u)=
	let [300 80] -> [w h] in
	let _CRwindow _channel ctWin 5 5 w h WN_MENU "add a table" -> ctATwin in
	let (
			_CRtext _channel ctATwin 5 5 w-10 20 ET_ALIGN_CENTER "name";
			_CReditLine _channel ctATwin 5 30 w-10 20 ET_DOWN|ET_ALIGN_CENTER "";
		) -> tname in
	_CBbutton
		_CRbutton _channel ctATwin 5 h-25 w-10 20 0 "Add immediately"
		@ctCBaddTableOk
		[ctATwin tname];
	0;;
	
fun ctRefreshTable (obj, u)=
	createTool_refreshTables;
	0;;
	
fun ctCBrefreshColumn (obj, u)=
	createTool_refreshColumns;
	0;;
	
fun ctCBdelTable (obj, u)=
	let _GETlist ctLtables -> [_ table] in
	if table == nil then
		_SETtext ctTstatus "ERROR : No table selected !"
	else
	(
		createTool_removeTable table;
		nil
	);;
	
fun ctCBdelColumn (obj, u)=
	let _GETlist ctLcolumns -> [_ column] in
	if column != nil then
		createTool_removeColumn column
	else
	(
		_SETtext ctTstatus "ERROR : No column selected !";
		nil
	);;
	
fun ctCBdelField (obj, u)=
	let _GETlist ctLtables -> [_ table] in
	let _GETlist ctLcolumns -> [_ column] in
	let _GETlist ctLfields -> [_ field] in
	if table == nil then
		_SETtext ctTstatus "ERROR : No table selected !"
	else if column == nil then
		_SETtext ctTstatus "ERROR : No column selected !"
	else if field == nil then
		_SETtext ctTstatus "ERROR : No field selected !"
	else
	(
		createTool_removeField table column field;
		nil
	);;

fun ctCBopenFile2 (obj, u, pfile)=
	if pfile == nil then
		nil
	else
	(
		_SETtext ctTfile _PtoScol pfile;
		createTool_connect;
	);
	0;;
	
fun ctCBopenFile (obj, u)=
	if ctDBok == 0 then
	(
		createTool_connect;
		createTool_refreshTables
	)
	else
	(
		_SETtext ctTstatus "ERROR : database already connected !";
		0
	);;

fun ctCBnewFile2 (obj, u, wfile)=
	if (wfile == nil) then
		0
	else
		(
		_SETtext ctTfile _PtoScol _WtoP wfile;
		_SETtext txt_db_file _PtoScol _WtoP wfile;
		_createpack "" wfile;
		createTool_connect;
		);;
		
fun ctCBnewFile (obj, u)=
	_DLGrflsave
		_DLGSaveFile _channel ctWin _GETtext ctTfile nil "All\0*.*\0\0"
		@ctCBnewFile2
		0;
	0;;

fun ctEnd (obj, u)=
	createTool_disconnect;
	0;;

fun createTool_gui ()=
	let [400 825] -> [w h] in
	(
		set ctWin = _CRwindow _channel editWin 50 0 w h WN_MENU _locEditor "tool_creation" nil;
		_CBwinClose ctWin @ctEnd 0;
		_CRtext _channel ctWin 5 5 w-10 50 0 _locEditor "tool_creation_before" nil;
		
		/* base */
		_CRtext _channel ctWin 5 60 w-10 20 ET_ALIGN_CENTER _locEditor "bases" nil;
		set ctTfile = _CReditLine _channel ctWin 5 85 w-180 20 ET_DOWN|ET_AHSCROLL _GETtext txt_db_file;
		_CBbutton
			_CRbutton _channel ctWin w-170 85 80 20 0 _locEditor "open" nil
			@ctCBopenFile
			0;
		_CBbutton
			_CRbutton _channel ctWin w-85 85 80 20 0 _locEditor "create" nil
			@ctCBnewFile
			0;
		
		/* tables */
		_CRtext _channel ctWin 5 110 w-10 20 ET_ALIGN_CENTER _locEditor "tables" nil;
		set ctLtables = _CRlist _channel ctWin 5 135 w-105 200 LB_VSCROLL|LB_BORDER;
		_CBbutton
			_CRbutton _channel ctWin w-95 135 90 20 0 _locEditor "add" nil
			@ctCBaddTable
			0;
		_CBbutton
			_CRbutton _channel ctWin w-95 160 90 20 0 _locEditor "remove" nil
			@ctCBdelTable
			0;
		_CBbutton
			_CRbutton _channel ctWin w-95 185 90 20 0 _locEditor "refresh" nil
			@ctRefreshTable
			0;
			
		/* columns */
		_CRtext _channel ctWin 5 340 w-10 20 ET_ALIGN_CENTER _locEditor "columns" nil;
		set ctLcolumns = _CRlist _channel ctWin 5 365 w-105 200 LB_VSCROLL|LB_BORDER;
		_CBbutton
			_CRbutton _channel ctWin w-95 365 90 20 0 _locEditor "add" nil
			@ctCBaddColumn
			0;
		_CBbutton
			_CRbutton _channel ctWin w-95 390 90 20 0 _locEditor "remove" nil
			@ctCBdelColumn
			0;
		_CBbutton
			_CRbutton _channel ctWin w-95 415 90 20 0 _locEditor "refresh" nil
			@ctCBrefreshColumn
			0;
			
		/* fields */
		_CRtext _channel ctWin 5 h-255 w-10 20 ET_ALIGN_CENTER _locEditor "fields" nil;
		set ctLfields = _CRlist _channel ctWin 5 h-230 w-105 200 LB_VSCROLL|LB_BORDER;
		_CBbutton
			_CRbutton _channel ctWin w-95 h-230 90 20 0 _locEditor "add" nil
			nil
			0;
		_CBbutton
			_CRbutton _channel ctWin w-95 h-205 90 20 0 _locEditor "remove" nil
			@ctCBdelField
			0;
		_CBbutton
			_CRbutton _channel ctWin w-95 h-180 90 20 0 _locEditor "update" nil
			nil
			0;
		_CBbutton
			_CRbutton _channel ctWin w-95 h-155 90 20 0 _locEditor "refresh" nil
			nil
			0;
			
		set ctTstatus = _CRtext _channel ctWin 5 h-25 w-10 20 ET_ALIGN_CENTER "";
	);
	0;;