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

Received: from seismo.CSS.GOV by KL.SRI.COM with TCP; Fri 14 Aug 87 15:50:17-PDT
Received: from scgvaxd.UUCP by seismo.CSS.GOV (5.54/1.14) with UUCP 
	id AA10165; Fri, 14 Aug 87 18:48:21 EDT
Received: by scgvaxd.SCG.HAC.COM (5.51/smail2.2/04-02-87)
	id AA11210; Fri, 14 Aug 87 08:59:05 PDT
Message-Id: <8708141559.AA11210@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 5 of 5 (5.for)
To: info-vax%kl.sri.COM@scgvaxd.scg.hac.com
X-Vms-To: INFO-VAX-SUBMIT

$ show default
$ check_sum = 70718357
$ write sys$output "Creating 5.FOR"
$ create 5.FOR
$ DECK/DOLLARS="$*$*EOD*$*$"
      subroutine print_message( message, abort )

      include    'swing.cmn'

      logical    abort, erased
      character  message*(*)

      if ( using_screen ) then

         if ( message .eq. ' ' ) then
            if ( .not. erased ) then
               erased = .true.
               call smg$erase_display( window3 )
               call smg$erase_line( window3, 2, 1 )
               end if

            else
            erased = .false.
            call smg$erase_display( window3 )
            call smg$put_chars( window3, message, 2, 1, 1 )
            end if

         if ( abort ) call exit_swing
                  
         else
         print *, 'SWING: ', message
         if ( abort ) stop ' '
         end if

      return
      end
        subroutine process_command ( out_message, window, stop )

c       Craig Young             3-AUG-87

        include   'swing.cmn'
        include   '($syssrvnam)'
        include   '($ssdef)'
        include   '($iodef)'
        include   '($clidef)'

        integer     window, stop
        integer*4   status, done, proc_id, message_len, lib$spawn
        integer*4   str$position
        character   in_message*100, out_message*100, terminator*50
        character   set_noon*8/'set noon'/
        parameter 
     -  (terminator = 'swing dcl subprocess command output terminator')

        message_len = 100

        if ( proc_created .eq. 0 ) then
           status = sys$crembx ( ,outbox_channel ,,,,,'swing_dcl_inbox')
           if ( status .ne. ss$_normal ) call exit(status)
           status = sys$crembx ( ,inbox_channel ,,,,,'swing_dcl_outbox')
           if ( status .ne. ss$_normal ) call exit(status)

           status = lib$spawn ( ,'swing_dcl_inbox' ,'swing_dcl_outbox'
     -                          ,cli$m_nowait ,,proc_id 
     -                          ,,done )
           if (status .ne. ss$_normal) call exit(status)
           status = sys$qiow( ,%val(outbox_channel)
     -                     ,%val(io$_writevblk) ,
     -                     ,,,%ref(set_noon)
     -                     ,%val(len(set_noon)) ,,,, )
           if ( status .ne. ss$_normal ) call exit(status)
           proc_created = 1
           end if

        status = sys$qiow( ,%val(outbox_channel)
     -                     ,%val(io$_writevblk) ,
     -                     ,,,%ref(out_message)
     -                     ,%val(message_len) ,,,, )
        if ( status .ne. ss$_normal ) call exit(status)

        if ( stop .eq. 0 ) then
           out_message = 'write sys$output "'//terminator//'"'

           status = sys$qio ( ,%val(outbox_channel)
     -                        ,%val(io$_writevblk) ,
     -                        ,,,%ref(out_message)
     -                        ,%val(message_len) ,,,, )
           if ( status .ne. ss$_normal ) call exit(status)

           in_message = '      '
           status = 0
           do while ( in_message .ne. terminator )
              if ( window .eq. DCL_window ) then
                 call smg$put_line( window, in_message )
              else
                 if ( in_message .ne. '     ' ) then
                    call print_message( in_message, 0 )
                    end if
                 end if

              in_message = '      '
              status = sys$qiow( ,%val(inbox_channel) 
     -                           ,%val(io$_readvblk) ,
     -                           ,,,%ref(in_message)
     -                           ,%val(message_len) ,,,, )
              if ( status .ne. ss$_normal ) call exit(status)

              end do
           end if

        return
        end
      subroutine record_structure( search )

      include    'swing.cmn'
     
      character  spec*255
      logical    search, modify_file_prot
      integer    icontext, ii, jj, istat, len_spec
      integer    lib$find_file, lib$delete_file

      if ( search .and. swing_file_exists ) then
         do ii = 1, num_nodes
            node(ii).length = 0
            node(ii).child = 0
            node(ii).sister = 0
         end do

         call load_nodes
   
         call load_display
   
         call update_screen( cur_line, cur_level )
         end if
 
      do_save = .false.

      call print_message( 'Saving directory structure', 0 )

      icontext = 0
      do while( lib$find_file( main(1:len_main)//'swing.sav;*',
     .                         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 )
               else 
               call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
     .                         main(1:len_main)//'swing.sav', 
     .                         'NL:', 'NL:' )
               istat = lib$delete_file( spec )
               end if
            end if
      end do
      call lib$find_file_end( icontext )

      open( unit=2, 
     .      name=main(1:len_main)//'swing.sav', 
     .      status='new',
     .      carriagecontrol='list',
     .      access='sequential',
     .      form='unformatted',
     .      recl=73,
     .      organization='sequential',
     .      recordtype='variable',
     .      iostat=istat,
     .      err=99 )

      write( 2 ) num_lines, num_nodes, lowest_level

      do ii = 1, num_lines
         write( 2 ) (node_pointer(jj,ii), jj=0, MAX_LEVELS)
      end do

      do ii = 1, num_nodes
         write( 2 ) node(ii)
      end do

      close( unit=2 )

      swing_file_exists = .true.

      call print_message( 'Finished saving directory structure', 0 )

      return

99    call print_message( 'Unable to record directory structure', 0 )
      return
      end
      subroutine redefine_smg_layout

c     Craig Young               3-AUG-87

c     This subroutine redefines the options for the command bar.

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

      record /pd_choice_type/ sub_choices(8)

      pull_choices.number = 8
      pull_choices.choice(1) = 'Delete'
      pull_choices.code(1) = 110
      pull_choices.ptr(1) = 0
      pull_choices.choice(2) = 'Edit'
      pull_choices.code(2) = 120
      pull_choices.ptr(2) = 0
      pull_choices.choice(3) = 'Move'
      pull_choices.code(3) = 130
      pull_choices.ptr(3) = 0
      pull_choices.choice(4) = 'Options'
      pull_choices.code(4) = 140
      pull_choices.ptr(4) = %loc( sub_choices(4) )
      pull_choices.choice(5) = 'Print'
      pull_choices.code(5) = 150
      pull_choices.ptr(5) = 0
      pull_choices.choice(6) = 'Rename'
      pull_choices.code(6) = 160
      pull_choices.ptr(6) = 0
      pull_choices.choice(7) = 'Help'
      pull_choices.code(7) = 170
      pull_choices.ptr(7) = 0
      pull_choices.choice(8) = 'Quit'
      pull_choices.code(8) = 180
      pull_choices.ptr(8) = %loc( sub_choices(8) )

      sub_choices(4).number = 1
      sub_choices(4).choice(1) = 'DCL Command'
      sub_choices(4).code(1) = 141
      sub_choices(8).number = 2
      sub_choices(8).choice(1) = 'Okay, quit filer'
      sub_choices(8).code(1) = 181
      sub_choices(8).choice(2) = 'Cancel'
      sub_choices(8).code(2) = 182

      call pd_load_bar( width, pull_choices )

      return
      end
      subroutine rename_directory( code ) 

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

      character  new_dir*42, key, string*39, message*255, file*255
      integer    ikey, len_string, lib$rename_file, code, parent
      integer    sys$getmsg, istat, len_message, ipos, from_level
      integer    old_line, old_level, from_num, from_line, ii, jj
      logical    dir_to_file, finished, check_directory_move

      if ( code .eq. 20 ) then

         call print_message( ' ', 0 )
         call smg$set_cursor_abs( window3, 1, 1 )
         call smg$read_string( keyboard, string, 
     .                         'Enter new name to give directory: ',
     .                         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. ' ' .and.
     .         string(ii:ii) .ne. ';' ) 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
            if ( dir_to_file( node(node_num).spec,
     .                        node(node_num).length, 
     .                        file, ipos ) ) then
               istat = lib$rename_file( file, 
     .                                  new_dir(1:jj)//'.DIR;1',,,
     .                                  1 )

               if ( istat .eq. ss$_normal ) then
                  call file_to_dir( file(1:ipos)//new_dir(1:jj)//'.DIR', 
     .                              node(node_num).spec,
     .                              node(node_num).length,
     .                              node(node_num).name )
 
                  parent = 0
                  call move_node( node_num, parent )
   
                  call adjust_node_pointers
        
                  call load_display

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

                  call update_screen( cur_line, cur_level )

                  call print_message( 'Subdirectory renamed', 0 )

                  do_save = .true.

                  else
                  call sys$getmsg( %val(istat), len_message, message, 
     .                             %val(1), )
                  call print_message( message(1:len_message), 0 )
                  end if
               end if
            else
            call smg$erase_display( window3 )
            end if

         else if ( code .eq. 30 ) then

         from_num = node_num
         from_line = cur_line
         from_level = cur_level         
         node(from_num).rend = smg$m_reverse + smg$m_blink

         call smg$change_rendition( window2, from_line, from_level*17+1,
     .                              1, 12, node(from_num).rend )

         call print_message( 'Travel to new parent directory and hit '// 
     .                       'RETURN - Hit any other key to abort', 0 )
         call smg$set_cursor_abs( window2, from_line, from_level*17+1 )

         finished = .false.

         do while ( .not. finished ) 

            call smg$read_keystroke( keyboard, ikey )

            old_line = cur_line
            old_level = cur_level
            old_rend = node(node_num).rend 

            if ( ikey .eq. smg$k_trm_cr .or. 
     .           ikey .eq. smg$k_trm_enter ) then
               finished = .true.

               else if ( ikey .eq. smg$k_trm_up ) then
               ii = cur_level
               jj = cur_line - 1
               do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 ) 
                  jj = jj - 1
               end do
               if ( jj .ge. 1 ) cur_line = jj
               call update_screen( old_line, old_level )
 
               else if ( ikey .eq. smg$k_trm_down ) then
               ii = cur_level
               jj = cur_line + 1
               do while( node_pointer(ii,jj) .eq. 0 .and.
     .                   jj .le. num_lines ) 
                  jj = jj + 1
               end do
               if ( jj .le. num_lines ) cur_line = jj
               call update_screen( old_line, old_level )

               else if ( ikey .eq. smg$k_trm_right ) then
               ii = cur_level + 1
               jj = cur_line 
               do while( node_pointer(ii,jj) .eq. 0 .and.
     .                   ii .le. MAX_LEVELS ) 
                  ii = ii + 1
               end do
               if ( ii .le. MAX_LEVELS ) cur_level = ii
               call update_screen( old_line, old_level )

               else if ( ikey .eq. smg$k_trm_left .and. 
     .                   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
                  cur_level = ii
                  cur_line = jj
                  end if
               call update_screen( old_line, old_level )
  
               else
               finished = .true.
               end if

            call smg$set_cursor_abs( window2, cur_line, cur_level*17+1 )

         end do

         node(from_num).rend = smg$m_reverse

         call smg$change_rendition( window2, from_line, from_level*17+1,
     .                              1, 12, node(from_num).rend )

         if ( ikey .eq. smg$k_trm_cr .or. 
     .        ikey .eq. smg$k_trm_enter ) then

            if ( .not. check_directory_move( from_num, node_num ) ) then
               call update_screen( cur_line, cur_level )
               call print_message( 'Rename would cause too great a '//
     .            'directory depth', 0 )
               return
               end if               

            if ( dir_to_file( node(from_num).spec,
     .                        node(from_num).length, 
     .                        file, ipos ) ) then

               istat = lib$rename_file( file, 
     .                 node(node_num).spec(1:node(node_num).length)//
     .                 '*.dir;1',,, 1 )

               if ( istat ) then
                  call move_node( from_num, node_num )
   
                  call adjust_node_pointers
        
                  call load_display

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

                  call update_screen( cur_line, cur_level )

                  call print_message( 'Subdirectory has been moved', 0 )

                  do_save = .true.

                  else
                  call sys$getmsg( %val(istat), len_message, message, 
     .                             %val(1), )
                  call print_message( message(1:len_message), 0 )
                  end if
               end if
            else
            call smg$erase_display( window3 )
            end if
         else
         call smg$erase_display( window3 )
         end if

      return
      end
      subroutine rename_file

c     Craig Young               3-AUG-87

c     This subroutine prompts the user for a new name for the current file.

      include   'swing.cmn'

      integer   istat, len_string, len_message, lib$rename_file
      character string*100, message*255

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

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

      if ( istat .eq. 0 ) then
         call print_message( ' ', 0 )
         call smg$set_cursor_abs( window3, 2, 1 )
         call smg$read_string( keyboard, string, 'New name: ',
     .                         ,,,,len_string,, window3 )
         call str$upcase( string, string )

         istat = lib$rename_file( fnode(file_num).spec, string )

         if ( istat ) then
            call print_message( 'File has been renamed.', 0 )

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

         call load_files
         call update_file_window

      else
         call print_message('Cannot rename directory with the filer.',0)
         end if

      return
      end
      subroutine reset_terminal( terminal, char_buffer )
      implicit none

C     ROUTINE USES THE IO$_SETMODE FUNCTION TO SET TERMINAL 
C     CHARACTERISTICS

      include    '($iodef)'

c                LAYOUT OF char_buffer
c
c     --------------------------------------------
c     |    buffer size     |   type   |   class  |  <- longword
c     |page len  |   terminal characteristics    |  <- longword (TTDEF)
c     |    extended terminal characteristics     |  <- longword (TT2DEF)
c     --------------------------------------------
c     31                                         0

      integer*2  iosb(4)
      integer*4  status, sys$trnlog, sys$assign, sys$qiow, chan
      integer*4  reset, char_buffer(3)
      character  terminal*(*)

      status = sys$assign( terminal, chan,, )

      status = sys$qiow ( %val(1), 
     .                  %val(chan), 
     .                  %val(io$_setmode),
     .                  iosb,,, 
     .                  %ref(char_buffer),
     .                  %val(12),,,, )

      return
      end
      subroutine set_notab( terminal, save_buffer )
      implicit none

C     ROUTINE USES THE IO$_SETMODE FUNCTION TO SET TERMINAL 
C     CHARACTERISTICS

      include    '($iodef)'
      include    '($ttdef)'
      include    '($tt2def)'

c                LAYOUT OF char_buffer
c
c     --------------------------------------------
c     |    buffer size     |   type   |   class  |  <- longword
c     |page len  |   terminal characteristics    |  <- longword (TTDEF)
c     |    extended terminal characteristics     |  <- longword (TT2DEF)
c     --------------------------------------------
c     31                                         0

      integer*2  iosb(4)
      integer*4  status, sys$trnlog, sys$assign, sys$qiow, chan
      integer*4  char_buffer(3), save_buffer(3)
      character  terminal*(*)

      status = sys$assign( terminal, chan,, )

      status = sys$qiow ( %val(1), 
     .                  %val(chan), 
     .                  %val(io$_sensemode),
     .                  iosb,,, 
     .                  %Ref(save_buffer),
     .                  %val(12),,,, )

      char_buffer(1) = save_buffer(1)
      char_buffer(2) = jibclr( save_buffer(2), tt$v_mechtab )
      char_buffer(3) = save_buffer(3)

      status = sys$qiow ( %val(1), 
     .                  %val(chan), 
     .                  %val(io$_setmode),
     .                  iosb,,, 
     .                  %Ref(char_buffer),
     .                  %val(12),,,, )

      return
      end
      subroutine show_files

c     Craig Young               3-AUG-87

c     This subroutine controls the initialization of the filer window as well
c     as movement and command_level input within the filer.

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

      integer    ikey, isave, code, code_type, jj
      logical    finished
      character  key, choice*(PD_MAX_CHOICE_LEN)

      call smg$begin_pasteboard_update( board_id )

      call smg$erase_display( file_window )
      call smg$label_border( file_window, node(node_num).name )
      call smg$paste_virtual_display( file_window, board_id, 10, 40 )
      call load_files
      call update_file_window
      call redefine_smg_layout

      call smg$end_pasteboard_update( board_id )

      finished = .false.

      do while ( .not. finished ) 

         call smg$set_cursor_abs( file_window,
     .                            file_num - top_file_line + 1, 1 )

         call smg$read_keystroke( keyboard, ikey )

         call print_message( ' ', 0 )

         if ( ikey .eq. smg$k_trm_do .or.
     .        ikey .eq. smg$k_trm_ctrlp ) then
            call pd_get_choice( board_id, keyboard, width, 
     .                          pull_choices, choice, code )
            code_type = code / 10
            else
            code_type = 0
            code = 0
            end if

         if ( ikey .eq. smg$k_trm_enter .or.
     .        ikey .eq. smg$k_trm_lowercase_q .or.
     .        ikey .eq. smg$k_trm_uppercase_q .or.
     .        code .eq. 181 ) then
            finished = .true.

            else if ( ikey .eq. smg$k_trm_up ) then
            jj = file_num - 1
            if ( jj .ge. 1 ) file_num = jj
            call update_file_window

            else if ( ikey .eq. smg$k_trm_down ) then
            jj = file_num + 1
            if ( jj .le. num_files ) file_num = jj
            call update_file_window


            else if ( code .eq. 111 .or. 
     .                ikey .eq. smg$k_trm_lowercase_d .or.
     .                ikey .eq. smg$k_trm_uppercase_d ) then
            call delete_file

            else if ( code_type .eq. 12 .or. 
     .                ikey .eq. smg$k_trm_lowercase_e .or.
     .                ikey .eq. smg$k_trm_uppercase_e ) then
            call edit_file

            else if ( code_type .eq. 13 .or. 
     .                ikey .eq. smg$k_trm_lowercase_m .or.
     .                ikey .eq. smg$k_trm_uppercase_m ) then
            call move_file

            else if ( code_type .eq. 14 .or. 
     .                ikey .eq. smg$k_trm_lowercase_o .or.
     .                ikey .eq. smg$k_trm_uppercase_o ) then
            call file_options( code )

            else if ( code_type .eq. 15 .or. 
     .                ikey .eq. smg$k_trm_lowercase_p .or.
     .                ikey .eq. smg$k_trm_uppercase_p ) then
            call print_file

            else if ( code_type .eq. 16 .or. 
     .                ikey .eq. smg$k_trm_lowercase_r .or.
     .                ikey .eq. smg$k_trm_uppercase_r ) then
            call rename_file

            else if ( code_type .eq. 17 .or. 
     .                ikey .eq. smg$k_trm_lowercase_h .or.
     .                ikey .eq. smg$k_trm_uppercase_h ) then
            call help_filer
            end if

      end do

      call smg$begin_pasteboard_update( board_id )

      call smg$unpaste_virtual_display( file_window, board_id )
      call define_smg_layout

      call smg$end_pasteboard_update( board_id )

      return
      end
      subroutine sm_allow_repaint

      include 'swing.cmn'

      integer  address
      external sm_repaint_screen

      address =  %loc( sm_repaint_screen )
      call smg$set_out_of_band_asts( board_id, '800000'x, 
     .                               %val(address) )

      return
      end
      subroutine sm_repaint_screen

      include 'swing.cmn'

      call smg$repaint_screen( board_id )

      return
      end
*=======================================================================
*     
*  Title:        SWING
*                
*  Version:      1-001
*                
*  Abstract:     SWING is a VMS utility for displaying and manipulating
*                VMS directory trees.
*                
*  Environment:  VMS
*                
*  Author:       Eric Andresen of General Research Corporation
*                
*  Date:         24-SEP-1986 
*                
*-----------------------------------------------------------------------
*
*  Modified and
*  Expanded by:  Craig Young of Hughes Aircraft Company
*                
*  Additions:    The main addition was the FILER and all the subroutines
*                which support it.  The DCL Command option was added to
*                the SWING command menu.  Changes were made to subroutine
*                Load_Nodes to support '<' and '>' as directory indica-
*                tors, to allow the Master file directory as the root
*                directory and to allow the START qualifier.
*
*  Date:         3-AUG-1987
*                
*-----------------------------------------------------------------------

      program swing

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

      integer    ii, jj, istat
      integer    ikey, old_level, old_line, isave, code, code_type
      integer    smg$create_virtual_display
      logical    crt, finished
      character  key, choice*(PD_MAX_CHOICE_LEN)

      if ( .not. crt() ) 
     .   call print_message( 'You must use a DEC CRT terminal', 1 )

      call define_paste_board

c     CREATE THE WINDOWS

      istat = smg$create_virtual_display(  1, 132, window1 )
      istat = smg$create_virtual_display(  MAX_LINES, 132, window2 )
      istat = smg$create_virtual_display(  2, 132, window3 )
      istat = smg$create_virtual_display(  12, 25, file_window )
      call smg$set_display_scroll_region(  file_window )
      istat = smg$create_virtual_display(  15, 70, DCL_window )
      call smg$set_display_scroll_region(  DCL_window )

      call load_nodes
      call define_smg_layout
      call load_display
      call draw_screen

      proc_created = 0

      do while ( .not. finished ) 

         call smg$read_keystroke( keyboard, ikey )

         call print_message( ' ', 0 )

         old_line = cur_line
         old_level = cur_level
         old_rend = node(node_num).rend 

         code_type = 0
         code = 0

         if ( ikey .eq. smg$k_trm_do .or.
     .        ikey .eq. smg$k_trm_ctrlp ) then
            if ( avo ) then
               call pd_get_choice( board_id, keyboard, width, 
     .                             pull_choices, choice, code )
               code_type = code / 10
            else
               call print_message( 'Advanced video option required', 0 )
               end if
            end if

         if ( ikey .eq. smg$k_trm_ctrlz .or. 
     .        ikey .eq. smg$k_trm_lowercase_x .or.
     .        ikey .eq. smg$k_trm_uppercase_x .or.
     .        ikey .eq. smg$k_trm_lowercase_e .or.
     .        ikey .eq. smg$k_trm_uppercase_e .or.
     .        ikey .eq. smg$k_trm_enter .or.
     .        code .eq. 91 ) then
            finished = .true.

            else if ( ikey .eq. smg$k_trm_up ) then
            ii = cur_level
            jj = cur_line - 1
            do while( jj .ge. 1 .and. node_pointer(ii,jj) .eq. 0 ) 
               jj = jj - 1
            end do
            if ( jj .ge. 1 ) cur_line = jj
            call update_screen( old_line, old_level )

            else if ( ikey .eq. smg$k_trm_down ) then
            ii = cur_level
            jj = cur_line + 1
            do while( node_pointer(ii,jj) .eq. 0 .and.jj .le. num_lines) 
               jj = jj + 1
            end do
            if ( jj .le. num_lines ) cur_line = jj
            call update_screen( old_line, old_level )

            else if ( ikey .eq. smg$k_trm_right ) then
            ii = cur_level + 1
            jj = cur_line 
            do while( node_pointer(ii,jj) .eq. 0 .and.ii.le. MAX_LEVELS) 
               ii = ii + 1
            end do
            if ( ii .le. MAX_LEVELS ) cur_level = ii
            call update_screen( old_line, old_level )

            else if ( ikey .eq. smg$k_trm_left .and. 
     .                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
               cur_level = ii
               cur_line = jj
               end if
            call update_screen( old_line, old_level )

            else if ( ikey .eq. smg$k_trm_lowercase_b .or.
     .                ikey .eq. smg$k_trm_uppercase_b ) then
            ii = MAX_LEVELS
            cur_line = num_lines
            do while( node_pointer(ii,cur_line) .eq. 0 .and. ii .ge. 1 )
               ii = ii - 1
            end do
            cur_level = ii
            call update_screen( old_line, old_level )

            else if ( ikey .eq. smg$k_trm_lowercase_t .or.
     .                ikey .eq. smg$k_trm_uppercase_t ) then
            cur_line = 1
            cur_level = 0
            call update_screen( old_line, old_level )

            else if ( code_type .eq. 1 .or. 
     .                ikey .eq. smg$k_trm_lowercase_c .or.
     .                ikey .eq. smg$k_trm_uppercase_c ) then
            call create_directory( code )

            else if ( code_type .eq. 2 .or. 
     .                ikey .eq. smg$k_trm_lowercase_r .or.
     .                ikey .eq. smg$k_trm_uppercase_r ) then
            call rename_directory( 20 ) 

            else if ( code_type .eq. 3 .or. 
     .                ikey .eq. smg$k_trm_lowercase_m .or.
     .                ikey .eq. smg$k_trm_uppercase_m ) then
            call rename_directory( 30 ) 

            else if ( code_type .eq. 4 .or. 
     .                ikey .eq. smg$k_trm_lowercase_d .or.
     .                ikey .eq. smg$k_trm_uppercase_d ) then
            call delete_directory( code )

            else if ( code_type .eq. 5 .or. 
     .                ikey .eq. smg$k_trm_lowercase_p .or.
     .                ikey .eq. smg$k_trm_uppercase_p ) then
            call hardcopy( code )

            else if ( code_type .eq. 6 .or. 
     .                ikey .eq. smg$k_trm_lowercase_s .or.
     .                ikey .eq. smg$k_trm_uppercase_s ) then
            call record_structure( .true. )

            else if ( code_type .eq. 7 .or. 
     .                ikey .eq. smg$k_trm_lowercase_o .or.
     .                ikey .eq. smg$k_trm_uppercase_o ) then
            call change_options( code )

            else if ( code_type .eq. 8 .or. 
     .                ikey .eq. smg$k_trm_pf2 .or.
     .                ikey .eq. smg$k_trm_help .or.
     .                ikey .eq. smg$k_trm_lowercase_h .or.
     .                ikey .eq. smg$k_trm_uppercase_h ) then
            call help( code )
            end if

         call smg$set_cursor_abs( window2, cur_line, cur_level*17+1 )

      end do

      call exit_swing
      end
        function        translate_logical (logical_name,translation)

c       Craig Young             3-AUG-87

        implicit        none
        include         '($lnmdef)'
        include         '($ssdef)'


        integer*4       translate_logical
        character*(*)   translation
        character*(*)   logical_name

        integer*4       sys$trnlnm
        integer*4       status
        integer*4       attribute
        integer*4       ret_buf_len
        integer*4       n

        structure /item_list/
          integer*2     item_len
          integer*2     item_code /lnm$_string/
          integer*4     buffer_addr
          integer*4     ret_buffer_addr /0/
          integer*4     end_items /0/
        end structure
        record /item_list/ items

        translation = ' '
        attribute = lnm$m_case_blind
        items.item_len = LEN(logical_name)
        items.buffer_addr = %loc(translation)
        call str$trim(logical_name,logical_name,n)

        status = sys$trnlnm ( attribute, 'LNM$PROCESS', 
     -          logical_name(1:n),,items)
        if ( status .ne. ss$_normal ) then
          status = sys$trnlnm ( attribute, 'LNM$JOB', 
     -          logical_name(1:n),,items)
          if ( status .ne. ss$_normal )
     -      status = sys$trnlnm ( attribute, 'LNM$SYSTEM', 
     -          logical_name(1:n),,items)
        end if

        translate_logical = status
        return
        end
      subroutine update_file_window

c     Craig Young               3-AUG-87

c     This subroutine updates the filer window to reflect movement of the
c     cursor and scrolling.

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

      integer    ii

      call smg$begin_pasteboard_update( board_id )

c     Check if scrolling required.  If so, scroll a half window.

      if ( file_num .gt. bottom_file_line ) then        !If cursor at bottom
         top_file_line = top_file_line + 6              !Scroll up
         bottom_file_line = bottom_file_line + 6

         else if ( file_num .lt. top_file_line ) then   !If cursor at top
         top_file_line = top_file_line - 6              !Scroll down
         bottom_file_line = bottom_file_line - 6
         end if

      call smg$set_cursor_abs( file_window, 1, 1 )

      do ii = top_file_line, bottom_file_line           !Reprint file names
         call smg$put_line( file_window, fnode(ii).name )
      end do                                            !for new range

      call smg$change_rendition( file_window, 
     .                           file_num - top_file_line + 1,
     .                           2, 1, 24, smg$m_reverse )

      call smg$end_pasteboard_update( board_id )

      return
      end
      subroutine update_screen( old_line, old_level )

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

      integer    old_line, old_level, ii, istat
      integer    sys$setddir

      node_num = node_pointer( cur_level, cur_line )

      call smg$begin_pasteboard_update( board_id )

      call smg$change_rendition( window2, old_line, old_level*17+1,
     .                           1, 12, old_rend )
      call smg$change_rendition( window2, cur_line, cur_level*17+1,
     .                           1, 12,
     .                           smg$m_bold + node(node_num).rend ) 

      call update_window1

      call smg$end_pasteboard_update( board_id )

      if ( cur_line .gt. bottom_line ) then
         do ii = bottom_line+1, cur_line
            call smg$move_virtual_display( window2, board_id,23-ii,1)
         end do
         top_line = cur_line - 19
         bottom_line = cur_line

         else if ( cur_line .lt. top_line ) then
         do ii = top_line-1, cur_line, -1
            call smg$move_virtual_display( window2, board_id, 4-ii,1)
         end do
         top_line = cur_line
         bottom_line = cur_line + 19
         end if

      istat = sys$setddir( node(node_num).spec, %val(0), %val(0) )

      return
      end
      subroutine update_window1

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

      integer    start

      if ( use_window1 ) then

      start = ( width - (len_disk + node(node_num).length) ) / 2
      if ( start .le. 0 ) start = 1

      call smg$erase_line( window1, 1, 1 )

      call smg$put_chars( window1, 
     .                    disk(1:len_disk)//
     .                    node(node_num).spec(1:node(node_num).length),
     .                    1, start,, smg$m_underline )

      end if

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