$! CD.COM v6.09
$! The Ultimate Change Directory Command.
$!
$ hdir = f$trnlnm("SYS$LOGIN") ! Home Directory
$ ndir = f$edit(p1,"UPCASE") ! New Directory
$ odir = f$environment("DEFAULT") ! Old Directory
$ prompton = (f$edit(f$trnlnm("SYS$PROMPT"),"UPCASE") .eqs. "ON")
$!
$ if (ndir .eqs. "") then goto DISPLAY ! No Dir
$ if (ndir .eqs. "*") then goto DIRSEARCH ! Search for Dirs
$ if (ndir .eqs. "?") then goto HELP ! Instructions
$!
$ PARSE:
$ length = f$length(ndir) ! Fix up ndir
$ if (f$location("@",ndir) .eq. 0) .or. -
(f$location("$",ndir) .eq. 0) then ndir = f$extract(1, length - 1, ndir)
$ right = f$location("]",ndir) + 1
$ if (right .gt. length) then right = f$location(">", ndir)
$ if (right .le. length) then ndir = f$extract(0, right, ndir)
$!
$ if (f$trnlnm(ndir) .eqs. "") then goto CASESYM ! Not Logical Name
$ ndir = f$trnlnm(ndir) ! Logical Name
$ goto PARSE
$!
$ CASESYM:
$ if ("''&ndir'" .eqs. "") then goto CASE0 ! Not Symbol
$ ndir = 'ndir' ! Symbol
$ goto PARSE
$!
$ CASE0:
$ len_ndir = f$length(ndir) ! Regular Dir
$ if (f$location("[", ndir) .lt. len_ndir) .or. -
(f$location("<", ndir) .lt. len_ndir) then goto SETDIR
$!
$ CASE1: ! Home Dir
$ if ((ndir .nes. "HOME") .and. (ndir .nes. "\")) then goto CASE2
$ ndir = hdir
$ goto SETDIR
$!
$ CASE2: ! . .. .dir
$ if (f$location(".", ndir) .nes. 0) then goto CASE3
$ if (ndir .eqs. "..") then ndir = "-"
$ if (f$extract(0, 2, ndir) .eqs. "..") -
then ndir = "-" + f$extract(1, len_ndir - 1, ndir)
$ ndir = "[" + ndir + "]"
$ if (ndir .eqs. "[.]") then ndir = odir
$ goto SETDIR
$!
$ CASE3: ! :
$ if (f$location(":", ndir) .ge. len_ndir) then goto CASE4
$ left = f$location(":", ndir) + 1
$ symbol = f$extract(left, 1, ndir)
$ if (symbol .eqs. ":") then goto CASE3B ! :: Node
$ if ((symbol .eqs. "[") .or. (symbol .eqs. "<")) then goto SETDIR
$ ndir = f$extract(0, left, ndir) + "[" -
+ f$extract(left, len_ndir - left+1, ndir) + "]"
$ goto SETDIR
$!
$ CASE3B: ! NODE::nothing
$ if (f$length(ndir)-1 .gt. left) then goto CASE3C
$ ndir = ndir + "[000000]"
$ goto SETDIR
$!
$ CASE3C: ! NODE::directory
$ if ((f$location("[", ndir) - f$location("<", ndir)) .ne. 0) -
then goto SETDIR
$
$ ndir = f$parse(ndir,,,"NODE") + "[" + f$parse(ndir,,,"NAME") + "]"
$ goto SETDIR
$!
$ CASE4: ! dir
$ ndir = "[" + ndir + "]"
$!
$ SETDIR:
$ set default 'ndir'
$ if (f$parse("") .eqs. "") then goto DIRERROR
$!
$ DISPLAY:
$ if ((ndir .nes. "") .and. prompton) then goto NODISPLAY
$ hnode = f$getsyi("NODENAME")
$ cnode = f$parse(f$trnlnm("SYS$DISK"),,,"NODE") - "::"
$ if (cnode .eqs. "") then cnode = hnode
$ cdir = f$environment("DEFAULT")
$ write sys$output " "
$ write sys$output " Home Node: ", hnode
$ write sys$output " Home Directory: ", hdir
$ if (cdir .eqs. hdir) .and. (cnode .eqs. hnode) then goto DISPSKIP
$ write sys$output " Current Node: ", cnode
$ write sys$output " Current Directory: ", cdir
$ DISPSKIP:
$ write sys$output " "
$!
$ NODISPLAY:
$ ndir = f$environment("DEFAULT")
$ if .not. prompton then goto END
$!
$ if (f$length(ndir) .ge. 32) then goto TOOLONG
$!
$ SETPROMPT:
$ set prompt = 'ndir'"$ "
$!
$ END:
$ exit
$!
$ DIRERROR:
$ write sys$output " "
$ write sys$output " ", ndir, " Directory does not exist!"
$ write sys$output " "
$ set default 'odir'
$ ndir = odir
$ goto NODISPLAY
$!
$! Prompt Problems------------------------------------------------------------
$!
$ TOOLONG:
$! Prompt is too long. Get rid of everything to the left of [ or <. If that
$! doesn't work, get rid of a subdirectory at a time. As a last resort,
$! set the prompt back to $.
$!
$ left = f$location("[", ndir)
$ len_ndir = f$length(ndir)
$ if (left .ge. len_ndir) then left = f$location("<",ndir)
$ if (left .gt. 0) .and. (left .lt. len_ndir) -
then ndir = f$extract(left, len_ndir - left, ndir)
$!
$ STILLTOOLONG:
$ if (f$length(ndir) .lt. 32) then goto SETPROMPT
$ left = f$location(".", ndir) + 1
$ len_ndir = f$length(ndir)
$ if left .ge. len_ndir then ndir = "$ "
$ if left .ne. len_ndir -
then ndir = "[*" + f$extract(left, len_ndir - left, ndir)
$ goto STILLTOOLONG
$!
$! Wildcard Directory---------------------------------------------------------
$!
$ DIRSEARCH:
$ error_message = f$environment("MESSAGE")
$ on control_y then goto DIREND
$ on control_c then goto DIREND
$ set message/nosev/nofac/noid/notext
$ write sys$output " "
$ dispct = 1
$ dirct = 0
$ pauseflag = 1
$!
$ DIRLOOP:
$ userfile = f$search("*.dir")
$ if (userfile .eqs. "") .and. (dirct .ne. 0) then goto DIRMENU
$ if (userfile .eqs. "") then goto DIRNONE
$ dispct = dispct + 1
$ dirct = dirct + 1
$ on severe then $ userprot = "No Priv"
$ userprot = f$file_attributes(userfile,"PRO")
$ if userprot .nes. "No Priv" then userprot = " "
$ userfile'dirct' = "[." + f$parse(userfile,,,"NAME") + "]"
$ userprot'dirct' = userprot
$ lengthflag = (f$length(userfile'dirct') .gt. 18)
$ if lengthflag then write sys$output -
f$fao(" !3SL !34AS ", dirct, userfile'dirct'), userprot'dirct'
$ if (.not. lengthflag) then write sys$output -
f$fao(" !3SL !20AS ", dirct, userfile'dirct'), userprot'dirct'
$ if (dispct .lt. 8) then goto DIRLOOP
$ dirct = dirct + 1
$ userfile'dirct' = ""
$ dirct = dirct + 1
$ userfile'dirct' = ""
$ if pauseflag then goto DIRMENU
$ dispct = 0
$ goto DIRLOOP
$!
$ DIRMENU:
$ write sys$output " "
$ if (userfile .eqs. "") then goto DIRMENU2
$ write sys$output " M More subdirectories"
$ if pauseflag then -
$ write sys$output " N More subdirectories/No pause"
$!
$ DIRMENU2:
$ write sys$output " R Re-Display subdirectories"
$ write sys$output " Q Quit (default)"
$
$ DIRINQUIRE:
$ write sys$output " "
$ inquire dirchoice " Select One"
$ write sys$output " "
$!
$ if (dirchoice .gt. 0) .and. -
(dirchoice .le. dirct) then goto DIRCASEDIGIT
$ dirchoice = f$edit(dirchoice,"UPCASE")
$ if (dirchoice .eqs. "") .or. -
(dirchoice .eqs. "Q") then goto DIRCASEBLANK
$ if (dirchoice .eqs. "M") .or. -
(dirchoice .eqs. "N") then goto DIRCASEMORE
$ if (dirchoice .eqs. "R") then goto DIRCASERED
$!
$ DIRCASERROR:
$ if (dirct .eq. 1) then write sys$output -
" Select 1 to change to the ", userfile1, " subdirectory. "
$ revdirct = dirct
$ if (dispct .eq. 8) then revdirct = revdirct - 2
$ if (dirct .gt. 1) then write sys$output -
" Valid subdirectory selections are 1 through ", revdirct, " (Octal)."
$ goto DIRINQUIRE
$!
$ DIRCASEDIGIT:
$ if (userfile'dirchoice' .eqs. "") then goto DIRCASERROR
$ ndir = userfile'dirchoice'
$ goto DIREND
$!
$ DIRCASEBLANK:
$ write sys$output " Subdirectory not changed."
$ write sys$output " "
$ goto DIREND
$!
$ DIRCASEMORE:
$ dispct = 0
$ if (dirchoice .eqs. "N") then pauseflag = 0
$ if (userfile .nes. "") then goto DIRLOOP
$ write sys$output " No more subdirectories to display."
$ goto DIRINQUIRE
$!
$ DIRCASERED:
$ dispct = 1
$ DISPLOOP:
$ if (userfile'dispct' .eqs "") then goto DISPDONT
$ lengthflag = (f$length(userfile'dispct') .gt. 18)
$ if lengthflag then write sys$output -
f$fao(" !3SL !34AS ", dispct, userfile'dispct'), userprot'dispct'
$ if (.not. lengthflag) then write sys$output -
f$fao(" !3SL !20AS ", dispct, userfile'dispct'), userprot'dispct'
$ DISPDONT:
$ dispct = dispct + 1
$ if (dispct .le. dirct) then goto DISPLOOP
$ goto DIRMENU
$!
$ DIRNONE:
$ write sys$output "No subdirectories to choose, or no directory privileges."
$ write sys$output " "
$ goto DIREND
$!
$ DIREND:
$ set message 'error_message'
$ on control_y then exit
$ on control_c then exit
$ if (ndir .eqs. "*") then goto DISPLAY
$ goto PARSE
$!
$!-Help-----------------------------------------------------------------------
$!
$ HELP:
$ type sys$input
CD.COM Version 6 VMS Change Directory Command
Usage: CD command/directory
CD Display home directory, CD .. Change directory to the
current directory, node. CD [-] dir above current dir.
CD \ Change directory to your CD ..sub Change directory to a
CD HOME SYS$LOGIN directory. CD [-.sub] "sideways" subdirectory.
CD dir Change directory to the CD * Display/select the
CD [dir] [dir] directory. available subdirectories.
CD .sub Change directory to the CD . Reset current directory.
CD [.sub] [.sub] subdirectory. CD ? Display CD instructions.
CD :== @SYS$LOGIN:CD.COM DEFINE SYS$PROMPT "ON"
To make CD available from To have the VMS $ prompt
any directory you change to. display the current directory.
By The Mentor
$ goto END