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_Record20: Read/End_Of_File=EOF20 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record20
$EOF20: 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_files(dir_spec)
X Implicit NONE
X
X include 'swing.cmn/List'
X include '($smgdef)/List'
X
X integer icontext,lib$delete_file,modify_file_prot,ptr,ii,
X 1 lib$find_file,istat,len_spec,ipos
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 1 node(ptr).level*17+1,1,12,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 1 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
X call lib$find_file_end(icontext)
X call dir_to_file(dir_spec,ii,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 1 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 1 call smg$change_rendition(window2,node(ptr).line,
X 1 node(ptr).level*17+1,1,12,node(ptr).rend)
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_Record21: Read/End_Of_File=EOF21 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record21
$EOF21: 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_node(ptr)
X Implicit NONE
X
X include 'swing.cmn/List'
X include '($smgdef)/List'
X
X logical found_node
X integer ptr,ii
X
X found_node=.false.
X ii=1
X
X do while (.not.found_node .and. ii.le.num_nodes)
X if (node(ii).sister.eq.ptr) then
X found_node=.true.
X node(ii).sister=node(ptr).sister
X else if (node(ii).child.eq.ptr) then
X found_node=.true.
X node(ii).child=node(ptr).sister
X end if
X ii=ii+1
X end do
X
X if (found_node) then
X node(ptr).name=' '
X call smg$put_chars(window2,node(ptr).name,node(ptr).line,
X 1 node(ptr).level*17+1,,node(ptr).rend)
X node(ptr).level=0
X node(ptr).length=0
X node(ptr).sister=0
X node(ptr).child=0
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_Record22: Read/End_Of_File=EOF22 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record22
$EOF22: 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 dir_to_file(dir,len_dir,file,ipos)
X Implicit NONE
X
X character dir*(*),file*(*)
X integer len_dir,ii,ipos
X
X ii=len_dir
X do while (ii.gt.0 .and. dir(ii:ii).ne.'.')
X ii=ii-1
X end do
X
X if (ii.ne.0) then
X dir_to_file=.true.
X file=dir
X file(ii:ii)=']'
X file(len_dir:)='.DIR;1'
X ipos=ii
X
X else
X call print_message('Operation not allowed on main directory',0)
X dir_to_file=.false.
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_Record23: Read/End_Of_File=EOF23 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record23
$EOF23: 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 draw_screen
X Implicit NONE
X
X include '($smgdef)/List'
X include 'swing.cmn/List'
X
X integer ii,jj,kk,smg$change_pbd_characteristics,smg$change_rendition
X
X call smg$begin_pasteboard_update(board_id)
X
X call smg$paste_virtual_display(window2,board_id,3,1)
X call smg$paste_virtual_display(window1,board_id,2,1)
X call smg$paste_virtual_display(window3,board_id,23,1)
X
X call smg$set_display_scroll_region(window3,1,2)
X
X call pd_draw_bar(board_id)
X
X top_line=1
X bottom_line=20
X
X node_num=node_pointer(cur_level,cur_line)
X
X call smg$change_rendition(window2,cur_line,cur_level*17+1,
X 1 1,12,smg$m_bold+node(node_num).rend)
X
X if (cur_line.gt.bottom_line) then
X top_line=cur_line-19
X bottom_line=cur_line
X call smg$move_virtual_display(window2,board_id,23-cur_line,1)
X else if (cur_line.lt.top_line) then
X top_line=cur_line
X bottom_line=cur_line+19
X call smg$move_virtual_display(window2,board_id,cur_line,1)
X end if
X
X call update_window1
X
X call smg$end_pasteboard_update(board_id)
X
X call smg$set_cursor_abs(window2,cur_line,cur_level*17+1)
X
X update=.true.
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_Record24: Read/End_Of_File=EOF24 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record24
$EOF24: 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 exit_swing
X Implicit NONE
X
X include 'swing.cmn/List'
X
X if (do_save .and. swing_file_exists) then
X call record_structure(.false.)
X end if
X
X Call SMG$Set_Cursor_Abs(window3,1,1)
X call smg$delete_pasteboard(board_id,0)
X!!! call reset_terminal('SYS$COMMAND',set_term_buf )
X
X Call Exit
X end
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record25: Read/End_Of_File=EOF25 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record25
$EOF25: 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 file_to_dir(file,dir,len_dir,name)
X Implicit NONE
X
X character dir*(*),file*(*),name*(*)
X integer len_dir,kk,ii,len_node,jj
X
X kk=1
X do while (file(kk:kk).ne.'[')
X kk=kk+1
X end do
X dir=file(kk:)
X
X ii=1
X do while (dir(ii:ii).ne.']')
X ii=ii+1
X end do
X
X jj=ii
X do while (dir(jj:jj).ne.'.')
X jj=jj+1
X end do
X
X dir(ii:ii)='.'
X dir(jj:)=']'
X
X len_dir=jj
X
X len_node=jj-ii-1
X if (len_node.le.9) then
X name='['//dir(ii:jj)
X else
X name='['//dir(ii:ii+9)//'*'
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_Record26: Read/End_Of_File=EOF26 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record26
$EOF26: 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 find_node(dir_spec,ptr)
X Implicit NONE
X
X! Returns the pointer (ptr) of a given dir_spec
X
X include 'swing.cmn/List'
X
X character dir_spec*(*)
X integer ii,jj,ptr,ll
X logical found_node
X
X! Find the non-blank length of dir_spec
X ii=len(dir_spec)
X do while (ii.gt.0 .and. dir_spec(ii:ii).eq.' ')
X ii=ii-1
X end do
X
X! Now search through node.spec
X jj=1
X found_node=.false.
X do while (.not. found_node)
X ll=node(jj).length
X If (ll.gt.0) then
X if (node(jj).spec(1:ll).eq.dir_spec(1:ii)) then
X found_node=.true.
X ptr=jj
X end if
X End If
X jj=jj+1
X end do
X
X find_node=found_node
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_Record27: Read/End_Of_File=EOF27 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record27
$EOF27: 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 integer function free_node
X Implicit NONE
X
X include 'swing.cmn/List'
X
X integer ii
X Character ErrMsg*4
X
X if (num_nodes.lt.MAX_NODES) then
X! Add the new node at the end.
X num_nodes=num_nodes+1
X node(num_nodes).length=0
X node(num_nodes).child=0
X node(num_nodes).sister=0
X free_node=num_nodes
X
X else
X
X! Find a free node.
X Do ii=1,MAX_NODES
X if (node(ii).length.eq.0) then
X node(ii).child=0
X node(ii).sister=0
X free_node=ii
X return
X end if
X end do
X
X! If we're here then there is no space
X Write (ErrMsg,'(I4)') MAX_NODES ! will crash if MAX_NODES > 9999
X call print_message
X 1 ('Directory structure has too many entries. Maximum: '//ErrMsg,1)
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_Record28: Read/End_Of_File=EOF28 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record28
$EOF28: 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 get_location(disk,len_disk,root,len_root)
X Implicit NONE
X
X integer*2 len_root
X integer*4 sys$setddir,len_disk,istat
X character root*255,disk*31
X
X call lib$sys_trnlog('SYS$DISK',len_disk,disk)
X istat=sys$setddir(0,len_root,root)
X
X root=root(1:len_root)
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_Record29: Read/End_Of_File=EOF29 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record29
$EOF29: 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 hardcopy(code)
X Implicit NONE
X
X include '($smgdef)/List'
X include 'swing.cmn/List'
X
X integer column,num,ii,jj,level,ikey,start,end,len,code,ll
X character hard_node*12,dashes*12,out_line(MAX_LINES)*132,one_line*200
X
X data dashes /'------------'/
X
X open (unit=1,
X 1 name='swing.lis',
X 1 carriagecontrol='list',
X 1 status='new',
X 1 err=99)
X
X call print_message('Creating hardcopy listing in SWING.LIS',0)
X
X last_level=1
X line=0
X
X do ii=0,MAX_LEVELS
X last_line(ii)=1
X end do
X
X do ii=1,num_lines
X out_line(ii)=' '
X end do
X
X do jj=1,num_lines
X do level=0,MAX_LEVELS
X if (node_pointer(level,jj).ne.0) then
X num=node_pointer(level,jj)
X column=level*17+1
X line=node(num).line
X call str$trim(hard_node,node(num).name,len)
X
X if (len.lt.12 .and. level.lt.7) then
X if (node_pointer(level+1,jj).ne.0)
X 1 hard_node=hard_node(1:len)//dashes(len+1:12)
X end if
X
X out_line(line)(column:column+11)=hard_node
X
X if (level.gt.0) then
X out_line(line)(column-3:column-1)='---'
X
X if (level.le.last_level) then
X out_line(line)(column-3:column-3)='+'
X if (out_line(line-1)(column-3:column-3).eq.'+')
X 1 out_line(line-1)(column-3:column-3)='|'
X
X else if (level.eq.last_level+1) then
X out_line(line)(column-5:column-2)='----'
X end if
X
X if (level.lt.last_level) then
X if (out_line(last_line(level))(column-3:column-3).eq.'+') then
X ll=last_line(level)
X else
X ll=last_line(level)+1
X end if
X
X do ii=ll,line-1
X out_line(ii)(column-3:column-3)='|'
X end do
X
X end if ! (level.lt.last_level)
X end if ! (level.gt.0)
X
X last_level=level
X last_line(level)=line
X
X end if ! (node_pointer(level,jj).ne.0)
X end do ! level=0,MAX_LEVELS
X end do ! jj=1,num_lines
X
X do ii=1,num_lines
X call str$trim(out_line(ii),out_line(ii),len)
X write (1,100) out_line(ii)(1:len)
X100 format (a)
X end do
X
X call print_message('Finished creating SWING.LIS',0)
X
X close(unit=1)
X
X return
X
X99 call print_message('Unable to open file for hardcopy',0)
X return
X end
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record30: Read/End_Of_File=EOF30 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record30
$EOF30: 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 help
X Implicit NONE
X
X include 'swing.cmn/List'
X include '($hlpdef)/List'
X
X external LIB$PUT_OUTPUT,LIB$GET_INPUT
X
X integer isave,flags,input,output,stat
X integer lbr$output_help
X
X call smg$save_physical_screen(board_id,isave)
X
X flags=hlp$m_prompt.or.HLP$M_PROCESS
X output=%loc(lib$put_output)
X input=%loc(lib$get_input)
X stat=lbr$output_help(%val(output),width,'swing',,flags,%val(input))
X
X call smg$restore_physical_screen(board_id,isave)
X
X if (.not.stat) call print_message
X 1 ('Can''t find help entry for SWING. Sorry.',0)
X
X return
X end