sub find_dirs
!	Written by Michael W. Wheeler (mww@tntech.bitnet)
!	VAX Basic V3.1
!	Copyright (c) by Michael W. Wheeler, September 1987
!	This program is intended for Public Domain, and may not be sold or
!	marketed in any form without the permision and written consent
!	from the author Michael W. Wheeler.  I retain all copyrights to
!	this program, in either the original or modified forms, and no
!	violation, deletion, or change of the copyright notice is
!	allowed.  Futhermore, I will have no liability or responsibilty
!	to any user with respect to loss or damage caused directly or
!	indirectly by this program.

! Lables
!	dir_number:

! Constants
%include "$ssdef"  %from %library "sys$library:basic$starlet.tlb"
%include "$rmsdef" %from %library "sys$library:basic$starlet.tlb"
%include "$dvidef" %from %library "sys$library:basic$starlet.tlb"
%include "$jpidef" %from %library "sys$library:basic$starlet.tlb"
external long constant		msg_notfound, msg_nocando, msg_nodef,	     &
				msg_unknown, msg_noscope, msg_noeventflg,    &
				msg_illegal, msg_noaccess 
declare integer constant	maxdirs = 2000
declare byte constant		TRUE = -1, FALSE = 0
declare string constant		dir_spec = "*.dir"

! Type (Record)
record fixed_len
    string			strng = 512
end record

record itmlst
    word			buf_len, itemcode
    long			buf_loc, len_loc
end record

record iosblk
    long			io_status, reserved
end record

! Variables
declare long			cur_col, cur_row, sys_status, term_type,     &
				return_status, context, dot_location,	     &
				dir_selection, scope
declare word			dir_count, len_dir, dot, colon, lbracket
declare string			dir_file, p1, full_name, dev, split_dir,     &
				test_logical, print_string, search_str,	     &
				new_dir(maxdirs)
declare fixed_len		cur_dir
declare itmlst			itemlist(5%)
declare iosblk			iosb
common (flags) byte		dir, prompt, help, log_qual
common (io_l) long		term_table, col_len, num_cols, tt_cols, tt_rows
common (io_w) word		chan, max_dir, cursor_len, start_row, start_col
common (rd_dirs) long		col_compare

! Procedures (Sub)
external sub			read_dirs( string, string dim ( ) ),	     &
				fancy_selection( long, string dim ( ) )

! Functions
external long function		lib$find_file, cli$get_value,		&
				sys$setddir,lib$set_logical,		&
				lib$getjpi, lib$sys_trnlog, sys$assign,	&
				sys$getdviw, sys$dassgn,		&
				smg$init_term_table_by_type
external integer function	find_last by desc ( string, string )

! These are declared as variables but are used as constants.

start_row = 5%
start_col = 1%

! Fill item list for call to sys$getdviw( ).
itemlist(1)::buf_len = 4%
itemlist(1)::itemcode = dvi$_devtype
itemlist(1)::buf_loc = loc(term_type)
itemlist(1)::len_loc = 0%

itemlist(2)::buf_len = 4%
itemlist(2)::itemcode = dvi$_devbufsiz
itemlist(2)::buf_loc = loc(tt_cols)
itemlist(2)::len_loc = 0%

itemlist(3)::buf_len = 4%
itemlist(3)::itemcode = dvi$_tt_page
itemlist(3)::buf_loc = loc(tt_rows)
itemlist(3)::len_loc = 0%

itemlist(4)::buf_len = 4%
itemlist(4)::itemcode = dvi$_tt_scope
itemlist(4)::buf_loc = loc(scope)
itemlist(4)::len_loc = 0%

itemlist(5)::buf_len = 0%
itemlist(5)::itemcode = 0%
itemlist(5)::buf_loc = 0%
itemlist(5)::len_loc = 0%
         
! Assign a channel to the terminal.

sys_status = sys$assign('sys$output',chan,,,)
if (sys_status and 1%) = 0% then call lib$signal( sys_status by value ) end if

! Get device type, buffer size, page size, and whether it's a
! scope terminal or not.
sys_status = sys$getdviw( ,	chan by value,,				&
				itemlist(1%) by ref,			&
				iosb by ref,,,	)
if ((sys_status and 1%) = 0%) or ((iosb::io_status and 1%) = 0%) then
    call lib$signal( sys_status by value )
    call lib$signal( iosb::io_status by value )
    call sys$exit( 1% by value )
end if

if tt_cols < 14% then tt_rows = tt_rows - 1% end if ! Allow extra line for wrapping.

! Call the help routine if /HELP was on the command line.

if help then
    call help
    exit sub
end if

! Was there a directory specification on the command line?

if dir then
    return_status = cli$get_value("directory", p1)
    if return_status <> ss$_normal then
     	call lib$signal( return_status by value )
    end if
    ! Try to convert the specification to a number.
    call ots$cvt_ti_l( p1 by desc, dir_selection by ref )
    ! Is it negative?
    if dir_selection < 0% then
	! Negative number means look for a directory whose name is a number.
	p1 = num1$(abs%(dir_selection))
	dir_selection = FALSE
    end if
dir_number:
    ! If it converted to a number > 0 then if dir_selection will be true.
    if dir_selection then
	! The specification was a number.
	call read_dirs( "", new_dir( ) )
	if dir_selection > max_dir then
	    dir_selection = FALSE
	    goto dir_number
	end if
	call set_dir( new_dir(dir_selection) )
	if prompt = TRUE then
	    dot = find_last(".", new_dir(dir_selection)) + 1%
	    call set_prompt( mid(new_dir(dir_selection), dot, instr(1%, new_dir(dir_selection), "]") - dot) )
	end if
    else
	! Must be a directory name specification.
	sys_status = lib$sys_trnlog( p1 by desc,, test_logical by desc,,, ) ! Try to translate if as if it were a logical name.
	if sys_status = ss$_normal then
	    p1 = p1 + ":"
	else
	    if (sys_status and 1%) = 0% then call lib$signal( sys_status by value ) end if
	end if
	colon = instr(0%, p1, ":")
	lbracket = instr(0%, p1, "[")
	dot = instr(0%, p1, ".")
	if (lbracket = 0%) and (colon = 0%) and (dot) then
	    if dot <> 1% then
	        p1 = "[." + p1 + "]"
	    else
		p1 = "[" + p1 + "]"
	    end if
	    lbracket = instr(0%, p1, "[")
	end if
	if colon or lbracket then
	    search_str = p1 + "*.*"
	    sys_status = lib$find_file( search_str, dir_file, context )
	    ! if status is not successful then user doesn't have
	    ! access to that directory.
	    if (sys_status <> rms$_normal and sys_status <> rms$_fnf) then
		if sys_status <> rms$_dnf then
		    call lib$signal( sys_status by value )
		    call lib$signal( msg_noaccess by value )
		else
		    call lib$stop( sys_status by value )
		end if
	    end if
	    ! Split the specification into device/logical and directory specs.
	    call split( p1, dev, split_dir, colon, lbracket )
	    if split_dir <> "" then
		call set_dir( p1 )
	    end if
	    ! If there was a device specification then change the default device.
	    if dev <> "" then
		return_status = lib$set_logical( "SYS$DISK" by desc,	&
						 dev by desc,,, )
		if (return_status <> ss$_supersede) and (return_status <> ss$_normal) then
		    call lib$signal( return_status by value )
		end if
	    end if
	    if prompt then
		! Set the DCL prompt based on the new directory.
	        return_status = sys$setddir( 0% by value,	&
		    			     len_dir by ref,	&
					     cur_dir::strng by desc )
		if return_status <> rms$_normal then
		    call lib$signal( return_status by value )
		end if
	        dot = find_last(".", cur_dir::strng)
		if dot = 0% then dot = 1% end if
		right_braket = instr(0%, cur_dir::strng, "]")
		dir_file = mid(cur_dir::strng, dot+1%, right_braket-(dot+1%))
		call set_prompt( dir_file )
	    end if
            exit sub
	end if
	context = 0
	return_status = sys$setddir(	0% by value,		&
					len_dir by ref,		&
					cur_dir::strng by desc )
	if return_status <> rms$_normal then
	    call lib$signal( return_status by value )
	end if
	full_name = "[...]" + p1 + ".dir"
	return_status = lib$find_file( full_name, dir_file, context )
	! If directory not found the search from the root down if not already
	! at the root.
	if (return_status <> rms$_normal) and (instr(0%, cur_dir::strng, ".")) then
	    dot_location = instr(0%, cur_dir::strng, ".")
	    if dot_location then
		full_name = mid(cur_dir::strng, 0%, dot_location) + "..]" + p1 + ".dir"
	    else
	    	full_name = mid(cur_dir::strng,0%,len_dir - 1%) + "...]" + p1 + ".dir"
	    end if
	    return_status = lib$find_file( full_name, dir_file, context )
	end if
	if return_status = rms$_normal then
	    ! Sucessful status - set default.
	    right_braket = instr(0%, dir_file, "]")
	    mid(dir_file, right_braket, 1%) = "."
	    new_braket = instr(right_braket, dir_file, ";") - 4%
	    mid(dir_file, new_braket, 1%) = "]"
	    dir_file = mid(dir_file, 0%, new_braket)
	    search_str = dir_file + "*.*"
	    sys_status = lib$find_file( search_str, search_str, context )
	    ! if status is not successful then user doesn't have
	    ! access to that directory.
	    if (sys_status <> rms$_normal and sys_status <> rms$_fnf) then
		if sys_status <> rms$_dnf then
		    call lib$signal( sys_status by value )
		    call lib$signal( msg_noaccess by value )
		else
		    call lib$stop( sys_status by value )
		end if
	    end if
	    call set_dir( dir_file )
	    dir_file = mid(dir_file, right_braket+1%, new_braket-right_braket - 1%)
	    if prompt then call set_prompt( dir_file ) end if
	else
	    ! Bad specification.
	    call lib$signal(msg_notfound by value)
	end if
	exit sub
    end if
else
    call read_dirs( "", new_dir( ) )
    if max_dir = 1% then
	! If only one subdirectory in current directory and none was specified
	! on the command line then set default to it.
    	call set_dir(new_dir(1%))
    	if prompt then
	    dot = find_last(".", new_dir(1%)) + 1%
	    call set_prompt( mid(new_dir(1%), dot, instr(1%, new_dir(1%), "]") - dot) )
	end if
	exit sub
    end if
    dir_count = 1%
    cur_col = 1%
    cur_row = 1%
    cursor_len = 0%

    if tt_rows < start_row then
	call lib$signal(msg_nocando by value, 1% by value, start_row by value)
	exit sub
    end if

    col_len = min(20%, tt_cols)
    num_cols = tt_cols / col_len
    col_compare = num_cols * col_len - col_len
    ! Get the definition for the type of terminal we are running on.
    sys_status = smg$init_term_table_by_type(term_type, term_table)
    if (Sys_status and 1%) = 0% then
	call lib$signal(msg_nodef by value)
	call lib$signal(msg_unknown by value)
	!call lib$signal(msg_hardcopy by value)
	!call hardcopy
        call lib$signal( sys_status by value )
    else
	if scope = 0% then
	    call lib$signal(msg_noscope by value)
	    !call lib$signal(msg_hardcopy by value)
	    !call hardcopy
	end if
    end if

    call fancy_selection( dir_selection, new_dir( ) )
    if (dir_selection < 0%) or (dir_selection > max_dir) then
	call lib$signal( msg_illegal by value )
	exit sub
    end if
    if dir_selection <> 0% then
	call set_dir(new_dir(dir_selection))
	if prompt then
	    dot = max(find_last(".", new_dir(dir_selection)) + 1%,	&
		      instr(0%, new_dir(dir_selection), "[") + 1%)
	    call set_prompt( mid(new_dir(dir_selection), dot, instr(1%, new_dir(dir_selection), "]") - dot) )
	end if
	exit sub
    end if

    ! Deassign the channel.
    sys_status = sys$dassgn (chan by value)

    if (sys_status and 1%) = 0% then
	call lib$signal( sys_status by value )
    end if
end if

subend