|
 |
Color source members
DOWNLOAD
Download text files
This program when passed a source file library and source file name will
read through all source members in that file (RPGLE) and change all comment lines
in the program to color white and all header specs to pink.
This is just a silly example but can be used to develop many other useful applications.
Again I ask if you modifiy the source please send it back to me and I will post it along with
your name.
I can supply you with an email address @Code400.com and forward emails
back to another account to combat the SPAMMERS.
Figure 1.
Figure 2.
H dftactgrp(*no) option(*srcstmt : *nodebugio)
F*
F* I know this is the system table for DSPFD *MBRLIST
F* but I am just going to CRTDUPOBJ to QTEMP and Override
F* Could have used CLLE but I wanted it all in one place
F*
FQAFDMBRL if e disk usropn
FQRPGLESRC Uf e disk usropn
F Rename(QRPGLESRC:Src)
*
* Field Definitions
*
D ISODate s D
D ISOTime s T
D*
D InLibrary s 10
D InSourceFile s 10
D*
D CmdString s 256
D CmdLength s 15 5
D*
D* Colors
D*
D Normal C X'20'
D Red C X'28'
D White C X'22'
D Blue C X'3A'
D Pink C X'38'
D NonDisplay C 'Hmm what could I do with this?'
*-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
* M A I N L I N E
*-=-=-=--=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C Exsr $GetSourceMbrs
C Exsr $ReadMembers
C Exsr $Process
C eval *inlr = *on
C return
C*----------------------------------------------------
C* $GetSourceMbrs - Load up the work file with members
C* from the source file
C* I assume RPGLE so when you mod
C* you will have to be much more
C* flexable.
C* DSPFD FILE(JJFLIB/QRPGLESRC) TYPE(*MBRLIST)
C* OUTPUT(*OUTFILE) OUTFILE(QTEMP/QAFDMBRL)
C*----------------------------------------------------
CSR $GetSourceMbrsbegsr
C*
C Eval CmdString = 'DSPFD FILE('
C + %Trim(InLibrary) + %Trim('/')
C + %trim(InSourceFile) + %Trim(')')
C + %trim('@@')
C + %trim('TYPE(*MBRLIST) OUTPUT(')
C + %trim('*OUTFILE) OUTFILE(QTEMP/')
C + %trim('*QAFDMBRL)')
C eval CmdString = %Xlate('@':' ': Cmdstring)
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
C*
C* OVRDBF FILE(QAFDMBRL) TOFILE(QTEMP/QAFDMBRL)
C*
C Eval CmdString = 'OVRDBF FILE('
C + %Trim('QAFDMBRL) TOFILE(QTEMP/')
C + %trim('QAFDMBRL)')
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
C If Not%Open(QAFDMBRL)
C Open QAFDMBRL
C Endif
C*
C endsr
C*----------------------------------------------------
C* $ReadMembers - Read through the members overriding
C* to each.. to color the lines of code
C*----------------------------------------------------
CSR $ReadMembers begsr
C*
C *Start Setll QAFDMBRL
C Read QAFDMBRL
C Dow Not%Eof(QAFDMBRL)
C*
C Exsr $SetupMember
C Exsr $Process
C*
C Read QAFDMBRL
C Enddo
C*
C endsr
C*----------------------------------------------------
C* $SetupMember - Do the override thing and color some
C* source.
C* I used similar technique for Y2K
C* there I created copy of source
C* and inserted code into members.
C* no insertion here just updates.
C*----------------------------------------------------
CSR $SetUpMember begsr
C*
C If MLSEU2 = 'RPGLE'
C*
C If %Open(QRPGLESRC)
C Close QRPGLESRC
C Endif
C*
C* DLTOVR QRPGLESRC *ALL
C*
C Eval CmdString = 'DLTOVR QRPGL'
C + %Trim('ESRC *ALL')
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
C*
C* OVRDBF FILE(QRPGLESRC) TOFILE(JJFLIB/QRPGLESRC) MBR(&MEMBER)
C*
C Eval CmdString = 'OVRDBF FILE(QRPGLESRC'
C + %Trim(') TOFILE(')
C + %Trim(InLibrary )
C + %Trim('/')
C + %Trim(InSourceFile)
C + %Trim(') MBR(')
C + %Trim(MLNAME)
C + %Trim(')')
C eval CmdLength = %len(%trim(CmdString))
C call 'QCMDEXC' 99
C parm CmdString
C parm CmdLength
C If Not%Open(QRPGLESRC)
C Open QRPGLESRC
C Endif
C Endif
C endsr
C*----------------------------------------------------
C* $Process - Lets do it This is all hard coded
C* should be table driven dont shoot
C* just example.
C*----------------------------------------------------
CSR $Process begsr
C *Start setll QRPGLESRC
C read QRPGLESRC
C Dow Not%Eof(QRPGLESRC)
C*
C* make comments white
C*
C If %Subst(SRCDTA:7:1) = '*'
C And %Subst(SRCDTA:1:1) <> white
C And %Subst(SRCDTA:6:1) <> pink
C Eval %Subst(SRCDTA:1:1) = white
C Eval %Subst(SRCDTA:100:1) = normal
C Update Src
C Endif
C*
C* make headings pink - Stop with the jokes
C*
C If %Subst(SRCDTA:6:1) = 'H'
C And %Subst(SRCDTA:1:1) <> pink
C Eval %Subst(SRCDTA:1:1) = pink
C Eval %Subst(SRCDTA:100:1) = normal
C Update Src
C Endif
C read QRPGLESRC
C enddo
C endsr
C*----------------------------------------------------
C* *Inzsr - One time run subroutine.
C*----------------------------------------------------
CSR *Inzsr begsr
C*
C *Entry plist
C parm InLibrary
C parm InSourceFile
C*
C* Okay I would use api to verify that this is truely a source file
C* but because I want to complete this in the next few minutes
C* I am going to skip that. Please if you add in send source back
C* to me so that I can post for others.
C*
C endsr
This is yet another example of coloring source code. There are many out there this is just
an old one I dug up somewhere. Its simple it writes the hex characters to a source member.
Once there you can use the browse member in PDM to copy in the color you want.
It would be easy to use rtvmbrd (command or API) and list all members in a source
physical file. Then read through each doing an override to a specific member.
Scanning for a value and based on rules changing that line of code.
All source files have three fields:
- SRCSEQ -The sequence number length: 6,2
- SRCDTA -Where the C-specs/D-specs/F-specs reside length: 100
- SRCDAT -The change date off to the right length: 6,0
DOWNLOAD
Download text files
Figure 1.
Figure 2.
SOURCE
F*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
F*
F* create a blanks source member into this source file.
F* The example used is "X".
F* Use command OVRDBF SAVSRC SAVSRC MBR(X) then call this
F* program. The member "X" will contain the HEX attributes
F* you desire.
F*
F*-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
FSAVSRC O E DISK
F RENAME(SAVSRC:SRC)
*/EJECT
***********************************************************
C* MAIN LINE
C Z-ADD *ZEROS X 3 0
C DO 9 X
C*
C SELECT
C*
C* X'20' is normal so first character is Hex attribute for the
C* color then the description followed bu the normal code.
C* you will need to use the F15 option to copy in program "X".
C* place your cursor on the text ex.RED the use insert key.
C*
C X WHENEQ 1.
C X'28' CAT(P) 'RED':0 SRCDTA
C ADD 1. SRCSEQ
C SRCDTA CAT(P) X'20':0 SRCDTA
C WRITE SRC
C*
C X WHENEQ 2.
C X'3A' CAT(P) 'BLU':0 SRCDTA
C ADD 1. SRCSEQ
C SRCDTA CAT(P) X'20':0 SRCDTA
C WRITE SRC
C*
C X WHENEQ 3.
C X'22' CAT(P) 'WHT':0 SRCDTA
C ADD 1. SRCSEQ
C SRCDTA CAT(P) X'20':0 SRCDTA
C WRITE SRC
C*
C X WHENEQ 4.
C X'38' CAT(P) 'PNK':0 SRCDTA
C ADD 1. SRCSEQ
C SRCDTA CAT(P) X'20':0 SRCDTA
C WRITE SRC
C*
C X WHENEQ 5.
C X'34' CAT(P) 'TRQ':0 SRCDTA
C ADD 1. SRCSEQ
C SRCDTA CAT(P) X'20':0 SRCDTA
C WRITE SRC
C*
C X WHENEQ 6.
C X'24' CAT(P) 'UND':0 SRCDTA
C ADD 1. SRCSEQ
C SRCDTA CAT(P) X'20':0 SRCDTA
C WRITE SRC
C*
C X WHENEQ 7.
C X'30' CAT(P) 'COL':0 SRCDTA
C ADD 1. SRCSEQ
C SRCDTA CAT(P) X'20':0 SRCDTA
C WRITE SRC
C*
C X WHENEQ 8.
C X'28' CAT(P) 'BNK':0 SRCDTA
C ADD 1. SRCSEQ
C SRCDTA CAT(P) X'20':0 SRCDTA
C WRITE SRC
C*
C X WHENEQ 9.
C X'21' CAT(P) 'REV':0 SRCDTA
C ADD 1. SRCSEQ
C SRCDTA CAT(P) X'20':0 SRCDTA
C WRITE SRC
C*
C ENDSL
C ENDDO
C MOVE *ON *INLR
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
C* *INZSR-One time initial run subroutine.
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
CSR *INZSR BEGSR
C Z-ADD UDATE SRCDAT
C ENDSR
C*=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
|
|
