From:	CSBVAX::MRGATE!vtcf@ncsc.ARPA@SMTP 13-APR-1988 04:48
To:	ARISIA::EVERHART
Subj:	SWING 9 OF 13


Received: from ncsc.ARPA by KL.SRI.COM with TCP; Mon 11 Apr 88 09:02:30-PDT
Received: by ncsc.ARPA id AA03130; Mon, 11 Apr 88 10:58:22 CST
Date: Mon, 11 Apr 88 10:58:22 CST
From: vtcf@ncsc.ARPA (Williams)
Message-Id: <8804111658.AA03130@ncsc.ARPA>
To: info-vax@kl.sri.com
Subject: SWING 9 OF 13

$Part09:
$ File_is="SWING_5.FOR"
$ Check_Sum_is=624751044
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X      subroutine help
X
X      include    'swing.cmn'
X      include    '($hlpdef)'
X
X      external   LIB$PUT_OUTPUT, LIB$GET_INPUT
X
X      integer    isave, flags, input, output, stat
X      integer    lbr$output_help
X
X      call smg$save_physical_screen( board_id, isave )
X
X      flags = hlp$m_prompt
X
X      output = %loc( lib$put_output )
X      input =  %loc( lib$get_input )
X
X      stat = lbr$output_help( %val(output),
X     .                        width,
X     .                        'swing',
X     .                        'swing',
X     .                        flags,
X     .                        %val(input) )
X
X      call smg$restore_physical_screen( board_id, isave )
X
X      if ( .not. stat ) then
X         call print_message( 
X     .        'There is no SWING.HLB help file in SYS$HELP', 0 )
X         end if
X
X      return
X      end
X      subroutine help_filer
X
Xc     Craig Young               3-AUG-87
X
Xc     This subroutine enters the swing HELP file at the FILER key.
X
X      include    'swing.cmn'
X      include    '($hlpdef)'
X
X      external   LIB$PUT_OUTPUT, LIB$GET_INPUT
X
X      integer    isave, flags, input, output, stat
X      integer    lbr$output_help
X
X      call smg$save_physical_screen( board_id, isave )
X
X      flags = hlp$m_prompt
X
X      output = %loc( lib$put_output )
X      input =  %loc( lib$get_input )
X
X      stat = lbr$output_help( %val(output),
X     .                        width,
X     .                        'swing commands option filer',
X     .                        'swing',
X     .                        flags,
X     .                        %val(input) )
X
X      call smg$restore_physical_screen( board_id, isave )
X
X      if ( .not. stat ) then
X         call print_message( 
X     .        'There is no SWING.HLB help file in SYS$HELP', 0 )
X         end if
X
X      return
X      end
X      subroutine load_display
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
X      integer    ii, istat, jj, kk, level
X      integer     smg$change_pbd_characteristics,smg$change_rendition
X
X      using_screen = .true.
X
X      if ( .not. found ) then
X         cur_level = 0
X         cur_line = 1
X         end if
X
X      last_level = 0
X      line = 0
X      do ii = 0, MAX_LEVELS
X         last_line(ii) = 1
X      end do         
X
X      if ( lowest_level .gt. 4 .and. width .ne. 132 ) then
X         width = 132
X         call pd_undraw_bar( board_id )
X         call smg$erase_display( window1 )
X         call smg$erase_display( window2 )
X         call smg$erase_display( window3 )
X         istat = smg$change_pbd_characteristics( board_id,132,,24 )
X         call smg$set_display_scroll_region( window3, 1, 2 )
X         call pd_load_bar( width, pull_choices)
X         call pd_draw_bar( board_id )
X
X         else if ( lowest_level .le. 4 .and. width .ne. 80 ) then
X         width = 80
X         call pd_undraw_bar( board_id )
X         call smg$erase_display( window1 )
X         call smg$erase_display( window2 )
X         call smg$erase_display( window3 )
X         istat = smg$change_pbd_characteristics( board_id,80,,24 )
X         call smg$set_display_scroll_region( window3, 1, 2 )
X         call pd_load_bar( width, pull_choices)
X         call pd_draw_bar( board_id )
X         end if
X
X      call smg$begin_pasteboard_update( board_id )
X
X      call smg$erase_display( window2 )
X
X      do jj = 1, num_lines
X         do level = 0, MAX_LEVELS
X            if ( node_pointer(level,jj) .ne. 0 )
X     .         call add_node_to_display( node_pointer(level,jj) )
X         end do
X      end do
X
Xc     PUT UNDERLINES ON THE LEAF NODES
X
X      do jj = 2, num_nodes
X         do ii = 2, MAX_LEVELS
X            if ( node_pointer(ii,jj) .ne. 0 .and.
X     .           node_pointer(ii-1,jj) .ne. 0 .and.
X     .           node_pointer(ii,jj-1) .ne. 0 ) then
X               kk = node_pointer( ii, jj-1 )
X               node(kk).rend = smg$m_underline + smg$m_reverse
X               istat = smg$change_rendition( window2, node(kk).line,
X     .                                       node(kk).level*17+1, 
X     .                                       1, 12, node(kk).rend )
X               end if
X         end do
X      end do
X
X      call smg$end_pasteboard_update( board_id )
X
X      if ( .not. found )
X     .   call print_message( 'The current directory was not found in'//
X     .                       ' your save file', 0 )
X
X      return
X      end
X      subroutine load_files
X
Xc     Craig Young               3-AUG-87
X
Xc     This subroutine stores the file names in the current directory into
Xc     the FNode array for use by the filer.
X
X      include    'swing.cmn'
X
X      integer    ii
X      integer*4  icontext, lib$find_file
X      character  spec*255, search*255
X
X      do ii = 1, MAX_FILES      !Initialize fnode array
X         fnode(ii).length = 0
X         fnode(ii).spec = ' '
X         fnode(ii).name = ' '
X      end do
X
X      num_files = 0             !Initialize num_files
X
X      search = node(node_num).spec(1:node(node_num).length)//'*.*;*'
X
X      icontext = 0
X      do while ( lib$find_file( search, spec, icontext ) .and. 
X     .           num_files .lt. MAX_FILES )
XC
XC         Modified to exclude directories ....... EHP  7/sep/87
XC
X         ii = index( spec, '.DIR')
X         if (ii .eq. 0) call append_fnode( spec )
X      end do
X      call lib$find_file_end( icontext )
X
X      if ( num_files .eq. MAX_FILES ) 
X     .   call print_message ( 'Too many files; not all displayed', 0 )
X
X      file_num = 1              !Initialize cursor, window range
X      top_file_line = 1
X      bottom_file_line = 12
X
X      return
X      end
X      subroutine load_nodes
X
X      include    'swing.cmn'
X
X      integer    istat, error, ii, jj                       
X      integer*2  cli$present, cli$get_value, len_temp
X      integer*4  icontext(MAX_LEVELS), lib$find_file
X      character  input*255, spec*255, search(0:MAX_LEVELS)*255
X      character  temp*20
X
X      integer*4 lib$sys_trnlog, lTR `009`009`009! added to allow
X      character TR*255`009`009`009`009`009! swing_save to
X                                                        ! be used
X      External  Swing_tables
X      Integer*4 Lib$Get_Foreign, Cli$Dcl_Parse, Lib$Get_Input, sts
X      Character*255 CmdLine
X      Integer*2 CL_Len
X
X
X      do ii = 1, MAX_LINES
X         do jj = 0, MAX_LEVELS
X            node_pointer(jj,ii) = 0
X         end do
X      end do
X
X      found = .false.
X      lowest_level = 0
X      last_level = 1
X      line = 0
X      num_nodes = 0      
X      node_num = 0       
X
Xc     If START qualifier was specified, set Main to value of START
XC     modified by E.H. Perkins, ARC
XC     Get the Foreign Command line, tack the verb onto the front and
XC     invoke the DCL command processor on the result.
XC     Default comes from library.
XC
X      sts = Lib$Get_Foreign( CmdLine,, CL_Len)
X      IF (.NOT. sts) CALL Lib$Signal( %VAL(sts))
X      IF (CL_Len .gt. 0) Then
X          sts = Cli$Dcl_Parse( 'SWING '//CmdLine(1:CL_Len),
X     .                          Swing_Tables, Lib$Get_Input)
X      Else
X          sts = Cli$Dcl_Parse( 'Swing ', Swing_Tables, Lib$Get_Input)
X      EndIf
X      IF (.NOT. sts) call exit
X
X      if ( cli$present( 'START' ) ) then
X         error = cli$get_value( 'START', spec, len_root )
X         if ( .not. error ) call sys$exit( %val(error) )
X                                                                
X         call str$upcase( spec, spec )
X         if ( spec .eq. 'CURRENT' ) then
X            call get_location( disk, len_disk, spec, len_root )      
X            end if
X
X         ii = 1
X         do while ( spec(ii:ii) .ne. '[' .and. spec(ii:ii) .ne. '<' )
X            ii = ii + 1
X         end do
X
X         if ( ii .ne. 1 ) then
X            disk = spec(:ii-1)
X            len_disk = ii-1
X            call lib$sys_trnlog( 'SYS$DISK', len_temp, temp )
X            if ( temp .ne. disk )
X     .         call print_message( 'Cannot SWING to another device.',1)
X         else
X            call lib$sys_trnlog( 'SYS$DISK', len_disk, disk )
X            end if
X
X         spec = spec(ii:)
X         main = spec
X         root = spec
X         len_root = len_root - (ii - 1)    
X         len_main = len_root
X
X      else
X         call get_location( disk, len_disk, root, len_root )      
X
X         ii = 1
X         do while ( root(ii:ii) .ne. '.' .and. root(ii:ii) .ne. ']'
X     .              .and. root(ii:ii) .ne. '>' )
X            ii = ii + 1
X         end do
X
X         istat = index( root(1:), '<' )
X         if ( istat .ne. 0 ) then
X            root(istat:istat) = '['
X            end if
X
X         main = root(:ii-1)//']'
X         len_main = ii
X         spec = main
X         end if
X
X! Create a file name for the save file (Michael Bednarek)
X! The rationale behind this is that I don't want to write the SWING.SAV file
X! into other users' directories.
X! If the logical name SWING_SAVE exists,
X
X`009If (LIB$SYS_TRNLOG('SWING_SAVE',lTR,TR,,,%VAL(0)).eq.1) then
X`009  main(1:len_main+10)='SWING_SAVE:'//main(2:len_main-1)//'_'
X`009  len_main=len_main+10
X          do ii = 1, len_main                            ! Federico Bonzanigo 
X             if (main(ii:ii) .eq. '.') main(ii:ii) = '_' ! ETH Feb 88
X          end do
X`009End If
X
X      ii = 0     
X      if ( .not. update .and. lib$find_file( main(1:len_main)//
X     .     'swing.sav', input, ii ) ) then
X
X         open( unit=1, 
X     .         readonly,
X     .         name=main(1:len_main)//'swing.sav', 
X     .         status='old',
X     .         carriagecontrol='list',
X     .         access='sequential',
X     .         form='unformatted',
X     .         recl=73,
X     .         organization='sequential',
X     .         recordtype='variable',
X     .         err=99 )
X
X         read( 1, err=99 ) num_lines, num_nodes, lowest_level
X
X         do ii = 1, num_lines
X            read( 1, err=99 ) (node_pointer(jj,ii), jj=0,MAX_LEVELS)
X         end do
X
X         do ii = 1, num_nodes
X            read( 1, err=99 ) node(ii)
X         end do
X
X         close( unit=1 )
X
X         swing_file_exists = .true.
X
X      else
X99       call print_message( 'Searching directory structure...', 0 )
X
X         call append_node( 0, spec, search(1) )
X
X         icontext(1) = 0
X         do while ( lib$find_file( search(1), spec, icontext(1) ) )      
X          if ( index( spec, '000000.DIR;1' ) .eq. 0 ) then
X          call append_node( 1, spec, search(2) )
X          icontext(2) = 0
X          do while ( lib$find_file( search(2), spec, icontext(2) ) )      
X           call append_node( 2, spec, search(3) )
X           icontext(3) = 0
X           do while ( lib$find_file( search(3), spec, icontext(3) ) )      
X            call append_node( 3, spec, search(4) )
X            icontext(4) = 0
X            do while ( lib$find_file( search(4), spec, icontext(4) ) )      
X             call append_node( 4, spec, search(5) )
X             icontext(5) = 0
X             do while ( lib$find_file( search(5), spec, icontext(5) ) )      
X              call append_node( 5, spec, search(6) )
X              icontext(6) = 0
X              do while ( lib$find_file( search(6), spec, icontext(6) ) )      
X               call append_node( 6, spec, search(7) )
X               icontext(7) = 0
X               do while ( lib$find_file( search(7), spec, icontext(7) ))      
X                call append_node( 7, spec, search(0) )
X               end do
X               call lib$find_file_end( icontext(7) )
X              end do
X              call lib$find_file_end( icontext(6) )
X             end do
X             call lib$find_file_end( icontext(5) )
X            end do
X            call lib$find_file_end( icontext(4) )
X           end do
X           call lib$find_file_end( icontext(3) )
X          end do
X          call lib$find_file_end( icontext(2) )
X         end if
X         end do
X         call lib$find_file_end( icontext(1) )
X         end if
X
X      return
X      end
X
$ GoSub Convert_File
$ Goto Part10
