Trailing-Edge
-
PDP-10 Archives
-
BB-K840A-BM_1981
-
sources/se.for
There are no other files named se.for in the archive.
C se> Edit command
C RTA 10/22/80 Add "help" command at "edit" command level
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C operating system dependent switches from RATLIB
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C copyright notice
C
C
C C O P Y R I G H T
C
C
C Copyright (C) 1980 by
C Digital Equipment Corporation, Maynard, Mass.
C
C
C This software is furnished under a license and may be used and
C copied only in accordance with the terms of such license and
C with the inclusion of the above copyright notice. This
C software or any other copies thereof may not be provided or
C otherwise made available to any other person. No title to and
C ownership of the software is hereby transferred.
C
C The information in this software is subject to change without
C notice and should not be construed as a commitment by Digital
C Equipment Corporation.
C
C DIGITAL assumes no responsibility for the use or reliability
C of its software on equipment that is not supplied by DIGITAL.
C
C ** Symbolic definitions **
C data types
C define character byte
C max string storage
C max number of string indices
C important string indices (see ss module)
C coord - axis codes
C cpystr - option codes
C dcs - function codes
C ffopen - modes
C ffopen - logical file numbers
C utty - function codes
C codes returned by keypad function
C parameter codes
C screen areas
C column number of text in aea 2
C character types
C composites
C CTKEY = CTALPHA + CTNUM + CTHYPH
C legal filename characters are defined in pflnm (sp module)
C colors
C maximum time between slides
C screen dimensions (pixels)
C character definitions
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C character definitions
C number of lines in display
C ef - function codes
C temp file names
C @87 sptmp1.tmp
C @88 sptmp2.tmp
C editcm - process edit command
subroutine editcm
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C secom>
common / secom / dollar , epl , epl1 , epl2 , fnfrom , fnto , top
C number of lines in tray file
C line# parsed by epline
C line#[-line#] parsed by epl
C "from" name string
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C complete parsing the command line
i = 0
C assume no filespec
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23000
C filespec present?
i = pptr
C yes, remember where it starts
if(.not.( pflnm ( pptr , 0 , 0 ) .lt. 0 ))goto 23002
return
23002 continue
C parse, and return if failed
23000 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23004
return
23004 continue
C parse end-of-line
if(.not.( i .gt. 0 ))goto 23006
call pflnm ( i , 5 , 13 )
23006 continue
C get tray name if present
if(.not.( optray ( 1 ) .ne. 0 ))goto 23008
return
C make sure I have a tray file
C parsing complete; find length of tray file, store in dollar
23008 continue
fnfrom = 5
fnto = 87
C set initial input, output files
if(.not.( ef ( 1 ) .ne. 0 ))goto 23010
C can I read the tray file?
C no, try creating an empty one
if(.not.( ffopen ( 1 , 5 , 2 ) .ne. 0 ))goto 23012
return
23012 continue
call pr0 ( 114 )
C @114 - creating empty file
call ffcls ( 1 )
C ok, empty tray created
if(.not.( ef ( 1 ) .ne. 0 ))goto 23014
return
23014 continue
C this open really should win
23010 continue
if(.not.( ef ( 2 ) .ne. 0 ))goto 23016
goto 400
23016 continue
C open temp file
top = 1
C top line of display = line 1
dollar = 0
C init counter
continue
23018 if(.not.( ffread ( 1 , 0 ) .gt. 0 ))goto 23019
C loop once per record
call ffwrt ( 3 )
C copy record to temp file
dollar = dollar + 1
C count # of records
goto 23018
23019 continue
call eshow
C generate display
call ef ( 4 )
C close files
fnfrom = 87
fnto = 88
C set initial input, output files
continue
23020 if(.not.( . true . ))goto 23021
call prdtty ( 83 )
C @83 Edit command:\b
cmd = pkey ( 84 )
C @84 00copy LINE1 [-LINE2] LINE3^
C 01delete LINE1 [-LINE2]^
C 02end [dont-save-changes]^
C 03find [TAG/LINE [SCREEN-POSITION]]^
C 04insert-after LINE^
C 05move LINE1 [-LINE2] LINE3^
C 06replace LINE1 [-LINE2]^
C 07show-slide FILESPEC [OBJECT]^
C 08help
goto ( 99 , 100 , 101 , 102 , 103 , 104 , 100 , 106 , 107 , 108 )
*, cmd + 2
C PARSE FAILED
99 goto 23020
C copy/move LINE1 [-LINE2] LINE3
100 if(.not.( epline ( 2 ) .ne. 0 ))goto 23022
goto 23020
C parse source line(s)
23022 continue
if(.not.( epline ( 1 ) .ne. 0 ))goto 23024
goto 23020
C parse destination line
23024 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23026
goto 23020
C parse eol
23026 continue
if(.not.( epl .ge. epl1 .and. epl .lt. epl2 ))goto 23028
C check for overlap
call pdiag ( 107 )
C @107 "To" and "from" lines overlap
goto 23020
23028 continue
if(.not.( ef ( 6 ) .ne. 0 ))goto 23030
goto 400
23030 continue
C open files
dollar = 0
rec = 0
C input file record #
continue
23032 if(.not.( . true . ))goto 23033
if(.not.( rec .eq. epl ))goto 23034
C want to add lines here?
top = dollar - 10
C yowsuh
continue
i = epl1
23036 if(.not.(i.le.epl2))goto 23038
j = ffread ( 1 , i )
C get record
call ffwrt ( 3 )
C copy to output file
dollar = dollar + 1
C count it
23037 i=i+1
goto 23036
23038 continue
23034 continue
rec = rec + 1
C next record
if(.not.( cmd .eq. 0 .or. rec .lt. epl1 .or. rec .gt. epl2 ))goto
*23039
C keep it?
i = ffread ( 1 , rec )
C yes, get it
if(.not.( i .le. 0 ))goto 23041
goto 23033
C exit loop if eof hit
23041 continue
call ffwrt ( 3 )
C write to output file
dollar = dollar + 1
C count it
23039 continue
goto 23032
23033 continue
call ef ( 3 )
C close files and swap
call eshow
C fix display
goto 23020
C delete LINE1 [-LINE2]
101 if(.not.( epline ( 2 ) .ne. 0 ))goto 23043
goto 23020
C parse LINE#[-LINE#]
23043 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23045
goto 23020
C parse eol
23045 continue
epl = - 1
C no insertion
goto 150
C go do it
C end [dont-save-changes]
102 i = 1
C assume saving changes
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23047
C are we?
i = pkey ( 113 )
C @113 00dont-save-changes
if(.not.( i .lt. 0 ))goto 23049
goto 23020
C blew it
23049 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23051
goto 23020
C parse eol
23051 continue
23047 continue
call ef ( 4 )
C close files
if(.not.( i .gt. 0 ))goto 23053
if(.not.( ffrenm ( fnfrom , 5 ) .ne. 0 ))goto 23055
call pdiag1 ( 105 , 5 )
C @105 Cannot rename temp file to %s
23055 continue
23053 continue
goto 23021
C split
C find [TAG/LINE [SCREEN-POSITION]]
103 if(.not.( chkeol ( 0 ) .ne. 0 ))goto 23057
C any args?
if(.not.( top .ge. dollar - 21 + 2 ))goto 23059
goto 23020
C no
23059 continue
top = top + 21 - 1
C compute new top
call eshow
C fix display
goto 23020
23057 continue
call pskip ( 4 )
C skip blanks
if(.not.( sv ( pptr ) .eq. 36 .and. dollar .gt. 0 ))goto 23061
C $ ?
pptr = pptr + 1
C yes, move past $
tag = dollar
C get value of $
goto 23062
23061 continue
tag = ptagob ( 0 , 11 )
23062 continue
C parse tag
if(.not.( tag .lt. 0 ))goto 23063
goto 23020
C split on error
23063 continue
i = 1
C assume position absent
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23065
C did user give a position?
i = pdec ( 1 , 21 )
C yes, parse it
if(.not.( i .le. 0 ))goto 23067
goto 23020
C check for error
23067 continue
23065 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23069
goto 23020
C parse end of line
23069 continue
if(.not.( ef ( 1 ) .ne. 0 ))goto 23071
goto 23020
C open tray file
23071 continue
if(.not.( tag .eq. 0 ))goto 23073
tag = tagluk ( 11 )
23073 continue
C find tag in tray
if(.not.( tag .gt. 0 ))goto 23075
C found it?
top = tag - i + 1
C yes, set new top
call eshow
C fix display
23075 continue
goto 23020
C insert-after LINE
104 if(.not.( epline ( 1 ) .ne. 0 ))goto 23077
goto 23020
C parse destination line
23077 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23079
goto 23020
C parse eol
23079 continue
epl1 = 0
epl2 = 0
C no deletion
goto 150
C go do it
C replace LINE1 [-LINE2]
106 if(.not.( epline ( 2 ) .ne. 0 ))goto 23081
goto 23020
C line(s) to replace
23081 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23083
goto 23020
C parse eol
23083 continue
epl = epl1 - 1
C where to insert
C epl1,epl2 are lines to delete, epl1 is line to add after
150 if(.not.( ef ( 6 ) .ne. 0 ))goto 23085
goto 400
23085 continue
C open files
rec = 0
C input file record #
dollar = 0
C $ will be recomputed
continue
23087 if(.not.( . true . ))goto 23088
if(.not.( rec .eq. epl ))goto 23089
C want to add lines here?
j = 0
C yowsuh
call helpx ( 108 )
C @108 To stop, type empty line
continue
23091 if(.not.( . true . ))goto 23092
C get lines from user
call helpcr ( 1 )
C next line on screen
j = j + 1
call putdec ( rec + j , 0 , 0 )
C prompt
call putc ( 32 )
call dcs ( 6 )
C original TM
call read1 ( 0 )
C read line
call dcs ( 5 )
C restore TM1
if(.not.( sv ( pptr ) .eq. 0 ))goto 23093
goto 23092
C chk empty line
23093 continue
call cpystr ( 2 , 512 + 256 )
call ffwrt ( 3 )
C write new record
dollar = dollar + 1
C add to total
goto 23091
23092 continue
23089 continue
rec = rec + 1
C next record
i = ffread ( 1 , rec )
C yes, get it
if(.not.( i .le. 0 ))goto 23095
goto 23088
C exit loop if eof hit
23095 continue
if(.not.( i .lt. epl1 .or. i .gt. epl2 ))goto 23097
C want to keep?
call ffwrt ( 3 )
C yes, copy to output
dollar = dollar + 1
C count it
23097 continue
goto 23087
23088 continue
call ef ( 3 )
C close files and swap
call eshow
C fix display
goto 23020
C show-slide FILESPEC [OBJECT]
107 call pskip ( 4 )
C skip blanks
if(.not.( pflnm ( pptr , 9 , 14 ) .lt. 0 ))goto 23099
goto 23020
C get filespec in SNSFL
23099 continue
obj = 0
C assume no object
if(.not.( chkeol ( 0 ) .eq. 0 ))goto 23101
C is there an object?
if(.not.( ptagob ( 1 , 10 ) .lt. 0 ))goto 23103
goto 23020
C yes, parse it
23103 continue
obj = 10
C remember object exists
23101 continue
if(.not.( peol ( 0 ) .ne. 0 ))goto 23105
goto 23020
C parse end-of-line
C all parsing is done, time to show the slide
23105 continue
if(.not.( show1 ( 9 , obj ) .eq. 0 ))goto 23107
C show ok?
call dcs ( 9 )
call read1 ( 0 )
C yes, wait for CR
23107 continue
goto 23020
C help
108 sv ( pptr ) = 63
C fudge a question-mark
i = pkey ( 84 )
C get the menu
goto 23020
goto 23020
23021 continue
400 call ef ( 4 )
C close files
call ef ( 5 )
C delete temp files
end
C ef - perform file functions for edit command
C func: EFxxx
C returns: 0 successful, -1 failed, diagnostic given
integer function ef ( func )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C secom>
common / secom / dollar , epl , epl1 , epl2 , fnfrom , fnto , top
C number of lines in tray file
C line# parsed by epline
C line#[-line#] parsed by epl
C "from" name string
C record number of first line of display
logical otray , onew
C .true. if file is open
data otray , onew / . false . , . false . /
ef = 0
C assume success
goto ( 101 , 102 , 103 , 104 , 105 , 101 ) , func
C dispatch
C EFOTRA
101 if(.not.( . not . otray ))goto 23109
C open yet?
if(.not.( ffopen ( 1 , fnfrom , 0 ) .ne. 0 ))goto 23111
C no, do it
call pdiag1 ( 86 , fnfrom )
C @86 Cannot read file %s
C NOTE: string 86 used elsewhere
ef = - 1
C set error
return
23111 continue
otray = . true .
goto 23110
23109 continue
call ffrew ( 1 )
23110 continue
C already open, rewind
if(.not.( func .eq. 1 ))goto 23113
return
C fall thru if EFOALL
C EFONEW
23113 continue
102 if(.not.( ffopen ( 3 , fnto , 2 ) .ne. 0 ))goto 23115
C no, do it
call pdiag1 ( 92 , fnto )
C @92 Cannot create file %s
ef = - 1
C set error
return
23115 continue
onew = . true .
C remember it's open
return
C EFCSWP, EFCLS
103 i = fnfrom
fnfrom = fnto
fnto = i
C swap fnfrom, fnto
104 if(.not.( otray ))goto 23117
call ffcls ( 1 )
23117 continue
C close from
otray = . false .
if(.not.( onew ))goto 23119
call ffcls ( 3 )
23119 continue
C close to
onew = . false .
return
C EFDEL
105 call ffdel ( 87 )
call ffdel ( 88 )
C delete temp files
return
end
C epline - parse line #
C n: 1 to parse line#, 2 to parse line#[-line#]
C returns: 0 successful, -1 failed
C n = 1: line# returned in epl
C n = 2: epl1/ first line#, epl2/ second line#
integer function epline ( n )
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C secom>
common / secom / dollar , epl , epl1 , epl2 , fnfrom , fnto , top
C number of lines in tray file
C line# parsed by epline
C line#[-line#] parsed by epl
C "from" name string
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C sscom>
integer sv ( 3500 )
integer sx ( 150 )
common / gscom / ipptr , iuptr , pptr , uptr , sv , sx
C contains sx (SNINP)
C contains sx (SNUST)
C index into sv, used when parsing tty input (SNINP)
C index into sv, used when building a string (SNUST)
C subscript is string #, contains index into sv
integer c
epline = - 1
C assume failed
continue
j = 1
23121 if(.not.(j.le.n))goto 23123
C get 1 or 2 numbers
call pskip ( 4 )
C skip blanks
c = sv ( pptr )
C get character
if(.not.( j .eq. 2 ))goto 23124
if(.not.( c .ne. 45 ))goto 23126
goto 23123
C check for [-line#]
23126 continue
pptr = pptr + 1
C skip hyphen
call pskip ( 4 )
C skip to line#
c = sv ( pptr )
C get first char of line#
23124 continue
if(.not.( c .eq. 63 ))goto 23128
C want help
call pdiag ( 93 )
C @93 Line number in tray, or $ to specify last line
return
23128 continue
if(.not.( c .eq. 36 ))goto 23130
i = dollar
pptr = pptr + 1
C $
goto 23131
23130 continue
i = pdec ( n - 1 , dollar )
C parse line #
if(.not.( i .lt. 0 ))goto 23132
return
23132 continue
C fail if parse failed
23131 continue
if(.not.( n .eq. 1 ))goto 23134
epl = i
C 1 line case
goto 23135
23134 continue
if(.not.( j .eq. 1 ))goto 23136
epl1 = i
epl2 = i
C 2 line case
goto 23137
23136 continue
epl2 = i
C 2nd line
if(.not.( epl1 .gt. epl2 ))goto 23138
call pdiag ( 106 )
return
C @106 First line number is greater than second
23138 continue
23137 continue
23135 continue
23122 j=j+1
goto 23121
23123 continue
epline = 0
C success
end
C eshow - show records from tray file on left side of screen
subroutine eshow
implicit integer ( a - z )
C Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C secom>
common / secom / dollar , epl , epl1 , epl2 , fnfrom , fnto , top
C number of lines in tray file
C line# parsed by epline
C line#[-line#] parsed by epl
C "from" name string
C record number of first line of display
call clr ( 1 , - 2 )
C clear area 1
call postc ( 0 )
C home cursor
if(.not.( dollar .eq. 0 ))goto 23140
C anything in file?
call pr0 ( 89 )
C @89 Tray is empty
return
23140 continue
call ef ( 1 )
C open tray file
if(.not.( top .gt. dollar ))goto 23142
top = dollar - 21 + 2
23142 continue
C adjust top
if(.not.( top .le. 0 ))goto 23144
top = 1
23144 continue
C if necessary
rec = top
C set current rec #
line = 1
C screen line #
continue
23146 if(.not.( . true . ))goto 23147
i = ffread ( 1 , rec )
C get record from tray
if(.not.( i .le. 0 ))goto 23148
goto 23147
C eof
23148 continue
i = 2
if(.not.( top + slines - 1 .ge. 100 ))goto 23150
i = 3
23150 continue
C get size of field
call putdec ( rec , i , 0 )
C write record #
call pr1 ( 85 , 6 )
C @85 %s\n
line = line + 1
rec = rec + 1
if(.not.( line .gt. 21 ))goto 23152
return
23152 continue
C return if screen full
goto 23146
23147 continue
if(.not.( line .le. 21 ))goto 23154
call pr0 ( 90 )
23154 continue
C @90 End
end