FUNCTION sort_uniq_wipe,str ; sorts, uniqs strings in string array str, and removes ; any multiple blank or null strings str1=str(sort(str)) ; sort the strings in alpha order str1=str1(uniq(str1)) ; keep only the unique ones w=where(str1 NE '',n0) if (n0 NE 0) then str1=str1(w) ; delete null strings RETURN,str1 END FUNCTION DOLLAR_WRAP,lines ; looks for lines in a program ending ; in a '$' sign and appends the successive lines stopping at one that ; has no '$' sign, returning the program unchanged except for wrapping. ; If no $ are found, the original input string is returned unchanged ; ; NOTE: To prevent comment after a $ from being wrapped, run ; remove_comments.pro before this program. ; The case of a quoted $ is taken care of. dollar_pos=stregex(lines,'\$') ; result like [-1,-1,26,20,-1,-1,-1] ; check to see if any of the '$' lies between quotes (either ' or "): quot1_pos=stregex(lines,"'") & quot2_pos=stregex(lines,'"') ; check for ' or " ;appearances of ' & $ in same line: both=where((dollar_pos NE -1) AND ((quot1_pos NE -1) OR (quot2_pos NE -1)),nb) if (nb NE 0) then begin for j=0,nb-1 do begin bytstr=byte(lines(both[j])) ; convert line to a byte array b0=(byte("$"))[0] & b1=(byte("'"))[0] & b2=(byte('"'))[0] w_doll=where(bytstr EQ b0) w1=where(bytstr EQ b1) & w2=where(bytstr EQ b2) if w1[0] NE -1 then $ if w_doll[0] GT w1[0] AND w_doll[0] LT w1[1] then begin ;print,both[j],' ',lines(both[j]) d1=lines(both[j]) & strput,d1,'#',w_doll[0] lines(both[j])=d1 endif ; replaced $ between ' and ' by # if w2[0] NE -1 then $ if w_doll[0] GT w2[0] AND w_doll[0] LT w2[1] then begin ;print,both[j],' ',lines(both[j]) d2=lines(both[j]) & strput,d2,'#',w_doll[0] lines(both[j])=d2 endif ; replaced $ between " and " by # endfor dollar_pos=stregex(lines,'\$') ; repeat now that quoted $ has been eliminated endif line_num=where(dollar_pos NE -1,Nd) ; = line number of the lines with a $ ; dollar_pos(line_num) contains the position out_string=lines ; if ND=0 return the original lines unchanged if Nd NE 0 then begin olines=lines group_start=lonarr(Nd) & group_index=lonarr(Nd) d=[-1,line_num] ; Example: ; converts line_num= [35,39,59,67,68,69,70,71,72,73,74,75,76,77,78,79,92,93,95,109] ; 0 1 2 3 . . . . . . . . . . . . 16 . 18 19] ; into ; group_start= [ 35, 39, 59, 67, 92, 95, 109 ] ; group_index= [ 0, 1, 2, 3, 16, 18, 19 ] ; group_size= [ 1, 1, 1, 13, 2, 1, 1 ] group_index=where(line_num-shift(line_num,1) NE 1) ; successors/non-successors group_start=line_num[group_index] n_groups=n_elements(group_start) group_size=shift(group_index-shift(group_index,1),-1) ; calculates all but the last size group_size(n_groups-1)=n_elements(where(line_num GE max(group_start))) ; the last size olines=lines for j=0,nd-1 do begin ; replace each '$' with '' A=lines(line_num[j]) strput,A,' ',dollar_pos(line_num[j]) olines(line_num[j])=A endfor n_lines=n_elements(olines) concat_lines=strarr(total(group_size)+n_groups) for j=0,n_groups-1 do $ concat_lines[j]=strjoin(olines(group_start[j]:group_start[j]+group_size[j])) out_string=lines(0:line_num[0]-1) ; all lines down to first $ inx2=n_lines ; needed to permit execution of "if inx2+1 LE n_lines-1" for g=0,n_groups-1 do begin ; append the lines together in each group out_string=[out_string,concat_lines[g]] if g+1 LE n_groups-1 then begin inx1=group_start[g]+1+group_size[g] inx2=group_start[g+1]-1 ; eliminate collisions where no lines exist between groups: if inx1 LE inx2 then $ ; append lines up to next group out_string=[out_string,olines(inx1:inx2) ] endif endfor if inx2+1 LE n_lines-1 then out_string=[out_string,olines(inx2+1:n_lines-1)] endif RETURN,out_string END ; DOLLAR_WRAP FUNCTION extract_word,str ; extracts the 1st word from a string of words separated by white ; space. Ignores leading spaces ; Returns the null string if str is all blank s1=strcompress(str) ; check for totally blank strings if (s1 EQ ' ') OR (s1 EQ '') then begin out_string='' endif else begin ; remove any leading blanks if (strmid(str,0,1) EQ ' ') then begin ; there is a leading blank pos=strpos(str,' ',1) out_string=strmid(str,1,pos-1) endif else begin pos=strpos(str,' ',0) ; no leading blank out_string=strmid(str,0,pos) endelse endelse return,out_string END PRO replace_tagged_substring,str,a,b,replacement ; Finds all substrings of the form a*****b, where a and b are tags ; and replaces each substring between the tags ; a,b with the string replacement ; If a or b is not found, the output is str ; If a and b are the same, nothing can be done, so the output is str ; The length of str is unchanged ; ;INPUTS: ; str=scalar STRING ; a=character STRING (length 1) ; b=character STRING (length 1) ; replacement=character STRING (length 1) ; ; EXAMPLE: ; STR='[0.00,22.00]' ; REPLACEMENT='X' ; A='[' ; b=']' ; result='x' bytstr=byte(str) r_byt=byte(replacement) if n_elements(r_byt) NE 1 then message,'Replacement not a single character.' if (n_elements(byte(a)) GT 1) OR (n_elements(byte(b)) GT 1) then $ message,'Warning: multi-character substring',/info a_byt=(byte(a))(0) ; convert to a scalar b_byt=(byte(b))(0) ; convert to a scalar wa=where(bytstr EQ a_byt,na) wb=where(bytstr EQ b_byt,nb) if (na NE 0) AND (nb NE 0) AND (na EQ nb) then begin for j=0,na-1 do bytstr[wa[j]:wb[j]]=r_byt endif str=string(bytstr) RETURN END ; replace_tagged_substring FUNCTION extract_tagged_substring,str,a,b ; Finds all substrings of the form a*****b, where a and b are characters ; and extracts each substring between the tags ; a,b into an output string array (leading spaces are removed) ; If a or b is not found, the output is the null string. ; If a and b are the same, the results are useless, so don't use it ; for quotes! ; EXAMPLE: ; STR=', xyoffset=xyoffset) ; a=',' b='=' ; output='xyoffset' ; ;INPUTS: ; str = STRING ; a=single-character string (tag) ; b=single-character string (tag) bytstr=byte(str) if (n_elements(byte(a)) GT 1) OR (n_elements(byte(b)) GT 1) then $ message,'Warning: multi-character substring',/info a_byt=(byte(a))(0) ; convert to a scalar b_byt=(byte(b))(0) ; convert to a scalar wa=where(bytstr EQ a_byt,na) wb=where(bytstr EQ b_byt,nb) if (na EQ 0 or nb EQ 0) then begin ;message,'No occurrences of '+a+' or '+b+' in string.',/info out_strarr=[''] endif if (nb GT na) then begin ;message,'More b tags than a tags, dropping first b',/info wb=wb(1:*) endif nc=min([na,nb]) if nc GT 0 then begin out_strarr=strarr(nc) for j=0,nc-1 do begin out_strarr[j]=string(bytstr[wa(j)+1:wb(j)-1]) out_strarr[j]=strcompress(out_strarr[j],/rem) endfor endif return,out_strarr END ; extract_tagged_substring FUNCTION remove_comments,z ; returns a program listing without any comment lines. ; comments that start in midline are also removed. ; All white spaces are reduced to single spaces before returning. ;INPUTS: ; z=string array representing a program listing space=(byte(' '))[0] null=(byte(''))[0] semi=(byte(';'))[0] z1=z k=0 z2=strarr(n_elements(z1)) n=n_elements(z1) for j=0,n-1 do begin zj=strcompress(z1[j]) zz=byte(zj) w=where(zz EQ semi,nw) if nw NE 0 then begin zz(w[0]:*)=space z1[j]=strcompress(zz) endif ; we're left with no-comment lines, single space lines or nulls if (z1[j] NE ' ') AND (z1[j] NE '') then begin z2[k]=z1[j] k=k+1 endif endfor RETURN,z2[0:k-1] END ;remove_comments.pro FUNCTION find_keywords,pro_file,SHOW_LINES=show_lines PURPOSE: ; Parses a string array representing an IDL program and finds uncommented ; lines containing: ; SET, keywd1=yyyy,keywd2=wwww, etc ; GETDATA( keywd3=vvvv,keywd4=tttt, etc ; GET(/keywd5) ; ;INPUTS: ; PRO_FILE=Text IDL program pathname ; e.g. jim_test.pro or /home/dinsick/mem_sato_test.pro ; ;OUTPUTS: ; Returns a string array of unique keywords ; (e.g. [keywd1,keywd2,keywd3,keywd4,keywd5) ; ; if SHOW_LINES is set, the parsed lines of the program will be ; printed ; ; RESTRICTIONS: ; Doesn't know about '/xxxxx" constructs in SET or GETDATA commands ; Bad syntax that crashes IDL will mislead and/or crash this program. ; Will not find keywords in hessi_image(). (yet) ; ; CALLS dollar_wrap, extract_tagged_substring,replace_tagged_substring, ; ; HISTORY: ; EJS GSFC 9/10/2001 ; 9/21/2001 Small upgrades: include '/xxxxx" in GET() ; 10/15/2001 incorporated rd_ascii.pro on suggestion of RS. ;- z=strarr(1000) ; Open the file message,'Searching '+pro_file+' for keywords...',/info if find_file(pro_file) EQ '' then message,'FILE '+pro_file+' NOT FOUND.' z=rd_ascii(pro_file) i=0 z1=z z1=remove_comments(z) ; Get rid of any '[xx,yy]' constructs which confuse keyword search z=strupcase(z1) zd=dollar_wrap(z) ;print,zd ; Look for appearance of ' set' or '>set,' in all lines ; (setstrings=grep(' set,',z) is not suitable for both ' set' and '>set,') reg=stregex(zd,"[>\ ]SET,") w=where(reg NE -1,nw) if nw GT 0 then setstrings=zd[w] ns=n_elements(setstrings) if ns NE 1 then print,'There are',strcompress(ns),' SET commands.' $ else print,'There is 1 SET command.' set_keywords='' if ns GT 0 then begin set_keywords=strarr(100) if keyword_set(show_lines) then for j=0,ns-1 do print,j+1,': ',setstrings[j] for j=0,ns-1 do begin ; extract the keywords on each on the "SET," lines setstrings[j]=strcompress(setstrings[j],/rem) if j EQ 0 then set_keywords=extract_tagged_substring(setstrings[j], ',', '=') if j GT 0 then set_keywords=[set_keywords,extract_tagged_substring(setstrings[j], ',', '=')] endfor nsk=n_elements(set_keywords) set_keywords=sort_uniq_wipe(set_keywords) nsk=n_elements(set_keywords) print,'Found the following keywords in the SET commands:' if nsk GE 1 then for k=0,nsk-1 do print,' ',set_keywords[k] keywds=set_keywords endif reg=stregex(zd,"GETDATA") getd_keywd='' w=where(reg NE -1, ng) ; locations of lines containing "GETDATA" if keyword_set(show_lines) then print,'-----GETDATA LINES BEING PARSED:-----' getd_keywords=[' '] if ng NE 0 then begin for n=0,ng-1 do begin getd_str=strupcase(zd[w[n]]) ; a line containing "GETDATA" if keyword_set(show_lines) then print,n+1,': ', strcompress(getd_str) ; replace the first '(' with ',' paren_pos=7+strpos(getd_str,'GETDATA(' ) & strput,getd_str,',',paren_pos getd_str=strmid(getd_str,paren_pos) ; use only chars after GETDATA getd_str=strcompress(getd_str,/rem) ; Get rid of commas between brackets; i.e. [...,...] -> [~~~~~~~] replace_tagged_substring,getd_str,'[', ']', '~' getd_keywd=extract_tagged_substring(getd_str,',', '=' ) getd_keywords=[getd_keywords,getd_keywd] endfor getd_keywords=getd_keywords[1:*] ; drop the blank one at the beginning endif ; If non-null blank lines sneak thru, change them to null strings: ngd=n_elements(getd_keywords) if (ngd GT 0) then for j=0,ngd-1 do $ getd_keywords[j]=strcompress(getd_keywords[j],/rem) getd_keywords=sort_uniq_wipe(getd_keywords) wg=where(getd_keywords NE '',ngd) if ngd NE 1 then print,'Found'+strcompress(ngd)+' GETDATA keywords' if ngd EQ 1 then print,'Found'+strcompress(ngd)+' GETDATA keyword' if ngd NE 0 then for j=0,ngd-1 do print,' ',getd_keywords[j] ; Find "GET(" keywords reg=stregex(zd,"GET\(") ; must escape the ( hence \( get_keywords='' w=where(reg NE -1, ng) ; locations of lines containing "GET(" if keyword_set(show_lines) AND (ng NE 0) then $ print,'-----"GET(" LINES BEING PARSED:-----' if ng NE 0 then begin for n=0,ng-1 do begin get_str=strupcase(zd[w[n]]) ; a line containing "GET(" get_str= strcompress(get_str,/rem) if keyword_set(show_lines) then print,n+1,': ', get_str paren_pos=4+strpos(getd_str,'GET(' ) get_str=strmid(get_str,paren_pos) ; use only chars after GET( get_str=strcompress(get_str,/rem) slash_pos=strpos(get_str,'/' ) & par_pos=strpos(get_str,')' ) if slash_pos GT 0 then begin get_keywd=strmid(get_str,slash_pos+1,par_pos-slash_pos-1) endif else get_keywd='' if n EQ 0 then get_keywords=get_keywd else $ get_keywords=[get_keywords,get_keywd] endfor endif else print,'Found 0 GET keywords' if ng GT 1 then print,'Found'+strcompress(ng)+' GET keywords' if ng EQ 1 then print,'Found'+strcompress(ng)+' GET keyword' if (set_keywords[0] NE '') AND (getd_keywords[0] NE '') then begin keywords=[set_keywords,getd_keywords] endif else begin if (getd_keywords[0] EQ '') then keywords=set_keywords if (set_keywords[0] EQ '') then keywords=getd_keywords endelse if (get_keywords[0] NE '') AND (keywords[0] NE '') then $ keywords=[keywords,get_keywords] return,keywords END ; find_keywords FUNCTION CHECK_KEYWORDS,pro_keywords,VERB=verb ; ; PURPOSE: ; Take user's list of keywords and compare it with the master list, ; 'keywords.tbl'. ; ; INPUTS: ; pro_keywords is a string array output by the routine find_keywords.pro ; wk=where(pro_keywords EQ '',nw) & ns=n_elements(pro_keywords) if (ns EQ nw) then message,'No keywords found in program',/info if (ns GT nw) then begin ; Read all the hessi keywords from keywords.tbl: if find_file('keyword.tbl') EQ '' then message,'FILE keyword.tbl NOT FOUND.' keywoids=rd_ascii('keyword.tbl') nk=n_elements(keywoids) keywords='' hessi_keywords=strarr(3,nk) for k=0,nk-1 do begin keywoids=strcompress(keywoids) hessi_keywords[0,k]=extract_word(keywoids) endwhile print,'Read'+strcompress(nk)+' HESSI keywords from keywords.tbl' print,$ 'Comparison of'+strcompress(ns)+' program keywords with HESSI keyword.tbl:' checked_keywords=strarr(2,ns) checked_keywords[0,*]=pro_keywords if (ns LT 1) then begin print,'No SET keywords to check' endif else begin for j=0,ns-1 do begin check='not found' for k=0,nk-1 do $ if strupcase(pro_keywords[j]) EQ hessi_keywords[0,k] then check='found' checked_keywords[1,j]=check fmt='(a32,t40,a10)' print,' '+checked_keywords(0,j),checked_keywords(1,j), format=fmt endfor endelse endif else checked_keywords='' RETURN,checked_keywords END ; check_keywords ; MAIN file='memsato_flare6.pro'; ;file='/home/schmahl/testdata.figures/sim_jim.pro' ;file='/home/schmahl/dinsick/hsi_memvis_demo_pntsrc_test.pro' ;/home/schmahl/dinsick/hsi_memvis_demo.pro' ;file='/home/schmahl/overres/err_example.pro' ;file='/home/schmahl/overres/fits_bproj_test.pro' ;file='/home/schmahl/testdata.figures/clean6_to_figure.pro ; no objects ;file='andre.pro' ;file='fwdfit_demo.pro' ;file='hsi_printf_keyword_tbl.pro' ;pro_keywds=find_keywords(file) ;,/show_lines) ;chk_wds=check_keywords(pro_keywds) ;,/verb) end