From:	CSBVAX::MRGATE!@KL.SRI.Com:scgvaxd!ENGVAX.SCG.HAC.COM!PORTIA@seismo.CSS.GOV@SMTP 14-AUG-1987 22:28
To:	EVERHART
Subj:	new SWING source, part 2 of 5 (2.for)

Received: from seismo.CSS.GOV by KL.SRI.COM with TCP; Fri 14 Aug 87 15:45:51-PDT
Received: from scgvaxd.UUCP by seismo.CSS.GOV (5.54/1.14) with UUCP 
	id AA09991; Fri, 14 Aug 87 18:44:21 EDT
Received: by scgvaxd.SCG.HAC.COM (5.51/smail2.2/04-02-87)
	id AA11118; Fri, 14 Aug 87 08:57:05 PDT
Message-Id: <8708141557.AA11118@scgvaxd.SCG.HAC.COM>
Date: Thu, 13 Aug 87 23:03 PDT
From: Portia 616-2635 <PORTIA@engvax.scg.hac.com>
Subject: new SWING source, part 2 of 5 (2.for)
To: info-vax%kl.sri.COM@scgvaxd.scg.hac.com
X-Vms-To: INFO-VAX-SUBMIT

$ show default
$ check_sum = 846395426
$ write sys$output "Creating 2.FOR"
$ create 2.FOR
$ DECK/DOLLARS="$*$*EOD*$*$"
      subroutine add_node( new_dir, parent )

      include    'swing.cmn'

      character new_dir*42, spec*255
      integer   parent, len, new_node, free_node, ii, jj
      logical   greater

      call str$trim( new_dir, new_dir, len )

      spec = node(parent).spec(1:node(parent).length)//
     .       new_dir(1:len)//'.DIR;1'

      new_node = free_node()

      call file_to_dir( spec, 
     .                  node(new_node).spec,
     .                  node(new_node).length,
     .                  node(new_node).name )

      if ( node(parent).child .eq. 0 ) then
         node(parent).child = new_node

         else
         ii = node(parent).child
         if ( node(new_node).name .lt. node(ii).name ) then
            node(new_node).sister = node(parent).child
            node(parent).child = new_node            

            else
            greater = .true.
            do while ( greater )
               if ( node(ii).sister .eq. 0 ) then
                  node(ii).sister = new_node
                  greater = .false.

                  else 
                  jj = ii
                  ii = node(ii).sister
                  if ( node(new_node).name .lt. node(ii).name ) then
                     node(jj).sister = new_node
                     node(new_node).sister = ii
                     greater = .false.
                     end if
                  end if                  
            end do
            end if            
         end if

      return
      end
      subroutine add_node_to_display( num )

      include    'swing.cmn'
      include    '($smgdef)'

      integer    column, num, level

      node(num).rend = smg$m_reverse

      level =  node(num).level
      column = level * 17 + 1
      line =   node(num).line

      call smg$put_chars( window2, node(num).name, line, column,,
     .                    node(num).rend )
      call smg$draw_line( window2, line, column-3, line, column-1 )  

      if ( level .eq. last_level ) then
         call smg$draw_line( window2, line-1, column-3, line, column-3 )
         else if ( level .eq. last_level + 1 ) then
         call smg$draw_line( window2, line, column-5, line, column-2 )
         else if ( level .lt. last_level ) then
         call smg$draw_line( window2, last_line(level), column-3, 
     .                       line, column-3 )
         end if

      if ( .not. found .and. root(2:len_root-1)
     .     .eq. node(num).spec(2:node(num).length-1) ) then
         found = .true.
         cur_line = line
         cur_level = level
         end if

      last_level = level
      last_line(level) = line

      return
      end
      subroutine adjust_node_pointers

      include    'swing.cmn'
      include    '($smgdef)'

      integer ll, jj, ptr(0:7), ii

      do ll = 1, MAX_LINES
         do jj = 0, MAX_LEVELS
            node_pointer(jj,ll) = 0
         end do
      end do

      do jj = 0, MAX_LEVELS
         ptr(jj) = 0
      end do

      ll = 1     !LINE
      ptr(0) = 1

      node_pointer(0,ll) = 1
      ptr(1) = node(ptr(0)).child
      do while( ptr(1) .ne. 0 )
        node_pointer(1,ll) = ptr(1)
        node(ptr(1)).line = ll
        node(ptr(1)).level = 1
        ptr(2) = node(ptr(1)).child
        do while( ptr(2) .ne. 0 ) 
          node_pointer(2,ll) = ptr(2)
          node(ptr(2)).line = ll
          node(ptr(2)).level = 2
          ptr(3) = node(ptr(2)).child
          do while( ptr(3) .ne. 0 ) 
            node_pointer(3,ll) = ptr(3)
            node(ptr(3)).line = ll
            node(ptr(3)).level = 3
            ptr(4) = node(ptr(3)).child
            do while( ptr(4) .ne. 0 ) 
              node_pointer(4,ll) = ptr(4)
              node(ptr(4)).line = ll
              node(ptr(4)).level = 4
              ptr(5) = node(ptr(4)).child
              do while( ptr(5) .ne. 0 ) 
                node_pointer(5,ll) = ptr(5)
                node(ptr(5)).line = ll
                node(ptr(5)).level = 5
                ptr(6) = node(ptr(5)).child
                do while( ptr(6) .ne. 0 ) 
                  node_pointer(6,ll) = ptr(6)
                  node(ptr(6)).line = ll
                  node(ptr(6)).level = 6
                  ptr(7) = node(ptr(6)).child
                  do while( ptr(7) .ne. 0 ) 
                    node_pointer(7,ll) = ptr(7)
                    node(ptr(7)).line = ll
                    node(ptr(7)).level = 7
                    ptr(7) = node(ptr(7)).sister
                    if ( ptr(7) .ne. 0 ) ll = ll + 1
                  end do
                  ptr(6) = node(ptr(6)).sister
                  if ( ptr(6) .ne. 0 ) ll = ll + 1
                end do
                ptr(5) = node(ptr(5)).sister
                if ( ptr(5) .ne. 0 ) ll = ll + 1
              end do
              ptr(4) = node(ptr(4)).sister
              if ( ptr(4) .ne. 0 ) ll = ll + 1
            end do
            ptr(3) = node(ptr(3)).sister
            if ( ptr(3) .ne. 0 ) ll = ll + 1
          end do
          ptr(2) = node(ptr(2)).sister
          if ( ptr(2) .ne. 0 ) ll = ll + 1
        end do
        ptr(1) = node(ptr(1)).sister
        if ( ptr(1) .ne. 0 ) ll = ll + 1
      end do

      lowest_level = 0
      do ii = 1, num_nodes
         if ( node(ii).level .gt. lowest_level ) 
     .      lowest_level = node(ii).level
      end do

c      if ( lowest_level .gt. 7 ) then
c         call print_message( 'Directory nesting is to deep', 1 )
c         end if

      num_lines = ll

      return
      end
      subroutine append_fnode( spec )

c     Craig Young               3-AUG-87

c     This subroutine adds a file name to the FNode array, truncating, if
c     necessary, the file spec into a 20-character name.

      include    'swing.cmn'

      integer    len_node, ii
      character  specout*255, spec*255

      num_files = num_files + 1
      file_num = num_files
      ii = 1
      do while ( spec(ii:ii) .ne. ']' .and. spec(ii:ii) .ne. '>' )
         ii = ii + 1
         end do

      call str$trim( specout, spec, len_node )
      fnode(file_num).spec = specout
      fnode(file_num).length = len_node - ii

      if ( fnode(file_num).length .le. 23 ) then
         fnode(file_num).name = specout(ii+1:)
         else
         fnode(file_num).name = specout(ii+1:ii+22)//'*'
         end if

      return
      end
      subroutine append_node( level, spec, search )

      include    'swing.cmn'
      include    '($smgdef)'

      integer    level, len_node, free_node, istat
      character  spec*255, search*255

      node_num = free_node()

      if ( level .gt. lowest_level ) lowest_level = level
      if ( level .le. last_level ) then
         line = line + 1
         num_lines = line

         node(last_node(level)).sister = node_num
         else
         node(node_num-1).child = node_num
         end if

      if ( level .ne. 0 ) then
         call file_to_dir( spec,
     .                     node(node_num).spec,
     .                     node(node_num).length,
     .                     node(node_num).name )

      else
         call str$trim( spec, spec, len_node )
         node(node_num).spec = spec
         node(node_num).length = len_node
         if ( len_node .le. 10 ) then
            node(node_num).name = spec
            else
            node(node_num).name = spec(:11)//'*'
            end if
         end if

      node(node_num).line = line
      node(node_num).level = level
      node(node_num).rend = smg$m_reverse

      node_pointer(level,line) = node_num

      search = node(node_num).spec(1:node(node_num).length)//'*.dir;1'

      last_level = level
      last_node(level) = node_num

      return
      end
      subroutine change_options( code )

      include    'swing.cmn'
      
      character  choice*(pd_max_choice_len)
      integer code
      logical do_bar
      logical temp

      if ( code .eq. 0 ) then
         call pd_list_choice( board_id, keyboard, width, 7,
     .                        %val(pull_choices.ptr(7)),
     .                        choice, code, do_bar )
      end if

      if ( code .eq. 71 ) then
         call execute_dcl

      else if ( code .eq. 72 ) then
         use_window1 = .not. use_window1
         if ( .not. use_window1 ) then
            call smg$erase_display( window1 )
            else
            call update_window1
            end if

      else if ( code .eq. 73 ) then
         temp = use_window1
         call show_files
         use_window1 = temp
         end if

      return
      end
      subroutine change_spec( parent, ptr )

      include    'swing.cmn'

      character  spec*255
      integer    len, parent, ptr, jj, ii

      jj = node(ptr).length - 1
      ii = jj
      do while ( ii .gt. 1 .and.
     .           node(ptr).spec(ii:ii) .ne. '[' .and. 
     .           node(ptr).spec(ii:ii) .ne. '.' ) 
         ii = ii - 1
      end do
      ii = ii + 1

      spec = node(parent).spec(1:node(parent).length)//
     .       node(ptr).spec(ii:jj)//'.DIR;1'

      call file_to_dir( spec,
     .                  node(ptr).spec,
     .                  node(ptr).length,
     .                  node(ptr).name )

      return
      end
      logical function check_directory_move( from_num, cur_num )

      include 'swing.cmn'

      integer from_num, cur_num, from_levels, ptr(0:7)

      from_levels = 1

      ptr(0) = from_num

      ptr(1) = node(ptr(0)).child
      do while( ptr(1) .ne. 0 )
        if ( from_levels .lt. 2 ) from_levels = 2
        ptr(2) = node(ptr(1)).child
        do while( ptr(2) .ne. 0 ) 
          if ( from_levels .lt. 3 ) from_levels = 3
          ptr(3) = node(ptr(2)).child
          do while( ptr(3) .ne. 0 ) 
            if ( from_levels .lt. 4 ) from_levels = 4
            ptr(4) = node(ptr(3)).child
            do while( ptr(4) .ne. 0 ) 
              if ( from_levels .lt. 5 ) from_levels = 5
              ptr(5) = node(ptr(4)).child
              do while( ptr(5) .ne. 0 ) 
                if ( from_levels .lt. 6 ) from_levels = 6
                ptr(6) = node(ptr(5)).child
                do while( ptr(6) .ne. 0 ) 
                  if ( from_levels .lt. 7 ) from_levels = 7
                  ptr(7) = node(ptr(6)).child
                  do while( ptr(7) .ne. 0 ) 
                    if ( from_levels .lt. 8 ) from_levels = 8
                    ptr(7) = node(ptr(7)).sister
                  end do
                  ptr(6) = node(ptr(6)).sister
                end do
                ptr(5) = node(ptr(5)).sister
              end do
              ptr(4) = node(ptr(4)).sister
            end do
            ptr(3) = node(ptr(3)).sister
          end do
          ptr(2) = node(ptr(2)).sister
        end do
        ptr(1) = node(ptr(1)).sister
      end do

      if ( node(cur_num).level + from_levels .gt. 7 ) then
         check_directory_move = .false.
         else
         check_directory_move = .true.
         end if

      return
      end
      subroutine create_directory( code )

      include    'swing.cmn'
      include    '($ssdef)'

      character  new_dir*42, term*5, string*39, message*255
      integer    iterm, len_string, ii, jj
      integer    lib$create_dir
      integer    sys$getmsg, istat, len_message, code

      call print_message( ' ', 0 )
      call smg$set_cursor_abs( window3, 1, 1 )
      call smg$read_string( keyboard, string, 
     .                      'New subdirectory name: ',
     .                      39,,,,len_string,, window3 )

      new_dir = ' '
      jj = 0

      do ii = 1, len_string
         if ( string(ii:ii) .ne. '[' .and. string(ii:ii) .ne. ']' .and. 
     .        string(ii:ii) .ne. '.' .and. string(ii:ii) .gt. ' ' ) then
            jj = jj + 1
            new_dir(jj:jj) = string(ii:ii)
            end if
      end do

      call str$upcase( new_dir, new_dir )

      if ( jj .ne. 0 ) then
         istat = lib$create_dir( '[.'//new_dir(1:jj)//']' )

         if ( istat .eq. ss$_created ) then

            do_save = .true.

            call add_node( new_dir(1:jj), node_num )

            call adjust_node_pointers
      
            call load_display

            call update_screen( cur_line, cur_level )

            call print_message( 'Created new subdirectory', 0 )

            else if ( .not. istat ) then
            call sys$getmsg( %val(istat), len_message, message, 
     .                       %val(1), )
            call print_message( message(1:len_message), 0 )

            else
            call smg$erase_display( window3 )
            end if

         else
         call smg$erase_display( window3 )
         end if

      return
      end
      logical function crt

      include    'swing.cmn'
      include    '($dvidef)'
      include    '($ttdef)'
      include    '($tt2def)'

      integer*2  b2(14)
      integer*4  b4(7), buf, len_buf, sys$trnlog, sys$getdviw, dev_type,
     -           len_dev_type
      logical*4  for$bjtest, istat

      equivalence ( b4(1), b2(1) )

      b2(1) = 4
      b2(2) = dvi$_devdepend2
      b4(2) = %loc( buf )
      b4(3) = %loc( len_buf )

      b2(7) = 4
      b2(8) = dvi$_devtype
      b4(5) = %loc( dev_type )
      b4(6) = %loc( len_dev_type )

      b4(7) = 0

      istat = sys$getdviw( ,, 'SYS$COMMAND', b4,,,, )

      crt      = ( for$bjtest( buf, tt2$v_deccrt ) .or. 
     .                            dev_type .eq. tt$_vt52 )
      avo      = for$bjtest( buf, tt2$v_avo )

      return
      end      
      subroutine define_paste_board

      include    'swing.cmn'
      include    '($smgdef)'

C     DEC FORGOT THIS PARAMETER IN $SMGDEF
      parameter  SMG$S_PASTEBOARD_INFO_BLOCK = '20'x

      integer    smg$create_pasteboard
      integer    smg$create_virtual_keyboard
      integer    smg$set_keypad_mode
      integer    smg$get_pasteboard_attributes
      integer    istat

      record     /smgdef/ table

      call set_notab( 'SYS$COMMAND', set_term_buf )

      istat = smg$create_pasteboard( board_id )

      istat = smg$get_pasteboard_attributes(board_id, %ref(table),
     .                                %ref(SMG$S_PASTEBOARD_INFO_BLOCK))

      width = table.smg$w_width

      istat = smg$create_virtual_keyboard( keyboard )
      istat = smg$set_keypad_mode( keyboard, 1 )

      call sm_allow_repaint

      return
      end      
      subroutine define_smg_layout

      include    'swing.cmn'
      include    '($smgdef)'

      record /pd_choice_type/ sub_choices(9)

      pull_choices.number = 9
      pull_choices.choice(1) = 'Create'
      pull_choices.code(1) = 10
      pull_choices.ptr(1) = 0
      pull_choices.choice(2) = 'Rename'
      pull_choices.code(2) = 20
      pull_choices.ptr(2) = 0
      pull_choices.choice(3) = 'Move'
      pull_choices.code(3) = 30
      pull_choices.ptr(3) = 0
      pull_choices.choice(4) = 'Delete'
      pull_choices.code(4) = 40
      pull_choices.ptr(4) = 0
      pull_choices.choice(5) = 'Print'
      pull_choices.code(5) = 50
      pull_choices.ptr(5) = 0
      pull_choices.choice(6) = 'Save'
      pull_choices.code(6) = 60
      pull_choices.ptr(6) = 0
      pull_choices.choice(7) = 'Options'
      pull_choices.code(7) = 70
      pull_choices.ptr(7) = %loc( sub_choices(7) )
      pull_choices.choice(8) = 'Help'
      pull_choices.code(8) = 80
      pull_choices.ptr(8) = 0
      pull_choices.choice(9) = 'Exit'
      pull_choices.code(9) = 90
      pull_choices.ptr(9) = %loc( sub_choices(9) )

      sub_choices(1).number = 0
      sub_choices(2).number = 0
      sub_choices(3).number = 0
      sub_choices(4).number = 0

      sub_choices(5).number = 0

      sub_choices(6).number = 0

      sub_choices(7).number = 3
      sub_choices(7).choice(1) = 'DCL Command'
      sub_choices(7).code(1) = 71
      sub_choices(7).choice(2) = 'Display Directory'
      sub_choices(7).code(2) = 72
      sub_choices(7).choice(3) = 'Filer'
      sub_choices(7).code(3) = 73

      sub_choices(8).number = 0

      sub_choices(9).number = 2
      sub_choices(9).choice(1) = 'ok exit'
      sub_choices(9).code(1) = 91
      sub_choices(9).choice(2) = 'cancel'
      sub_choices(9).code(2) = 92

      call pd_load_bar( width, pull_choices)
     
      use_window1 = .false.

      return
      end
      subroutine delete_directory( code )

      include    'swing.cmn'
      include    '($ssdef)'

      character  spec(0:MAX_LEVELS)*255, search(0:MAX_LEVELS)*255
      character  term*5, string*3, message*255, name*50
      integer    iterm, len_string, code, jj
      integer    sys$getmsg, istat, len_message, len(0:MAX_LEVELS)
      integer    icont(0:MAX_LEVELS), lib$find_file, ii
      logical    found_node

      call print_message( ' ', 0 )
      call smg$set_cursor_abs( window3, 1, 1 )
      call smg$read_string( keyboard, string, 
     .                      'Enter YES to to delete this direc'//
     .                      'tory and all directories below it: ',
     .                      3,,,,len_string,, window3 )

      call str$upcase( string, string )

      if ( string .eq. 'YES' ) then

         do_save = .true.

         call print_message('Deleting current directory structure...',0)

         delete_problem = .false.
         search(0)=node(node_num).spec(1:node(node_num).length)//'*.dir'

         icont(0) = 0
         do while ( lib$find_file( search(0), spec(0), icont(0) ) )      
          call file_to_dir( spec(0), search(1), len(1), name )
          search(1) = search(1)(1:len(1))//'*.dir'
          icont(1) = 0
          do while ( lib$find_file( search(1), spec(1), icont(1) ) )      
           call file_to_dir( spec(1), search(2), len(2), name )
           search(2) = search(2)(1:len(2))//'*.dir'
           icont(2) = 0
           do while ( lib$find_file( search(2), spec(2), icont(2) ) )      
            call file_to_dir( spec(2), search(3), len(3), name )
            search(3) = search(3)(1:len(3))//'*.dir'
            icont(3) = 0
            do while ( lib$find_file( search(3), spec(3), icont(3) ) )      
             call file_to_dir( spec(3), search(4), len(4), name )
             search(4) = search(4)(1:len(4))//'*.dir'
             icont(4) = 0
             do while ( lib$find_file( search(4), spec(4), icont(4) ) )      
              call file_to_dir( spec(4), search(5), len(5), name )
              search(5) = search(5)(1:len(5))//'*.dir'
              icont(5) = 0
              do while ( lib$find_file( search(5), spec(5), icont(5) ) )      
               call file_to_dir( spec(5), search(6), len(6), name )
               search(6) = search(6)(1:len(6))//'*.dir'
               icont(6) = 0
               do while ( lib$find_file( search(6), spec(6), icont(6) ))      
                call file_to_dir( spec(6), search(7), len(7), name )
                call delete_files( search(7)(1:len(7)) )
               end do
               call lib$find_file_end( icont(6) )
               call delete_files( search(6)(1:len(6)) )
              end do
              call lib$find_file_end( icont(5) )
              call delete_files( search(5)(1:len(5)) )
             end do
             call lib$find_file_end( icont(4) )
             call delete_files( search(4)(1:len(4)) )
            end do
            call lib$find_file_end( icont(3) )
            call delete_files( search(3)(1:len(3)) )
           end do
           call lib$find_file_end( icont(2) )
           call delete_files( search(2)(1:len(2)) )
          end do
          call lib$find_file_end( icont(1) )
          call delete_files( search(1)(1:len(1)) )
         end do
         call lib$find_file_end( icont(0) )
         call delete_files( search(0)(1:node(node_num).length) )

         if ( cur_level .ge. 1 ) then
            ii = cur_level - 1
            jj = cur_line
            do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 ) 
               jj = jj - 1
            end do
            if ( jj .ge. 1 ) then
               node_num = node_pointer(ii,jj)
               else
               node_num = 1
               end if
            else
            node_num = 1
            end if

         call adjust_node_pointers
         call load_display

         cur_level = node(node_num).level
         cur_line = node(node_num).line

         call update_screen( cur_line, cur_level )

         if ( delete_problem ) then
            call print_message( 'Attempted to delete subdirectory - '//
     .           'but some files could not be deleted', 0 )
            else
            call print_message( 'Deleted subdirectory structure', 0 )
            end if
         else

         call print_message( 'No directories deleted', 0 )
         end if

      return
      end
      subroutine delete_file

c     Craig Young               3-AUG-87

c     This subroutine deletes the current file after verification.

      include   'swing.cmn'

      character string*5
      integer   old_file, old_top, old_bottom, istat, len_string

c     Check if current file is a directory.  If so, abort delete.

      istat = index( fnode(file_num).spec(1:), '.DIR;1' )

      if ( istat .eq. 0 ) then
         old_file = file_num                    !Save current position
         old_top  = top_file_line               !and window range
         old_bottom = bottom_file_line

         call print_message( ' ', 0 )
         call smg$set_cursor_abs( window3, 2, 1 )
         call smg$read_string( keyboard, string,
     .                         'Enter YES to delete this file: ',
     .                         ,,,,len_string,, window3 )
         call str$upcase( string, string )

         if ( string .eq. 'YES' ) then
            call lib$delete_file( fnode(file_num).spec )
            call print_message( 'File deleted', 0 )
         else
            call print_message( 'Delete aborted', 0 )
         end if

         call load_files                        !Reload fnode array

         if ( old_file .le. num_files ) then
            file_num = old_file                 !Reset cursor position
         else
            file_num = 1
            end if
         top_file_line = old_top                !Reset window range
         bottom_file_line = old_bottom

         call update_file_window
      else
         call print_message( 'Cannot delete a directory '//
     .                       'with the filer.', 0 )
         end if

      return
      end
      subroutine delete_files( dir_spec )

      include    'swing.cmn'
      include    '($smgdef)'

      integer    len_spec, istat, ii, ipos
      integer    icontext, lib$delete_file, modify_file_prot, ptr
      integer    lib$find_file
      character  dir_spec*(*), spec*255
      logical    find_node, found_node

      ii = len( dir_spec )
      do while ( dir_spec(ii:ii) .eq. ' ' .and. ii .gt. 0 ) 
         ii = ii - 1
      end do

      if ( find_node( dir_spec(1:ii), ptr ) ) then
         found_node = .true.
         call smg$change_rendition( window2, node(ptr).line, 
     .                              node(ptr).level*17+1,
     .                              1, 12,
     .                              smg$m_blink + node(ptr).rend ) 
         else
         found_node = .false.
         end if

      icontext = 0
      do while( lib$find_file( dir_spec(:ii)//'*.*;*', spec, icontext ))
         if ( .not. lib$delete_file( spec ) ) then
            call str$trim( spec, spec, len_spec )
            if ( modify_file_prot( spec(1:len_spec), 0, 0 ) ) then
               istat = lib$delete_file( spec )
               if ( .not. istat ) delete_problem = .true.
               else 
               call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
     .                         dir_spec(:ii)//'*.*;*', 'NL:', 'NL:' )
               istat = lib$delete_file( spec )
               if ( .not. istat ) delete_problem = .true.
               end if
            end if
      end do
      call lib$find_file_end( icontext )

      call dir_to_file( dir_spec, ii,
     .                  spec, ipos )
      if ( .not. lib$delete_file( spec ) ) then
         call str$trim( spec, spec, len_spec )
         if ( modify_file_prot( spec(1:len_spec), 0, 0 ) ) then
            istat = lib$delete_file( spec )
            if ( .not. istat ) delete_problem = .true.
            else 
            call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
     .                      dir_spec(:ii)//'*.*;*', 'NL:', 'NL:' )
            istat = lib$delete_file( dir_spec(1:ii) )
            if ( .not. istat ) delete_problem = .true.
            end if
         end if

      if ( .not. delete_problem ) then
         if ( found_node ) call delete_node( ptr )
         else
         if ( found_node ) 
     .      call smg$change_rendition( window2, node(ptr).line, 
     .                                 node(ptr).level*17+1,
     .                                 1, 12,
     .                                 node(ptr).rend ) 
         end if

      return
      end
$*$*EOD*$*$
$ checksum 2.FOR
$ if checksum$checksum .ne. check_sum then -
$   write sys$output "Checksum failed, file probably corrupted"
$ exit
