From:	CSBVAX::MRGATE!vtcf@ncsc.ARPA@SMTP 13-APR-1988 03:36
To:	ARISIA::EVERHART
Subj:	SWING 6 OF 13


Received: from ncsc.ARPA by KL.SRI.COM with TCP; Mon 11 Apr 88 08:32:34-PDT
Received: by ncsc.ARPA id AA02843; Mon, 11 Apr 88 10:28:35 CST
Date: Mon, 11 Apr 88 10:28:35 CST
From: vtcf@ncsc.ARPA (Williams)
Message-Id: <8804111628.AA02843@ncsc.ARPA>
To: info-vax@kl.sri.com
Subject: SWING 6 OF 13

$Part06:
$ File_is="SWING_2.FOR"
$ Check_Sum_is=1767557836
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X      subroutine add_node( new_dir, parent )
X
X      include    'swing.cmn'
X
X      character new_dir*42, spec*255
X      integer   parent, len, new_node, free_node, ii, jj
X      logical   greater
X
X      call str$trim( new_dir, new_dir, len )
X
X      spec = node(parent).spec(1:node(parent).length)//
X     .       new_dir(1:len)//'.DIR;1'
X
X      new_node = free_node()
X
X      call file_to_dir( spec, 
X     .                  node(new_node).spec,
X     .                  node(new_node).length,
X     .                  node(new_node).name )
X
X      if ( node(parent).child .eq. 0 ) then
X         node(parent).child = new_node
X
X         else
X         ii = node(parent).child
X         if ( node(new_node).name .lt. node(ii).name ) then
X            node(new_node).sister = node(parent).child
X            node(parent).child = new_node            
X
X            else
X            greater = .true.
X            do while ( greater )
X               if ( node(ii).sister .eq. 0 ) then
X                  node(ii).sister = new_node
X                  greater = .false.
X
X                  else 
X                  jj = ii
X                  ii = node(ii).sister
X                  if ( node(new_node).name .lt. node(ii).name ) then
X                     node(jj).sister = new_node
X                     node(new_node).sister = ii
X                     greater = .false.
X                     end if
X                  end if                  
X            end do
X            end if            
X         end if
X
X      return
X      end
X      subroutine add_node_to_display( num )
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
X      integer    column, num, level
X
X      node(num).rend = smg$m_reverse
X
X      level =  node(num).level
X      column = level * 17 + 1
X      line =   node(num).line
X
X      call smg$put_chars( window2, node(num).name, line, column,,
X     .                    node(num).rend )
X      call smg$draw_line( window2, line, column-3, line, column-1 )  
X
X      if ( level .eq. last_level ) then
X         call smg$draw_line( window2, line-1, column-3, line, column-3 )
X         else if ( level .eq. last_level + 1 ) then
X         call smg$draw_line( window2, line, column-5, line, column-2 )
X         else if ( level .lt. last_level ) then
X         call smg$draw_line( window2, last_line(level), column-3, 
X     .                       line, column-3 )
X         end if
X
X      if ( .not. found .and. root(2:len_root-1)
X     .     .eq. node(num).spec(2:node(num).length-1) ) then
X         found = .true.
X         cur_line = line
X         cur_level = level
X         end if
X
X      last_level = level
X      last_line(level) = line
X
X      return
X      end
X      subroutine adjust_node_pointers
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
X      integer ll, jj, ptr(0:7), ii
X
X      do ll = 1, MAX_LINES
X         do jj = 0, MAX_LEVELS
X            node_pointer(jj,ll) = 0
X         end do
X      end do
X
X      do jj = 0, MAX_LEVELS
X         ptr(jj) = 0
X      end do
X
X      ll = 1     !LINE
X      ptr(0) = 1
X
X      node_pointer(0,ll) = 1
X      ptr(1) = node(ptr(0)).child
X      do while( ptr(1) .ne. 0 )
X        node_pointer(1,ll) = ptr(1)
X        node(ptr(1)).line = ll
X        node(ptr(1)).level = 1
X        ptr(2) = node(ptr(1)).child
X        do while( ptr(2) .ne. 0 ) 
X          node_pointer(2,ll) = ptr(2)
X          node(ptr(2)).line = ll
X          node(ptr(2)).level = 2
X          ptr(3) = node(ptr(2)).child
X          do while( ptr(3) .ne. 0 ) 
X            node_pointer(3,ll) = ptr(3)
X            node(ptr(3)).line = ll
X            node(ptr(3)).level = 3
X            ptr(4) = node(ptr(3)).child
X            do while( ptr(4) .ne. 0 ) 
X              node_pointer(4,ll) = ptr(4)
X              node(ptr(4)).line = ll
X              node(ptr(4)).level = 4
X              ptr(5) = node(ptr(4)).child
X              do while( ptr(5) .ne. 0 ) 
X                node_pointer(5,ll) = ptr(5)
X                node(ptr(5)).line = ll
X                node(ptr(5)).level = 5
X                ptr(6) = node(ptr(5)).child
X                do while( ptr(6) .ne. 0 ) 
X                  node_pointer(6,ll) = ptr(6)
X                  node(ptr(6)).line = ll
X                  node(ptr(6)).level = 6
X                  ptr(7) = node(ptr(6)).child
X                  do while( ptr(7) .ne. 0 ) 
X                    node_pointer(7,ll) = ptr(7)
X                    node(ptr(7)).line = ll
X                    node(ptr(7)).level = 7
X                    ptr(7) = node(ptr(7)).sister
X                    if ( ptr(7) .ne. 0 ) ll = ll + 1
X                  end do
X                  ptr(6) = node(ptr(6)).sister
X                  if ( ptr(6) .ne. 0 ) ll = ll + 1
X                end do
X                ptr(5) = node(ptr(5)).sister
X                if ( ptr(5) .ne. 0 ) ll = ll + 1
X              end do
X              ptr(4) = node(ptr(4)).sister
X              if ( ptr(4) .ne. 0 ) ll = ll + 1
X            end do
X            ptr(3) = node(ptr(3)).sister
X            if ( ptr(3) .ne. 0 ) ll = ll + 1
X          end do
X          ptr(2) = node(ptr(2)).sister
X          if ( ptr(2) .ne. 0 ) ll = ll + 1
X        end do
X        ptr(1) = node(ptr(1)).sister
X        if ( ptr(1) .ne. 0 ) ll = ll + 1
X      end do
X
X      lowest_level = 0
X      do ii = 1, num_nodes
X         if ( node(ii).level .gt. lowest_level ) 
X     .      lowest_level = node(ii).level
X      end do
X
Xc      if ( lowest_level .gt. 7 ) then
Xc         call print_message( 'Directory nesting is to deep', 1 )
Xc         end if
X                 
X      num_lines = ll
X
X      return     
X      end
X      subroutine append_fnode( spec )
X
Xc     Craig Young               3-AUG-87
X
Xc     This subroutine adds a file name to the FNode array, truncating, if
Xc     necessary, the file spec into a 20-character name.
X
X      include    'swing.cmn'
X
X      integer    len_node, ii
X      character  specout*255, spec*255
X
X      num_files = num_files + 1
X      file_num = num_files
X      ii = 1
X      do while ( spec(ii:ii) .ne. ']' .and. spec(ii:ii) .ne. '>' )
X         ii = ii + 1
X         end do
X
X      call str$trim( specout, spec, len_node )
X      fnode(file_num).spec = specout
X      fnode(file_num).length = len_node - ii
X
X      if ( fnode(file_num).length .le. 23 ) then
X         fnode(file_num).name = specout(ii+1:)
X         else
X         fnode(file_num).name = specout(ii+1:ii+22)//'*'
X         end if
X
X      return
X      end
X      subroutine append_node( level, spec, search )
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
X      integer    level, len_node, free_node, istat
X      character  spec*255, search*255
X
X      node_num = free_node()
X
X      if ( level .gt. lowest_level ) lowest_level = level
X      if ( level .le. last_level ) then
X         line = line + 1
X         num_lines = line
X
X         node(last_node(level)).sister = node_num
X         else
X         node(node_num-1).child = node_num
X         end if
X
X      if ( level .ne. 0 ) then
X         call file_to_dir( spec,
X     .                     node(node_num).spec,
X     .                     node(node_num).length,
X     .                     node(node_num).name )
X
X      else
X         call str$trim( spec, spec, len_node )
X         node(node_num).spec = spec
X         node(node_num).length = len_node
X         if ( len_node .le. 10 ) then
X            node(node_num).name = spec
X            else
X            node(node_num).name = spec(:11)//'*'
X            end if
X         end if
X
X      node(node_num).line = line
X      node(node_num).level = level
X      node(node_num).rend = smg$m_reverse
X
X      node_pointer(level,line) = node_num
X
X      search = node(node_num).spec(1:node(node_num).length)//'*.dir;1'
X
X      last_level = level
X      last_node(level) = node_num
X
X      return  
X      end
X      subroutine change_options( code )
X
X      include    'swing.cmn'
X      
X      character  choice*(pd_max_choice_len)
X      integer code, ii
X      logical do_bar
X      logical temp
X
X      if ( code .eq. 0 ) then
X         ii = 7
X         call pd_list_choice( board_id, keyboard, width, ii,
X     .                        %val(pull_choices.ptr(7)),
X     .                        choice, .false., code, do_bar )
X      end if
X
X      if ( code .eq. 71 ) then
X         call execute_dcl
X
X      else if ( code .eq. 72 ) then
X         use_window1 = .not. use_window1
X         if ( .not. use_window1 ) then
X            call smg$erase_display( window1 )
X            else
X            call update_window1
X            end if
X
X      else if ( code .eq. 73 ) then
X         temp = use_window1
X         call show_files
X         use_window1 = temp
X         end if
X
X      return
X      end
X      subroutine change_spec( parent, ptr )
X
X      include    'swing.cmn'
X
X      character  spec*255
X      integer    len, parent, ptr, jj, ii
X
X      jj = node(ptr).length - 1
X      ii = jj
X      do while ( ii .gt. 1 .and.
X     .           node(ptr).spec(ii:ii) .ne. '[' .and. 
X     .           node(ptr).spec(ii:ii) .ne. '.' ) 
X         ii = ii - 1
X      end do
X      ii = ii + 1
X
X      spec = node(parent).spec(1:node(parent).length)//
X     .       node(ptr).spec(ii:jj)//'.DIR;1'
X
X      call file_to_dir( spec,
X     .                  node(ptr).spec,
X     .                  node(ptr).length,
X     .                  node(ptr).name )
X
X      return
X      end
X      logical function check_directory_move( from_num, cur_num )
X
X      include 'swing.cmn'
X
X      integer from_num, cur_num, from_levels, ptr(0:7)
X
X      from_levels = 1
X
X      ptr(0) = from_num
X
X      ptr(1) = node(ptr(0)).child
X      do while( ptr(1) .ne. 0 )
X        if ( from_levels .lt. 2 ) from_levels = 2
X        ptr(2) = node(ptr(1)).child
X        do while( ptr(2) .ne. 0 ) 
X          if ( from_levels .lt. 3 ) from_levels = 3
X          ptr(3) = node(ptr(2)).child
X          do while( ptr(3) .ne. 0 ) 
X            if ( from_levels .lt. 4 ) from_levels = 4
X            ptr(4) = node(ptr(3)).child
X            do while( ptr(4) .ne. 0 ) 
X              if ( from_levels .lt. 5 ) from_levels = 5
X              ptr(5) = node(ptr(4)).child
X              do while( ptr(5) .ne. 0 ) 
X                if ( from_levels .lt. 6 ) from_levels = 6
X                ptr(6) = node(ptr(5)).child
X                do while( ptr(6) .ne. 0 ) 
X                  if ( from_levels .lt. 7 ) from_levels = 7
X                  ptr(7) = node(ptr(6)).child
X                  do while( ptr(7) .ne. 0 ) 
X                    if ( from_levels .lt. 8 ) from_levels = 8
X                    ptr(7) = node(ptr(7)).sister
X                  end do
X                  ptr(6) = node(ptr(6)).sister
X                end do
X                ptr(5) = node(ptr(5)).sister
X              end do
X              ptr(4) = node(ptr(4)).sister
X            end do
X            ptr(3) = node(ptr(3)).sister
X          end do
X          ptr(2) = node(ptr(2)).sister
X        end do
X        ptr(1) = node(ptr(1)).sister
X      end do
X
X      if ( node(cur_num).level + from_levels .gt. 7 ) then
X         check_directory_move = .false.
X         else
X         check_directory_move = .true.
X         end if
X
X      return
X      end
X      subroutine create_directory( code )
X
X      include    'swing.cmn'
X      include    '($ssdef)'
X
X      character  new_dir*42, term*5, string*39, message*255
X      integer    iterm, len_string, ii, jj
X      integer    lib$create_dir
X      integer    sys$getmsg, istat, len_message, code
X
X      call print_message( ' ', 0 )
X      call smg$set_cursor_abs( window3, 1, 1 )
X      call smg$read_string( keyboard, string, 
X     .                      'New subdirectory name: ',
X     .                      39,,,,len_string,, window3 )
X
X      new_dir = ' '
X      jj = 0
X
X      do ii = 1, len_string
X         if ( string(ii:ii) .ne. '[' .and. string(ii:ii) .ne. ']' .and. 
X     .        string(ii:ii) .ne. '.' .and. string(ii:ii) .gt. ' ' ) then
X            jj = jj + 1
X            new_dir(jj:jj) = string(ii:ii)
X            end if
X      end do
X
X      call str$upcase( new_dir, new_dir )
X
X      if ( jj .ne. 0 ) then
X         istat = lib$create_dir( '[.'//new_dir(1:jj)//']' )
X
X         if ( istat .eq. ss$_created ) then
X
X            do_save = .true.
X
X            call add_node( new_dir(1:jj), node_num )
X
X            call adjust_node_pointers
X      
X            call load_display
X
X            call update_screen( cur_line, cur_level )
X
X            call print_message( 'Created new subdirectory', 0 )
X
X            else if ( .not. istat ) then
X            call sys$getmsg( %val(istat), len_message, message, 
X     .                       %val(1), )
X            call print_message( message(1:len_message), 0 )
X
X            else
X            call smg$erase_display( window3 )
X            end if
X
X         else
X         call smg$erase_display( window3 )
X         end if
X
X      return
X      end
$ GoSub Convert_File
$ Goto Part07
