!In article <4163@dftsrv.gsfc.nasa.gov>,
!  vander@nssdcb.gsfc.nasa.gov (John Vanderpool) writes:
!
!> i need a TPU/EVE DIRectory command so i don't have to SPAWN DIR
!> anybody have such a beast or any other neat small EVE procedures
!
!Here you go: (it works for lse too, just do an ADD COMMAND DIRECTORY CALL
!EVE_DIRECTORY)
!
!-- 
!    +----------------------------------------------------------------------+
!    |   Mitchell W. Brown              Internet: brown%gcc@edinboro.edu    |
!    | Grove City College TLC           Uucp: ...pitt!edinboro!gcc!brown    |
!    |  Grove City, PA 16127            (412) 458-2072                      |
!    +----------------------------------------------------------------------+
!----------------------------cut here------------------------------------------
procedure dired_module_ident
  return "V01-000";
endprocedure;

procedure dired_module_init
endprocedure;

procedure eve_directory(cmd_line_arg)
  utl_dired(cmd_line_arg);
endprocedure;

procedure utl_dired(arg_dired_spec)
  local len,name_index,dired_spec,dired_buf,file;
  on_error
    message("DIRECTORY error: Can't reach specified directory.");
    utl_dired_fspec:='';
  endon_error;

  dired_spec := arg_dired_spec;

  dired_buf := Utl_find_buffer("Directory");
  if dired_buf = 0 then
    dired_buf := create_buffer("Directory");
    set (eob_text,dired_buf,"");
    set (no_write,dired_buf);
    set (system,dired_buf);
    set (margins,dired_buf,1,get_info(dired_buf,"RECORD_SIZE")-1);
    utl_dired_fspec:='';
  endif;
  erase (dired_buf);
  if utl_find_kml("dired_kml") = 0 then
    utl_copy_kml(get_info(key_map_list,"CURRENT"),"dired_kml");
    create_key_map("dired_km");
    define_key("utl_dired_edit",ctrl_e_key,"directory edit file","dired_km");
    add_key_map("dired_kml","FIRST","dired_km");
    set(shift_key,ctrl_w_key,"dired_kml");
  endif;
  set (key_map_list,"dired_kml",dired_buf);
  if dired_spec="?" then
    dired_spec := read_line("Directory> ");
    if last_key = ctrl_z_key then
      utl_dired_fspec :='';
      return;
    endif;
  endif;
  utl_dired_fspec := file_parse(utl_dired_fspec,"","",node)+
    file_parse(utl_dired_fspec,"","",device)+
    file_parse(utl_dired_fspec,"","",directory);
  utl_dired_fspec :=file_parse(dired_spec,utl_dired_fspec+"*.*;*");
  if utl_dired_fspec = "" then
    return;
  endif;
  file := file_search(utl_dired_fspec);
  if file = "" then
    message ("File search returned no files.");
    return;
  endif;
  position(dired_buf);
  copy_text("Directory of "+utl_dired_fspec);
  split_line;
  split_line;
  copy_text("[?]  Prompt for new directory path");
  split_line;
  copy_text("[-]  Back up one directory level");
  split_line;
  loop
    name_index := index(file,"]");
    len :=length(file);
    file:=substr(file,name_index+1,len-name_index);
    copy_text(file);
    split_line;
    file := file_search(utl_dired_fspec);
    exitif file = "";
  endloop;
  map(current_window,dired_buf);
  position (beginning_of(dired_buf));
  update(current_window);
  move_vertical(2);
  utl_set_status_line(current_window);
endprocedure;

procedure utl_dired_edit
  local dired_edit_buf,buf_name,dum,file,new_buf_name;

  utl_dired_fspec := file_parse(utl_dired_fspec,"","",node)+
    file_parse(utl_dired_fspec,"","",device)+
    file_parse(utl_dired_fspec,"","",directory);
  if substr(current_line,1,3) = "[-]" then
    if index(utl_dired_fspec,".") = 0 then
      message("You are already at the top of a directory tree.");
      return;
    else
      dum := utl_rcindex(utl_dired_fspec,".");
      utl_dired_fspec := substr(utl_dired_fspec,1,dum-1)+"]";
      utl_dired(utl_dired_fspec);
      return;
    endif;
  endif;
  if substr(current_line,1,3) = "[?]" then
    utl_dired_spec := read_line("Directory> ");
    if last_key = ctrl_z_key then
      return;
    endif;
    utl_dired(utl_dired_spec);
    return;
  endif;
  file := file_parse(current_line,utl_dired_fspec);
  dum:=file_search("");
  file:=file_search(file);
  if file = "" then
    message("File name not selected.");
    return;
  endif;
  if file_parse(file,'','',type)=".DIR" then
    subdir := substr(utl_dired_fspec,1,length(utl_dired_fspec)-1);
    subdir := subdir + "."+file_parse(file,'','',name)+"]";
    utl_dired(subdir);
    return;
  endif;
  buf_name := file_parse(file,"","",name)+file_parse(file,"","",type);
  dired_edit_buf := utl_find_buffer(buf_name);
  if dired_edit_buf <> 0 then
    new_buf_name := read_line(
      "Enter new name.  RETURN to replace, Ctrl-Z to cancel > ");
    edit (new_buf_name,trim);
    if last_key = ctrl_z_key then
      return;
    endif;
    if new_buf_name = '' then
      delete (dired_edit_buf);
      dired_edit_buf := create_buffer(buf_name,file);
    else
      dired_edit_buf := create_buffer(new_buf_name,file);
    endif;
  else
    dired_edit_buf := create_buffer(buf_name,file);
  endif;
  position (beginning_of(dired_edit_buf));
  map(current_window,dired_edit_buf);
  utl_set_status_line(current_window);
endprocedure;

procedure utl_find_kml(key_list_name);
local upcased_name,km_list;
  upcased_name := key_list_name;
  change_case(upcased_name,upper);
  km_list := get_info(key_map_list,'FIRST');
  loop
    exitif km_list = 0;
    exitif upcased_name = km_list;
    km_list := get_info(key_map_list,'NEXT');
  endloop;
  return km_list;
endprocedure;

procedure utl_copy_kml(src_kml,dest_kml)
local km,kml_new;
  if utl_find_kml(src_kml) = 0 then
    message("COPY_KML: Source key map list does not exist - no copy done");
    return 0;
  endif;
  km := get_info(key_map,"FIRST",src_kml);
  if km=0 then
    message("COPY_KML: Source key map list empty - no copy done");
    return 0;
  endif;
  if utl_find_kml(dest_kml)<>0 then
    add_key_map(dest_kml,"LAST",km);
  else
    create_key_map_list(dest_kml,km);
  endif;
  loop
    km := get_info(key_map,"NEXT",src_kml);
    exitif km=0;
    add_key_map(dest_kml,"LAST",km);
  endloop;
endprocedure;

procedure utl_find_buffer(buffer_name)
local upcased_name,buffer_ptr;
  upcased_name := buffer_name;
  change_case(upcased_name,upper);
  buffer_ptr := get_info(buffers,'FIRST');
  loop
    exitif buffer_ptr = 0;
    exitif upcased_name = get_info(buffer_ptr,'NAME');
    buffer_ptr:=get_info(buffers,'NEXT');
  endloop;
  return buffer_ptr;
endprocedure;

procedure utl_rcindex(src,sub)
local idx,new_idx,tmp;
  idx := 0;
  tmp := src;
  loop
    new_idx := index(tmp,sub);
    exitif new_idx = 0;
    tmp := substr(tmp,new_idx+1,length(tmp)-new_idx);
    idx := idx + new_idx;
  endloop;
  return (idx);
endprocedure;

procedure utl_set_status_line(win)
local msg_buf_name;
on_error
endon_error;
  msg_buf_name := get_info(message_buffer,"NAME");
  if msg_buf_name = "MESSAGES" then
    eve$set_status_line(win);
    return;
  endif;
  if msg_buf_name = "$MESSAGES" then
    lse$set_status_line(win);
    return;
  endif;
endprocedure;