KBBVFND: KBBVFND.m

File KBBVFND.m, 3.5 KB (added by Jim B., 7 years ago)

KBBVFND - Barebones Global/Routine string search

Line 
1KBBVFND ;Portland/jeb Barebones search for global or routine strings May 2016
2 ;;v2.0 June 2019
3 ;; This program is free software: you can redistribute it and/or modify
4 ;; it under the terms of the GNU General Public License as published by
5 ;; the Free Software Foundation, either version 3 of the License, or
6 ;; (at your option) any later version.
7 ;;
8 ;; This program is distributed in the hope that it will be useful,
9 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
10 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 ;; GNU General Public License for more details.
12 ;;
13 ;; You should have received a copy of the GNU General Public License
14 ;; along with this program. If not, see <http://www.gnu.org/licenses>
15 ;
16EN ;
17 K %ZR,%ZG S ANS=""
18EN2 R !,"Search [G]lobal or (R)outine or [H]elp: ",WHAT:30 I '$L(WHAT) K WHAT,ANS Q
19 S WHAT=$E($$UP^XLFSTR(WHAT),1) ;Upcase it
20 I WHAT="H" D HELP G EN2
21 I WHAT="R" D
22 . R !?5,"[L]abel or [S]tring: ",W1:30 S W1=$E($$UP^XLFSTR(W1),1) Q:'$L(W1)
23 . I W1="L" R !?7,"Enter part or full label or [A]ll for all labels: ",W2:30 Q:'$L(W2) D LAB($S(W2="A":"",1:W2),$S(W2="A":W2,1:"C"))
24 . I W1="S" R !?7,"Search for string: ",MATCH:30 G EN2:'$L(MATCH) D STR(MATCH) G EN2
25 ;Q ;Testing
26 I WHAT="G" R !?2,"Search for String: ",MATCH:30 G EN2:'$L(MATCH) D GSRCH(MATCH)
27 K WHAT,WHERE,ANS,R,X,I,J,W1,W2,MATCH
28 W ! G EN2
29 ;
30LAB(MATCH,ANS) ;
31 D ^%RSEL
32 Q:$D(%ZR)#11 ;No selection array
33 D ^%ZIS U IO
34 S R="" F S R=$O(%ZR(R)) Q:R="" D
35 . S MATCH=$S('$L($G(MATCH)):"",1:MATCH)
36 . F I=1:1 S X=$T(@R+I^@R) Q:X="" S LABEL=$P(X," ") I $L(LABEL) D
37 .. I ANS="A",MATCH="" S %ZR(R,$O(%ZR(R," "),-1)+1)="+"_$J(I,5)_" "_X Q
38 .. I ANS="C",X[MATCH S %ZR(R,$O(%ZR(R," "),-1)+1)="+"_$J(I,5)_" "_X Q
39 .. ;I ANS="E",X=MATCH S %ZR(R,$O(%ZR(R," "),-1)+1)=X Q
40 D WR,^%ZISC
41 K I,ANS,MATCH,R,LABEL,X,%ZR
42 Q
43 ;
44STR(MATCH) ;Strings in the code
45 I '$L(MATCH) W !?4,"Dude! No info!" Q
46 D ^%RSEL
47 Q:$D(%ZR)#11 ;No selection array
48 D ^%ZIS U IO
49 S R="" F S R=$O(%ZR(R)) Q:R="" D
50 . F I=1:1 S X=$T(@R+I^@R) Q:X="" D
51 .. F J=1:1:$L(X,MATCH) I X[MATCH S %ZR(R,$O(%ZR(" "),-1)+1)="+"_I_" ->"_X
52 D WR,^%ZISC
53 K %ZR,R,X,I
54 Q
55 ;
56WR ;Go through %ZR array and only print path/routine name
57 ; target...
58 W !,"Searching for ",MATCH
59 S R="" F S R=$O(%ZR(R)) Q:R="" D:$O(%ZR(R,0))
60 . W !,%ZR(R)_R
61 . S N=0 F S N=$O(%ZR(R,N)) Q:'+N W !?2,%ZR(R,N)
62 Q
63 ;
64 ;ROUTINE fini
65 ;
66GSRCH(MATCH) ;Global search for string
67 D CALL^%GSEL Q:$D(%ZG)#11
68G1 W !,"Searching for ",MATCH,"...working...."
69 S N="" F S N=$O(%ZG(N)) Q:N="" S X=N W "." D
70 . F S X=$Q(@X) Q:X="" I X[MATCH!(@X[MATCH) W !,X,"->",@X
71 . K %ZG(N)
72 K WHERE,N,X,%ZG,MATCH
73 Q
74 ;Global fini
75 ;
76HELP F I=1:1 S X=$P($T(HELP+I^STUFF),";;",2) Q:'$L(X) W !,X
77 ;;G________Select to search a Global. Both node(subscript) and
78 ;; content of the subscript will be searched. Return
79 ;; will be any matches containing the string.
80 ;; HINT: To avoid searching a full global, use Merge to move
81 ;; the subscripted global to a temp/scratch global and
82 ;; just search that.
83 ;;
84 ;;R________Select to search a string in selected routine(s).
85 ;; If L for Label search is selected:
86 ;; Entering an A at the prompt will show all labels at
87 ;; the location in the routine, otherwise it will search
88 ;; for labels containing the string.
89 ;; If S for string is selected, search will be for the string
90 ;; specified in the body of the routine. All matches will get listed.
91 W !
92 Q
93 ;