237 lines
8.2 KiB
Mathematica
237 lines
8.2 KiB
Mathematica
ARJTDDKR ;WV/TOAD-FileMan Search All Routines ;5/24/2004 19:08
|
|
;;22.0;VA FileMan;;Mar 30, 1999;
|
|
;
|
|
; Change History:
|
|
;
|
|
; 2004 05 24 modified to handle GT.M as well as DSM
|
|
;
|
|
; table of contents:
|
|
; ALL - search all routines in current environment
|
|
; RSE - search selected routines
|
|
; FEEDBACK - give routine search feedback
|
|
; SEARCH - search 1 routine
|
|
; CONTAINS - function: does code contain what we're looking for
|
|
; CODEROU - cross-reference results by code then routine
|
|
; RESULTS - report results of search
|
|
; ADDLINE - add a line to the Line WP field (2)
|
|
;
|
|
; input:
|
|
; .CONTAINS(string)="" to search any line containing the string
|
|
; FIND = optional. special search, e.g., "DSM"
|
|
;
|
|
; output:
|
|
; .EXIT = returns 1 if interrupted.
|
|
; report to current device
|
|
;
|
|
;
|
|
ALL(CONTAINS,FIND,EXIT) ; public subroutine: search all routines
|
|
;
|
|
; input: DSM-specific ^ () global (name = space)
|
|
; called by ALL^ARJTDDK -- master search option
|
|
; calls:
|
|
; FEEDBACK - give routine search feedback
|
|
; SEARCH - search each routine
|
|
; RESULTS^ARJTDDKU - report results of search
|
|
;
|
|
W !!,"Searching all routines"
|
|
K ^XTMP("DSMROUTINES")
|
|
S ^XTMP("DSMROUTINES",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)_U_$$DT^XLFDT()
|
|
;
|
|
S EXIT=0 ; not interrupted so far
|
|
N PRE S PRE="" ; trace shifting prefixes
|
|
N COUNT ; number of routines searched
|
|
N FOUND S FOUND=0 ; number of matching routines found
|
|
N ROU S ROU="" ; name of each routine
|
|
F COUNT=0:1 D Q:ROU=""!EXIT
|
|
. S ROU=$O(^ (ROU)) Q:ROU="" ; DSM stores rtn direc. in ^[space].
|
|
. I COUNT,'(COUNT#100) D FEEDBACK(COUNT,ROU,.PRE,.EXIT) Q:EXIT
|
|
. D SEARCH($P(ROU,"."),.CONTAINS,FIND,.FOUND)
|
|
D RESULTS^ARJTDDKU(EXIT,COUNT,FOUND,"Search","routine")
|
|
Q:EXIT
|
|
D COMPILE^ARJTDDKS(1)
|
|
;
|
|
QUIT ; end of ALL
|
|
;
|
|
;
|
|
RSE(CONTAINS,FIND,EXIT) ; public subroutine: search selected routines
|
|
;
|
|
; calls:
|
|
; ^%RSEL - select routines to search
|
|
; FEEDBACK - give routine search feedback
|
|
; SEARCH - search each routine
|
|
; RESULTS - report results of search
|
|
; note: since DSM's ^%RSEL returns its list in the local %UTILITY
|
|
; variable, a large symbol table size is needed to hold large lists.
|
|
;
|
|
N %UTILITY D ^%RSEL Q:$O(%UTILITY(""))=""
|
|
W !!,"Searching selected routines"
|
|
K ^XTMP("DSMROUTINES")
|
|
S ^XTMP("DSMROUTINES",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)_U_$$DT^XLFDT()
|
|
;
|
|
S EXIT=0 ; not interrupted so far
|
|
N PRE S PRE="" ; trace shifting prefixes
|
|
N COUNT ; number of routines searched
|
|
N FOUND S FOUND=0 ; number of matching routines found
|
|
N ROU S ROU="" ; name of each routine
|
|
F COUNT=0:1 D Q:ROU=""!EXIT
|
|
. S ROU=$O(%UTILITY(ROU)) Q:ROU=""
|
|
. I COUNT,'(COUNT#100) D FEEDBACK(COUNT,ROU,.PRE,.EXIT) Q:EXIT
|
|
. D SEARCH($P(ROU,"."),.CONTAINS,FIND,.FOUND)
|
|
D RESULTS^ARJTDDKU(EXIT,COUNT,FOUND,"Search","routine")
|
|
Q:EXIT
|
|
D COMPILE^ARJTDDKS()
|
|
;
|
|
QUIT ; end of ALL
|
|
;
|
|
;
|
|
FEEDBACK(COUNT,ROU,PRE,EXIT) ; subroutine: give routine search feedback
|
|
;
|
|
; input:
|
|
; COUNT = # searched so far
|
|
; ROU = name of next routine to search
|
|
; in/output: .PRE = 1st 2 letters of previous routine searched
|
|
; called by: ALL, RSE
|
|
;
|
|
S EXIT=0 ; not interrupted yet
|
|
N READ ; results of quick read command
|
|
W "." ; dots
|
|
I '(COUNT#1000) W !,$FN(COUNT,",")," routines searched so far" ; counts
|
|
I $E(ROU,1,2)'=PRE S PRE=$E(ROU,1,2) W " ",PRE,"*" ; changing prefixes
|
|
R READ:0 S EXIT=READ=U ; quick reads to allow ^-escape
|
|
;
|
|
QUIT ; end of FEEDBACK
|
|
;
|
|
;
|
|
SEARCH(RTN,CONTAINS,FIND,FINDCNT) ; subroutine: search 1 routine
|
|
;
|
|
; input: RTN = name of routine to search
|
|
; in/output: .FINDCNT = optional. increments # of instances found
|
|
; called by: ALL, RSE
|
|
; calls:
|
|
; $$CONTAINS - test each line: does it contain what we're looking for
|
|
; CHECK^ARJTDIM - search each line of code
|
|
;
|
|
; S.1. Traverse The Routine Lines
|
|
;
|
|
Q:RTN="" ; need a routine name
|
|
N SKIP S SKIP=0 D Q:SKIP ; we skip routine if doesn't exist or too big
|
|
. ; if error, will probably be because too large, report & skip
|
|
. N $ET S $ET="S SKIP=1 W !?5,RTN,"" TOO LARGE!"",! S ($EC,$ZE)="""""
|
|
. S SKIP=$T(^@RTN)="" ; make sure 1st line exists
|
|
N FOUND S FOUND=0 ; flag success or failure for routine
|
|
N FIRST S FIRST=1 ; only report routine name on 1st hit
|
|
N FOUNDR S FOUNDR=0 ; any found within routine?
|
|
N RIEN ; the IEN of routine's entry in Cache Routine file (663075)
|
|
N LIEN ; the last line # in the Line WP field (2)
|
|
N NUM ; # lines
|
|
N LINE ; each line of code
|
|
N CODE ; the code part of each line
|
|
F NUM=1:1 S LINE=$T(+NUM^@RTN) Q:LINE="" I $$CONTAINS(LINE,.CONTAINS) D
|
|
. ;
|
|
. ; S.2. Parse each simply matching line using ARJTDIM
|
|
. ;
|
|
. I $G(MAH) W !!,"+",NUM," ",LINE
|
|
. S CODE=$P(LINE," ",2,99999) ; ARJTDIM doesn't deal with labels
|
|
. F Q:CODE="" Q:" ."'[$E(CODE) S $E(CODE)="" ; or spaces and periods
|
|
. Q:CODE="" ; skip line if nothing but labels, periods, and spaces
|
|
. D CHECK^ARJTDIM(CODE,FIND,.FOUND) ; parse line
|
|
. Q:'FOUND ; skip lines that don't match
|
|
. S FOUNDR=1,FOUND=0
|
|
. ;
|
|
. ; S.3. Count routine once if one of its lines completely matches
|
|
. ;
|
|
. I FIRST D ; when routine first gets a hit
|
|
. . W !?5,RTN ; make its name stand out
|
|
. . I $X>6 W ! ; try to keep first match line on same line with name
|
|
. . S RIEN=$O(^DIZ(663075,"B",RTN,0))
|
|
. . I '$D(^DIZ(663075,+RIEN,0)) D ; create a new entry if missing
|
|
. . . N RNODE S RNODE=$G(^DIZ(663075,0)) ; file header
|
|
. . . S RIEN=$P(RNODE,U,3) ; most recent IEN assigned
|
|
. . . F S RIEN=RIEN+1 Q:'$D(^DIZ(663075,RIEN)) ; find free IEN
|
|
. . . S $P(RNODE,U,3,4)=RIEN_U_($P(RNODE,U,4)+1) ; update recent & count
|
|
. . . S ^DIZ(663075,0)=RNODE ; update header
|
|
. . . S ^DIZ(663075,RIEN,0)=RTN ; new entry's Routine Name field (.01)
|
|
. . . S ^DIZ(663075,"B",RTN,RIEN)="" ; cross-reference new entry
|
|
. . S LIEN=$O(^DIZ(663075,RIEN,1," "),-1) ; find last line in WP
|
|
. . I LIEN>0 D ADDLINE(RIEN,.LIEN," ")
|
|
. . D ADDLINE(RIEN,.LIEN,$$HTE^XLFDT($H))
|
|
. S FIRST=0 ; no longer 1st hit
|
|
. S FINDCNT=$G(FINDCNT)+1 ; one more routine found
|
|
. ;
|
|
. ; S.4. Report each completely matching line
|
|
. ;
|
|
. W FINDCNT,"." ; for ease of using the report, # each match found
|
|
. W ?7 ; indent for clarity
|
|
. N LINEID ; how shall we ID the line?
|
|
. I $E(LINE)'=" " S LINEID=$P(LINE," ") ; as label, if any
|
|
. E S LINEID="+"_NUM ; otherwise as absolute offset
|
|
. S LINEID=LINEID_$J(" ",9-$L(LINEID)) ; ID then "tab" to col 16
|
|
. W LINEID ; display line ID to screen
|
|
. S LINE=$P(LINE," ",2,9999) ; remove label and ls
|
|
. N LINCHUNK ; each chunk of line to show
|
|
. F Q:'$L(LINE) D ; repeat until we're out of code
|
|
. . S LINCHUNK=$E(LINE,1,64)
|
|
. . W ?16,LINCHUNK,! ; write to screen what will fit
|
|
. . D ADDLINE(RIEN,.LIEN,LINEID_LINCHUNK) ; set ID + line chunk
|
|
. . S LINEID=" " ; just "tab" for remaining chunks
|
|
. . S $E(LINE,1,64)="" ; clear written code
|
|
I FOUNDR D
|
|
. W ! ; line feed to end list of matching lines for routine
|
|
. Q:FIND'="DSM" ; rest of block for John Harvey
|
|
. M ^XTMP("DSMROUTINES","ROU CODE",RTN)=FOUND("DSM")
|
|
. D CODEROU(RTN,.FOUND)
|
|
;
|
|
QUIT ; end of SEARCH
|
|
;
|
|
;
|
|
CONTAINS(CODE,CONTAINS) ; function: does code contain what we're looking for
|
|
;
|
|
; input: CODE = line of code
|
|
; output: true if line contains any of CONTAINS
|
|
; called by: SEARCH
|
|
;
|
|
N DOES I $D(CONTAINS)#2 S DOES=CODE[CONTAINS Q DOES
|
|
I $D(CONTAINS)>9 D Q DOES
|
|
. N SUB S SUB=""
|
|
. F S SUB=$O(CONTAINS(SUB)) Q:SUB="" S DOES=CODE[SUB Q:DOES
|
|
QUIT 0 ; end of CONTAINS
|
|
;
|
|
;
|
|
CODEROU(ROU,FOUND) ; subroutine: cross-reference results by code then routine
|
|
N NUM
|
|
N SUB S SUB="DSMROUTINES"
|
|
N CODE S CODE="" F D Q:CODE=""
|
|
. S CODE=$O(FOUND("DSM",CODE)) Q:CODE=""
|
|
. S NUM=$G(^XTMP(SUB,"CODE ROU",CODE,ROU))+FOUND("DSM",CODE)
|
|
. S ^XTMP(SUB,"CODE ROU",CODE,ROU)=NUM
|
|
. ;
|
|
. S NUM=$G(^XTMP(SUB,"CODE ROU",CODE,0))+FOUND("DSM",CODE)
|
|
. S ^XTMP(SUB,"CODE ROU",CODE,0)=NUM
|
|
Q
|
|
;
|
|
;
|
|
RESULTS(EXIT,COUNT,FOUND) ; subroutine: report results of search
|
|
;
|
|
; input:
|
|
; COUNT = # of routines searched
|
|
; FOUND = # of instances found
|
|
; called by: ALL, RSE
|
|
;
|
|
W !
|
|
I EXIT W !,"Search interrupted."
|
|
W !,COUNT," routine",$E("s",COUNT'=1)," searched."
|
|
W !,FOUND," instance",$E("s",FOUND'=1)," found."
|
|
QUIT ; end of RESULTS
|
|
;
|
|
;
|
|
ADDLINE(RIEN,LIEN,LINE) ; add a line to the Line WP field (2)
|
|
;
|
|
; Input:
|
|
; LIEN = last line # in WP field
|
|
; LINE = the line of text to append
|
|
;
|
|
S LIEN=LIEN+1
|
|
S ^DIZ(663075,RIEN,1,LIEN,0)=LINE
|
|
QUIT ; end of ADDLINE
|
|
;
|