*! version 1.0.0 JW 02Oct98 STB-49 gr36 * -- modified after version 2.0.1 of -for- by PR * modifications are contained in jw+/jw- switches for ease of * updating to a new version of -for- program define forgraph 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. /* jw+ */ *local options "Any noHeader noStop Pause Ltype(str) Cmdsep(str) Quote(str) MAcro(str) MStub(str)" local options "Any noHeader noStop noPause Ltype(str) Cmdsep(str) Quote(str) MAcro(str) MStub(str) MARgin(int 0) SAving(str) TItle(str) TSize(int 0)" /* jw- */ parse ", `optlist'" if `nlist'==0 & "`ltype'"!="" { errexit "ltype, no forlist(s) specified" } if "`ltype'"=="" { if "`any'"!="" { local ltype a } else local ltype v } else { if "`any'"!="" { errexit "options, any not allowed with ltype" } } 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 i 1 local prev v while `i'<=`nlist' { local w : word `i' of `ltype' local t `w' if "`t'"=="" { local t `prev' } /* pad with most recent list type */ local t=substr("`t'",1,1) if "`t'"!="v" & "`t'"!="a" & "`t'"!="n" { errexit "`w'" } 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 prev `t' 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' /* jw+ */ if "`pause'" == "" { di in bl "Graphics are temporarily switched off" di in bl "If an error occurs, you may have to 'set graphics on' again" set graphics off } local txtsize : set textsize if `tsize'==0 { local tsize `txtsize' } set textsize `tsize' /* jw- */ /* pos indexes the position reached in each forlist */ local pos 1 while `pos'<=`ll' { /* jw + */ tempfile file`pos' local flist "`flist' `file`pos''" /* jw - */ 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 /* jw+ */ * saving() is only appended Only to first cmd if `j'==1 { local gopt "saving(`file`pos'')" } else local gopt /* jw- */ 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'" } local iq 0 if "`quote'"!="" { local iq=index("`cmd'","`quote'") if `iq'>0 { *?? next few commands with substr() may need the plsp treatment *?? to avoid problems with leading spaces local Cmd1=substr("`cmd'",1,`iq'-1) local Cmd2=substr("`cmd'",`iq'+1,.) local iq2=index("`Cmd2'","`quote'") if `iq2'==0 { errexit "`cmd', unmatched quotes" } local Cmd3=substr("`Cmd2'",`iq2'+1,.) local Cmd2=substr("`Cmd2'",1,`iq2'-1) } } if "`stop'"!="" { if `iq'>0 { capture noisily `Cmd1'"`Cmd2'"`Cmd3' `gopt' } else capture noisily `cmd' `gopt' if _rc { if _rc==1 { global FOR_1 global FOR_2 exit 1 } di in blue "r(" _rc ");" } } else { if `iq'>0 { cap noi `Cmd1'"`Cmd2'"`Cmd3' `gopt' } else `cmd' `gopt' } if "`pause'"~="" { more } } local pos=`pos'+1 } if "`quote'"!="" & "`header'"=="" { di in bl _n "[Quote character is " in ye "`quote'" in bl "]" } /* jw+ */ if "`margin'" ~= "" { local margin margin(`margin') } if "`saving'" ~= "" { local saving saving(`saving') } if "`title'" ~= "" { local title title(`title') } set graphics on set textsize `txtsize' graph using `flist', `margin' `saving' `title' /* jw- */ 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