× The internal search function is temporarily non-functional. The current search engine is no longer viable and we are researching alternatives.
As a stop gap measure, we are using Google's custom search engine service.
If you know of an easy to use, open source, search engine ... please contact support@midrange.com.


  • Subject: RE: SEU - User defined Line Commands code sample - long
  • From: Buck Calabro <buck.calabro@xxxxxxxxxxxxxxxxx>
  • Date: Thu, 3 Aug 2000 14:02:16 -0400

Joe Teff wrote:

>Would you care to share any of your work?

Here's a sample - lurkers please feel free to critique!


     h dftactgrp(*no) actgrp('QILE') indent(*none)

      * dbgview(*list)

      * Buck Calabro April 2000
      * large portions lifted from the SEU User's Guide and Reference
SC09-2605-00
      * If you have a really large source file, increase the size of
SourceStmt
      * Note that this is really a boiler-plate more than anything else.

      * To activate, STRSEU, press F13, page down and fill in the name of
this program

      * SEU puts data in QTEMP/QSUSPC
      * this space has 3 data blocks:
      *   1. Input from SEU
      *   2. Output back to SEU
      *   3. Actual source lines

      * Supports the following line commands:
      * ATTRxx - set line attribute (colour, highlight, etc.)

      * Supports the following F keys:
      * F7 - Split/join a line (Splits this line to next if cursor in the
middle of a line,
      *                         joins next line to this if cursor at the end
of a line)
      * F8 - NOP

      * Uses messages in a user-created message file:
      *   Message ID  Severity  Message Text
      *    SEU0001        0     Cursor is not positioned within a source
statement.
      *    SEU0002        0     Line split complete.
      *    SEU0003        0     Line join complete.
      *    SEU0004        0     Cannot update in Browse mode
      *    SEU0005        0     ATTR command processed
      *    SEU0006        0     ATTR command not valid for this member type

      * Input from SEU
     D SEUInput        DS                  BASED(SEUInputP)
     D  StmtLength                   10i 0
     D  CurRec                       10i 0
     D  CurCol                       10i 0
     D  CCSID                        10i 0
     D  InputRecords                 10i 0
     D  SrcMbr                       10
     D  SrcFil                       10
     D  SrcLib                       10
     D  MbrType                      10
     D  FnKey                         1
     D  SEUMode                       1
     D  SplitSession                  1
     D  ReservedInp                   1

      * Output to SEU
     D SEUOutput       DS                  BASED(SEUOutputP)
     D  ReturnCode                    1
     D  ReservedOut1                  3
     D  OutputRecords                10i 0
     D  InsertedSeq                   7
     D  ReservedOut2                 21

      * Source statements.  SEU passes the line the cursor is on,
      *                     and the next line
     D SEUSource       DS                  BASED(SEUSourceP)
     D  LineCmd                       7
     D  LineRetCode                   1
     D  SourceSeq                     6
     D  SourceDate                    6
     D  SourceStmt                  256

      * Work variables
     D SEUInputPParm   S               *
     D SEUOutputPParm  S               *
     D SEUSourcePParm  S               *
     D ThisLineP       S               *
     D NextLineP       S               *
     D WorkLineP       S               *

     D i               s             10i 0 inz
     D CutColumns      s                   like(SourceStmt)
     D ThisLineCmd     s                   like(LineCmd)
     D ThisStmt        s                   like(SourceStmt)
     D NextStmt        s                   like(SourceStmt)
     D SourceLength    s             10i 0
     D CutLen          s             10i 0
     D BlankLineCmd    s                   like(LineCmd)
     D RtnCode         s              7

     DSndMsg           pr
     D MsgID                          7    const
     D RtnCodeOut                          Like(RtnCode)

     DLoadWorkFromInp  pr
     D SrcDtaPtrInp                    *   const
     D LineCmdOut                          like(LineCmd)     Options(*Omit)
     D LineRetCodeOut                      like(LineRetCode) Options(*Omit)
     D SourceSeqOut                        like(SourceSeq)   Options(*Omit)
     D SourceDateOut                       like(SourceDate)  Options(*Omit)
     D SourceStmtOut                       like(SourceStmt)  Options(*Omit)

     DLoadOutFromWork  pr
     D SrcDtaPtrInp                    *                     const
     D LineCmdInp                          like(LineCmd)     Options(*Omit)
     D LineRetCodeInp                      like(LineRetCode) Options(*Omit)
     D SourceSeqInp                        like(SourceSeq)   Options(*Omit)
     D SourceDateInp                       like(SourceDate)  Options(*Omit)
     D SourceStmtInp                       like(SourceStmt)  Options(*Omit)

     DGetAttrFromCmd   pr             1
     D LineCmdInp                          like(LineCmd) const

      *================================================================
     C     *Entry        Plist
     C                   Parm                    SEUInputPParm
     C                   Parm                    SEUOutputPParm
     C                   Parm                    SEUSourcePParm

      * Get the data referred to by the input pointers
     C                   Eval      SEUInputP    = SEUInputPParm
     C                   Eval      SourceLength = %len(SEUSource) -
     C                                            %len(SourceStmt) +
     C                                            StmtLength
     C                   Eval      SEUOutputP   = SEUOutputPParm
     C                   Eval      ThisLineP    = SEUSourcePParm
     C                   Eval      NextLineP    = SEUSourcePParm +
SourceLength

      * Set default values
     C                   Eval      ReturnCode = '0'
     C                   Eval      OutputRecords = InputRecords - 1
     C                   Eval      InsertedSeq = '0000000'

      * Allow updates only if in Update mode
     C                   If        SeuMode = 'U'
     C                   Exsr      LineCommands
     C                   Exsr      CmdKeys
     C                   Else
     C                   Eval      ReturnCode = '1'
      * Send back "Not in update mode" message
     C                   CallP     SndMsg('SEU0004': RtnCode)
     C                   EndIf

     C                   Eval      *InLR = *On
     C                   Return

      *================================================================
      * Process all the line commands (commands typed in the seq number
area)
      * InputRecords includes the "next" line.
      * For example, if a line command is placed on lines 1 and 5,
InputRecords will be 6

     C     LineCommands  Begsr

     C                   Eval      WorkLineP = ThisLineP
     C                   Eval      i = 1

     C                   DoW       i <= (InputRecords - 1)
     C                   Callp     LoadWorkFromInp(WorkLineP:
     C                                             ThisLineCmd:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             ThisStmt)

     C                   Select

      * Line command to set the attribute of the line
     C                   When      %subst(ThisLineCmd: 1: 4)  = 'ATTR'

      * Blank out the line command
     C                   Callp     LoadOutFromWork(WorkLineP:
     C                                             BlankLineCmd:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit)

      * Highlight the line by forcing an attribute byte in the proper column
      * based on the source member type
     C                   If        MbrType = 'RPG'      or
     C                             MbrType = 'RPGLE'    or
     C                             MbrType = 'SQLRPG'   or
     C                             MbrType = 'SQLRPGLE' or
     C                             MbrType = 'PF'       or
     C                             MbrType = 'PRTF'     or
     C                             MbrType = 'DSPF'
     C                   Eval      %subst(ThisStmt: 1: 1) =
     C                               GetAttrFromCmd(ThisLineCmd)

      * Put the work fields back into the source space
     C                   Callp     LoadOutFromWork(ThisLineP:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             ThisStmt)

      * Send back a message to show that we saw and processed the line cmd
     C                   CallP     SndMsg('SEU0005': RtnCode)
     C                   Else
      * Send back a message to show that we saw and ignored the line cmd
     C                   CallP     SndMsg('SEU0006': RtnCode)
     C                   EndIf

     C                   EndSL

     C                   Eval      i = i + 1
     C                   Eval      WorkLineP = WorkLineP + SourceLength
     C                   EndDO

     C                   EndSR

      *================================================================
      * Process the command keys (F7/F8)

     C     CmdKeys       Begsr

     C                   Select

      * Is the cursor outside of the source statement with an F key press?
     C                   When      (FnKey = '7'  or
     C                              FnKey = '8') and
     C                             CurCol = 0

      * Tell SEU that the cursor is outside the source area
     C                   CallP     SndMsg('SEU0001': RtnCode)

      * F7 = split/join
     C                   When      FnKey = '7'

      * Should we do a split or a join?
      * Get the line the cursor is on
     C                   Callp     LoadWorkFromInp(ThisLineP:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             ThisStmt)
      * Get the next line
     C                   Callp     LoadWorkFromInp(NextLineP:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             NextStmt)

      * If there is data beyond the current column, split it
      * If the rest of the line is blank, join the next line to this one
     C                   if        %subst(ThisStmt: CurCol:
     C                                    StmtLength - CurCol - 1) <>
     C                                      *Blanks
     C                   Exsr      SplitLine
     C                   Else
     C                   Exsr      JoinLine
     C                   EndIf

     C                   EndSL

     C                   EndSR

      *================================================================
      * Split line at blank

     C     SplitLine     Begsr

      * Cut the columns to the right including the column the cursor is in
     C                   Eval      CutColumns = %subst(ThisStmt:
     C                                                 CurCol)

      * Drop the rightmost columns into the next line
     C                   Eval      NextStmt = CutColumns

      * Trim the cut columns off the right side of this line
     C                   If        CurCol > 1
     C                   Eval      ThisStmt = %subst(ThisStmt:
     C                                               1:
     C                                               CurCol - 1)
     C                   Else
     C                   Eval      ThisStmt = *Blanks
     C                   EndIf

      * Put the work fields back into the source space
     C                   Callp     LoadOutFromWork(ThisLineP:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             ThisStmt)

     C                   Callp     LoadOutFromWork(NextLineP:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             NextStmt)

      * Tell SEU that we're returning 2 lines
     C                   Eval      OutputRecords = 2

      * Tell SEU that the split is complete
     C                   CallP     SndMsg('SEU0002': RtnCode)
     C                   EndSR

      *================================================================
      * Join line

     C     JoinLine      Begsr

      * Don't try to join if the next line is a blank
     C                   If        NextStmt <> *Blanks

      * Grab the leftmost columns from the next line (as many columns
      * as are blank at the end of this line)
     C                   Eval      CutColumns = %subst(NextStmt:
     C                                                 1:
     C                                                 (StmtLength -
     C                                                  CurCol +
     C                                                  1               ))

      * Add the columns from the next line onto the end of this line
     C     ' '           Checkr    CutColumns    CutLen
     C                   Eval      ThisStmt = %subst(ThisStmt:
     C                                               1:
     C                                               CurCol - 1)       +
     C                                         %subst(CutColumns:
     C                                                1:
     C                                                CutLen)

      * Blank out the cut columns
     C                   Eval      %subst(NextStmt: 1: CutLen) = *Blanks

      * If we've cut the entire next line, delete it.  Otherwise,
      * simply cut the columns out - don't shift the remainder of the line
     C                   If        NextStmt = *Blanks
     C                   Eval      OutputRecords = 1
     C                   Eval      InsertedSeq = 'A000000'
     C                   Else
     C                   Eval      OutputRecords = 2
     C                   Eval      InsertedSeq = 'A000000'
     C                   EndIf

      * Put the work fields back into the source space
     C                   Callp     LoadOutFromWork(ThisLineP:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             ThisStmt)

     C                   Callp     LoadOutFromWork(NextLineP:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             *Omit:
     C                                             NextStmt)

      * Tell SEU that the join is complete
     C                   CallP     SndMsg('SEU0003': RtnCode)
     C                   EndIf

     C                   EndSR

      *================================================================
      * Send a "status" message back to SEU
      * There's a trick in use here that you need to be aware of.
      * the message stack count is determined by how deep in the call stack
the
      * subprocedure is!  Here's why it was set to 3:
      *     STRSEU      1
      *       SEUEXIT   2
      *         SndMsg  3

     PSndMsg           b
     DSndMsg           pi
     D MsgID                          7    const
     D RtnCodeOut                          Like(ErrSMsgID)

      * Send message API parameters
     D MsgIDWrk        s                   like(MsgID)
     D MsgFil          s             20    inz('SEUEXIT   *LIBL     ')
     D MsgData         s              1    inz(' ')
     D MsgDataLen      s             10i 0 inz
     D MsgType         s             10    inz('*INFO')
     D MsgStackEnt     s             10    inz('*')
     D MsgStackCnt     s             10i 0 inz(3)
     D MsgKey          s              4
     D MsgErrStruc     s                   like(ErrStruc)

      * API error structure
     D ErrStruc        DS                  inz
     D  ErrSSize                     10i 0 inz(%len(ErrStruc))
     D  ErrSUse                      10i 0
     D  ErrSMsgID                     7
     D  ErrSResrv                     1
     D  ErrSData                     80

     C                   eval      MsgIdWrk = MsgID
     C                   eval      MsgErrStruc = ErrStruc

     C                   Call      'QMHSNDPM'
     C                   Parm                    MsgIDWrk
     C                   Parm                    MsgFil
     C                   Parm                    MsgData
     C                   Parm                    MsgDataLen
     C                   Parm                    MsgType
     C                   Parm                    MsgStackEnt
     C                   Parm                    MsgStackCnt
     C                   Parm                    MsgKey
     C                   Parm                    MsgErrStruc

     C                   Eval      ErrStruc = MsgErrStruc
     C                   Eval      RtnCodeOut = ErrSMsgID

     PSndMsg           e

      *================================================================
      * Load the work fields from the data SEU sent us

     PLoadWorkFromInp  b
     DLoadWorkFromInp  pi
     D SrcDtaPtrInp                    *   const
     D LineCmdOut                          like(LineCmd)     Options(*Omit)
     D LineRetCodeOut                      like(LineRetCode) Options(*Omit)
     D SourceSeqOut                        like(SourceSeq)   Options(*Omit)
     D SourceDateOut                       like(SourceDate)  Options(*Omit)
     D SourceStmtOut                       like(SourceStmt)  Options(*Omit)

      * Point to the data within the SEU space
     C                   Eval      SEUSourceP = SrcDtaPtrInp

     C                   If        %addr(LineCmdOut) <> *Null
     C                   Eval            LineCmdOut  =  LineCmd
     C                   Endif
     C                   If        %addr(LineRetCodeOut) <> *Null
     C                   Eval            LineRetCodeOut  =  LineRetCode
     C                   Endif
     C                   If        %addr(SourceSeqOut) <> *Null
     C                   Eval            SourceSeqOut  =  SourceSeq
     C                   Endif
     C                   If        %addr(SourceDateOut) <> *Null
     C                   Eval            SourceDateOut  =  SourceDate
     C                   Endif
     C                   If        %addr(SourceStmtOut) <> *Null
     C                   Eval            SourceStmtOut  =
%subst(SourceStmt: 1:
     C                                                       StmtLength)
     C                   Endif

     P                 e

      *================================================================
      * Load data back to SEU from the work fields

     PLoadOutFromWork  b
     DLoadOutFromWork  pi
     D SrcDtaPtrInp                    *                     const
     D LineCmdInp                          like(LineCmd)     Options(*Omit)
     D LineRetCodeInp                      like(LineRetCode) Options(*Omit)
     D SourceSeqInp                        like(SourceSeq)   Options(*Omit)
     D SourceDateInp                       like(SourceDate)  Options(*Omit)
     D SourceStmtInp                       like(SourceStmt)  Options(*Omit)

      * Point to the data within the SEU space
     C                   Eval      SEUSourceP = SrcDtaPtrInp

     C                   If        %addr(LineCmdInp) <> *Null
     C                   Eval            LineCmd     =  LineCmdInp
     C                   Endif
     C                   If        %addr(LineRetCodeInp) <> *Null
     C                   Eval            LineRetCode     =  LineRetCodeInp
     C                   Endif
     C                   If        %addr(SourceSeqInp) <> *Null
     C                   Eval            SourceSeq     =  SourceSeqInp
     C                   Endif
     C                   If        %addr(SourceDateInp) <> *Null
     C                   Eval            SourceDate     =  SourceDateInp
     C                   Endif
     C                   If        %addr(SourceStmtInp) <> *Null
     C                   Eval            SourceStmt     =  SourceStmtInp
     C                   Endif

     P                 e

      *================================================================
      * Extract an attribute byte from the input line command
      * The line command is formatted "ATTRxx" where XX is a mnemnonic for
      * the attribute byte to assign to the line.  The mnemnonics are the
same
      * as used by DDS with the addition of colours.

     PGetAttrFromCmd   b
     DGetAttrFromCmd   pi             1
     D LineCmdInp                          like(LineCmd) const

     D AttributeByte   s              1
     D AttrTest        s              2
     D i               s             10i 0

     DAttrMnemDS       ds
     D                                2    inz('  ')
     D                                2    inz('RI')
     D                                2    inz('HI')
     D                                2    inz('UL')
     D                                2    inz('BL')
     D                                2    inz('CS')
     D                                2    inz('CP')
     D                                2    inz('CL')
     D AttrMnem                       2    dim(8) overlay(AttrMnemDS)

     DAttrDS           ds
     D                                1    inz(x'20')
     D                                1    inz(x'21')
     D                                1    inz(x'22')
     D                                1    inz(x'24')
     D                                1    inz(x'28')
     D                                1    inz(x'30')
     D                                1    inz(x'38')
     D                                1    inz(x'3A')
     D Attr                           1    dim(8) overlay(AttrDS)

      * Default to normal
     C                   Eval      AttributeByte = Attr(1)

      * Extract the mnemnonic from the line command
     C                   Eval      AttrTest = %subst(ThisLineCmd: 5: 2)

      * Convert the mnemnonic to an attribute byte
     C                   Eval      i = 1
     C     AttrTest      Lookup    AttrMnem(i)                            20
     C                   If        *In20 = *On
     C                   Eval      AttributeByte = Attr(i)
     C                   EndIf

     C                   Return    AttributeByte
     P                 e

Buck Calabro
Aptis; Albany, NY
"We are what we repeatedly do.
 Excellence, then, is not an act, but a habit." --Aristotle


Billing Concepts Corp., a NASDAQ Listed Company, Symbol: BILL
+---
| This is the RPG/400 Mailing List!
| To submit a new message, send your mail to RPG400-L@midrange.com.
| To subscribe to this list send email to RPG400-L-SUB@midrange.com.
| To unsubscribe from this list send email to RPG400-L-UNSUB@midrange.com.
| Questions should be directed to the list owner/operator: david@midrange.com
+---

As an Amazon Associate we earn from qualifying purchases.

This thread ...


Follow On AppleNews
Return to Archive home page | Return to MIDRANGE.COM home page

This mailing list archive is Copyright 1997-2024 by midrange.com and David Gibbs as a compilation work. Use of the archive is restricted to research of a business or technical nature. Any other uses are prohibited. Full details are available on our policy page. If you have questions about this, please contact [javascript protected email address].

Operating expenses for this site are earned using the Amazon Associate program and Google Adsense.