[613] | 1 | ARJTDDKR ;WV/TOAD-FileMan Search All Routines ;5/24/2004 19:08
|
---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999;
|
---|
| 3 | ;
|
---|
| 4 | ; Change History:
|
---|
| 5 | ;
|
---|
| 6 | ; 2004 05 24 modified to handle GT.M as well as DSM
|
---|
| 7 | ;
|
---|
| 8 | ; table of contents:
|
---|
| 9 | ; ALL - search all routines in current environment
|
---|
| 10 | ; RSE - search selected routines
|
---|
| 11 | ; FEEDBACK - give routine search feedback
|
---|
| 12 | ; SEARCH - search 1 routine
|
---|
| 13 | ; CONTAINS - function: does code contain what we're looking for
|
---|
| 14 | ; CODEROU - cross-reference results by code then routine
|
---|
| 15 | ; RESULTS - report results of search
|
---|
| 16 | ; ADDLINE - add a line to the Line WP field (2)
|
---|
| 17 | ;
|
---|
| 18 | ; input:
|
---|
| 19 | ; .CONTAINS(string)="" to search any line containing the string
|
---|
| 20 | ; FIND = optional. special search, e.g., "DSM"
|
---|
| 21 | ;
|
---|
| 22 | ; output:
|
---|
| 23 | ; .EXIT = returns 1 if interrupted.
|
---|
| 24 | ; report to current device
|
---|
| 25 | ;
|
---|
| 26 | ;
|
---|
| 27 | ALL(CONTAINS,FIND,EXIT) ; public subroutine: search all routines
|
---|
| 28 | ;
|
---|
| 29 | ; input: DSM-specific ^ () global (name = space)
|
---|
| 30 | ; called by ALL^ARJTDDK -- master search option
|
---|
| 31 | ; calls:
|
---|
| 32 | ; FEEDBACK - give routine search feedback
|
---|
| 33 | ; SEARCH - search each routine
|
---|
| 34 | ; RESULTS^ARJTDDKU - report results of search
|
---|
| 35 | ;
|
---|
| 36 | W !!,"Searching all routines"
|
---|
| 37 | K ^XTMP("DSMROUTINES")
|
---|
| 38 | S ^XTMP("DSMROUTINES",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)_U_$$DT^XLFDT()
|
---|
| 39 | ;
|
---|
| 40 | S EXIT=0 ; not interrupted so far
|
---|
| 41 | N PRE S PRE="" ; trace shifting prefixes
|
---|
| 42 | N COUNT ; number of routines searched
|
---|
| 43 | N FOUND S FOUND=0 ; number of matching routines found
|
---|
| 44 | N ROU S ROU="" ; name of each routine
|
---|
| 45 | F COUNT=0:1 D Q:ROU=""!EXIT
|
---|
| 46 | . S ROU=$O(^ (ROU)) Q:ROU="" ; DSM stores rtn direc. in ^[space].
|
---|
| 47 | . I COUNT,'(COUNT#100) D FEEDBACK(COUNT,ROU,.PRE,.EXIT) Q:EXIT
|
---|
| 48 | . D SEARCH($P(ROU,"."),.CONTAINS,FIND,.FOUND)
|
---|
| 49 | D RESULTS^ARJTDDKU(EXIT,COUNT,FOUND,"Search","routine")
|
---|
| 50 | Q:EXIT
|
---|
| 51 | D COMPILE^ARJTDDKS(1)
|
---|
| 52 | ;
|
---|
| 53 | QUIT ; end of ALL
|
---|
| 54 | ;
|
---|
| 55 | ;
|
---|
| 56 | RSE(CONTAINS,FIND,EXIT) ; public subroutine: search selected routines
|
---|
| 57 | ;
|
---|
| 58 | ; calls:
|
---|
| 59 | ; ^%RSEL - select routines to search
|
---|
| 60 | ; FEEDBACK - give routine search feedback
|
---|
| 61 | ; SEARCH - search each routine
|
---|
| 62 | ; RESULTS - report results of search
|
---|
| 63 | ; note: since DSM's ^%RSEL returns its list in the local %UTILITY
|
---|
| 64 | ; variable, a large symbol table size is needed to hold large lists.
|
---|
| 65 | ;
|
---|
| 66 | N %UTILITY D ^%RSEL Q:$O(%UTILITY(""))=""
|
---|
| 67 | W !!,"Searching selected routines"
|
---|
| 68 | K ^XTMP("DSMROUTINES")
|
---|
| 69 | S ^XTMP("DSMROUTINES",0)=$$FMADD^XLFDT($$DT^XLFDT(),90)_U_$$DT^XLFDT()
|
---|
| 70 | ;
|
---|
| 71 | S EXIT=0 ; not interrupted so far
|
---|
| 72 | N PRE S PRE="" ; trace shifting prefixes
|
---|
| 73 | N COUNT ; number of routines searched
|
---|
| 74 | N FOUND S FOUND=0 ; number of matching routines found
|
---|
| 75 | N ROU S ROU="" ; name of each routine
|
---|
| 76 | F COUNT=0:1 D Q:ROU=""!EXIT
|
---|
| 77 | . S ROU=$O(%UTILITY(ROU)) Q:ROU=""
|
---|
| 78 | . I COUNT,'(COUNT#100) D FEEDBACK(COUNT,ROU,.PRE,.EXIT) Q:EXIT
|
---|
| 79 | . D SEARCH($P(ROU,"."),.CONTAINS,FIND,.FOUND)
|
---|
| 80 | D RESULTS^ARJTDDKU(EXIT,COUNT,FOUND,"Search","routine")
|
---|
| 81 | Q:EXIT
|
---|
| 82 | D COMPILE^ARJTDDKS()
|
---|
| 83 | ;
|
---|
| 84 | QUIT ; end of ALL
|
---|
| 85 | ;
|
---|
| 86 | ;
|
---|
| 87 | FEEDBACK(COUNT,ROU,PRE,EXIT) ; subroutine: give routine search feedback
|
---|
| 88 | ;
|
---|
| 89 | ; input:
|
---|
| 90 | ; COUNT = # searched so far
|
---|
| 91 | ; ROU = name of next routine to search
|
---|
| 92 | ; in/output: .PRE = 1st 2 letters of previous routine searched
|
---|
| 93 | ; called by: ALL, RSE
|
---|
| 94 | ;
|
---|
| 95 | S EXIT=0 ; not interrupted yet
|
---|
| 96 | N READ ; results of quick read command
|
---|
| 97 | W "." ; dots
|
---|
| 98 | I '(COUNT#1000) W !,$FN(COUNT,",")," routines searched so far" ; counts
|
---|
| 99 | I $E(ROU,1,2)'=PRE S PRE=$E(ROU,1,2) W " ",PRE,"*" ; changing prefixes
|
---|
| 100 | R READ:0 S EXIT=READ=U ; quick reads to allow ^-escape
|
---|
| 101 | ;
|
---|
| 102 | QUIT ; end of FEEDBACK
|
---|
| 103 | ;
|
---|
| 104 | ;
|
---|
| 105 | SEARCH(RTN,CONTAINS,FIND,FINDCNT) ; subroutine: search 1 routine
|
---|
| 106 | ;
|
---|
| 107 | ; input: RTN = name of routine to search
|
---|
| 108 | ; in/output: .FINDCNT = optional. increments # of instances found
|
---|
| 109 | ; called by: ALL, RSE
|
---|
| 110 | ; calls:
|
---|
| 111 | ; $$CONTAINS - test each line: does it contain what we're looking for
|
---|
| 112 | ; CHECK^ARJTDIM - search each line of code
|
---|
| 113 | ;
|
---|
| 114 | ; S.1. Traverse The Routine Lines
|
---|
| 115 | ;
|
---|
| 116 | Q:RTN="" ; need a routine name
|
---|
| 117 | N SKIP S SKIP=0 D Q:SKIP ; we skip routine if doesn't exist or too big
|
---|
| 118 | . ; if error, will probably be because too large, report & skip
|
---|
| 119 | . N $ET S $ET="S SKIP=1 W !?5,RTN,"" TOO LARGE!"",! S ($EC,$ZE)="""""
|
---|
| 120 | . S SKIP=$T(^@RTN)="" ; make sure 1st line exists
|
---|
| 121 | N FOUND S FOUND=0 ; flag success or failure for routine
|
---|
| 122 | N FIRST S FIRST=1 ; only report routine name on 1st hit
|
---|
| 123 | N FOUNDR S FOUNDR=0 ; any found within routine?
|
---|
| 124 | N RIEN ; the IEN of routine's entry in Cache Routine file (663075)
|
---|
| 125 | N LIEN ; the last line # in the Line WP field (2)
|
---|
| 126 | N NUM ; # lines
|
---|
| 127 | N LINE ; each line of code
|
---|
| 128 | N CODE ; the code part of each line
|
---|
| 129 | F NUM=1:1 S LINE=$T(+NUM^@RTN) Q:LINE="" I $$CONTAINS(LINE,.CONTAINS) D
|
---|
| 130 | . ;
|
---|
| 131 | . ; S.2. Parse each simply matching line using ARJTDIM
|
---|
| 132 | . ;
|
---|
| 133 | . I $G(MAH) W !!,"+",NUM," ",LINE
|
---|
| 134 | . S CODE=$P(LINE," ",2,99999) ; ARJTDIM doesn't deal with labels
|
---|
| 135 | . F Q:CODE="" Q:" ."'[$E(CODE) S $E(CODE)="" ; or spaces and periods
|
---|
| 136 | . Q:CODE="" ; skip line if nothing but labels, periods, and spaces
|
---|
| 137 | . D CHECK^ARJTDIM(CODE,FIND,.FOUND) ; parse line
|
---|
| 138 | . Q:'FOUND ; skip lines that don't match
|
---|
| 139 | . S FOUNDR=1,FOUND=0
|
---|
| 140 | . ;
|
---|
| 141 | . ; S.3. Count routine once if one of its lines completely matches
|
---|
| 142 | . ;
|
---|
| 143 | . I FIRST D ; when routine first gets a hit
|
---|
| 144 | . . W !?5,RTN ; make its name stand out
|
---|
| 145 | . . I $X>6 W ! ; try to keep first match line on same line with name
|
---|
| 146 | . . S RIEN=$O(^DIZ(663075,"B",RTN,0))
|
---|
| 147 | . . I '$D(^DIZ(663075,+RIEN,0)) D ; create a new entry if missing
|
---|
| 148 | . . . N RNODE S RNODE=$G(^DIZ(663075,0)) ; file header
|
---|
| 149 | . . . S RIEN=$P(RNODE,U,3) ; most recent IEN assigned
|
---|
| 150 | . . . F S RIEN=RIEN+1 Q:'$D(^DIZ(663075,RIEN)) ; find free IEN
|
---|
| 151 | . . . S $P(RNODE,U,3,4)=RIEN_U_($P(RNODE,U,4)+1) ; update recent & count
|
---|
| 152 | . . . S ^DIZ(663075,0)=RNODE ; update header
|
---|
| 153 | . . . S ^DIZ(663075,RIEN,0)=RTN ; new entry's Routine Name field (.01)
|
---|
| 154 | . . . S ^DIZ(663075,"B",RTN,RIEN)="" ; cross-reference new entry
|
---|
| 155 | . . S LIEN=$O(^DIZ(663075,RIEN,1," "),-1) ; find last line in WP
|
---|
| 156 | . . I LIEN>0 D ADDLINE(RIEN,.LIEN," ")
|
---|
| 157 | . . D ADDLINE(RIEN,.LIEN,$$HTE^XLFDT($H))
|
---|
| 158 | . S FIRST=0 ; no longer 1st hit
|
---|
| 159 | . S FINDCNT=$G(FINDCNT)+1 ; one more routine found
|
---|
| 160 | . ;
|
---|
| 161 | . ; S.4. Report each completely matching line
|
---|
| 162 | . ;
|
---|
| 163 | . W FINDCNT,"." ; for ease of using the report, # each match found
|
---|
| 164 | . W ?7 ; indent for clarity
|
---|
| 165 | . N LINEID ; how shall we ID the line?
|
---|
| 166 | . I $E(LINE)'=" " S LINEID=$P(LINE," ") ; as label, if any
|
---|
| 167 | . E S LINEID="+"_NUM ; otherwise as absolute offset
|
---|
| 168 | . S LINEID=LINEID_$J(" ",9-$L(LINEID)) ; ID then "tab" to col 16
|
---|
| 169 | . W LINEID ; display line ID to screen
|
---|
| 170 | . S LINE=$P(LINE," ",2,9999) ; remove label and ls
|
---|
| 171 | . N LINCHUNK ; each chunk of line to show
|
---|
| 172 | . F Q:'$L(LINE) D ; repeat until we're out of code
|
---|
| 173 | . . S LINCHUNK=$E(LINE,1,64)
|
---|
| 174 | . . W ?16,LINCHUNK,! ; write to screen what will fit
|
---|
| 175 | . . D ADDLINE(RIEN,.LIEN,LINEID_LINCHUNK) ; set ID + line chunk
|
---|
| 176 | . . S LINEID=" " ; just "tab" for remaining chunks
|
---|
| 177 | . . S $E(LINE,1,64)="" ; clear written code
|
---|
| 178 | I FOUNDR D
|
---|
| 179 | . W ! ; line feed to end list of matching lines for routine
|
---|
| 180 | . Q:FIND'="DSM" ; rest of block for John Harvey
|
---|
| 181 | . M ^XTMP("DSMROUTINES","ROU CODE",RTN)=FOUND("DSM")
|
---|
| 182 | . D CODEROU(RTN,.FOUND)
|
---|
| 183 | ;
|
---|
| 184 | QUIT ; end of SEARCH
|
---|
| 185 | ;
|
---|
| 186 | ;
|
---|
| 187 | CONTAINS(CODE,CONTAINS) ; function: does code contain what we're looking for
|
---|
| 188 | ;
|
---|
| 189 | ; input: CODE = line of code
|
---|
| 190 | ; output: true if line contains any of CONTAINS
|
---|
| 191 | ; called by: SEARCH
|
---|
| 192 | ;
|
---|
| 193 | N DOES I $D(CONTAINS)#2 S DOES=CODE[CONTAINS Q DOES
|
---|
| 194 | I $D(CONTAINS)>9 D Q DOES
|
---|
| 195 | . N SUB S SUB=""
|
---|
| 196 | . F S SUB=$O(CONTAINS(SUB)) Q:SUB="" S DOES=CODE[SUB Q:DOES
|
---|
| 197 | QUIT 0 ; end of CONTAINS
|
---|
| 198 | ;
|
---|
| 199 | ;
|
---|
| 200 | CODEROU(ROU,FOUND) ; subroutine: cross-reference results by code then routine
|
---|
| 201 | N NUM
|
---|
| 202 | N SUB S SUB="DSMROUTINES"
|
---|
| 203 | N CODE S CODE="" F D Q:CODE=""
|
---|
| 204 | . S CODE=$O(FOUND("DSM",CODE)) Q:CODE=""
|
---|
| 205 | . S NUM=$G(^XTMP(SUB,"CODE ROU",CODE,ROU))+FOUND("DSM",CODE)
|
---|
| 206 | . S ^XTMP(SUB,"CODE ROU",CODE,ROU)=NUM
|
---|
| 207 | . ;
|
---|
| 208 | . S NUM=$G(^XTMP(SUB,"CODE ROU",CODE,0))+FOUND("DSM",CODE)
|
---|
| 209 | . S ^XTMP(SUB,"CODE ROU",CODE,0)=NUM
|
---|
| 210 | Q
|
---|
| 211 | ;
|
---|
| 212 | ;
|
---|
| 213 | RESULTS(EXIT,COUNT,FOUND) ; subroutine: report results of search
|
---|
| 214 | ;
|
---|
| 215 | ; input:
|
---|
| 216 | ; COUNT = # of routines searched
|
---|
| 217 | ; FOUND = # of instances found
|
---|
| 218 | ; called by: ALL, RSE
|
---|
| 219 | ;
|
---|
| 220 | W !
|
---|
| 221 | I EXIT W !,"Search interrupted."
|
---|
| 222 | W !,COUNT," routine",$E("s",COUNT'=1)," searched."
|
---|
| 223 | W !,FOUND," instance",$E("s",FOUND'=1)," found."
|
---|
| 224 | QUIT ; end of RESULTS
|
---|
| 225 | ;
|
---|
| 226 | ;
|
---|
| 227 | ADDLINE(RIEN,LIEN,LINE) ; add a line to the Line WP field (2)
|
---|
| 228 | ;
|
---|
| 229 | ; Input:
|
---|
| 230 | ; LIEN = last line # in WP field
|
---|
| 231 | ; LINE = the line of text to append
|
---|
| 232 | ;
|
---|
| 233 | S LIEN=LIEN+1
|
---|
| 234 | S ^DIZ(663075,RIEN,1,LIEN,0)=LINE
|
---|
| 235 | QUIT ; end of ADDLINE
|
---|
| 236 | ;
|
---|