From:	ADVAX::"mcnc!WKUVX1.BITNET!goathunter" "Hunter Goatley, WKU" 25-MAY-1991 04:07:58.29
To:	flist-l@WKUVX1.BITNET
CC:	
Subj:	procedure flist_tree - optional patch to FLIST v2.0

Received: by ADVAX.DECnet (utk-mail11 v1.5) ; Sat, 25 May 91 04:06:07 EDT
Received:  from mcnc by ge-dab.GE.COM (5.61/GE-DAB 1.15) with UUCP
	id AA10967 for ; Sat, 25 May 91 02:32:19 -0400
Received: from UKCC.uky.edu by mcnc.mcnc.org (5.59/MCNC/3-21-91)
	id AA24205; Fri, 24 May 91 18:28:23 -0400
	for ARISIA.DNET.ge.com!EVERHART
Received: from ukcc.uky.edu by UKCC.uky.edu (IBM VM SMTP V2R1)
   with BSMTP id 2614; Fri, 24 May 91 18:27:53 EST
Received: from UKCC by ukcc.uky.edu (Mailer R2.07) with BSMTP id 3700; Fri, 24
 May 91 18:27:20 EST
Received: from WKUVX1.BITNET by ukcc.uky.edu (Mailer R2.07) with BSMTP id 3647;
 Fri, 24 May 91 18:26:27 EST
Received: by WKUVX1.BITNET (MX V2.2-2) id 476; Fri, 24 May 1991 16:50:13 CDT
Date: Fri, 24 May 1991 16:50:13 CDT
From: "Hunter Goatley, WKU" <mcnc!WKUVX1.BITNET!goathunter>
To: flist-l@WKUVX1.BITNET
Message-Id: <0094916F.DA291560.476@WKUVX1.BITNET>
Subject: procedure flist_tree - optional patch to FLIST v2.0
 
procedure flist_tree
 local root_search, root_tree, file_spec, file_array, last_spec, this_position,
       level, offset, newoffset, display_line, array_index, this_window,
       root_flag, the_index, found_flag;
 
on_error
  [TPU$_CONTROLC]:                      !On CTRL-C
    if (current_window = tree_window) then ! Almost finished anyway
      flist_set_status_line(0);
      set (timer, OFF);
      message(" ");
      position(beginning_of(flist$tree_buffer));
      scroll(tree_window,1);
      flist_tree_position_default;
      flist$tree_post_key_procedure;
    else
      erase(flist$reftree_buffer);
      erase(flist$tree_buffer);
      position(this_position);
      position(this_window);
    endif;
    message(ERROR_TEXT);                !Say "Operation aborted by CTRL/C"
    return;                             !Return to the caller
  [OTHERWISE] : ;
    message(ERROR_TEXT);
    return;
  [TPU$_SEARCHFAIL]:
endon_error;
 
 this_position := mark(free_cursor);
 this_window   := current_window;
 set (timer, ON, "Reading...");
 message("Finding all directories...");
 
! start at SYS$LOGIN if in our own tree
! start at other root directory unless already at [000000]
 if (file_parse("sys$disk:[]","","",directory) = "[000000]")  then
   root_tree   := file_parse("sys$disk:[]","","",device) + "[000000]";
   root_search := file_parse("sys$disk:[]","","",device) + "[000000...]*.DIR";
   root_flag := TRUE;
 else ! check if within own tree
   root_flag := FALSE;
   current_root := file_parse("sys$disk:[]","","",device,directory);
   if index(current_root,".") <> 0 then
     if index(current_root,"[000000") <> 0 then !Strip out 000000 to compare
       current_root := file_parse(current_root,"","",device) + "[" +
                       substr(current_root,index(current_root,".")+1);
     endif;
     if index(current_root,".") <> 0 then ! Keep first directory only
       current_root := substr(current_root,1,index(current_root,".")-1) + "]";
     endif;
   endif;
   root_tree   := current_root;
   root_search := current_root - "]" + "...]*.DIR";
 endif;
 
 file_spec := file_search ('');
 file_array := create_array(200);
 flist$tree_array := create_array(200);
 loop
   file_spec := file_search (root_search);
   exitif file_spec = "";
   found_flag := TRUE;
   if root_flag then
     if index(file_spec,"[000000") = 0 then
       the_index := index(file_spec,"[");
       file_spec := substr(file_spec,1,the_index) + "000000." +
                    substr(file_spec,the_index+1);
     endif;
   endif;
   translate(file_spec,".","]");
   file_spec := substr(file_spec,1,index(file_spec,".DIR")-1);
   file_array{file_spec} := 1;
 endloop;
 if not found_flag then
   erase(flist$reftree_buffer);
   if current_buffer = flist$tree_buffer then
     unmap(tree_window);
     unmap(reftree_window);
     flist_set_status_line(0);
     message("No directories found---Returned to File list");
   else
     message("No directories found");
   endif;
   return;
 endif;
 
! Make Reference array
 last_spec := get_info(file_array,"last");
 file_spec := get_info(file_array,"first");
 array_index := 1;
 flist$tree_array{1} := root_tree;
 loop
   array_index := array_index + 1;
   flist$tree_array{array_index} := file_spec + "]";
   exitif (file_spec = last_spec);
   file_spec := get_info(file_array,"next");
 endloop;
 flist$tree_last_index := array_index;
 
! Make Display buffer -- Pick out last directory and level
 if (get_info(flist$tree_buffer,"type") <> BUFFER) then
   flist$tree_buffer := create_buffer("DIRECTORY TREE");
   set(eob_text,flist$tree_buffer,"[End of TREE buffer]");
 endif;
 set(no_write,flist$tree_buffer);
 set(scrolling,tree_window,on,0,2,0);
 set(modifiable,flist$tree_buffer,on);
 erase(flist$tree_buffer);
 position(beginning_of(flist$tree_buffer));
 copy_text(" " + root_tree);
 display_line := "  " + "|     "*20;
 array_index := 2;
 loop
   file_spec := flist$tree_array{array_index};
   level := -1;
   offset := 1;
   loop
     newoffset := index(substr(file_spec,offset),".");
     exitif(newoffset = 0);
     offset := offset + newoffset;
     level := level + 1;
   endloop;
   split_line;
   copy_text(substr(display_line,1,3+(level*6)) + "--" +
             substr(file_spec,offset) - "]" );
   exitif (array_index = flist$tree_last_index);
   array_index := array_index + 1;
 endloop;
 position(this_position);
 map(reftree_window, flist$reftree_buffer);
 map(tree_window, flist$tree_buffer);
 flist_set_status_line(0);
 set (timer, OFF);
 message(" ");
 position(buffer_begin);
 scroll(tree_window,1);
 flist_tree_position_default;
 flist$tree_post_key_procedure;
endprocedure;
 
