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


Received: from ncsc.ARPA by KL.SRI.COM with TCP; Mon 11 Apr 88 09:01:48-PDT
Received: by ncsc.ARPA id AA03126; Mon, 11 Apr 88 10:57:34 CST
Date: Mon, 11 Apr 88 10:57:34 CST
From: vtcf@ncsc.ARPA (Williams)
Message-Id: <8804111657.AA03126@ncsc.ARPA>
To: info-vax@kl.sri.com
Subject: SWING 7 OF 13

$Part07:
$ File_is="SWING_3.FOR"
$ Check_Sum_is=840577090
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X      logical function crt
X
X      include    'swing.cmn'
X      include    '($dvidef)'
X      include    '($ttdef)'
X      include    '($tt2def)'
X
X      integer*2  b2(14)
X      integer*4  b4(7), buf, len_buf, sys$trnlog, sys$getdviw, dev_type,
X     -           len_dev_type
X      logical*4  for$bjtest, istat
X
X      equivalence ( b4(1), b2(1) )
X
X      b2(1) = 4
X      b2(2) = dvi$_devdepend2
X      b4(2) = %loc( buf )
X      b4(3) = %loc( len_buf )
X
X      b2(7) = 4
X      b2(8) = dvi$_devtype
X      b4(5) = %loc( dev_type )
X      b4(6) = %loc( len_dev_type )
X
X      b4(7) = 0
X
X      istat = sys$getdviw( ,, 'SYS$COMMAND', b4,,,, )
X
X      crt      = ( for$bjtest( buf, tt2$v_deccrt ) .or. 
X     .                            dev_type .eq. tt$_vt52 )
X      avo      = for$bjtest( buf, tt2$v_avo )
X
X      return
X      end      
X      subroutine define_paste_board
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
XC     DEC FORGOT THIS PARAMETER IN $SMGDEF
X      parameter  SMG$S_PASTEBOARD_INFO_BLOCK = '20'x
X
X      integer    smg$create_pasteboard
X      integer    smg$create_virtual_keyboard
X      integer    smg$set_keypad_mode
X      integer    smg$get_pasteboard_attributes
X      integer    istat
X
XC
XC`009To cope with strange terminal screen lengths
XC       Added by EH Perkins, Aug 16, 1987
XC
X`009integer linest
X`009common /length/ linest
X
X      record     /smgdef/ table
X
X      call set_notab( 'SYS$COMMAND', set_term_buf )
X
X      istat = smg$create_pasteboard( board_id,,linest)  ! linest added by
XC                                                                EHP
X
X      istat = smg$get_pasteboard_attributes(board_id, %ref(table),
X     .                                %ref(SMG$S_PASTEBOARD_INFO_BLOCK))
X
X      width = table.smg$w_width
X
X      istat = smg$create_virtual_keyboard( keyboard )
X      istat = smg$set_keypad_mode( keyboard, 1 )
X
X      call sm_allow_repaint
X
X      return
X      end      
X      subroutine define_smg_layout
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
XC
XC     sub_choices redimensioned to 10 from 9  EH Perkins Aug 1987
XC
X
X      record /pd_choice_type/ sub_choices(10)
X
XC
XC     Pull_choices.number increased to 10 from 9 to include FILER
XC          option
XC
X
X      pull_choices.number = 10
X      pull_choices.choice(1) = 'Create'
X      pull_choices.code(1) = 10
X      pull_choices.ptr(1) = 0
X      pull_choices.choice(2) = 'Rename'
X      pull_choices.code(2) = 20
X      pull_choices.ptr(2) = 0
X      pull_choices.choice(3) = 'Move'
X      pull_choices.code(3) = 30
X      pull_choices.ptr(3) = 0
X      pull_choices.choice(4) = 'Delete'
X      pull_choices.code(4) = 40
X      pull_choices.ptr(4) = 0
X      pull_choices.choice(5) = 'Print'
X      pull_choices.code(5) = 50
X      pull_choices.ptr(5) = 0
X      pull_choices.choice(6) = 'Save'
X      pull_choices.code(6) = 60
X      pull_choices.ptr(6) = 0
X      pull_choices.choice(7) = 'Options'
X      pull_choices.code(7) = 70
X      pull_choices.ptr(7) = %loc( sub_choices(7) )
X      pull_choices.choice(8) = 'Help'
X      pull_choices.code(8) = 80
X      pull_choices.ptr(8) = 0
X      pull_choices.choice(9) = 'Exit'
X      pull_choices.code(9) = 90
X      pull_choices.ptr(9) = %loc( sub_choices(9) )
XC
XC`009Filer option added by EH Perkins, Aug 16, 1987
XC
X      pull_choices.choice(10) = 'Filer' 
X      pull_choices.code(10) = 100
X      pull_choices.ptr(10) = 0
X
X      sub_choices(1).number = 0
X      sub_choices(2).number = 0
X      sub_choices(3).number = 0
X      sub_choices(4).number = 0
X      sub_choices(5).number = 0 
X      sub_choices(6).number = 0
X
X      sub_choices(7).number = 3
X      sub_choices(7).choice(1) = 'DCL Command'
X      sub_choices(7).code(1) = 71
X      sub_choices(7).ptr(1) = 68
X      sub_choices(7).choice(2) = 'Filer'
X      sub_choices(7).code(2) = 73
X      sub_choices(7).ptr(2) = 70
X      sub_choices(7).choice(3) = 'Show Directory Name'
X      sub_choices(7).code(3) = 72
X      sub_choices(7).ptr(3) = 83
X
X      sub_choices(8).number = 0
X
X      sub_choices(9).number = 2
X      sub_choices(9).choice(1) = 'ok exit'
X      sub_choices(9).code(1) = 91
X      sub_choices(9).ptr(1) = 79
X      sub_choices(9).choice(2) = 'cancel'
X      sub_choices(9).code(2) = 92
X      sub_choices(9).ptr(2) = 67
X
X      sub_choices(10).number = 0
X
X      call pd_load_bar( width, pull_choices)
X     
X      use_window1 = .false.
X
X      return     
X      end
X      subroutine delete_directory( code )
X
X      include    'swing.cmn'
X      include    '($ssdef)'
X
X      character  spec(0:MAX_LEVELS)*255, search(0:MAX_LEVELS)*255
X      character  term*5, string*3, message*255, name*50
X      integer    iterm, len_string, code, jj
X      integer    sys$getmsg, istat, len_message, len(0:MAX_LEVELS)
X      integer    icont(0:MAX_LEVELS), lib$find_file, ii
X      logical    found_node
X
X      call print_message( ' ', 0 )
X      call smg$set_cursor_abs( window3, 1, 1 )
X      call smg$read_string( keyboard, string, 
X     .                      'Enter YES to to delete this direc'//
X     .                      'tory and all directories below it: ',
X     .                      3,,,,len_string,, window3 )
X
X      call str$upcase( string, string )
X
X      if ( string .eq. 'YES' ) then
X
X         do_save = .true.
X
X         call print_message('Deleting current directory structure...',0)
X
X         delete_problem = .false.
X         search(0)=node(node_num).spec(1:node(node_num).length)//'*.dir'
X
X         icont(0) = 0
X         do while ( lib$find_file( search(0), spec(0), icont(0) ) )      
X          call file_to_dir( spec(0), search(1), len(1), name )
X          search(1) = search(1)(1:len(1))//'*.dir'
X          icont(1) = 0
X          do while ( lib$find_file( search(1), spec(1), icont(1) ) )      
X           call file_to_dir( spec(1), search(2), len(2), name )
X           search(2) = search(2)(1:len(2))//'*.dir'
X           icont(2) = 0
X           do while ( lib$find_file( search(2), spec(2), icont(2) ) )      
X            call file_to_dir( spec(2), search(3), len(3), name )
X            search(3) = search(3)(1:len(3))//'*.dir'
X            icont(3) = 0
X            do while ( lib$find_file( search(3), spec(3), icont(3) ) )      
X             call file_to_dir( spec(3), search(4), len(4), name )
X             search(4) = search(4)(1:len(4))//'*.dir'
X             icont(4) = 0
X             do while ( lib$find_file( search(4), spec(4), icont(4) ) )      
X              call file_to_dir( spec(4), search(5), len(5), name )
X              search(5) = search(5)(1:len(5))//'*.dir'
X              icont(5) = 0
X              do while ( lib$find_file( search(5), spec(5), icont(5) ) )      
X               call file_to_dir( spec(5), search(6), len(6), name )
X               search(6) = search(6)(1:len(6))//'*.dir'
X               icont(6) = 0
X               do while ( lib$find_file( search(6), spec(6), icont(6) ))      
X                call file_to_dir( spec(6), search(7), len(7), name )
X                call delete_files( search(7)(1:len(7)) )
X               end do
X               call lib$find_file_end( icont(6) )
X               call delete_files( search(6)(1:len(6)) )
X              end do
X              call lib$find_file_end( icont(5) )
X              call delete_files( search(5)(1:len(5)) )
X             end do
X             call lib$find_file_end( icont(4) )
X             call delete_files( search(4)(1:len(4)) )
X            end do
X            call lib$find_file_end( icont(3) )
X            call delete_files( search(3)(1:len(3)) )
X           end do
X           call lib$find_file_end( icont(2) )
X           call delete_files( search(2)(1:len(2)) )
X          end do
X          call lib$find_file_end( icont(1) )
X          call delete_files( search(1)(1:len(1)) )
X         end do
X         call lib$find_file_end( icont(0) )
X         call delete_files( search(0)(1:node(node_num).length) )
X
X         if ( cur_level .ge. 1 ) then
X            ii = cur_level - 1
X            jj = cur_line
X            do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 ) 
X               jj = jj - 1
X            end do
X            if ( jj .ge. 1 ) then
X               node_num = node_pointer(ii,jj)
X               else
X               node_num = 1
X               end if
X            else
X            node_num = 1
X            end if
X
X         call adjust_node_pointers
X         call load_display
X
X         cur_level = node(node_num).level
X         cur_line = node(node_num).line
X
X         call update_screen( cur_line, cur_level )
X
X         if ( delete_problem ) then
X            call print_message( 'Attempted to delete subdirectory - '//
X     .           'but some files could not be deleted', 0 )
X            else
X            call print_message( 'Deleted subdirectory structure', 0 )
X            end if
X         else
X
X         call print_message( 'No directories deleted', 0 )
X         end if
X
X      return
X      end
X      subroutine delete_file
X
Xc     Craig Young               3-AUG-87
X
Xc     This subroutine deletes the current file after verification.
X
X      include   'swing.cmn'
X
X      character string*5
X      integer   old_file, old_top, old_bottom, istat, len_string
X
Xc     Check if current file is a directory.  If so, abort delete.
X
X      istat = index( fnode(file_num).spec(1:), '.DIR;1' )
X
X      if ( istat .eq. 0 ) then
X         old_file = file_num                    !Save current position
X         old_top  = top_file_line               !and window range
X         old_bottom = bottom_file_line
X
X         call print_message( ' ', 0 )
X         call smg$set_cursor_abs( window3, 2, 1 )
XC
XC        Call to smg$read_string changed from
XC     .                         ,,,,len_string,, window3 )
XC        to
XC     .                        3,,,,len_string,, window3 )
XC        so it is the same as the delete node confirmation.
XC
XC        EH Perkins Aug 16, 1987
XC
X         call smg$read_string( keyboard, string,
X     .                         'Enter YES to delete this file: ',
X     .                        3,,,,len_string,, window3 )
X         call str$upcase( string, string )
X
X         if ( string .eq. 'YES' ) then
X            call lib$delete_file( fnode(file_num).spec )
X            call print_message( 'File deleted', 0 )
X         else
X            call print_message( 'Delete aborted', 0 )
X         end if
X
X         call load_files                        !Reload fnode array
X
X         if ( old_file .le. num_files ) then
X            file_num = old_file                 !Reset cursor position
X         else
X            file_num = 1
X            end if
X         top_file_line = old_top                !Reset window range
X         bottom_file_line = old_bottom
X
X         call update_file_window
X      else
X         call print_message( 'Cannot delete a directory '//
X     .                       'with the filer.', 0 )
X         end if
X
X      return
X      end
X      subroutine delete_files( dir_spec )
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
X      integer    len_spec, istat, ii, ipos
X      integer    icontext, lib$delete_file, modify_file_prot, ptr
X      integer    lib$find_file
X      character  dir_spec*(*), spec*255
X      logical    find_node, found_node
X
X      ii = len( dir_spec )
X      do while ( dir_spec(ii:ii) .eq. ' ' .and. ii .gt. 0 ) 
X         ii = ii - 1
X      end do
X
X      if ( find_node( dir_spec(1:ii), ptr ) ) then
X         found_node = .true.
X         call smg$change_rendition( window2, node(ptr).line, 
X     .                              node(ptr).level*17+1,
X     .                              1, 12,
X     .                              smg$m_blink + node(ptr).rend ) 
X         else
X         found_node = .false.
X         end if
X
X      icontext = 0
X      do while( lib$find_file( dir_spec(:ii)//'*.*;*', spec, icontext ))
X         if ( .not. lib$delete_file( spec ) ) then
X            call str$trim( spec, spec, len_spec )
X            if ( modify_file_prot( spec(1:len_spec), 0, 0 ) ) then
X               istat = lib$delete_file( spec )
X               if ( .not. istat ) delete_problem = .true.
X               else 
X               call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
X     .                         dir_spec(:ii)//'*.*;*', 'NL:', 'NL:' )
X               istat = lib$delete_file( spec )
X               if ( .not. istat ) delete_problem = .true.
X               end if
X            end if
X      end do
X      call lib$find_file_end( icontext )
X
X      call dir_to_file( dir_spec, ii,
X     .                  spec, ipos )
X      if ( .not. lib$delete_file( spec ) ) then
X         call str$trim( spec, spec, len_spec )
X         if ( modify_file_prot( spec(1:len_spec), 0, 0 ) ) then
X            istat = lib$delete_file( spec )
X            if ( .not. istat ) delete_problem = .true.
X            else 
X            call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
X     .                      dir_spec(:ii)//'*.*;*', 'NL:', 'NL:' )
X            istat = lib$delete_file( dir_spec(1:ii) )
X            if ( .not. istat ) delete_problem = .true.
X            end if
X         end if
X
X      if ( .not. delete_problem ) then
X         if ( found_node ) call delete_node( ptr )
X         else
X         if ( found_node ) 
X     .      call smg$change_rendition( window2, node(ptr).line, 
X     .                                 node(ptr).level*17+1,
X     .                                 1, 12,
X     .                                 node(ptr).rend ) 
X         end if
X
X      return
X      end
X
$ GoSub Convert_File
$ Goto Part08
