From:	CSBVAX::MRGATE!info-vax-request@kl.sri.com@SMTP  6-APR-1988 07:02
To:	ARISIA::EVERHART
Subj:	Assorted directory utilities


Received: from ucbvax.Berkeley.EDU by KL.SRI.COM with TCP; Mon 4 Apr 88 02:50:24-PDT
Received: by ucbvax.Berkeley.EDU (5.59/1.26)
	id AA09061; Fri, 1 Apr 88 19:17:14 PST
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: 31 Mar 88 21:13:40 GMT
From: mcvax!enea!sommar@uunet.uu.net  (Erland Sommarskog)
Organization: ENEA DATA AB, Sweden
Subject: Assorted directory utilities
Message-Id: <2967@enea.se>
Sender: info-vax-request@kl.sri.com
To: info-vax@kl.sri.com

There are probably as many ways to move between directories as there
are VMS users. Some use SWING with bells and whistles that give.
Other uses a CD.COM which emulates cd on Unix. Myself, I am one of
those who have a symbol and a logical name for each directory. 
For instance if I have a directory somewhere called UTILITIES I
may have a symbol 
   UTILI*TIES == "CHP DISK:<HOME.SUBDIR.UTILITIES>"
(See below on CHP.) And a logical name referring to the directory,
which is convenient when I need to refer to it from somewhere else.
One good point is that I don't have to remember the exact structure
of my directory tree.
  I have a command file that defines all these names at login time.
I also have two command files for creating and deleting directories,
automatically updating the command file.
  This method fails of course when I visit somebody else's directories.
for this I use a convenient little directory-tree climber. 
  All these utilities are contained in this posting. Use them if you like.

CONTENTS:
CHP.COM: Performs a SET DEFAULT and changes the prompt to the directory.
Only the lowest directory name is displayed. 
CREDIR.COM: Creates a new directory, a symbol for going there and a logical
name. Adds the two names to the file KOM:KATALOG.COM (you will probably 
edit CREDIR to use some other name). The directory may already exist, 
i.e. you can call it just to get the names.
DELDIR.COM  Deletes (recursively) a directory and removes the names for it.
Z.COM: The climber. Example: "Z ,, , po" first takes us to the home 
directory, goes one step up and then to PO.DIR, if it exists. Else we 
go to PO*.DIR if PO* is unique. A special feature is that Z looks for
concealed device names and translates them if necessary. 
DOWNSUB.PAS: Performs the same task as Z.COM, but is quicke, they say. 
I haven't written this one. Don't know if handles concealed names or 
finds PO.DIR when there is a PO1.DIR too.

----------------------------------------------------------------------
$create/log CHP.COM
$deck/dollars="$88033122150226"
$! Performs a SET DEFAULT and sets the prompt according to the
$! to name of the default directory. Parents are not included
$! in the prompt.
$ Set def 'p1'
$ Directory = f$dir() 
$ Directory = f$extract(1, f$length(Directory)-2, Directory) + "> "
$ i = 0
$loop:
$ Subdir = f$element(i, ".", Directory)
$ i = i + 1
$ if f$locate(">", Subdir) .eq. f$length(Subdir) then $ goto loop
$ set prompt="''Subdir'"
$88033122150226
$create/log Z.COM
$deck/dollars="$88033122150299"
$! Directory-tree climber originally written by Lars Hamren. Modified
$! by Erland Sommarskog to handle logical devices.
$! Use: @Z P1 P2 ...
$! where Pn is a name of a subdirectory or non-ambiguous abbreviation. 
$! Pn can also be a comma(,) for the parent directory or double-comma(,,) 
$! for the login directory. Brackets should not be included.
$! You must have read permission in a directory when you use abbreviated names.
$!
$! Assumption: The symbol "Set default" is defined. Preferably it points at a 
$! DCL routine setting the prompt to the current directory.
$!
$ Say = "Write sys$output"
$ On Error then $ Goto Error
$ On Severe then $ Goto Error
$ Current = f$directory()
$ i = 1  
$ Parameter = p1
$Loop:   
$      If Parameter .nes. "," then $ Goto NotUp
$         Set default <->
$         If f$directory() .nes. "<000000>" then $ Goto Endloop
$            Disk = f$parse("<>",,,"DEVICE")
$            Disk = f$extract(0, f$locate(":", Disk), Disk)
$            File_name = f$logical(Disk)
$            If File_name .eqs. "" then $ Goto Endloop
$            Dot_pos = f$locate(".>", File_name)
$            If Dot_pos .eq. f$length(File_name) then -
$               Dot_pos = f$locate(".]", File_name)
$            If Dot_pos .eq. f$length(File_name) then $ Goto Endloop
$            File_name = f$extract(0, Dot_pos, File_name) + -
                         f$extract(Dot_pos + 1, f$length(File_name), File_name)
$            Set default 'File_name'
$            Goto Endloop
$      NotUp:
$      If Parameter .nes. ",," then $ Goto NotHome
$         Set default sys$login
$         Goto Endloop
$      NotHome:
$         File_name = f$search("''parameter'.dir")
$         If File_name .nes. "" then Goto Fixed
$         File_name = f$search("''parameter'*.dir")
$         If File_name .eqs. "" then $ Goto NoExist
$         If f$search("''Parameter'*.dir") .nes. "" then $ Goto NotUnique
$         Fixed:
$         File_name = f$parse(File_name,,,"NAME")
$         Set default <.'File_name'>
$      Endloop:
$      Say f$logical("SYS$DISK") + f$directory()
$      i = 'i' + 1
$      Parameter = p'i'
$ If parameter .nes. "" then $ Goto Loop
$Fine:     
$ chp <>
$ Exit
$!
$! Error exits
$NoExist:
$ Say "No such directory: ''parameter'"
$ Say Current
$ Set default 'Current'
$ Goto Fine
$NotUnique:
$ Say "Abbreviation not unique ''Parameter'" 
$ Say Current
$ Set default 'Current'
$ Goto Fine
$Error:           
$ Set default 'Current'
$ Say "Something went wrong. Back to ''Current'"
$ Goto Fine
$88033122150299
$create/log CREDIR.COM
$deck/dollars="$88033122150380"
$! This routine creates a sub-directory and creates a logical name
$! for it and a symbol for going to the new directory. The two
$! definitions are added to a file KOM:KATALOG.COM which we assume
$! is called at login.
$!
$! Use:
$!    Credir P1 P2 P3
$!    P1 = Name of sub-directory without brackets. P1 may already exist.
$!    P2 = Name of the symbol. Default is P1 with a "*" after the 5th char. 
$!    P3 = Logical name. Default is P1.
$!
$! Assumptions: 
$!    The file KOM:KATALOG.COM exists
$!    The symbol CHP is defined to SET DEFAULT or a corresponding routine.
$! 
$!
$ If p1 .eqs. "" then $ inquire p1 "Name of the directory? "
$ Name := 'p1
$ Name := 'f$extract(0, f$locate(">", f$parse("<>")), f$parse("<>"))'.'Name'>
$ Symbol := 'p2                                             
$ If Symbol .eqs. "" then -
$      Symbol := 'f$extract(0,5,p1)'*'f$extract(5,f$length(p1),p1)'
$ LogName := 'f$extract(0, f$locate(":", p3), p3)'
$ If LogName .eqs. "" then $ LogName := 'p1
!
$ Create/directory 'Name'
$ Open/write File sys$login:temp.xxx
$ Write File "!"                                  
$ Write File "$ ''Symbol' == ""'" + "'chp' ''Name'"""
$ Write File "$ Assign ''Name' ''LogName'"
$ Close File
$ @sys$login:temp.xxx
$ Append sys$login:temp.xxx kom:katalog.com       
$ Delete/noconfirm/nolog sys$login:temp.xxx;
$88033122150380
$create/log DELDIR.COM
$deck/dollars="$88033122150455"
$! Deletes a directory and all subdirectories. The entries for the
$! the directories in KOM:KATALOG.COM are erased. The user is asked
$! the deletion of all encountered directories.
$!
$! Use:
$!    Deldir P1
$!    P1 = Name of subdirectory to be erased. Brackets should be omitted.
$!    P2 = Should not be given. Only used for internal recursive calls.
$!
$! Assumptions:
$!   The file KOM:KATALOG.COM exists.
$!   The symbol CHP is defined to SET DEFAULT or a corresponding routine.
$!
$ Level = p2
$ If Level .eqs. "" then $ Level = 1
$ Directory        = p1
$ Dir_file_name = f$parse(Directory + ".DIR")
$ Inquire/nopunct Answer "Delete ''Dir_file_name'?"
$ If f$extract(0, 1, f$edit(Answer, "TRIM, UPCASE")) .eqs. "N" then exit
$ chp <.'Directory'>             
$More_dirs:
$    SubDirectory = f$search("**.dir", Level)
$    If SubDirectory .eqs. "" then $ Goto Dirs_ready
$    Deldir "''f$parse(SubDirectory, "", "", "NAME")'" "''Level + 1'"
$ Goto More_dirs
$Dirs_ready:
$ Delete/noconfirm/nolog *.*;
$ Directorynamn = f$directory()
$ chp <->
$ Set prot=O:rwed         'Dir_file_name'
$ Delete/noconfirm/log    'Dir_file_name'
$ Open/read  Dir_file      kom:KATALOG.com
$ Open/write New_dir_file  kom:KATALOG.com
$MoreLines:
$ Read/end_of_file=EOF Dir_file Line
$    If f$locate(Directorynamn, Line) .eq. f$length(Line) then -
        Write New_dir_file Line
$ Goto MoreLines
$EOF:
$ Close Dir_file
$ Close New_dir_file
$ Exit
$88033122150455
$create/log DOWNSUB.PAS
$deck/dollars="$88033122150530"
program downsub(output);

(*
   DOWNSUB, a fast way to change subdirectory (emulates DOWNSUB.COM
   in DNALIB).
   
   Should be run as a foreign command and may be given several parameters.
   
      $ d		! Show default
      $ d sub		! Goto subdirectory 'sub' (name may be abbreviated)
      $ d ,		! Go up one level
      $ d ,,		! Goto home directory
   
   Written by : Bengt Larsson E-81
   Created    : 30/7-1986
   Revised    :     --

*)

label 999; 	(* end of program *)

const home_specifier_1 = ',,';	home_specifier_2 = '..';
      up_specifier_1   = ',';	up_specifier_2   = '.';

type $uword = [word] 0..65535;
     string_type = varying [255] of char;

var line : string_type;
    find_context : integer := 0;
    l_bracket,r_bracket : char;
    start_disk,start_dir : string_type;

function sys$setddir
( %stdescr new_dir : packed array [l1..u1:integer] of char := %immed 0;
  %ref     out_len : $uword := %immed 0;
  %stdescr cur_dir : packed array [l2..u2:integer] of char := %immed 0
) : integer; extern;

function lib$find_file
( %descr file_spec   : varying [c1] of char;
  %descr result_spec : varying [c2] of char;
  %ref   context     : integer
) : integer; extern;

function lib$get_foreign
( %descr command_line : varying [c] of char ) : integer; extern;

function lib$sys_trnlog
( %descr log_name : varying [c1] of char;
  %ref   ret_len  : $uword := %immed 0;
  %descr result   : varying [c2] of char;
  %descr table    : varying [c3] of char := 'LNM$DCL_LOGICAL'
) : integer; extern;

function lib$set_logical
( %descr log_name  : varying [c1] of char;
  %descr log_value : varying [c2] of char
) : integer; extern;

(* --- Remember which brackets we are using --- *)
    
procedure set_brackets;
var current_dir : string_type;
begin
   sys$setddir(,current_dir.length,current_dir.body);
   
   if index(current_dir,']') <> 0 then
   begin 
      l_bracket := '[';
      r_bracket := ']';
   end
   else 
   begin 
      l_bracket := '<';
      r_bracket := '>';
   end;
end; (* set_brackets *) 


(* --- Find an abbreviated subdirectory and set default to it.  --- *)
(* --- Also process special parameters for 'sys$login' and 'up' --- *)

procedure set_def_dir(dir_abbrev : string_type);
var dummy,new_dir,dir_file,home_dir : string_type;
    pos1,pos2 : integer;
begin
   if (dir_abbrev = home_specifier_1) or (dir_abbrev = home_specifier_2) then
   begin
      lib$sys_trnlog('SYS$LOGIN',,home_dir);
      lib$set_logical('SYS$DISK',substr(home_dir,1,index(home_dir,':')));
      sys$setddir('SYS$LOGIN');
      sys$setddir(l_bracket + r_bracket);
   end
   else if (dir_abbrev = up_specifier_1) or (dir_abbrev = up_specifier_2) then
      sys$setddir(l_bracket + '-' + r_bracket)
   else 
   begin 
      if not odd(lib$find_file(dir_abbrev + '*.DIR',dir_file,find_context)) then
      begin          
         writeln('No such directory : ',dir_abbrev,'*');
         writeln(start_disk,start_dir);
         
         lib$set_logical('SYS$DISK',start_disk);
         sys$setddir((start_dir));
         
         goto 999;
      end;
      
      if index(dir_file,dir_abbrev + '.DIR;') = 0 then 
        (* make uniqueness check only if not exact match *)
      begin
         if odd(lib$find_file(dir_abbrev + '*.DIR',dummy,find_context)) then
         begin
            writeln('Directory abbreviation not unique : ',dir_abbrev,'*');
            writeln(start_disk,start_dir);
         
            lib$set_logical('SYS$DISK',start_disk);
            sys$setddir((start_dir));

            goto 999;
         end;
      end;
      
      pos1 := index(dir_file,r_bracket);
      pos2 := index(dir_file,'.DIR;');
      
      sys$setddir(l_bracket + '.' + 
                  substr(dir_file,pos1+1,pos2-pos1-1) + r_bracket);
   end;
end; (* set_def_dir *)                


(* --- Extract the parameters from the command line and call set_def_dir --- *)

procedure process_parameters(line : string_type);
var first,last : integer;
    exit : boolean;
    new_dir,disk : string_type;
begin
   first := 1;
   last := 1;
   
   while first <= line.length do
   begin
      last := first;
      exit := false;

      while (last <= line.length) and not exit do
         if line[last] = ' ' then
            exit := true
         else
            last := last + 1;
      
      last := last - 1;
      
      set_def_dir(substr(line,first,last-first+1));

      sys$setddir(,new_dir.length,new_dir.body);
      lib$sys_trnlog('SYS$DISK',,disk);
      writeln(disk,new_dir);
      
      first := last + 2;
   end;
end; (* process_parameters *)      


(* --- Main program. Show current default or process parameters --- *)

begin
   lib$get_foreign(line);

   set_brackets;

   lib$sys_trnlog('SYS$DISK',,start_disk);
   sys$setddir(,start_dir.length,start_dir.body);
   
   if line = '' then
      writeln(start_disk,start_dir)
   else
      process_parameters(line);

   999:
end (* downsub *).                                                    

$88033122150530

-- 
Erland Sommarskog       
ENEA Data, Stockholm        
sommar@enea.UUCP
