Viewing contents of file '../idllib/iuedac/iuelib/pro/getpro.pro'
;******************************************************************************
;+
;*NAME:
;
; GETPRO AUG. 28, 1989
;
;*CLASS:
;
; File copy utility
;
;*CATEGORY:
;
;*PURPOSE:
;
; To copy IDL procedure files to the current directory.
;
;*CALLING SEQUENCE:
;
; GETPRO,PROC_NAME,OUT_NAME,LIBRARY
;
;*PARAMETERS:
;
; PROC_NAME (REQ) (I) (0) (S)
; Procedure name without the .pro suffix.
;
; OUT_NAME (OPT) (I)
; New name for the procedure without the .pro suffix.
; If not given, PROC_NAME is used.
;
; LIBRARY (OPT) (I)
; Specific directory (VMS or UNIX) or text library (VMS only)to search.
; If not given, defaults to directories (VMS and UNIX) and text
; libraries (VMS only) in !path.
;
;*EXAMPLES:
;
; To copy the procedure "iueplot" to the current directory
; use:
; getpro,'iueplot'
;
; To copy the procedure "iueplot" to the current directory
; and rename it to "myplot" use:
; getpro,'iueplot','myplot'
;
; To copy the procedure "myplot" from a specific directory
; to the current directory use:
; VMS: getpro,'myplot','','IUE$USER0:[USER#.SUBDIR]'
; UNIX: getpro,'myplot','','/home/user/subdir'
;
; To copy the procedure "set_xy" from a specific directory (UNIX)/
; text library (VMS) to the current directory use:
; VMS: getpro,'set_xy','','@IDL_DIR:[LIB]USERLIB.TLB'
; UNIX: getpro,'set_xy','','/home/iueidl/lib/userlib'
;
;
;*SYSTEM VARIABLES USED:
;
; !path
;
;*INTERACTIVE INPUT:
;
;*SUBROUTINES CALLED:
;
; PARCHECK
; IUEGETTOK
; PLATFORM
; COPUF
;
;*FILES USED:
;
; LIBEXT.COM (VMS only)
;
;*SIDE EFFECTS:
;
; If file already exists,
; for VMS: the new version will supersede the existing versions(s).
; for UNIX: the user will be asked if the old version should be
; overwritten.
;
;*RESTRICTIONS:
;
; Finds only the first occurrence of the procedure.
;
;*NOTES:
;
; Not ready to be used on Macintosh.
;
; tested with IDL Version 2.1.0 (sunos sparc) 18 Jun 91
; tested with IDL Version 2.1.0 (vms vax) N/A
; tested with IDL Version 2.1.0 (ultrix mipsel) 21 Jun 91
;
;*PROCEDURE:
;
; If no LIBRARY is specified, GETPRO searches the libraries
; in the IDL system variable !path for the requested procedure.
; If the procedure is not found in the directories (UNIX and VMS) or
; text library (VMS only) pointed to by !path, the IUERDAF's experimental
; library is searched. If the procedure is still not found, the
; IUERDAF's copy of the CURDAF's experimental library is searched.
; If a LIBRARY is specified, only that directory is searched.
; If a text library is specified, only that library is searched.
; If the procedure is found during the search process,
; the user is notified. If an OUT_NAME is given, the file will
; be copied to thet name. Otherwise, the PROC_NAME is used.
; On VMS systems, the current directory is checked to see
; if a version of the output name already exists. If it does, the
; user is warned that this version will supersede the old version(s).
; On UNIX systems, if the output file name already exists,
; the user is asked if the old version should be overwritten.
;
;*I_HELP nn:
;
;*MODIFICATION HISTORY:
;
; aug. 28, 1989 jtb version 1 for unix/sun idl
; 4-10-91 KBC modify filename structure based on operating system type
; for compatibility on SUN/DEC/VAX
; 5-23-91 PJL modified and tested VMS and UNIX versions; removed VMS
; LIBEXT command file and UNIX GETPRO command file - procedure
; no longer needs any command file; added IUEGETTOK and !path
; 6-21-91 PJL added IUERDAF's copy of the CURDAF's experimental library
; to the search path; tested on SUN and VAX; updated prolog
; 1-21-92 PJL added LIBEXT.COM to allow VMS text libraries to be searched
; 9 Apr 92 PJL added getenv to experimental and curdaf library branches
; 14 Jun 94 PJL replaced !version with PLATFORM and check for libext.com
; 30 Aug 94 RWT allow up to 30 libraries to be searched
; 23 Nov 94 LLT use !iuer and get rid of search of curdaf library
; 24 Jan 95 LLT get rid of one getenv command that was missed in Nov 94.
; 23 Mar 95 RWT use COPUF if icopy = 'na'
;-
;******************************************************************************
pro getpro,proc_name,out_name,library
;
npar = n_params(0)
if npar eq 0 then begin
print,'GETPRO,PROC_NAME,out_name,library'
retall
endif ; napr
parcheck,npar,[1,2,3],'GETPRO'
;
; obtain system information
;
platform,dummy,copymes=copymes,ncopy=ncopy,icopy=icopy,syntax=syntax
;
if (npar lt 3) then begin
filepath = !path
sepobj = syntax.pathlist
libname = strarr(30)
;
; Separates the paths given in !path.
;
for i = 0,29 do begin
iuegettok,filepath,sepobj,temp
libname(i) = temp
if (filepath eq '') then begin
numlib = i
goto,search
endif ; filepath
if (i eq 29) then begin
print,'Array LIBNAME is too small'
retall
endif ; i
endfor ; i
endif else begin
;
; For a given directory.
;
if ((out_name eq '') or (out_name eq ' ')) then out_name = proc_name
numlib = 0
libname = strarr(1)
libname(0) = library
print,'Searching ' + library + ' for procedure ' + strupcase(proc_name)
endelse ; npar
;
search:
if npar lt 3 then $
print,'Beginning search for procedure ' + strupcase(proc_name)
;
; determine if libext.com file exists
;
libext = !iuer.exe + 'libext.com'
libtemp = findfile(libext,count=libct)
;
; Search the libraries in !path or the specified library.
;
for i = 0,numlib do begin
if (syntax.execute eq '') then text = -1 else $
text = strpos(libname(i),syntax.execute)
if ((text ge 0) and (libct gt 0)) then begin
;
; Search the VMS text library
;
textlib = strmid(libname(i),text+1,strlen(libname(i))-1)
runl = syntax.execute + !iuer.exe + 'libext ' + proc_name
if (npar eq 1) then runl = runl + ' ' + proc_name + ' ' + textlib $
else runl = runl + ' ' + out_name + ' ' + textlib
spawn,runl
a = trnlog('FOUND_LIB',oldfile)
if (oldfile ne 'UNKNOWN') then begin
print,'File ' + strupcase(proc_name) + ' found in ' + oldfile + '.'
return
endif ; oldfile
endif else begin
;
; Search the directory.
;
if (syntax.endpath ne ']') then libname(i) = libname(i) + $
syntax.endpath
name = libname(i) + proc_name + '.pro'
oldfile = findfile(name,count = number)
if (number gt 0) then goto,found
endelse ; text
endfor ; i
;
; If procedure not found, search experimental library.
;
if (npar lt 3) then begin
print,strupcase(proc_name) + ' not found in IDL_PATH'
name = !iuer.expr + proc_name + '.pro'
oldfile = findfile(name,count = number)
if (number gt 0) then goto,found
;
; Procedure not found in !iuer.expr (when npar lt 3)
;
print,strupcase(proc_name) + ' not found in experimental library'
;
; Procedure not found (when npar ge 3)
;
endif else print,strupcase(proc_name) + ' not found in ' + library
retall
;
found:
print,'File ' + oldfile + ' found'
;
; Determines output file name.
;
if (npar ge 2) then begin
if ((out_name eq '') or (out_name eq ' ')) then $
ofile = proc_name + '.pro' else ofile = out_name + '.pro'
endif else ofile = proc_name + '.pro'
;
; copy file
;
if (ncopy eq 'NA') then copuf,oldfile(0),ofile,/form $
else begin
cmd = ' ' + name + ' ' + ofile
check = findfile(ofile,COUNT=number)
if (number gt 0) then print,'WARNING: output file will' + $
copymes.present + ' an existing version.'
if (strtrim(copymes.present,2) eq 'supersede') then $
spawn,ncopy + cmd else spawn,icopy + cmd
endelse
;
return
end ; getpro