go to post Rodrigo Werneck · Jan 17, 2022 Two bug fixes: Reset $Test wherever needed Adjust position of posts commands in the case of IF ... DO: %zDot2Braces(routine,indent=4) NEW (routine,indent) SET S=$CHAR(127) SET lineNumber=0 KILL level SET level=0 SET rm=##class(%Regex.Matcher).%New("dummy") KILL postCommands,whileLoop SET sc=##class(%Atelier.v2.Utils.TextServices).GetTextAsArray(routine,0,.moduleTextArray) IF 'sc DO $system.OBJ.DisplayError(sc) KILL:moduleTextArray(1)?1"ROUTINE [Type=".E moduleTextArray(1) SET instr=##class(%Stream.TmpCharacter).%New() FOR { SET lineNumber=$order(moduleTextArray(lineNumber),1,line) QUIT:lineNumber="" QUIT:lineNumber'=+lineNumber DO instr.WriteLine(line) } SET colorer=##class(%SyntaxColor).%New() SET outstr=##class(%Stream.TmpCharacter).%New() SET sc=colorer.Color(instr,outstr,$select($zconvert($piece(routine,".",*),"U")="CLS":"CLS",1:"COS"),"Q=N",,,.langs,.coloringerrors) IF 'sc { WRITE "Fatal error: ",colorer.DLLResultCode,! Return } IF coloringerrors { WRITE "Syntax error(s)",! Return } Set lastPostCommands="" FOR lineNumber=1:1 { SET line=$$getParsedLine(.cmdpos) QUIT:line=-1 SET midCode="" SET lineLevel=$$lineLevel(line) FOR i=1:1:$length(line) quit:" "_$CHAR(9)'[$EXTRACT(line,i) SET lineMargin=$extract(line,1,i-1),line=$extract(line,i,*) Set postDone="" WHILE lineLevel<level { Set lastLineMargin=$P(level(level),S,2) FOR i=1:1:$P(level(level),S,1) { WRITE lastLineMargin,$justify("",(level-1)*indent),$select(lastLineMargin=""&(level'>1):" ",1:""),"}" IF $get(whileLoop(level)) { WRITE " While 0" KILL whileLoop(level) } IF i=($P(level(level),S,1)-1),$LENGTH($zstrip($get(postCommands(level)),"<>W")) { WRITE !,lastLineMargin,$justify("",(level)*indent),postCommands(level) Set lastPostCommands=postCommands(level) KILL postCommands(level) } WRITE ! } SET level=level-1 Set postDone=1 } SET line=$$codeQuotedSpaces(line) SET posDo=$locate(line,"\b[dD][oO]? ") SET:'posDo posDo=$locate(line,"\b[dD][oO]? *$") SET:'posDo posDo=$locate(line,"\b[dD][oO]?:[^ ]+ ") SET:'posDo posDo=$locate(line,"\b[dD][oO]?:[^ ]+ *$") Set nextCmd="" SET braceLevel=0 IF posDo||(cmdpos && ('$G(cmdpos("FCWB"))&&("iIeE"[$extract(line,$o(cmdpos(""))-$length(lineMargin))))) { Set ELSEcmd="" IF cmdpos>1 { SET cpos=9999,posEndCmd=$select($data(cmdpos("E"),payloadEnd):payloadEnd,1:$length(lineMargin_line)) Set originalLine=line Set oldElse="" Set lastCmd=1 FOR { SET cpos=$order(cmdpos(cpos),-1) QUIT:cpos="" Set cmd=$extract(line,cpos-$length(lineMargin),posEndCmd-$length(lineMargin)) IF ('posDo||((cpos-$length(lineMargin))<posDo))&("iIfF"[$extract(cmd))&('lastCmd!'$locate(cmd,"[iI][fF]? 1")) { SET $extract(line,posEndCmd-$length(lineMargin)) = $extract(line,posEndCmd-$length(lineMargin))_" { " SET braceLevel=braceLevel + 1 } IF $locate(cmd,"[eE]([lL][sS][eE])? ") { IF $locate(lastPostCommands,"\b[iI][fF]? ") { IF nextCmd?1(1"i",1"I").E { SET $extract(line,cpos-$length(lineMargin),cpos-$length(lineMargin)+$length(cmd)+$length(nextCmd))="If '$Test , " } ELSE { SET $extract(line,cpos-$length(lineMargin),cpos-$length(lineMargin)+$length(cmd)-1)="If '$Test { " SET braceLevel=braceLevel + 1 } Set ELSEcmd=1 } ELSE { IF nextCmd?1(1"i",1"I").E { SET $extract(line,cpos-$length(lineMargin),cpos-$length(lineMargin)+$length(cmd)+$length(nextCmd))="ElseIf " } ELSE { SET $extract(line,cpos-$length(lineMargin),cpos-$length(lineMargin)+$length(cmd)-1)="Else { " SET braceLevel=braceLevel + 1 } } Set lastPostCommands = "" SET:1 oldElse=1 } Set nextCmd="" FOR i=0:1 Set carCmd=$extract(line,cpos+i-$length(lineMargin)) q:carCmd'?1A SET nextCmd=nextCmd_carCmd SET posEndCmd = cpos - 1 SET lastCmd = 0 } ; Set:postDone&'posDo&'oldElse line=originalLine,braceLevel=0 } If posDo&cmdpos { SET posFor=$locate(line,"\b[fF]([oO][rR])? .*") SET:'posFor posFor=$locate(line,"\b[fF]([oO][rR])? [%A-Za-z][A-Za-z0-9]* ?=") FOR pat="\b[dD][oO]? ","\b[dD][oO]?:([^ ]+) ","\b[dD][oO]? *$","\b[dD][oO]?:([^ ]+) *$" { SET rm.Pattern=pat SET rm.Text=line SET line=rm.ReplaceFirst($select($find(pat,":"):"If $1 { ",1:"")_"Do {") SET:rm.Locate(1) braceLevel=braceLevel+$select($find(pat,":"):2,1:1) SET whileLoop(level+1)=1 } SET postCommands(level+1) = $translate($piece(line,"{",*),S," ") SET line=$piece(line,"{",1,*-1)_"{ " IF $locate(postCommands(level+1),"\b[iI][fF]? ")&'ELSEcmd { WRITE $replace(lineMargin_$JUSTIFY("",level*indent)_"Set $Test=0",$char(9)," "),! } } } SET line=$translate(line,S," ") WRITE $replace(lineMargin_$JUSTIFY("",level*indent)_$zstrip($piece(line,".",level+1,*),"<W"),$char(9)," "),! WRITE:$LENGTH(midCode) $replace(lineMargin_$JUSTIFY("",(level+1)*indent)_midCode,$CHAR(9)," "),! SET:posDo!(braceLevel) level=level+1,level(level)=braceLevel_S_lineMargin } QUIT lineLevel(line) NEW (line) SET line=$translate(line," "_$CHAR(9),"") FOR i=1:1 quit:$extract(line,i)'="." QUIT i-1 codeQuotedSpaces(line) NEW (line) SET S=$CHAR(127) SET quoting="" FOR i=1:1:$length(line) { SET c=$extract(line,i) IF c="""" { SET quoting='quoting } ElseIf c=" ""ing { SET c=S } SET $extract(line,i)=c } QUIT line getParsedLine(vetpos) KILL vetpos Set vetpos=0 SET recLine="",cmdCount=0 Do { SET token=$zstrip(outstr.ReadLine(),"<>W") } WHILE token'="<line>"&'outstr.AtEnd RETURN:outstr.AtEnd -1 FOR { SET token=$zstrip(outstr.ReadLine(),"<>W") QUIT:outstr.AtEnd QUIT:token="</line>" SET rm.Pattern="<([^>]*)>(.*)<\/([^>]*)>$" IF rm.Match(token) { SET:rm.Group(1)="Command" vetpos($LENGTH(recLine)+1)="",cmdCount = cmdCount+1 Set:rm.Group(1)="Comment" vetpos("E")=$LENGTH(recLine) Set:(cmdCount=1)&(rm.Group(1)="Brace")&(rm.Group(2)="{") vetpos("FCWB")=1 SET recLine = recLine_$ZCONVERT(rm.Group(2),"I","HTML") } } SET vetpos=cmdCount RETURN recLine
