Viewing contents of file '../idllib/user_contrib/creaso/changedir.pro'
; Copyright(c) 1992, CreaSo Creative Software Systems GmbH. All rights reserved.
; Unauthorized reproduction prohibited.
;+
; NAME:
; CHANGEDIR
;
; PURPOSE:
; This routine changes the current directory.
;
; CALLING SEQUENCE:
; changedir, dir, error=error, /message
;
; INPUTS:
; None
;
; KEYWORDS:
; error - if an error occured, error is -1
; message - if an error occured, a message wil be send
;
; OUTPUT:
; None
;
; COMMON BLOCKS:
; None
;
; SIDE EFFECTS:
; No known side effects.
;
; RESTRICTIONS:
; For VAX/VMS only.
;
; EXAMPLE:
;
; MODIFICATION HISTORY:
; July 1992, AH, CreaSo Created.
;-
pro changedir, directory, error=error, message=message
;Inialize variables
error = 0
if n_params() eq 0 then return
;a: Initialize path value
if (strpos(directory, '[]') ne -1) then cd, current=dire $
else dire = strcompress(directory)
;a: Scan full path
filescan, dire, path=path, node=node, dir=dir, dev=dev, $
/full, /current, /exclude
if ((byte(dir(0)))(0) eq (byte('.'))(0)) or $
((byte(dir(0)))(0) eq (byte('-'))(0)) then begin
error = -1
if keyword_set(message)then begin
print, "% changedir.pro: Path not found - "+ path
endif
return
endif
if (dir ne '') then begin
junk = loadarray(dir, '.')
if (n_elements(junk) eq 1 and junk(0) eq '000000') then begin
stat = trnlog (dev, ans)
if (stat eq 1) then if (strpos(ans(0), '.]') eq -1) then dirs = junk
endif else dirs=junk
endif
case n_elements(dirs) of
0 : begin
stat = trnlog (dev, ans)
if (stat eq 1) then begin
pos = strpos(ans(0), '.]')
if (pos ne -1) then begin
filescan, strmid(ans(0), 0, pos)+']', $
node=cnode,dev=cdev,dir=cdir, /exclude
d = loadarray (cdir, '.')
if (n_elements(d) gt 1) then $
cdir = '['+restorearray (d, '.', 0, n_elements(d)-2)+']' $
else cdir = '[000000]'
destdir = d(n_elements(d)-1)
endif else begin
cnode = node
cdev = dev
cdir = '[000000]'
destdir = '000000'
endelse
endif else begin
cnode = node
cdev = dev
cdir = '[000000]'
destdir = '000000'
endelse
end
1 : begin
stat = trnlog (dev, ans)
if (stat eq 1) then begin
pos = strpos(ans(0), '.]')
if (pos ne -1) then begin
cdir = strmid(ans(0), 0, pos)+']'
filescan,cdir,dir=cdir,dev=cdev,/exclude
if (cdir eq '') then cdir = '000000'
cdir = '['+cdir+']'
endif else begin
cdir = '[000000]'
endelse
endif else begin
cdir = '[000000]'
endelse
cnode = node
cdev = dev
destdir = dirs(0)
end
else : begin
cnode = node
cdev = dev
cdir = '['+restorearray(dirs,'.',0,n_elements(dirs)-2)+']'
destdir = dirs(n_elements(dirs)-1)
end
endcase
dest = ''
if (cnode ne '') then dest = cnode+'::'
if (cdev ne '') then dest = dest+cdev+':'
if (cdir ne '') then dest = dest+cdir $
else dest = dest+'[000000]'
dest = dest+destdir+'.dir'
ans = findfile (dest)
if (ans(0) ne '') then cd, path $
else begin
error = -1
if keyword_set(message)then begin
print, "% changedir.pro: Path not found - "+ path
endif
endelse
return
end