On 18-May-2016 08:10 -0500, Dan wrote:
On Tue, May 17, 2016 at 6:00 PM,broehmer wrote:
This doesn't work/compile?
[http://archive.midrange.com/rpg400-l/200008/msg00028.html]
Copying / pasting this strips all of the CR/LF characters, so the
paste results in a single line. I'll try reaching out to Buck
directly.
Not sure what was the problem with copy\paste from that page, but
that process was functional for me. Given .txt attachments have a
history of being capable for posting via the list, presumably, refer to
the attachment.
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
midrange.com
