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


Received: from ncsc.ARPA by KL.SRI.COM with TCP; Mon 11 Apr 88 09:51:37-PDT
Received: by ncsc.ARPA id AA03433; Mon, 11 Apr 88 11:48:08 CST
Date: Mon, 11 Apr 88 11:48:08 CST
From: vtcf@ncsc.ARPA (Williams)
Message-Id: <8804111748.AA03433@ncsc.ARPA>
To: info-vax@kl.sri.com
Subject: SWING 13 OF 13

$Part13:
$ File_is="SWING_9.FOR"
$ Check_Sum_is=2082750150
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X      subroutine rename_file
X
Xc     Craig Young               3-AUG-87
X
Xc     This subroutine prompts the user for a new name for the current file.
X
X      include   'swing.cmn'
X
X      integer   istat, len_string, len_message, lib$rename_file
X      character string*100, message*255
X
Xc     Check if current file is a directory.  If so, abort rename.
X
X      istat = index( fnode(file_num).spec(1:), '.DIR;1' )
X
X      if ( istat .eq. 0 ) then
X         call print_message( ' ', 0 )
X         call smg$set_cursor_abs( window3, 2, 1 )
X         call smg$read_string( keyboard, string, 'New name: ',
X     .                         ,,,,len_string,, window3 )
X         call str$upcase( string, string )
X
X         istat = lib$rename_file( fnode(file_num).spec, string )
X
X         if ( istat ) then
X            call print_message( 'File has been renamed.', 0 )
X
X         else
X            call sys$getmsg( %val(istat), len_message, message, 
X     .                       %val(1), )
X            call print_message( message(1:len_message), 0 )
X            end if
X
X         call load_files
X         call update_file_window
X
X      else
X         call print_message('Cannot rename directory with the filer.',0)
X         end if
X
X      return
X      end
X      subroutine reset_terminal( terminal, char_buffer )
X      implicit none
X
XC     ROUTINE USES THE IO$_SETMODE FUNCTION TO SET TERMINAL 
XC     CHARACTERISTICS
X
X      include    '($iodef)'
X
Xc                LAYOUT OF char_buffer
Xc
Xc     --------------------------------------------
Xc     |    buffer size     |   type   |   class  |  <- longword
Xc     |page len  |   terminal characteristics    |  <- longword (TTDEF)
Xc     |    extended terminal characteristics     |  <- longword (TT2DEF)
Xc     --------------------------------------------
Xc     31                                         0
X
X      integer*2  iosb(4)
X      integer*4  status, sys$trnlog, sys$assign, sys$qiow, chan
X      integer*4  reset, char_buffer(3)
X      character  terminal*(*)
X
X      status = sys$assign( terminal, chan,, )
X
X      status = sys$qiow ( %val(1), 
X     .                  %val(chan), 
X     .                  %val(io$_setmode),
X     .                  iosb,,, 
X     .                  %ref(char_buffer),
X     .                  %val(12),,,, )
X
X      return
X      end
X      subroutine set_notab( terminal, save_buffer )
X      implicit none
X
XC     ROUTINE USES THE IO$_SETMODE FUNCTION TO SET TERMINAL 
XC     CHARACTERISTICS
X      
X      include    '($iodef)'
X      include    '($ttdef)'
X      include    '($tt2def)'
X
Xc                LAYOUT OF char_buffer
Xc
Xc     --------------------------------------------
Xc     |    buffer size     |   type   |   class  |  <- longword
Xc     |page len  |   terminal characteristics    |  <- longword (TTDEF)
Xc     |    extended terminal characteristics     |  <- longword (TT2DEF)
Xc     --------------------------------------------
Xc     31                                         0
X
X      integer*2  iosb(4)
X      integer*4  status, sys$trnlog, sys$assign, sys$qiow, chan
X      integer*4  char_buffer(3), save_buffer(3)
X      character  terminal*(*)
X
X      status = sys$assign( terminal, chan,, )
X
X      status = sys$qiow ( %val(1), 
X     .                  %val(chan), 
X     .                  %val(io$_sensemode),
X     .                  iosb,,, 
X     .                  %Ref(save_buffer),
X     .                  %val(12),,,, )
X
X      char_buffer(1) = save_buffer(1)
X      char_buffer(2) = jibclr( save_buffer(2), tt$v_mechtab )
X      char_buffer(3) = save_buffer(3)
X
X      status = sys$qiow ( %val(1), 
X     .                  %val(chan), 
X     .                  %val(io$_setmode),
X     .                  iosb,,, 
X     .                  %Ref(char_buffer),
X     .                  %val(12),,,, )
X
X      return
X      end
X      subroutine show_files
X
Xc     Craig Young               3-AUG-87
X                                             
Xc     This subroutine controls the initialization of the filer window as well
Xc     as movement and command_level input within the filer.
X
X      include    'swing.cmn'
X      include    '($smgdef)'
X
X      integer    ikey, isave, code, code_type, jj
X      logical    finished
X      character  key, choice*(PD_MAX_CHOICE_LEN)
X
X      call smg$begin_pasteboard_update( board_id )
X
X      call smg$erase_display( file_window )
X      call smg$label_border( file_window, node(node_num).name )
X      call smg$paste_virtual_display( file_window, board_id, 10, 40 )
X      call load_files
X      call update_file_window
X      call redefine_smg_layout
X
X      call smg$end_pasteboard_update( board_id )
X
X      finished = .false.
X
X      do while ( .not. finished ) 
X
X         call smg$set_cursor_abs( file_window,
X     .                            file_num - top_file_line + 1, 1 )
X
X         call smg$read_keystroke( keyboard, ikey )
X                                                              
X         call print_message( ' ', 0 )
X
X         if ( ikey .eq. smg$k_trm_do .or.
X     .        ikey .eq. smg$k_trm_ctrlp ) then
X            call pd_get_choice( board_id, keyboard, width, 
X     .                          pull_choices, choice, code )
X            code_type = code / 10
X            else
X            code_type = 0
X            code = 0
X            end if
X
XC
XC`009ikey = x or X or <ctrl>z added by EH Perkins  Aug 1987
XC
X         if ( ikey .eq. smg$k_trm_enter .or.
X     .        ikey .eq. smg$k_trm_lowercase_q .or.
X     .        ikey .eq. smg$k_trm_uppercase_q .or.
X     .        ikey .eq. smg$k_trm_lowercase_x .or.
X     .        ikey .eq. smg$k_trm_uppercase_x .or.
X     .        ikey .eq. smg$k_trm_ctrlz       .or.         
X     .        code .eq. 181 ) then
X            finished = .true.
X
X            else if ( ikey .eq. smg$k_trm_up ) then
X            jj = file_num - 1
X            if ( jj .ge. 1 ) file_num = jj
X            call update_file_window
X
X            else if ( ikey .eq. smg$k_trm_down ) then
X            jj = file_num + 1
X            if ( jj .le. num_files ) file_num = jj
X            call update_file_window
X
X            else if ( ikey .eq. smg$k_trm_prev_screen .or.
X     .                ikey .eq. smg$k_trm_ctrlb ) then
X            jj = file_num - 11
X            if ( jj .lt. 1 ) jj = 1
X            file_num = jj
X            call update_file_window
X
X            else if ( ikey .eq. smg$k_trm_next_screen .or.
X     .                ikey .eq. smg$k_trm_ctrlf ) then
X            jj = file_num + 11
X            if ( jj .gt. num_files ) jj = num_files
X            file_num = jj
X            call update_file_window
X
X            else if ( ikey .eq. smg$k_trm_lowercase_t .or.
X     .                ikey .eq. smg$k_trm_uppercase_t ) then
X            file_num = 1
X            call update_file_window
X
X            else if ( ikey .eq. smg$k_trm_lowercase_b .or.
X     .                ikey .eq. smg$k_trm_uppercase_b ) then
X            file_num = num_files
X            call update_file_window
X
X
X
X            else if ( code .eq. 111 .or. 
X     .                ikey .eq. smg$k_trm_lowercase_d .or.
X     .                ikey .eq. smg$k_trm_uppercase_d ) then
X            call delete_file
X
X            else if ( code_type .eq. 12 .or. 
X     .                ikey .eq. smg$k_trm_lowercase_e .or.
X     .                ikey .eq. smg$k_trm_uppercase_e ) then
X            call edit_file
X
X            else if ( code_type .eq. 13 .or. 
X     .                ikey .eq. smg$k_trm_lowercase_m .or.
X     .                ikey .eq. smg$k_trm_uppercase_m ) then
X            call move_file
X
X            else if ( code_type .eq. 14 .or. 
X     .                ikey .eq. smg$k_trm_lowercase_o .or.
X     .                ikey .eq. smg$k_trm_uppercase_o ) then
X            call file_options( code )
X
X            else if ( code_type .eq. 15 .or. 
X     .                ikey .eq. smg$k_trm_lowercase_p .or.
X     .                ikey .eq. smg$k_trm_uppercase_p ) then
X            call print_file
X
X            else if ( code_type .eq. 16 .or. 
X     .                ikey .eq. smg$k_trm_lowercase_r .or.
X     .                ikey .eq. smg$k_trm_uppercase_r ) then
X            call rename_file
X
X            else if ( code_type .eq. 17 .or. 
X     .                ikey .eq. smg$k_trm_lowercase_h .or.
X     .                ikey .eq. smg$k_trm_uppercase_h ) then
X            call help_filer
X            end if
X
X      end do
X
X      call smg$begin_pasteboard_update( board_id )
X
X      call smg$unpaste_virtual_display( file_window, board_id )
X      call define_smg_layout
X
X      call smg$end_pasteboard_update( board_id )
X
X      return
X      end
X      subroutine sm_allow_repaint
X
X      include 'swing.cmn'
X
X      integer  address
X      external sm_repaint_screen
X
X      address =  %loc( sm_repaint_screen )
X      call smg$set_out_of_band_asts( board_id, '800000'x, 
X     .                               %val(address) )
X
X      return
X      end
X      subroutine sm_repaint_screen
X
X      include 'swing.cmn'
X
X      call smg$repaint_screen( board_id )
X
X      return
X      end
X
$ GoSub Convert_File
$ File_is="SWING_BUILD.COM"
$ Check_Sum_is=511254674
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X$ fortran swing_1
X$ fortran swing_2
X$ fortran swing_3
X$ fortran swing_4    
X$ fortran swing_5
X$ fortran swing_6
X$ fortran swing_7
X$ fortran swing_8    
X$ fortran swing_9
X$ fortran swing_10    
X$ SET COMMAND/OBJECT  swing_tables !Makes .OBJ file
X$ library/create swing swing_1,swing_2,swing_3,swing_4
X$ library/insert swing swing_5,swing_6,swing_7,swing_8
X$ library/insert swing swing_9,swing_10
X$ LIBRARY swing swing_tables 
X$ link/exe=swing swing/lib/inc=swing
X$ set noon
X$ delete swing_%.lis;*
X$ delete swing_%.obj;*
X$ delete swing_%.map;*
X$ delete swing_10.lis;*
X$ delete swing_10.obj;*
X$ delete swing_10.map;*
X$ delete swing.olb;*
X$ delete swing_tables.obj;*
X$ set on
X$ set protection=(O:REWD,S:RWE,G:RWE,W:RWE) swing.exe;*
$ GoSub Convert_File
$ File_is="SWING_TABLES.CLD"
$ Check_Sum_is=436411688
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
XModule swing_tables
XIdent "V1.0"
XDefine verb swing
Xqualifier START 
X          value (default = "CURRENT"), Placement=Global
$ GoSub Convert_File
$ Exit
