/* $GROUPDIRTREE does for group directories what BBN's $DIRTREE does for dirs */
/* This procedure was written by Rivkah Stabiner, Eye Research Institute */
/* It is based on the $DIRTREE procedure provided by Bolt Beranek and Newman */
/* Return a text dir tree picture, thus should invoke this proc like: */
/*      TYPE DIRTREE()    or    A=DIRTREE()               */
/* Truncate long object names to 20 chars, like DIR does. */
/* MUST provide NUM_CHARS argument to not truncate longer names. */
/* Can pass DATA_TYPE and/or CONTAINS_STRING to limit result. */
/* Can pass START_PATH to restrict result to part of the dir tree. */

procedure(start_path,data_type,contains_string,indent_string,num_chars);
{
    first_thru = False;
    if empty(indent_string) then   /* can only be empty first time thru */
	{
	first_thru = True;
	if empty(num_chars) then num_chars = 20;
	if notempty(data_type) then
	    {       /* fix up the data_type argument */
	    data_type = caps(data_type);
	    if data_type='TABLES' then
		data_type = 'Table';
	    else if data_type='GRAPHS' then
		data_type = 'Graph';
	    else if data_type='BARGRAPHS' then
		data_type = 'Bargraph';
	    else if data_type='PIECHARTS' then
		data_type = 'Piechart';
	    else if data_type='THREEDS' then
		data_type = 'Threed';
	    else if data_type='MODELS' then
		data_type = 'Model';
	    else if data_type='DIRS' then
		data_type = 'Dir';
	    else call error('Can only specify TABLES, GRAPHS,
BARGRAPHS, PIECHARTS, THREEDS, MODELS, or DIRS.');
	    }
        indent_string = '';
	if notempty(start_path) then
	    {
	    old_dir = #dir;
	    #dir = start_path;
	    }
	start_path=$path(#dir);
	wh=loc('DIR OF ',start_path);
	if (wh = 0) then 
	    {
            start_path = '#@';
    	    result_string = indent_string.'Top-level Directory';
	    }
	else 
	    {
start_path=ext(1,wh-1,start_path).ext(wh+7,chars(start_path),start_path);
            result_string = indent_string.'Directory: '.start_path;
	    }
	}
    else
    	result_string = indent_string.'Directory: '.start_path;

    c=chars(indent_string);
    b=chars(result_string)-c;
    if (b<num_chars+10) then b=num_chars+10;    /* 10 is for the object type */
    b=b+c;

    result_string = '
'.result_string.'
'.ext(1,b,indent_string.
'----------------------------------------------------------------------------').'
';

	/* need to add the 's' back on */
    /* fix up the start_path */
	start_path_save = start_path;
	start_path = $replacetext('@#','@',start_path);
    if empty(data_type) then    /* but only if is something there */
        call $$dir(dir_table,start_path,data_type,contains_string);
    else
        call $$dir(dir_table,start_path,(data_type.'s'),contains_string);
    nrows = lastrow(dir_table);
    if empty(data_type) then    /* only delete the dir rows if not */
	{                       /* looking for a specific data_type */
        if nrows>0 then
    	    {
    	    del rows 1 to nrows of table(dir_table) where col 1 = 'Directory';
    	    }
	}
    else    /* add col 1 because its not there when looking for data_type */
	set col 1 of table(dir_table) = data_type;

    c='                                                                    ';
    nrows = lastrow(dir_table);
    if nrows>0 then
	{
        sort table(dir_table) by col 0;
    	do i = 1 to nrows;
    	    {
	    a=dir_table[i,0];
	    b=chars(a);
	    if (b>num_chars) then 
		{
                b=num_chars;
		a=ext(1,b,a);
		}
	    result_string=result_string.indent_string.
			  a.ext(1,((num_chars+2)-b),c).dir_table[i,1].'
';
	    }
	}
    call $$dir(dir_table,start_path,'Dirs');
    nrows = lastrow(dir_table);
    if nrows>0 then
	{
        sort table(dir_table) by col 0;
	if (start_path='#@') then start_path='#';
	do i = 1 to nrows;
	   {
           result_string=result_string. $groupdirtree((start_path.'@'.dir_table[i,0]),
                         data_type,contains_string,(indent_string.'    '),num_chars);
	   }
	}
    if first_thru then 
	if notempty(old_dir) then
	    #dir = old_dir;
  result_string_save = result_string;
    result_string = $replacetext('@#','@',result_string_save); 
    return result_string;
}