;+ ; Contains the extrait_lis procedure ; ; :Author: ; Philippe Zarka ; ; :History: ; 2004/07/30: Created ; ; 2004/07/30: Last Edit ;- ; ;+ ; extraction de la liste de modes de "nomlis" contenant "chaine" a la position ; "position" et ecriture du fichier "nomext" ; (avec saut de ligne au changement de jour). ; ; "chaine" peut contenir des "?" comme "wildcard". ; ; si chaine = "?", alors nomext = nomlis + saut de ligne au changement de jour. ; ; :Params: ; nomlis: in, required, type=sometype ; fichier lis ; position: in, required, type=int ; position de "chaine" ; chaine: in, required, type=string ; recherché à la position "position" ; nomext: in, required, type=string ; fichier de sortie ; nomscratch: in, required, type=byte ; si present, extraction de .../Pro/liste.scratch des ; fichiers NE contenant QUE le mode selectionne et ecriture dans "nomscratch". ;- pro EXTRAIT_LIS, nomlis, position, chaine, nomext, nomscratch if N_elements(nomscratch) eq 0 then scr=0 else scr=1 longueur=strlen(chaine) ;for j=0,longueur-1 do if strmid(chaine,j,1) eq ' ' then $ ; chaine = strmid(chaine,0,j)+string(202b)+strmid(chaine,j+1,longueur-j-1) ; chargement de "nomlis" et ouverture de "nomext" openr,ur,nomlis,/get_lun bb='' & b='' on_ioerror, finb suiteb: readf,ur,b bb=[bb,b] goto,suiteb finb: bb=bb[1:*] jour=strmid(bb,1,7) fichier=strmid(bb,0,11) nbb=n_elements(bb) close,ur & free_lun,ur openw,uw,nomext,/get_lun ; chargement de liste.scratch et ouverture de "nomscratch" if scr then begin ll='' & l='' openr,ut,'liste.scratch',/get_lun on_ioerror, finl suitel: readf,ut,l ll=[ll,l] goto,suitel finl: nll=n_elements(ll) close,ut & free_lun,ut openw,ul,nomscratch,/get_lun endif ; ecriture de "nomext" for k=0,nbb-1 do begin b=bb(k) if b eq '' then printf,uw,b else begin ; saut de ligne longb=strlen(b) if longb ge position+longueur then begin buf=b for j=0,longueur-1 do if strmid(chaine,j,1) eq '?' then $ buf = strmid(buf,0,position+j)+'?'+strmid(buf,position+j+1,longb-j-1) if strmid(buf,position,longueur) eq chaine then begin if k gt 0 then if jour(k) ne jour(k-1) then printf,uw ; saut de ligne printf,uw,b if scr and n_elements(where(fichier eq fichier(k))) eq 1 then $ for j=0,nll-1 do if strmid(ll(j),strlen(ll(j))-11,11) eq fichier(k) $ then printf,ul,ll(j) endif endif endelse endfor close,uw & free_lun,uw if scr then begin close,ul & free_lun,ul endif return end