Conference noted::hackers_v1

583.0. "SET DEF Utility" by FRAMBO::SCHABACKER (Tim Schabacker SWAS FRS ext.226) Mon Oct 19 1987 12:52

$! CD.COM
$!          >>>>>     SET DEF Utility    <<<<<
$!
$! AUTHOR: Tim Schabacker                              FRAMBO::SCHABACKER
$! DATE  : 19.10.87
$!-----------------------------------------------------------------------
$!
$! Now it's allowed to use asterisk's ("*") in a SET DEF !!.
$! Besides you can forget the brackets "[]" or "<>".
$! This procedure has a search order that looks first in the
$! default Dir and then on the root Dir.
$! If you want you can use a "/" instead of a ".".
$! With CD BACK you can go back to that defautl where you was
$! one step ago.
$!  
$! CD . 	moves one step up
$! CD .. 	moves one step up
$! CD ./. 	moves to the root Dir
$!
$! define a symbol CD an you can enjoy this utility.
$! 
$! The following Syntax is allowed:
$!
$! CD DEV:[DIR*.DIR*.........]
$! CD [DIR1.DIR2.............]
$! CD DEV:DIR1.DIR2..........
$! CD DIR1.DIR2..............
$! CD DIR1/DIR2..........
$!
$!
$!
$!-----------------------------------------------------------------------
$ ADRESSE=""
$ ESC[0,7]=27
$ BELL[0,7]=7
$ IF P1.EQS."" THEN GOTO SHOW_DEF
$ IF P1.EQS."." THEN P1="-"
$ IF P1.EQS.".." THEN P1="-"
$ IF F$EXTR(0,2,P1).EQS.".." THEN $ P1="-''F$EXT(1,F$LENGTH(P1)-1,P1)'"
$ IF P1.EQS."./." THEN P1="[000000]"
$ ON ERROR THEN GOTO NO_DEF
$ DEF_ALT = "''F$ENVIROMENT("DEFAULT")'"
$ ADRESSE=P1
$ FLAG=0
$ IF F$EXTR(0,1,P1).NES."." THEN GOTO START
$ P1="''F$EXT(1,F$LENGTH(P1)-1,P1)'"
$ FLAG=1
$
$!
$!
$ START:
$!
$ L=F$LENGTH(P1)
$ P=F$LOCATE("/",P1)
$!
$ L1:
$ IF P.NE.L THEN P1=F$EXT(0,P,P1)+"."+F$EXT(P+1,L-P,P1)
$ P=F$LOCATE("/",P1)
$ IF P.NE.L THEN GOTO L1
$!
$!
$ IF F$LOCATE("[",P1).NE.L THEN -
  P1=F$EXT(0,F$LOCATE("[",P1),P1)+F$EXT(1+F$LOCATE("[",P1),L-F$LOCATE("[",P1),P1)
$ IF F$LOCATE("]",P1).NE.L THEN -
  P1=F$EXT(0,F$LOCATE("]",P1),P1)+F$EXT(1+F$LOCATE("]",P1),L-F$LOCATE("]",P1),P1)
$ IF F$LOCATE("<",P1).NE.L THEN -
  P1=F$EXT(0,F$LOCATE("<",P1),P1)+F$EXT(1+F$LOCATE("<",P1),L-F$LOCATE("<",P1),P1)
$ IF F$LOCATE(">",P1).NE.L THEN -
  P1=F$EXT(0,F$LOCATE(">",P1),P1)+F$EXT(1+F$LOCATE(">",P1),L-F$LOCATE(">",P1),P1)

$ L=F$LENGTH(P1)
$ D_PUNKT=F$LOCATE(":",P1)
$ IF D_PUNKT.LT.L THEN SET DEF 'F$EXT(0,D_PUNKT+1,P1)
$ IF D_PUNKT.LT.L THEN P1=F$EXT(D_PUNKT+1,L,P1)
$!
$!
$ MAIN_LOOP:
$ IF P1.EQS."" THEN GOTO SHOW_DEF
$ L=F$LENGTH(P1)
$ P=F$LOCATE(".",P1)
$ A=F$LOCATE("*",P1)
$ IF (A.NE.L).AND.(A.LT.P) THEN GOTO ASTERISK
$!
$!
$ ADR=F$EXT(0,P,P1)
$ IF ADR.NES."-" THEN GOTO V1
$ ADR="[-]"
$ GOTO SET_DEF
$!
$!
$ V1:
$ IF F$SEARCH("''ADR'.DIR").EQS."" THEN GOTO V2
$ ADR="[.''ADR']"
$ IF F$DIRECTORY().EQS."[000000]" THEN ADR="[''F$EXT(0,P,P1)']"
$ GOTO SET_DEF
$!
$!
$ V2:
$ IF ((FLAG.EQ.1).OR.(F$SEARCH("[000000]''ADR'.DIR").EQS."")) THEN GOTO V3
$ ADR="[''ADR']"
$ GOTO SET_DEF
$!
$!
$ V3:
$ IF ((FLAG.EQ.1).OR.(F$SEARCH("''ADR':[000000]*.*").EQS."")) THEN GOTO V4
$ ADR="''ADR':[000000]"
$ GOTO SET_DEF
$!
$!
$ V4:
$ IF ((FLAG.EQ.0).AND.(F$SEARCH("''ADR':*.*").NES."")) THEN GOTO SET_DEF
$! 
$ GOTO NO_DEF
$!
$!
$ SET_DEF:
$ SET DEF 'ADR
$ FLAG=1
$ P1=F$EXT(P+1,L,P1)
$!
$ GOTO MAIN_LOOP
$!
$!
$ SHOW_DEF:
$ WRITE SYS$OUTPUT ESC,"[1A",ESC,"[1m",F$ENVIRMOENT("DEFAULT"),-
  ESC,"[0m",ESC,"[0K"
$ IF ADRESSE.NES."" THEN DEFINE/NOLOG BACK 'DEF_ALT
$ EXIT
$!
$!
$ NO_DEF:
$ WRITE SYS$OUTPUT BELL,ESC,"[1AERROR in setting Default to ",ESC,"[0;5m",-
ADRESSE,ESC,"[0K"
$ WRITE SYS$OUTPUT ESC,"[0;1m",F$ENVIRMOENT("DEFAULT"),ESC,"[0m",ESC,"[0K"
$ GOTO SHOW_DEF
$!
$!
$ ASTERISK:
$ P=F$LOCATE(".",P1)
$ STERN=F$LOCATE("*",P1)
$ STRING=F$SEARCH("''F$EXT(0,P,P1)'.DIR")
$ IF ((FLAG.EQ.0).AND.(STRING.EQS."")) THEN -
  STRING=F$SEARCH("[000000]''F$EXT(0,P,P1)'.DIR")
$ IF STRING.EQS."" THEN GOTO NO_DEF
$ X=F$LOCATE("]",STRING)
$ IF X.EQ.F$LEN(STRING) THEN X=F$LOCATE(">",STRING)
$ X=X+1
$ Y=F$LOCATE(".",F$EXTR(X,F$LEN(STRING)-X,STRING))
$ P=F$LOCATE(".",P1)
$ IF P.NE.F$LEN(P1) THEN P1=F$EXT(X,Y,STRING)+"."+F$EXT(P+1,F$LEN(P1)-P,P1)
$ IF P.EQ.F$LEN(P1) THEN P1=F$EXT(X,Y,STRING)
$ GOTO MAIN_LOOP