View source for TMGIDE.m

        ;"------------------------------------------------------------
        ;"------------------------------------------------------------
        ;"
        ;" GT.M STEP TRAP
        ;"
        ;" K. Toppenberg
        ;" 4-13-2005
        ;" License: GPL Applies
        ;" 
        ;" This code module will allow tracing through code.
        ;" It is used as follows:
        ;"
        ;" set $ZSTEP="do STEPTRAP^TMGTRSTP($ZPOS) zstep into zcontinue"
        ;" zstep into
        ;" do ^MyFunction   ;"<--- put the function you want to trace here
        ;"
        ;" set $ZSTEP=""  ;"<---turn off step capture
        ;" quit
        ;"
        ;"
        ;" Dependencies:
        ;"   Uses TMGTERM
        ;"
        ;"Notes:
        ;"  This function will be called inbetween lines of the main 
        ;"  program that is being traced.  Thus is function can't do
        ;"  anything that might change the environment of the main
        ;"  program.  This includes accessing global variables --
        ;"  because it will mess up the "naked reference".
        ;"------------------------------------------------------------
        ;"------------------------------------------------------------
        
     STEPTRAP(Pos)
                ;"Purpose: This is the line that is called by GT.M for each zstep event.
                ;"	It will be used to display the current code execution point, and 
                ;"	query user as to plans for future execution: run/step/ etc.
        
        new tpBlankLine
        new tpAction
        new tpKeyIn
        new tpRunMode,tpStepMode
        new tpI
        new tpDone
        new result set result=1  ;1=step into, 2=step over
        
        ;"Run modes: 0=running mode  
        ;"           1=stepping mode 
        ;"           2=Don't show code 
        ;"	    3=running SLOW mode
        ;"          -1=quit
        
        set tpRunMode=$get(TMGRunMode,1)
        set tpStepMode=$get(TMGStepMode,"into")
        
        new ScrHeight,ScrWidth
        set ScrHeight=$get(TMGScrHeight,10)
        set ScrWidth=$get(TMGScrWidth,80)
        
        set tpBlankLine=" "
        for tpI=1:1:ScrWidth-1 set tpBlankLine=tpBlankLine_" "
        
        do VCUSAV2^TMGTERM
        if tpRunMode'=2 do
        . do ShowCodePos(Pos,ScrWidth,ScrHeight)
        else  do
        . do CUP^TMGTERM(1,2)
        write tpBlankLine,!
        write tpBlankLine,!
        do CUU^TMGTERM(2)
        
        if (tpRunMode=0)!(tpRunMode=3)!(tpRunMode=2) do
        . write tpBlankLine,!
        . do CUU^TMGTERM(1)
        . write "(Press any key to pause)",!
        . read *tpKeyIn:0
        . if (tpKeyIn>0) set tpRunMode=1
        . else  if tpRunMode=3 hang 1
        
        if tpRunMode=2 goto SPDone ;"Don't showmode --> goto SPDone
        
        set tpDone=0
        if tpRunMode=1 for  do  quit:tpDone=1
        . new DefAction set DefAction="O"
        . do ShowCodePos(Pos,ScrWidth,ScrHeight)
        . do CUP^TMGTERM(1,ScrHeight+4) ;"Cursor to line (x,y) 
        . write tpBlankLine,!
        . do CUU^TMGTERM(1)
        . write "Action (? for help): "
        . if tpStepMode="into" write "step INTO// " set DefAction="I"
        . else  write "step OVER// " set DefAction="O"
        . read tpAction,!
        . if tpAction="" set tpAction=DefAction
        . if "rR"[tpAction do  quit
        . . set tpRunMode=0
        . . set tpDone=1
        . if "lL"[tpAction do  quit
        . . set tpRunMode=3
        . . set tpDone=1
        . if "mM"[tpAction do  quit
        . . write tpBlankLine,!
        . . do CUU^TMGTERM(1)
        . . new tpLine
        . . read " enter M code: ",tpLine,!
        . . xecute tpLine
        . if "iI"[tpAction do  quit
        . . set tpStepMode="into"
        . . ;"set $ZSTEP="do STEPTRAP^TMGTPSTP($ZPOS) zstep into zcontinue"
        . . set tpDone=1
        . if "Oo"[tpAction do  quit
        . . set tpStepMode="over"
        . . ;"set $ZSTEP="do STEPTRAP^TMGTPSTP($ZPOS) zstep over zcontinue"
        . . set tpDone=1
        . if "Hh"[tpAction do  quit
        . . set tpRunMode=2
        . . set tpDone=1
        . else  do  quit
        . . new tpNLines
        . . for tpNLines=1:1:5 write tpBlankLine,!
        . . do CUU^TMGTERM(5)
        . . write " L  -- run in sLow mode",!
        . . write " M  -- enter any line of M code",!
        . . write " O  -- step OVER line",!
        . . write " I  -- step INTO line",!
        . . write " R  -- run",!
        . . write " H  -- Hide debug code",!
        
     SPDone
        do VCULOAD2^TMGTERM
        set TMGRunMode=tpRunMode
        if tpStepMode="into" set result=1
        else  set result=2
        set TMGStepMode=tpStepMode
        quit result
        
        
     ErrTrap(Pos)
                ;"Purpose: This is the line that is called by GT.M for each ztrap event.
                ;"	It will be used to display the current code execution point 
        
        new ScrHeight,ScrWidth
        set ScrHeight=$get(TMGScrHeight,10)
        set ScrWidth=$get(TMGScrWidth,70)
        
        do VCUSAV2^TMGTERM
        do ShowCodePos(Pos,ScrWidth,ScrHeight)
        
        ETDone
        do VCULOAD2^TMGTERM
        quit 
        
        
        
        
     ShowCode(Pos,ScrWidth,ScrHeight,Wipe)
        ;"Purpose: This will display code at the top of the screen
        ;"Input: Pos -- string like this: X+2^ROUTINE[$DMOD]
        ;"      ScrWidth -- width of code display (Num of columns)
        ;	
        ;"      Wipe -- OPTIONAL.  if 1, then code area is wiped blank
        
        new i
        new Routine,Label,Offest,s
        new LastRou,LastLabel,LastOffset
        new dbFGColor,bBGColor,nlFGColor,nlBGColor
        new BlankLine        
        new StartOffset
        
        set ScrWidth=$get(ScrWidth,80)
        set ScrHeight=$get(ScrHeight,10)
        
        set nlFGColor=$get(TMGNlFGColor,3)
        set nlBGColor=$get(TMGNlBGColor,0)
        set dbFGColor=$get(TMGDbFGColor,0)
        set dbBGColor=$get(TMGDbBGColor,3)
        
        set BlankLine=" "
        for i=1:1:ScrWidth-1 set BlankLine=BlankLine_" "
        
        do VCOLORS^TMGTERM(dbFGColor,dbBGColor)
        
        do CUP^TMGTERM(1,1) ;"Cursor to line (1,1) 
        write BlankLine,!  ;"This is needed for some reason...
        do CUU^TMGTERM(2)
        
        if $get(Wipe)=1 do  goto SCDone
        . do VCOLORS^TMGTERM(nlFGColor,nlBGColor)
        . for i=0:1:ScrHeight+1 write BlankLine
        
        set s=$piece(Pos,"$",1)  ;"e.g. X+2^ROUTINE$DMOD-->X+2^ROUTINE
        set Routine=$piece(s,"^",2)
        set Label=$piece(s,"^",1)
        set Offset=+$piece(Label,"+",2)
        set Label=$piece(Label,"+",1)
        
        set s="=== Routine: ^"_Routine_" " write s
        for i=1:1:ScrWidth-$length(s) write "="
        write !
        
        if Offset>(ScrHeight) do
                set StartOffset=(Offset-ScrHeight)
        else  set StartOffset=0
        
        for i=StartOffset:1:(ScrHeight+StartOffset) do
        . new line,Bl,ref,LoopOffset
        . set ref=Label_"+"_i_"^"_Routine
        . set line=$text(@ref)
        . if (i=Offset) do 
        . . do VCOLORS^TMGTERM(nlFGColor,nlBGColor)
        . . write ">"
        . else  write " "
        . if $length(line)>(ScrWidth-1) do
        . . write $extract(line,1,ScrWidth-4),"...",!
        . else  do
        . . write $extract(line,1,ScrWidth-1)
        . . write $extract(BlankLine,1,ScrWidth-$length(line)-1),!
        . if (i=Offset) do VCOLORS^TMGTERM(dbFGColor,dbBGColor)
        
        for i=1:1:ScrWidth write "~"
        write !
        
     SCDone
        ;"do VCULOAD^TMGTERM
        do VCOLORS^TMGTERM(nlFGColor,nlBGColor)
        
        ;"do CUD^TMGTERM(2)
        
        quit