!+ ! NAME ! get_default_dir -- uses lib$find_file to get current directory ! ! DESCRIPTION ! This routine does a DIR on []*.*;* and gets the current ! directory when needed for /INPUT /OUTPUT commands. ! ! RETURN VALUE ! ! HISTORY ! 7/18/88 Bauer Initial implementation. ! !- MODULE RCMS$GET_DEFAULT_DIR IDENT 'v1.0'; EXTERNAL PROCEDURE lib$find_file( STRING, STRING, INTEGER ) OF BOOLEAN; ! For searching current directory PROCEDURE get_default_dir ( return_dir : STRING, return_dir_length : INTEGER ); DECLARE context : INTEGER; DECLARE full_file_name : STRING; DECLARE i, len : INTEGER; context = 0; ! Search current directory WHILE lib$find_file( '[]*.*;*', full_file_name, context ); ! DIR []*.*;* len = LENGTH(full_file_name); FOR i = len TO 1 STEP -1; ! Strip out default dir IF full_file_name[i..i] = ']' THEN return_dir = full_file_name[1..i]; return_dir_length = i; i = 1; END IF; END FOR; RETURN; END WHILE; END PROCEDURE; END MODULE;