**********************************************************************************************
      * DBG020R4: Edit text screen
      * Copyright (C) 2000  Martin Rowe  <martin@dbg400.net>
      *
      * This program is free software; you can redistribute it and/or modify
      * it under the terms of the GNU General Public License as published by
      * the Free Software Foundation; either version 2 of the License, or
      * (at your option) any later version.
      *
      * This program is distributed in the hope that it will be useful,
      * but WITHOUT ANY WARRANTY; without even the implied warranty of
      * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
      * GNU General Public License for more details.
      *
      * You should have received a copy of the GNU General Public License
      * along with this program; if not, write to the Free Software
      * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
      **********************************************************************************************
      *  N.B. This pgm uses workfile logicals, TEMPDFT1 & TEMPDFT2. These are copies of DBGDFTD1 &
      *  DBGDFTD2 in QTEMP. To create this program, wrap the CRTBNDRPG command with overrides, or
      *  create permanent copies of the objects.
      **********************************************************************************************
     H DATEDIT(*YMD) DEBUG(*YES) OPTION(*NODEBUGIO : *SRCSTMT)
      **********************************************************************************************
      * FILES:
      **********************************************************************************************
     FTEMPDFT1  UF A E           K DISK    USROPN
     F                                     RENAME(DB1DFT0:TEMP0)
     FTEMPDFT2  UF   E           K DISK    USROPN
     F                                     RENAME(DB1DFT1:TEMP1)
     FDBGDFTD1  UF A E           K DISK
     FDBGDFTH1  UF   E           K DISK
     FDBG020DF  CF   E             WORKSTN
     F                                     SFILE(SFL:RRN1)
      **********************************************************************************************
      * ARRAYS:
      **********************************************************************************************
      *  Input text 50 lines of upto 132 characters
     D P#I             S            132    DIM(50)
      *  Output text 50 lines of upto 132 characters
     D P#O             S            132    DIM(50)
      **********************************************************************************************
      * DATA STRUCTURES:
      **********************************************************************************************
      *  PROGRAM NAME
     D                SDS
     D PGM                           10
     D #@User                254    263
      *
     D                 DS
     D Cmd                           40    INZ('CLRPFM FILE(QTEMP/DB-
     D                                     GDFTD0)             ')
      *
     D Banner          DS            79
     D Headtx                        13    INZ('Edit Text for')
     D Docmnt                 15     24
     D Descrp                 26     75
      *
     D                 DS
     D  Atr                    1     48
     D                                     DIM(24)
     D  ATR001                 1      2
     D  ATR002                 3      4
     D  ATR003                 5      6
     D  ATR004                 7      8
     D  ATR005                 9     10
     D  ATR006                11     12
     D  ATR007                13     14
     D  ATR008                15     16
     D  ATR009                17     18
     D  ATR010                19     20
     D  ATR011                21     22
     D  ATR012                23     24
     D  ATR013                25     26
     D  ATR014                27     28
     D  ATR015                29     30
     D  ATR016                31     32
     D  ATR017                33     34
     D  ATR018                35     36
     D  ATR019                37     38
     D  ATR020                39     40
     D  ATR021                41     42
     D  ATR022                43     44
     D  ATR023                45     46
     D  ATR024                47     48
      *
      **********************************************************************************************
      * NAMED CONSTANTS:
      **********************************************************************************************
     D Atribs          C                   CONST(X'215C225C235C245C-
     D                                     255C265C305C315C325C-
     D                                     335C345C355C365C285C-
     D                                     295C2C5C2D5C385C395C-
     D                                     3A5C3B5C3C5C3D5C3E5C')
     D Blanks          C                   CONST(X'4040404040404040404040404040-
     D                                     4040404040404040404040')
     D DspAtr          C                   CONST(X'2021222324252630313233343536-
     D                                     28292C2D38393A3B3C3D3E')
     D Lower           C                   CONST('abcdefghijklmnopqrstuvwxyz')
     D Upper           C                   CONST('ABCDEFGHIJKLMNOPQRSTUVWXYZ')
      **********************************************************************************************
      * WORK FIELDS:
      **********************************************************************************************
     D #C              S              3  0
     D #E              S              1
     D #Errid          S              7
     D #L              S              3  0
     D #O              S              3  0
     D #P              S              3  0
     D #S              S              1
     D BegWrp          S              5  0
     D CmdLen          S             15  5
     D CmdStr          S            256
     D CpyDta          S             79
     D CsrPos          S              3  0
     D CurrentLine     S              5  0
     D DataToScan      S             80
     D DtaLen          S              5  0
     D EndWrp          S              5  0
     D ErrCde          S              1
     D GoCopy          S              1
     D GoMove          S              1
     D GoOver          S              1
     D GoWrap          S              1
     D HldPag          S              4  0
     D HldWrp          S              5  0
     D Ignore          S              3  0
     D LDA             S            512
     D Len#1           S              3  0
     D Len#2           S              3  0
     D Lineno          S              5  0
     D LineNumber      S              3  0
     D MovDta          S             79
     D MsgDta          S            512
     D MsgFil          S             10
     D MsgID           S              7
     D MsgLib          S             10
     D MsgTyp          S             10
     D Needed          S              3  0
     D NewLin          S              5  0
     D Object          S             10
     D ObjTyp          S             10
     D OrgSeq          S              5  0
     D OvrDta          S             79
     D P#Elen          S              3  0
     D P#Flen          S              3  0
     D P#In1           S            256
     D P#In2           S            256
     D P#Out           S            256
     D P#Rent          S              3  0
     D P#Tent          S              3  0
     D P#TextLine      S            132
     D PatternLen      S              3  0
     D PgmQ            S             10
     D PgmStk          S              5  0
     D RcdNbr          S              4  0
     D Remain          S              3  0
     D Result          S             79
     D Rrn1            S              4  0
     D SearchMask      S             25
     D SearchString    S             25
     D StartPos        S              3  0
     D StringLen       S              3  0
     D StringPos       S              3  0
     D Sv#Col          S              3  0
     D Sv#Lin          S              3  0
     D SyntaxPgm       S             10
     D Tolib           S             10
     D Toobj           S             10
     D Totrrn          S              4  0
     D Totseq          S              5  0
     D Translate       S              1
     D Trim            S              1
     D W#Data          S             79
     D Wrap            S              1
     D Wildcard        S              1
      **********************************************************************************************
      * ENTRY PARAMETERS:
      **********************************************************************************************
     C     *ENTRY        PLIST
     C                   PARM                    P#DOCD
     C                   PARM                    P#TITL
      **********************************************************************************************
      * MAINLINE:
      **********************************************************************************************
     C                   EXSR      #INITS
      *  Screen display
     C                   CALL      'DBG045CL'                           90      REMOVE MSGS
B001 C                   DOW       *IN03 = *OFF
      *
     C                   WRITE     MSFLC                                        MSG SUBFILE
     C                   WRITE     FOOTER
     C                   EVAL      *IN36 = Rrn1 > 0
     C                   EXFMT     SFLCTL
     C                   CALL      'DBG045CL'                           90      REMOVE MSGS
      *  Store current cursor location
     C                   EVAL      Sv#Lin = CSRLIN
     C                   EVAL      Sv#Col = CSRCOL
     C                   EVAL      HldPag = 1
      *  Store subfile page number
B002 C                   IF        RELRCD > 0
     C                   EVAL      HldPag = RELRCD
E002 C                   ENDIF
      *  Process response
B002 C                   SELECT
      *  F2=Syntax prompt/check routine
S002 C                   WHEN      *IN02 = *ON
     C                             AND SyntaxPgm <> *BLANKS
     C     RELRCD        CHAIN     SFL                                80
B003 C                   IF        *IN80 = *OFF
     C                   CALL      SyntaxPgm                            90
     C     TXTDTA        PARM      TXTDTA        P#TextLine
     C                   UPDATE    SFL
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E003 C                   ENDIF
      *  F3=Exit
S002 C                   WHEN      *IN03 = *ON
     C                             OR *IN12 = *ON
      *  Display exit panel
     C                   MOVE      'Y'           #SSAVE
     C                   EXFMT     WINDOW2
      *  If F12=Previous not requested
B003 C                   IF        *IN12 = *OFF
      *  If 'Save changes' is 'Y'es
B004 C                   IF        #SSAVE = 'Y'
      *  Load screen subfile to temp file, process, & write back to document
     C                   EXSR      DWLOAD
     C                   EXSR      UPDATE
E004 C                   ENDIF
      *  Exit display
     C                   LEAVE
      *  Otherwise user wants to stay on the edit screen so set off exit inds
X003 C                   ELSE
     C                   EVAL      *IN03 = *OFF
     C                   EVAL      *IN12 = *OFF
E003 C                   ENDIF
      *  F4=Split line
S002 C                   WHEN      *IN04 = *ON
     C     RELRCD        CHAIN     SFL                                80
B003 C                   IF        *IN80 = *OFF
      *  Store page number for redisplay
     C                   EVAL      HldPag = RELRCD
     C                   EVAL      CsrPos = CSRCOL - 1
B004 C                   IF        CsrPos > 1
      *  Allocate line number (to go above selected line)
     C                   EVAL      NewLin = TXTSEQ
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E004 C                   ENDIF
E003 C                   ENDIF
      *  F5=Move
S002 C                   WHEN      *IN05 = *ON
     C     RELRCD        CHAIN     SFL                                80
B003 C                   IF        *IN80 = *OFF
      *  Store page number for redisplay
     C                   EVAL      HldPag = RELRCD
      *  If selecting the move line
B004 C                   IF        GoMove = *OFF
      *  Flag to select the move location next time round
     C                   MOVE      *ON           GoMove
      *  Highlight the line to be moved
     C                   MOVE      TXTDTA        MovDta
     C                   EVAL      OrgSeq = TXTSEQ
     C                   MOVE      X'23'         TXTATR
     C                   UPDATE    SFL
      *  Tell user to put cursor on desired line & press F5 again
     C                   MOVE      'GSM0302'     MsgID
     C                   EVAL      MsgDta = *BLANKS
     C                   EVAL      DtaLen = 0
     C                   EVAL      PgmStk = 0
     C                   EXSR      SNDMSG
      *  Put cursor back to prior location
     C                   EVAL      LINE = Sv#Lin
     C                   EVAL      COL = Sv#Col
     C                   EVAL      SFPAGE = RELRCD
      *  Otherwise, user is specifying move location
X004 C                   ELSE
      *  Flag back to standard overlay status
     C                   MOVE      *OFF          GoMove
      *  Allocate line number (to go above selected line)
      *  If moved line to go above previous location, use that line number
B005 C                   IF        TXTSEQ < OrgSeq
     C                   EVAL      NewLin = TXTSEQ
      *  otherwise account for shuffling up of all lines above new location
X005 C                   ELSE
     C                   EVAL      NewLin = TXTSEQ - 10
E005 C                   ENDIF
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E004 C                   ENDIF
E003 C                   ENDIF
      *  F6=Insert
S002 C                   WHEN      *IN06 = *ON
     C     RELRCD        CHAIN     SFL                                80
B003 C                   IF        *IN80 = *OFF
      *  Store page number for redisplay
     C                   EVAL      HldPag = RELRCD
      *  Allocate line number (to go above selected line)
     C                   EVAL      NewLin = TXTSEQ
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E003 C                   ENDIF
      *  F7=Copy
S002 C                   WHEN      *IN07 = *ON
     C     RELRCD        CHAIN     SFL                                80
B003 C                   IF        *IN80 = *OFF
      *  Store page number for redisplay
     C                   EVAL      HldPag = RELRCD
      *  If selecting the copy line
B004 C                   IF        GoCopy = *OFF
      *  Flag to select the copy location next time round
     C                   MOVE      *ON           GoCopy
      *  Highlight the line to be copied
     C                   MOVE      TXTDTA        CpyDta
     C                   MOVE      X'23'         TXTATR
     C                   UPDATE    SFL
      *  Tell user to put cursor on desired line & press F7 again
     C                   MOVE      'GSM0300'     MsgID
     C                   EVAL      MsgDta = *BLANKS
     C                   EVAL      DtaLen = 0
     C                   EVAL      PgmStk = 0
     C                   EXSR      SNDMSG
      *  Put cursor back to prior location
     C                   EVAL      LINE = Sv#Lin
     C                   EVAL      COL = Sv#Col
     C                   EVAL      SFPAGE = RELRCD
      *  Otherwise, user is specifying copy location
X004 C                   ELSE
      *  Flag back to standard copy status
     C                   MOVE      *OFF          GoCopy
      *  Allocate line number (to go above selected line)
     C                   EVAL      NewLin = TXTSEQ
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E004 C                   ENDIF
E003 C                   ENDIF
      *  F8=Remove
S002 C                   WHEN      *IN08 = *ON
     C     RELRCD        CHAIN     SFL                                80
B003 C                   IF        *IN80 = *OFF
      *  Store page number for redisplay
     C                   EVAL      HldPag = RELRCD
      *  Throw line to end of file (blanked out) & it wiil be removed
     C                   EVAL      TXTSEQ = 99999
     C                   EVAL      TXTDTA = *BLANKS
     C                   UPDATE    SFL
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E003 C                   ENDIF
      *  F9=Overlay
S002 C                   WHEN      *IN09 = *ON
     C     RELRCD        CHAIN     SFL                                80
B003 C                   IF        *IN80 = *OFF
      *  Store page number for redisplay
     C                   EVAL      HldPag = RELRCD
      *  If selecting the overlay line
B004 C                   IF        GoOver = *OFF
      *  Flag to select the overlay location next time round
     C                   MOVE      *ON           GoOver
      *  Highlight the line to be overlaid
     C                   MOVE      TXTDTA        OvrDta
     C                   EVAL      OrgSeq = TXTSEQ
     C                   MOVE      X'23'         TXTATR
     C                   UPDATE    SFL
      *  Tell user to put cursor on desired line & press F9 again
     C                   MOVE      'GSM0303'     MsgID
     C                   EVAL      MsgDta = *BLANKS
     C                   EVAL      DtaLen = 0
     C                   EVAL      PgmStk = 0
     C                   EXSR      SNDMSG
      *  Put cursor back to prior location
     C                   EVAL      LINE = Sv#Lin
     C                   EVAL      COL = Sv#Col
     C                   EVAL      SFPAGE = RELRCD
      *  Otherwise, user is specifying overlay location
X004 C                   ELSE
      *  Flag back to standard overlay status
     C                   MOVE      *OFF          GoOver
     C                   CALL      'DBG042R3'                           90
     C                   PARM      OvrDta        P#In1
     C                   PARM      TXTDTA        P#In2
     C                   PARM                    P#Out
     C                   MOVEL     P#Out         TXTDTA
     C                   EVAL      OvrDta = *BLANKS
     C                   MOVE      X'20'         TXTATR
     C                   UPDATE    SFL
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E004 C                   ENDIF
E003 C                   ENDIF
      *  F10=Attributes
S002 C                   WHEN      *IN10 = *ON
     C     RELRCD        CHAIN     SFL                                80
B003 C                   IF        *IN80 = *OFF
      *  Store page number for redisplay
     C                   EVAL      HldPag = RELRCD
      *  Select the desired attributes for the text
     C                   EXSR      ATTRIB
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E003 C                   ENDIF
      *  F11=Word wrap
S002 C                   WHEN      *IN11 = *ON
     C     RELRCD        CHAIN     SFL                                80
B003 C                   IF        *IN80 = *OFF
      *  Store page number for redisplay
     C                   EVAL      HldPag = RELRCD
      *  If selecting the first word wrap line
B004 C                   IF        GoWrap = *OFF
      *  Flag to select the copy location next time round
     C                   MOVE      *ON           GoWrap
      *  Highlight the wrapping start line
     C                   MOVE      TXTSEQ        BegWrp
     C                   MOVE      X'23'         TXTATR
     C                   UPDATE    SFL
      *  Tell user to put cursor on the last line to be wrapped, & press 14
     C                   MOVE      'GSM0307'     MsgID
     C                   EVAL      MsgDta = *BLANKS
     C                   EVAL      DtaLen = 0
     C                   EVAL      PgmStk = 0
     C                   EXSR      SNDMSG
      *  Put cursor back to prior location
     C                   EVAL      LINE = Sv#Lin
     C                   EVAL      COL = Sv#Col
     C                   EVAL      SFPAGE = RELRCD
      *  Otherwise, user is specifying copy location
X004 C                   ELSE
      *  Flag back to standard wrap status
     C                   MOVE      *OFF          GoWrap
      *  Allocate line number (end of wrap block)
     C                   EVAL      EndWrp = TXTSEQ
      *  Shuffle line numbers if wrap selection done in reverse order (end wrap
      *  line selected first, then start wrap line).
B005 C                   IF        BegWrp > EndWrp
     C                   EVAL      HldWrp = EndWrp
     C                   EVAL      EndWrp = BegWrp
     C                   EVAL      BegWrp = HldWrp
E005 C                   ENDIF
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E004 C                   ENDIF
E003 C                   ENDIF
      *  F14=Find Options
S002 C                   WHEN      *IN14 = *ON
     C                   EXSR      FINDOPTIONS
      *  F16=Find
S002 C                   WHEN      *IN16 = *ON
     C                   EXSR      FIND
      *  Roll up
S002 C                   WHEN      *IN60 = *ON
      *  Add a page of blank records
     C                   EXSR      ADDPAG
      *  Print (*IN29)
S002 C                   WHEN      *IN29 = *ON
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
      *  Print the current 'live' document
     C                   CALL      'DBG015R4'                           90
     C                   PARM                    P#DOCD
     C                   PARM                    P#TITL
      *  Inform user that report has been printed
     C                   MOVE      'GSM0301'     MsgID
     C     P#DOCD        CAT(P)    P#TITL        MsgDta
     C                   EVAL      DtaLen = 60
     C                   EVAL      PgmStk = 0
     C                   EXSR      SNDMSG
      *  Otherwise, just save the current changes
S002 C                   OTHER
      *  Load screen subfile to temp file, process, & copy back to screen
     C                   EXSR      DWLOAD
     C                   EXSR      UPLOAD
E002 C                   ENDSL
E001 C                   ENDDO
      *  Update the index lock
     C     P#DOCD        CHAIN     DBGDFTH1                           80
B001 C                   IF        *IN80 = *OFF
     C                   MOVE      'F'           DFLOCK
     C                   UPDATE    DB1DFTH
E001 C                   ENDIF
      *
     C                   EVAL      *INLR = *ON
     C                   RETURN
      **************************************************************************
      *  #INITS: INITIALISE ROUTINE
      **************************************************************************
     C     #INITS        BEGSR
      *  Create temp physical of document formatted text file
     C                   CALL      'DBG046CL'                           90
     C                   PARM      'DBGDFTD0'    Object
     C                   PARM      '*FILE'       ObjTyp
     C                   PARM      'DBGDFTD0'    Toobj
     C                   PARM      'QTEMP'       Tolib
     C                   PARM      '0'           ErrCde
      *  Create temp logicals over temp document formatted text file
     C                   CALL      'DBG046CL'                           90
     C                   PARM      'DBGDFTD1'    Object
     C                   PARM      '*FILE'       ObjTyp
     C                   PARM      'TEMPDFT1'    Toobj
     C                   PARM      'QTEMP'       Tolib
     C                   PARM      '0'           ErrCde
      *
     C                   CALL      'DBG046CL'                           90
     C                   PARM      'DBGDFTD2'    Object
     C                   PARM      '*FILE'       ObjTyp
     C                   PARM      'TEMPDFT2'    Toobj
     C                   PARM      'QTEMP'       Tolib
     C                   PARM      '0'           ErrCde
      *  Clear the file out (if running in same job as earlier editor session)
     C                   CALL      'QCMDEXC'                            90
     C                   PARM      Cmd           CmdStr
     C                   PARM      40            CmdLen
      *  Open the temp logicals
     C                   OPEN      TEMPDFT1
     C                   OPEN      TEMPDFT2
      *  Load the temp physical with selected document
     C     P#DOCD        CHAIN     DBGDFTD1                           80
B001 C                   DOW       *IN80 = *OFF
     C                   WRITE     TEMP0
     C     P#DOCD        READE     DBGDFTD1                               80
E001 C                   ENDDO
      *  Field setups
      *  Get company name
     C     *DTAARA       DEFINE    DBGCOMP       COMPNY
     C                   IN        COMPNY
      * Get primary search string if present
     C     *DTAARA       DEFINE    *LDA          LDA
     C                   IN        LDA
     C                   EVAL      FINDSTRING = %SUBST(LDA:503:10)
     C                   EVAL      SyntaxPgm = %SUBST(LDA:493:10)
     C                   MOVE      P#DOCD        Docmnt
     C                   MOVE      P#TITL        Descrp
     C                   MOVE      *OFF          GoMove
     C                   MOVE      *OFF          GoCopy
     C                   MOVE      *OFF          GoOver
     C                   MOVE      *OFF          GoWrap
     C                   EVAL      CpyDta = *BLANKS
     C                   EVAL      OvrDta = *BLANKS
     C                   EVAL      MovDta = *BLANKS
     C                   EVAL      W#Data = *BLANKS
     C                   EVAL      NewLin = 0
     C                   EVAL      CsrPos = 0
     C                   EVAL      #P = 0
     C                   EVAL      Len#1 = 0
     C                   EVAL      Len#2 = 0
     C                   EVAL      OrgSeq = 0
     C                   EVAL      BegWrp = 0
     C                   EVAL      EndWrp = 0
     C                   EVAL      HldWrp = 0
     C                   MOVEA     Atribs        Atr
     C                   MOVE      '{'           STRIND
     C                   MOVE      '}'           ENDIND
     C                   MOVE      X'20'         #E
     C                   EVAL      HldPag = 1
      * Set Find defaults
     C                   EVAL      MATCHTYPE = '2'
     C                   EVAL      Wrap = *ON
      *  Load screen from temp file
     C                   EXSR      UPLOAD
      *  Enable message subfile keywords
     C                   EVAL      *IN26 = *ON
      *
     C                   ENDSR
      **************************************************************************
      *  DWLOAD: DOWNLOAD DATA TO DATABASE FILE FROM SCREEN
      **************************************************************************
     C     DWLOAD        BEGSR
      *  Loop through the whole subfile, loading into temp file
     C                   EVAL      DFLINE = 0
     C                   CLEAR                   P#I
     C                   EVAL      #C = 0
B001 C     1             DO        Totrrn        RcdNbr
     C     RcdNbr        CHAIN     SFL                                80
B002 C                   IF        *IN80 = *OFF
      * If word wrapping this block
B003 C                   IF        TXTSEQ >= BegWrp
     C                             AND TXTSEQ <= EndWrp
      * Store text in array, ready for wrapping
     C                   EVAL      #C = #C + 1
     C                   MOVEL     TXTDTA        P#I(#C)
      * If on the last line of the word wrap block
B004 C                   IF        TXTSEQ = EndWrp
      *  Fit text to screen size (78 char length)
     C                   CALL      'DBG040R3'                           90
     C                   PARM      #C            P#Tent                         Text entries
     C                   PARM      79            P#Elen                         Entry length
     C                   PARM                    P#I                            Entry data
     C                   PARM      78            P#Flen                         Format to length
     C                   PARM                    P#Rent                         Returned entries
     C                   PARM                    P#O                            Returned data
      *  If format text line program completed okay, load screen fields
B005 C                   IF        *IN90 = *OFF
B006 C     1             DO        P#Rent        #L
     C                   MOVEL     P#O(#L)       DFTEXT
     C                   EVAL      DFLINE = DFLINE + 10
     C                   WRITE     TEMP0
E006 C                   ENDDO
E005 C                   ENDIF
E004 C                   ENDIF
      * Otherwise processing non wrap lines
X003 C                   ELSE
      *  Don't write lines to be removed after F5=Move/F8=Remove/F9=Overlay
B004 C                   IF        TXTSEQ <> OrgSeq
     C                             AND TXTSEQ <> 99999
      *  Bump up text sequence by ten for each line
     C                   EVAL      DFLINE = DFLINE + 10
     C                   MOVE      P#DOCD        DFDOCD
      *  If current line is required slot for copy or move
B005 C                   IF        DFLINE = NewLin
B006 C                   SELECT
      *  Load split text to two lines
S006 C                   WHEN      *IN04 = *ON
      *  Calc length of data before cursor position
     C                   EVAL      Len#1 = CsrPos - 1
      *  Calc length of data from cursor position to end
     C                   EVAL      Len#2 = 80 - CsrPos
     C                   EVAL      #P = CsrPos
      *  Split line, leaving data before cursor on the original line (in effect)
     C     Len#1         SUBST(P)  TXTDTA:1      DFTEXT
      *  And remainder onto the new, inserted line
     C     Len#2         SUBST(P)  TXTDTA:#P     W#Data
     C                   MOVE      W#Data        TXTDTA
      *  Load moved text to new location
S006 C                   WHEN      *IN05 = *ON
     C                   MOVE      MovDta        DFTEXT
     C                   EVAL      MovDta = *BLANKS
      *  Load copied text to new location
S006 C                   WHEN      *IN07 = *ON
     C                   MOVE      CpyDta        DFTEXT
     C                   EVAL      CpyDta = *BLANKS
      *  Inserting a line - blank entry
S006 C                   OTHER
     C                   EVAL      DFTEXT = *BLANKS
E006 C                   ENDSL
      *  Write a record for the moved/copied data
     C                   WRITE     TEMP0
      *  Bump up text sequence for original line
     C                   EVAL      DFLINE = DFLINE + 10
E005 C                   ENDIF
      *  Write the subfile record to temp file
     C                   MOVE      TXTDTA        DFTEXT
     C                   WRITE     TEMP0
E004 C                   ENDIF
E003 C                   ENDIF
E002 C                   ENDIF
E001 C                   ENDDO
      *  Reset pointers
     C                   EVAL      OrgSeq = 0
     C                   EVAL      NewLin = 0
     C                   EVAL      BegWrp = 0
     C                   EVAL      EndWrp = 0
      *  Strip out all blanks lines from the end of the document (but leave at
      *  least one line to indicate the document exists)
     C     *LOVAL        SETLL     TEMPDFT2
     C                   READ      TEMPDFT2                               80
B001 C                   DOW       *IN80 = *OFF
B002 C                   IF        DFTEXT <> *BLANKS
     C                             OR DFLINE <= 10
     C                   UPDATE    TEMP1
     C                   LEAVE
E002 C                   ENDIF
     C                   DELETE    TEMP1
     C                   READ      TEMPDFT2                               80
E001 C                   ENDDO
      *
     C                   ENDSR
      **************************************************************************
      *  UPLOAD: UPLOAD DATA FROM DATABASE FILE TO SCREEN
      **************************************************************************
     C     UPLOAD        BEGSR
      *  Clear the subfile
     C                   EVAL      *IN36 = *OFF                                 SFLCLR
     C                   WRITE     SFLCTL
     C                   EVAL      Rrn1 = 0
     C                   EVAL      TXTDTA = *BLANKS
     C                   EVAL      TXTSEQ = 0
     C                   MOVE      X'20'         TXTATR
      *  Load in the data from the temp file
     C     *LOVAL        SETLL     TEMPDFT1
     C                   READ      TEMPDFT1                               80
B001 C                   DOW       *IN80 = *OFF
     C                   MOVE      DFTEXT        TXTDTA
     C                   EVAL      TXTSEQ = DFLINE
     C                   EVAL      Rrn1 = Rrn1 + 1
     C                   WRITE     SFL
      *  Delete the records after reading them
     C                   DELETE    TEMP0
     C                   READ      TEMPDFT1                               80
E001 C                   ENDDO
      *  If records added to subfile, complete the page with blank records
B001 C                   IF        Rrn1 > 0
     C     Rrn1          DIV       18            Ignore
     C                   MVR                     Remain
     C                   EVAL      Needed = 18 - Remain
X001 C                   ELSE
     C                   EVAL      Needed = 18
E001 C                   ENDIF
      *  Add the needed blank lines
B001 C     1             DO        Needed
     C                   EVAL      TXTSEQ = TXTSEQ + 10
     C                   EVAL      TXTDTA = *BLANKS
     C                   EVAL      Rrn1 = Rrn1 + 1
     C                   WRITE     SFL
E001 C                   ENDDO
      *  Save max relative record number
     C                   EVAL      Totrrn = Rrn1
      *  Save the max text sequence number
     C                   EVAL      Totseq = TXTSEQ
      *  If previous page number is still valid (ie not displayed a blank page)
B001 C                   IF        HldPag <= Totrrn
     C                   EVAL      SFPAGE = HldPag
      *  Otherwise set to page 1
X001 C                   ELSE
     C                   EVAL      SFPAGE = Rrn1
E001 C                   ENDIF
      *  Put cursor back to prior location
     C                   EVAL      LINE = Sv#Lin
     C                   EVAL      COL = Sv#Col
      *
     C                   ENDSR
      ***********************************************************************
      *  UPDATE: UPDATE LIVE FILE WITH NEW INFO
      ***********************************************************************
     C     UPDATE        BEGSR
      *  Delete the original document records (live file)
B001 C                   DOU       *IN80 = *ON
     C     P#DOCD        DELETE    DB1DFT0                            80
E001 C                   ENDDO
      *  Now loop through temp file, & write to live file
     C     *LOVAL        SETLL     TEMPDFT1
     C                   READ      TEMPDFT1                               80
     C                   EVAL      Lineno = 0
B001 C                   DOW       *IN80 = *OFF
     C                   MOVE      P#DOCD        DFDOCD
     C                   EVAL      Lineno = Lineno + 10
     C                   EVAL      DFLINE = Lineno
     C                   WRITE     DB1DFT0
     C                   READ      TEMPDFT1                               80
E001 C                   ENDDO
      *  Update the index with change date/user
     C     P#DOCD        CHAIN     DBGDFTH1                           80
B001 C                   IF        *IN80 = *OFF
     C                   EVAL      DFADTE = *DATE
     C                   MOVE      #@User        DFAUSR
     C                   MOVE      'F'           DFLOCK
     C                   UPDATE    DB1DFTH
E001 C                   ENDIF
      *  Update the keyword index file for this document
     C                   CALL      'DBG006R4'                           90
     C                   PARM                    DFDOCD
      *
     C                   ENDSR
      ***********************************************************************
      *  ATTRIB: REPLACE MARKED CHARACTERS WITH SELECTED ATTRIBUTES
      ***********************************************************************
     C     ATTRIB        BEGSR
      *  Display the attribute menu for selection
     C                   EXFMT     WINDOW1
      *  If user didn't quit out of the screen, and selected an option
B001 C                   IF        *IN12 = *OFF
     C                             AND OPTION <> 0
      *  Extract the selected attribute
     C                   EVAL      #O = OPTION
     C                   MOVEL     Atr(#O)       #S
      *  Replace start character with selected attribute
     C     STRIND:#S     XLATE     TXTDTA        Result
      *  Move translated result back into target string
     C                   MOVE      Result        TXTDTA
      *  Replace start character with normalise attribute (hex 20)
     C     ENDIND:#E     XLATE     TXTDTA        Result
      *  Move translated result back into target string
     C                   MOVE      Result        TXTDTA
      *  Update subfile with 'tarted up' text
     C                   UPDATE    SFL
E001 C                   ENDIF
      *
     C                   ENDSR
      **************************************************************************
      *  ADDPAG: ADD A PAGE OF BLANK RECORDS
      **************************************************************************
     C     ADDPAG        BEGSR
      *  Starting from last record written to subfile
     C                   EVAL      Rrn1 = Totrrn
     C                   EVAL      TXTSEQ = Totseq
     C                   MOVE      X'20'         TXTATR
     C                   EVAL      TXTDTA = *BLANKS
      *  Add 18 blank records
B001 C     1             DO        18
     C                   EVAL      TXTSEQ = TXTSEQ + 10
     C                   EVAL      Rrn1 = Rrn1 + 1
     C                   WRITE     SFL
E001 C                   ENDDO
      *  Update max values
     C                   EVAL      Totrrn = Rrn1
     C                   EVAL      Totseq = TXTSEQ
     C                   EVAL      SFPAGE = Totrrn
      *  Position cursor to start of first line on the new page
     C                   EVAL      LINE = 2
     C                   EVAL      COL = 2
      *
     C                   ENDSR
      **************************************************************************
      * SNDMSG: SEND PROGRAM MESSAGE
      **********************************************************************************************
      *  FINDOPTIONS: Set find options
      **********************************************************************************************
     C     FINDOPTIONS   BEGSR
      *
     C                   WRITE     MSFLC
     C                   EXFMT     WINDOW3
      *  Remove messages from queue after display
     C                   CALL      'DBG045CL'                           90
B001 C                   SELECT
      *  F3=Exit
S001 C                   WHEN      *IN03 = *ON
      *  F12=Previous
S001 C                   WHEN      *IN12 = *ON
      *  Enter/F16=Find
S001 C                   OTHER
     C                   EVAL      Wrap = *ON
     C                   EXSR      FIND
E001 C                   ENDSL
      *
     C                   ENDSR
      **********************************************************************************************
      *  FIND: SEARCH FOR STRING AND POSITION TO, IF FOUND
      **********************************************************************************************
     C     FIND          BEGSR
      *
B001 C                   IF        FINDSTRING <> *BLANKS
B002 C                   IF        MATCHTYPE = '2'
     C     Lower:Upper   XLATE     FINDSTRING    SearchMask
     C                   EVAL      Translate = *ON
X002 C                   ELSE
     C                   EVAL      SearchMask = FINDSTRING
     C                   EVAL      Translate = *OFF
E002 C                   ENDIF
      *  Read all records for this document number
B002 C                   IF        Wrap = *ON
     C                   EVAL      CurrentLine = 1
     C                   EVAL      Wrap = *OFF
     C                   EVAL      StartPos = 1
E002 C                   ENDIF
B002 C                   DOW       CurrentLine <= Totrrn
      * Get the latest version of the current line being searched
     C     CurrentLine   CHAIN     SFL                                80
      * Strip out any display attributes, so search doesn't get confused
     C     DspAtr:Blanks XLATE     TXTDTA        DataToScan
     C                   CALL      'QCLSCAN'                            90
     C                   PARM                    DataToScan
     C                   PARM      79            StringLen
     C                   PARM                    StartPos
     C                   PARM      SearchMask    SearchString
     C                   PARM      25            PatternLen
     C                   PARM                    Translate
     C                   PARM      '1'           Trim
     C                   PARM      '$'           Wildcard
     C                   PARM      0             StringPos
B003 C                   IF        StringPos > 0
     C     CurrentLine   DIV       18            Ignore
     C                   MVR                     LineNumber
     C                   EVAL      SFPAGE = CurrentLine
     C                   EVAL      COL = StringPos + 1
     C                   EVAL      StartPos = COL
B004 C                   IF        LineNumber = 0
     C                   EVAL      LineNumber = 18
E004 C                   ENDIF
     C                   EVAL      LINE = LineNumber + 3
     C                   LEAVE
X003 C                   ELSE
     C                   EVAL      StartPos = 1
E003 C                   ENDIF
      *  Read next record for document number
     C                   EVAL      CurrentLine = CurrentLine + 1
B003 C                   IF        CurrentLine > Totrrn
     C                   LEAVE
E003 C                   ENDIF
E002 C                   ENDDO
      *
B002 C                   IF        StringPos = 0
     C                   EVAL      Wrap = *ON
      *  Inform user that the string wasn't found - press F16 to search from the start
     C                   MOVE      'GSM0308'     MsgID
     C                   EVAL      MsgDta = FINDSTRING
     C                   EVAL      DtaLen = 25
     C                   EVAL      PgmStk = 0
     C                   EXSR      SNDMSG
E002 C                   ENDIF
E001 C                   ENDIF
      *
     C                   ENDSR
      **************************************************************************
     C     SNDMSG        BEGSR
      *  Use in-house utility (via system API 'QMHSNDPM')
     C                   CALL      'DBG044R3'
     C                   PARM                    MsgID
     C                   PARM      'DBGMSGF'     MsgFil
     C                   PARM      '*LIBL'       MsgLib
     C                   PARM                    MsgDta
     C                   PARM                    DtaLen
     C                   PARM      '*INFO'       MsgTyp
     C                   PARM      PGM           PgmQ
     C                   PARM                    PgmStk
     C                   PARM      '       '     #Errid
      *
     C                   ENDSR
      **************************************************************************


This topic: DBG400 > SourceCodeList > RpgleSource > RpgleDBG030R4
Topic revision: r1 - 26 May 2005 - 19:15:06 - MartinRowe
 
This site is powered by FoswikiCopyright © by the contributing authors. All material on this collaboration platform is the property of the contributing authors.
Ideas, requests, problems regarding DBG/400? Send feedback