From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX" 27-JUL-1989 11:47
To:	MRGATE::"ARISIA::EVERHART"
Subj:	Re: Anyone have a UNIX-Like CD for VMS

Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Thu, 27 JUL 89 07:13:20 PDT
Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Thu, 27 Jul 89 07:10:08 PDT
Received: by ucbvax.Berkeley.EDU (5.61/1.37)
	id AA23632; Thu, 27 Jul 89 06:57:26 -0700
Received: from USENET by ucbvax.Berkeley.EDU with netnews
	for info-vax@kl.sri.com (info-vax@kl.sri.com)
	(contact usenet@ucbvax.Berkeley.EDU if you have questions)
Date: 27 Jul 89 13:49:53 GMT
From: robert@arizona.edu  (Robert J. Drabek)
Organization: U of Arizona CS Dept, Tucson
Subject: Re: Anyone have a UNIX-Like CD for VMS
Message-Id: <12874@megaron.arizona.edu>
References: <8907242012.AA00554@ucbvax.Berkeley.EDU>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

In article <8907242012.AA00554@ucbvax.Berkeley.EDU>, TNIELAND@FALCON.BERKELEY.EDU (Ted Nieland) writes:
> Does anyone have a UNIX-Like CD for VMS?  I have several
> users who a very used to UNIX and would like to a CD command
> that works the same.  The last CD posted here was not UNIX
> compatible.  I know I have heard of some, but I need to get
> a hold of one.
> 
> TNIELAND@AAMRL.AF.MIL

The following is very Unix compatible.  The only caution is (like most
of these programs) it doesn't verify that the directory exists, so it
is like "set default" it that way.

It understands devices and can go up and down any number of levels.
Actually understands both Unix and VMS names!
"cd ?" gives a quick help message with examples.



{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

  A Pascal program to set the default device and directory.

  Similar to the "cd" (change directory) command of Unix.

  Accepts both VMS and UNIX directory names.  Examples of commands are:

             cd sub               cd dev:
             cd /a/b              cd dev:sub
             cd [a.b.c]           cd dev:/a/b/c
             cd ../../sub         cd dev:[a.b.c]
             cd

  It must be used as a foreign command which can be created with:
    $ CD :== $CSC_DISK:[CSC.BIN]CD.EXE  (use your own drive/directory names)

  Author:
    Robert J. Drabek   May 1989
    Department of Computer Science
    The University of Arizona
    Tucson, Arizona   85721

  Inspired by my own very old CD.COM and by a program written in
  Pascal by Rotan Hanrahan, February 1989, Dept of Comp Sci, UCD,
  Dublin Ireland, 1989 which in turn was based on CD.COM which
  appeared in Pageswapper, March 1982.

  This program is really much different than the above mentioned
  inspirations.  No history stack is included.

  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

program cd(output);

const
  ALLOWED_DIR_DELIMITER = '/';
  REAL_DIR_DELIMITER    = '.';
  HELP_COM              = '?';
 
  SET_ERROR =
  '%CD-F-NODIR, could not change directory to ';
  MAXPARM_ERROR = 
  '%CD-F-MAXPARM, too many parameters - reenter command with fewer parameters';

type
 word_type  = 0..65535;
 text_range = 1 .. 255;
 string     = varying[255] of char;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

procedure LIB$Get_Foreign(var Cmd_Line: varying [n] of char);
extern;

procedure LIB$Set_Logical(%Descr LogNam: varying [n] of char;
                          %Descr Valu:   varying [m] of char);
extern;

procedure LIB$Sys_TrnLog(%Descr LogNam: varying [n] of char;
                         var RetLen:    [word] word_type;
                         var Result:    varying [m] of char);
extern;

procedure SYS$SetDDir(newdir: [Class_S] packed array [x..n:Integer] of char;
                      var RetLen: [word] word_type;
                      var CurAdr:
                              [Class_S] packed array [a..b:Integer] of char);
extern;

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

{ do_help
    Help the novice.
}
procedure do_help(var disk, directory : string);
begin
  writeln('Current device    : ', disk);
  writeln('Current directory : ', directory);
  writeln;
  writeln('Commands:');
  writeln(' CD                          Go to Sys$Login');
  writeln(' CD ..                       Go to parent directory');
  writeln(' CD /                        Go to root directory');
  writeln(' CD directory_specification  Go to specified directory');
  writeln(' CD ?                        Get help');
  writeln;
  writeln('Specification can be a mixture of VMS and Unix styles, for example :');
  writeln('    "cd sub"               "cd dev:"');
  writeln('    "cd /a/b"              "cd dev:sub"');
  writeln('    "cd [a.b.c]"           "cd dev:/a/b/c"');
  writeln('    "cd ../../sub"         "cd dev:[a.b.c]"');
  writeln('    "cd"')

end;  { do_help }


{ fix
    Modifies the input string to look like a correct VMS directory
    name even if originally it looked like a Unix name.
}
procedure fix(var S : string);
  var i : Integer;
begin
  if S = '/' then S := '[000000]';
  { Handle the first `..' pair. }
  if length(S) >= 2 then if (S[1] = '.') and (S[2] = '.') then S[2] := '-';
  { Handle the remaining `..' pairs. }
  i := index(S, '..');
  while i > 0 do begin
    if length(S) > i + 2 then
      S := substr(S, 1, i - 1) + '-' + substr(S, i + 2, length(S) - i - 1)
    else
      S := substr(S, 1, i - 1) + '-';
    i := index(S, '..')
  end;
  { Change Unix slashes to VMS dots. }
  for i := 1 to length(S) do
    if S[i] = ALLOWED_DIR_DELIMITER then S[i] := REAL_DIR_DELIMITER;
  { Since we allow silliness like /[a.b], we may need to strip off
    the leading character. }
  if length(S) >= 2 then if (S[1] = '.') and (S[2] = '[') then
    S := substr(S, 2, length(S) - 1);
  { Finally, bracket the directory name. }
  if S[1] = '.' then S[1] := '[';
  if S[1] = '[' then if S[length(S)] <> ']' then S := S + ']'
end;  { fix }


{ parse
    Create the device and directory names from the command
    line and the current path.
    Expects the device and directory names to be set to the
    empty string upon entry.
    Returns FALSE if the command line appears incorrect.
}
function parse(var command_line, original_directory,
                   device, directory : string) : boolean;
  var i : integer; return : boolean;
      dummy : [word] word_type;
      untrans_device, trans_device : string;
begin

  return := TRUE;
  { Must extract the first word on the line, minus any preceeding spaces }
  command_line := command_line + ' !';
  i := 1;
  while command_line[i] = ' ' do   { Skip spaces }
    i := i + 1;
  if command_line[i] = '!' then
    command_line := ''
  else begin                     {Get 1st word on line}
    command_line := substr(command_line, i, length(command_line) - i + 1);
    i := index(command_line, ' ');
    if i <> length(command_line) - 1 then
      return := FALSE
    else
      command_line := substr(command_line, 1, i - 1)
  end;

  if return <> FALSE then begin

    { First, we need to create a new device name if there is a colon. }
    i := index(command_line, ':');
    if i <> 0 then begin { create a new device name }
      { Eliminate leading slashes since they are acceptable. }
      if command_line[1] = ALLOWED_DIR_DELIMITER then begin
        command_line := substr(command_line, 2, length(command_line) - 1);
        i := i - 1
      end;
      untrans_device := substr(command_line, 1, i - 1);
      LIB$Sys_TrnLog(untrans_device, dummy, trans_device);
      command_line := substr(command_line, i + 1, length(command_line) - i);
      if trans_device = untrans_device then { No translation occured. }
        device := untrans_device + ':'
      else if length(trans_device) > 2 then begin
        if substr(trans_device, length(trans_device) - 1, 2) = '.]' then
          { This came from Rotan's code and I am not sure about all of it. }
          device := untrans_device + ':'
        else if trans_device[length(trans_device)] = ']' then begin
          i := index(trans_device, ':');
          if i > 0 then begin
            device := substr(trans_device, 1, i);
            directory := substr(trans_device, i + 1, length(trans_device) - i)
            end
          else
            device := untrans_device + ':'
          end
        else
          device := untrans_device + ':'
      end { of length(trans_device) > 2 }
    end;

    { Second, let's create a directory name. }
    if length(command_line) > 0 then begin
      fix(command_line);
      if command_line[1] <> '[' then
        command_line := '[.' + command_line + ']';
      LIB$Sys_TrnLog(command_line, dummy, directory)
    end

  end;

  parse := return

end;  { parse }


{ can_cd
    Verifies that the proposed device/directory combination is
    accessible; returns FALSE if an error was discovered.
}
function can_cd(var device, directory, original_directory : string) : boolean;
begin
  { haven't yet discovered the right way to check possible failure }
  can_cd := TRUE
end;  { can_cd }


{ do_cd
    Modify the Sys$Disk logical name to point to the new device.
    Use the system call Sys$SetDDir to set the default directory.
}
procedure do_cd(var device, directory, original_directory : string);
begin
  if length(device) > 0 Then { No point in changing it to ""! }
    LIB$Set_Logical('SYS$DISK', device);
  if length(directory) > 0 Then { No point in changing it to ""! }
    SYS$SetDDir(directory.body,
                original_directory.length, original_directory.body)
end;  { do_cd }


{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }

var
    original_device    : string;
    original_directory : string;
    new_device         : string;
    new_directory      : string;
    command_line       : string;
    dummy_len          : [word] word_type;

begin { main - cd }

  new_device := '';
  original_device := 'UnknownDisk';
  LIB$Sys_TrnLog('SYS$DISK', dummy_len, original_device);

  new_directory := '';
  SYS$SetDDir(new_directory.body,
              original_directory.length, original_directory.body);

  LIB$Get_Foreign(command_line);
  if length(command_line) = 0 then begin
    LIB$Sys_TrnLog('SYS$LOGIN', dummy_len, command_line);
    LIB$Sys_TrnLog(command_line, dummy_len, command_line);
    if parse(command_line, original_directory,
             new_device, new_directory) then begin
      if can_cd(new_device, new_directory, original_directory) then
        do_cd(new_device, new_directory, original_directory)
      else
        writeln(output, SET_ERROR, new_device, new_directory)
    end
    end
  else if command_line = HELP_COM then
    do_help(original_device, original_directory)
  else if parse(command_line, original_directory,
                new_device, new_directory) then
    if can_cd(new_device, new_directory, original_directory) then
      do_cd(new_device, new_directory, original_directory)
    else
      writeln(output, SET_ERROR, new_device, new_directory)
  else begin
    writeln(output, MAXPARM_ERROR);
    writeln(output);
    do_help(original_device, original_directory)
  end

end. { main - cd }

{ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - }
-- 
Robert J. Drabek
Department of Computer Science
The University of Arizona
Tucson, AZ  85721

