From:	CSBVAX::MRGATE!@KL.SRI.Com:nieland%falcon.decnet@wpafb-aamrl.arpa@SMTP 25-AUG-1987 09:16
To:	EVERHART
Subj:	Source Code for IN  - -   1 of 1

Received: from wpafb-aamrl.arpa by KL.SRI.COM with TCP; Tue 25 Aug 87 05:09:57-PDT
Date: 25 Aug 87 08:02:00 EDT
From: "FALCON::NIELAND" <nieland%falcon.decnet@wpafb-aamrl.arpa>
Subject: Source Code for IN  - -   1 of 1
To: "info-vax" <info-vax@kl.sri.com>
Reply-To: "FALCON::NIELAND" <nieland%falcon.decnet@wpafb-aamrl.arpa>

Hello Info-VAXers,

	I thought I would send out an update to the IN foreign utility.  IN is 
a set default utility that prevents setting default to non-existant 
directories and keeps track of DECnet nodes and device specifications.  It 
doesn't need brackets and it is also fast!  It is written in FORTRAN.

It is not SWING, but it is for people who don't need the graphic interface, 
but want to use a command interface.  Previous versions have been available on 
the DECUS VAX SIG Tapes.

--------------------------------------------------------------------------------
|                M. Edward (Ted) Nieland - Systems Analyst                     |
|------------------------------------------------------------------------------|
| US Snail:                            | Arpa Internet:                        |
| Systems Research Laboratories, Inc.  | TNIELAND@WPAFB-AAMRL.ARPA             |
| 2800 Indian Ripple Road   WP 196     | NIELAND%FALCON.DECNET@WPAFB-AAMRL.ARPA|
| Dayton, OH  45440                    |                                       |
|------------------------------------------------------------------------------|
| A T & T:  (513) 255-5156                                                     |
--------------------------------------------------------------------------------

                              CUT HERE
------------------------------------------------------------------------------
$BEGIN:
$ WRITE SYS$OUTPUT "Creating SETDEF.FOR"
$ COPY SYS$INPUT: SETDEF.FOR
C***********************************************************************
C	SETDEF is a default directory setting program.  It is based
C	on the SETDEF command procedure to set default from Ames
C	Laboratory and uses some constructs from the program CHANGE
C	by Byran J. Jensen (c) Copyright 1983.  SETDEF should be defined
C	by the foriegn command IN:
C
C		IN :== $ DISK:[DIRECTORY]SETDEF.EXE.
C
C 	(c) Copyright 1986  M. Edward Nieland, Ames Laboratory USDOE
C       and Systems Research Laboratories, Inc.
C	This is free software and may be copied or distributed to your
C	hearts content.  Do not remove the copyright notice.
C 
C 	Address any comments to:
C
C	M. Edward (Ted) Nieland 
C	4498 Stonecastle Drive
C	Apartment 207  
C	Dayton, OH  45440
C***********************************************************************
C
C Updated:  February, 1987   Corrected problems with concealed devices
C Updated:  March, 1987      Corrected problem with logical-named devices
C Updated:  August, 1987     Corrected problem with rooted-logicals.
C
C************************************************************************
	PROGRAM SET_DEFAULT_DIRECTORY
	IMPLICIT INTEGER (A-Z)
	INCLUDE '($SSDEF)'
	INCLUDE '($RMSDEF)'
	INCLUDE '($LNMDEF)'
	CHARACTER*(*) BELL,NULL,BLANK
	CHARACTER*255 WHERE, SAVE, BLANKS, ERROR*256
	CHARACTER*255 DEV, NODE, CDEV, CURNODE
	CHARACTER*255 DIR, CURDIR, CURDEV
	CHARACTER*1   BLNKS(255) 
	INTEGER*2 NAME_LEN,NAME_CODE
	INTEGER*4 NAME_ADDR,RET_ADDR,END_LIST/0/
	COMMON/LIST/ NAME_LEN,NAME_CODE,NAME_ADDR,RET_ADDR,END_LIST
	EQUIVALENCE (BLNKS(1),BLANKS(1:1))
	LOGICAL SET
	PARAMETER (BLANK=CHAR(32), NULL=CHAR(0), BELL=CHAR(7))
	DATA BLNKS/255*' '/
	IN_UNIT = 3
	OUT_UNIT = 4
	OPEN(UNIT=IN_UNIT, FILE = 'SYS$INPUT', STATUS = 'UNKNOWN')
	OPEN(UNIT=OUT_UNIT, FILE = 'SYS$OUTPUT', STATUS = 'UNKNOWN')
C***********************************************************************
C 	Find the current directory, device and node.  
C	Also find out what node this CPU is.
C***********************************************************************
	STATUS = SYS$SETDDIR ( ,CDLEN,CURDIR)
	NAME_CODE = LNM$_STRING
	NAME_LEN = 255
	NAME_ADDR = %LOC(CURDEV)
	RET_ADDR = %LOC(CDVLEN)
	STATUS = SYS$TRNLNM (LNM$M_CASE_BLIND,'LNM$PROCESS_TABLE',
	1	'SYS$DISK',,NAME_LEN)
	NAME_ADDR = %LOC(NODE)
	RET_ADDR = %LOC(NODELEN)
	STATUS = SYS$TRNLNM (LNM$M_CASE_BLIND,'LNM$SYSTEM_TABLE',
	1	'SYS$NODE',,NAME_LEN)
C***********************************************************************
C	Remove leading underscores, if any, from NODE.
C***********************************************************************
	DO WHILE (NODE(1:1).EQ.'_')
		NODE(1:NODELEN-1) = NODE(2:NODELEN)
		NODELEN = NODELEN - 1
	ENDDO
C***********************************************************************
C	Remove the node from CURDEV, if one was specified, and 
C	place the node name in CURNODE.
C***********************************************************************
	OFFSET = INDEX(CURDEV,'::')
	IF (OFFSET.EQ.0) THEN  ! Node was not specified
		CURNODE = NODE
		CNLEN = NODELEN
		CDEV = CURDEV
		CDDLEN = CDVLEN
	ELSE
		CURNODE = CURDEV(:OFFSET+1)
		CNLEN = LENSTR(CURNODE)
		CDEV = CURDEV(OFFSET+2:CDVLEN)
		CDDLEN = LENSTR(CDEV)
	ENDIF
	DO WHILE (CURNODE(1:1).EQ.'_') 
		CURNODE(1:CNLEN-1) = CURNODE(2:CNLEN)
		CNLEN = CNLEN - 1 
	ENDDO
C***********************************************************************
C	SET is used to detemine if the default (SYS$LOGIN) or
C	PRE is being used to keep from doing unnecessary parsing.
C***********************************************************************
	SET = .FALSE.
C***********************************************************************
C	Get input specified in command.
C***********************************************************************
	CALL LIB$GET_FOREIGN(WHERE, ,SIZE, )
C***********************************************************************
C	If no input, then prompt for location.
C***********************************************************************
	IF (SIZE.EQ.0) THEN
		WRITE(OUT_UNIT,5000)
5000	FORMAT(' _Default_Directory? ',$)
		READ(IN_UNIT,5020,ERR=20,END=20) WHERE
5020	FORMAT(A255)
		SIZE = LENSTR(WHERE)
		GO TO 40
20 		WHERE = BLANKS
		SIZE = 0
	ENDIF
C***********************************************************************
C	Make sure everything is in upper case.
C***********************************************************************
40	CALL STR$UPCASE(WHERE,WHERE)
C***********************************************************************
C 	The default for the directory is SYS$LOGIN.
C***********************************************************************
	IF (SIZE .EQ. 0) THEN
	  WHERE = 'SYS$LOGIN'
	  SIZE = 9
	  SET = .TRUE.
	ENDIF
C***********************************************************************
C	If WHERE = "PRE" then get symbol for PREV_DIR from logical table.
C	Note:  PREV_DIR is the directory that was the default when 
C	SETDEF.EXE was last executed.  
C	It used to toggle between directories.
C***********************************************************************
	OFFSET = INDEX(WHERE,'PRE')
	IF (OFFSET.NE.0) THEN
	IF ((WHERE(OFFSET+3:OFFSET+3).NE.BLANK).AND.(WHERE(OFFSET+3:OFFSET+3)
     &	.NE.NULL)) GO TO 60
		NAME_ADDR = %LOC(WHERE)
		RET_ADDR = %LOC(SIZE)
		STAT = SYS$TRNLNM(LNM$M_CASE_BLIND,'LNM$PROCESS_TABLE',
	1	'PREV_DIR',,NAME_LEN)
		SET = .TRUE.
		IF ((.NOT.STAT).OR.(SIZE.EQ.0)) THEN
		  WHERE = 'SYS$LOGIN'
		  SIZE = 9
		ENDIF
	ENDIF
C***********************************************************************
C 	Allow logical names to be specified, but translate only up
C	to where the ':' is located, not including the ':'.  If a colon
C	is found and a logical name is found, then a subdirectory may
C	be specified after the colon.
C***********************************************************************
60 	OFFSET = INDEX(WHERE,':') - 1
	IF (OFFSET.EQ.-1) OFFSET = SIZE
	  NAME_ADDR = %LOC(DIR)
	  RET_ADDR = %LOC(DIRLEN)
	  STATUS = SYS$TRNLNM(LNM$M_CASE_BLIND,'LNM$FILE_DEV'
	1	,WHERE(1:OFFSET),,NAME_LEN)
C***********************************************************************
C	Check STATUS of translate logical name operation, go to 80
C	on failure.
C***********************************************************************
	  IF ((.NOT.STATUS).OR.(STATUS .EQ. SS$_NOLOGNAM)) THEN
		GO TO 80
  	  ENDIF
	  SET = .TRUE.
C***********************************************************************
C	If offset is not equal to size then a subdirectory may have
C	been specified.
C***********************************************************************
	  IF (OFFSET.NE.SIZE) THEN
C***********************************************************************
C	Check to see if the logical was device:[dir.] and if so
C	then don't translate.  If using other logicals, then translate.
C***********************************************************************
		IF (DIR(DIRLEN-1:DIRLEN).EQ.'.]') THEN
			Continue ! Skip Translation for rooted logicals
		ELSEIF ((WHERE(OFFSET+2:OFFSET+2).EQ.'[').AND.
	1  	(DIR(DIRLEN:DIRLEN).EQ.']')) THEN
			OLDSIZE = SIZE
			SIZE = DIRLEN + OLDSIZE - OFFSET - 4
			WHERE(1:SIZE) = DIR(:DIRLEN-1)//
	1		WHERE(OFFSET+3:OLDSIZE)
		ELSEIF ((WHERE(OFFSET+1:OFFSET+1).EQ.':')
	1		.AND.(SIZE.GE.OFFSET+2).AND.
	1		(DIR(DIRLEN:DIRLEN).NE.':')) THEN
			SAVESIZE = SIZE - OFFSET - 1
			SAVE(:SAVESIZE) = WHERE(OFFSET+2:SIZE)
			SIZE = DIRLEN + SAVESIZE 
			WHERE(1:SIZE) = DIR(:DIRLEN-1)//'.'//
	1				SAVE(:SAVESIZE)
			WHERE(SIZE+1:255) = BLANKS(SIZE+1:255)
		ELSE
			SAVESIZE = SIZE - OFFSET - 1
			SAVE(:SAVESIZE) = WHERE(OFFSET+2:SIZE)
			SIZE = DIRLEN + SAVESIZE 
			WHERE(1:SIZE) = DIR(:DIRLEN)//
	1				SAVE(:SAVESIZE)
			WHERE(SIZE+1:255) = BLANKS(SIZE+1:255)
		ENDIF
	  ELSE
		  WHERE = DIR
		  SIZE = DIRLEN
	  ENDIF
80	CONTINUE
C***********************************************************************
C 	Provide [ ] around directory if omitted
C***********************************************************************
	IF (WHERE(SIZE:SIZE) .NE. ':') THEN	! No [ ] if only device spec
	  IF (INDEX(WHERE(:SIZE), '[') .EQ. 0) THEN	! If no [,
	    DO IDX = SIZE, 1, -1		! Search for device end
	      IF (WHERE(IDX:IDX) .EQ. ':')
     &		GO TO 100	! allowing for node::device
	    END DO			! or device: or node::
	    IDX = 0			! No device
100	    IDX = IDX+1			! Point to directory name
	    WHERE(IDX:SIZE+1) = '['//WHERE(IDX:SIZE)
	    SIZE = SIZE + 1		! Insert [ before directory name
	  END IF
	  IF (INDEX(WHERE(:SIZE), ']') .EQ. 0) THEN	! If no ],
	    SIZE = SIZE + 1				! add ] to end
	    WHERE(SIZE:SIZE) = ']'
	  END IF
	END IF
C***********************************************************************
C 	Change \ to - (- gets confused with DCL line continuation, so on 
C	input we allow \ to be used instead).
C***********************************************************************
	DO I = 1, SIZE
	  IF (WHERE(I:I) .EQ. '\') WHERE(I:I) = '-'
	END DO
C***********************************************************************
C	If the node, device, or directory remain unspecified
C	then use the current node, device, and/or directory
C
C	If SET = TRUE then the directory is either SYS$LOGIN or 
C	PREV_DIR, so skip this section.
C***********************************************************************
	IF (SET) GO TO 120
	OFFSET = INDEX(WHERE,'::')   ! Check for node
	IF (OFFSET.EQ.0) THEN
C***********************************************************************
C	If the current node is this CPU's node, then don't fill it in
C***********************************************************************
		IF (CURNODE.NE.NODE) THEN
		  SAVE(:SIZE) = WHERE(:SIZE)
		  SLEN = SIZE
		  SIZE = SLEN + CNLEN
		  WHERE(:SIZE) = CURNODE(:CNLEN)//SAVE(:SLEN)
		  OFFSET = CNLEN 
		ENDIF
	ELSE
		IF (WHERE(:OFFSET+1).EQ.NODE(:NODELEN)) THEN
			NSIZE = SIZE - OFFSET - 1
			WHERE(:NSIZE) = WHERE(OFFSET+2:SIZE)
			SIZE = NSIZE
			OFFSET = 0
		ELSE
			OFFSET = OFFSET + 1
		ENDIF
	ENDIF
	OFFSET1 = INDEX(WHERE(OFFSET+1:SIZE),':')  ! Check for device
	IF (OFFSET1.EQ.0) THEN
		SLEN = SIZE - OFFSET 
		SAVE(:SLEN) = WHERE(OFFSET+1:SIZE)
		SIZE = OFFSET + SLEN + CDDLEN
		WHERE(OFFSET+1:SIZE) = CDEV(:CDDLEN)//SAVE(:SLEN)
		OFFSET1 = OFFSET + CDDLEN
	ENDIF
	IF (OFFSET1.GE.SIZE) THEN  ! Check for directory
		SIZE = OFFSET1 + CDLEN
		WHERE(OFFSET1+1:SIZE) = CURDIR(:CDLEN)
	ENDIF
C***********************************************************************
C 	Check to see if directory is properly specified
C***********************************************************************
	OFFSET1 = INDEX(WHERE(1:SIZE),'[')
	IF (WHERE(OFFSET1+1:OFFSET1+1).EQ.'.') THEN
		OLDSIZE = SIZE
		SIZE = SIZE + CDLEN - 2 
		WHERE(OFFSET1+1:SIZE) = 
	1	CURDIR(2:CDLEN-1)//WHERE(OFFSET1+1:OLDSIZE)
	ELSEIF (WHERE(OFFSET1+1:OFFSET1+1).EQ.'-') THEN
		OLDSIZE = SIZE
		SIZE = SIZE + CDLEN - 1
		WHERE(OFFSET1+1:SIZE) = 
	1	CURDIR(2:CDLEN-1)//'.'//WHERE(OFFSET1+1:OLDSIZE)
	ELSEIF (INDEX(WHERE(1:SIZE),']').EQ.0) THEN
		OLDSIZE = SIZE
		SIZE = SIZE + CDLEN 
		WHERE(OLDSIZE+1:SIZE) = CURDIR(1:CDLEN)
	ENDIF
C***********************************************************************
C 	Check to see if directory exists
C***********************************************************************
120	IDX = 0
D	WRITE(OUT_UNIT,9100) WHERE
D9100	FORMAT(' F. WHERE(1:SIZE) = ', A<SIZE>)
	STATUS = LIB$FIND_FILE (WHERE(:SIZE), DIR, IDX, '*.*', )
	IF ((.NOT.STATUS).AND.(STATUS.NE.RMS$_FNF)) THEN 
		J= SYS$GETMSG(%VAL(STATUS),LENGTH,ERROR,%VAL(3),)
		WRITE(OUT_UNIT,5030) BELL,ERROR(2:LENGTH)
5030	FORMAT(' ',A1,'%IN-I-',A<LENGTH-1>)
		WRITE(OUT_UNIT,5050) CURNODE(:CNLEN)//
	1			CDEV(:CDDLEN)//CURDIR(:CDLEN)
5050	FORMAT(' ',A)
		GO TO 140
C***********************************************************************
C	The directory was not found, so print out a warning message 
C	and the current default directory.
C***********************************************************************
	END IF
	DIRLEN = INDEX (DIR, ']')
C***********************************************************************
C 	Set the device
C***********************************************************************
	IDX = INDEX (DIR(:DIRLEN), '[') - 1	! Separate device/directory
	STATUS = LIB$SET_LOGICAL ('SYS$DISK', DIR(:IDX))
	IF (.NOT.STATUS) CALL LIB$STOP(%VAL(STATUS))
C***********************************************************************
C 	Set the directory
C***********************************************************************
	STATUS = SYS$SETDDIR (DIR(IDX+1:DIRLEN),,)
	IF (.NOT.STATUS) CALL LIB$STOP (%VAL(STATUS))
C***********************************************************************
C	Set the logical for the previous directory used when PRE is
C	specified as the directory.
C***********************************************************************
	STATUS = LIB$SET_LOGICAL ('PREV_DIR',
	1	CURDEV(:CDVLEN)//CURDIR(:CDLEN))
C***********************************************************************
C	Write out the directory that was set.  Omit any underscores ("_")
C	on the node name.
C
C	If the node is not specified in DIR then it is the current node
C	and we need to add the node name.
C***********************************************************************
	IF (INDEX(DIR,'::').EQ.0) THEN
		WRITE(OUT_UNIT,5050) NODE(:NODELEN)//DIR(:DIRLEN)
	ELSE
		  OFFSET = 1
		  DO WHILE (DIR(OFFSET:OFFSET).EQ.'_')
			OFFSET = OFFSET + 1
		  ENDDO
		  WRITE(OUT_UNIT,5050)  DIR(OFFSET:DIRLEN)
	ENDIF
140	END

	INTEGER FUNCTION LENSTR(STRING)
C***********************************************************************
C     Function to accept a string STRING and calculate
C     its length LENGTH.  Where here LENGTH is not equal
C     X for a CHARACTER*X character string, but is the last
C     position in the character string where a character is found.
C***********************************************************************
	CHARACTER*(*) STRING,SPACE,NULL
	PARAMETER (SPACE=CHAR(32), NULL=CHAR(0))
	LENSTR = 0
	ILENGTH=LEN(STRING)
	DO  I = ILENGTH,1,-1
	  IF ((STRING(I:I).NE.SPACE).AND.(STRING(I:I).NE.NULL)) THEN
		LENSTR = I
	 	RETURN
	  ENDIF
	ENDDO
	RETURN
	END
$ WRITE SYS$OUTPUT "Doing checksum validation on SETDEF.FOR . . . "
$ CHECKSUM SETDEF.FOR
$ IF CHECKSUM$CHECKSUM .NE. 1384057369 THEN GOTO CHECK_ERROR
$ WRITE SYS$OUTPUT "Creating SETDEF.HLP . . . "
$ COPY SYS$INPUT SETDEF.HLP
1 IN
The IN sets the default directory.  The desired default directory
is specified by the parameter, p1. 

Command Format:

	      $ IN p1

                where
                       p1 = {node::}{device:}{directory}
                or
                       p1 = logical_name_for_a_directory{:subdirectory}
                or
                       p1 = .subdirectory
                or 
                       p1 = /
                or 
                       p1 = PRE

If the specified directory does not exist, an error message is
generated and the default directory is not changed. 
!---------------------------------------------------------------------
02 {node::}{device:}{directory}                                       

Specifies the node, and/or device, and/or directory for the default
directory. 

The curly brackets indicate optional items in the parameter (p1).
   If node:: is not specified, it defaults to the current node::
   If device: is not specified, it defaults to the current device:
   If directory is not specifed, it defaults to the current directory.
   The directory does not have to be enclosed in [ ] brackets.  

EXAMPLES:
 $ IN VAXLA:: ! Sets default directory equal to 
              ! VAXLA::current_default_device:current_default_directory

 $ IN DUA0:   ! Sets default directory equal to
              ! current_default_node::DUA0:current_default_directory

 $ IN DOT     ! Sets default directory equal to
              ! current_default_node::current_default_device:[DOT]

 $ IN VAXLB::DRA1:DIR     ! Sets default directory equal to
                          ! VAXLB::DRA1:[DIR]

 $ IN DIR.CAT ! Sets default directory equal to 
              ! current_default_node::current_default_device:[DIR.CAT]
!---------------------------------------------------------------------
2 .subdirectory                                                       
Specifies that the default directory is to be set to

             [current_default_directory.subdirectory]

The current_default_node and current_default_device are not changed.

EXAMPLE:
  $ IN .NEXTDIR               ! Sets the default directory to
                              ! [current_default_directory.NEXTDIR]
!---------------------------------------------------------------------
2 \                                                                   
\ specifies that the default directory is to be the parent directory
of the current default directory. 

 EXAMPLES:

   $ IN \.ADIR         ! Sets the default directory to the daughter
                       ! directory ADIR of the current directory's
                       ! parent directory.
                                
   $ IN \\.SOMEDIR     ! Sets the default directory to the daughter
                       ! directory SOMEDIR of the current directory's
                       ! grandparent directory.
!---------------------------------------------------------------------
2 Logical_name_of_a_directory{:subdirectory}                          

 Specifies the desired default directory by logical name.  

  EXAMPLE:  $ IN SYS$LOGIN     ! Sets the default directory equal to 
                               ! the default login directory.

 If the logical name is not defined, then the input is treated as a
 {node::}{device:}{directory} entry. 

 If the optional item indicated in { } brackets is given, the default
 is set to the specified subdirectory of the directory specified by the
 logical name. 

  EXAMPLE:  $ IN GR$PROG:SOURCE   ! SOURCE is a subdirectory of the 
                                  ! directory whose logical name is 
                                  ! GR$PROG

 The logical name LNM$FILE_DEV is used to indicate which logical name
 tables will be used to translate the logical name.  See the System
 Services manual, page 6-11, for more information on LNM$FILE_DEV
!---------------------------------------------------------------------
2 PRE                                                                 
 PRE resets the default directory to the default directory that was
 defined before the last previous use of IN. 

  $ IN PRE is useful for 'toggling' between  two default directories. 
!---------------------------------------------------------------------
$ WRITE SYS$OUTPUT "Doing checksum validation on SETDEF.HLP . . . "
$ CHECKSUM SETDEF.HLP
$ IF CHECKSUM$CHECKSUM .NE. 975903774 THEN GOTO CHECK_ERROR
$ WRITE SYS$OUTPUT "Compiling SETDEF.FOR"
$ FORT/EXTEND/OPT SETDEF
$ WRITE SYS$OUTPUT "Linking SETDEF"
$ LINK/NOTRACE/NODEB SETDEF
$ DELETE SETDEF.OBJ;
$ TYPE SYS$INPUT 

    You now need to define the symbol for IN.  Add the following to your
    system wide or personal LOGIN.COM file:

            IN :== $ device:[directory]SETDEF.EXE

   where device:[directory] is the device and directory specifying the 
   location of the executable directory.  You will also want to add the
   Help file, SETDEF.HLP, to the appropriate HELP Library.

$ EXIT
$CHECK_ERROR:
$ TYPE SYS$INPUT

     There was a checksum error on creating IN.  You may not have
     gotten a clean copy of the source.  You may want to request a new copy 
     from the author, Ted Nieland.  The Internet address is 
     TNIELAND@WPAFB-AAMRL.ARPA. 

$ EXIT
------
