$! 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