/*===============================*/ /* THIS IS AN RPG PROGRAM */ /* Format source for sending as */ /* email */ /* */ /* SOURCE FILE QRPGSRC */ /* SOURCE MEMBER NAME XFMTEM */ /*===============================*/ /* */ /* Author Steve Miall */ /* Company Genesis V */ /* Date 2000/10/04 */ /* */ /*===============================*/ *=================================================================== FQTXTSRC IP F 256 DISK F KINFDS RDSPR1 FEMAIL O F 72 DISK *=================================================================== * Character ARRAYS E SRC 256 1 E @1A 256 1 *=================================================================== * Primary Input file IQTXTSRC NS 01 I 1 6 SRCSEQ I 7 12 SRCDAT I 13 256 SRCDTA I 1 256 SRCALL * Primary Output File IOUTPUT DS I 1 72 SRCOP * Primary Input file feedback area IRDSPR1 DS * Is it a Source file? (Y=Yes) I 163 163 @@#SRC I* *=================================================================== I X'06' C NEWLIN I X'0606' C NEWPAR *=================================================================== C *ENTRY PLIST C PARM @@@RTN 1 * INITIALIZE C @@ONCE CASNE'N' $$INIT ONCE ONLY * ----- --------> C END C @@#SRC IFEQ 'Y' C MOVELSRCDTA @001WK 1 C MOVELSRCDTA @002WK 2 * Ignore special controls from EDTTXT C @001WK IFEQ '.' C @002WK ANDNE'.' C @002WK ANDNE'.*' C @002WK ANDNE'.A' C @002WK ANDNE'.a' C MOVE *BLANK SRCDTA C ENDIF C ENDIF C @@SKIP IFNE 'Y' C SRCDTA ORNE *BLANK C MOVE 'N' @@SKIP C @@#SRC IFEQ 'Y' C SRCDTA IFEQ *BLANK C SRCSEQ OREQ '000000' C MOVE 'Y' @@SKIP C ENDIF C ENDIF C MOVELSRCDTA SRCIN 256 P C @@#SRC IFNE 'Y' C MOVELSRCALL SRCIN P C END * Line controls C EXSR LINEFD * ---- ------ --------> C* Maintain original format by ensuring there's a new line C* character at the end of each source line C EXSR ENDLIN * ---- ------ --------> C ' ' CHEKRSRCIN LL 30 C LL IFNE *ZERO C NXPOS ADD LL ENDAT 30 C SUB 1 ENDAT 30 C Z-ADDNXPOS @2 30 C MOVEASRCIN SRC,@2 * ----- C SELEC * ----- C ENDAT WHLT 72 * Enough room C ENDAT ADD 1 NXPOS * ----- C ENDAT WHEQ 72 * Exactly fits C EXSR WRITE * ---- ------ --------> C Z-ADD1 NXPOS * ----- C OTHER * Not enough room. Find remainder C EXSR REMANS * ---- ------ --------> * ----- C ENDSL * ----- C ENDIF C ENDIF * Flush remains out CLR EXSR LRSR * ---- ------ --------> *=================================================================== C ENDLIN BEGSR * ------ ----- C* Maintain original format by ensuring there's a new line C* character at the end of each source line C ' ' CHEKRSRCIN LL 30 C LL SUB 3 @1 C @1 IFLT 1 C Z-ADD1 @1 C ENDIF C MOVEASRCIN @1A,1 C @1A,@1 IFNE NEWLIN C CAT NEWLIN:0 SRCIN C ENDIF * ------ ----- C ENDSR *=================================================================== *=================================================================== C REMANS BEGSR * ------ ----- * Not enough room. Write out full buffer(s) & find remainder C ENDAT DOWGE72 C EXSR WRITE * ---- ------ --------> C NXPOS IFGE 74 C SUB 72 NXPOS C ENDIF C 74 SUB NXPOS @1 C MOVEASRCIN @1A,1 C MOVEA@1A,@1 SRC,1 C SUB 72 ENDAT C ENDAT ADD 1 NXPOS C ENDDO C NXPOS IFLT 1 C Z-ADD1 NXPOS C ENDIF * ------ ----- C ENDSR *=================================================================== *=================================================================== C $$INIT BEGSR * ------ ----- C Z-ADD1 NXPOS 30 C MOVE 'N' @@ONCE 1 C MOVE 'N' @@SKIP 1 * ------ ----- C ENDSR *=================================================================== *=================================================================== C LINEFD BEGSR * ------ ----- * Line controls C MOVEASRCIN @1A,1 * new paragraph? C SRCIN IFEQ '.A' C SRCIN OREQ '.a' C SRCIN OREQ X'0081' C SRCIN OREQ X'0082' C MOVEANEWPAR @1A,1 C ENDIF C Z-ADD1 @1 30 C @1 DOWLT256 C MOVEA@1A,@1 @003WK 3 P * new line? C @003WK IFEQ ':/N' C MOVELNEWLIN @003WK P C MOVEA@003WK @1A,@1 C ENDIF * new paragraph? C @003WK IFEQ ':/P' C MOVELNEWPAR @003WK P C MOVEA@003WK @1A,@1 C ENDIF * Attribute bytes: C @1A,@1 IFGE X'20' C @1A,@1 ANDLEX'3F' C MOVE ' ' @1A,@1 C ENDIF C ADD 1 @1 C ENDDO C MOVEA@1A,1 SRCIN * special edittext line? C @@#SRC IFEQ 'Y' C X'00' CHEKRSRCIN LL C ADD 1 LL C LL IFLT 100 C MOVEA*BLANK @1A,LL C MOVEA@1A,1 SRCIN C ENDIF C ENDIF * ------ ----- C ENDSR *=================================================================== *=================================================================== C LRSR BEGSR * ------ ----- C NXPOS IFGT 1 C EXSR WRITE * ---- ------ --------> C ENDIF C SETON LR C RETRN * <============== * ----- C ENDSR *=================================================================== *=================================================================== C WRITE BEGSR * ------ ----- C MOVEASRC,1 SRCOP C EXCPT * <- - - - ------ * ----- C ENDSR *=================================================================== *=================================================================== OEMAIL E O SRCOP 72