/*------------------------------------------------------------------------ File : pro2html.p Purpose : Export the source code file to html Syntax : pro2html (SourceFile, OutputFile). Description : Just for fun... you can use code2html instead Author(s) : Marian Edu Created : 03.08.2002 Updated : 08.08.2003 - Marian EDU Notes : Version : v1.1 ----------------------------------------------------------------------*/ DEFINE INPUT PARAMETER pcSrcFile AS CHARACTER NO-UNDO. DEFINE INPUT PARAMETER pcHtmlFile AS CHARACTER NO-UNDO. &GLOBAL-DEFINE CodeColor "#0000ff" &GLOBAL-DEFINE CommentColor "#008000" &GLOBAL-DEFINE PreprocColor "#ff0000" DEFINE VARIABLE cLine AS CHARACTER NO-UNDO. DEFINE VARIABLE lCode AS LOGICAL NO-UNDO. DEFINE VARIABLE lPreproc AS LOGICAL NO-UNDO. DEFINE VARIABLE iComment AS INTEGER NO-UNDO. DEFINE VARIABLE iText AS INTEGER NO-UNDO. DEFINE VARIABLE lChoose AS LOGICAL NO-UNDO. DEFINE STREAM s_In. DEFINE STREAM s_Out. FILE-INFO:FILE-NAME = pcSrcFile. IF FILE-INFO:FILE-TYPE = ? OR INDEX(FILE-INFO:FILE-TYPE,'R':U) = 0 THEN DO: MESSAGE 'File not found - [' + pcSrcFile + ']' VIEW-AS ALERT-BOX ERROR. RETURN. END. pcSrcFile = FILE-INFO:FULL-PATHNAME. FILE-INFO:FILE-NAME = pcHtmlFile. IF FILE-INFO:FILE-TYPE NE ? THEN DO: IF INDEX(FILE-INFO:FILE-TYPE,'W':U) = 0 THEN DO: MESSAGE 'File write access deny - [' + pcHtmlFile + ']' VIEW-AS ALERT-BOX ERROR. RETURN. END. ELSE DO: MESSAGE 'File already exist - [' + pcHtmlFile + ']' SKIP 'Do you want to overwrite?' VIEW-AS ALERT-BOX QUESTION BUTTONS YES-NO UPDATE lChoose. IF NOT lChoose THEN RETURN. END. pcHtmlFile = FILE-INFO:FULL-PATHNAME. END. ASSIGN pcSrcFile = REPLACE(pcSrcFile,CHR(92),CHR(47)) pcHtmlFile = REPLACE(pcHtmlFile,CHR(92),CHR(47)). /* open input/output streams */ INPUT STREAM s_In FROM VALUE(pcSrcFile) NO-CONVERT. OUTPUT STREAM s_Out TO VALUE(pcHtmlFile) NO-CONVERT. PUT STREAM s_Out UNFORMATTED 'Pro2Html - ' ENTRY(NUM-ENTRIES(pcSrcFile,CHR(47)),pcSrcFile,CHR(47)) '
' SKIP. REPEAT: IMPORT STREAM s_In UNFORMATTED cLine. cLine = REPLACE(RIGHT-TRIM(cLine),CHR(9),FILL(' ',2)). IF TRIM(cLine) = '' THEN DO: PUT STREAM s_Out UNFORMATTED cLine '
' SKIP. NEXT. END. /* don't mess with black spaces */ cLine = REPLACE(REPLACE(REPLACE(cLine,' ',CHR(1)), '/*',CHR(2)), '*/',CHR(3)). /* html code */ IF TRIM(cLine) NE '' THEN RUN pHtmlCode(INPUT-OUTPUT cLine, INPUT-OUTPUT lCode, INPUT-OUTPUT iComment, INPUT-OUTPUT iText). PUT STREAM s_Out UNFORMATTED cLine '
' SKIP. END. PUT STREAM s_Out UNFORMATTED '

' 'output by ' 'Pro2Html v1.1

'. /* close input/output streams */ OUTPUT STREAM s_Out CLOSE. INPUT STREAM s_In CLOSE. /* functions && procedures implementation */ FUNCTION html-encode RETURNS CHARACTER (INPUT pcString AS CHARACTER /* string to be html encoded */): /*------------------------------------------------------------------------------ Purpose: Encode the html tags from string Notes: ------------------------------------------------------------------------------*/ ASSIGN pcString = REPLACE(pcString, CHR(38), "&~;":U) /* "@" */ pcString = REPLACE(pcString, CHR(34), ""~;":U) /* <"> */ pcString = REPLACE(pcString, CHR(60), "<~;":U) /* "<" */ pcString = REPLACE(pcString, CHR(62), ">~;":U). /* ">" */ RETURN pcString. END FUNCTION. /* html-encode */ PROCEDURE pCodeChange: /*------------------------------------------------------------------------------ Purpose: Translate an 'word' of code in HTML Notes: An 'word' can have more elements, by 'word' it means all characters between two consecutive spaces. ex: ERROR-STATUS:GET-MESSAGES(ERROR-STATUS:NUM-MESSAGES) ------------------------------------------------------------------------------*/ DEFINE INPUT-OUTPUT PARAMETER pcCode AS CHARACTER NO-UNDO. DEFINE INPUT-OUTPUT PARAMETER plCode AS LOGICAL NO-UNDO. DEFINE VARIABLE iNo1 AS INTEGER NO-UNDO. DEFINE VARIABLE iNo2 AS INTEGER NO-UNDO. DEFINE VARIABLE iNo3 AS INTEGER NO-UNDO. DEFINE VARIABLE iNo4 AS INTEGER NO-UNDO. DEFINE VARIABLE cCode1 AS CHARACTER NO-UNDO. DEFINE VARIABLE cCode2 AS CHARACTER NO-UNDO. DEFINE VARIABLE cCode3 AS CHARACTER NO-UNDO. DEFINE VARIABLE cWord AS CHARACTER NO-UNDO. DEFINE VARIABLE cKeyWord AS CHARACTER NO-UNDO. DEFINE VARIABLE cRetVal AS CHARACTER NO-UNDO. DEFINE VARIABLE cLeading AS CHARACTER NO-UNDO. DEFINE VARIABLE cTrailing AS CHARACTER NO-UNDO. IF TRIM(pcCode) = '' THEN RETURN. IF LEFT-TRIM(pcCode,'.,:()[]') NE pcCode THEN cLeading = SUBSTRING(pcCode,1, LENGTH(pcCode,'CHARACTER':U) - LENGTH(LEFT-TRIM(pcCode,'.,:()[]'),'CHARACTER':U), 'CHARACTER':U). pcCode = LEFT-TRIM(pcCode,'.,:()[]'). IF cLeading NE '' THEN DO: IF plCode THEN cRetVal = '':U. ASSIGN cRetVal = cRetVal + cLeading plCode = FALSE. END. CODE-BLOCK: DO iNo1 = 1 TO NUM-ENTRIES(pcCode,':'): IF iNo1 > 1 THEN DO: IF plCode THEN cRetVal = cRetVal + '':U. ASSIGN cRetVal = cRetVal + ':':U plCode = FALSE. END. cCode1 = ENTRY(iNo1,pcCode,':'). DO iNo2 = 1 TO NUM-ENTRIES(cCode1,'('): IF iNo2 > 1 THEN DO: IF plCode THEN cRetVal = cRetVal + '':U. ASSIGN cRetVal = cRetVal + '(':U plCode = FALSE. END. cCode2 = ENTRY(iNo2,cCode1,'(':U). DO iNo3 = 1 TO NUM-ENTRIES(cCode2,'['): IF iNo3 > 1 THEN DO: IF plCode THEN cRetVal = cRetVal + '':U. ASSIGN cRetVal = cRetVal + '[':U plCode = FALSE. END. cCode3 = ENTRY(iNo3,cCode2,'[':U). DO iNo4 = 1 TO NUM-ENTRIES(cCode3,','): IF iNo4 > 1 THEN DO: IF plCode THEN cRetVal = cRetVal + '':U. ASSIGN cRetVal = cRetVal + ',':U plCode = FALSE. END. ASSIGN cWord = ENTRY(iNo4,cCode3,',') cKeyWord = KEYWORD-ALL(TRIM(cWord,'.,:()[]')) NO-ERROR. IF RIGHT-TRIM(cWord,'.,:()[]') NE cWord THEN cTrailing = SUBSTRING(cWord, LENGTH(RIGHT-TRIM(cWord,'.,:()[]'),'CHARACTER':U) + 1, -1, 'CHARACTER':U). ELSE cTrailing = ''. /* current word is preprocess keyword */ IF INDEX(cWord,'&') = 1 THEN DO: /* if previews code, close it */ IF plCode THEN cRetVal = cRetVal + '':U. ASSIGN cRetVal = cRetVal + '':U + cWord + '':U plCode = FALSE. NEXT. END. /* current word is progress keyword */ IF cKeyWord = ? THEN DO: /* if previews code, close it */ IF plCode THEN cRetVal = cRetVal + '':U. plCode = FALSE. END. ELSE DO: /* if no preview code open it */ IF NOT plCode THEN cRetVal = cRetVal + '':U. plCode = TRUE. END. cRetVal = cRetVal + RIGHT-TRIM(cWord,'.,:()[]'). IF cTrailing NE '' THEN DO: IF plCode THEN cRetVal = cRetVal + '':U. ASSIGN cRetVal = cRetVal + cTrailing plCode = FALSE. END. END. END. END. END. pcCode = cRetVal. END. /* pCodeChange */ PROCEDURE pHtmlCode: /*------------------------------------------------------------------------------ Purpose: The main procedure will translate a line of code in HTML Notes: It will handle coments, preprocessor directives and text segments ------------------------------------------------------------------------------*/ DEFINE INPUT-OUTPUT PARAMETER pcLine AS CHARACTER NO-UNDO. DEFINE INPUT-OUTPUT PARAMETER plCode AS LOGICAL NO-UNDO. DEFINE INPUT-OUTPUT PARAMETER piComment AS INTEGER NO-UNDO. DEFINE INPUT-OUTPUT PARAMETER piText AS INTEGER NO-UNDO. DEFINE VARIABLE cNewLine AS CHARACTER NO-UNDO. DEFINE VARIABLE cWord AS CHARACTER NO-UNDO. DEFINE VARIABLE cAttr AS CHARACTER NO-UNDO. DEFINE VARIABLE cKeyWord AS CHARACTER NO-UNDO. DEFINE VARIABLE iCount AS INTEGER NO-UNDO. DEFINE VARIABLE iNo AS INTEGER NO-UNDO. DEFINE VARIABLE iText AS INTEGER NO-UNDO. IF TRIM(pcLine) = '' THEN RETURN. DO iCount = 1 TO NUM-ENTRIES(pcLine,CHR(1)): cWord = ENTRY(iCount,pcLine,CHR(1)). IF iCount > 1 THEN cNewLine = cNewLine + ' ':U. IF cWord = '' THEN NEXT. COMMENT-BLOCK: DO: /* we are in comment block */ IF piComment > 0 THEN DO: IF INDEX(cWord,CHR(3)) = 0 THEN ASSIGN piComment = piComment + NUM-ENTRIES(cWord,CHR(2)) - 1 cNewLine = cNewLine + html-encode(cWord). /* we have an end comment tag */ ELSE DO: /* cros comment, comment level increase */ IF INDEX(cWord,CHR(2)) > 0 AND INDEX(cWord,CHR(2)) < INDEX(cWord,CHR(3)) THEN DO: ASSIGN piComment = piComment + 1 iNo = INDEX(cWord,CHR(2)) cKeyWord = SUBSTRING(cWord,1,iNo,'CHARACTER':U) cNewLine = cNewLine + html-encode(cKeyWord) cWord = SUBSTRING(cWord,iNo + 1,-1,'CHARACTER':U). RUN pHtmlCode(INPUT-OUTPUT cWord, INPUT-OUTPUT plCode, INPUT-OUTPUT piComment, INPUT-OUTPUT piText). cNewLine = cNewLine + cWord. END. /* comment level decrease */ ELSE DO: ASSIGN piComment = piComment - 1 iNo = INDEX(cWord,CHR(3)) cKeyWord = SUBSTRING(cWord,1,iNo,'CHARACTER':U) cNewLine = cNewLine + html-encode(cKeyWord) cWord = SUBSTRING(cWord,iNo + 1,-1,'CHARACTER':U). IF piComment = 0 THEN cNewLine = cNewLine + '':U. RUN pHtmlCode(INPUT-OUTPUT cWord, INPUT-OUTPUT plCode, INPUT-OUTPUT piComment, INPUT-OUTPUT piText). cNewLine = cNewLine + cWord. END. END. NEXT. END. /* comment start here */ IF INDEX(cWord,CHR(2)) > 0 THEN DO: IF (INDEX(cWord,CHR(34)) > 0 AND INDEX(cWord,CHR(34)) < INDEX(cWord,CHR(2))) OR (INDEX(cWord,CHR(39)) > 0 AND INDEX(cWord,CHR(39)) < INDEX(cWord,CHR(2))) OR piText > 0 THEN LEAVE COMMENT-BLOCK. iNo = INDEX(cWord,CHR(2)). IF iNo > 1 THEN DO: cKeyWord = SUBSTRING(cWord,1,iNo - 1,'CHARACTER':U). RUN pHtmlCode(INPUT-OUTPUT cKeyWord, INPUT-OUTPUT plCode, INPUT-OUTPUT piComment, INPUT-OUTPUT piText). cNewLine = cNewLine + cKeyWord. END. IF plCode THEN cNewLine = cNewLine + '':U. ASSIGN plCode = FALSE cWord = SUBSTRING(cWord,iNo + 1,-1,'CHARACTER':U) piComment = piComment + 1 cNewLine = cNewLine + '':U + CHR(2). RUN pHtmlCode(INPUT-OUTPUT cWord, INPUT-OUTPUT plCode, INPUT-OUTPUT piComment, INPUT-OUTPUT piText). cNewLine = cNewLine + cWord. NEXT. END. /* we are out of comments here */ END. TEXT-BLOCK: DO: /* text block treatment */ IF piText = 0 THEN DO: /* text start here */ IF INDEX(cWord,CHR(34)) > 0 OR INDEX(cWord,CHR(39)) > 0 THEN DO: IF INDEX(cWord,CHR(39)) = 0 OR (INDEX(cWord,CHR(34)) > 0 AND INDEX(cWord,CHR(34)) < INDEX(cWord,CHR(39))) THEN ASSIGN iNo = INDEX(cWord,CHR(34)) piText = 1. ELSE ASSIGN iNo = INDEX(cWord,CHR(39)) piText = 2. iText = 0. IF iNo > 1 THEN DO: cKeyWord = SUBSTRING(cWord,1,iNo - 1,'CHARACTER':U). RUN pHtmlCode(INPUT-OUTPUT cKeyWord, INPUT-OUTPUT plCode, INPUT-OUTPUT piComment, INPUT-OUTPUT iText). cNewLine = cNewLine + cKeyWord. END. IF plCode THEN cNewLine = cNewLine + '':U. ASSIGN plCode = FALSE cWord = SUBSTRING(cWord,iNo + 1,-1,'CHARACTER':U). IF piText = 1 THEN ASSIGN iNo = INDEX(cWord,CHR(34)) cNewLine = cNewLine + CHR(34). ELSE ASSIGN iNo = INDEX(cWord,CHR(39)) cNewLine = cNewLine + CHR(39). IF iNo = 0 THEN cNewLine = cNewLine + html-encode(cWord). ELSE DO: ASSIGN cKeyWord = SUBSTRING(cWord,iNo + 1,-1,'CHARACTER':U) cWord = SUBSTRING(cWord,1,iNo,'CHARACTER':U) cNewLine = cNewLine + REPLACE(REPLACE(cWord,'<','<'),'>','>') piText = 0. RUN pHtmlCode(INPUT-OUTPUT cKeyWord, INPUT-OUTPUT plCode, INPUT-OUTPUT piComment, INPUT-OUTPUT piText). cNewLine = cNewLine + cKeyWord. END. NEXT. END. END. /* we are in text block */ ELSE DO: iNo = IF piText = 1 THEN INDEX(cWord,CHR(34)) ELSE INDEX(cWord,CHR(39)). IF iNo = 0 THEN cNewLine = cNewLine + html-encode(cWord). ELSE DO: ASSIGN cKeyWord = SUBSTRING(cWord,iNo + 1,-1,'CHARACTER':U) cWord = SUBSTRING(cWord,1,iNo,'CHARACTER':U) cNewLine = cNewLine + html-encode(cWord) piText = 0. RUN pHtmlCode(INPUT-OUTPUT cKeyWord, INPUT-OUTPUT plCode, INPUT-OUTPUT piComment, INPUT-OUTPUT piText). cNewLine = cNewLine + cKeyWord. END. NEXT. END. END. /* preprocess start here */ IF INDEX(cWord,CHR(38)) > 0 THEN DO: ASSIGN iNo = INDEX(cWord,CHR(38)) iNo = IF INDEX(cWord,CHR(123)) = iNo - 1 THEN iNo - 1 ELSE iNo. IF iNo > 1 THEN DO: ASSIGN cKeyWord = SUBSTRING(cWord,1, iNo - 1,'CHARACTER':U) cWord = SUBSTRING(cWord,iNo,-1,'CHARACTER':U). RUN pHtmlCode(INPUT-OUTPUT cKeyWord, INPUT-OUTPUT plCode, INPUT-OUTPUT piComment, INPUT-OUTPUT piText). cNewLine = cNewLine + cKeyWord. END. IF plCode THEN cNewLine = cNewLine + '':U. IF INDEX(cWord,CHR(125)) > 0 AND INDEX(cWord,CHR(125)) < LENGTH(cWord,'CHARACTER':U) THEN ASSIGN iNo = INDEX(cWord,CHR(125)) cKeyWord = SUBSTRING(cWord,iNo + 1,-1,'CHARACTER':U) cWord = SUBSTRING(cWord,1,iNo,'CHARACTER':U) cNewLine = cNewLine + '':U + html-encode(cWord) + '':U + html-encode(cKeyWord). ELSE ASSIGN cNewLine = cNewLine + '':U + html-encode(cWord) + '':U. plCode = FALSE. NEXT. END. /* end preprocess */ RUN pCodeChange(INPUT-OUTPUT cWord, INPUT-OUTPUT plCode). cNewLine = cNewLine + cWord. END. pcLine = REPLACE(REPLACE(REPLACE(cNewLine,CHR(1),' ':U), CHR(2),'/*'), CHR(3),'*/'). END PROCEDURE. /* pHtmlCode */