FTN4 
C                          <800822.0801>
C 
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C 
C           NAME:   EDTU4 
C           SOURCE: 92074-18012 
C           RELOC:  PART OF 92074-12002 
C           PGMR:   J.D.J.
C 
C 
C     DEFAULT LISTER FOR EDIT 
C 
C     JOHN JOHNSON
C     6/22/80 
C 
      SUBROUTINE SHOW,92074-1X012 REV.2034 800818 
      IMPLICIT INTEGER(A-Z) 
      INTEGER FBUF0(150),XYBF0(150),L1BF0(150)
      INTEGER L2BF0(150),NBUF0(10),LNAM(10),TAB0(20)
      LOGICAL KEYT3 ,KEYFG
      COMMON /ANCCH/ ANCCH
      COMMON /TABCH/ TABCH
      COMMON /INDEF/ INDEF
      COMMON /ESCCH/ ESCCH
      COMMON /BAR/   BAR
      COMMON /ASKFG/ ASKFG
      COMMON /FOLDF/ FOLDF
      COMMON /REFLG/ REFLG
      COMMON /DSPFG/ DSPFG
      COMMON /ABOVE/ ABOVE
      COMMON /BELOW/ BELOW
      COMMON /OLAP / OLAP 
      COMMON /VWABV/ VWABV
      COMMON /VWBLW/ VWBLW
      COMMON /WIND1/ WIND1
      COMMON /WIND2/ WIND2
      COMMON /MAXOP/ MAXOP
      COMMON /FBUF0/ FBUF0
      COMMON /FLNG/ FLNG
      COMMON /XYBF0/ XYBF0
      COMMON /XLNG/ XLNG
      COMMON /YOFFS/ YOFFS
      COMMON /YLNG/ YLNG
      COMMON /L1BF0/ L1BF0
      COMMON /L1LNG/ L1LNG
      COMMON /L2BF0/ L2BF0
      COMMON /L2LNG/ L2LNG
      COMMON /NBUF0/ NBUF0
      COMMON /LNAM/ LNAM
      COMMON /TAB0/ TAB0
      COMMON /KEYFG/ KEYFG
      COMMON /FRTNF/ FRTNF
      COMMON /TMSIZ/ TMSIZ
      COMMON /DLMTR/ DLMTR
      COMMON /TSFLG/ TSFLG
      KEYFG = .FALSE. 
      IF(.NOT.( KEYT3(2HER) .OR. KEYT3(2HWR) ))GOTO 23000 
      CALL MSG(33HER or WR...................... =_,-33)
      CALL INAM3(NBUF0) 
23000 CONTINUE
      IF(.NOT.( KEYT3(1HL)))GOTO 23002
      CALL MSG(33HList file .................... =_,-33)
      CALL INAM3(LNAM)
23002 CONTINUE
      IF(.NOT.( KEYT3(2HF ) .OR. KEYT3(2HB ) .OR.KEYT3(1HD)))GOTO 23004 
      CALL MSG(33HF, B, D or line spec pattern...=_,-33)
      CALL BUFF3(FBUF0,FLNG ) 
23004 CONTINUE
      IF(.NOT.( KEYT3(1HX) .OR. KEYT3(1HU) .OR. KEYT3(1HY) .OR. KEYT3(1H
     *G) ))GOTO 23006 
      CALL MSG(33HG, U, X or Y match.............=_,-33)
      CALL BUFF3(XYBF0,XLNG)
      CALL MSG(33HG, U, X or Y substitute........=_,-33)
      CALL BUFF3(XYBF0((YOFFS+1)/2+1),YLNG) 
23006 CONTINUE
      IF(.NOT.( KEYT3(2HAL)))GOTO 23008 
      CALL MSG(31H            Set command options,-31)
23008 CONTINUE
      IF(.NOT.( KEYT3(2HAC)))GOTO 23010 
      CALL MSG(33HAnchor character........... AC =_,-33)
      CALL MSG(ANCCH,-2)
23010 CONTINUE
      IF(.NOT.( KEYT3(2HEC)))GOTO 23012 
      CALL MSG(33Hescape character........... EC =_,-33)
      CALL MSG(ESCCH,-2)
23012 CONTINUE
      IF(.NOT.( KEYT3(2HIC)))GOTO 23014 
      CALL MSG(33Hindefinite character....... IC =_,-33)
      CALL MSG(INDEF,-2)
23014 CONTINUE
      IF(.NOT.( KEYT3(2HPC)))GOTO 23016 
      CALL MSG(33Hprompt character........... PC =_,-33)
      CALL MSG(DLMTR,-2)
23016 CONTINUE
      IF(.NOT.( KEYT3(2HCS)))GOTO 23018 
      CALL MSG(33Hcommand separator.......... CS =_,-33)
      CALL MSG(BAR,-2)
23018 CONTINUE
      IF(.NOT.(KEYT3(2HTC) .OR. KEYT3(1HT) ))GOTO 23020 
      CALL MSG(33HTab character.............. TC =_,-33)
      IF(.NOT.(TABCH .EQ. 11B))GOTO 23022 
      CALL MSG(12Htab (cntl I),-12) 
      GOTO 23023
23022 CONTINUE
      CALL MSG(TABCH,-2)
23023 CONTINUE
      CALL MSG(33HTab columns....................=_,-33)
      CONTINUE
      I=1 
23024 IF(.NOT.(TAB0(I) .NE. 0 ))GOTO 23026
      CALL PNUM(1-TAB0(I))
23025 I=I+1 
      GOTO 23024
23026 CONTINUE
C give the lf 
      CALL MSG(2H  ,-2)   
23020 CONTINUE
      IF(.NOT.( KEYT3(2HWC)))GOTO 23027 
      CALL MSG(33HSearch window columns...... WC =_,-33)
      CALL PNUM(WIND1+1)
      CALL PNUM(-WIND2) 
C  give lf
      CALL MSG(1H  ,-1)   
23027 CONTINUE
      IF(.NOT.(KEYT3(2HSD)))GOTO 23029
      CALL MSG(33HScreen defaults............ SD =_,-33)
      CALL PNUM(ABOVE)
      CALL PNUM(BELOW)
      CALL PNUM(OLAP) 
      CALL MSG(1H ,-1)
23029 CONTINUE
      IF(.NOT.( KEYT3(2HSL)))GOTO 23031 
      CALL MSG(33HMaximum screen mode lines.. SL =_,-33)
      CALL PNUM(-TMSIZ) 
      CALL MSG(1H ,-1)
23031 CONTINUE
      IF(.NOT.(KEYT3(2HVW)))GOTO 23033
      CALL MSG(33HVertical window ........... VW =_,-33)
      CALL PNUM(VWABV)
      CALL PNUM(VWBLW)
      CALL MSG(1H ,-1)
23033 CONTINUE
      IF(.NOT.( KEYT3(2HLE)))GOTO 23035 
      CALL MSG(33HLine length ............... LE =_,-33)
      CALL PNUM(MAXOP)
      CALL MSG(1H ,-1)
23035 CONTINUE
      IF(.NOT.( KEYT3(2HAS)))GOTO 23037 
      CALL MSG(33HAsking..................... AS =_,-33)
      CALL PUOFF(ASKFG) 
23037 CONTINUE
      IF(.NOT.( KEYT3(2HCF)))GOTO 23039 
      CALL MSG(33HCase folding............... CF =_,-33)
      CALL PUOFF(FOLDF) 
23039 CONTINUE
      IF(.NOT.( KEYT3(2HRE)))GOTO 23041 
      CALL MSG(33HRegular expressions........ RE =_,-33)
      CALL PUOFF(REFLG) 
23041 CONTINUE
      IF(.NOT.( KEYT3(2HRT)))GOTO 23043 
      CALL MSG(33HReturn to dot if no match.. RT =_,-33)
      CALL PUOFF(FRTNF) 
23043 CONTINUE
      IF(.NOT.( KEYT3(2HDF)))GOTO 23045 
      CALL MSG(33HScreen mode display functs. DF =_,-33)
      CALL PUOFF(DSPFG) 
23045 CONTINUE
      IF(.NOT.( KEYT3(2HTS)))GOTO 23047 
      CALL MSG(33HTime stamp <YYMMDD.HHMM>... TS =_,-33)
      CALL PUOFF(TSFLG) 
23047 CONTINUE
      IF(.NOT.( .NOT. KEYFG ))GOTO 23049
      CALL MSG(70HNot an option.  Type SH to show all options and their 
     *current setting.,-70) 
23049 CONTINUE
      END 
      SUBROUTINE PNUM(I),92074-1X012 REV.2034 800818
      INTEGER I ,BUF(4) 
      DATA BUF/2H  ,2H  ,2H  ,2H_ / 
      CALL CNUMD(I,BUF) 
      CALL MSG(BUF,-7)
      END 
      SUBROUTINE PUOFF(FLAG),92074-1X012 REV.2034 800818
      INTEGER FLAG,ON,OFF(2)
      DATA ON/2Hon/ 
      DATA OFF/2Hof,2Hf / 
      IF(.NOT.( FLAG .EQ. 0 ))GOTO 23051
      CALL MSG(OFF,-3)
      GOTO 23052
23051 CONTINUE
      CALL MSG(ON,-2) 
23052 CONTINUE
      END 
       SUBROUTINE BUFF3(TEXT,LENGTH),92074-1X012 REV.2034 800818
      INTEGER TEXT(LENGTH),LENGTH 
      IF(.NOT.( LENGTH .GT. 0 ))GOTO 23053
      CALL MSG(TEXT,-LENGTH)
      GOTO 23054
23053 CONTINUE
      CALL MSG(1H ,-1)
23054 CONTINUE
      END 
      SUBROUTINE MSG(MESS,L),92074-1X012 REV.2034 800818
      INTEGER MESS(L) 
      COMMON /LSTLU/ LSTLU
97    CALL EXEC(100002B,LSTLU,MESS,L) 
98    GOTO 100
100   RETURN
      END 
       SUBROUTINE INAM3(INBUF),92074-1X012 REV.2034 800818
      INTEGER INBUF(10),BUF(20) 
      IF(.NOT.( INBUF(4) .NE. 0 ))GOTO 23055
      I = 0 
      CALL INAMR(INBUF,BUF,40,I)
      I = -I+1
      CALL MSG(BUF,I) 
      GOTO 23056
23055 CONTINUE
      CALL MSG(2H  ,-2) 
23056 CONTINUE
      END 
      LOGICAL FUNCTION KEYT3(TEST),92074-1X012 REV.2034 800818
      INTEGER TEST
      LOGICAL KEYFG 
      COMMON /KEYFG/ KEYFG
      COMMON /KEY/ KEY
      KEYT3 = ( (TEST .EQ. KEY) .OR. (KEY .EQ. 2HAL)) 
      IF(.NOT.(KEYT3))GOTO 23057
      KEYFG = .TRUE.
23057 CONTINUE
      END 
      SUBROUTINE EHMSG(MESS,L),92074-1X012 REV.2034 800818
      INTEGER MESS(L) 
      COMMON /LSTLU/ LSTLU
      COMMON/KEY/ KEY 
      CALL EXEC(100002B,LSTLU,3H  _,-3) 
96    GOTO 100
97    CALL EXEC(100002B,LSTLU,MESS,L) 
98    GOTO 100
99    CONTINUE
      IF(.NOT.(  IFBRK(JUNK) .NE. 0 ))GOTO 23059
      KEY = 0 
23059 CONTINUE
      RETURN
100   KEY = 0 
      RETURN
      END 
C 
C 
C 
      LOGICAL FUNCTION KEYT(TEST),92074-1X012 REV.2034 800818 
      INTEGER TEST
      LOGICAL KEYFG 
      COMMON /KEYFG/ KEYFG
      COMMON /KEY/ KEY
      IF(.NOT.( KEY .EQ. 2HAL))GOTO 23061 
      CALL EHMSG(1H ,-1)
      CALL EHMSG(1H ,-1)
23061 CONTINUE
      KEYT = ( (TEST .EQ. KEY) .OR. (KEY .EQ. 2HAL))
      IF(.NOT.(KEYT))GOTO 23063 
      KEYFG = .TRUE.
23063 CONTINUE
      END 
C 
C 
C 
C 
      SUBROUTINE EHLP2,92074-1X012 REV.2034 800818
      IMPLICIT INTEGER(A-Z) 
      LOGICAL KEYT,KEYFG
      COMMON  /KEYFG/ KEYFG 
      IF(.NOT.( KEYT(2HMO)))GOTO 23065
      CALL EHMSG(14H l1 [*] MO [Q],-14) 
      CALL EHMSG(44H  Move lines in range to after current line.,-44) 
23065 CONTINUE
      IF(.NOT.( KEYT(1HN)))GOTO 23067 
      CALL EHMSG(1HN,-1)
      CALL EHMSG(21H Current line number.,-21)
23067 CONTINUE
      IF(.NOT.( KEYT(1HO)))GOTO 23069 
      CALL EHMSG(9H[.] Otext,-9)
      CALL EHMSG(50H Copy current line then do a pl edit on this copy.,-
     *50) 
23069 CONTINUE
      IF(.NOT.( KEYT(1HP)))GOTO 23071 
      CALL EHMSG(9H[.] Ptext,-9)
      CALL EHMSG(34H Do a pl edit on the current line.,-34) 
23071 CONTINUE
      IF(.NOT.( KEYT(1HQ)))GOTO 23073 
      CALL EHMSG(5H[.] Q,-5)
      CALL EHMSG(53H Use terminal's edit keys to edit the line displayed
     *.,-53)
23073 CONTINUE
      IF(.NOT.( KEYT(1HR)))GOTO 23075 
      CALL EHMSG(9H[.] Rtext,-9)
      CALL EHMSG(49H Replace current line.  Escape character applies.,-4
     *9)
      CALL EHMSG(62H If 'U' is the first charecter in the line it must b
     *e escaped.,-62) 
23075 CONTINUE
      IF(.NOT.( KEYT(2HRU)))GOTO 23077
      CALL EHMSG(17HRU program string,-17)
      CALL EHMSG(53H Clone and run a program. Parameters may be separate
     *d,-53)
      CALL EHMSG(41H by spaces and the string is case folded.,-41)
      CALL EHMSG(64H To pass spaces and suppress case folding in the run
     * string use:,-64) 
      CALL EHMSG(1H ,-1)
      CALL EHMSG(55H   /RU program `Pass this string without modificatio
     *n.`,-55)
      CALL EHMSG(1H ,-1)
      CALL EHMSG(52H To pass a back quote in the string use two of them.
     *,-52) 
23077 CONTINUE
      IF(.NOT.( KEYT(1HS)))GOTO 23079 
      CALL EHMSG(14H[.-10][*+20] S,-14) 
      CALL EHMSG(71HScreen mode edit.  See SH SD for current above, belo
     *w and overlap size.,-71)
      CALL EHMSG(69H The screen may be modified using any of the HP264X 
     *or HP262X editing,-69)
      CALL EHMSG(73H features.  When you have what you want enter one of
     * the exit commands as,-73)
      CALL EHMSG(47H   <control character command><carriage return>,-47)
      CALL EHMSG(1H ,-1)
      CALL EHMSG(27H Screen mode commands are :,-27)
      CALL EHMSG(29H  cntl Q  - Quit screen mode.,-29)
      CALL EHMSG(34H  cntl P  - Go to previous screen.,-34) 
      CALL EHMSG(35H  cntl F  - Go to following screen.,-35)
      CALL EHMSG(57H  cntl S  - Start next screen at current cursor posi
     *tion.,-57)
      CALL EHMSG(68H  cntl X  - Like cntl S but make next screen extra l
     *arge (SL lines).,-68) 
      CALL EHMSG(68H  cntl C  - Execute one line mode command and return
     * to screen mode.,-68) 
      CALL EHMSG(68H  cntl O  - Copy.  A copy of current line is inserte
     *d on the screen.,-68) 
      CALL EHMSG(1H ,-1)
      CALL EHMSG(66H Entering the control character once causes the scre
     *en to be read.,-66) 
      CALL EHMSG(59H Entering it twice skips reading the screen and leav
     *es the ,-59)
      CALL EHMSG(64H workspace unchanged.  Thus cntl Q will read the scr
     *een and quit,-64) 
      CALL EHMSG(54H screen mode and cntl Q cntl Q will abort screen mod
     *e.,-54) 
      CALL EHMSG(68H The cntl C will prompt you for the line mode comman
     *d, such as F or ,-68) 
      CALL EHMSG(66H S or WR.  If the prompt is / then the screen will b
     *e read.  If it,-66) 
      CALL EHMSG(39H is \ then the screen will not be read.,-39)
23079 CONTINUE
      IF(.NOT.( KEYT(2HSC)))GOTO 23081
      CALL EHMSG(2HSC,-2) 
      CALL EHMSG(71H Screen copy. Copy everything on the terminal's scre
     *en into work space.,-71)
      CALL EHMSG(43H Stops when 24 zero length lines are found.,-43)
23081 CONTINUE
      IF(.NOT.( KEYT(2HSE)))GOTO 23083
      CALL EHMSG(19HSE option parameter,-19)
      CALL EHMSG(62H Used to set various options and defaults.  Type SH 
     *for a list,-62) 
      CALL EHMSG(70H of options and current values.  If the parameter(s)
     * are defaulted and,-70) 
      CALL EHMSG(66H the option requires a character or numeric value, t
     *he option will,-66) 
      CALL EHMSG(67H be set to its original value.  If it requires an on
     */off value then,-67)
      CALL EHMSG(42H a null parameter will cause it to toggle.,-42) 
23083 CONTINUE
      IF(.NOT.(KEYT(2HSH).OR.KEYT(2H??)))GOTO 23085 
      CALL EHMSG(23HSH,option  or ??,option,-23)
      CALL EHMSG(66H Show options.  SH will show all options, ?? will sh
     *ow ER default.,-66) 
23085 CONTINUE
      IF(.NOT.( KEYT(2HSZ)))GOTO 23087
      CALL EHMSG(2HSZ,-2) 
      CALL EHMSG(59H Approximate size in words of workspace above curren
     *t line.,-59)
23087 CONTINUE
      IF(.NOT.( KEYT(1HT)))GOTO 23089 
      CALL EHMSG(31HT [n1 [n2 [n3 ... [n10] ... ]]],-31)
      CALL EHMSG(40H Set tab columns    (up to 10 tabstops).,-40) 
      CALL EHMSG(2HTA,-2) 
      CALL EHMSG(49H ASMB tab stops     (columns 7 and 21) (default).,-4
     *9)
      CALL EHMSG(2HTF,-2) 
      CALL EHMSG(52H Fortran tab stops  (column 7 then every 4 columns).
     *,-52) 
      CALL EHMSG(2HTM,-2) 
      CALL EHMSG(52H Macro tab stops    (columns 10, 26, 40, 44 and 48).
     *,-52) 
      CALL EHMSG(2HTP,-2) 
      CALL EHMSG(38H Pascal tab stops   (every 3 columns).,-38) 
      CALL EHMSG(1H ,-1)
      CALL EHMSG(2HTL,-2) 
      CALL EHMSG(66H Set terminal's tabstops so that they line up with l
     *ine mode tabs.,-66) 
      CALL EHMSG(2HTS,-2) 
      CALL EHMSG(68H Set terminal's tabstops so that they line up with s
     *creen mode tabs.,-68) 
23089 CONTINUE
      IF(.NOT.( KEYT(2HTR)))GOTO 23091
      CALL EHMSG(11HTR namr [Q],-11)
      CALL EHMSG(66H Transfer command input to namr.  Commands will be e
     *choed onto the,-66) 
      CALL EHMSG(41H screen if the quiet option is not given.,-41)
23091 CONTINUE
      IF(.NOT.( KEYT(2HTI)))GOTO 23093
      CALL EHMSG(8H[.] TI n,-8) 
      CALL EHMSG(63H Replace columns n through n+30 with the current dat
     *e and time.,-63)
23093 CONTINUE
      IF(.NOT.( KEYT(1HU)))GOTO 23095 
      CALL EHMSG(22H[.][*] U /xxx/yyy/ [Q],-22) 
      CALL EHMSG(61H Unconditional replace of xxx characters with the yy
     *y string.,-61)
      CALL EHMSG(60H Number of characters in the xxx field determines th
     *e number,-60) 
      CALL EHMSG(59H of characters to be deleted starting at the window 
     *column.,-59)
      CALL EHMSG(58H After deleting the characters the yyy string is ins
     *erted.,-58) 
      CALL EHMSG(48H Default patterns are the same as the X command.,-48
     *) 
23095 CONTINUE
      IF(.NOT.( KEYT(2HUN)))GOTO 23097
      CALL EHMSG(2HUN,-2) 
      CALL EHMSG(66H Undo last command.  Works for CO, MO, J, D, K, U, X
     *, Y, SC, M and,-66) 
      CALL EHMSG(65H current line edits.  Must be given as the next non-
     *help command.,-65)
23097 CONTINUE
      IF(.NOT.(KEYT(1HW) .OR. KEYT(2HWU) .OR. KEYT(2HWN) ))GOTO 23099 
      CALL EHMSG(14H[.-10][*+20] W,-14) 
      CALL EHMSG(50H List a window of lines.  Returns to current line.,-
     *50) 
      CALL EHMSG(1H ,-1)
      CALL EHMSG(2HWN,-2) 
      CALL EHMSG(22H Numbered window list.,-22) 
      CALL EHMSG(1H ,-1)
      CALL EHMSG(2HWU,-2) 
      CALL EHMSG(24H Unnumbered window list.,-24) 
23099 CONTINUE
      IF(.NOT.(KEYT(1HX)))GOTO 23101
      CALL EHMSG(41H[.][*] X/pattern/substitute/ [N][Q][R][S],-41)
      CALL EHMSG(70H Exchange all occurrences of pattern to substitute i
     *n specified range.,-70) 
      CALL EHMSG(67H When a substitution occurs the new line and line nu
     *mber is listed.,-67)
      CALL EHMSG(70H The R option removes zero length lines.  The origin
     *al line is flagged,-70) 
      CALL EHMSG(23H with a '~' and listed.,-23)
      CALL EHMSG(54H The S option permits only a single exchange per lin
     *e.,-54) 
      CALL EHMSG(1H ,-1)
      CALL EHMSG(63H If a null pattern is given then the F command patte
     *rn is used.,-63)
      CALL EHMSG(68H If no pattern or substitute is given then the last 
     *X,U or Y pattern,-68) 
      CALL EHMSG(24H and substitute is used.,-24) 
23101 CONTINUE
      IF(.NOT.( KEYT(1HY)))GOTO 23103 
      CALL EHMSG(38H[.] Y /pattern/substitute/[N][Q][R][S],-38) 
      CALL EHMSG(68H Exchange pattern to substitute on current then find
     * next occurrence,-68) 
      CALL EHMSG(61H of pattern. Defaults patterns are the same as the X
     * command.,-61)
23103 CONTINUE
      IF(.NOT.( KEYT(1H/)))GOTO 23105 
      CALL EHMSG(5H /[n],-5)
      CALL EHMSG(71H Command stack. Place cursor on command and carriage
     * return execute it.,-71)
      CALL EHMSG(58H The commands may be edited with the terminal's edit
     * keys.,-58) 
23105 CONTINUE
      IF(.NOT.( KEYT(1H#)))GOTO 23107 
      CALL EHMSG(9H#CCCn1,n2,-9)
      CALL EHMSG(51H Add line sequence numbers in columns 73 though 80.,
     *-51)
      CALL EHMSG(66H CCC is a 3 character id, n1 start number and n2 is 
     *the increment.,-66) 
23107 CONTINUE
      IF(.NOT.( KEYT(2HSP)))GOTO 23109
      CALL EHMSG(11H<space>text,-11)
      CALL EHMSG(47H Append text after current line and make it pl.,-47)
23109 CONTINUE
      IF(.NOT.( KEYT(2HDA)))GOTO 23111
      CALL EHMSG(27H EDIT/1000  REV.2034 800821,-27)
23111 CONTINUE
      IF(.NOT. (.NOT. KEYFG ))GOTO 23113
      CALL EHMSG(57H No help for this. Use ? for a list of possible comm
     *ands.,-57)
23113 CONTINUE
      RETURN
      END 
      END$
#                          <800822.0801>
C 
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C 
C           NAME:   EDTU4 
C           SOURCE: 92074-18012 
C           RELOC:  PART OF 92074-12002 
C           PGMR:   J.D.J.
C 
C 
#     DEFAULT LISTER FOR EDIT 
# 
#     JOHN JOHNSON
#     6/22/80 
# 
"      SUBROUTINE SHOW,92074-1X012 REV.2034 800818" 
  
      IMPLICIT INTEGER(A-Z) 
  
      DEFINE(ARB,150) 
  
      INTEGER FBUF0(ARB),XYBF0(ARB),L1BF0(ARB)
      INTEGER L2BF0(ARB),NBUF0(10),LNAM(10),TAB0(20)
      LOGICAL keyt3, KEYFG
      COMMON /ANCCH/ ANCCH
      COMMON /TABCH/ TABCH
      COMMON /INDEF/ INDEF
      COMMON /ESCCH/ ESCCH
      COMMON /BAR/   BAR
      COMMON /ASKFG/ ASKFG
      COMMON /FOLDF/ FOLDF
      COMMON /REFLG/ REFLG
      COMMON /DSPFG/ DSPFG
      COMMON /ABOVE/ ABOVE
      COMMON /BELOW/ BELOW
      COMMON /OLAP / OLAP 
      COMMON /VWABV/ VWABV
      COMMON /VWBLW/ VWBLW
      COMMON /WIND1/ WIND1
      COMMON /WIND2/ WIND2
      COMMON /MAXOP/ MAXOP
      COMMON /FBUF0/ FBUF0
      COMMON /FLNG/ FLNG
      COMMON /XYBF0/ XYBF0
      COMMON /XLNG/ XLNG
      COMMON /YOFFS/ YOFFS
      COMMON /YLNG/ YLNG
      COMMON /L1BF0/ L1BF0
      COMMON /L1LNG/ L1LNG
      COMMON /L2BF0/ L2BF0
      COMMON /L2LNG/ L2LNG
      COMMON /NBUF0/ NBUF0
      COMMON /LNAM/ LNAM
      COMMON /TAB0/ TAB0
      COMMON /KEYFG/ KEYFG
      COMMON /FRTNF/ FRTNF
      COMMON /TMSIZ/ TMSIZ
      COMMON /DLMTR/ DLMTR
      COMMON /TSFLG/ TSFLG
  
      KEYFG = .FALSE. 
  
DEFINE(KEYTEST,[*IF( keyt3($1)) [ *]) 
  
DEFINE(MS,[*CALL MSG($1,-QLENGTH)*])
  
  
if( keyt3('ER') \ keyt3('WR') )[
MS('ER or WR...................... =_') 
  call inam3(NBUF0) 
] 
  
KEYTEST('L')
MS("List file .................... =_") 
   call inam3(LNAM) 
] 
  
if( keyt3('F ') \ keyt3('B ') \KEYT3('D'))[ 
MS('F, B, D or line spec pattern...=_') 
   call buff3(fbuf0,flng )
] 
  
  
if( keyt3('X') \ keyt3('U') \ KEYT3('Y') \ KEYT3('G') )[
MS('G, U, X or Y match.............=_') 
  call buff3(XYBF0,XLNG)
MS('G, U, X or Y substitute........=_') 
  call buff3(xybF0((yoffs+1)/2+1),ylng) 
 ]
  
keytest('AL') 
MS('            Set command options') 
] 
  
KEYTEST('AC') 
MS('Anchor character........... AC =_') 
   CALL MSG(ancch,-2) 
] 
  
  
  
KEYTEST('EC') 
MS('escape character........... EC =_') 
   CALL MSG(ESCCH,-2) 
] 
  
  
KEYTEST('IC') 
MS('indefinite character....... IC =_') 
   CALL MSG(INDEF,-2) 
  
] 
  
  
  
KEYTEST('PC') 
MS('prompt character........... PC =_') 
   call msg(dlmtr,-2) 
] 
  
KEYTEST('CS') 
MS('command separator.......... CS =_') 
   call msg(bar,-2) 
] 
  
 IF(KEYT3('TC') \ KEYT3('T') )[ 
MS('Tab character.............. TC =_') 
 if(tabch == 11b) 
   MS('tab (cntl I)') 
 else 
   CALL MSG(tabch,-2) 
MS('Tab columns....................=_') 
 for( i=1 ; TAB0(I) ^= 0 ; i=i+1) 
    call pnum(1-TAB0(i))
  ms('  ')  # give the lf 
 ]
  
KEYTEST('WC') 
MS('Search window columns...... WC =_') 
  call pnum(wind1+1)
  call pnum(-WIND2) 
MS( ' ' )   #  give lf
] 
  
if(keyt3('SD'))[
MS('Screen defaults............ SD =_') 
   call pnum(above) 
   call pnum(below) 
   call pnum(olap)
MS(' ') 
] 
  
KEYTEST('SL') 
MS('Maximum screen mode lines.. SL =_') 
  call pnum(-tmsiz) 
MS(' ') 
] 
  
if(keyt3('VW'))[
MS('Vertical window ........... VW =_') 
   call pnum(vwabv) 
   call pnum(vwblw) 
MS(' ') 
] 
keytest('LE') 
ms('Line length ............... LE =_') 
    call pnum(MAXOP)
   MS(' ')
] 
KEYTEST('AS') 
MS('Asking..................... AS =_') 
   call puoff(askfg)
] 
  
keytest('CF') 
MS('Case folding............... CF =_') 
   call puoff(FOLDF)
] 
  
keytest('RE') 
MS('Regular expressions........ RE =_') 
   call puoff(reflg)
] 
  
keytest('RT') 
MS('Return to dot if no match.. RT =_') 
      call puoff(FRTNF) 
] 
  
keytest('DF') 
MS('Screen mode display functs. DF =_') 
      call puoff(DSPFG) 
] 
  
KEYTEST('TS') 
MS('Time stamp <YYMMDD.HHMM>... TS =_') 
      call puoff(TSFLG) 
] 
  
  
 if( .NOT. KEYFG )
 MS('Not an option.  Type SH to show all options and their current setting.') 
  
      end 
  
  
"      SUBROUTINE PNUM(I),92074-1X012 REV.2034 800818"
      integer i, buf(4) 
      chardata buf/'      _'/ 
  
      call cnumd(i,buf) 
      call msg(buf,-7)
      end 
  
  
  
"      SUBROUTINE PUOFF(FLAG),92074-1X012 REV.2034 800818"
      integer flag,on,off(2)
      chardata on/'on'/ 
      chardata off/'off'/ 
  
      if( flag == 0 ) 
        call msg(off,-3)
      else
        call msg(on,-2) 
      end 
  
  
  
"       SUBROUTINE BUFF3(TEXT,LENGTH),92074-1X012 REV.2034 800818"
        INTEGER TEXT(LENGTH),LENGTH 
        IF( LENGTH > 0 ) [
          CALL MSG(TEXT,-LENGTH)
          ] 
        ELSE [
           MS(' ')
        ] 
        END 
"      SUBROUTINE MSG(MESS,L),92074-1X012 REV.2034 800818"
      INTEGER MESS(L) 
      COMMON /lstlu/ lstlu
  
 97   CALL EXEC(100002b,lstlu,MESS,L) 
 98   goto 100
  
100   RETURN
      END 
  
"       SUBROUTINE INAM3(INBUF),92074-1X012 REV.2034 800818"
        INTEGER INBUF(10),BUF(20) 
  
        IF( INBUF(4) ^= 0 ) [ 
          I = 0 
          CALL INAMR(INBUF,BUF,40,I)
          I = -I+1
          CALL MSG(BUF,I) 
          ] 
        ELSE
          MS('  ')
  
        END 
  
  
"      LOGICAL FUNCTION KEYT3(TEST),92074-1X012 REV.2034 800818"
      INTEGER TEST
      LOGICAL KEYFG 
      COMMON /KEYFG/ KEYFG
      COMMON /KEY/ KEY
      keyt3 = ( (TEST .EQ. KEY) \ (KEY .EQ. 'AL'))
      IF(keyt3) 
        KEYFG = .TRUE.
      END 
  
  
  
DEFINE(KEYTEST,[* 
         IF( KEYT($1)) [ *])
DEFINE(MS,[*CALL EHMSG($1,-QLENGTH)*])
  
"      SUBROUTINE EHMSG(MESS,L),92074-1X012 REV.2034 800818"
      INTEGER MESS(L) 
      COMMON /lstlu/ lstlu
      common/key/ key 
  
  
      CALL EXEC(100002b,lstlu,'  _',-3) 
 96    goto 100 
 97   CALL EXEC(100002b,lstlu,MESS,L) 
 98   goto 100
 99   CONTINUE
      IF(  ifbrk(junk) ^= 0 ) 
          key = 0 
       return 
  
100   key = 0 
      RETURN
      END 
# 
# 
# 
  
"      LOGICAL FUNCTION KEYT(TEST),92074-1X012 REV.2034 800818" 
      INTEGER TEST
      LOGICAL KEYFG 
      COMMON /KEYFG/ KEYFG
      COMMON /KEY/ KEY
      IF( KEY .EQ. 'AL') [
         MS(' ')
         MS(' ')
         ]
      keyt = ( (TEST .EQ. KEY) \ (KEY .EQ. 'AL')) 
      IF(keyt)
        KEYFG = .TRUE.
      END 
  
# 
# 
# 
# 
  
  
"      SUBROUTINE EHLP2,92074-1X012 REV.2034 800818"
  
                      
      IMPLICIT INTEGER(A-Z) 
  
      LOGICAL KEYT,KEYFG
      COMMON  /KEYFG/ KEYFG 
  
  
  
  
KEYTEST('MO') 
MS(' l1 [*] MO [Q]')
MS('  Move lines in range to after current line.')
] 
  
KEYTEST('N')
MS('N') 
MS(' Current line number.') 
] 
  
KEYTEST('O')
MS('[.] Otext') 
MS(' Copy current line then do a pl edit on this copy.')
] 
  
KEYTEST('P')
MS('[.] Ptext') 
MS(' Do a pl edit on the current line.')
] 
  
KEYTEST('Q')
MS('[.] Q') 
MS(" Use terminal's edit keys to edit the line displayed.") 
] 
  
KEYTEST('R')
MS('[.] Rtext') 
MS(' Replace current line.  Escape character applies.') 
MS(" If 'U' is the first charecter in the line it must be escaped.")
] 
  
KEYTEST('RU') 
MS('RU program string') 
MS(' Clone and run a program. Parameters may be separated') 
MS(' by spaces and the string is case folded.') 
MS(' To pass spaces and suppress case folding in the run string use:')
MS(' ') 
MS("   /RU program `Pass this string without modification.`") 
MS(' ') 
MS(' To pass a back quote in the string use two of them.')
] 
KEYTEST('S')
MS('[.-10][*+20] S')
MS('Screen mode edit.  See SH SD for current above, below and overlap size.') 
MS(" The screen may be modified using any of the HP264X or HP262X editing") 
MS(' features.  When you have what you want enter one of the exit commands as') 
MS('   <control character command><carriage return>') 
MS(' ') 
MS(' Screen mode commands are :') 
MS('  cntl Q  - Quit screen mode.') 
MS('  cntl P  - Go to previous screen.')
MS('  cntl F  - Go to following screen.') 
MS('  cntl S  - Start next screen at current cursor position.') 
MS('  cntl X  - Like cntl S but make next screen extra large (SL lines).')
MS('  cntl C  - Execute one line mode command and return to screen mode.')
MS('  cntl O  - Copy.  A copy of current line is inserted on the screen.')
MS(' ') 
MS(' Entering the control character once causes the screen to be read.')
MS(' Entering it twice skips reading the screen and leaves the ') 
MS(' workspace unchanged.  Thus cntl Q will read the screen and quit')
MS(' screen mode and cntl Q cntl Q will abort screen mode.')
MS(' The cntl C will prompt you for the line mode command, such as F or ')
MS(' S or WR.  If the prompt is / then the screen will be read.  If it')
MS(' is \ then the screen will not be read.') 
] 
  
KEYTEST('SC') 
MS('SC')
MS(" Screen copy. Copy everything on the terminal's screen into work space.") 
MS(' Stops when 24 zero length lines are found.') 
] 
  
KEYTEST('SE') 
MS('SE option parameter') 
MS(' Used to set various options and defaults.  Type SH for a list')
MS(' of options and current values.  If the parameter(s) are defaulted and')
MS(' the option requires a character or numeric value, the option will')
MS(' be set to its original value.  If it requires an on/off value then') 
MS(' a null parameter will cause it to toggle.')
] 
  
IF(keyt('SH')\keyt('??'))[
MS('SH,option  or ??,option') 
MS(' Show options.  SH will show all options, ?? will show ER default.')
] 
  
keytest('SZ') 
MS('SZ')
MS(' Approximate size in words of workspace above current line.') 
] 
  
KEYTEST('T')
MS('T [n1 [n2 [n3 ... [n10] ... ]]]') 
MS(' Set tab columns    (up to 10 tabstops).')
MS('TA')
MS(' ASMB tab stops     (columns 7 and 21) (default).') 
MS('TF')
MS(' Fortran tab stops  (column 7 then every 4 columns).')
MS('TM')
MS(' Macro tab stops    (columns 10, 26, 40, 44 and 48).')
MS('TP')
MS(' Pascal tab stops   (every 3 columns).')
MS(' ') 
MS('TL')
MS(" Set terminal's tabstops so that they line up with line mode tabs.")
MS('TS')
MS(" Set terminal's tabstops so that they line up with screen mode tabs.")
] 
  
KEYTEST('TR') 
MS('TR namr [Q]') 
MS(' Transfer command input to namr.  Commands will be echoed onto the')      
MS(' screen if the quiet option is not given.') 
] 
  
KEYTEST('TI') 
MS('[.] TI n')
MS(' Replace columns n through n+30 with the current date and time.') 
] 
  
KEYTEST('U')
MS('[.][*] U /xxx/yyy/ [Q]')
MS(' Unconditional replace of xxx characters with the yyy string.') 
MS(' Number of characters in the xxx field determines the number')
MS(' of characters to be deleted starting at the window column.') 
MS(' After deleting the characters the yyy string is inserted.')
MS(' Default patterns are the same as the X command.')
] 
  
KEYTEST('UN') 
MS('UN')
MS(' Undo last command.  Works for CO, MO, J, D, K, U, X, Y, SC, M and')
MS(' current line edits.  Must be given as the next non-help command.') 
] 
  
IF(KEYT('W') \ KEYT('WU') \ KEYT('WN') ) [
MS('[.-10][*+20] W')
MS(' List a window of lines.  Returns to current line.')
MS(' ') 
MS('WN')
MS(' Numbered window list.')
MS(' ') 
MS('WU')
MS(' Unnumbered window list.')
] 
  
if(keyt('X'))[
MS('[.][*] X/pattern/substitute/ [N][Q][R][S]') 
MS(' Exchange all occurrences of pattern to substitute in specified range.')
MS(' When a substitution occurs the new line and line number is listed.') 
MS(' The R option removes zero length lines.  The original line is flagged')
MS(" with a '~' and listed.") 
MS(' The S option permits only a single exchange per line.')
MS(' ') 
MS(' If a null pattern is given then the F command pattern is used.') 
MS(' If no pattern or substitute is given then the last X,U or Y pattern')
MS(' and substitute is used.')
] 
  
KEYTEST('Y')
MS('[.] Y /pattern/substitute/[N][Q][R][S]')
MS(' Exchange pattern to substitute on current then find next occurrence')
MS(' of pattern. Defaults patterns are the same as the X command.') 
] 
  
  
  
KEYTEST('/')
MS(' /[n]') 
MS(' Command stack. Place cursor on command and carriage return execute it.') 
MS(" The commands may be edited with the terminal's edit keys.")
] 
  
KEYTEST('#')
MS('#CCCn1,n2') 
MS(' Add line sequence numbers in columns 73 though 80.') 
MS(' CCC is a 3 character id, n1 start number and n2 is the increment.')
] 
  
KEYTEST('SP') 
MS('<space>text') 
MS(' Append text after current line and make it pl.') 
] 
  
KEYTEST('DA') 
MS(' EDIT/1000  REV.2034 800821') 
] 
  
  
if (.not. keyfg ) 
MS(' No help for this. Use ? for a list of possible commands.') 
  
RETURN
 END