[comp.os.vms] Still Yet Another Swing Fix

nagy%warner.hepnet@LBL.GOV (Frank J. Nagy, VAX Wizard & Guru) (02/03/88)

	SYASF :== still yet another swing fix

	I   have   modified  RENAME_DIRECTORY.FOR  to  cure  another
	arithmetic  overflow  problem.   When  moving  a  directory,
	should  one  hit  the up-arrow once too often (attempting to
	move up beyond highest node in current level),  SWING  bombs
	... the  directory  doesn't  move,  but  the  SWING.SAV file
	thinks its gone (a real heart-stopper!). 

					Lin Winterowd
					Fermilab Accelerator Controls

...................... Cut between dotted lines and save ......................
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-5.01 01-Oct-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by NAGY
$! on Tuesday 2-FEB-1988 10:02:01.68
$!
$! It contains the following 1 file:
$! RENAME_DIRECTORY.FOR
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
                ", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
        VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="RENAME_DIRECTORY.FOR"
$ Check_Sum_is=473192705
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X      subroutine rename_directory( code )
X
X      include    'swing.cmn'
X      include    '($ssdef)'
X      include    '($smgdef)'
X
X      character  new_dir*42, key, string*39, message*255, file*255
X      integer    ikey, len_string, lib$rename_file, code, parent
X      integer    sys$getmsg, istat, len_message, ipos, from_level
X      integer    old_line, old_level, from_num, from_line, ii, jj
X      logical    dir_to_file, finished, check_directory_move
X
X      if ( code .eq. 20 ) then
X
X         call print_message( ' ', 0 )
X         call smg$set_cursor_abs( window3, 1, 1 )
X         call smg$read_string( keyboard, string,
X     .                         'Enter new name to give directory: ',
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. ' ' .and.
X     .         string(ii:ii) .ne. ';' ) 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            if ( dir_to_file( node(node_num).spec,
X     .                        node(node_num).length,
X     .                        file, ipos ) ) then
X               istat = lib$rename_file( file,
X     .                                  new_dir(1:jj)//'.DIR;1',,,
X     .                                  1 )
X
X               if ( istat .eq. ss$_normal ) then
X                  call file_to_dir( file(1:ipos)//new_dir(1:jj)//'.DIR',
X     .                              node(node_num).spec,
X     .                              node(node_num).length,
X     .                              node(node_num).name )
X
X                  parent = 0
X                  call move_node( node_num, parent )
X
X                  call adjust_node_pointers
X
X                  call load_display
X
X                  cur_line = node(node_num).line
X                  cur_level = node(node_num).level
X
X                  call update_screen( cur_line, cur_level )
X
X                  call print_message( 'Subdirectory renamed', 0 )
X
X                  do_save = .true.
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               end if
X            else
X            call smg$erase_display( window3 )
X            end if
X
X         else if ( code .eq. 30 ) then
X
X         from_num = node_num
X         from_line = cur_line
X         from_level = cur_level
X         node(from_num).rend = smg$m_reverse + smg$m_blink
X
X         call smg$change_rendition( window2, from_line, from_level*17+1,
X     .                              1, 12, node(from_num).rend )
X
X         call print_message( 'Travel to new parent directory and hit '//
X     .                       'RETURN - Hit any other key to abort', 0 )
X         call smg$set_cursor_abs( window2, from_line, from_level*17+1 )
X
X         finished = .false.
X
X         do while ( .not. finished )
X
X            call smg$read_keystroke( keyboard, ikey )
X
X            old_line = cur_line
X            old_level = cur_level
X            old_rend = node(node_num).rend
X
X            if ( ikey .eq. smg$k_trm_cr .or.
X     .           ikey .eq. smg$k_trm_enter ) then
X               finished = .true.
X
X               else if ( ikey .eq. smg$k_trm_up ) then
X               ii = cur_level
X               jj = cur_line - 1
X               do while( jj .ge. 1 .and. node_pointer(ii,jj) .eq. 0 )`009!LAW
X                  jj = jj - 1
X               end do
X               if ( jj .ge. 1 ) cur_line = jj
X               call update_screen( old_line, old_level )
X
X               else if ( ikey .eq. smg$k_trm_down ) then
X               ii = cur_level
X               jj = cur_line + 1
X               do while( node_pointer(ii,jj) .eq. 0 .and.
X     .                   jj .le. num_lines )
X                  jj = jj + 1
X               end do
X               if ( jj .le. num_lines ) cur_line = jj
X               call update_screen( old_line, old_level )
X
X               else if ( ikey .eq. smg$k_trm_right ) then
X               ii = cur_level + 1
X               jj = cur_line
X               do while( node_pointer(ii,jj) .eq. 0 .and.
X     .                   ii .le. MAX_LEVELS )
X                  ii = ii + 1
X               end do
X               if ( ii .le. MAX_LEVELS ) cur_level = ii
X               call update_screen( old_line, old_level )
X
X               else if ( ikey .eq. smg$k_trm_left .and.
X     .                   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                  cur_level = ii
X                  cur_line = jj
X                  end if
X               call update_screen( old_line, old_level )
X
X               else
X               finished = .true.
X               end if
X
X            call smg$set_cursor_abs( window2, cur_line, cur_level*17+1 )
X
X         end do
X
X         node(from_num).rend = smg$m_reverse
X
X         call smg$change_rendition( window2, from_line, from_level*17+1,
X     .                              1, 12, node(from_num).rend )
X
X         if ( ikey .eq. smg$k_trm_cr .or.
X     .        ikey .eq. smg$k_trm_enter ) then
X
X            if ( .not. check_directory_move( from_num, node_num ) ) then
X               call update_screen( cur_line, cur_level )
X               call print_message( 'Rename would cause too great a '//
X     .            'directory depth', 0 )
X               return
X               end if
X
X            if ( dir_to_file( node(from_num).spec,
X     .                        node(from_num).length,
X     .                        file, ipos ) ) then
X
X               istat = lib$rename_file( file,
X     .                 node(node_num).spec(1:node(node_num).length)//
X     .                 '*.dir;1',,, 1 )
X
X               if ( istat ) then
X                  call move_node( from_num, node_num )
X
X                  call adjust_node_pointers
X
X                  call load_display
X
X                  cur_line = node(from_num).line
X                  cur_level = node(from_num).level
X
X                  call update_screen( cur_line, cur_level )
X
X                  call print_message( 'Subdirectory has been moved', 0 )
X
X                  do_save = .true.
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               end if
X            else
X            call smg$erase_display( window3 )
X            end if
X         else
X         call smg$erase_display( window3 )
X         end if
X
X      return
X      end
$ GoSub Convert_File
$ Exit

-------