Google
 

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