*! version 1.1.1 PR 25Jan96.			(STB30: ip8.1)
program define for3 /* list [\list [\list...]] [, options] : stata_cmd */
	version 4.0
	split ":" "`*'"
	if "$S_1"=="" | "$S_2"=="" { error 198 }
	local forstuf "$S_1"
/*
	Substitute hashes for spaces in the stata_cmd
*/
	parse "$S_2", parse(" ")
	while "`1'"!="" {
		local cmdhash "`cmdhash'`1'#"
		mac shift
	}
/*
	Pull out the for3 optionlist, heralded by the first single comma
*/
	split "," "`forstuf'"
	if "$S_1"=="" { error 198 }
	local optlist "$S_2"
/*
	Get the forlist(s).
	"\" is a reserved char here; double \ does not work.
*/
	local i 1
	parse "$S_1", parse(" \")
	while "`1'"!="" {
		if "`1'"=="\" {
			local i=`i'+1
		}
		else {
			local forl`i' "`forl`i'' `1'"
		}
		mac shift
	}
	if trim("`forl`i''")=="" { error 198 }
	local nlist `i' /* no. of lists */
	local options "noHeader noStop Pause Ltype(str)"
	parse ", `optlist'"
	if "`ltype'"=="" { local ltype v }
	local tlen : word count `ltype'
	if `tlen'>`nlist' {
		di in red /*
	*/ "too many items in ltype(`ltype'), should be <=`nlist'"
		exit 198
	}
	local i 1
	while `i'<=`nlist' {
		local w : word `i' of `ltype'
		local t `w'
		if "`t'"=="" { local t v } /* pad with v(ar)s */
		local t=substr("`t'",1,1)
		if "`t'"!="v" & "`t'"!="a" & "`t'"!="n" {
			di in red "invalid `w'"
			exit 198
		}
		local any`i'=("`t'"=="a")
		if "`t'"=="n" {
			lexp `forl`i''
			local forl`i' $S_1
			local t "a"
		}
		if "`t'"!="a" {
			local varlist "req ex" 
			parse "`forl`i''"
			local forl`i' "`varlist'"
		}
		local ll : word count `forl`i''
		if `i'>1 {
			if `ll'!=`ll0' {
				di in red "inconsistent list lengths"
				exit 198
			}
		}
		local ll0 `ll'
		local i=`i'+1
	}
/*
	pos indexes the position reached in each forlist
*/
	local pos 1
	while `pos'<=`ll' {
		local i 1
		while `i'<=`nlist' {
			parse "`forl`i''", parse(" ")
			local f "``pos''" /* pos'th item in i'th list */
			if `any`i'' {
				parse "`f'", parse("#")
				local f
				while "`1'"!="" {
					if "`1'"=="#" { local f "`f' " }
					else local f "`f'`1'"
					mac shift
				}
			}
			local for`i' "`f'"
			local i=`i'+1
		}
		parse "`cmdhash'", parse("@#")
		local cmd
		while "`1'"!="" {
			local a 1
			if "`1'"=="#" {
				if "`2'"!="" { local cmd "`cmd' " }
			}
			else {
				while "``a''"=="@" {
					local a=`a'+1
				}
				if `a'>1 {
					local a=`a'-1
					local cmd "`cmd'`for`a''"
				}
				else {
					local cmd "`cmd'`1'"
				}
			}
			mac shift `a'
		}
		di
		if "`header'"=="" {
			di in bl "-> `cmd'"
		}
		if "`stop'"!="" {
			capture noisily `cmd'
			if _rc {
				if _rc==1 { exit 1 }
				di in blue "r(" _rc ");"
			}
		}
		else {
			`cmd'
		}
		if "`pause'"!="" { more }
		local pos=`pos'+1
	}
end
program define lexp /* based on modified reshape.rsgroup program */
	parse "`*'", parse(" -")
	if "`3'"=="" { error 198 } 
	confirm integer number `1'
	global S_1 `1'
	local last `1'
	mac shift
	local j 1
	while "``j''"!="" {
		local arg`j' ``j''
		local j=`j'+1
	}
	local j 1
	while "`arg`j''"!="" {
		local aj `arg`j''
		if "`aj'"=="-" {
			local j=`j'+1
			parse "`arg`j''", parse(" /")
			local aj `1'
			confirm integer number `aj'
			mac shift
			local inc 1
			if "`1'"=="/" {
				mac shift
				confirm integer number `1'
				local inc `1'
				mac shift
			}
			if "`1'"!="" { error 111 }

			if `aj'<=`last' { error 198 }
			local i=`last'+`inc'
			while `i'<=`aj' {
				global S_1 "$S_1 `i'"
				local i=`i'+`inc'
			}
			local last `aj'
		}
		else {
			confirm integer number `aj'
			global S_1 "$S_1 `aj'"
			local last `aj'
		}
		local j=`j'+1
	}
end

program define split /* split splitchar string */
* Translates double schar to single schar
	local schar "`1'"
	mac shift
	parse "`*'", parse("`schar'")
	local split 0
	local done 0
	while "`1'"!="" & !`done' {
		if "`1'"=="`schar'" {
			if `split' {
				local split 0
				local s "`s'`schar'" /* schar schar -> schar */
			}
			else local split 1 /* note schar */
		}
		else {
			if `split' { local done 1 } /* schar then not schar */
			else local s "`s'`1'"
		}
		if !`done' { mac shift }
	}
	global S_1 `s'
	global S_2 `*'
end