BEN@TECHMAX.BITNET.UUCP (03/02/87)
Portia sent me about 10 copies of the swing source files, none of which arrived intact. Most of these arrived only partially complete. I imagine that this is due to some size restriction of code from or through a mailer. Could someone please send me an intact set of code, preferably in netdata format. Thanks, ------------------------------------------------------------------- |Ben Pashkoff xx xxxxxxxx | |System Engineer xx xxxxxx | |Biomedical Engineering xx xx | |Technion, IIT xx xx | |Haifa, Israel 32000 xxxx | |BEN@TECHMAX.BITNET xx | -------------------------------------------------------------------
u3369429@seismo.CSS.GOV@murdu.OZ.AU (03/03/87)
Hi Swingers! By public demand I herwith post the revised SWING source. It comes in six postings. You save each one on your VMS machine, remove the mailing header lines with your favourite editor and execute (@) the rest. Here is what I would do: (Example for one (1) posting/file) in rn I say: s swing.shar1 and answer n to the prompt 'Use mailbox format?' Then I copy the file(s) to my VMS machine as SWING.SHAR1 On the VMS machine I edit SWING.SHAR1 and delete all mailing header lines, so the first line looks like: $write sys$error "extract AAAREADME.GRC" I also delete the last line which is empty. After exiting from the editor, I do: $ @SWING.SHAR1 and watch. Then you should edit the COMPILE.COM file and either execute or submit it. Enjoy. Michael Bednarek (u3369429@murdu.oz.au) PSI%23342000301::U3369429
u3369429@seismo.CSS.GOV@murdu.OZ.AU (03/03/87)
$write sys$error "extract AAAREADME.GRC"
$copy sys$input AAAREADME.GRC
$deck/dollars="870303:12:53:38"
SWING displays the current directory tree on a CRT screen for
interactive tree manipulation. It is able to do the following:
o SET DEFAULT by moving from node to node with the arrow keys
and exiting SWING when the current node is the directory
desired.
o Rename a subdirectory.
o Interactively create a new subdirectory.
o Interactively move a subdirectory structure to a new position,
with all of its children.
o Interactively delete a tree structure - each node blinks and
then disappears as it is deleted. This graphically does what
the DELTREE type command procedures do.
o Create hardcopy of the current directory structure.
o Create a "binary save file" so the whole directory doesn't have
to be searched each time SWING is used.
The SWING program is written entirely in FORTRAN and replaces a
lot of worn out command procedures that have been written over the years.
It allows the user to quickly examine and manipulate a directory
structure, saving time for the real work at hand.
The screen manipulation is handled by the SMG routines and all
eight directory levels are supported. The screen is switched between
80 and 132 columns as the directory tree changes size. The display
scrolls up and down for long directory trees and commands are either
entered by hitting keys or by a pulldown menu at the top of the screen.
There is help while in SWING and a help file is furnished for the VMS
HELP library as well. You have to try SWING to believe it. It is
proof that computers can be easy to use!
------------------------------------------------------------------------
COMPLEMENTS, SUGGESTIONS AND COMPLAINTS TO THE FOLLOWING:
Eric Andresen
General Research Corporation
5383 Hollister Avenue
Santa Barbara, CA 93111
(805)964-7724 Ext. 332
------------------------------------------------------------------------
870303:12:53:38
$write sys$error "extract AAA_ADD_SWING.MB"
$copy sys$input AAA_ADD_SWING.MB
$deck/dollars="870303:12:53:38"
Features modified/added to SWING:
o A few arrays needed to be dimensioned
Dimension blabla(0:SOME_PARAMETER)
^^
o A few IF-statements needed to be turned around. E.g.:
If (array(i).eq.0 .and. i.lt.Bound_of_i)
must be written as
If (i.lt.Bound_of_i .and. array(i).eq.0 )
o Added {Q,q,F10} as commands to quit (identical to {E,e,X,x,^Z}
o Changed a flag in the HELP routine to look for HLP$LIBRARYx in the
process table (no need to put SWING.HLP in the system help file).
o Added support for directories a la TOPS-10/20, e.g.: <FOOBAR>
o Rather than keeping the save-file in the top-level current tree, SWING
now checks for a logical name SWING_SAVE and writes/reads save files there,
the name being toplevel_SWING.SAV, e.g.: when
SWING_SAVE = "D_3:[U3369429.SWING_SAVE]"
and I swing through U3364711 and save,
the file will be D_3:[U3369429.SWING_SAVE]U3364711_SWING.SAV
May I suggest some guidelines for Fortran developers?
Use "IMPLICIT NONE"!
Someone observed that his FORSYSDEF.TLB didn't contain the proper $SMGDEF.
That's due to a mockup on DEC's part. It happened at our site, too.
I figured out the missing structure, and it compiled. BUT, no keystroke was
recognised because they were all interrogated by their symbolic names, set up
as PARAMETERs in $SMGDEF (the proper one), which were missing in my version.
Compile using "/CHECK"!
SWING bombed a number of times due to susbscript out of bounds.
I as an author would find this rather embarrassing.
This is not meant to put Eric Andresen down. In fact, I believe SWING is a very
commendable effort and I use it a lot.
870303:12:53:38
$write sys$error "extract SWING.HLP"
$copy sys$input SWING.HLP
$deck/dollars="870303:12:53:38"
!=======================================================================
! THIS IS THE HELP LIBRARY FOR SWING
!=======================================================================
!
! This is the help file for the program SWING
! To add this to the standard help library on the VAX type:
! $ LIBRARY/HELP SYS$HELP:HELPLIB SWING.HLP
!
! Note that the processed version of this file (.HLB)
! is used by the SWING executable and must be located in SYS$HELP
!
1 SWING
SWING is a VAX/VMS utility for displaying the graphical representation
of directory trees on a VT100 or VT200 type terminal. It can be used to
move to a directory or subdirectory, as is done with the SET DEFAULT
command, and it can rename, move and delete subdirectories. SWING can
also create hardcopy listings of a directory structure.
Simply type SWING at the VMS prompt.
2 Moving_around
Once SWING has drawn a picture of the default directory structure the
cursor will be positioned at the current directory and it will be
highlighted. The arrow keys can be used to move from one subdirectory
to another. As you travel around you are "setting default" to that
directory. To exit simply type X, E, Q, RETURN, CONTROL-Z, F10
or ENTER and you will return to VMS in the new directory location.
As you move around with the arrow keys notice that the RIGHT, UP and
DOWN arrows take you to the first directory available in that direction
and that the LEFT arrow takes you to the parent of the current directory.
Other commands can be entered to create, rename and move subdirectories,
as well as delete entire directory trees and get a hardcopy listing of
the current directory structure. To get help on these various commands
enter the section of help called COMMANDS.
2 Save_file
Every time SWING displays a directory tree it gets its information from
either searching the disk or from a save file.
If the logical name SWING_SAVE is defined as a directory, this file
will be called SWING_SAVE:(top_level)_SWING.SAV.
If such logical name is not defined, the file name is
[(top_level)]SWING_SAV
If SWING is going to be used on a regular basis it is advisable
that the structure be saved in such a file.
The SAVE command will create a save file and from that point on SWING will
attempt to keep that file up-to-date. Having the save file will speed
up initialization so much that it might be tempting to use SWING for
"setting default" all of the time.
If the directory structure is changed in any way by SWING the save file
will be updated automatically, but if a change has occured without the
use of SWING it will be necessary to do a manual SAVE on the new
directory tree.
NOTE: SWING does purge the save files provided the current process
has enough privilege.
2 Commands
Commands can be entered by either hitting the first letter of the
commands located on the menu at the top of the screen or by hitting the
CONTROL-P or DO keys and using the menu bar like a pulldown menu. The
pulldown menu is operated by using the arrow keys to go to a selection
and then hitting the ENTER key to choose that item. CONTROL-Z will exit
the pulldown menu without making a choice. Although the pulldown menu is
cute, hitting the first letter of the commands is by far a faster
method.
3 Create
CREATE prompts the user for the name of a new subdirectory to be created.
The display will be updated and an actual directory is created.
3 Rename
RENAME prompts for a new name to be given to the current directory. The
display may change since the directories are in alphabetical order.
3 Move
MOVE initiates the move operation by blinking the current subdirectory
and then the user is asked to move to the a new parent directory. When
either RETURN or ENTER is hit the move takes place. Both the new parent
and the directory being moved can have other subdirectories attached to
them as well. While moving to the new parent directory the operation
can be canceled by hitting any key besides the arrow keys, ENTER and
RETURN.
3 Delete
DELETE causes the current directory and all subdirectories below it to
be deleted automatically. The user is asked to enter YES before any
delete operation takes place and the word YES must be spelled out
completely. The deletion starts at the lowest subdirectory in the tree
and works its way back to the current directory. As files are being
deleted from a subdirectory that node will blink on the screen. If the
subdirectory is successfully deleted the node name will blank out, so you
can watch the directory tree being deleted graphically.
IMPORTANT: IF A FILE DOES NOT HAVE DELETE ACCESS FOR THE USER, SWING
WILL ATTEMPT TO CHANGE THE PROTECTION ON IT SO THAT IT CAN
DELETE THE FILE (GIVEN THE PRIVILEGE OF THE USER ONLY)
If a particular subdirectory or file still can't be deleted then the
deletion process will continue anyway, leaving the protected files.
A message will be given stating the problem.
3 Print
PRINT creates a file for printing that contains a hardcopy version of
the directory structure. One of two file types can be created. The
normal output is for any printer and the LQP input file is for running
through the LQP utility on a laser printer for a clean line drawn
representation of the directory tree. The file is called SWING.LIS and
it will be placed in the current directory.
3 Save
SAVE causes a new save file to be created in the main directory. The
save file is for speeding up the initialization of SWING. See the
section called SAVE_FILE on the level of help above this level.
3 Option
OPTION causes an optional full directory specification to be displayed
at the top of the screen. The directory name will be modified each time
the user moves to a new directory location.
3 Exit
EXIT causes the SWING to exit to the currently selected subdirectory or
directory. The keys E, X, Q, F10, CONTROL-Z, ENTER and RETURN exit SWING.
870303:12:53:38
$write sys$error "extract COMPILE.COM"
$copy sys$input COMPILE.COM
$deck/dollars="870303:12:53:38"
$ ! COMMAND PROCEDURE TO COMPILE SWING
$ ! It takes a VAX 8650 about 50 CPU seconds to do this.
$ Set Default [.SWING.EXPORT] !*** LOCAL
$!
$ If F$Search("SWING.OLB").eqs."" then goto Create_OLB
$ Write SYS$Output "Using library SWING.OLB"
$ Goto C1
$!
$Create_OLB:
$ Write SYS$Output "Creating library SWING.OLB"
$ Library/Create/Object SWING.OLB
$!
$C1:
$ Fortran="Fortran/Check/NoList/Extend_Source"
$!
$ Fortran SWING
$ Purge SWING.OBJ
$!
$ Fortran ADD_NODE
$ Library SWING ADD_NODE
$ Delete ADD_NODE.OBJ;*
$!
$ Fortran ADD_NODE_TO_DISPLAY
$ Library SWING ADD_NODE_TO_DISPLAY
$ Delete ADD_NODE_TO_DISPLAY.OBJ;*
$!
$ Fortran ADJUST_NODE_POINTERS
$ Library SWING ADJUST_NODE_POINTERS
$ Delete ADJUST_NODE_POINTERS.OBJ;*
$!
$ Fortran APPEND_NODE
$ Library SWING APPEND_NODE
$ Delete APPEND_NODE.OBJ;*
$!
$ Fortran CHANGE_OPTIONS
$ Library SWING CHANGE_OPTIONS
$ Delete CHANGE_OPTIONS.OBJ;*
$!
$ Fortran CHANGE_SPEC
$ Library SWING CHANGE_SPEC
$ Delete CHANGE_SPEC.OBJ;*
$!
$ Fortran CHECK_DIRECTORY_MOVE
$ Library SWING CHECK_DIRECTORY_MOVE
$ Delete CHECK_DIRECTORY_MOVE.OBJ;*
$!
$ Fortran CREATE_DIRECTORY
$ Library SWING CREATE_DIRECTORY
$ Delete CREATE_DIRECTORY.OBJ;*
$!
$ Fortran CRT
$ Library SWING CRT
$ Delete CRT.OBJ;*
$!
$ Fortran DEFINE_PASTE_BOARD
$ Library SWING DEFINE_PASTE_BOARD
$ Delete DEFINE_PASTE_BOARD.OBJ;*
$!
$ Fortran DEFINE_SMG_LAYOUT
$ Library SWING DEFINE_SMG_LAYOUT
$ Delete DEFINE_SMG_LAYOUT.OBJ;*
$!
$ Fortran DELETE_DIRECTORY
$ Library SWING DELETE_DIRECTORY
$ Delete DELETE_DIRECTORY.OBJ;*
$!
$ Fortran DELETE_FILES
$ Library SWING DELETE_FILES
$ Delete DELETE_FILES.OBJ;*
$!
$ Fortran DELETE_NODE
$ Library SWING DELETE_NODE
$ Delete DELETE_NODE.OBJ;*
$!
$ Fortran DIR_TO_FILE
$ Library SWING DIR_TO_FILE
$ Delete DIR_TO_FILE.OBJ;*
$!
$ Fortran DRAW_SCREEN
$ Library SWING DRAW_SCREEN
$ Delete DRAW_SCREEN.OBJ;*
$!
$ Fortran EXIT_SWING
$ Library SWING EXIT_SWING
$ Delete EXIT_SWING.OBJ;*
$!
$ Fortran FILE_TO_DIR
$ Library SWING FILE_TO_DIR
$ Delete FILE_TO_DIR.OBJ;*
$!
$ Fortran FIND_NODE
$ Library SWING FIND_NODE
$ Delete FIND_NODE.OBJ;*
$!
$ Fortran FREE_NODE
$ Library SWING FREE_NODE
$ Delete FREE_NODE.OBJ;*
$!
$ Fortran GET_LOCATION
$ Library SWING GET_LOCATION
$ Delete GET_LOCATION.OBJ;*
$!
$ Fortran HARDCOPY
$ Library SWING HARDCOPY
$ Delete HARDCOPY.OBJ;*
$!
$ Fortran HELP
$ Library SWING HELP
$ Delete HELP.OBJ;*
$!
$ Fortran LOAD_DISPLAY
$ Library SWING LOAD_DISPLAY
$ Delete LOAD_DISPLAY.OBJ;*
$!
$ Fortran LOAD_NODES
$ Library SWING LOAD_NODES
$ Delete LOAD_NODES.OBJ;*
$!
$ Fortran MODIFY_FILE_PROT
$ Library SWING MODIFY_FILE_PROT
$ Delete MODIFY_FILE_PROT.OBJ;*
$!
$ Fortran MOVE_NODE
$ Library SWING MOVE_NODE
$ Delete MOVE_NODE.OBJ;*
$!
$ Fortran PD_BAR_CHOICE
$ Library SWING PD_BAR_CHOICE
$ Delete PD_BAR_CHOICE.OBJ;*
$!
$ Fortran PD_DRAW_BAR
$ Library SWING PD_DRAW_BAR
$ Delete PD_DRAW_BAR.OBJ;*
$!
$ Fortran PD_GET_CHOICE
$ Library SWING PD_GET_CHOICE
$ Delete PD_GET_CHOICE.OBJ;*
$!
$ Fortran PD_LIST_CHOICE
$ Library SWING PD_LIST_CHOICE
$ Delete PD_LIST_CHOICE.OBJ;*
$!
$ Fortran PD_LOAD_BAR
$ Library SWING PD_LOAD_BAR
$ Delete PD_LOAD_BAR.OBJ;*
$!
$ Fortran PD_UNDRAW_BAR
$ Library SWING PD_UNDRAW_BAR
$ Delete PD_UNDRAW_BAR.OBJ;*
$!
$ Fortran PRINT_MESSAGE
$ Library SWING PRINT_MESSAGE
$ Delete PRINT_MESSAGE.OBJ;*
$!
$ Fortran RECORD_STRUCTURE
$ Library SWING RECORD_STRUCTURE
$ Delete RECORD_STRUCTURE.OBJ;*
$!
$ Fortran RENAME_DIRECTORY
$ Library SWING RENAME_DIRECTORY
$ Delete RENAME_DIRECTORY.OBJ;*
$!
$ Fortran RESET_TERMINAL
$ Library SWING RESET_TERMINAL
$ Delete RESET_TERMINAL.OBJ;*
$!
$ Fortran SET_NOTAB
$ Library SWING SET_NOTAB
$ Delete SET_NOTAB.OBJ;*
$!
$ Fortran SM_ALLOW_REPAINT
$ Library SWING SM_ALLOW_REPAINT
$ Delete SM_ALLOW_REPAINT.OBJ;*
$!
$ Fortran SM_REPAINT_SCREEN
$ Library SWING SM_REPAINT_SCREEN
$ Delete SM_REPAINT_SCREEN.OBJ;*
$!
$ Fortran UPDATE_SCREEN
$ Library SWING UPDATE_SCREEN
$ Delete UPDATE_SCREEN.OBJ;*
$!
$ Fortran UPDATE_WINDOW1
$ Library SWING UPDATE_WINDOW1
$ Delete UPDATE_WINDOW1.OBJ;*
$!
$ Link/NoMap SWING,SWING/Library
870303:12:53:38
$write sys$error "extract SHAR.COM"
$copy sys$input SHAR.COM
$deck/dollars="870303:12:53:38"
$ VMS_shar aaa*.*,*.hlp,*.com,*.for,*.cmn,*.txt swing.shar
870303:12:53:38
$write sys$error "extract SWING.COM"
$copy sys$input SWING.COM
$deck/dollars="870303:12:53:38"
$! This is my procedure to run SWING, the line in my LOGIN.COM file reads:
$! SWING:=="@COM_LIB:SWING"
$!
$ Define/User SYS$INPUT SYS$COMMAND
$ Run COM_LIB:SWING
$!
$! My procedure SDS needs to be run to update its stack.
$ If "''SD_SP'".eqs."" then goto 10 ! did we run SDS before?
$ SDS
$ Exit ! We exit here because SDS does a check for D_PCD itself.
$!
$! Check whether we want our PROMPT line set.
$10: If "''DO_PCD'" then PCD
870303:12:53:38
$write sys$error "extract ADD_NODE.FOR"
$copy sys$input ADD_NODE.FOR
$deck/dollars="870303:12:53:38"
subroutine add_node( new_dir, parent )
include 'swing.cmn/List'
character new_dir*42, spec*255
integer parent, len, new_node, free_node, ii
logical greater
call str$trim( new_dir, new_dir, len )
spec = node(parent).spec(1:node(parent).length)//
. new_dir(1:len)//'.DIR;1'
new_node = free_node()
call file_to_dir( spec,
. node(new_node).spec,
. node(new_node).length,
. node(new_node).name )
if ( node(parent).child .eq. 0 ) then
node(parent).child = new_node
else
ii = node(parent).child
if ( node(new_node).name .lt. node(ii).name ) then
node(new_node).sister = node(parent).child
node(parent).child = new_node
else
greater = .true.
do while ( greater )
if ( node(ii).sister .eq. 0 ) then
node(ii).sister = new_node
greater = .false.
else
jj = ii
ii = node(ii).sister
if ( node(new_node).name .lt. node(ii).name ) then
node(jj).sister = new_node
node(new_node).sister = ii
greater = .false.
end if
end if
end do
end if
end if
return
end
870303:12:53:38
$write sys$error "extract ADD_NODE_TO_DISPLAY.FOR"
$copy sys$input ADD_NODE_TO_DISPLAY.FOR
$deck/dollars="870303:12:53:38"
subroutine add_node_to_display( num )
include '($smgdef)/List'
include 'swing.cmn/List'
integer column, num
node(num).rend = smg$m_reverse
level = node(num).level
column = level * 17 + 1
line = node(num).line
call smg$put_chars( window2, node(num).name, line, column,,
. node(num).rend )
call smg$draw_line( window2, line, column-3, line, column-1 )
if ( level .eq. last_level ) then
call smg$draw_line( window2, line-1, column-3, line, column-3 )
else if ( level .eq. last_level + 1 ) then
call smg$draw_line( window2, line, column-5, line, column-2 )
else if ( level .lt. last_level ) then
call smg$draw_line( window2, last_line(level), column-3,
. line, column-3 )
end if
if ( .not. found .and. root .eq. node(num).spec ) then
found = .true.
cur_line = line
cur_level = level
end if
last_level = level
last_line(level) = line
return
end
870303:12:53:38
$write sys$error "extract ADJUST_NODE_POINTERS.FOR"
$copy sys$input ADJUST_NODE_POINTERS.FOR
$deck/dollars="870303:12:53:38"
subroutine adjust_node_pointers
include '($smgdef)/List'
include 'swing.cmn/List'
integer ll, jj, ptr(0:7)
do ll = 1, MAX_LINES
do jj = 0, MAX_LEVELS
node_pointer(jj,ll) = 0
end do
end do
do jj = 0, MAX_LEVELS
ptr(jj) = 0
end do
ll = 1 !LINE
ptr(0) = 1
node_pointer(0,ll) = 1
ptr(1) = node(ptr(0)).child
do while( ptr(1) .ne. 0 )
node_pointer(1,ll) = ptr(1)
node(ptr(1)).line = ll
node(ptr(1)).level = 1
ptr(2) = node(ptr(1)).child
do while( ptr(2) .ne. 0 )
node_pointer(2,ll) = ptr(2)
node(ptr(2)).line = ll
node(ptr(2)).level = 2
ptr(3) = node(ptr(2)).child
do while( ptr(3) .ne. 0 )
node_pointer(3,ll) = ptr(3)
node(ptr(3)).line = ll
node(ptr(3)).level = 3
ptr(4) = node(ptr(3)).child
do while( ptr(4) .ne. 0 )
node_pointer(4,ll) = ptr(4)
node(ptr(4)).line = ll
node(ptr(4)).level = 4
ptr(5) = node(ptr(4)).child
do while( ptr(5) .ne. 0 )
node_pointer(5,ll) = ptr(5)
node(ptr(5)).line = ll
node(ptr(5)).level = 5
ptr(6) = node(ptr(5)).child
do while( ptr(6) .ne. 0 )
node_pointer(6,ll) = ptr(6)
node(ptr(6)).line = ll
node(ptr(6)).level = 6
ptr(7) = node(ptr(6)).child
do while( ptr(7) .ne. 0 )
node_pointer(7,ll) = ptr(7)
node(ptr(7)).line = ll
node(ptr(7)).level = 7
ptr(7) = node(ptr(7)).sister
if ( ptr(7) .ne. 0 ) ll = ll + 1
end do
ptr(6) = node(ptr(6)).sister
if ( ptr(6) .ne. 0 ) ll = ll + 1
end do
ptr(5) = node(ptr(5)).sister
if ( ptr(5) .ne. 0 ) ll = ll + 1
end do
ptr(4) = node(ptr(4)).sister
if ( ptr(4) .ne. 0 ) ll = ll + 1
end do
ptr(3) = node(ptr(3)).sister
if ( ptr(3) .ne. 0 ) ll = ll + 1
end do
ptr(2) = node(ptr(2)).sister
if ( ptr(2) .ne. 0 ) ll = ll + 1
end do
ptr(1) = node(ptr(1)).sister
if ( ptr(1) .ne. 0 ) ll = ll + 1
end do
lowest_level = 0
do ii = 1, num_nodes
if ( node(ii).level .gt. lowest_level )
. lowest_level = node(ii).level
end do
if ( lowest_level .gt. 7 ) then
call print_message( 'Directory nesting is to deep', 1 )
end if
num_lines = ll
return
end
870303:12:53:38
$write sys$error "extract APPEND_NODE.FOR"
$copy sys$input APPEND_NODE.FOR
$deck/dollars="870303:12:53:38"
subroutine append_node( level, spec, search )
include 'swing.cmn/List'
integer level, len_node, free_node
character spec*255, search*255
node_num = free_node()
if ( level .gt. lowest_level ) lowest_level = level
if ( level .le. last_level ) then
line = line + 1
num_lines = line
node(last_node(level)).sister = node_num
else
node(node_num-1).child = node_num
end if
if ( level .ne. 0 ) then
call file_to_dir( spec,
. node(node_num).spec,
. node(node_num).length,
. node(node_num).name )
else
call str$trim( spec, spec, len_node )
node(node_num).spec = spec
node(node_num).length = len_node
if ( len_node .le. 10 ) then
node(node_num).name = spec
else
node(node_num).name = spec(:11)//'*'
end if
end if
node(node_num).line = line
node(node_num).level = level
node(node_num).rend = smg$m_reverse
node_pointer(level,line) = node_num
search = node(node_num).spec(1:node(node_num).length)//'*.dir;1'
last_level = level
last_node(level) = node_num
return
end
870303:12:53:38
$write sys$error "extract CHANGE_OPTIONS.FOR"
$copy sys$input CHANGE_OPTIONS.FOR
$deck/dollars="870303:12:53:38"
subroutine change_options( code )
include 'swing.cmn/List'
integer code
if ( code .eq. 71 ) then
use_window1 = .not. use_window1
end if
if ( .not. use_window1 ) then
call smg$erase_display( window1 )
else
call update_window1
end if
return
end
870303:12:53:38
$write sys$error "extract CHANGE_SPEC.FOR"
$copy sys$input CHANGE_SPEC.FOR
$deck/dollars="870303:12:53:38"
subroutine change_spec( parent, ptr )
include 'swing.cmn/List'
character spec*255
integer len, parent, ptr, jj
jj = node(ptr).length - 1
ii = jj
do while ( ii .gt. 1 .and.
. node(ptr).spec(ii:ii) .ne. '[' .and.
. node(ptr).spec(ii:ii) .ne. '.' )
ii = ii - 1
end do
ii = ii + 1
spec = node(parent).spec(1:node(parent).length)//
. node(ptr).spec(ii:jj)//'.DIR;1'
call file_to_dir( spec,
. node(ptr).spec,
. node(ptr).length,
. node(ptr).name )
return
end
870303:12:53:38u3369429@seismo.CSS.GOV@murdu.OZ.AU (03/03/87)
$write sys$error "extract CHECK_DIRECTORY_MOVE.FOR"
$copy sys$input CHECK_DIRECTORY_MOVE.FOR
$deck/dollars="870303:12:53:38"
logical function check_directory_move( from_num, cur_num )
include 'swing.cmn/List'
integer from_num, cur_num, from_levels, ptr(0:7)
from_levels = 1
ptr(0) = from_num
ptr(1) = node(ptr(0)).child
do while( ptr(1) .ne. 0 )
if ( from_levels .lt. 2 ) from_levels = 2
ptr(2) = node(ptr(1)).child
do while( ptr(2) .ne. 0 )
if ( from_levels .lt. 3 ) from_levels = 3
ptr(3) = node(ptr(2)).child
do while( ptr(3) .ne. 0 )
if ( from_levels .lt. 4 ) from_levels = 4
ptr(4) = node(ptr(3)).child
do while( ptr(4) .ne. 0 )
if ( from_levels .lt. 5 ) from_levels = 5
ptr(5) = node(ptr(4)).child
do while( ptr(5) .ne. 0 )
if ( from_levels .lt. 6 ) from_levels = 6
ptr(6) = node(ptr(5)).child
do while( ptr(6) .ne. 0 )
if ( from_levels .lt. 7 ) from_levels = 7
ptr(7) = node(ptr(6)).child
do while( ptr(7) .ne. 0 )
if ( from_levels .lt. 8 ) from_levels = 8
ptr(7) = node(ptr(7)).sister
end do
ptr(6) = node(ptr(6)).sister
end do
ptr(5) = node(ptr(5)).sister
end do
ptr(4) = node(ptr(4)).sister
end do
ptr(3) = node(ptr(3)).sister
end do
ptr(2) = node(ptr(2)).sister
end do
ptr(1) = node(ptr(1)).sister
end do
if ( node(cur_num).level + from_levels .gt. 7 ) then
check_directory_move = .false.
else
check_directory_move = .true.
end if
return
end
870303:12:53:38
$write sys$error "extract CREATE_DIRECTORY.FOR"
$copy sys$input CREATE_DIRECTORY.FOR
$deck/dollars="870303:12:53:38"
subroutine create_directory( code )
include 'swing.cmn/List'
include '($ssdef)/List'
character new_dir*42, term*5, string*39, message*255
integer iterm, len_string, lib$create_dir
integer sys$getmsg, istat, len_message, code
call print_message( ' ', 0 )
call smg$set_cursor_abs( window3, 1, 1 )
call smg$read_string( keyboard, string,
. 'New subdirectory name: ',
. 39,,,,len_string,, window3 )
new_dir = ' '
jj = 0
do ii = 1, len_string
if ( string(ii:ii) .ne. '[' .and. string(ii:ii) .ne. ']' .and.
. string(ii:ii) .ne. '.' .and. string(ii:ii) .gt. ' ' ) then
jj = jj + 1
new_dir(jj:jj) = string(ii:ii)
end if
end do
call str$upcase( new_dir, new_dir )
if ( jj .ne. 0 ) then
istat = lib$create_dir( '[.'//new_dir(1:jj)//']' )
if ( istat .eq. ss$_created ) then
do_save = .true.
call add_node( new_dir(1:jj), node_num )
call adjust_node_pointers
call load_display
call update_screen( cur_line, cur_level )
call print_message( 'Created new subdirectory', 0 )
else if ( .not. istat ) then
call sys$getmsg( %val(istat), len_message, message,
. %val(1), )
call print_message( message(1:len_message), 0 )
else
call smg$erase_display( window3 )
end if
else
call smg$erase_display( window3 )
end if
return
end
870303:12:53:38
$write sys$error "extract CRT.FOR"
$copy sys$input CRT.FOR
$deck/dollars="870303:12:53:38"
logical function crt
include '($dvidef)/List'
include '($ttdef)/List'
include '($tt2def)/List'
include 'swing.cmn/List'
integer*2 b2(14)
integer*4 b4(7), buf, len_buf, sys$trnlog, sys$getdvi, dev_type
logical*4 for$bjtest, istat
equivalence ( b4(1), b2(1) )
b2(1) = 4
b2(2) = dvi$_devdepend2
b4(2) = %loc( buf )
b4(3) = %loc( len_buf )
b2(7) = 4
b2(8) = dvi$_devtype
b4(5) = %loc( dev_type )
b4(6) = %loc( len_dev_type )
b4(7) = 0
istat = sys$getdviw( ,, 'SYS$COMMAND', b4,,,, )
crt = ( for$bjtest( buf, tt2$v_deccrt ) .or.
. dev_type .eq. tt$_vt52 )
avo = for$bjtest( buf, tt2$v_avo )
return
end
870303:12:53:38
$write sys$error "extract DEFINE_PASTE_BOARD.FOR"
$copy sys$input DEFINE_PASTE_BOARD.FOR
$deck/dollars="870303:12:53:38"
subroutine define_paste_board
include '($smgdef)/List'
include 'swing.cmn/List'
C DEC FORGOT THIS PARAMETER IN $SMGDEF
parameter SMG$S_PASTEBOARD_INFO_BLOCK = '20'x
integer smg$create_pasteboard
integer smg$create_virtual_keyboard
integer smg$set_keypad_mode
integer smg$get_pasteboard_attributes
record /smgdef/ table
call set_notab( 'SYS$COMMAND', set_term_buf )
istat = smg$create_pasteboard( board_id )
istat = smg$get_pasteboard_attributes(board_id, %ref(table),
. %ref(SMG$S_PASTEBOARD_INFO_BLOCK))
width = table.smg$w_width
istat = smg$create_virtual_keyboard( keyboard )
istat = smg$set_keypad_mode( keyboard, 1 )
call sm_allow_repaint
return
end
870303:12:53:38
$write sys$error "extract DEFINE_SMG_LAYOUT.FOR"
$copy sys$input DEFINE_SMG_LAYOUT.FOR
$deck/dollars="870303:12:53:38"
subroutine define_smg_layout
include '($smgdef)/List'
include 'swing.cmn/List'
integer smg$create_virtual_display
record /pd_choice_type/ sub_choices(9)
call define_paste_board
c CREATE THE WINDOWS
istat = smg$create_virtual_display( 1, 132, window1 )
istat = smg$create_virtual_display( MAX_LINES, 132, window2 )
istat = smg$create_virtual_display( 2, 132, window3 )
pull_choices.number = 9
pull_choices.choice(1) = 'Create'
pull_choices.code(1) = 10
pull_choices.ptr(1) = 0
pull_choices.choice(2) = 'Rename'
pull_choices.code(2) = 20
pull_choices.ptr(2) = 0
pull_choices.choice(3) = 'Move'
pull_choices.code(3) = 30
pull_choices.ptr(3) = 0
pull_choices.choice(4) = 'Delete'
pull_choices.code(4) = 40
pull_choices.ptr(4) = 0
pull_choices.choice(5) = 'Print'
pull_choices.code(5) = 50
pull_choices.ptr(5) = 0
pull_choices.choice(6) = 'Save'
pull_choices.code(6) = 60
pull_choices.ptr(6) = 0
pull_choices.choice(7) = 'Options'
pull_choices.code(7) = 70
pull_choices.ptr(7) = %loc( sub_choices(7) )
pull_choices.choice(8) = 'Help'
pull_choices.code(8) = 80
pull_choices.ptr(8) = 0
pull_choices.choice(9) = 'Exit'
pull_choices.code(9) = 90
pull_choices.ptr(9) = %loc( sub_choices(9) )
sub_choices(1).number = 0
sub_choices(2).number = 0
sub_choices(3).number = 0
sub_choices(4).number = 0
sub_choices(5).number = 0
sub_choices(6).number = 0
sub_choices(7).number = 1
sub_choices(7).choice(1) = 'display directory'
sub_choices(7).code(1) = 71
sub_choices(8).number = 0
sub_choices(9).number = 2
sub_choices(9).choice(1) = 'ok exit'
sub_choices(9).code(1) = 91
sub_choices(9).choice(2) = 'cancel'
sub_choices(9).code(2) = 92
call pd_load_bar( width, pull_choices)
use_window1 = .false.
return
end
870303:12:53:38
$write sys$error "extract DELETE_DIRECTORY.FOR"
$copy sys$input DELETE_DIRECTORY.FOR
$deck/dollars="870303:12:53:38"
subroutine delete_directory( code )
include 'swing.cmn/List'
include '($ssdef)/List'
character spec(0:MAX_LEVELS)*255, search(0:MAX_LEVELS)*255
character term*5, string*3, message*255, name*50
integer iterm, len_string, code
integer sys$getmsg, istat, len_message, len(0:MAX_LEVELS)
!!! integer icont(MAX_LEVELS), lib$find_file, ii ! Michael Bednarek changed to:
integer icont(0:MAX_LEVELS), lib$find_file, ii
logical found_node
call print_message( ' ', 0 )
call smg$set_cursor_abs( window3, 1, 1 )
call smg$read_string( keyboard, string,
. 'Enter YES to to delete this direc'//
. 'tory and all directories below it: ',
. 3,,,,len_string,, window3 )
call str$upcase( string, string )
if ( string .eq. 'YES' ) then
do_save = .true.
call print_message('Deleting current directory structure...',0)
delete_problem = .false.
search(0)=node(node_num).spec(1:node(node_num).length)//'*.dir'
icont(0) = 0
do while ( lib$find_file( search(0), spec(0), icont(0) ) )
call file_to_dir( spec(0), search(1), len(1), name )
search(1) = search(1)(1:len(1))//'*.dir'
icont(1) = 0
do while ( lib$find_file( search(1), spec(1), icont(1) ) )
call file_to_dir( spec(1), search(2), len(2), name )
search(2) = search(2)(1:len(2))//'*.dir'
icont(2) = 0
do while ( lib$find_file( search(2), spec(2), icont(2) ) )
call file_to_dir( spec(2), search(3), len(3), name )
search(3) = search(3)(1:len(3))//'*.dir'
icont(3) = 0
do while ( lib$find_file( search(3), spec(3), icont(3) ) )
call file_to_dir( spec(3), search(4), len(4), name )
search(4) = search(4)(1:len(4))//'*.dir'
icont(4) = 0
do while ( lib$find_file( search(4), spec(4), icont(4) ) )
call file_to_dir( spec(4), search(5), len(5), name )
search(5) = search(5)(1:len(5))//'*.dir'
icont(5) = 0
do while ( lib$find_file( search(5), spec(5), icont(5) ) )
call file_to_dir( spec(5), search(6), len(6), name )
search(6) = search(6)(1:len(6))//'*.dir'
icont(6) = 0
do while ( lib$find_file( search(6), spec(6), icont(6) ))
call file_to_dir( spec(6), search(7), len(7), name )
call delete_files( search(7)(1:len(7)) )
end do
call lib$find_file_end( icont(6) )
call delete_files( search(6)(1:len(6)) )
end do
call lib$find_file_end( icont(5) )
call delete_files( search(5)(1:len(5)) )
end do
call lib$find_file_end( icont(4) )
call delete_files( search(4)(1:len(4)) )
end do
call lib$find_file_end( icont(3) )
call delete_files( search(3)(1:len(3)) )
end do
call lib$find_file_end( icont(2) )
call delete_files( search(2)(1:len(2)) )
end do
call lib$find_file_end( icont(1) )
call delete_files( search(1)(1:len(1)) )
end do
call lib$find_file_end( icont(0) )
call delete_files( search(0)(1:node(node_num).length) )
if ( cur_level .ge. 1 ) then
ii = cur_level - 1
jj = cur_line
do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 )
jj = jj - 1
end do
if ( jj .ge. 1 ) then
node_num = node_pointer(ii,jj)
else
node_num = 1
end if
else
node_num = 1
end if
call adjust_node_pointers
call load_display
cur_level = node(node_num).level
cur_line = node(node_num).line
call update_screen( cur_line, cur_level )
if ( delete_problem ) then
call print_message( 'Attempted to delete subdirectory - '//
. 'but some files could not be deleted', 0 )
else
call print_message( 'Deleted subdirectory structure', 0 )
end if
else
call print_message( 'No directories deleted', 0 )
end if
return
end
870303:12:53:38
$write sys$error "extract DELETE_FILES.FOR"
$copy sys$input DELETE_FILES.FOR
$deck/dollars="870303:12:53:38"
subroutine delete_files( dir_spec )
include 'swing.cmn/List'
include '($smgdef)/List'
integer icontext, lib$delete_file, modify_file_prot, ptr
character dir_spec*(*), spec*255
logical find_node, found_node
ii = len( dir_spec )
do while ( dir_spec(ii:ii) .eq. ' ' .and. ii .gt. 0 )
ii = ii - 1
end do
if ( find_node( dir_spec(1:ii), ptr ) ) then
found_node = .true.
call smg$change_rendition( window2, node(ptr).line,
. node(ptr).level*17+1,
. 1, 12,
. smg$m_blink + node(ptr).rend )
else
found_node = .false.
end if
icontext = 0
do while( lib$find_file( dir_spec(:ii)//'*.*;*', spec, icontext ))
if ( .not. lib$delete_file( spec ) ) then
call str$trim( spec, spec, len_spec )
if ( modify_file_prot( spec(1:len_spec), 0, 0 ) ) then
istat = lib$delete_file( spec )
if ( .not. istat ) delete_problem = .true.
else
call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
. dir_spec(:ii)//'*.*;*', 'NL:', 'NL:' )
istat = lib$delete_file( spec )
if ( .not. istat ) delete_problem = .true.
end if
end if
end do
call lib$find_file_end( icontext )
call dir_to_file( dir_spec, ii,
. spec, ipos )
if ( .not. lib$delete_file( spec ) ) then
call str$trim( spec, spec, len_spec )
if ( modify_file_prot( spec(1:len_spec), 0, 0 ) ) then
istat = lib$delete_file( spec )
if ( .not. istat ) delete_problem = .true.
else
call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
. dir_spec(:ii)//'*.*;*', 'NL:', 'NL:' )
istat = lib$delete_file( dir_spec(1:ii) )
if ( .not. istat ) delete_problem = .true.
end if
end if
if ( .not. delete_problem ) then
if ( found_node ) call delete_node( ptr )
else
if ( found_node )
. call smg$change_rendition( window2, node(ptr).line,
. node(ptr).level*17+1,
. 1, 12,
. node(ptr).rend )
end if
return
end
870303:12:53:38
$write sys$error "extract DELETE_NODE.FOR"
$copy sys$input DELETE_NODE.FOR
$deck/dollars="870303:12:53:38"
subroutine delete_node( ptr )
include 'swing.cmn/List'
include '($smgdef)/List'
logical found_node
integer ptr, ii
found_node = .false.
ii = 1
do while ( .not. found_node .and. ii .le. num_nodes )
if ( node(ii).sister .eq. ptr ) then
found_node = .true.
node(ii).sister = node(ptr).sister
else if ( node(ii).child .eq. ptr ) then
found_node = .true.
node(ii).child = node(ptr).sister
end if
ii = ii + 1
end do
if ( found_node ) then
node(ptr).name = ' '
call smg$put_chars( window2, node(ptr).name,
. node(ptr).line,
. node(ptr).level * 17 + 1,,
. node(ptr).rend )
node(ptr).level = 0
node(ptr).length = 0
node(ptr).sister = 0
node(ptr).child = 0
end if
return
end
870303:12:53:38
$write sys$error "extract DIR_TO_FILE.FOR"
$copy sys$input DIR_TO_FILE.FOR
$deck/dollars="870303:12:53:38"
logical function dir_to_file( dir, len_dir, file, ipos )
character dir*(*), file*(*)
integer len_dir, ii, ipos
ii = len_dir
do while ( dir(ii:ii) .ne. '.' .and. ii .gt. 0 )
ii = ii - 1
end do
if ( ii .ne. 0 ) then
dir_to_file = .true.
file = dir
file(ii:ii) = ']'
file(len_dir:) = '.dir;1'
ipos = ii
else
call print_message( 'Operation not allowed on main directory',
. 0 )
dir_to_file = .false.
end if
return
end
870303:12:53:38
$write sys$error "extract DRAW_SCREEN.FOR"
$copy sys$input DRAW_SCREEN.FOR
$deck/dollars="870303:12:53:38"
subroutine draw_screen
include '($smgdef)/List'
include 'swing.cmn/List'
integer ii, jj, kk, smg$change_pbd_characteristics
integer smg$change_rendition
call smg$begin_pasteboard_update( board_id )
call smg$paste_virtual_display( window2, board_id, 3, 1 )
call smg$paste_virtual_display( window1, board_id, 2, 1 )
call smg$paste_virtual_display( window3, board_id, 23, 1 )
call smg$set_display_scroll_region( window3, 1, 2 )
call pd_draw_bar( board_id )
top_line = 1
bottom_line = 20
node_num = node_pointer( cur_level, cur_line )
call smg$change_rendition( window2, cur_line, cur_level*17+1,
. 1, 12,
. smg$m_bold + node(node_num).rend )
if ( cur_line .gt. bottom_line ) then
top_line = cur_line - 19
bottom_line = cur_line
call smg$move_virtual_display( window2, board_id,
. 23 - cur_line, 1 )
else if ( cur_line .lt. top_line ) then
top_line = cur_line
bottom_line = cur_line + 19
call smg$move_virtual_display( window2, board_id,
. cur_line, 1 )
end if
call update_window1
call smg$end_pasteboard_update( board_id )
call smg$set_cursor_abs( window2, cur_line, cur_level*17+1 )
update = .true.
return
end
870303:12:53:38
$write sys$error "extract EXIT_SWING.FOR"
$copy sys$input EXIT_SWING.FOR
$deck/dollars="870303:12:53:38"
subroutine exit_swing
include 'swing.cmn/List'
character string*3
integer len_string
if ( do_save .and. swing_file_exists ) then
call record_structure( .false. )
end if
call smg$delete_pasteboard( board_id, 1 )
call smg$change_pbd_characteristics( board_id, 80,, 24 )
call reset_terminal( 'SYS$COMMAND', set_term_buf )
stop ' '
end
870303:12:53:38
$write sys$error "extract FILE_TO_DIR.FOR"
$copy sys$input FILE_TO_DIR.FOR
$deck/dollars="870303:12:53:38"
logical function file_to_dir( file, dir, len_dir, name )
character dir*(*), file*(*), name*(*)
integer len_dir, kk, ii, len_node
kk = 1
do while ( file(kk:kk) .ne. '[' )
kk = kk + 1
end do
dir = file(kk:)
ii = 1
do while ( dir(ii:ii) .ne. ']' )
ii = ii + 1
end do
jj = ii
do while ( dir(jj:jj) .ne. '.' )
jj = jj + 1
end do
dir(ii:ii) = '.'
dir(jj:) = ']'
len_dir = jj
len_node = jj - ii - 1
if ( len_node .le. 9 ) then
name = '['//dir(ii:jj)
else
name = '['//dir(ii:ii+9)//'*'
end if
return
end
870303:12:53:38
$write sys$error "extract FIND_NODE.FOR"
$copy sys$input FIND_NODE.FOR
$deck/dollars="870303:12:53:38"
logical function find_node( dir_spec, ptr )
include 'swing.cmn/List'
character dir_spec*(*)
integer ii, jj, ptr
logical found_node
ii = len( dir_spec )
do while ( dir_spec(ii:ii) .eq. ' ' .and. ii .gt. 0 )
ii = ii - 1
end do
jj = 1
found_node = .false.
do while ( .not. found_node )
if ( node(jj).spec(1:node(jj).length) .eq. dir_spec(1:ii) )then
found_node = .true.
ptr = jj
end if
jj = jj + 1
end do
find_node = found_node
return
end
870303:12:53:38
$write sys$error "extract FREE_NODE.FOR"
$copy sys$input FREE_NODE.FOR
$deck/dollars="870303:12:53:38"
integer function free_node
include 'swing.cmn/List'
integer ii
if ( num_nodes .lt. MAX_NODES ) then
num_nodes = num_nodes + 1
node(num_nodes).length = 0
node(num_nodes).child = 0
node(num_nodes).sister = 0
free_node = num_nodes
else
ii = 1
do while ( ii .le. MAX_NODES )
if ( node(ii).length .eq. 0 ) then
node(ii).length = 0
node(ii).child = 0
node(ii).sister = 0
free_node = ii
return
end if
ii = ii + 1
end do
if ( num_nodes .gt. MAX_NODES .or. num_lines .gt. MAX_LINES )
. call print_message( 'Directory structure is too large', 1 )
end if
return
end
870303:12:53:38
$write sys$error "extract GET_LOCATION.FOR"
$copy sys$input GET_LOCATION.FOR
$deck/dollars="870303:12:53:38"
subroutine get_location( disk, len_disk, root, len_root )
integer*2 len_root
integer*4 sys$setddir, len_disk
character root*255, disk*31
call lib$sys_trnlog( 'SYS$DISK', len_disk, disk )
istat = sys$setddir( 0, len_root, root )
root = root(1:len_root)
return
end
870303:12:53:38
$write sys$error "extract HARDCOPY.FOR"
$copy sys$input HARDCOPY.FOR
$deck/dollars="870303:12:53:38"
subroutine hardcopy( code )
include '($smgdef)/List'
include 'swing.cmn/List'
integer column, num, ii, jj, level, ikey, start, end, len
integer code
character hard_node*12, dashes*12, out_line(MAX_LINES)*132
character one_line*200
data dashes / '------------' /
open( unit=1,
. name='swing.lis',
. carriagecontrol='list',
. status='new',
. err=99 )
call print_message( 'Creating hardcopy listing in SWING.LIS', 0 )
last_level = 1
line = 0
do ii = 0, MAX_LEVELS
last_line(ii) = 1
end do
do ii = 1, num_lines
out_line(ii) = ' '
end do
do jj = 1, num_lines
do level = 0, MAX_LEVELS
if ( node_pointer(level,jj) .ne. 0 ) then
num = node_pointer(level,jj)
column = level * 17 + 1
line = node(num).line
call str$trim( hard_node, node(num).name, len )
if ( level .lt. 7 ) then
if ( node_pointer(level+1,jj) .ne. 0 )
. hard_node = hard_node(1:len)//dashes(len+1:12)
end if
out_line(line)(column:column+11) = hard_node
if ( level .gt. 0 ) then
out_line(line)(column-3:column-1) = '---'
if ( level .le. last_level ) then
out_line(line)(column-3:column-3) = '+'
if ( out_line(line-1)(column-3:column-3) .eq. '+' )
. out_line(line-1)(column-3:column-3) = '|'
else if ( level .eq. last_level + 1 ) then
out_line(line)(column-5:column-2) = '----'
end if
if ( level .lt. last_level ) then
if ( out_line(last_line(level))(column-3:column-3)
. .eq. '+' ) then
ll = last_line(level)
else
ll = last_line(level) + 1
end if
do kk = ll, line-1
out_line(kk)(column-3:column-3) = '|'
end do
end if
end if
last_level = level
last_line(level) = line
end if
end do
end do
do ii = 1, num_lines
call str$trim( out_line(ii), out_line(ii), len )
write( 1, 100 ) out_line(ii)(1:len)
100 format( a )
end do
call print_message( 'Finished creating SWING.LIS',0 )
close( unit=1 )
return
99 call print_message( 'Unable to open file for hardcopy', 0 )
return
end
870303:12:53:38u3369429@seismo.CSS.GOV@murdu.OZ.AU (03/03/87)
$write sys$error "extract HELP.FOR"
$copy sys$input HELP.FOR
$deck/dollars="870303:12:53:38"
subroutine help
include 'swing.cmn/List'
include '($hlpdef)/List'
external LIB$PUT_OUTPUT, LIB$GET_INPUT
integer isave, flags, input, output, stat
integer lbr$output_help
call smg$save_physical_screen( board_id, isave )
!!! The changes in this section allow for private help libraries.
!!! flags = hlp$m_prompt ! Michael Bednarek changed to:
flags = hlp$m_prompt.or.HLP$M_PROCESS
output = %loc( lib$put_output )
input = %loc( lib$get_input )
stat = lbr$output_help( %val(output),
. width,
. 'swing',
. , !!! was 'swing',
. flags,
. %val(input) )
call smg$restore_physical_screen( board_id, isave )
if ( .not. stat ) call print_message('Can''t find help entry for SWING. Sorry.', 0 )
return
end
870303:12:53:38
$write sys$error "extract LOAD_DISPLAY.FOR"
$copy sys$input LOAD_DISPLAY.FOR
$deck/dollars="870303:12:53:38"
subroutine load_display
include '($smgdef)/List'
include 'swing.cmn/List'
integer jj, level
using_screen = .true.
if ( .not. found ) then
cur_level = 0
cur_line = 1
end if
last_level = 0
line = 0
do ii = 0, MAX_LEVELS
last_line(ii) = 1
end do
if ( lowest_level .gt. 4 .and. width .ne. 132 ) then
width = 132
call pd_undraw_bar( board_id )
call smg$erase_display( window1 )
call smg$erase_display( window2 )
call smg$erase_display( window3 )
istat = smg$change_pbd_characteristics( board_id,132,,24 )
call smg$set_display_scroll_region( window3, 1, 2 )
call pd_load_bar( width, pull_choices)
call pd_draw_bar( board_id )
else if ( lowest_level .le. 4 .and. width .ne. 80 ) then
width = 80
call pd_undraw_bar( board_id )
call smg$erase_display( window1 )
call smg$erase_display( window2 )
call smg$erase_display( window3 )
istat = smg$change_pbd_characteristics( board_id,80,,24 )
call smg$set_display_scroll_region( window3, 1, 2 )
call pd_load_bar( width, pull_choices)
call pd_draw_bar( board_id )
end if
call smg$begin_pasteboard_update( board_id )
call smg$erase_display( window2 )
do jj = 1, num_lines
do level = 0, MAX_LEVELS
if ( node_pointer(level,jj) .ne. 0 )
. call add_node_to_display( node_pointer(level,jj) )
end do
end do
c PUT UNDERLINES ON THE LEAF NODES
do jj = 2, num_nodes
do ii = 2, MAX_LEVELS
if ( node_pointer(ii,jj) .ne. 0 .and.
. node_pointer(ii-1,jj) .ne. 0 .and.
. node_pointer(ii,jj-1) .ne. 0 ) then
kk = node_pointer( ii, jj-1 )
node(kk).rend = smg$m_underline + smg$m_reverse
istat = smg$change_rendition( window2, node(kk).line,
. node(kk).level*17+1,
. 1, 12, node(kk).rend )
end if
end do
end do
call smg$end_pasteboard_update( board_id )
if ( .not. found )
. call print_message( 'The current directory was not found in'//
. ' your save file', 0 )
return
end
870303:12:53:38
$write sys$error "extract LOAD_NODES.FOR"
$copy sys$input LOAD_NODES.FOR
$deck/dollars="870303:12:53:38"
subroutine load_nodes
include 'swing.cmn/List'
integer*2 len_root
integer*4 icontext(MAX_LEVELS), lib$find_file,
1 LIB$SYS_TRNLOG,lTR
character input*255, spec*255, search(0:MAX_LEVELS)*255,
1 TR*255
do ii = 1, MAX_LINES
do jj = 0, MAX_LEVELS
node_pointer(jj,ii) = 0
end do
end do
call get_location( disk, len_disk, root, len_root )
found = .false.
lowest_level = 0
last_level = 1
line = 0
num_nodes = 0
node_num = 0
! Added by Michael Bednarek:
! A directory name may be surrounded either by "[]" or "<>".
ii=INDEX(root,'<')
If (ii.ne.0) then
root(ii:ii)='['
ii=INDEX(root,'>')
root(ii:ii)=']'
End If
! Find top-level
ii = 1
do while ( root(ii:ii) .ne. '.' .and. root(ii:ii) .ne. ']')
ii = ii + 1
end do
main = root(:ii-1)//']'
len_main = ii
spec = main
! Michael Bednarek disabled the next statement:
!!! if (main .eq. '[000000]') call print_message('Master file directory not allowed',1)
! Create a file name for the save file (Michael Bednarek)
! The rationale behind this is that I don't want to write the SWING.SAV file
! into other users' directories.
! If the logical name SWING_SAVE exists,
If (LIB$SYS_TRNLOG('SWING_SAVE',lTR,TR,,,%VAL(0)).eq.1) then
! construct a file name like: SWING_SAVE:USERNAME_SWING.SAV
main(1:len_main+10)='SWING_SAVE:'//main(2:len_main-1)//'_'
len_main=len_main+10
End If
ii = 0
if ( .not. update .and. lib$find_file( main(1:len_main)//
. 'swing.sav', input, ii ) ) then
open( unit=1,
. readonly,
. name=main(1:len_main)//'swing.sav',
. status='old',
. carriagecontrol='list',
. access='sequential',
. form='unformatted',
. recl=73,
. organization='sequential',
. recordtype='variable',
. err=99 )
read( 1, err=99 ) num_lines, num_nodes, lowest_level
do ii = 1, num_lines
read( 1, err=99 ) (node_pointer(jj,ii), jj=0,MAX_LEVELS)
end do
do ii = 1, num_nodes
read( 1, err=99 ) node(ii)
end do
close( unit=1 )
swing_file_exists = .true.
else
99 call print_message( 'Searching directory structure...', 0 )
call append_node( 0, spec, search(1) )
icontext(1) = 0
do while ( lib$find_file( search(1), spec, icontext(1) ) )
call append_node( 1, spec, search(2) )
icontext(2) = 0
do while ( lib$find_file( search(2), spec, icontext(2) ) )
call append_node( 2, spec, search(3) )
icontext(3) = 0
do while ( lib$find_file( search(3), spec, icontext(3) ) )
call append_node( 3, spec, search(4) )
icontext(4) = 0
do while ( lib$find_file( search(4), spec, icontext(4) ) )
call append_node( 4, spec, search(5) )
icontext(5) = 0
do while ( lib$find_file( search(5), spec, icontext(5) ) )
call append_node( 5, spec, search(6) )
icontext(6) = 0
do while ( lib$find_file( search(6), spec, icontext(6) ) )
call append_node( 6, spec, search(7) )
icontext(7) = 0
do while ( lib$find_file( search(7), spec, icontext(7) ))
call append_node( 7, spec, search(0) )
end do
call lib$find_file_end( icontext(7) )
end do
call lib$find_file_end( icontext(6) )
end do
call lib$find_file_end( icontext(5) )
end do
call lib$find_file_end( icontext(4) )
end do
call lib$find_file_end( icontext(3) )
end do
call lib$find_file_end( icontext(2) )
end do
call lib$find_file_end( icontext(1) )
end if
return
end
870303:12:53:38
$write sys$error "extract MODIFY_FILE_PROT.FOR"
$copy sys$input MODIFY_FILE_PROT.FOR
$deck/dollars="870303:12:53:38"
INTEGER*4 FUNCTION MODIFY_FILE_PROT ( FILE, PROT, CODE )
C Modifies the protection on a specified file. The file's access
C control list, if it has one, is not modified. The status of the
C operation is returned as a function value.
C This routine will fail if the protection on the file (prior to the
C modification) is such that we do not have read and write access to
C it. It will also fail if the file has already been opened without
C write-shareability.
C Greg Janee, 19-MAR-1986
C-----------------------------------------------------------------------
C Arguments:
C
C FILE type: character string
C access: read only
C mechanism: by descriptor, fixed-length descriptor
C
C The filename of the file whose protection is to be modified. If
C the string is larger than 255 bytes, only the first 255 bytes are
C used.
C
C PROT type: unsigned word
C access: read only
C mechanism: by reference
C
C The bit mask that is to replace or modify the file's protection
C bits. The mask should be specified in the format described by
C section 12.13 of the VAX Record Management Services Reference Man-
C ual.
C
C CODE type: signed longword integer
C access: read only
C mechanism: by reference
C
C The type of modification to be performed on the file's protection
C bits. A value of 0 indicates the bits are to be replaced by the
C PROT argument; values 1, 2, and 3 indicate the bits are to be
C ANDed, inclusive-ORed, or exclusive-ORed with the PROT argument,
C respectively. The protection bits are left unchanged for all
C other values of this argument.
C=======================================================================
IMPLICIT NONE
INCLUDE '($FABDEF)/List'
INCLUDE '($XABDEF)/List'
INCLUDE '($XABPRODEF)/List'
C We have to define our own structure to access a XABPRO because DEC
C is too stupid to define theirs correctly.
STRUCTURE /XABPRO/
UNION
MAP
RECORD /XABDEF/ A
END MAP
MAP
RECORD /XABPRODEF1/ B
END MAP
END UNION
END STRUCTURE
CHARACTER FILE*(*)
INTEGER*2 PROT
INTEGER*4 CODE
RECORD /FABDEF/ FAB
RECORD /XABPRO/ XAB
INTRINSIC JMIN0
INTRINSIC LEN
EXTERNAL LIB$INSV
EXTERNAL LIB$MOVC5
EXTERNAL SYS$CLOSE
INTEGER*4 SYS$CLOSE
EXTERNAL SYS$OPEN
INTEGER*4 SYS$OPEN
C-----------------------------------------------------------------------
C First initialize and link a FAB and XAB. Note that if we do not
C open the file with some sort of write access the protection will
C not be changed.
CALL LIB$MOVC5 ( 0, 0, 0, FAB$C_BLN, FAB )
FAB.FAB$B_BID = FAB$C_BID
FAB.FAB$B_BLN = FAB$C_BLN
FAB.FAB$B_FAC = FAB$M_PUT
FAB.FAB$L_FNA = %LOC( FILE )
CALL LIB$INSV ( JMIN0( LEN(FILE), 255 ), 0, 8, FAB.FAB$B_FNS )
C RMS will balk if the file has been opened by someone else. With
C the following SHR options we'll at least get through the case when
C the file has been opened write-shared.
FAB.FAB$B_SHR = FAB$M_SHRPUT .OR. FAB$M_SHRGET .OR.
. FAB$M_SHRDEL .OR. FAB$M_SHRUPD .OR. FAB$M_UPI
FAB.FAB$L_XAB = %LOC( XAB )
CALL LIB$MOVC5 ( 0, 0, 0, XAB$C_PROLEN, XAB )
XAB.A.XAB$B_BLN = XAB$C_PROLEN
XAB.A.XAB$B_COD = XAB$C_PRO
C-----------------------------------------------------------------------
C There is no RMS service to change file protections. To do so we
C open the file with write access and then close it with a new pro-
C tection mask.
MODIFY_FILE_PROT = SYS$OPEN( FAB )
IF ( .NOT.MODIFY_FILE_PROT ) RETURN
IF ( CODE .EQ. 0 ) THEN
XAB.B.XAB$W_PRO = PROT
ELSEIF ( CODE .EQ. 1 ) THEN
XAB.B.XAB$W_PRO = XAB.B.XAB$W_PRO .AND. PROT
ELSEIF ( CODE .EQ. 2 ) THEN
XAB.B.XAB$W_PRO = XAB.B.XAB$W_PRO .OR. PROT
ELSEIF ( CODE .EQ. 3 ) THEN
XAB.B.XAB$W_PRO = XAB.B.XAB$W_PRO .XOR. PROT
END IF
MODIFY_FILE_PROT = SYS$CLOSE( FAB )
RETURN
C=======================================================================
END
870303:12:53:38
$write sys$error "extract MOVE_NODE.FOR"
$copy sys$input MOVE_NODE.FOR
$deck/dollars="870303:12:53:38"
subroutine move_node( num, parent )
include 'swing.cmn/List'
logical found_node, greater
integer num, ii, jj, parent, ptr(0:7)
found_node = .false.
ii = 1
do while ( .not. found_node .and. ii .le. num_nodes )
if ( node(ii).sister .eq. num ) then
found_node = .true.
node(ii).sister = node(num).sister
else if ( node(ii).child .eq. num ) then
found_node = .true.
node(ii).child = node(num).sister
end if
ii = ii + 1
end do
if ( .not. found_node ) return
node(num).sister = 0
if ( parent .eq. 0 ) then
ii = cur_level - 1
jj = cur_line
do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 )
jj = jj - 1
end do
if ( jj .ge. 1 ) then
parent = node_pointer(ii,jj)
else
parent = 1
end if
end if
if ( node(parent).child .eq. 0 ) then
node(parent).child = num
else
ii = node(parent).child
if ( node(num).name .lt. node(ii).name ) then
node(num).sister = node(parent).child
node(parent).child = num
else
greater = .true.
do while ( greater )
if ( node(ii).sister .eq. 0 ) then
node(ii).sister = num
greater = .false.
else
jj = ii
ii = node(ii).sister
if ( node(num).name .lt. node(ii).name ) then
node(jj).sister = num
node(num).sister = ii
greater = .false.
end if
end if
end do
end if
end if
ptr(0) = num
call change_spec( parent, ptr(0) )
ptr(1) = node(ptr(0)).child
do while( ptr(1) .ne. 0 )
call change_spec( ptr(0), ptr(1) )
ptr(2) = node(ptr(1)).child
do while( ptr(2) .ne. 0 )
call change_spec( ptr(1), ptr(2) )
ptr(3) = node(ptr(2)).child
do while( ptr(3) .ne. 0 )
call change_spec( ptr(2), ptr(3) )
ptr(4) = node(ptr(3)).child
do while( ptr(4) .ne. 0 )
call change_spec( ptr(3), ptr(4) )
ptr(5) = node(ptr(4)).child
do while( ptr(5) .ne. 0 )
call change_spec( ptr(4), ptr(5) )
ptr(6) = node(ptr(5)).child
do while( ptr(6) .ne. 0 )
call change_spec( ptr(5), ptr(6) )
ptr(7) = node(ptr(6)).child
do while( ptr(7) .ne. 0 )
call change_spec( ptr(6), ptr(7) )
ptr(7) = node(ptr(7)).sister
end do
ptr(6) = node(ptr(6)).sister
end do
ptr(5) = node(ptr(5)).sister
end do
ptr(4) = node(ptr(4)).sister
end do
ptr(3) = node(ptr(3)).sister
end do
ptr(2) = node(ptr(2)).sister
end do
ptr(1) = node(ptr(1)).sister
end do
return
end
870303:12:53:38
$write sys$error "extract PD_BAR_CHOICE.FOR"
$copy sys$input PD_BAR_CHOICE.FOR
$deck/dollars="870303:12:53:38"
subroutine pd_bar_choice( keyboard, num_choice, pd_choices )
include '($smgdef)/List'
include 'pulldown.cmn/List'
integer pos, new_pos, key, num_choice, keyboard
logical exit, down
record /pd_choice_type/ pd_choices
exit = .false.
down = .false.
key = 0
new_pos = num_choice
pos = num_choice
C SET THE RENDITION OF THE FIRST CHOICE
ii = 1 + (pd_cell_size*(new_pos-1))
call smg$change_rendition( pd_bar_id, 1, ii, 1,
. pd_cell_size, smg$m_bold )
do while ( key .ne. smg$k_trm_enter .and.
. key .ne. smg$k_trm_cr .and.
. .not. down .and. .not. exit )
call smg$set_cursor_abs( pd_bar_id, 1, 1 )
call smg$read_keystroke( keyboard, key )
if ( key .eq. smg$k_trm_left ) then
if ( pos .gt. 1 ) new_pos = pos - 1
else if ( key .eq. smg$k_trm_right ) then
if ( pos .lt. pd_num_choices ) new_pos = pos + 1
else if ( key .eq. smg$k_trm_down ) then
if ( pd_choices.ptr(pos) .ne. 0 ) down = .true.
else if ( key .eq. smg$k_trm_ctrlz ) then
exit = .true.
end if
if ( new_pos .ne. pos ) then
ii = 1 + (pd_cell_size*(pos-1))
call smg$change_rendition( pd_bar_id, 1, ii, 1,
. pd_cell_size, 0, 0 )
ii = 1 + (pd_cell_size*(new_pos-1))
call smg$change_rendition( pd_bar_id, 1, ii, 1,
. pd_cell_size, smg$m_bold )
end if
pos = new_pos
end do
ii = 1 + (pd_cell_size*(pos-1))
call smg$change_rendition( pd_bar_id, 1, ii, 1,
. pd_cell_size, 0, 0 )
if ( exit ) then
num_choice = 0
else
num_choice = pos
end if
return
end
870303:12:53:38
$write sys$error "extract PD_DRAW_BAR.FOR"
$copy sys$input PD_DRAW_BAR.FOR
$deck/dollars="870303:12:53:38"
subroutine pd_draw_bar( board_id )
* PD_DRAW_BAR( BOARD_ID )
*
* BOARD_ID INTEGER*4
*
include 'pulldown.cmn/List'
integer board_id
call smg$unpaste_virtual_display( pd_bar_id, board_id )
call smg$paste_virtual_display( pd_bar_id, board_id, 1, 1 )
return
end
870303:12:53:38
$write sys$error "extract PD_GET_CHOICE.FOR"
$copy sys$input PD_GET_CHOICE.FOR
$deck/dollars="870303:12:53:38"
*=======================================================================
*
* Title: PULLDOWN PACKAGE
*
* Version: 1-001
*
* Abstract: This is a package of routines to implement a pulldown
* menu system on a VT100 type terminal with SMG routines.
* It is used by SWING
*
* Environment: VMS
*
* Author: Eric Andresen of General Research Corporation
*
* Date: 24-SEP-1986
*
*-----------------------------------------------------------------------
subroutine pd_get_choice( board_id, keyboard, width,
. pd_choices, choice, code )
* PD_GET_CHOICE( BOARD_ID, KEYBOARD, WIDTH, PD_CHOICES, CHOICE, CODE )
*
* BOARD_ID INTEGER*4
* KEYBOARD INTEGER*4
* WIDTH INTEGER*4
* PD_CHOICES RECORD /PD_CHOICE_TYPE/ (PULLDOWN.CMN)
* CHOICE CHARACTER*(PD_MAX_CHOICE_LEN)
* CODE INTEGER*4
*
include 'pulldown.cmn/List'
integer num_choice, save_choice, code, keyboard, width
integer board_id
logical do_bar
character choice*(PD_MAX_CHOICE_LEN)
record /pd_choice_type/ pd_choices
do_bar = .true.
num_choice = 1
C LOOP UNTIL A VALID EXIT OCCURS
do while ( do_bar )
C GET A CHOICE FROM THE BAR
call pd_bar_choice( keyboard, num_choice, pd_choices )
save_choice = 0
do_bar = .false.
C AS LONG AS THE USER IS CHOOSING LISTS FROM THE BAR
do while ( save_choice .ne. num_choice .and.
. pd_choices.ptr(num_choice) .ne. 0 )
save_choice = num_choice
call pd_list_choice( board_id, keyboard, width, num_choice,
. %val(pd_choices.ptr(num_choice)),
. choice, code, do_bar )
end do
C IF A CHOICE HAS BEEN MADE
if ( .not. do_bar ) then
C IF ITS ONLY A CHOICE FROM THE BAR BECAUSE THERE WAS NO
C ASSOCIATED LIST
if ( save_choice .eq. 0 .and. num_choice .ne. 0 ) then
choice = pd_choices.choice(num_choice)
code = pd_choices.code(num_choice)
C IF NO CHOICE WAS MADE
else if ( save_choice .eq.0 .and. num_choice .eq.0 ) then
choice = ' '
code = -1
end if
C OTHERWISE A CHOICE WAS MADE FROM THE CALL TO
C pd_list_choice
end if
end do
return
end
870303:12:53:38u3369429@seismo.CSS.GOV@murdu.OZ.AU (03/03/87)
$write sys$error "extract PD_LIST_CHOICE.FOR"
$copy sys$input PD_LIST_CHOICE.FOR
$deck/dollars="870303:12:53:38"
subroutine pd_list_choice( board_id, keyboard, width, num_choice,
. pd_choices, choice, code, do_bar)
include '($smgdef)/List'
include 'pulldown.cmn/List'
record /pd_choice_type/ pd_choices
integer max_cell, ii, jj, kk, lens(PD_MAX_CHOICES), code
integer start_pos, pd_list_id, atts(PD_MAX_CHOICES), num_choice
integer pos, new_pos, key, width, keyboard, board_id
logical exit, do_bar
character choice*(PD_MAX_CHOICE_LEN)
do_bar = .false.
C FIND OUT HOW MANY CHOICES THERE ARE AND THE MAXIMUM LENGTH
ii = 1
max_cell = 0
do while ( ii .le. pd_choices.number )
call str$trim( pd_choices.choice(ii), pd_choices.choice(ii),
. lens(ii) )
max_cell = max( max_cell, lens(ii) )
ii = ii + 1
end do
ii = ii - 1
C CREATE THE VIRTUAL DISPLAY FOR THE LIST
istat = smg$create_virtual_display( ii, max_cell, pd_list_id,
. smg$m_border, smg$m_reverse )
C PUT THE CHOICES IN THE LIST
do jj = 1, ii
if ( pd_choices.ptr(jj) .eq. 0 ) then
call smg$put_chars( pd_list_id,
. pd_choices.choice(jj)(1:max_cell),
. jj, 1 )
atts(jj) = 0
else
call smg$put_chars( pd_list_id,
. pd_choices.choice(jj)(1:max_cell),
. jj, 1,, smg$m_underline )
atts(jj) = smg$m_underline
end if
end do
start_pos = 1 + (pd_cell_size*(num_choice-1))
if ( start_pos + max_cell .gt. width ) then
start_pos = width - max_cell + 1
end if
call smg$begin_pasteboard_update( board_id )
call smg$paste_virtual_display( pd_list_id, board_id, 2,
. start_pos )
call smg$repaste_virtual_display( pd_bar_id, board_id, 1, 1 )
call smg$end_pasteboard_update( board_id )
C GET A CHOICE FROM THE LIST
exit = .false.
key = 0
pos = 1
new_pos = 1
C SET THE RENDITION OF THE FIRST CHOICE
call smg$change_rendition( pd_list_id, 1, 1, 1,
. max_cell, smg$m_bold + atts(1) )
do while ( key .ne. smg$k_trm_enter .and.
. key .ne. smg$k_trm_cr .and. .not. exit )
call smg$set_cursor_abs( pd_list_id, pos, 1 )
call smg$read_keystroke( keyboard, key )
if ( key .eq. smg$k_trm_up ) then
if ( pos .gt. 1 ) then
new_pos = pos - 1
else
do_bar = .true.
exit = .true.
end if
else if ( key .eq. smg$k_trm_down ) then
if ( pos .lt. ii ) new_pos = pos + 1
else if ( key .eq. smg$k_trm_left ) then
if ( num_choice .gt. 1 ) num_choice = num_choice - 1
do_bar = .true.
exit = .true.
else if ( key .eq. smg$k_trm_right ) then
if ( num_choice .lt. pd_num_choices )
. num_choice = num_choice + 1
do_bar = .true.
exit = .true.
else if ( key .eq. smg$k_trm_ctrlz ) then
exit = .true.
end if
if ( new_pos .ne. pos ) then
call smg$change_rendition( pd_list_id, pos, 1, 1,
. max_cell, atts(pos))
call smg$change_rendition( pd_list_id, new_pos, 1, 1,
. max_cell,
. smg$m_bold+atts(new_pos) )
end if
pos = new_pos
end do
call smg$unpaste_virtual_display( pd_list_id, board_id )
if ( exit ) then
choice = ' '
code = -1
else
choice = pd_choices.choice(pos)
code = pd_choices.code(pos)
end if
return
end
870303:12:53:38
$write sys$error "extract PD_LOAD_BAR.FOR"
$copy sys$input PD_LOAD_BAR.FOR
$deck/dollars="870303:12:53:38"
subroutine pd_load_bar( width, pd_choices )
* PD_LOAD_BAR( WIDTH, PD_CHOICES )
*
* WIDTH INTEGER*4
* PD_CHOICES RECORD /PD_CHOICE_TYPE/ (PULLDOWN.CMN)
*
include '($smgdef)/List'
include 'pulldown.cmn/List'
integer max_cell, ii, jj, kk, lens(PD_MAX_CHOICES)
integer start_pos, off_set, width
record /pd_choice_type/ pd_choices
C FIND OUT HOW MANY CHOICES THERE ARE AND THE MAXIMUM LENGTH
ii = 1
max_cell = 0
do while ( ii .le. pd_choices.number )
call str$trim( pd_choices.choice(ii), pd_choices.choice(ii),
. lens(ii) )
max_cell = max( max_cell, lens(ii) )
ii = ii + 1
end do
ii = ii - 1
C CREATE THE VIRTUAL DISPLAY FOR THE BAR
if ( pd_bar_id .eq. 0 ) then
istat = smg$create_virtual_display( 1, width, pd_bar_id,,
. smg$m_reverse )
else
call smg$erase_display( pd_bar_id )
istat = smg$change_virtual_display( pd_bar_id, 1, width,
. pd_bar_id,, smg$m_reverse )
end if
C FIGURE OUT THE LENGTH OF EACH CELL
C IF THERE IS ROOM ENOUGH FOR ALL OF THE CHOICES AS IS
if ( (ii*max_cell) .le. width ) then
pd_cell_size = min( 16, width / ii )
C MAKE IT 16 OR LESS
else
pd_cell_size = min( 16, width / max_cell )
end if
C PUT THE CHOICES IN THE MENU
do jj = 1, ii
start_pos = 1 + (pd_cell_size*(jj-1))
off_set = max( 1, pd_cell_size-lens(jj)) / 2
call smg$put_chars( pd_bar_id,
. pd_choices.choice(jj)(1:lens(jj)),,
. start_pos + off_set )
end do
pd_num_choices = ii
return
end
870303:12:53:38
$write sys$error "extract PD_UNDRAW_BAR.FOR"
$copy sys$input PD_UNDRAW_BAR.FOR
$deck/dollars="870303:12:53:38"
subroutine pd_undraw_bar( board_id )
* PD_UNDRAW_BAR( BOARD_ID )
*
* BOARD_ID INTEGER*4
*
include 'pulldown.cmn/List'
integer board_id
call smg$unpaste_virtual_display( pd_bar_id, board_id )
return
end
870303:12:53:38
$write sys$error "extract PRINT_MESSAGE.FOR"
$copy sys$input PRINT_MESSAGE.FOR
$deck/dollars="870303:12:53:38"
subroutine print_message( message, abort )
include 'swing.cmn/List'
logical abort, erased
character message*(*)
if ( using_screen ) then
if ( message .eq. ' ' ) then
if ( .not. erased ) then
erased = .true.
call smg$erase_display( window3 )
call smg$erase_line( window3, 2, 1 )
end if
else
erased = .false.
call smg$erase_display( window3 )
call smg$put_chars( window3, message, 2, 1, 1 )
end if
if ( abort ) call exit_swing
else
print *, 'SWING: ', message
if ( abort ) stop ' '
end if
return
end
870303:12:53:38
$write sys$error "extract RECORD_STRUCTURE.FOR"
$copy sys$input RECORD_STRUCTURE.FOR
$deck/dollars="870303:12:53:38"
subroutine record_structure( search )
include 'swing.cmn/List'
character spec*255
logical search
integer icontext
if ( search .and. swing_file_exists ) then
do ii = 1, num_nodes
node(ii).length = 0
node(ii).child = 0
node(ii).sister = 0
end do
call load_nodes
call load_display
call update_screen( cur_line, cur_level )
end if
do_save = .false.
call print_message( 'Saving directory structure', 0 )
icontext = 0
do while( lib$find_file( main(1:len_main)//'swing.sav;*',
. spec, icontext ))
if ( .not. lib$delete_file( spec ) ) then
call str$trim( spec, spec, len_spec )
if ( modify_file_prot( spec(1:len_spec), 0, 0 ) ) then
istat = lib$delete_file( spec )
else
call lib$spawn( 'SET PROT=(S:D,O:D,G:D,W:D) '//
. main(1:len_main)//'swing.sav',
. 'NL:', 'NL:' )
istat = lib$delete_file( spec )
end if
end if
end do
call lib$find_file_end( icontext )
open( unit=2,
. name=main(1:len_main)//'swing.sav',
. status='new',
. carriagecontrol='list',
. access='sequential',
. form='unformatted',
. recl=73,
. organization='sequential',
. recordtype='variable',
. iostat=istat,
. err=99 )
write( 2 ) num_lines, num_nodes, lowest_level
do ii = 1, num_lines
write( 2 ) (node_pointer(jj,ii), jj=0, MAX_LEVELS)
end do
do ii = 1, num_nodes
write( 2 ) node(ii)
end do
close( unit=2 )
call print_message( 'Finished saving directory structure', 0 )
return
99 call print_message( 'Unable to record directory structure', 0 )
return
end
870303:12:53:38
$write sys$error "extract RENAME_DIRECTORY.FOR"
$copy sys$input RENAME_DIRECTORY.FOR
$deck/dollars="870303:12:53:38"
subroutine rename_directory( code )
include 'swing.cmn/List'
include '($ssdef)/List'
include '($smgdef)/List'
character new_dir*42, key, string*39, message*255, file*255
integer ikey, len_string, lib$rename_file, code, parent
integer sys$getmsg, istat, len_message, ipos, from_level
integer old_line, old_level, from_num, from_line
logical dir_to_file, finished, check_directory_move
if ( code .eq. 20 ) then
call print_message( ' ', 0 )
call smg$set_cursor_abs( window3, 1, 1 )
call smg$read_string( keyboard, string,
. 'Enter new name to give directory: ',
. 39,,,,len_string,, window3 )
new_dir = ' '
jj = 0
do ii = 1, len_string
if (string(ii:ii) .ne. '[' .and. string(ii:ii) .ne. ']'.and.
. string(ii:ii) .ne. '.' .and. string(ii:ii) .gt. ' ' .and.
. string(ii:ii) .ne. ';' ) then
jj = jj + 1
new_dir(jj:jj) = string(ii:ii)
end if
end do
call str$upcase( new_dir, new_dir )
if ( jj .ne. 0 ) then
if ( dir_to_file( node(node_num).spec,
. node(node_num).length,
. file, ipos ) ) then
istat = lib$rename_file( file,
. new_dir(1:jj)//'.DIR;1',,,
. 1 )
if ( istat .eq. ss$_normal ) then
call file_to_dir( file(1:ipos)//new_dir(1:jj)//'.DIR',
. node(node_num).spec,
. node(node_num).length,
. node(node_num).name )
parent = 0
call move_node( node_num, parent )
call adjust_node_pointers
call load_display
cur_line = node(node_num).line
cur_level = node(node_num).level
call update_screen( cur_line, cur_level )
call print_message( 'Subdirectory renamed', 0 )
do_save = .true.
else
call sys$getmsg( %val(istat), len_message, message,
. %val(1), )
call print_message( message(1:len_message), 0 )
end if
end if
else
call smg$erase_display( window3 )
end if
else if ( code .eq. 30 ) then
from_num = node_num
from_line = cur_line
from_level = cur_level
node(from_num).rend = smg$m_reverse + smg$m_blink
call smg$change_rendition( window2, from_line, from_level*17+1,
. 1, 12, node(from_num).rend )
call print_message( 'Travel to new parent directory and hit '//
. 'RETURN - Hit any other key to abort', 0 )
call smg$set_cursor_abs( window2, from_line, from_level*17+1 )
finished = .false.
do while ( .not. finished )
call smg$read_keystroke( keyboard, ikey )
old_line = cur_line
old_level = cur_level
old_rend = node(node_num).rend
if ( ikey .eq. smg$k_trm_cr .or.
. ikey .eq. smg$k_trm_enter ) then
finished = .true.
else if ( ikey .eq. smg$k_trm_up ) then
ii = cur_level
jj = cur_line - 1
!!! do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 ) ! Michael Bednarek changed to:
do while (jj.ge.1 .and. node_pointer(ii,jj).eq.0)
jj = jj - 1
end do
if ( jj .ge. 1 ) cur_line = jj
call update_screen( old_line, old_level )
else if ( ikey .eq. smg$k_trm_down ) then
ii = cur_level
jj = cur_line + 1
do while( node_pointer(ii,jj) .eq. 0 .and.
. jj .le. num_lines )
jj = jj + 1
end do
if ( jj .le. num_lines ) cur_line = jj
call update_screen( old_line, old_level )
else if ( ikey .eq. smg$k_trm_right ) then
ii = cur_level + 1
jj = cur_line
do while( node_pointer(ii,jj) .eq. 0 .and.
. ii .le. MAX_LEVELS )
ii = ii + 1
end do
if ( ii .le. MAX_LEVELS ) cur_level = ii
call update_screen( old_line, old_level )
else if ( ikey .eq. smg$k_trm_left .and.
. cur_level .ge. 1 ) then
ii = cur_level - 1
jj = cur_line
do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 )
jj = jj - 1
end do
if ( jj .ge. 1 ) then
cur_level = ii
cur_line = jj
end if
call update_screen( old_line, old_level )
else
finished = .true.
end if
call smg$set_cursor_abs( window2, cur_line, cur_level*17+1 )
end do
node(from_num).rend = smg$m_reverse
call smg$change_rendition( window2, from_line, from_level*17+1,
. 1, 12, node(from_num).rend )
if ( ikey .eq. smg$k_trm_cr .or.
. ikey .eq. smg$k_trm_enter ) then
if ( .not. check_directory_move( from_num, node_num ) ) then
call update_screen( cur_line, cur_level )
call print_message( 'Rename would cause too great a '//
. 'directory depth', 0 )
return
end if
if ( dir_to_file( node(from_num).spec,
. node(from_num).length,
. file, ipos ) ) then
istat = lib$rename_file( file,
. node(node_num).spec(1:node(node_num).length)//
. '*.dir;1',,, 1 )
if ( istat ) then
call move_node( from_num, node_num )
call adjust_node_pointers
call load_display
cur_line = node(from_num).line
cur_level = node(from_num).level
call update_screen( cur_line, cur_level )
call print_message( 'Subdirectory has been moved', 0 )
do_save = .true.
else
call sys$getmsg( %val(istat), len_message, message,
. %val(1), )
call print_message( message(1:len_message), 0 )
end if
end if
else
call smg$erase_display( window3 )
end if
else
call smg$erase_display( window3 )
end if
return
end
870303:12:53:38
$write sys$error "extract RESET_TERMINAL.FOR"
$copy sys$input RESET_TERMINAL.FOR
$deck/dollars="870303:12:53:38"
subroutine reset_terminal( terminal, char_buffer )
C ROUTINE USES THE IO$_SETMODE FUNCTION TO SET TERMINAL
C CHARACTERISTICS
include '($iodef)/List'
c LAYOUT OF char_buffer
c
c --------------------------------------------
c | buffer size | type | class | <- longword
c |page len | terminal characteristics | <- longword (TTDEF)
c | extended terminal characteristics | <- longword (TT2DEF)
c --------------------------------------------
c 31 0
integer*2 iosb(4)
integer*4 status, sys$trnlog, sys$assign, sys$qiow, chan
integer*4 reset, char_buffer(3)
character terminal*(*)
status = sys$assign( terminal, chan,, )
status = sys$qiow ( %val(1),
. %val(chan),
. %val(io$_setmode),
. iosb,,,
. %ref(char_buffer),
. %val(12),,,, )
return
end
870303:12:53:38
$write sys$error "extract SET_NOTAB.FOR"
$copy sys$input SET_NOTAB.FOR
$deck/dollars="870303:12:53:38"
subroutine set_notab( terminal, save_buffer )
C ROUTINE USES THE IO$_SETMODE FUNCTION TO SET TERMINAL
C CHARACTERISTICS
include '($iodef)/List'
include '($ttdef)/List'
include '($tt2def)/List'
c LAYOUT OF char_buffer
c
c --------------------------------------------
c | buffer size | type | class | <- longword
c |page len | terminal characteristics | <- longword (TTDEF)
c | extended terminal characteristics | <- longword (TT2DEF)
c --------------------------------------------
c 31 0
integer*2 iosb(4)
integer*4 status, sys$trnlog, sys$assign, sys$qiow, chan
integer*4 char_buffer(3), save_buffer(3)
character terminal*(*)
status = sys$assign( terminal, chan,, )
stat = sys$qiow ( %val(1),
. %val(chan),
. %val(io$_sensemode),
. iosb,,,
. %Ref(save_buffer),
. %val(12),,,, )
char_buffer(1) = save_buffer(1)
char_buffer(2) = jibclr( save_buffer(2), tt$v_mechtab )
char_buffer(3) = save_buffer(3)
status = sys$qiow ( %val(1),
. %val(chan),
. %val(io$_setmode),
. iosb,,,
. %Ref(char_buffer),
. %val(12),,,, )
return
end
870303:12:53:38
$write sys$error "extract SM_ALLOW_REPAINT.FOR"
$copy sys$input SM_ALLOW_REPAINT.FOR
$deck/dollars="870303:12:53:38"
subroutine sm_allow_repaint
include 'swing.cmn/List'
integer address
external sm_repaint_screen
address = %loc( sm_repaint_screen )
call smg$set_out_of_band_asts( board_id, '800000'x,
. %val(address) )
return
end
870303:12:53:38
$write sys$error "extract SM_REPAINT_SCREEN.FOR"
$copy sys$input SM_REPAINT_SCREEN.FOR
$deck/dollars="870303:12:53:38"
subroutine sm_repaint_screen
include 'swing.cmn/List'
call smg$repaint_screen( board_id )
return
end
870303:12:53:38u3369429@seismo.CSS.GOV@murdu.OZ.AU (03/03/87)
$write sys$error "extract SWING.FOR"
$copy sys$input SWING.FOR
$deck/dollars="870303:12:53:38"
*=======================================================================
*
* Title: SWING
*
* Version: 1-001
*
* Abstract: SWING is a VMS utility for displaying and manipulating
* VMS directory trees.
*
* Environment: VMS
*
* Author: Eric Andresen of General Research Corporation
*
* Date: 24-SEP-1986
*
*-----------------------------------------------------------------------
program swing
include '($smgdef)/List'
include 'swing.cmn/List'
integer ikey, old_level, old_line, isave, code, code_type
logical crt, finished
character key, choice*(PD_MAX_CHOICE_LEN)
if ( .not. crt() )
. call print_message( 'You must use a DEC CRT terminal', 1 )
call load_nodes
call define_smg_layout
call load_display
call draw_screen
do while ( .not. finished )
call smg$read_keystroke( keyboard, ikey )
call print_message( ' ', 0 )
old_line = cur_line
old_level = cur_level
old_rend = node(node_num).rend
if ( ikey .eq. smg$k_trm_do .or. ! Pulldown Menu
. ikey .eq. smg$k_trm_ctrlp ) then
call pd_get_choice( board_id, keyboard, width,
. pull_choices, choice, code )
code_type = code / 10
else
code_type = 0
code = 0
end if
if ( ikey .eq. smg$k_trm_ctrlz .or.
. ikey .eq. smg$k_trm_lowercase_x .or.
. ikey .eq. smg$k_trm_uppercase_x .or.
. ikey .eq. smg$k_trm_lowercase_e .or.
. ikey .eq. smg$k_trm_uppercase_e .or.
1 ikey.eq.SMG$K_TRM_LowerCase_q .or. ! Michael Bednarek
1 ikey.eq.SMG$K_TRM_UpperCase_Q .or. ! added {q,Q,F10,<CR>}
1 ikey.eq.SMG$K_TRM_F10 .or.
. ikey .eq. smg$k_trm_enter .or.
1 ikey.eq.SMG$K_TRM_CR .or.
. code .eq. 91 ) then
finished = .true.
else if ( ikey .eq. smg$k_trm_up ) then
ii = cur_level
jj = cur_line - 1
! find the next line upwards with a node_pointer
!!! do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 ) ! Michael Bednarek changed to:
do while (jj.ge.1 .and. node_pointer(ii,jj).eq.0)
jj = jj - 1
end do
if ( jj .ge. 1 ) cur_line = jj
call update_screen( old_line, old_level )
else if ( ikey .eq. smg$k_trm_down ) then
ii = cur_level
jj = cur_line + 1
do while( node_pointer(ii,jj) .eq. 0 .and.jj .le. num_lines)
jj = jj + 1
end do
if ( jj .le. num_lines ) cur_line = jj
call update_screen( old_line, old_level )
else if ( ikey .eq. smg$k_trm_right ) then
ii = cur_level + 1
jj = cur_line
do while( node_pointer(ii,jj) .eq. 0 .and.ii.le. MAX_LEVELS)
ii = ii + 1
end do
if ( ii .le. MAX_LEVELS ) cur_level = ii
call update_screen( old_line, old_level )
else if ( ikey .eq. smg$k_trm_left .and.
. cur_level .ge. 1 ) then
ii = cur_level - 1
jj = cur_line
do while( node_pointer(ii,jj) .eq. 0 .and. jj .ge. 1 )
jj = jj - 1
end do
if ( jj .ge. 1 ) then
cur_level = ii
cur_line = jj
end if
call update_screen( old_line, old_level )
else if ( code_type .eq. 1 .or.
. ikey .eq. smg$k_trm_lowercase_c .or.
. ikey .eq. smg$k_trm_uppercase_c ) then
call create_directory( code )
else if ( code_type .eq. 2 .or.
. ikey .eq. smg$k_trm_lowercase_r .or.
. ikey .eq. smg$k_trm_uppercase_r ) then
call rename_directory( 20 )
else if ( code_type .eq. 3 .or.
. ikey .eq. smg$k_trm_lowercase_m .or.
. ikey .eq. smg$k_trm_uppercase_m ) then
call rename_directory( 30 )
else if ( code_type .eq. 4 .or.
. ikey .eq. smg$k_trm_lowercase_d .or.
. ikey .eq. smg$k_trm_uppercase_d ) then
call delete_directory( code )
else if ( code_type .eq. 5 .or.
. ikey .eq. smg$k_trm_lowercase_p .or.
. ikey .eq. smg$k_trm_uppercase_p ) then
call hardcopy( code )
else if ( code_type .eq. 6 .or.
. ikey .eq. smg$k_trm_lowercase_s .or.
. ikey .eq. smg$k_trm_uppercase_s ) then
call record_structure( .true. )
else if ( code_type .eq. 7 .or.
. ikey .eq. smg$k_trm_lowercase_o .or.
. ikey .eq. smg$k_trm_uppercase_o ) then
call change_options( 71 )
else if ( code_type .eq. 8 .or.
. ikey .eq. smg$k_trm_pf2 .or.
. ikey .eq. smg$k_trm_help .or.
. ikey .eq. smg$k_trm_lowercase_h .or.
. ikey .eq. smg$k_trm_uppercase_h ) then
call help( code )
end if
call smg$set_cursor_abs( window2, cur_line, cur_level*17+1 )
end do
call exit_swing
end
870303:12:53:38
$write sys$error "extract UPDATE_SCREEN.FOR"
$copy sys$input UPDATE_SCREEN.FOR
$deck/dollars="870303:12:53:38"
subroutine update_screen( old_line, old_level )
include '($smgdef)/List'
include 'swing.cmn/List'
integer old_line, old_level, sys$setddir
node_num = node_pointer( cur_level, cur_line )
call smg$begin_pasteboard_update( board_id )
call smg$change_rendition( window2, old_line, old_level*17+1,
. 1, 12, old_rend )
call smg$change_rendition( window2, cur_line, cur_level*17+1,
. 1, 12,
. smg$m_bold + node(node_num).rend )
call update_window1
call smg$end_pasteboard_update( board_id )
if ( cur_line .gt. bottom_line ) then
do ii = bottom_line+1, cur_line
call smg$move_virtual_display( window2, board_id,23-ii,1)
end do
top_line = cur_line - 19
bottom_line = cur_line
else if ( cur_line .lt. top_line ) then
do ii = top_line-1, cur_line, -1
call smg$move_virtual_display( window2, board_id, 4-ii,1)
end do
top_line = cur_line
bottom_line = cur_line + 19
end if
istat = sys$setddir( node(node_num).spec, %val(0), %val(0) )
return
end
870303:12:53:38
$write sys$error "extract UPDATE_WINDOW1.FOR"
$copy sys$input UPDATE_WINDOW1.FOR
$deck/dollars="870303:12:53:38"
subroutine update_window1
include '($smgdef)/List'
include 'swing.cmn/List'
integer start
if ( use_window1 ) then
start = ( width - (len_disk + node(node_num).length) ) / 2
if ( start .le. 0 ) start = 1
call smg$erase_line( window1, 1, 1 )
call smg$put_chars( window1,
. disk(1:len_disk)//
. node(node_num).spec(1:node(node_num).length),
. 1, start,, smg$m_underline )
end if
return
end
870303:12:53:38
$write sys$error "extract PULLDOWN.CMN"
$copy sys$input PULLDOWN.CMN
$deck/dollars="870303:12:53:38"
*=======================================================================
* COMMONS FOR PULLDOWN.FOR
*=======================================================================
C CONSTRAINTS
parameter PD_MAX_CHOICES=10
parameter PD_MAX_CHOICE_LEN=20
C THE PULL DOWN CHOICE STRUCTURE
structure /pd_choice_type/
integer number
character*(PD_MAX_CHOICE_LEN) choice(PD_MAX_CHOICES)
integer code(PD_MAX_CHOICES)
integer ptr(PD_MAX_CHOICES)
end structure
C PULL DOWN SCREEN INFORMATION
integer pd_bar_id,pd_num_choices,pd_cell_size
common /pd_common/ pd_bar_id, ! BAR DISPLAY ID
1 pd_num_choices, ! NUMBER OF POSSIBLE CHOICES
1 pd_cell_size ! LENGTH OF EACH CELL IN THE BAR
870303:12:53:38
$write sys$error "extract SWING.CMN"
$copy sys$input SWING.CMN
$deck/dollars="870303:12:53:38"
*=======================================================================
* COMMONS FOR SWING.FOR
*=======================================================================
include 'pulldown.cmn/List'
parameter MAX_LINES = 300
parameter MAX_LEVELS = 7
parameter MAX_NODES = 600
integer line,last_level,last_line(0:MAX_LEVELS)
integer last_node(0:MAX_LEVELS)
integer node_pointer(0:MAX_LEVELS,MAX_LINES),lowest_level
integer node_num,num_nodes,num_lines
structure /node_type/
character*255 spec
character*12 name
integer*4 length
integer*4 level
integer*4 line
integer*4 rend
integer*4 child
integer*4 sister
end structure
!!! record /node_type/ node(MAX_NODES) ! Michael Bednarek changed to :
record /node_type/ node(0:MAX_NODES)
common /node_info/ line,
1 last_level,
1 lowest_level,
1 last_line,
1 last_node,
1 num_lines,
1 node_pointer,
1 node,
1 node_num,
1 num_nodes
integer window1,window2,window3,board_id,set_term_buf(3)
integer width,cur_level,cur_line,bottom_line,top_line
integer old_rend,len_disk,len_main,keyboard
logical avo,using_screen,found,update,delete_problem
logical use_window1,do_save,swing_file_exists
character this_terminal*31,disk*31,root*255,main*50
record /pd_choice_type/ pull_choices
common /smg_info/ board_id,
1 keyboard,
1 window1,
1 window2,
1 window3,
1 pull_choices,
1 this_terminal,
1 set_term_buf,
1 width,
1 avo,
1 old_rend,
1 disk,
1 len_disk,
1 root,
1 main,
1 len_main,
1 cur_level,
1 cur_line,
1 top_line,
1 bottom_line,
1 using_screen,
1 use_window1,
1 update,
1 found,
1 delete_problem,
1 do_save,
1 swing_file_exists
870303:12:53:38u3369429@seismo.CSS.GOV@murdu.OZ.AU (03/03/87)
$write sys$error "extract SMGDEF.TXT" $copy sys$input SMGDEF.TXT $deck/dollars="870303:12:53:38" ! This is for you poor souls without a proper $SMGDEF in SYS$LIBRARY:FORSYSDEF.TLB ! CHECK YOUR SITUATION ! ! ******************************************************************************************************************************** ! Created 27-FEB-1987 09:42:43 by VAX-11 SDL V2.0 Source: 27-FEB-1987 09:40:35 SYS_SYSROOT:[TEMP]SMGGEN.SDL;1 ! ******************************************************************************************************************************** !*** MODULE $SMGDEF *** ! Definitions for RTL Screen Management ! ! Input terminator codes ! ! Control characters PARAMETER SMG$K_TRM_CTRLA = '00000001'X ! SOH PARAMETER SMG$K_TRM_CTRLB = '00000002'X ! STX PARAMETER SMG$K_TRM_CTRLC = '00000003'X ! ETX PARAMETER SMG$K_TRM_CTRLD = '00000004'X ! EOT PARAMETER SMG$K_TRM_CTRLE = '00000005'X ! ENQ PARAMETER SMG$K_TRM_CTRLF = '00000006'X ! ACK PARAMETER SMG$K_TRM_CTRLG = '00000007'X ! BEL PARAMETER SMG$K_TRM_CTRLH = '00000008'X ! BS PARAMETER SMG$K_TRM_CTRLI = '00000009'X ! HT PARAMETER SMG$K_TRM_CTRLJ = '0000000A'X ! LF PARAMETER SMG$K_TRM_CTRLK = '0000000B'X ! VT PARAMETER SMG$K_TRM_CTRLL = '0000000C'X ! FF PARAMETER SMG$K_TRM_CTRLM = '0000000D'X ! CR PARAMETER SMG$K_TRM_CTRLN = '0000000E'X ! SO PARAMETER SMG$K_TRM_CTRLO = '0000000F'X ! SI PARAMETER SMG$K_TRM_CTRLP = '00000010'X ! DLE PARAMETER SMG$K_TRM_CTRLQ = '00000011'X ! DC1 PARAMETER SMG$K_TRM_CTRLR = '00000012'X ! DC2 PARAMETER SMG$K_TRM_CTRLS = '00000013'X ! DC3 PARAMETER SMG$K_TRM_CTRLT = '00000014'X ! DC4 PARAMETER SMG$K_TRM_CTRLU = '00000015'X ! NAK PARAMETER SMG$K_TRM_CTRLV = '00000016'X ! SYN PARAMETER SMG$K_TRM_CTRLW = '00000017'X ! ETB PARAMETER SMG$K_TRM_CTRLX = '00000018'X ! CAN PARAMETER SMG$K_TRM_CTRLY = '00000019'X ! EM PARAMETER SMG$K_TRM_CTRLZ = '0000001A'X ! SUB PARAMETER SMG$K_TRM_ESCAPE = '0000001B'X ! ESC ! FS ! GS ! RS ! US PARAMETER SMG$K_TRM_SPACE = '00000020'X ! SP PARAMETER SMG$K_TRM_EXCLAMATION_POINT = '00000021'X ! ! PARAMETER SMG$K_TRM_DOUBLE_QUOTE = '00000022'X ! " PARAMETER SMG$K_TRM_NUMBER_SIGN = '00000023'X ! # PARAMETER SMG$K_TRM_DOLLAR_SIGN = '00000024'X ! $ PARAMETER SMG$K_TRM_PERCENT_SIGN = '00000025'X ! % PARAMETER SMG$K_TRM_AMPERSAND = '00000026'X ! & PARAMETER SMG$K_TRM_QUOTE = '00000027'X ! ' PARAMETER SMG$K_TRM_LEFT_PAREN = '00000028'X ! ( PARAMETER SMG$K_TRM_RIGHT_PAREN = '00000029'X ! ) PARAMETER SMG$K_TRM_ASTERISK = '0000002A'X ! * PARAMETER SMG$K_TRM_PLUS_SIGN = '0000002B'X ! + ! , PARAMETER SMG$K_TRM_DASH = '0000002D'X ! - PARAMETER SMG$K_TRM_DOT = '0000002E'X ! . PARAMETER SMG$K_TRM_SLASH = '0000002F'X ! / PARAMETER SMG$K_TRM_ZERO = '00000030'X ! 0 PARAMETER SMG$K_TRM_ONE = '00000031'X ! 1 PARAMETER SMG$K_TRM_TWO = '00000032'X ! 2 PARAMETER SMG$K_TRM_THREE = '00000033'X ! 3 PARAMETER SMG$K_TRM_FOUR = '00000034'X ! 4 PARAMETER SMG$K_TRM_FIVE = '00000035'X ! 5 PARAMETER SMG$K_TRM_SIX = '00000036'X ! 6 PARAMETER SMG$K_TRM_SEVEN = '00000037'X ! 7 PARAMETER SMG$K_TRM_EIGHT = '00000038'X ! 8 PARAMETER SMG$K_TRM_NINE = '00000039'X ! 9 PARAMETER SMG$K_TRM_COLON = '0000003A'X ! : PARAMETER SMG$K_TRM_SEMICOLON = '0000003B'X ! ; PARAMETER SMG$K_TRM_LESS_THAN = '0000003C'X ! < PARAMETER SMG$K_TRM_EQUAL = '0000003D'X ! = PARAMETER SMG$K_TRM_GREATER_THAN = '0000003E'X ! > PARAMETER SMG$K_TRM_QUESTION_MARK = '0000003F'X ! ? PARAMETER SMG$K_TRM_AT_SIGN = '00000040'X ! @ PARAMETER SMG$K_TRM_UPPERCASE_A = '00000041'X ! A PARAMETER SMG$K_TRM_UPPERCASE_B = '00000042'X ! B PARAMETER SMG$K_TRM_UPPERCASE_C = '00000043'X ! C PARAMETER SMG$K_TRM_UPPERCASE_D = '00000044'X ! D PARAMETER SMG$K_TRM_UPPERCASE_E = '00000045'X ! E PARAMETER SMG$K_TRM_UPPERCASE_F = '00000046'X ! F PARAMETER SMG$K_TRM_UPPERCASE_G = '00000047'X ! G PARAMETER SMG$K_TRM_UPPERCASE_H = '00000048'X ! H PARAMETER SMG$K_TRM_UPPERCASE_I = '00000049'X ! I PARAMETER SMG$K_TRM_UPPERCASE_J = '0000004A'X ! J PARAMETER SMG$K_TRM_UPPERCASE_K = '0000004B'X ! K PARAMETER SMG$K_TRM_UPPERCASE_L = '0000004C'X ! L PARAMETER SMG$K_TRM_UPPERCASE_M = '0000004D'X ! M PARAMETER SMG$K_TRM_UPPERCASE_N = '0000004E'X ! N PARAMETER SMG$K_TRM_UPPERCASE_O = '0000004F'X ! O PARAMETER SMG$K_TRM_UPPERCASE_P = '00000050'X ! P PARAMETER SMG$K_TRM_UPPERCASE_Q = '00000051'X ! Q PARAMETER SMG$K_TRM_UPPERCASE_R = '00000052'X ! R PARAMETER SMG$K_TRM_UPPERCASE_S = '00000053'X ! S PARAMETER SMG$K_TRM_UPPERCASE_T = '00000054'X ! T PARAMETER SMG$K_TRM_UPPERCASE_U = '00000055'X ! U PARAMETER SMG$K_TRM_UPPERCASE_V = '00000056'X ! V PARAMETER SMG$K_TRM_UPPERCASE_W = '00000057'X ! W PARAMETER SMG$K_TRM_UPPERCASE_X = '00000058'X ! X PARAMETER SMG$K_TRM_UPPERCASE_Y = '00000059'X ! Y PARAMETER SMG$K_TRM_UPPERCASE_Z = '0000005A'X ! Z PARAMETER SMG$K_TRM_LEFT_BRACKET = '0000005B'X ! [ PARAMETER SMG$K_TRM_BACKSLASH = '0000005C'X ! \ PARAMETER SMG$K_TRM_RIGHT_BRACKET = '0000005D'X ! ] PARAMETER SMG$K_TRM_CARET = '0000005E'X ! ^ PARAMETER SMG$K_TRM_UNDERLINE = '0000005F'X ! _ PARAMETER SMG$K_TRM_GRAVE_ACCENT = '00000060'X ! ` PARAMETER SMG$K_TRM_LOWERCASE_A = '00000061'X ! a PARAMETER SMG$K_TRM_LOWERCASE_B = '00000062'X ! b PARAMETER SMG$K_TRM_LOWERCASE_C = '00000063'X ! c PARAMETER SMG$K_TRM_LOWERCASE_D = '00000064'X ! d PARAMETER SMG$K_TRM_LOWERCASE_E = '00000065'X ! e PARAMETER SMG$K_TRM_LOWERCASE_F = '00000066'X ! f PARAMETER SMG$K_TRM_LOWERCASE_G = '00000067'X ! g PARAMETER SMG$K_TRM_LOWERCASE_H = '00000068'X ! h PARAMETER SMG$K_TRM_LOWERCASE_I = '00000069'X ! i PARAMETER SMG$K_TRM_LOWERCASE_J = '0000006A'X ! j PARAMETER SMG$K_TRM_LOWERCASE_K = '0000006B'X ! k PARAMETER SMG$K_TRM_LOWERCASE_L = '0000006C'X ! l PARAMETER SMG$K_TRM_LOWERCASE_M = '0000006D'X ! m PARAMETER SMG$K_TRM_LOWERCASE_N = '0000006E'X ! n PARAMETER SMG$K_TRM_LOWERCASE_O = '0000006F'X ! o PARAMETER SMG$K_TRM_LOWERCASE_P = '00000070'X ! p PARAMETER SMG$K_TRM_LOWERCASE_Q = '00000071'X ! q PARAMETER SMG$K_TRM_LOWERCASE_R = '00000072'X ! r PARAMETER SMG$K_TRM_LOWERCASE_S = '00000073'X ! s PARAMETER SMG$K_TRM_LOWERCASE_T = '00000074'X ! t PARAMETER SMG$K_TRM_LOWERCASE_U = '00000075'X ! u PARAMETER SMG$K_TRM_LOWERCASE_V = '00000076'X ! v PARAMETER SMG$K_TRM_LOWERCASE_W = '00000077'X ! w PARAMETER SMG$K_TRM_LOWERCASE_X = '00000078'X ! x PARAMETER SMG$K_TRM_LOWERCASE_Y = '00000079'X ! y PARAMETER SMG$K_TRM_LOWERCASE_Z = '0000007A'X ! z PARAMETER SMG$K_TRM_LEFT_BRACE = '0000007B'X ! left curly brace PARAMETER SMG$K_TRM_VERTICAL_LINE = '0000007C'X ! | PARAMETER SMG$K_TRM_RIGHT_BRACE = '0000007D'X ! right curly brace PARAMETER SMG$K_TRM_TILDE = '0000007E'X ! ~ PARAMETER SMG$K_TRM_DELETE = '0000007F'X ! DEL ! Synonyms for control characters PARAMETER SMG$K_TRM_BS = '00000008'X PARAMETER SMG$K_TRM_HT = '00000009'X PARAMETER SMG$K_TRM_LF = '0000000A'X PARAMETER SMG$K_TRM_CR = '0000000D'X ! Keypad keys PARAMETER SMG$K_TRM_PF1 = '00000100'X PARAMETER SMG$K_TRM_PF2 = '00000101'X PARAMETER SMG$K_TRM_PF3 = '00000102'X PARAMETER SMG$K_TRM_PF4 = '00000103'X PARAMETER SMG$K_TRM_KP0 = '00000104'X PARAMETER SMG$K_TRM_KP1 = '00000105'X PARAMETER SMG$K_TRM_KP2 = '00000106'X PARAMETER SMG$K_TRM_KP3 = '00000107'X PARAMETER SMG$K_TRM_KP4 = '00000108'X PARAMETER SMG$K_TRM_KP5 = '00000109'X PARAMETER SMG$K_TRM_KP6 = '0000010A'X PARAMETER SMG$K_TRM_KP7 = '0000010B'X PARAMETER SMG$K_TRM_KP8 = '0000010C'X PARAMETER SMG$K_TRM_KP9 = '0000010D'X PARAMETER SMG$K_TRM_ENTER = '0000010E'X PARAMETER SMG$K_TRM_MINUS = '0000010F'X PARAMETER SMG$K_TRM_COMMA = '00000110'X PARAMETER SMG$K_TRM_PERIOD = '00000111'X ! Cursor positioning keys PARAMETER SMG$K_TRM_UP = '00000112'X PARAMETER SMG$K_TRM_DOWN = '00000113'X PARAMETER SMG$K_TRM_LEFT = '00000114'X PARAMETER SMG$K_TRM_RIGHT = '00000115'X ! Function keys PARAMETER SMG$K_TRM_F1 = '00000119'X PARAMETER SMG$K_TRM_F2 = '0000011A'X PARAMETER SMG$K_TRM_F3 = '0000011B'X PARAMETER SMG$K_TRM_F4 = '0000011C'X PARAMETER SMG$K_TRM_F5 = '0000011D'X PARAMETER SMG$K_TRM_F6 = '0000011E'X PARAMETER SMG$K_TRM_F7 = '0000011F'X PARAMETER SMG$K_TRM_F8 = '00000120'X PARAMETER SMG$K_TRM_F9 = '00000121'X PARAMETER SMG$K_TRM_F10 = '00000122'X PARAMETER SMG$K_TRM_F11 = '00000123'X PARAMETER SMG$K_TRM_F12 = '00000124'X PARAMETER SMG$K_TRM_F13 = '00000125'X PARAMETER SMG$K_TRM_F14 = '00000126'X PARAMETER SMG$K_TRM_HELP = '00000127'X ! F15 PARAMETER SMG$K_TRM_DO = '00000128'X ! F16 PARAMETER SMG$K_TRM_F17 = '00000129'X PARAMETER SMG$K_TRM_F18 = '0000012A'X PARAMETER SMG$K_TRM_F19 = '0000012B'X PARAMETER SMG$K_TRM_F20 = '0000012C'X ! Synonyms for function keys PARAMETER SMG$K_TRM_F15 = '00000127'X PARAMETER SMG$K_TRM_F16 = '00000128'X ! Editing keys PARAMETER SMG$K_TRM_FIND = '00000137'X ! E1 PARAMETER SMG$K_TRM_INSERT_HERE = '00000138'X ! E2 PARAMETER SMG$K_TRM_REMOVE = '00000139'X ! E3 PARAMETER SMG$K_TRM_SELECT = '0000013A'X ! E4 PARAMETER SMG$K_TRM_PREV_SCREEN = '0000013B'X ! E5 PARAMETER SMG$K_TRM_NEXT_SCREEN = '0000013C'X ! E6 ! Synonyms for editing keys PARAMETER SMG$K_TRM_E1 = '00000137'X ! FIND PARAMETER SMG$K_TRM_E2 = '00000138'X ! INSERT_HERE PARAMETER SMG$K_TRM_E3 = '00000139'X ! REMOVE PARAMETER SMG$K_TRM_E4 = '0000013A'X ! SELECT PARAMETER SMG$K_TRM_E5 = '0000013B'X ! PREV_SCREEN PARAMETER SMG$K_TRM_E6 = '0000013C'X ! NEXT_SCREEN ! Conditions PARAMETER SMG$K_TRM_CANCELLED = '000001FC'X ! I/O cancelled by SMG$CANCEL_INPUT PARAMETER SMG$K_TRM_TIMEOUT = '000001FD'X ! Timeout period expired PARAMETER SMG$K_TRM_BUFFER_FULL = '000001FE'X ! Buffer is full PARAMETER SMG$K_TRM_UNKNOWN = '000001FF'X ! Unknown terminator ! ! Key definition attributes ! PARAMETER SMG$M_KEY_NOECHO = '00000001'X PARAMETER SMG$M_KEY_TERMINATE = '00000002'X PARAMETER SMG$M_KEY_LOCK = '00000004'X PARAMETER SMG$M_KEY_PROTECTED = '00000008'X PARAMETER SMG$M_KEY_SETSTATE = '00000010'X STRUCTURE /SMG$R_KEY_DEF_ATTR/ PARAMETER SMG$S_KEY_NOECHO = 1 PARAMETER SMG$V_KEY_NOECHO = 0 ! Don't echo strings PARAMETER SMG$S_KEY_TERMINATE = 1 PARAMETER SMG$V_KEY_TERMINATE = 1 ! This key terminates read PARAMETER SMG$S_KEY_LOCK = 1 PARAMETER SMG$V_KEY_LOCK = 2 ! Lock new state PARAMETER SMG$S_KEY_PROTECTED = 1 PARAMETER SMG$V_KEY_PROTECTED = 3 ! Definition is protected PARAMETER SMG$S_KEY_SETSTATE = 1 PARAMETER SMG$V_KEY_SETSTATE = 4 ! Definition sets a state (output only) BYTE %FILL (1) END STRUCTURE ! SMG$R_KEY_DEF_ATTR ! SCREEN MANAGEMENT REQUEST TYPES PARAMETER SMG$C_CHANGE_RENDITION = '0000000A'X ! SMG$CHANGE_RENDITION PARAMETER SMG$C_DELETE_CHARS = '0000000B'X ! SMG$DELETE_CHARS PARAMETER SMG$C_ERASE_DISPLAY = '0000000C'X ! SMG$ERASE_DISPLAY PARAMETER SMG$C_ERASE_LINE = '0000000D'X ! SMG$ERASE_LINE PARAMETER SMG$C_HOME_CURSOR = '0000000E'X ! SMG$HOME_CURSOR PARAMETER SMG$C_INSERT_CHARS = '0000000F'X ! SMG$INSERT_CHARS PARAMETER SMG$C_INSERT_LINE = '00000010'X ! SMG$INSERT_LINE PARAMETER SMG$C_PUT_CHARS = '00000011'X ! SMG$PUT_CHARS PARAMETER SMG$C_PUT_LINE = '00000012'X ! SMG$PUT_LINE PARAMETER SMG$C_PUT_DISPLAY_ENCODED = '00000013'X ! SMG$PUT_VIRTUAL_DISPLAY_ENCODED PARAMETER SMG$C_RETURN_CURSOR_POS = '00000014'X ! SMG$RETURN_CURSOR_POS PARAMETER SMG$C_PUT_WITH_SCROLL = '00000015'X ! SMG$PUT_WITH_SCROLL PARAMETER SMG$C_SET_CURSOR_ABS = '00000016'X ! SMG$SET_CURSOR_ABS PARAMETER SMG$C_SET_CURSOR_REL = '00000017'X ! SMG$SET_CURSOR_REL PARAMETER SMG$C_DELETE_LINE = '00000018'X ! SMG$DELETE_LINE PARAMETER SMG$C_ERASE_CHARS = '00000019'X ! SMG$ERASE_CHARS PARAMETER SMG$C_SCROLL_DISPLAY_AREA = '0000001A'X ! SMG$SCROLL_DISPLAY_AREA PARAMETER SMG$C_CHANGE_VIRTUAL_DISPLAY = '0000001B'X ! SMG$CHANGE_VIRTUAL_DISPLAY PARAMETER SMG$C_LABEL_BORDER = '0000001C'X ! SMG$LABEL_BORDER PARAMETER SMG$C_END_DISPLAY_UPDATE = '0000001D'X ! SMG$END_DISPLAY_UPDATE ! Character Set Codes PARAMETER SMG$C_UNITED_KINGDOM = '00000000'X PARAMETER SMG$C_ASCII = '00000001'X PARAMETER SMG$C_SPEC_GRAPHICS = '00000002'X ! Special Graphics PARAMETER SMG$C_ALT_CHAR = '00000003'X ! Alternate - Standard Char. PARAMETER SMG$C_ALT_GRAPHICS = '00000004'X ! Alternate - Special Graphics ! ! The following constants define corner cursor positions used in ! SMG$HOME_CURSOR. ! PARAMETER SMG$C_UPPER_LEFT = '00000000'X PARAMETER SMG$C_LOWER_LEFT = '00000001'X PARAMETER SMG$C_UPPER_RIGHT = '00000002'X PARAMETER SMG$C_LOWER_RIGHT = '00000003'X ! ! The following constants define label positions used in ! SMG$LABEL_BORDER. ! PARAMETER SMG$K_TOP = '00000000'X PARAMETER SMG$K_BOTTOM = '00000001'X PARAMETER SMG$K_LEFT = '00000002'X PARAMETER SMG$K_RIGHT = '00000003'X ! ! DEFINE BIT MASKS AND VALUES FOR SCREEN ATTRIBUTES ! PARAMETER SMG$M_BOLD = '00000001'X PARAMETER SMG$M_REVERSE = '00000002'X PARAMETER SMG$M_BLINK = '00000004'X PARAMETER SMG$M_UNDERLINE = '00000008'X PARAMETER SMG$M_NORMAL = '00000000'X ! no bits set ! PARAMETER SMG$M_BUF_ENABLED = '00000001'X PARAMETER SMG$M_MINUPD = '00000002'X PARAMETER SMG$M_CLEAR_SCREEN = '00000004'X PARAMETER SMG$M_NOTABS = '00000008'X PARAMETER SMG$K_BUF_ENABLED = '00000000'X ! Enable Buffering bitvector index PARAMETER SMG$K_MINUPD = '00000001'X ! Enable minimal update bitvector index PARAMETER SMG$K_CLEAR_SCREEN = '00000002'X ! Clear screen on exit PARAMETER SMG$K_NOTABS = '00000003'X ! Don't use physical tabs ! PARAMETER SMG$C_COLOR_UNKNOWN = '00000000'X PARAMETER SMG$C_COLOR_WHITE = '00000001'X PARAMETER SMG$C_COLOR_BLACK = '00000002'X ! PARAMETER SMG$K_UNKNOWN = '00000000'X ! non-graphics or unknown type PARAMETER SMG$K_VT05 = '00000001'X ! vt05 series terminal PARAMETER SMG$K_VT52 = '00000002'X ! vt52 series terminal PARAMETER SMG$K_VT100 = '00000003'X ! vt100 series terminal PARAMETER SMG$K_VTFOREIGN = '00000004'X ! foreign terminal (ft1-8) PARAMETER SMG$K_HARDCOPY = '00000005'X ! hardcopy device PARAMETER SMG$K_VTTERMTABLE = '00000006'X ! video terminal ! PARAMETER SMG$M_BORDER = '00000001'X PARAMETER SMG$M_TRUNC_ICON = '00000002'X PARAMETER SMG$M_DISPLAY_CONTROLS = '00000004'X PARAMETER SMG$M_USER_DISPLAY = '00000008'X PARAMETER SMG$M_UP = '00000001'X PARAMETER SMG$M_DOWN = '00000002'X PARAMETER SMG$M_RIGHT = '00000004'X PARAMETER SMG$M_LEFT = '00000008'X PARAMETER SMG$K_FIRST_PRIV_TYPE = '000000BF'X STRUCTURE /SMGDEF/ UNION MAP PARAMETER SMG$S_BOLD = 1 PARAMETER SMG$V_BOLD = 0 ! Bold rendition PARAMETER SMG$S_REVERSE = 1 PARAMETER SMG$V_REVERSE = 1 ! Reverse video rendition PARAMETER SMG$S_BLINK = 1 PARAMETER SMG$V_BLINK = 2 ! Blink rendition PARAMETER SMG$S_UNDERLINE = 1 PARAMETER SMG$V_UNDERLINE = 3 ! Underline rendition BYTE %FILL (1) END MAP ! DEFINE BITS, MASKS, AND FIELDS FOR THE CONTROL MODES. ! MAP PARAMETER SMG$S_BUF_ENABLED = 1 PARAMETER SMG$V_BUF_ENABLED = 0 ! Enable buffering PARAMETER SMG$S_MINUPD = 1 PARAMETER SMG$V_MINUPD = 1 ! Enable minimal update (default) PARAMETER SMG$S_CLEAR_SCREEN = 1 PARAMETER SMG$V_CLEAR_SCREEN = 2 ! Clear screen on exit PARAMETER SMG$S_NOTABS = 1 PARAMETER SMG$V_NOTABS = 3 ! Don't use physical tabs BYTE %FILL (1) END MAP ! Master color wheel for screen background colors. ! ! The following constants correspond to the internal types defined ! in SMGTERM.REQ. These names used to be for public use - the SMGTERM names ! used to be needed for compatibility with SCR$ and SMG$ code. ! Use of these names is now very highly discouraged. ! ! The following masks define values to be used ! to specify a display attribute. These may be added ! together to specify multiple attributes. ! MAP PARAMETER SMG$S_BORDER = 1 PARAMETER SMG$V_BORDER = 0 ! Display is bordered PARAMETER SMG$S_TRUNC_ICON = 1 PARAMETER SMG$V_TRUNC_ICON = 1 ! Truncation icon enabled if set PARAMETER SMG$S_DISPLAY_CONTROLS = 1 PARAMETER SMG$V_DISPLAY_CONTROLS = 2 ! Display carriage controls if set PARAMETER SMG$S_USER_DISPLAY = 1 PARAMETER SMG$V_USER_DISPLAY = 3 ! User display for DEBUG if set BYTE %FILL (1) END MAP ! ! When an out-of-band AST triggers, the user's AST routine ! will get called. The first argument passed to his ! routine is the address of a Band Information Table. ! The offsets into this table are described below. ! To make it easy to access from certain languages, ! the table is arranged so that it is convenient to ! reference it as a longword vector as well as a byte block. ! MAP INTEGER*4 SMG$L_PASTEBOARD_ID ! Pasteboard ID INTEGER*4 SMG$L_ARG ! User's AST argument UNION MAP BYTE SMG$B_CHARACTER ! The character typed END MAP MAP INTEGER*4 SMG$L_CHARACTER ! The character and 3 spaces END MAP END UNION END MAP ! When SMG$GET_PASTEBOARD_ATTRIBUTES is called, ! it returns data in a pasteboard information block. ! The following structure is used to reference fields ! in this block. ! Items marked with a plus (+) will be 0 unless the ! device is a terminal (DEVCLASS=DC$_TERM). MAP INTEGER*4 SMG$L_DEVCHAR ! Device characteristics INTEGER*4 SMG$L_DEVDEPEND ! Specific characteristics (1) INTEGER*4 SMG$L_DEVDEPEND2 ! Specific characteristics (2) BYTE SMG$B_DEVCLASS ! Device class (e.g. DC$_TERM) BYTE SMG$B_SMG_DEVTYPE ! Internal SMG device type BYTE SMG$B_PHY_DEVTYPE ! Physical device type (e.g. DT$_VT100) BYTE SMG$B_ROWS ! Number of rows on device INTEGER*2 SMG$W_WIDTH ! Terminal width BYTE SMG$B_COLOR ! Reserved for future use BYTE SMG$B_PARITY ! Parity attributes (+) INTEGER*2 SMG$W_SPEED ! Terminal Speed (+) INTEGER*2 SMG$W_FILL ! Fill characteristics (+) INTEGER*2 SMG$W_CURSOR_ROW ! Row where physical cursor is ! (1-origin) INTEGER*2 SMG$W_CURSOR_COL ! Col where physical cursor is ! (1-origin) INTEGER*4 SMG$L_CURSOR_DID ! Display id of topmost ! display that cursor is in. ! 0 if cursor is not in a ! virtual display END MAP ! When SMG$GET_KEYBOARD_ATTRIBUTES is called, ! it returns data in a keyboard information block. ! The following structure is used to reference fields ! in this block. ! Items marked with a plus (+) will be 0 unless the ! device is a terminal (DEVCLASS=DC$_TERM). MAP INTEGER*4 SMG$l_fill1 ! Device characteristics INTEGER*4 SMG$l_fill2 ! Specific characteristics (1) INTEGER*4 SMG$l_fill3 ! Specific characteristics (2) BYTE SMG$b_fill4 ! Device class (e.g. DC$_TERM) BYTE SMG$B_RECALL_SIZE ! Size of recall buffer (+) BYTE SMG$b_fill5 ! Physical device type (e.g. DT$_VT100) BYTE SMG$B_TYPEAHEAD_CHAR ! First char in typeahead buffer (+) INTEGER*2 SMG$w_fill6 ! Terminal width INTEGER*2 SMG$W_TYPEAHEAD_COUNT ! Number of chars in typeahead buffer (+) END MAP ! ! Directions are set up as a structure, assuming that directions ! may be combined in the future (ie. diagonal movement). ! MAP PARAMETER SMG$S_UP = 1 PARAMETER SMG$V_UP = 0 ! Scroll up PARAMETER SMG$S_DOWN = 1 PARAMETER SMG$V_DOWN = 1 ! Scroll down PARAMETER SMG$S_RIGHT = 1 PARAMETER SMG$V_RIGHT = 2 ! Scroll right PARAMETER SMG$S_LEFT = 1 PARAMETER SMG$V_LEFT = 3 ! Scroll left BYTE %FILL (1) END MAP END UNION END STRUCTURE ! SMGDEF 870303:12:53:38
charettep@nusc-wpn.UUCP.UUCP (03/04/87)
Well ... I got the SWING ditribution stuff, but when I compiled
it I got a frustrating result ... It would run, and then show me the pretty
picture, but then it would utterly ignore anything I did ... I tried all
the arrow keys and all the command letters, etc. No luck. Did my mailer
eat somthing important, or something?
Does anyone out there have running version of SWING that I could
FTP? I'd really appreciate it, as it looks quite nice.
Adv*THANKS*ance,
Paul C.
+--------------------------------------------------------+
| Paul Charette |
| Naval Underwater Systems Centre |
| Newport, RI |
| |
| ARPAmail: <charettep@nusc-wpn.ARPA> |
| UUCPmail: {allegra!seismo}!nusc-wpn!charettep.UUCP |
+--------------------------------------------------------+
------u3369429@seismo.CSS.GOV@murdu.OZ.AU (03/05/87)
In article <8703040211.AA21795@ucbvax.Berkeley.EDU> <charettep@nusc-wpn> writes: > Well ... I got the SWING distribution stuff, but when I compiled >it I got a frustrating result ... It would run, and then show me the pretty >picture, but then it would utterly ignore anything I did ... I tried all >the arrow keys and all the command letters, etc. No luck. Did my mailer >eat somthing important, or something? > | Paul Charette | Yes, something. Your SYS$LIBRARY:FORSYSDEF.TLB has been screwed up by DEC. The module $SMGDEF which you find there should be called $SMGMSGDEF. If you go back to your installation procedure, you can manually rectify it. Or you can use part 6 of my SWING posting. If SWING were written using IMPLICIT NONE this would be detected at compile time. (This is also an answer to thompson%jplrag who e-mailed the same question) Michael Bednarek (u3369429@murdu.oz.au)
SYSOP1@HARTFORD.BITNET.UUCP (03/06/87)
Hi,
When i use swing on a large structure 100+ directories it comes
up with a subscript out of range error. Has anyone found a fix for this.
I would realy like to be able to examine the structure of an entire disk.
S. David Streiff
Asst. Programmer
Univ of Hartford
West Hartford CT
BitNet: STREIFF@HARTFORD.BITNET