nieland%falcon.DECnet@WPAFB-AAMRL.ARPA ("FALCON::NIELAND") (08/25/87)
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 ------