48. (再)ソースのカラーをつける COLORSRC
「10. SEUのカラー化」で RPGソースの命令にカラーをつける
Tool : COLORRPG を紹介したが、ここでは任意のソースの
指定した任意の文字列に指定カラーをつけるTool: COLORSRC である。
弊社のAutoWebという製品のCONFIG はソース・ファイルに定義しているが
この度、数多くのユーザーへの公開を予定しているので
例えソース・ファイルと言えども少しはちがうところを強調して
CONFIG を見やすいものにするためには適切な文字列や用語をカラー化して
強調したいという思惑があった。
そこで以前に作成したCOLORRPGを少し改良した COLORSRC というツールを
ここで紹介する。
【COLORSRCの実行例】
ソースのカラー化 (COLORSRC)
選択項目を入力して，実行キーを押してください。
ソース・ファイル . . . . . . . > TESTCFG 名前
ライブラリー . . . . . . . . > TEST.COM 名前 , *LIBL, *CURLIB
ソース・メンバー . . . . . . . > HTMLCFG 名前 , *CMD
ステートメント . . . . . . . . > 'AUTOWEB HTML 画面構成 V5R1M0 - V5R4M0, VER6
.1'
カラー . . . . . . . . . . . . > PNK GRN, BLU, PNK, RED, TRQ...
【コマンド: COLORSRC】
0001.00 CMD PROMPT(' ソースのカラー化 ')
0002.00 PARM KWD(SRCF) TYPE(SRCF) +
0003.00 PROMPT(' ソース・ファイル ')
0004.00 SRCF: QUAL TYPE(*NAME) LEN(10) DFT(QHLPSRC) EXPR(*YES)
0005.00 QUAL TYPE(*NAME) LEN(10) DFT(*LIBL) +
0006.00 SPCVAL((*LIBL) (*CURLIB)) +
0007.00 PROMPT(' ライブラリー ')
0008.00 PARM KWD(SRCMBR) TYPE(*NAME) LEN(10) DFT(*CMD) +
0009.00 SPCVAL((*CMD)) +
0010.00 PROMPT(' ソース・メンバー ')
0011.00 PARM KWD(WORD) TYPE(*CHAR) LEN(50) +
0012.00 PROMPT(' ステートメント ')
0013.00 PARM KWD(COLOR) TYPE(*CHAR) LEN(3) RSTD(*YES) +
0014.00 DFT(GRN) VALUES(GRN BLU PNK RED TRQ WHT +
0015.00 YLW) PROMPT(' カラー ')
【CLP: COLORSRCCL】
0001.00 PGM PARM(&SRCFILLIB &SRCMBR &WORD &COLOR)
0002.00 /*-------------------------------------------------------------------*/
0003.00 /* COLORSRCCL : ソースのカラー化 */
0004.00 /* */
0005.00 /* 2016/06/25 作成 */
0006.00 /*-------------------------------------------------------------------*/
0007.00 DCL VAR(&SRCFILLIB) TYPE(*CHAR) LEN(20)
0008.00 DCL VAR(&SRCF) TYPE(*CHAR) LEN(10)
0009.00 DCL VAR(&SRCFLIB) TYPE(*CHAR) LEN(10)
0010.00 DCL VAR(&SRCMBR) TYPE(*CHAR) LEN(10)
0011.00 DCL VAR(&WORD) TYPE(*CHAR) LEN(50)
0012.00 DCL VAR(&COLOR) TYPE(*CHAR) LEN(3)
0013.00 DCL VAR(&MSG) TYPE(*CHAR) LEN(132)
0014.00 DCL VAR(&MSGID) TYPE(*CHAR) LEN(7)
0015.00 DCL VAR(&MSGF) TYPE(*CHAR) LEN(10)
0016.00 DCL VAR(&MSGFLIB) TYPE(*CHAR) LEN(10)
0017.00 DCL VAR(&MSGDTA) TYPE(*CHAR) LEN(132)
0018.00 DCL VAR(&TYPE) TYPE(*CHAR) LEN(1)
0019.00 DCL VAR(&TOPGMQ) TYPE(*CHAR) LEN(10)
0020.00 DCL VAR(&APIERR) TYPE(*CHAR) LEN(116) +
0021.00 VALUE(X'000074') /* 2 進数 */
0022.00 DCL VAR(&NULL4) TYPE(*CHAR) LEN(4) +
0023.00 VALUE(X'00000000')
0024.00 MONMSG MSGID(CPF0000) EXEC(GOTO CMDLBL(ERROR))
0025.00
0026.00 /* 環境の取得 */
0027.00 RTVJOBA TYPE(&TYPE)
0028.00 IF COND(&TYPE *EQ '0') THEN(DO) /* バッチ */
0029.00 CHGVAR VAR(&TOPGMQ) VALUE('*SYSOPR ')
0030.00 ENDDO /* バッチ */
0031.00 ELSE CMD(DO) /* 対話式 */
0032.00 CHGVAR VAR(&TOPGMQ) VALUE('*TOPGMQ ')
0033.00 ENDDO /* 対話式 */
0034.00
0035.00 /* パラメータの取得 */
0036.00 CHGVAR VAR(&SRCF) VALUE(%SST(&SRCFILLIB 01 10))
0037.00 CHGVAR VAR(&SRCFLIB) VALUE(%SST(&SRCFILLIB 11 10))
0038.00
0039.00 /*( カラー化の実行 )*/
0040.00 OVRDBF FILE(SRCF) TOFILE(&SRCFLIB/&SRCF) +
0041.00 MBR(&SRCMBR) SECURE(*YES) OVRSCOPE(*JOB)
0042.00 CALL PGM(QUATTRO/COLORSRC) PARM(&WORD &COLOR)
0043.00 DLTOVR FILE(SRCF) LVL(*JOB)
0044.00 RETURN
0045.00
0046.00 APIERR:
0047.00 CHGVAR VAR(&MSGID) VALUE(%SST(&APIERR 9 7))
0048.00 CHGVAR VAR(&MSGDTA) VALUE(%SST(&APIERR 17 100))
0049.00 CHGVAR VAR(&MSGF) VALUE('QCPFMSG ')
0050.00 CHGVAR VAR(&MSGFLIB) VALUE('QSYS ')
0051.00 GOTO SNDMSG
0052.00 ERROR: RCVMSG MSGTYPE(*LAST) RMV(*NO) MSG(&MSG) +
0053.00 MSGDTA(&MSGDTA) MSGID(&MSGID) MSGF(&MSGF) +
0054.00 MSGFLIB(&MSGFLIB)
0055.00 SNDMSG: IF COND(&MSGID *EQ ' ') THEN(DO)
0056.00 SNDPGMMSG MSGID(CPF9897) MSGF(QCPFMSG) MSGDTA(&MSG) +
0057.00 TOMSGQ(&TOPGMQ) MSGTYPE(*ESCAPE)
0058.00 ENDDO
0059.00 ELSE CMD(DO)
0060.00 SNDPGMMSG MSGID(&MSGID) MSGF(&MSGFLIB/&MSGF) +
0061.00 MSGDTA(&MSGDTA) TOMSGQ(&TOPGMQ) +
0062.00 MSGTYPE(*ESCAPE)
0063.00 ENDDO
0064.00 ENDPGM
【RPG: COLORSRC】
0001.00 H DFTNAME(COLORSRC) DATEDIT(*YMD/) 0002.00 F********** カラー SRC ***************************************** 0003.00 FSRCF UF F 256 DISK USROPN 0004.00 F***************************************************************** 0005.00 D AR S 1 DIM(256) 0006.00 D LEN S 4S 0 0007.00 D L S 4S 0 0008.00 D N S 4S 0 0009.00 D COLSTR S 1A 0010.00 D COLEND S 1A INZ(X'20') 0011.00 D A S 4S 0 0012.00 D B S 4S 0 0013.00 0014.00 D BLU C CONST(X'3A') 0015.00 D GRN C CONST(X'40') 0016.00 D PNK C CONST(X'38') 0017.00 D RED C CONST(X'28') 0018.00 D TRQ C CONST(X'30') 0019.00 D YLW C CONST(X'32') 0020.00 D WHT C CONST(X'22') 0021.00 ISRCF AA 10 0022.00 I 1 256 SRCDTA 0023.00 C*----------------------------------------------------+ 0024.00 C *ENTRY PLIST 0025.00 C PARM WORD 50 0026.00 C PARM COLOR 3 0027.00 C*----------------------------------------------------+ 0028.00 C OPEN SRCF 0029.00 C DO *HIVAL 0030.00 C SETOFF 50 0031.00 C READ SRCF 50 0032.00 C 50 LEAVE 0033.00 C EXSR CHECK 0034.00 C*----------------------------------------------------+ 0035.00 C *IN42 IFEQ *ON 0036.00 C EXCEPT @UPDATE 0037.00 C SETOFF 42 0038.00 C ENDIF 0039.00 C*----------------------------------------------------+ 0040.00 C ENDDO 0041.00 C CLOSE SRCF 0042.00 C SETON LR 0043.00 C RETURN 0044.00 C END TAG 0045.00 C****************************************************** 0046.00 C *INZSR BEGSR 0047.00 C****************************************************** 0048.00 C ' ' CHECKR WORD L 0049.00 C SELECT 0050.00 C WHEN COLOR = 'BLU' 0051.00 C MOVE BLU COLSTR 0052.00 C WHEN COLOR = 'GRN' 0053.00 C MOVE GRN COLSTR 0054.00 C WHEN COLOR = 'PNK' 0055.00 C MOVE PNK COLSTR 0056.00 C WHEN COLOR = 'TRQ' 0057.00 C MOVE TRQ COLSTR 0058.00 C WHEN COLOR = 'YLW' 0059.00 C MOVE YLW COLSTR 0060.00 C WHEN COLOR = 'RED' 0061.00 C MOVE RED COLSTR 0062.00 C WHEN COLOR = 'WHT' 0063.00 C MOVE WHT COLSTR 0064.00 C ENDSL 0065.00 C ENDSR 0066.00 C****************************************************** 0067.00 C CHECK BEGSR 0068.00 C****************************************************** 0069.00 C WORD:L SCAN SRCDTA:1 N 50 0070.00 C *IN50 IFEQ *ON 0071.00 C MOVEA SRCDTA AR 0072.00 C N SUB 1 A 0073.00 C MOVE COLSTR AR(A) 0074.00 C N ADD L B 0075.00 C MOVE COLEND AR(B) 0076.00 C MOVEA AR SRCDTA 0077.00 C SETON 42 0078.00 C ENDIF 0079.00 C ENDSR 0080.00 C****************************************************** 0081.00 C OUTPUT BEGSR 0082.00 C****************************************************** 0083.00 C*----------------------------------------------------+ 0084.00 C EXCEPT @UPDATE 0085.00 C*--------------------------------------------- 0086.00 C ENDSR 0087.00 OSRCF E @UPDATE 0088.00 O SRCDTA 256
【解説】
ソース・ファイルは内部で
FSRCF UF F 256 DISK USROPN
:
ISRCF AA 10
I 1 256 SRCDTA
:
OSRCF E @UPDATE
O SRCDTA 256
のように 256バイトとして使用しているが実際に更新するソース・ファイルが
92バイトや 112バイトのように 256バイトより小さくても実行上のエラーにも
問題にもならない。
256バイト以内のソース・ファイルであればすべてこのプログラムによって
色を更新することができる。
