100 %ident "V4.01" ! ! DIRSET - set symbols and logicals for directory navigation ! ! Eric F. Richards, 25-Jun-85 ! ! First DIRSET.BAS created c. 1982 at Hiram College by EFR ! Original .COM file created c. 1982 at Hiram College by EJE ! option type=integer, size=(integer long) ! external sub lib$signal(long by value) external integer function lib$set_symbol external integer function lib$set_logical external integer function lib$find_file declare string constant subdirs = "[...]*.DIR;1" ! ! Get default file name to find the starting search location ! call lib$get_foreign(deffil$) ! ! Loop until no more ! while (lib$find_file(subdirs, dirfil$, contxt, deffil$) and 1) = 1 ! ! Get dir name and dir spec from file name returned above ! startname = pos(dirfil$, "]", 1) endname = pos(dirfil$, ".", startname) - 1 dirnam$ = seg$(dirfil$, startname + 1, endname) dirspec$ = seg$(dirfil$, 1, startname - 1) + "." + dirnam$ + "]" ! %if %variant = 2 %then print dirfil$; tab(39%); " "; dirspec$ %else ! ! Set global symbol, process logical ! st1 = lib$set_symbol (dirnam$, "SET DEFAULT " + dirspec$, 2) st2 = lib$set_logical(dirnam$, dirspec$) ! ! Optional error checking code - activate with BAS/VARIANT=1 ! %if %variant = 1 %then ! ! On error then force a traceback ! call lib$signal(st1) if (st1 and 1) <> 1 call lib$signal(st2) if (st2 and 1) <> 1 %else ! ! Make sure a valid compilation option was supplied ! %if %variant <> 0 %then %abort "Improper %VARIANT supplied - use 0 or 1" %end %if %end %if %end %if ! next %if %variant = 2 %then print "Exiting name: ";dirfil$ %end %if end