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_Record11: Read/End_Of_File=EOF11 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record11
$EOF11: 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 append_node(level,spec,search)
X Implicit NONE
X
X include '($smgdef)/List'
X include 'swing.cmn/List'
X
X integer level,len_node,free_node
X character spec*255,search*255
X
X node_num=free_node()
X
X if (level.gt.lowest_level) lowest_level=level
X if (level.le.last_level) then
X line=line+1
X
X If (line.gt.MAX_LINES) then
X Write (spec(1:4),'(I4)') MAX_LINES ! will crash if MAX_LINES > 9999
X call print_message
X 1 ('Directory structure has too many lines. Maximum: '//spec(1:4),1)
X End If
X
X num_lines=line
X
X node(last_node(level)).sister=node_num
X else
X node(node_num-1).child=node_num
X end if
X
X if (level.ne.0) then
X call file_to_dir(spec,
X 1 node(node_num).spec,
X 1 node(node_num).length,
X 1 node(node_num).name)
X
X else
X call str$trim(spec,spec,len_node)
X node(node_num).spec=spec
X node(node_num).length=len_node
X
X if (len_node.le.10) then
X node(node_num).name=spec
X else
X node(node_num).name=spec(:11)//'*'
X end if
X
X end if
X
X node(node_num).line=line
X node(node_num).level=level
X node(node_num).rend=smg$m_reverse
X
X node_pointer(level,line)=node_num
X
X search=node(node_num).spec(1:node(node_num).length)//'*.dir;1'
X
X last_level=level
X last_node(level)=node_num
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_Record12: Read/End_Of_File=EOF12 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record12
$EOF12: 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 change_options(code)
X Implicit NONE
X
X include 'swing.cmn/List'
X
X integer code
X
X if (code.eq.71) then
X use_window1=.not.use_window1
X end if
X
X if (.not.use_window1) then
X call smg$erase_display(window1)
X else
X call update_window1
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_Record13: Read/End_Of_File=EOF13 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record13
$EOF13: 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 change_spec(parent,ptr)
X Implicit NONE
X
X include 'swing.cmn/List'
X
X character spec*255
X integer len,parent,ptr,ii,jj
X
X jj=node(ptr).length-1
X ii=jj
X do while (ii.gt.1.and.
X 1 node(ptr).spec(ii:ii).ne.'[' .and. node(ptr).spec(ii:ii).ne.'.')
X ii=ii-1
X end do
X ii=ii+1
X
X spec=node(parent).spec(1:node(parent).length)//
X 1 node(ptr).spec(ii:jj)//'.DIR;1'
X
X call file_to_dir(spec,node(ptr).spec,node(ptr).length,node(ptr).name)
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_Record14: Read/End_Of_File=EOF14 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record14
$EOF14: 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 logical function check_directory_move(from_num,cur_num)
X Implicit NONE
X
X include 'swing.cmn/List'
X
X integer from_num,cur_num,from_levels,ptr(0:7)
X
X from_levels=1
X
X ptr(0)=from_num
X
X ptr(1)=node(ptr(0)).child
X do while(ptr(1).ne.0)
X if (from_levels.lt.2) from_levels=2
X ptr(2)=node(ptr(1)).child
X do while(ptr(2).ne.0)
X if (from_levels.lt.3) from_levels=3
X ptr(3)=node(ptr(2)).child
X do while(ptr(3).ne.0)
X if (from_levels.lt.4) from_levels=4
X ptr(4)=node(ptr(3)).child
X do while(ptr(4).ne.0)
X if (from_levels.lt.5) from_levels=5
X ptr(5)=node(ptr(4)).child
X do while(ptr(5).ne.0)
X if (from_levels.lt.6) from_levels=6
X ptr(6)=node(ptr(5)).child
X do while(ptr(6).ne.0)
X if (from_levels.lt.7) from_levels=7
X ptr(7)=node(ptr(6)).child
X do while(ptr(7).ne.0)
X if (from_levels.lt.8) from_levels=8
X ptr(7)=node(ptr(7)).sister
X end do
X ptr(6)=node(ptr(6)).sister
X end do
X ptr(5)=node(ptr(5)).sister
X end do
X ptr(4)=node(ptr(4)).sister
X end do
X ptr(3)=node(ptr(3)).sister
X end do
X ptr(2)=node(ptr(2)).sister
X end do
X ptr(1)=node(ptr(1)).sister
X end do
X
X if (node(cur_num).level+from_levels.gt.7) then
X check_directory_move=.false.
X else
X check_directory_move=.true.
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_Record15: Read/End_Of_File=EOF15 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record15
$EOF15: 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 create_directory(code)
X Implicit NONE
X
X include 'swing.cmn/List'
X include '($ssdef)/List'
X
X character new_dir*42,term*5,string*39,message*255
X integer ii,jj,iterm,len_string,lib$create_dir,
X 1 sys$getmsg,istat,len_message,code
X
X call print_message(' ',0)
X call smg$set_cursor_abs(window3,1,1)
X call smg$read_string(keyboard,string,'New subdirectory name: ',
X 1 39,,,,len_string,,window3)
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.' ') 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 istat=lib$create_dir('[.'//new_dir(1:jj)//']')
X
X if (istat.eq.ss$_created) then
X do_save=.true.
X call add_node(new_dir(1:jj),node_num)
X call adjust_node_pointers
X call load_display
X call update_screen(cur_line,cur_level)
X call print_message('Created new subdirectory',0)
X
X else if (.not.istat) then
X call sys$getmsg(%val(istat),len_message,message,%val(1),)
X call print_message(message(1:len_message),0)
X
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_Record16: Read/End_Of_File=EOF16 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record16
$EOF16: 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 logical function crt
X Implicit NONE
X
X include '($dvidef)/List'
X include '($ttdef)/List'
X include '($tt2def)/List'
X
X include 'swing.cmn/List'
X
X integer*2 b2(14)
X integer*4 b4(7),buf,len_buf,sys$trnlog,sys$getdvi,dev_type,
X 1 len_dev_type,sys$getdviw
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. dev_type.eq.tt$_vt52)
X avo=for$bjtest(buf,tt2$v_avo)
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_Record17: Read/End_Of_File=EOF17 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record17
$EOF17: 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 define_paste_board
X Implicit NONE
X
X include '($smgdef)/List'
X include 'swing.cmn/List'
X
XC DEC FORGOT THIS PARAMETER IN $SMGDEF
X parameter SMG$S_PASTEBOARD_INFO_BLOCK='20'x
X
X integer istat,smg$create_pasteboard,
X 1 smg$create_virtual_keyboard,
X 1 smg$set_keypad_mode,
X 1 smg$get_pasteboard_attributes
X
X record /smgdef/table
X
X!!! call set_notab('SYS$COMMAND',set_term_buf)
X
X istat=smg$create_pasteboard(board_id)
X
X istat=smg$get_pasteboard_attributes(board_id,%ref(table),
X 1 %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
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record18: Read/End_Of_File=EOF18 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record18
$EOF18: 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 define_smg_layout
X Implicit NONE
X
X include '($smgdef)/List'
X include 'swing.cmn/List'
X
X integer smg$create_virtual_display,istat
X record /pd_choice_type/sub_choices(9)
X
X call define_paste_board
X
Xc CREATE THE WINDOWS
X istat=smg$create_virtual_display(1,132,window1)
X istat=smg$create_virtual_display(MAX_LINES,132,window2)
X istat=smg$create_virtual_display(2,132,window3)
X
X pull_choices.number=9
X
X pull_choices.choice(1)='Create'
X pull_choices.code(1)=10
X pull_choices.ptr(1)=0
X
X pull_choices.choice(2)='Rename'
X pull_choices.code(2)=20
X pull_choices.ptr(2)=0
X
X pull_choices.choice(3)='Move'
X pull_choices.code(3)=30
X pull_choices.ptr(3)=0
X
X pull_choices.choice(4)='Delete'
X pull_choices.code(4)=40
X pull_choices.ptr(4)=0
X
X pull_choices.choice(5)='Print'
X pull_choices.code(5)=50
X pull_choices.ptr(5)=0
X
X pull_choices.choice(6)='Save'
X pull_choices.code(6)=60
X pull_choices.ptr(6)=0
X
X pull_choices.choice(7)='Options'
X pull_choices.code(7)=70
X pull_choices.ptr(7)=%loc(sub_choices(7))
X
X pull_choices.choice(8)='Help'
X pull_choices.code(8)=80
X pull_choices.ptr(8)=0
X
X pull_choices.choice(9)='Exit'
X pull_choices.code(9)=90
X pull_choices.ptr(9)=%loc(sub_choices(9))
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=1
X sub_choices(7).choice(1)='display directory'
X sub_choices(7).code(1)=71
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).choice(2)='cancel'
X sub_choices(9).code(2)=92
X
X call pd_load_bar(width,pull_choices)
X
X use_window1=.false.
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_Record19: Read/End_Of_File=EOF19 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record19
$EOF19: 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 delete_directory(code)
X Implicit NONE
X include 'swing.cmn/List'
X include '($ssdef)/List'
X
X character spec(0:MAX_LEVELS)*255,search(0:MAX_LEVELS)*255,
X 1 term*5,string*3,message*255,name*50
X integer iterm,len_string,code,
X 1 sys$getmsg,istat,len_message,len(0:MAX_LEVELS),
X 1 icont(0:MAX_LEVELS),lib$find_file,ii,jj
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,'Enter YES to to delete this '//
X 1 'directory and all directories below it: ',
X 1 3,,,,len_string,,window3)
X call str$upcase(string,string)
X
X if (string.eq.'YES') then
X do_save=.true.
X call print_message('Deleting current directory structure...',0)
X delete_problem=.false.
X
X search(0)=node(node_num).spec(1:node(node_num).length)//'*.dir'
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
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 1 '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