From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CRVAX.SRI.COM::RELAY-INFO-VAX"  4-MAY-1989 17:09
To:	MRGATE::"ARISIA::EVERHART"
Subj:	A nice version of CD

Message-Id:  <8905031810.AA29285@crdgw1.ge.com>
Received: From KL.SRI.COM by CRVAX.SRI.COM with TCP; Wed,  3 MAY 89 10:21:29 PDT
Received: from CUNYVM.CUNY.EDU by KL.SRI.COM with TCP; Wed, 3 May 89 10:00:56 PDT
Received: from IRLEARN.BITNET by CUNYVM.CUNY.EDU (IBM VM SMTP R1.1) with BSMTP id 3225; Wed, 03 May 89 13:00:10 EDT
Received: by IRLEARN (Mailer X1.24) id 6132; Wed, 03 May 89 17:39:47 GMT
Date:         Wed, 03 May 89 17:26:13 GMT
From: Rotan <HANRAH88%IRLEARN.BITNET@CUNYVM.CUNY.EDU>
Subject:      A nice version of CD
To: Info-Vax <info-vax@kl.sri.com>


"Jean Luc Picard.USS Enterprise NCC-1701-D" <802376335%RUMAC@ACUPR.UPR.CUN.EDU>
says:

>   Since i have seen people bringing Unix commands to VMS i thought
>you would be interested in an implementation i made of the SET DEFAULT
>command of VMS. I changed it to CD and i eliminated the brackets. The
>program is not the best, nor structered no anything it only works. Any
>changes that would improve the quality of the program are very apreciated.
>It needs refinment.

Well, here is a proper version of CD based on the COM version that appeared in
Pageswapper a long time ago. Our sysmgr says I should do a MACRO version, well
Tom, if you're watching, have patience! Meanwhile be content with this Pascal
version:

-------------------------- cut here -----------------------------


Program Change_Directory(Output);
{ Rotan, Dept Computer Science, UCD, Dublin, Ireland. February 1989 }
{Idea based on the original CD.COM ("Pageswapper" March 1982)}
{Last modification 2-May-1989}

{ Notice: Rotan Hanrahan, the author, declares that this product is in
  the public domain and may be freely used and/or incorporated into other
  commercial and/or public domain products, and may be freely distributed
  to other users under the condition that it is distributed in it's
  present form with no financial (or otherwise) charge to the recipient(s)
  save those charges incurred in distribution, and subject to the condition
  that this notice accompany any such distribution. The author does not
  undertake to service any installation of this product nor will be held
  responsible for any loss (whatsoever) incurred as a result of the use of
  this product or any derivative thereof. }

{ General notice: I believe this product to be a reasonable rendition in Pascal
  of the original CD.COM and have tried and tested it. I suggest that it be
  installed in systems where CD.COM is currently in use (very slow Com file!)
  to improve response time for existing CD users. The command CD must be
  defined as "foreign" because of the silly way CD.COM manages its parameters.
  I.e.   $ CD :== $DeviceName:[The.Path.To.Take]CD.EXE
  I hope you find it useful. Personally I don't like it because of the way that
  the original CD was written (not my product!). Considering that I wrote this
  program during a lazy afternoon, I hope you won't be too bothered by its
  layout. If there are bugs let me know. <HANRAH88@IRLEARN> or
  <HANRAHAN@CCVAX.UCD.IE> (At least until circa 1992!). Thank you. }

Type
 WordType= 0..65535;
 String= Varying [255] of Char;

Var
 NewDir,Current_Dir,WhereToGo,CommandLine,
 Current_Disk,SPtr,There,Device: String;
 DummyLen: [Word] WordType;
 SP: Char;
 Start,TblAdr: Integer;

 LIB$K_CLI_Global_Sym: [External,Value] Integer;  {Global symbol table}

Procedure CLI$Get_Value(%Descr Symbol__Name:Varying[n__1] of Char;
                        Var Returned__Value:Varying[n__2] of Char);
Extern;

Procedure LIB$Get_Foreign(Var Cmd_Line: Varying [n] of Char);
Extern;

Procedure LIB$Set_Symbol(%Descr Symb: Varying [n] of Char;
                         %Descr Valu: Varying [m] of Char;
                         Var Tbl: Integer);

Extern;

Procedure LIB$Set_Logical(%Descr LogNam: Varying [n] of Char;
                          %Descr Valu:   Varying [m] of Char);
Extern;

Procedure LIB$Get_Symbol(%Descr Symb: Varying [n] of Char;
                         Var Valu:    Varying [m] of Char);
Extern;

Procedure LIB$Sys_TrnLog(%Descr LogNam: Varying [n] of Char;
                         Var RetLen:    [Word] WordType;
                         Var Result:    Varying [m] of Char);
Extern;

Procedure SYS$SetDDir(NewDir: [Class_S] Packed Array [x..n:Integer] of Char;
                      Var RetLen:
                              [Word] WordType;
                      Var CurAdr:
                              [Class_S] Packed Array [a..b:Integer] of Char);
Extern;


{ Modify the Sys$Disk logical name to point to the new device and
  use the system call Sys$SetDDir to set the default directory }
Procedure GoThere;
Begin
  LIB$Set_Symbol('THERE',There,TblAdr);
  LIB$Set_Logical('THERE',There);
  If Device.Length > 0 Then                  {No point in changing it to ""!}
    LIB$Set_Logical('SYS$DISK',Device);
  SYS$SetDDir(WhereToGo,Current_Dir.Length,Current_Dir.Body)
End;

{ Stack the current directory. The original CD used the same symbols/lognames }
Procedure PushDir;
Begin
  SP:=Succ(SP);
  If SP='8' Then SP:='0';
  SPtr:=SP;
  LIB$Set_Symbol('CD_SP',SPtr,TblAdr);
  LIB$Set_Symbol('CD_SLOT'+SPtr,There,TblAdr);
  LIB$Set_Symbol('HERE','CD_SLOT'+SPtr,TblAdr);
  LIB$Set_Logical('HERE','CD_SLOT'+SPtr)
End;

{ Set NewDir to the login directory }
Procedure FindHome;
Begin
  LIB$Sys_TrnLog('SYS$LOGIN',DummyLen,NewDir)
End;

{ This just set the new dir to [-] (i.e. up-a-level) }
Procedure GoUpOne;
Begin
  WhereToGo:='[-]';
  PushDir;
  GoThere
End;

{ Drop all the current subdirs, so, if the current dir is [A.B.C.D] then
  the new dir will be [A] }
Procedure GoTop;
Begin
  WhereToGo:='';
  If Index(Current_Dir,'.')>0 Then
    Begin
      {Convert [a.b.c...] into [a]}
      WhereToGo:=SubStr(Current_Dir,1,Index(Current_Dir,'.')-1)+']';
      PushDir;
      GoThere
    End
End;

{ Move to a new subdir on the same level, so, if the current dir is [A.B.C]
  then $CD >X will change to dir [A.B.X] }
Procedure GoAcross;
Var
 CD_Sub:String;
 P:Integer;
Begin
  NewDir:=SubStr(NewDir,2,NewDir.Length-1);  {Removes the dot at the start}
  If NewDir.Length>0 Then
    Begin
      {Now locate x in [a.b.c...x]}
      CD_Sub:=Current_Dir;
      P:=CD_Sub.Length;
      Repeat
        P:=P-1
      Until (P=1) Or (CD_Sub.Body[P]='.');
      {Remove x]}
      If CD_Sub.Body[P]='.' Then
        CD_Sub:=SubStr(CD_Sub,1,P-1)
       Else
        CD_Sub:=SubStr(CD_Sub,1,CD_Sub.Length-1);
      {and replace it with NewDir]}
      WhereToGo:=CD_Sub+'.'+NewDir+']';
      PushDir;
      GoThere
    End
End;

{ Show the user what's on the stack }
Procedure DisplayStack;
Var
 Stack_Index,Stack_Symbol,SymbolVal:String;
 SI:Char;
 X:Integer;
Begin
  SI:=SP;
  Writeln('Directory Stack:');
  For X:=0 To 7 Do
    Begin
      Stack_Symbol:='CD_SLOT'+SI;
      LIB$Get_Symbol(Stack_Symbol,SymbolVal);
      Writeln('<',X:0,': ',SymbolVal);
      If SI='0' Then SI:='8';
      SI:=Pred(SI)
    End
End;

{ Remove [ ] < and > from a string }
Function Strip(S:String):String;
Var
 R:String;
 I:Integer;
Begin
  R:='';
  For I:=1 To S.Length Do
    If Not(S.Body[I] In ['[',']','<','>']) Then
      R:=R+S.Body[I];
  Strip:=R
End;

{ Go to a subdir }
Procedure GoDown;
Begin
  If Current_Dir='[000000]' Then   {Dump the 0s (because I don't like them!)}
    WhereToGo:='['+SubStr(NewDir,2,NewDir.Length-1)+']'
   Else
    {Drop the last ], add in the new dir and tag a ] on the end}
    WhereToGo:=SubStr(Current_Dir,1,Current_Dir.Length-1)+NewDir+']';
  PushDir;
  GoThere
End;

{ Change the dir assuming that no : appeared in the dir spec,
  that includes the spec *after* it has been converted from a logname (if it
  was one) }
Procedure NoColon; {dir spec has no device/log-name at the start}
Begin
  NewDir:=Strip(NewDir);
  If NewDir.Body[1]='.' Then
    GoDown  {Must mean a subdir}
   Else
    Begin   {or else it is a brand new dir spec}
      WhereToGo:='';
      LIB$Sys_TrnLog(NewDir,DummyLen,WhereToGo);        {Log-name?}
      If WhereToGo=NewDir Then                          {no}
        WhereToGo:='['+NewDir+']';                      {Enclose it}
      PushDir;
      GoThere
    End
End;

{ The default operation. A simple (!) dir change operation }
Procedure JustGoThere;
Var
 Disk,DevSpec:String;
 ColonPosition:Integer;
Begin
  ColonPosition:=Index(NewDir,':');     {Dev spec included?}
  If ColonPosition=0 Then
    NoColon                             {No! Very simple operation then :-) }
   Else
    Begin                               {Complicated beast with : in it!}
      LIB$Set_Symbol('THERE',There,TblAdr);
      LIB$Set_Logical('THERE',There);   {Note where we were}
      Disk:=SubStr(NewDir,1,ColonPosition-1);
      LIB$Sys_TrnLog(Disk,DummyLen,DevSpec);    {Get the dev spec}
      NewDir:=SubStr(NewDir,ColonPosition+1,NewDir.Length-ColonPosition);
      Device:='';                       {Assume nothing to start with}
      If Disk=DevSpec Then
        Device:=Disk+':'                {Spec was exact, (not a LogName)}
       Else
        If DevSpec.Length>2 Then        {Just in case!}
          Begin
              If SubStr(DevSpec,DevSpec.Length-1,2)='.]' Then
                Device:=Disk+':'        {Spec is complete with dir spec
                                        (unusual situation)}
               Else
                If SubStr(DevSpec,DevSpec.Length,1)=']' Then
                                        {Very strange, device has ] in it!}
                                        {Just pretend it's OK}
                  If Index(DevSpec,':')>0 Then
                    Begin
                      {Extract the dev name from the spec}
                      Device:=SubStr(DevSpec,1,Index(DevSpec,':'));
                      {And get the dir spec also}
                      NewDir:=SubStr(DevSpec,Index(DevSpec,':')+1,
                                     DevSpec.Length-Index(DevSpec,':'))
                    End
                   Else
                    Device:=Disk+':'    {Default operation}
                 Else
                  Device:=Disk+':'      {Ditto}
          End;
      If NewDir.Length>0 Then
        NoColon     {Device handled OK, now for the rest of the dir spec}
       Else
        Begin
          PushDir;
          GoThere
        End
    End
End;

{ Get a dir spec from one of the stack elements (stored in symbols)
  and use that to set up the new dir }
Procedure GoPop;
Var
 Selected:Char;
Begin
  If NewDir.Length=1 Then
    Selected:='1'
   Else
    {This just converts the given character into the correct stack index}
    Selected:=Chr(Ord('0')+((Ord(SP)-Ord(NewDir.Body[2])) Mod 8));
  NewDir:='';
  {Get dir spec from selected slot in the stack}
  LIB$Get_Symbol('CD_SLOT'+Selected,NewDir);
  JustGoThere
End;

{ Help the novice }
Procedure GoHelp;
Begin
  Writeln('Current disk: ',Current_Disk); {This is an added Rotanism}
  Writeln('Current dir:  ',Current_Dir);  {Not like the old CD help}
  Writeln;
  Writeln('Commands:');
  Writeln(' CD          Go to Sys$Login');
  Writeln(' CD ..       Go to parent dir');
  Writeln(' CD ^^       Go to top dir');
  Writeln(' CD >        Go to next leaf sub-dir');
  Writeln(' CD <        Go to first dir on stack');
  Writeln(' CD <N       Go to Nth dir on stack');
  Writeln(' CD <<       Display entire dir stack');
  Writeln(' CD dir_spec Go to specified dir/device')
End;

Begin
  NewDir:=''; Device:=''; TblAdr:=LIB$K_CLI_Global_Sym;         {Init}
  SYS$SetDDir(NewDir,Current_Dir.Length,Current_Dir.Body);      {Get status}
  Current_Disk:='UnknownDisk';                                  {Default}
  LIB$Sys_TrnLog('SYS$DISK',DummyLen,Current_Disk);             {Get device}
  There:=Current_Disk+Current_Dir;                              {Note position}
  SPtr:='Undefined';                                            {Stack pointer}
  LIB$Get_Symbol('CD_SP',SPtr);                                 {Get pointer}
  If SPtr='Undefined' Then      {This is the first time CD has been called}
    Begin                       {So let's set up all the global symbols}
      LIB$Set_Symbol('CD_SP','0',TblAdr);
      For SP:='0' To '7' Do
        LIB$Set_Symbol('CD_SLOT'+SP,There,TblAdr);
      SP:='0'
    End
   Else
    SP:=SPtr.Body[1];                           {Else get current stack pointer}
  WhereToGo:='';                                                {Default}
  LIB$Get_Foreign(CommandLine);                 {What did the user type?}
  NewDir:=CommandLine+' !';                     {Sentinel}
  Start:=1;                                     {Index/pointer}
  {Must extract the first word on the line, minus any preceeding spaces}
  While NewDir.Body[Start]=' ' Do               {Skip spaces}
    Start:=Start+1;
  If NewDir.Body[Start]='!' Then                {Sentinel?}
    NewDir:=''
   Else
    Begin                                       {Get 1st word on line}
      NewDir:=SubStr(NewDir,Start,NewDir.Length-Start+1);
      NewDir:=SubStr(NewDir,1,Index(NewDir,' ')-1)
    End;
  If NewDir='' Then FindHome;                   {Make NewDir equal to sys$login}
  LIB$Sys_TrnLog(NewDir,DummyLen,NewDir);       {In case NewDir is a LogName}
  If      NewDir='..'         Then GoUpOne                      {Pop}
  Else If NewDir='^^'         Then GoTop                        {Up high}
  Else If NewDir.Body[1]='>'  Then GoAcross                     {EquiLevel}
  Else If NewDir='<<'         Then DisplayStack                 {Info}
  Else If NewDir.Body[1]='<'  Then GoPop                        {Up one}
  Else If NewDir.Body[1]='?'  Then GoHelp                       {Assistance}
  Else JustGoThere                                              {Set Default}
End.


--------------------- cut here ------------------------------

Sorry about the size :-)
                                     Rotan.



  +--.  ____|_____________   > hanrah88@irlearn.bitnet < |      Only
  |   )     |     __   __      b_hanrahan@csvax.ucd.ie   |       an
  +--<  / \ |  |  __| |  |     rotan@opus.ucd.ie         |     e-mail
  |   \ \ /  \_/ (__| |  |     hanrahan@ccvax.ucd.ie     |      away.
  -=R=e=s=e=a=r=c=h=e=r=-=i=n=-=PpAaRrAaLlLlEeLlIiSsMm-=-=
  The Department of Computer Science, UCD, Dublin 4, Ireland.
  Fax +353-1-694409 Tlx +353-1-32693 EI  Attn: Rotan Comp Sci   +-----+
  Ph: +353-1-693244 extension 2488    Contact: Rotan Hanrahan   | 8-> |
  Disclaimer: "If I'm wrong I'll eat my hat... again."          +-----+

