u3369429@murdu.OZ (Michael 'I love VMS' Bednarek) (05/07/87)
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record44: Read/End_Of_File=EOF44 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record44
$EOF44: Close Out
$ Close In
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'Name
$ Success=F$Element(Check_Sum'nF.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)
$ Write SYS$ERROR "Checking CHECKSUM. ''Success'"
$ nF=nF+1
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X Options /Extend_Source
X subroutine rename_directory(code)
X Implicit NONE
X
X include 'swing.cmn/List'
X include '($ssdef)/List'
X include '($smgdef)/List'
X
X character new_dir*42,key,string*39,message*255,file*255
X integer*4 ikey,len_string,lib$rename_file,code,parent,
X 1 sys$getmsg,istat,len_message,ipos,from_level,
X 1 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 call print_message(' ',0)
X call smg$set_cursor_abs(window3,1,1)
X call smg$read_string(keyboard,string,
X 1 'Enter new name to give directory: ',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 1 string(ii:ii).ne.'.' .and. string(ii:ii).gt.' ' .and.
X 1 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,node(node_num).length,
X 1 file,ipos)) then
X istat=lib$rename_file(file,new_dir(1:jj)//'.DIR;1',,,1)
X
X if (istat.eq.ss$_normal) then
X call file_to_dir(file(1:ipos)//new_dir(1:jj)//'.DIR',
X 1 node(node_num).spec,node(node_num).length,node(node_num).name)
X parent=0
X call move_node(node_num,parent)
X call adjust_node_pointers
X call load_display
X cur_line=node(node_num).line
X cur_level=node(node_num).level
X call update_screen(cur_line,cur_level)
X call print_message('Subdirectory renamed',0)
X do_save=.true.
X else
X call sys$getmsg(%val(istat),len_message,message,%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 call smg$change_rendition(window2,from_line,from_level*17+1,
X 1 1,12,node(from_num).rend)
X call print_message('Travel to new parent directory and hit '//
X 1 '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 do while (.not. finished)
X call smg$read_keystroke(keyboard,ikey)
X old_line=cur_line
X old_level=cur_level
X old_rend=node(node_num).rend
X if (ikey.eq.smg$k_trm_cr .or. ikey.eq.smg$k_trm_enter) then
X finished=.true.
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)
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(jj.le.num_lines .and. node_pointer(ii,jj).eq.0)
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(ii.le.MAX_LEVELS .and. node_pointer(ii,jj).eq.0)
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. cur_level.ge.1) then
X ii=cur_level-1
X jj=cur_line
X do while(jj.ge.1 .and. node_pointer(ii,jj).eq.0)
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 1,12,node(from_num).rend)
X
X if (ikey.eq.smg$k_trm_cr .or. 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 1 'directory depth',0)
X return
X end if
X
X if (dir_to_file(node(from_num).spec,node(from_num).length,
X 1 file,ipos)) then
X istat=lib$rename_file(file,
X 1 node(node_num).spec(1:node(node_num).length)//'*.DIR;1',,,1)
X if (istat) then
X call move_node(from_num,node_num)
X call adjust_node_pointers
X call load_display
X cur_line=node(from_num).line
X cur_level=node(from_num).level
X call update_screen(cur_line,cur_level)
X call print_message('Subdirectory has been moved',0)
X do_save=.true.
X else
X call sys$getmsg(%val(istat),len_message,message,%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
X call smg$erase_display(window3)
X end if
X
X return
X end
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record45: Read/End_Of_File=EOF45 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record45
$EOF45: Close Out
$ Close In
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'Name
$ Success=F$Element(Check_Sum'nF.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)
$ Write SYS$ERROR "Checking CHECKSUM. ''Success'"
$ nF=nF+1
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X Options /Extend_Source
X subroutine reset_terminal(terminal,char_buffer)
X Implicit NONE
X
XC ROUTINE USES THE IO$_SETMODE FUNCTION TO SET TERMINAL CHARACTERISTICS
X
X include '($iodef)/List'
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 1 %val(chan),
X 1 %val(io$_setmode),
X 1 iosb,,,
X 1 %ref(char_buffer),
X 1 %val(12),,,,)
X
X return
X end
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record46: Read/End_Of_File=EOF46 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record46
$EOF46: Close Out
$ Close In
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'Name
$ Success=F$Element(Check_Sum'nF.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)
$ Write SYS$ERROR "Checking CHECKSUM. ''Success'"
$ nF=nF+1
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X Options /Extend_Source
X subroutine set_notab(terminal,save_buffer)
X Implicit NONE
X
XC ROUTINE USES THE IO$_SETMODE FUNCTION TO SET TERMINAL CHARACTERISTICS
X
X include '($iodef)/List'
X include '($ttdef)/List'
X include '($tt2def)/List'
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 1 %val(chan),
X 1 %val(io$_sensemode),
X 1 iosb,,,
X 1 %ref(save_buffer),
X 1 %val(12),,,,)
X
X char_buffer(1)=save_buffer(1)
X char_buffer(2)=jibclr(save_buffer(2),tt$v_mechtab) ! Clear Bit
X char_buffer(3)=save_buffer(3)
X
X status=sys$qiow (%val(1),
X 1 %val(chan),
X 1 %val(io$_setmode),
X 1 iosb,,,
X 1 %ref(char_buffer),
X 1 %val(12),,,,)
X
X return
X end
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record47: Read/End_Of_File=EOF47 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record47
$EOF47: Close Out
$ Close In
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'Name
$ Success=F$Element(Check_Sum'nF.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)
$ Write SYS$ERROR "Checking CHECKSUM. ''Success'"
$ nF=nF+1
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X Options /Extend_Source
X subroutine sm_allow_repaint
X Implicit NONE
X
X include 'swing.cmn/List'
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,%val(address))
X
X return
X end
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record48: Read/End_Of_File=EOF48 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record48
$EOF48: Close Out
$ Close In
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'Name
$ Success=F$Element(Check_Sum'nF.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)
$ Write SYS$ERROR "Checking CHECKSUM. ''Success'"
$ nF=nF+1
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X Options /Extend_Source
X subroutine sm_repaint_screen
X Implicit NONE
X include 'swing.cmn/List'
X call smg$repaint_screen(board_id)
X return
X end