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_Record3: Read/End_Of_File=EOF3 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record3
$EOF3: 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$ ! COMMAND PROCEDURE TO COMPILE SWING
X$ ! It takes a VAX 8650 about 50 CPU seconds to do this.
X$ Set Default D_3:[U3369429.SWING.SOURCE] !*** LOCAL
X$!
X$ If F$Search("SWING.OLB").eqs."" then goto Create_OLB
X$ Write SYS$Output "Using library SWING.OLB"
X$ Goto C1
X$!
X$Create_OLB:
X$ Write SYS$Output "Creating library SWING.OLB"
X$ Library/Create/Object SWING.OLB
X$!
X$C1:
X$ Delete="Delete"
X$ Fortran="Fortran/Check/NoList"
X$ Library="Library"
X$ Link="Link/NoMap"
X$ Macro="Macro/NoList"
X$ Purge="Purge"
X$!
X$ Fortran SWING
X$ Purge SWING.OBJ
X$!
X$ Fortran ADD_NODE
X$ Library SWING ADD_NODE
X$ Delete ADD_NODE.OBJ;*
X$!
X$ Fortran ADD_NODE_TO_DISPLAY
X$ Library SWING ADD_NODE_TO_DISPLAY
X$ Delete ADD_NODE_TO_DISPLAY.OBJ;*
X$!
X$ Fortran ADJUST_NODE_POINTERS
X$ Library SWING ADJUST_NODE_POINTERS
X$ Delete ADJUST_NODE_POINTERS.OBJ;*
X$!
X$ Fortran APPEND_NODE
X$ Library SWING APPEND_NODE
X$ Delete APPEND_NODE.OBJ;*
X$!
X$ Fortran CHANGE_OPTIONS
X$ Library SWING CHANGE_OPTIONS
X$ Delete CHANGE_OPTIONS.OBJ;*
X$!
X$ Fortran CHANGE_SPEC
X$ Library SWING CHANGE_SPEC
X$ Delete CHANGE_SPEC.OBJ;*
X$!
X$ Fortran CHECK_DIRECTORY_MOVE
X$ Library SWING CHECK_DIRECTORY_MOVE
X$ Delete CHECK_DIRECTORY_MOVE.OBJ;*
X$!
X$ Fortran CREATE_DIRECTORY
X$ Library SWING CREATE_DIRECTORY
X$ Delete CREATE_DIRECTORY.OBJ;*
X$!
X$ Fortran CRT
X$ Library SWING CRT
X$ Delete CRT.OBJ;*
X$!
X$ Fortran DEFINE_PASTE_BOARD
X$ Library SWING DEFINE_PASTE_BOARD
X$ Delete DEFINE_PASTE_BOARD.OBJ;*
X$!
X$ Fortran DEFINE_SMG_LAYOUT
X$ Library SWING DEFINE_SMG_LAYOUT
X$ Delete DEFINE_SMG_LAYOUT.OBJ;*
X$!
X$ Fortran DELETE_DIRECTORY
X$ Library SWING DELETE_DIRECTORY
X$ Delete DELETE_DIRECTORY.OBJ;*
X$!
X$ Fortran DELETE_FILES
X$ Library SWING DELETE_FILES
X$ Delete DELETE_FILES.OBJ;*
X$!
X$ Fortran DELETE_NODE
X$ Library SWING DELETE_NODE
X$ Delete DELETE_NODE.OBJ;*
X$!
X$ Fortran DIR_TO_FILE
X$ Library SWING DIR_TO_FILE
X$ Delete DIR_TO_FILE.OBJ;*
X$!
X$ Fortran DRAW_SCREEN
X$ Library SWING DRAW_SCREEN
X$ Delete DRAW_SCREEN.OBJ;*
X$!
X$ Fortran EXIT_SWING
X$ Library SWING EXIT_SWING
X$ Delete EXIT_SWING.OBJ;*
X$!
X$ Fortran FILE_TO_DIR
X$ Library SWING FILE_TO_DIR
X$ Delete FILE_TO_DIR.OBJ;*
X$!
X$ Fortran FIND_NODE
X$ Library SWING FIND_NODE
X$ Delete FIND_NODE.OBJ;*
X$!
X$ Fortran FREE_NODE
X$ Library SWING FREE_NODE
X$ Delete FREE_NODE.OBJ;*
X$!
X$ Fortran GET_LOCATION
X$ Library SWING GET_LOCATION
X$ Delete GET_LOCATION.OBJ;*
X$!
X$ Fortran HARDCOPY
X$ Library SWING HARDCOPY
X$ Delete HARDCOPY.OBJ;*
X$!
X$ Fortran HELP
X$ Library SWING HELP
X$ Delete HELP.OBJ;*
X$!
X$ Macro ISADIR
X$ Library SWING ISADIR
X$ Delete ISADIR.OBJ;*
X$!
X$ Fortran LOAD_DISPLAY
X$ Library SWING LOAD_DISPLAY
X$ Delete LOAD_DISPLAY.OBJ;*
X$!
X$ Fortran LOAD_NODES
X$ Library SWING LOAD_NODES
X$ Delete LOAD_NODES.OBJ;*
X$!
X$ Fortran MODIFY_FILE_PROT
X$ Library SWING MODIFY_FILE_PROT
X$ Delete MODIFY_FILE_PROT.OBJ;*
X$!
X$ Fortran MOVE_NODE
X$ Library SWING MOVE_NODE
X$ Delete MOVE_NODE.OBJ;*
X$!
X$ Fortran ONE_MORE_LINE
X$ Library SWING ONE_MORE_LINE
X$ Delete ONE_MORE_LINE.OBJ;*
X$!
X$ Fortran PD_BAR_CHOICE
X$ Library SWING PD_BAR_CHOICE
X$ Delete PD_BAR_CHOICE.OBJ;*
X$!
X$ Fortran PD_DRAW_BAR
X$ Library SWING PD_DRAW_BAR
X$ Delete PD_DRAW_BAR.OBJ;*
X$!
X$ Fortran PD_GET_CHOICE
X$ Library SWING PD_GET_CHOICE
X$ Delete PD_GET_CHOICE.OBJ;*
X$!
X$ Fortran PD_LIST_CHOICE
X$ Library SWING PD_LIST_CHOICE
X$ Delete PD_LIST_CHOICE.OBJ;*
X$!
X$ Fortran PD_LOAD_BAR
X$ Library SWING PD_LOAD_BAR
X$ Delete PD_LOAD_BAR.OBJ;*
X$!
X$ Fortran PD_UNDRAW_BAR
X$ Library SWING PD_UNDRAW_BAR
X$ Delete PD_UNDRAW_BAR.OBJ;*
X$!
X$ Fortran PRINT_MESSAGE
X$ Library SWING PRINT_MESSAGE
X$ Delete PRINT_MESSAGE.OBJ;*
X$!
X$ Fortran RECORD_STRUCTURE
X$ Library SWING RECORD_STRUCTURE
X$ Delete RECORD_STRUCTURE.OBJ;*
X$!
X$ Fortran RENAME_DIRECTORY
X$ Library SWING RENAME_DIRECTORY
X$ Delete RENAME_DIRECTORY.OBJ;*
X$!
X$! This routine is no longer required
X$!Fortran RESET_TERMINAL
X$!Library SWING RESET_TERMINAL
X$!Delete RESET_TERMINAL.OBJ;*
X$!
X$! This routine is no longer required
X$!Fortran SET_NOTAB
X$!Library SWING SET_NOTAB
X$!Delete SET_NOTAB.OBJ;*
X$!
X$ Fortran SM_ALLOW_REPAINT
X$ Library SWING SM_ALLOW_REPAINT
X$ Delete SM_ALLOW_REPAINT.OBJ;*
X$!
X$ Fortran SM_REPAINT_SCREEN
X$ Library SWING SM_REPAINT_SCREEN
X$ Delete SM_REPAINT_SCREEN.OBJ;*
X$!
X$ Fortran SWING_ERR_HDL
X$ Library SWING SWING_ERR_HDL
X$ Delete SWING_ERR_HDL.OBJ;*
X$!
X$ Fortran UPDATE_SCREEN
X$ Library SWING UPDATE_SCREEN
X$ Delete UPDATE_SCREEN.OBJ;*
X$!
X$ Fortran UPDATE_WINDOW1
X$ Library SWING UPDATE_WINDOW1
X$ Delete UPDATE_WINDOW1.OBJ;*
X$!
X$Link:
X$ Link SWING,SWING/Library
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record4: Read/End_Of_File=EOF4 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record4
$EOF4: 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$! This is my procedure to run SWING, the line in my LOGIN.COM file reads:
X$! SWING:=="@COM_LIB:SWING"
X$!
X$! Of course, you don't need to run SWING through this procedure,
X$! you could define SWING just as:
X$! SWING:=="Run somewhere:SWING"
X$! The reason that I run SWING through this procedure is:
X$! 1. to keep my directory stack updated (my procedure SDS will do that)
X$! 2. to change my prompt string (my procedure PCD will do that)
X$!
X$ Define/User SYS$INPUT SYS$COMMAND
X$ Run COM_LIB:SWING
X$!
X$! My procedure SDS needs to be run to update its stack.
X$ If "''SD_SP'".eqs."" then goto 10 ! did we run SDS before?
X$ SDS
X$ Exit ! We exit here because SDS does a check for D_PCD itself.
X$!
X$! Check whether we want our PROMPT line set.
X$10: If "''DO_PCD'" then PCD
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record5: Read/End_Of_File=EOF5 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record5
$EOF5: 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$ Inquire Help_Lib "Help Library"
X$ Library/Help/Log 'Help_Lib SWING.HLP
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record6: Read/End_Of_File=EOF6 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record6
$EOF6: 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*=======================================================================
X* COMMONS FOR PULLDOWN.FOR
X*=======================================================================
X
XC CONSTRAINTS
X
X parameter PD_MAX_CHOICES=10
X parameter PD_MAX_CHOICE_LEN=20
X
XC THE PULL DOWN CHOICE STRUCTURE
X
X structure /pd_choice_type/
X integer number
X character*(PD_MAX_CHOICE_LEN) choice(PD_MAX_CHOICES)
X integer code(PD_MAX_CHOICES)
X integer ptr(PD_MAX_CHOICES)
X end structure
X
XC PULL DOWN SCREEN INFORMATION
X
X integer pd_bar_id,pd_num_choices,pd_cell_size
X
X common /pd_common/ pd_bar_id, ! BAR DISPLAY ID
X 1 pd_num_choices, ! NUMBER OF POSSIBLE CHOICES
X 1 pd_cell_size ! LENGTH OF EACH CELL IN THE BAR
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record7: Read/End_Of_File=EOF7 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record7
$EOF7: 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*=======================================================================
X* COMMONS FOR SWING.FOR
X*=======================================================================
X
X include 'pulldown.cmn/List'
X
X parameter MAX_LINES=300
X parameter MAX_LEVELS=7
X parameter MAX_NODES=600
X
X integer line,last_level,last_line(0:MAX_LEVELS)
X integer last_node(0:MAX_LEVELS)
X integer node_pointer(0:MAX_LEVELS,MAX_LINES),lowest_level
X integer node_num,num_nodes,num_lines
X
X structure /node_type/
X character*255 spec
X character*12 name
X integer*4 length
X integer*4 level
X integer*4 line
X integer*4 rend
X integer*4 child
X integer*4 sister
X end structure
X
X record /node_type/ node(0:MAX_NODES)
X
X common /node_info/ line,
X 1 last_level,
X 1 lowest_level,
X 1 last_line,
X 1 last_node,
X 1 num_lines,
X 1 node_pointer,
X 1 node,
X 1 node_num,
X 1 num_nodes
X
X integer window1,window2,window3,board_id,set_term_buf(3)
X integer width,cur_level,cur_line,bottom_line,top_line
X integer old_rend,len_disk,len_main,keyboard
X logical avo,using_screen,found,update,delete_problem
X logical use_window1,do_save,swing_file_exists
X character this_terminal*31,disk*31,root*255,main*50
X
X record /pd_choice_type/ pull_choices
X
X common /smg_info/ board_id,
X 1 keyboard,
X 1 window1,
X 1 window2,
X 1 window3,
X 1 pull_choices,
X 1 this_terminal,
X 1 set_term_buf,
X 1 width,
X 1 avo,
X 1 old_rend,
X 1 disk,
X 1 len_disk,
X 1 root,
X 1 main,
X 1 len_main,
X 1 cur_level,
X 1 cur_line,
X 1 top_line,
X 1 bottom_line,
X 1 using_screen,
X 1 use_window1,
X 1 update,
X 1 found,
X 1 delete_problem,
X 1 do_save,
X 1 swing_file_exists
$ Name=File'nF
$ Write SYS$Output "creating ",Name
$ Open/Write Out 'Name
$ Open/Read In VMS_SHAR_DUMMY.DUMMY
$Next_Record8: Read/End_Of_File=EOF8 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record8
$EOF8: 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 add_node(new_dir,parent)
X Implicit NONE
X
X include 'swing.cmn/List'
X
X character new_dir*42,spec*255
X integer parent,len,new_node,free_node,ii,jj
X logical greater
X
X call str$trim(new_dir,new_dir,len)
X
X spec=node(parent).spec(1:node(parent).length)//new_dir(1:len)//'.DIR;1'
X
X new_node=free_node()
X
X call file_to_dir(spec,
X 1 node(new_node).spec,
X 1 node(new_node).length,
X 1 node(new_node).name)
X
X if (node(parent).child.eq.0) then
X node(parent).child=new_node
X
X else
X ii=node(parent).child
X
X if (node(new_node).name.lt.node(ii).name) then
X node(new_node).sister=node(parent).child
X node(parent).child=new_node
X else
X greater=.true.
X
X do while (greater)
X
X if (node(ii).sister.eq.0) then
X node(ii).sister=new_node
X greater=.false.
X else
X jj=ii
X ii=node(ii).sister
X
X if (node(new_node).name.lt.node(ii).name) then
X node(jj).sister=new_node
X node(new_node).sister=ii
X greater=.false.
X end if
X
X end if ! node(ii).sister.eq.0
X end do ! while (greater)
X end if ! node(new_node).name.lt.node(ii).name
X end if ! node(parent).child.eq.0
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_Record9: Read/End_Of_File=EOF9 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record9
$EOF9: 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 add_node_to_display(num)
X Implicit NONE
X
X include '($smgdef)/List'
X include 'swing.cmn/List'
X
X integer column,num,level
X
X node(num).rend=smg$m_reverse
X
X level=node(num).level
X column=level*17+1
X line=node(num).line
X
X call smg$put_chars(window2,node(num).name,line,column,,node(num).rend)
X call smg$draw_line(window2,line,column-3,line,column-1)
X
X if (level.eq.last_level) then
X call smg$draw_line(window2,line-1,column-3,line,column-3)
X else if (level.eq.last_level+1) then
X call smg$draw_line(window2,line,column-5,line,column-2)
X else if (level.lt.last_level) then
X call smg$draw_line(window2,last_line(level),column-3,line,column-3)
X end if
X
X if (.not.found.and.root.eq.node(num).spec) then
X found=.true.
X cur_line=line
X cur_level=level
X end if
X
X last_level=level
X last_line(level)=line
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_Record10: Read/End_Of_File=EOF10 In Record
$ Write Out F$Extract(1,255,Record)
$ Goto Next_Record10
$EOF10: 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 adjust_node_pointers
X Implicit NONE
X
X include 'swing.cmn/List'
X
X integer ll,jj,ptr(0:7)
X
X do jj=0,MAX_LEVELS
X ptr(jj)=0
X do ll=1,MAX_LINES
X node_pointer(jj,ll)=0
X end do
X end do
X
X ll=1 ! LINE
X ptr(0)=1
X
X node_pointer(0,ll)=1
X ptr(1)=node(ptr(0)).child
X
X do while (ptr(1).ne.0)
X node_pointer(1,ll)=ptr(1)
X node(ptr(1)).line=ll
X node(ptr(1)).level=1
X ptr(2)=node(ptr(1)).child
X
X do while (ptr(2).ne.0)
X node_pointer(2,ll)=ptr(2)
X node(ptr(2)).line=ll
X node(ptr(2)).level=2
X ptr(3)=node(ptr(2)).child
X
X do while (ptr(3).ne.0)
X node_pointer(3,ll)=ptr(3)
X node(ptr(3)).line=ll
X node(ptr(3)).level=3
X ptr(4)=node(ptr(3)).child
X
X do while (ptr(4).ne.0)
X node_pointer(4,ll)=ptr(4)
X node(ptr(4)).line=ll
X node(ptr(4)).level=4
X ptr(5)=node(ptr(4)).child
X
X do while (ptr(5).ne.0)
X node_pointer(5,ll)=ptr(5)
X node(ptr(5)).line=ll
X node(ptr(5)).level=5
X ptr(6)=node(ptr(5)).child
X
X do while (ptr(6).ne.0)
X node_pointer(6,ll)=ptr(6)
X node(ptr(6)).line=ll
X node(ptr(6)).level=6
X ptr(7)=node(ptr(6)).child
X
X do while (ptr(7).ne.0)
X node_pointer(7,ll)=ptr(7)
X node(ptr(7)).line=ll
X node(ptr(7)).level=7
X ptr(7)=node(ptr(7)).sister
X
X if (ptr(7).ne.0) Call One_More_Line(MAX_LINES,ll)
X end do
X
X ptr(6)=node(ptr(6)).sister
X if (ptr(6).ne.0) Call One_More_Line(MAX_LINES,ll)
X end do
X
X ptr(5)=node(ptr(5)).sister
X if (ptr(5).ne.0) Call One_More_Line(MAX_LINES,ll)
X end do
X
X ptr(4)=node(ptr(4)).sister
X if (ptr(4).ne.0) Call One_More_Line(MAX_LINES,ll)
X end do
X
X ptr(3)=node(ptr(3)).sister
X if (ptr(3).ne.0) Call One_More_Line(MAX_LINES,ll)
X end do
X
X ptr(2)=node(ptr(2)).sister
X if (ptr(2).ne.0) Call One_More_Line(MAX_LINES,ll)
X end do
X
X ptr(1)=node(ptr(1)).sister
X if (ptr(1).ne.0) Call One_More_Line(MAX_LINES,ll)
X end do
X
X lowest_level=0
X do jj=1,num_nodes
X if (node(jj).level.gt.lowest_level) lowest_level=node(jj).level
X end do
X
X if (lowest_level.gt.7) call print_message
X 1 ('Directory nesting is to deep',1)
X
X num_lines=ll
X
X return
X end