*! version 2.1.1 PR 12Jan98. program define for211 version 5.0 /* Note: $FOR_* used instead of $S_* macros internally to avoid messing up access to $S_* via %%*. */ split ":" "`*'" if "$FOR_1"=="" { global FOR_2 di in red "for-list empty" exit 198 } if "$FOR_2"=="" { errexit "command" } /* Substitute hashes for spaces in the stata_cmd(s) */ parse "$FOR_2", parse(" ") while "`1'"!="" { local cmdhash "`cmdhash'`1'" if "`2'"!="" { local cmdhash "`cmdhash'#" } mac shift } /* Extract for optionlist, heralded by the first single comma */ split "," "$FOR_1" local optlist "$FOR_2" /* Get the forlist(s). "\" is a reserved char here; double \ does not work. */ local nlist 0 if "$FOR_1"!="" { local i 1 parse "$FOR_1", parse(" \") while "`1'"!="" { if "`1'"=="\" { local i=`i'+1 } else { local forl`i' "`forl`i'' `1'" } mac shift } if trim("`forl`i''")=="" { errexit "$FOR_1" } local nlist `i' /* no. of lists */ } *?? The cmdsep, macro() and mstub() options, inherited from -forx-, *?? are not documented in the help file, nor is the multiple stata_cmd *?? facility. These features still work. #delimit ; local options "Any noHeader noStop Pause Ltype(str) Cmdsep(str) Quote(str) Numeric MAcro(str) MStub(str)" ; #delimit cr parse ", `optlist'" if "`ltype'"=="" { if "`any'"!="" { local ltype a } else if "`numeric'"!="" { local ltype n } else local ltype v } else { if "`any'`numeric'"!="" { errexit "options, any and numeric not allowed with ltype" } } if `nlist'==0 & "`ltype'"!="" { errexit "ltype, no forlist(s) specified" } local tlen : word count `ltype' if `tlen'>`nlist' & `nlist'>0 { errexit "ltype(`ltype'), number of items should be <=`nlist'" } if length("`cmdsep'")>1 | "`cmdsep'"=="\" { errexit "cmdsep(`cmdsep')" } if "`cmdsep'"=="" { local cmdsep "/" } if "`macro'"=="" { local sub "%%" } else local sub `macro' if "`mstub'"=="" { local mstub "S_" } local sublen=length("`sub'") if length("`quote'")>1 { errexit "quote(`quote')" } local ll 1 local ltypes "varlist numeric any" local i 1 local prev: word 1 of `ltype' while `i'<=`nlist' { local w : word `i' of `ltype' local t `w' if "`t'"=="" { local t `prev' } /* pad with most recent list type */ if length("`t'")>7 { errexit "`w'" } local done 0 parse "`ltypes'", parse(" ") while "`1'"!="" & !`done' { local done=("`t'"==substr("`1'", 1, length("`t'"))) mac shift } if !`done' { errexit "`w'" } local t=substr("`t'",1,1) local prev `t' local any`i'=("`t'"=="a") if "`t'"=="n" { lexp `forl`i'' local forl`i' $FOR_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' { errexit "`forl`i'', inconsistent list lengths" } } local ll0 `ll' local i=`i'+1 } /* Break up `cmdhash' into component Stata cmds according to double `cmdsep' */ local s local slash 0 local i 0 parse "`cmdhash'", parse("`cmdsep'") while "`1'"!="" { if "`1'"=="`cmdsep'" { if `slash' { local i=`i'+1 local cmd`i' `s' local s local slash 0 } else local slash 1 } else { if `slash' { local s "`s'`cmdsep'" local slash 0 } local s "`s'`1'" } mac shift } if "`s'"!="" { if `slash' { local s "`s'`cmdsep'" } local i=`i'+1 local cmd`i' "`s'" } local ncmd `i' /* 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 } /* Run thru the Stata cmds (indexed by j) */ local j 0 while `j'<`ncmd' { local j=`j'+1 parse "`cmd`j''", parse("@#") local cmd local a 0 while "`1'"!="" { if "`1'"=="#" { if "`2'"!="" { local 1 " " } else local 1 /* chop trailing space */ } if "`1'"=="@" { local a 1 if "`2'"=="@" { local 1 1 } if "`2'"=="" { local 2 1 } } if "`1'"!="@" { if !`a' { local cmd "`cmd'`1'" } else { local arg=substr("`1'",1,1) cap confirm integer num `arg' if _rc { /* @ found */ local arg 1 local p1 1 } else local p1 2 if `arg'==0 { local arg 10 } if `arg'>`nlist' { errexit "@`arg'" } plsp "`1'" `p1' /* preserve ld space */ local c=substr("`1'",`p1',.) local cmd "`cmd'`for`arg''${FOR_1}`c'" local a 0 } } mac shift } local c "`cmd'" local c2 local s=index("`cmd'","`sub'") while `s'>0 { local s2=`s'+`sublen' * plsp "`c'" `s2' * if "$FOR_1"!="" { errexit "macro name in `c'" } local fchar=substr("`c'",`s2',1) plsp "`c'" 1 local c1=substr("`c'",1,`s'-1)+"\${`mstub'`fchar'}" local c2 "`c2'${FOR_1}`c1'" local s2=`s2'+1 local csp=substr("`c'",`s2',1)==" " plsp "`c'" `s2' local c=substr("`c'",`s2',.) local c "${FOR_1}`c'" local s=index("`c'","`sub'") } local cmd "`c2'`c'" if "`header'"=="" { di if `ncmd'==1 { di in bl "-> `cmd'" } else di in bl "-> [`j'] `cmd'" } /* Fragment that differs between for210.ado and for211.ado. Multiple quote aupport now fixed (29Oct97). */ if "`quote'"!="" { local iq=index("`cmd'","`quote'") if `iq'>0 { local OrigCmd "`cmd'" /* original */ local RemCmd "`cmd'" /* remaining */ local cmd /* rebuild */ } while `iq'>0 { *?? next few commands with substr() may need the plsp treatment *?? to avoid problems with leading spaces local Cmd1=substr("`RemCmd'",1,`iq'-1) local Cmd2=substr("`RemCmd'",`iq'+1,.) local iq2=index("`Cmd2'","`quote'") if `iq2'==0 { errexit "`OrigCmd', unmatched quotes" } local Cmd3=substr("`Cmd2'",`iq2'+1,.) local Cmd2=substr("`Cmd2'",1,`iq2'-1) local cmd `cmd'`Cmd1'"`Cmd2'" local RemCmd "`Cmd3'" local iq=index("`RemCmd'","`quote'") if `iq'==0 { /* finish cmd and end */ local cmd `cmd'`Cmd3' } } } if "`stop'"!="" { capture noisily `cmd' if _rc { if _rc==1 { global FOR_1 global FOR_2 exit 1 } di in blue "r(" _rc ");" } } else { `cmd' } if "`pause'"!="" { more } } local pos=`pos'+1 } if "`quote'"!="" & "`header'"=="" { di in bl _n "[Quote character is " in ye "`quote'" in bl "]" } global FOR_1 global FOR_2 end program define lexp /* based on modified reshape.rsgroup program */ parse "`*'", parse(" -") confirm integer number `1' global FOR_1 `1' if "`2'"=="" { exit /* returns a single integer */ } if "`3'"=="" { confirm integer number `2' global FOR_1 "`1' `2'" exit /* returns integer1 integer2 */ } 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'"!="" { errexit "syntax" } if `aj'<=`last' { errexit "syntax" } local i=`last'+`inc' while `i'<=`aj' { global FOR_1 "$FOR_1 `i'" local i=`i'+`inc' } local last `aj' } else { confirm integer number `aj' global FOR_1 "$FOR_1 `aj'" local last `aj' } local j=`j'+1 } end program define split /* split splitchar string */ * Also translates double schar to single schar. local schar "`1'" mac shift if index("`*'","`schar'`schar' ") { di in bl /* */ "[warning: trailing space(s) removed from `schar'`schar']" } 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 } else { while "`1'"!="" { local c "`c'`1'" mac shift } } } global FOR_1 "`s'" global FOR_2 "`c'" end program define plsp /* preserve leading spaces */ * 1=string, 2=position to scan from. global FOR_1 local i `2' while substr("`1'",`i',1)==" " { global FOR_1 " $FOR_1" local i=`i'+1 } end program define errexit noi di in red "invalid `1'" global FOR_1 global FOR_2 exit 197 end