SajaxTCL is a Sajax [http://www.modernmethod.com/sajax] port in [TCL] written and maintained by [DcK].

Sajax is an open source tool to make programming websites using the [Ajax] framework
also known as XMLHTTPRequest or remote scripting as easy as possible.
----
 # # # # # # # # # # # # # # # # # # # #  # # # # # # # # # # # # # # # # # # # #
 #		_____________________________________________		 #
 #			Espace Win Open Source Project			#
 #		    _____       _	 _______ _____ _		     #
 #		   / ____|     (_)       |__   __/ ____| |		    #
 #		  | (___   __ _ _  __ ___  _| | | |    | |		    #
 #		   \___ \ / _` | |/ _` \ \/ / | | |    | |		    #
 #		   ___ ) | (_| | | (_| |>  <| | | |____| |____		#
 #		  |_____/ \__,_| |\__,_/_/\_\_|  \_____|______|	       #
 #			      _/ |					    #
 #			     |__/					     #
 #		_____________________________________________		 #
 #		TCL port of Sajax,  the AJAX open source tool		 #
 #		  http://www.espace-win.info/EWOSP/SajaxTCL		   #
 #									      #
 #		Sajax is written & maintained by ModernMethod		 #
 #		      http://www.modernmethod.com/sajax		       #
 #		_____________________________________________		 #
 #									      #
 # # # # # # # # # # # # # # # # # # # #  # # # # # # # # # # # # # # # # # # # #
 
 package provide Sajax 0.12

 namespace eval Sajax {}

 #Default values
 #If you don't use $GET and $POST as GET/POST arrays, edit the _array variables.
 array set Sajax {
     version 0.12
     debug_mode 0
     export_list {}
     request_type GET
     remote_uri {}
     failure_redirect {}
     js_has_been_shown 0
     GET_array GET
     POST_array POST
     output_function puts
 }

 proc Sajax::getmyuri {} {
     global env
     return $env(REQUEST_URI)
 }

 #Checks if a string is a natural number
 proc Sajax::isnatural {string} {
     if {([string compare $string ""]) && (![regexp -- \[^0-9\] $string])} {return 1} {return 0}
 }

 #Checks if a string is a float
 proc Sajax::isfloat {string} {
     if [catch {expr {double($string)}}] {return 0} {return 1}
 }

 #Checks if a string is an integer
 proc Sajax::isinteger {string} {
     if {[Sajax::isnatural $string]} {return 1}
     if {[string range $string 0 1] == "- "} {
	 Sajax::isnatural [string range $string 2 end]
     } elseif {[string index $string 0] == "-"} {
	 Sajax::isnatural [string range $string 1 end]
     } {
	 return 0
     }
 }

 proc Sajax::esc {string} {
     regsub -all {\\}    $string {\\\\} newstring
     regsub -all {\r} $newstring {\\r}  newstring
     regsub -all {\n} $newstring {\\n}  newstring
     regsub -all {'}  $newstring {\\'}  newstring
     regsub -all {"}  $newstring {\\"}  newstring
     return $newstring
 }

 proc Sajax::getjsrepr {var} {
     upvar 1 $var data
     if {[array exists data]} {
	 #XXX Arrays with non-numeric indices are not
	 #permitted according to ECMAScript, yet everyone
	 #uses them.. We'll use an object.
	 set js_object "{ "
	 set i 0
	 foreach key [array names data] {
	     if {$i > 0} {append js_object ", "}
	     if {[Sajax::isnatural $key]} {
		 append js_object "$key: "
	     } {
		 append js_object "\"[Sajax::esc $key]\": "
	     }
	     append js_object [Sajax::getjsrepr data($key)]
	     incr i
	 }
	 append js_object " }"
     } elseif {[Sajax::isinteger $var]} {
	 return "parseInt($var)";
     } elseif {[Sajax::isfloat $var]} {
	 return "parseFloat($var)";    
     } {
	 #List, string, ...
	 return "'[Sajax::esc $var]'"
     }
 }

 proc Sajax::inlist {list item} {
     foreach listitem $list {
	 if {$item == $listitem} {return 1}
     }
     return 0
 }

 proc Sajax::die {msg} {
     global Sajax
     $Sajax(output_function) "FATAL ERROR"
     error $msg
 }

 proc Sajax::callproc {proc {procargs ""}} {
     if {$procargs == 0} {
	 $proc
     } {
	 set cmd "$proc "
	 foreach arg [lindex $procargs 0] {
	    append cmd "{$arg} "
	 }
	 eval $cmd
     }
 }

 proc Sajax::init {} {
     global Sajax
     set Sajax(remote_uri) [Sajax::getmyuri]
 }

 proc Sajax::header {header} {
     global Sajax
     #$Sajax(output_function) header
 }

 proc Sajax::handleclientrequest {} {
     global Sajax
     upvar 1 $Sajax(GET_array) GET
     upvar 1 $Sajax(POST_array) POST
     
     if {[array exists GET] && [info exists GET(rs)] && $GET(rs) != ""} {
	 set mode get
     }
     if {[array exists POST] && [info exists POST(rs)] && $POST(rs) != ""} {
	 set mode post
     }
     if {![info exists mode]} {
	 return
     }
    
     if {$mode == "get"} {
	 #HEADERS
	
	 #Bust cache in the head with a date in the past
	 Sajax::header "Expires: Mon, 26 Jul 1997 05:00:00 GMT"
	 Sajax::header "Last-Modified: [clock format [unixtime] -format "%a, %d %b %Y %H:%M:%S" -gmt true] GMT"
	 #Always modified
	 Sajax::header "Cache-Control: no-cache, must-revalidate"
	 Sajax::header "Pragma: no-cache"
	 set procname $GET(rs)
	 set procargs $GET(rsargs)
     } {
	 set procname $POST(rs)
	 set procargs $POST(rsargs)
     }
    
     #Checks if this function is specified and has been exported
     if {![Sajax::inlist $Sajax(export_list) $procname]} {
	 Sajax::die "$procname is not a callable function"
     }

     if {[catch {set result [Sajax::callproc $procname $procargs]} message]} {Sajax::die $message}
     $Sajax(output_function) "+:var res = [Sajax::getjsrepr $result]; res;"
    
     exit
 } 

 proc Sajax::truefalse {bool} {
     if {$bool} {return "true"} {return "false"}
 }

 proc Sajax::showcommonjs {} {
     global Sajax
     $Sajax(output_function) [Sajax::getcommonjs]
 }

 proc Sajax::getcommonjs {} {
     global Sajax;
     set Sajax(request_type) [string toupper $Sajax(request_type)]
     if {($Sajax(request_type) != "GET") && ($Sajax(request_type) != "POST")} {
	 return "// Invalid type: Sajax(request_type)\n\n"
     }
     return  "
	urn  "
	// remote scripting library
	// (c) copyright 2005 modernmethod, inc
	// (c) copyright 2005 modernmethod, inc
	var sajax_debug_mode = [Sajax::truefalse $Sajax(debug_mode)];
	var sajax_request_type = '$Sajax(request_type)';
	var sajax_target_id = '';
	var sajax_failure_redirect = '$Sajax(failure_redirect)';
	var sajax_failure_redirect = '$Sajax(failure_redirect)';
	function sajax_debug(text) {
		if (sajax_debug_mode)
			alert(text);
	}
	}
	function sajax_init_object() {
		sajax_debug('sajax_init_object() called..')
		sajax_debug('sajax_init_object() called..')
		var A;
		var A;
		var msxmlhttp = new Array(
			'Msxml2.XMLHTTP.5.0',
			'Msxml2.XMLHTTP.4.0',
			'Msxml2.XMLHTTP.3.0',
			'Msxml2.XMLHTTP',
			'Microsoft.XMLHTTP');
		for (var i = 0; i < msxmlhttp.length; i++) {
			try {
				A = new ActiveXObject(msxmlhttp\[i\]);
			} catch (e) {
				A = null;
			}
		}
		}
		if(!A && typeof XMLHttpRequest != 'undefined')
			A = new XMLHttpRequest();
		if (!A)
			sajax_debug('Could not create connection object.');
		return A;
	}
	}
	var sajax_requests = new Array();
	var sajax_requests = new Array();
	function sajax_cancel() {
		for (var i = 0; i < sajax_requests.length; i++) 
			sajax_requests\[i].abort();
	}
	}
	function sajax_do_call(func_name, args) {
		var i, x, n;
		var uri;
		var post_data;
		var target_id;
		var target_id;
		sajax_debug('in sajax_do_call()..' + sajax_request_type + '/' + sajax_target_id);
		target_id = sajax_target_id;
		if (typeof(sajax_request_type) == 'undefined' || sajax_request_type == '') 
			sajax_request_type = 'GET';
			sajax_request_type = 'GET';
		uri = '$Sajax(remote_uri)';
		if (sajax_request_type == 'GET') {
		if (sajax_request_type == 'GET') {
			if (uri.indexOf('?') == -1) 
				uri += '?rs=' + escape(func_name);
			else
				uri += '&rs=' + escape(func_name);
			uri += '&rst=' + escape(sajax_target_id);
			uri += '&rsrnd=' + new Date().getTime();
			uri += '&rsrnd=' + new Date().getTime();
			uri += '&rsargs={'
			for (i = 0; i < args.length-1; i++) 
				uri += '{' + escape(args\[i]) + '} ';
			uri += '}';
			post_data = null;
		} 
		else if (sajax_request_type == 'POST') {
			post_data  = 'rs=' + escape(func_name);
			post_data += '&rst=' + escape(sajax_target_id);
			post_data += '&rsrnd=' + new Date().getTime();
			post_data += '&rsargs={'
			post_data += '&rsargs={'
			for (i = 0; i < args.length-1; i++) 
				post_data += '{' + escape(args\[i]) + '} ';
			post_data += '}';
		}
		else {
			alert('Illegal request type: ' + sajax_request_type);
		}
		}
		x = sajax_init_object();
		if (x == null) {
			if (sajax_failure_redirect != '') {
				location.href = sajax_failure_redirect;
				return false;
			} else {
				sajax_debug('NULL sajax object for user agent: ' + navigator.userAgent);
				return false;
			}
		} else {
			x.open(sajax_request_type, uri, true);
			// window.open(uri);
			// window.open(uri);
			sajax_requests\[sajax_requests.length] = x;
			sajax_requests\[sajax_requests.length] = x;
			if (sajax_request_type == 'POST') {
				x.setRequestHeader('Method', 'POST ' + uri + ' HTTP/1.1');
				x.setRequestHeader('Content-Type', 'application/x-www-form-urlencoded');
			}
			}
			x.onreadystatechange = function() {
				if (x.readyState != 4) 
					return;

				sajax_debug('received ' + x.responseText);
				sajax_debug('received ' + x.responseText);
				var status;
				var data;
				var txt = x.responseText.replace(/^\s*|\s*$/g,'');
				status = txt.charAt(0);
				data   = txt.substring(2);

				if (status == '') {
					// let's just assume this is a pre-response bailout and let it slide for now
				} else if (status == '-') 
					alert('Error: ' + data);
				else {
					if (target_id != '') 
						document.getElementById(target_id).innerHTML = eval(data);
					else {
						try {
							var callback;
							var extra_data = false;
							if (typeof args\[args.length-1] == 'object') {
								callback = args\[args.length-1].callback;
								extra_data = args\[args.length-1].extra_data;
							} else {
								callback = args\[args.length-1];
							}
							callback(eval(data), extra_data);
						} catch (e) {
							sajax_debug('Caught error ' + e + ': Could not eval ' + data );
						}
					}
				}
			}
		}
		}
		sajax_debug(func_name + ' uri = ' + uri + '/post = ' + post_data);
		x.send(post_data);
		sajax_debug(func_name + ' waiting..');
		delete x;
		return true;
	}
    "
 }

 proc Sajax::getonestub {proc_name} {
    return "

    // wrapper for $proc_name
    
    function x_$proc_name () {
	sajax_do_call('$proc_name', x_$proc_name.arguments);
    }
    "
 }

 proc Sajax::showonestub {proc_name} {
     global Sajax
     $Sajax(output_function) [Sajax::getonestub $proc_name]
 }

 proc Sajax::export {procs} {
    global Sajax
    foreach proc $procs {
	lappend Sajax(export_list) $proc
    }
 }

 proc Sajax::getjavascript {} {
    global Sajax
    if {!$Sajax(js_has_been_shown)} {
	append html [Sajax::getcommonjs]
	set js_has_been_shown 1
    }
    foreach proc $Sajax(export_list) {
	append html [Sajax::getonestub $proc]
    }
    return $html
 }

 proc Sajax::showjavascript {} {
    global Sajax
    $Sajax(output_function) [Sajax::getjavascript]
 }

----
!!!!!!
%| [Category Application] | [Category Internet] | [Category Ajax] |%
!!!!!!