SEU User Defined Line Commands
SEU User Defined Line Commands
SEU User Defined Line Commands
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-260500 * 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 D StmtLength D CurRec D CurCol D CCSID D InputRecords D SrcMbr D SrcFil D SrcLib D MbrType D FnKey D SEUMode D SplitSession D ReservedInp * Output to SEU D SEUOutput
DS
BASED(SEUOutputP)
D D D D D
1 3 10i 0 7 21 SEU passes the line the cursor is on, and the next line BASED(SEUSourceP) 7 1 6 6 256
* Source statements. * D SEUSource DS D LineCmd D LineRetCode D SourceSeq D SourceDate D SourceStmt * Work variables D SEUInputPParm D SEUOutputPParm D SEUSourcePParm D ThisLineP D NextLineP D WorkLineP D D D D D D D D D i CutColumns ThisLineCmd ThisStmt NextStmt SourceLength CutLen BlankLineCmd RtnCode
S S S S S S s s s s s s s s s pr
DSndMsg D MsgID D RtnCodeOut DLoadWorkFromInp D SrcDtaPtrInp D LineCmdOut D LineRetCodeOut D SourceSeqOut D SourceDateOut D SourceStmtOut DLoadOutFromWork D SrcDtaPtrInp D LineCmdInp D LineRetCodeInp D SourceSeqInp D SourceDateInp D SourceStmtInp DGetAttrFromCmd D LineCmdInp
const Like(RtnCode)
pr * const like(LineCmd) like(LineRetCode) like(SourceSeq) like(SourceDate) like(SourceStmt) Options(*Omit) Options(*Omit) Options(*Omit) Options(*Omit) Options(*Omit)
pr * like(LineCmd) like(LineRetCode) like(SourceSeq) like(SourceDate) like(SourceStmt) pr 1 like(LineCmd) const const Options(*Omit) Options(*Omit) Options(*Omit) Options(*Omit) Options(*Omit)
* 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 C Eval C Eval
* 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 C Eval Return *InLR = *On
*================================================================ * 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 C C C C C C C C C C LineCommands Begsr Eval Eval DoW Callp WorkLineP = ThisLineP i = 1 i <= (InputRecords - 1) LoadWorkFromInp(WorkLineP: ThisLineCmd: *Omit: *Omit: *Omit: ThisStmt)
Select
= '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
type MbrType = 'RPG' or MbrType = 'RPGLE' or MbrType = 'SQLRPG' or MbrType = 'SQLRPGLE' or MbrType = 'PF' or MbrType = 'PRTF' or MbrType = 'DSPF' %subst(ThisStmt: 1: 1) = 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 C C C C EndSL Eval Eval EndDO EndSR i = i + 1 WorkLineP = WorkLineP + SourceLength
*================================================================ * Process the command keys (F7/F8) C C CmdKeys Begsr Select statement with an F key press? '7' or '8') and 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 C C C C C
Callp
* 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 C EndSL EndSR
* 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 C C C C C Callp LoadOutFromWork(NextLineP: *Omit: *Omit: *Omit: *Omit: NextStmt)
* Tell SEU that we're returning 2 lines C Eval OutputRecords = 2 * Tell SEU that the split is complete
C C
CallP EndSR
SndMsg('SEU0002': RtnCode)
* 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
))
* 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 C C C C C Callp LoadOutFromWork(NextLineP: *Omit: *Omit: *Omit: *Omit: 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 DSndMsg D MsgID D RtnCodeOut b pi 7 const Like(ErrSMsgID)
* Send message API parameters D MsgIDWrk s D MsgFil s D MsgData s D MsgDataLen s D MsgType s D MsgStackEnt s D MsgStackCnt s D MsgKey s D MsgErrStruc s * API error structure D ErrStruc DS D ErrSSize D ErrSUse D ErrSMsgID D ErrSResrv D ErrSData C C C C C C C C C C C C C C PSndMsg e eval eval Call Parm Parm Parm Parm Parm Parm Parm Parm Parm Eval Eval
like(MsgID) 20 inz('SEUEXIT *LIBL 1 inz(' ') 10i 0 inz 10 inz('*INFO') 10 inz('*') 10i 0 inz(3) 4 like(ErrStruc)
')
inz 10i 0 inz(%len(ErrStruc)) 10i 0 7 1 80 MsgIdWrk = MsgID MsgErrStruc = ErrStruc 'QMHSNDPM' MsgIDWrk MsgFil MsgData MsgDataLen MsgType MsgStackEnt MsgStackCnt MsgKey MsgErrStruc ErrStruc = MsgErrStruc RtnCodeOut = ErrSMsgID
*================================================================ * Load the work fields from the data SEU sent us PLoadWorkFromInp DLoadWorkFromInp D SrcDtaPtrInp D LineCmdOut D LineRetCodeOut b pi * const like(LineCmd) Options(*Omit) like(LineRetCode) Options(*Omit)
* Point to the data within the SEU space C Eval SEUSourceP = SrcDtaPtrInp C C C C C C C C C C C C C C C C P e If Eval Endif If Eval Endif If Eval Endif If Eval Endif If Eval Endif %addr(LineCmdOut) <> *Null LineCmdOut = LineCmd %addr(LineRetCodeOut) <> *Null LineRetCodeOut = LineRetCode %addr(SourceSeqOut) <> *Null SourceSeqOut = SourceSeq %addr(SourceDateOut) <> *Null SourceDateOut = SourceDate %addr(SourceStmtOut) <> *Null SourceStmtOut = %subst(SourceStmt: 1: StmtLength)
*================================================================ * Load data back to SEU from the work fields PLoadOutFromWork DLoadOutFromWork D SrcDtaPtrInp D LineCmdInp D LineRetCodeInp D SourceSeqInp D SourceDateInp D SourceStmtInp b pi * like(LineCmd) like(LineRetCode) like(SourceSeq) like(SourceDate) like(SourceStmt) const Options(*Omit) Options(*Omit) Options(*Omit) Options(*Omit) Options(*Omit)
* Point to the data within the SEU space C Eval SEUSourceP = SrcDtaPtrInp C C C C C C C C C C C C C C C P e If Eval Endif If Eval Endif If Eval Endif If Eval Endif If Eval Endif %addr(LineCmdInp) <> *Null LineCmd = LineCmdInp %addr(LineRetCodeInp) <> *Null LineRetCode = LineRetCodeInp %addr(SourceSeqInp) <> *Null SourceSeq = SourceSeqInp %addr(SourceDateInp) <> *Null SourceDate = SourceDateInp %addr(SourceStmtInp) <> *Null SourceStmt = SourceStmtInp
* 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 DGetAttrFromCmd D LineCmdInp D AttributeByte D AttrTest D i DAttrMnemDS D D D D D D D D D AttrMnem DAttrDS D D D D D D D D D Attr b pi
1 like(LineCmd) const
s s s ds
1 2 10i 0
2 2 2 2 2 2 2 2 2 ds 1 1 1 1 1 1 1 1 1
inz(' ') inz('RI') inz('HI') inz('UL') inz('BL') inz('CS') inz('CP') inz('CL') dim(8) overlay(AttrMnemDS)
inz(x'20') inz(x'21') inz(x'22') inz(x'24') inz(x'28') inz(x'30') inz(x'38') inz(x'3A') dim(8) overlay(AttrDS)
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) C If *In20 = *On C Eval AttributeByte = Attr(i) C EndIf C P Return e AttributeByte
20