PeterJ 2007-09-04 22:27

/*
GUIBEGIN


WINDOW , 128, 264, 455, 223, POPUP|CAPTION|SYSMENU|MINBOX|MAXBOX|THICK, STATICEDGE, REX Cross Reference Scan
	FONT 8, 400, MS Shell Dlg
	PUSH 237, 10, 40, 14, TABSTOP, , File, , File
	ENTRY 5, 11, 222, 12, H_AUTO|BORDER|TABSTOP, STATICEDGE, SFile
	CHECK 291, 11, 136, 10, AUTO|TABSTOP, , VProc, , Show Variables Procedure related
	TEXT 2, 28, 23, 8, GROUP
	TEXT 27, 28, 49, 9, GROUP, , , , Procedures
	TEXT 10, 115, 18, 8, GROUP
	TEXT 27, 115, 64, 8, GROUP, , , , Variables
	TEXT 137, 28, 34, 8, GROUP, , , , Defined at   Called at
	TEXT 137, 115, 265, 8, GROUP, , , , Modified at Line (Suffix: '+' PARSE ARG / '*' PARSE VALUE / none normal SET)
	TEXT 179, 29, 208, 8, GROUP, , , , Called at                  Suffix: '+' LABEL  /  none PROCEDURE
	PUSH 412, 204, 40, 14, DEFAULT|TABSTOP, , Run, , Run
DEND
GUIEND
*/

LIBRARY rexxgui, rxconsole
guierr = "ERROR"
guiheading = 1
guicreatewindow('NORMAL')
again:
DO FOREVER
    guigetmsg()
    CATCH SYNTAX
            CONDITION()
            SIGNAL again
    CATCH HALT
    FINALLY
        guidestroywindow()
END
RETURN
 /* ---------------------------------------------------------------------------------
  * Called when the window and its controls are created, but
  * before it is displayed
  * ---------------------------------------------------------------------------------
  */
wm_initdialog:
/* Get the size of the window */
guigetctlplacement(guiwindow, , , "width", "height")
guigetctlplacement('File', "SayX", "SayY", "SayWidth", "SayHeight")
sayy = sayy + sayheight+5
sayx=sayx+1
height = (height-34- sayy)%2
concreate('x1', guiwindow, "CHILD | NODEFAULT",4, sayy+20, width-7, height-25)
consetcolor(x1, "BACK", "White")
consetcolor(x1, "Text", 1)
consetfont(x1, "Courier New", 16,)
concreate('x2', guiwindow, "CHILD | NODEFAULT",4, sayy+height+20, width-7, height-25)
consetcolor(x2, "BACK", "White")
consetcolor(x2, "Text", 1)
consetfont(x2, "Courier New", 16,)

RETURN ""
/* ---------------------------------------------------------------------------------
 * File button has been clicked
 * ---------------------------------------------------------------------------------
 */
wm_click_file:
file='*.rex'
ERROR = guifile('File', , 'Select REX To Scan')
IF file='' | file='*.rex' THEN RETURN
sfile=file
guisetctlvalue("SFILE")
CALL init
RETURN
/* ------------------------------------------------------------
 * Scan file for rexx variables 
 * ------------------------------------------------------------
 */
wm_click_run:
guigetctlvalue("SFILE")
IF sfile='' THEN RETURN
IF POS('.',sfile)=0 THEN sfile=sfile||'.rex'
guigetctlvalue("VPROC")
IF vproc=1 THEN NOP
   ELSE vrpoc=0
ovarlen=20                   /* Lenght of colunm for variable display */ 
IF vproc=0 THEN oproclen=0
   ELSE oproclen=15          /* maximum length for procedure */  
split=77-ovarlen-oproclen
IF LOADTEXT('code.',sfile,'LT')=0 THEN RETURN /* nothing there */
CALL init

CALL scanvar
CALL scanproc
CALL sortv
CALL outproc
CALL outvar

RETURN  
/* ---------------------------------------------------------------------------------
 * Output Procedure XREF  
 * ---------------------------------------------------------------------------------
 */
outproc:
split2=split-8
IF procs.0=0 THEN consay(x1,'None') 
ELSE DO i=1 TO procs.0
   len=linesplit(procref.i,split2)
   vreflin=STRIP(SUBSTR(procref.i,1,len))
   vrefn=STRIP(SUBSTR(procref.i,len+1))
   IF proctype.i='P' THEN ptype=' '
      ELSE ptype='+'
   consay(x1,RIGHT(i,3) LEFT(procs.i,ovarlen) RIGHT(procdef.i,4)ptype ' ' vreflin)
   DO WHILE vrefn \= ''
      len=linesplit(vrefn,split2)
      vreflin=STRIP(SUBSTR(vrefn,1,len))
      consay(x1,COPIES(' ',ovarlen+2+10) vreflin)
      vrefn=STRIP(SUBSTR(vrefn,len+1)) 
   END 
END
RETURN 
/* ---------------------------------------------------------------------------------
 * Output Variable XREF  
 * ---------------------------------------------------------------------------------
 */
outvar:
DO i=1 TO variable.0
   len=linesplit(varref.i,split)
   vreflin=STRIP(SUBSTR(varref.i,1,len))
   vrefn=STRIP(SUBSTR(varref.i,len+1))
   IF LENGTH(variable.i)<ovarlen+oproclen THEN consay(x2,RIGHT(i,3) LEFT(variable.i,ovarlen+oproclen) vreflin) 
      ELSE consay(x2,RIGHT(i,3) variable.i vreflin) 
   DO WHILE vrefn \= ''
      len=linesplit(vrefn,split)
      vreflin=STRIP(SUBSTR(vrefn,1,len))
      consay(x2,COPIES(' ',ovarlen+oproclen+4) vreflin)
      vrefn=STRIP(SUBSTR(vrefn,len+1)) 
   END 
END
RETURN
/* ---------------------------------------------------------------------------------
 * Sort variables and References  
 * ---------------------------------------------------------------------------------
 */
sortv:
OPTIONS "SORT"
SORT = "varref."
SORT variable. a

OPTIONS "SORT"
SORT = "procref. procdef."
SORT procs. a
RETURN
/* ---------------------------------------------------------------------------------
 * Scan for variables, references, and procedure names 
 * ---------------------------------------------------------------------------------
 */
scanvar:
DO i=1 TO code.0
   code.i=TRANSLATE(code.i)
   line=CHANGESTR('=',code.i,' = ')  /* for SETs */
   line=CHANGESTR(':',line,': ')     /* for labels */
   fword=WORD(line,1)
   IF LENGTH(fword)<2 THEN fword='????' /* can't be label */
   IF POS('PROCEDURE',line)>0 THEN current_proc=proc(line,current_proc,i)
   ELSE IF SUBSTR(fword,LENGTH(fword),1)=':' THEN CALL label(fword,i)
   PARSE VALUE line WITH varx eq rem
   IF eq = '=' THEN CALL addvar(varx,i,,current_proc,vproc)
   ELSE IF varx='PARSE' THEN CALL PARSE 
END
RETURN
/* ---------------------------------------------------------------------------------
 * Scan procedure usage 
 * ---------------------------------------------------------------------------------
 */
scanproc:
DO i=1 TO code.0
   DO j=1 TO procs.0
      IF POS(procs.j'(',code.i)>0 THEN procref.j=procref.j||i||' '     
   END
END
RETURN
/* ---------------------------------------------------------------------------------
 * Determines space near position requested (to aviod a split within a word
 * ---------------------------------------------------------------------------------
 */
parse: 
line=STRIP(TRANSLATE(line,,"',;/."'"')) 
IF eq='ARG' THEN DO
   argx=POS('ARG',line)
   IF argx>0 THEN line=SUBSTR(line,argx)
   parsem='+'
END     
ELSE IF eq='VALUE' THEN DO 
   withx=POS('WITH',line)
   IF withx>0 THEN line=SUBSTR(line,withx)
   parsem='*'
END
PARSE VALUE line WITH withx v.1 v.2 v.3 v.3 v.4 v.5 v.6 v.7 v.8 v.9 v.10 v.11 v.12 v.13 v.14 v.15
DO j=1 TO 15
   CALL addvar(v.j,i,parsem,current_proc,vproc)
END
RETURN
/* ---------------------------------------------------------------------------------
 * Pick up procedure name 
 * ---------------------------------------------------------------------------------
 */
proc: PROCEDURE EXPOSE procs. proctype. procref. procdef.
PARSE ARG line,cproc,linei
ip=POS('PROCEDURE',line)
IF ip<2 THEN RETURN cproc
proc=STRIP(SUBSTR(line,1,ip-1))
IF WORDS(proc) \= 1 THEN RETURN cproc
IF SUBSTR(proc,LENGTH(proc),1) \= ':' THEN RETURN cproc
proc=SUBSTR(proc,1,LENGTH(proc)-1)
si=procs.0+1
procs.0=si
procs.si=proc
procdef.si=linei
procref.si=''
proctype.si='P'
RETURN proc
/* ---------------------------------------------------------------------------------
 * Pick up label name may be used for procedure call 
 * ---------------------------------------------------------------------------------
 */
label: PROCEDURE EXPOSE procs. proctype. procref. procdef.
PARSE ARG flabel,linei
flabel=STRIP(TRANSLATE(flabel,,':'))
IF flabel='' THEN RETURN 
si=procs.0+1
procs.0=si
procs.si=flabel
procdef.si=linei
procref.si=''
proctype.si='L'
RETURN  
/* ---------------------------------------------------------------------------------
 * Determines space near position requested (to aviod a split within a word
 * ---------------------------------------------------------------------------------
 */
addvar: PROCEDURE EXPOSE variable. varref.
PARSE ARG varname,line,settype,cproc,showproc
IF varname='' THEN RETURN 
fstr=STRIP(TRANSLATE(SUBSTR(varname,1,1),,'ABCDEFGHIJKLMNOPQRSTUVWXYZ'))
IF fstr\='' THEN RETURN
IF showproc=1 THEN varname=varname||'('||cproc||')'
si=search(variable.,varname,,,'M','UPPER')
IF si<1 THEN DO  	
   si=variable.0+1
   varref.si=''
   variable.0=si
END
variable.si=varname
varref.si=varref.si||line||settype||' '
RETURN
/* ---------------------------------------------------------------------------------
 * Determines space near position requested (to aviod a split within a word
 * ---------------------------------------------------------------------------------
 */
linesplit: PROCEDURE
PARSE ARG string, offset
IF SUBSTR(string,offset,1)=' ' THEN RETURN offset
sstr=SUBSTR(string,1,offset)
wrd=WORDS(sstr)
offset=WORDINDEX(sstr,wrd)-1
RETURN offset
/* ---------------------------------------------------------------------------------
 * Search string in stem variable
 * ---------------------------------------------------------------------------------
 */ 
search:procedure
USE ARG stemin.,sstr,from,tohi,match,case
IF EXISTS('stemin.0')=0 THEN RETURN -1
hi=stemin.0
IF sstr='SQL_KEY_COLNAME' THEN DO
   NOP
END 
IF DATATYPE(hi) \= 'NUM' THEN RETURN -1
IF ARG(1,'E')=0 THEN RETURN -1
IF ARG(2,'E')=0 THEN RETURN 0
IF ARG(3,'E')=0 THEN from=1 
IF ARG(4,'E')=0 THEN tohi=hi
IF hi=0 THEN RETURN 0
up=TRANSLATE(case)
IF up='NO' | SUBSTR(up,1,1)='U' THEN OPTIONS 'CASELESS' 
   ELSE OPTIONS 'NOCASELESS' 
IF TRANSLATE(match)='M' THEN DO i=from TO tohi
   IF sstr=stemin.i THEN RETURN i
END
ELSE DO i=from TO tohi
   IF POS(sstr,stemin.i)>0 THEN RETURN i
END
RETURN 0 
/* ---------------------------------------------------------------------------------
 * Init Procedure
 * ---------------------------------------------------------------------------------
 */
init:
DROP code variable. procs. varref. procdef. procref. 
conclear(x1)
conclear(x2)
variable.0=0
procs.0=0
vari=0
current_proc='MAIN'
RETURN

PeterJ 2007-09-04 22:27