Syntax highlighting using Mediawiki formatting: Difference between revisions
Syntax highlighting using Mediawiki formatting (view source)
Revision as of 11:27, 11 February 2024
, 4 months ago→{{header|Wren}}: Minor change
(→{{header|Wren}}: Now allows for nesting of multi-line comments.) |
m (→{{header|Wren}}: Minor change) |
||
| (8 intermediate revisions by 3 users not shown) | |||
Line 170:
'''END'''
=={{header|ALGOL W}}==
'''begin''' ''comment syntax highlight an Algol W source using Mediawiki formatting''
'' the source is read from standard input and written to standard output''
'' ;''
''% Algol W strings are limited to 256 characters in length so source lines %''
''% are limited to 256 characters %''
'''integer''' lineWidth, errorCount, lowerA, upperA, linePos, kwMax;
'''integer''' MAX_TOKEN_LENGTH;
'''string'''(1) nl;
'''string'''(256) line;
'''string'''(1) currChar, commentEnd;
'''string'''(9) '''array''' kw ( 1 :: 64 );
'''logical''' inString, inComment;
''% returns true if currChar is in the inclusive range low to high, false otherwise %''
'''logical''' '''procedure''' range( '''string'''(1) '''value''' low, high ) ; currChar >= low '''and''' currChar <= high;
'''procedure''' nextChar ; ''% gets the next source character %''
'''if''' linePos = lineWidth '''then''' '''begin'''
currChar := nl;
linePos := linePos + 1
'''end'''
'''else''' '''if''' linePos > lineWidth '''then''' '''begin'''
readcard( line );
lineWidth := 256;
'''while''' lineWidth > 1 '''and''' line( lineWidth - 1 // 1 ) = " " '''do''' lineWidth := lineWidth - 1;
linePos := 1;
currChar := line( 0 // 1 )
'''end'''
'''else''' '''begin'''
currChar := line( linePos // 1 );
linePos := linePos + 1
'''end''' nextChar ;
''% returns true if the current character can start an identifier, false otherwise %''
'''logical''' '''procedure''' identifierStartChar ; range( "a", "z" ) '''or''' range( "A", "Z" );
''% returns true if the current character can be pat of an identifier, false otherwise %''
'''logical''' '''procedure''' identifierChar ; identifierStartChar '''or''' range( "0", "9" ) '''or''' currChar = "_";
'''procedure''' outAndNextChar ; '''begin''' ''% output currChar and get the next %''
'''if''' currChar = "'" '''then''' writeon( "&apos;" )
'''else''' '''if''' currChar = "&" '''then''' writeon( "&amp;" )
'''else''' '''if''' currChar = "<" '''then''' writeon( "&lt;" )
'''else''' '''if''' currChar = ">" '''then''' writeon( "&gt;" )
'''else''' '''if''' currChar = nl '''then''' '''begin'''
'''if''' inComment '''then''' writeon( "''" );
write( " " );
'''if''' inComment '''then''' writeon( "''" )
'''end'''
'''else''' writeon( currChar );
nextChar
'''end''' outAndNextChar ;
'''procedure''' identifierOrKeyword ; '''begin''' ''% handle an indentifier or keyword %''
'''string'''(9) word, lWord;
'''integer''' wLength;
''% recursive keyword binary search %''
'''logical''' '''procedure''' isKeyword ( '''integer''' '''value''' low, high ) ;
'''if''' high < low '''then''' '''false'''
'''else''' '''begin'''
'''integer''' mid;
mid := ( low + high ) '''div''' 2;
'''if''' kw( mid ) > lWord '''then''' isKeyword( low, mid - 1 )
'''else''' '''if''' kw( mid ) = lWord '''then''' '''true'''
'''else''' isKeyword( mid + 1, high )
'''end''' binarySearchR ;
wLength := 0;
'''for''' chPos := 0 '''until''' 8 '''do''' '''begin'''
'''if''' identifierChar '''then''' '''begin'''
word( chPos // 1 ) := currChar;
lWord( chPos // 1 ) := '''if''' range( "A", "Z" ) '''then''' code( ( decode( currChar ) - upperA ) + lowerA )
'''else''' currChar;;
wLength := wLength + 1;
nextChar
'''end'''
'''else''' '''begin'''
lWord( chPos // 1 ) := " ";
word( chPos // 1 ) := " "
'''end''' if_identifierChar__
'''end''' for_chPos ;
'''if''' identifierChar '''then''' '''begin'''
''% all keywords are <= 9 characters long so this must be an identifier %''
writeon( word );
'''while''' identifierChar '''do''' outAndNextChar
'''end'''
'''else''' '''if''' lWord = "comment" '''then''' '''begin'''
writeon( "''comment" );
commentEnd := ";";
inComment := '''true'''
'''end'''
'''else''' '''if''' isKeyword( 1, kwMax ) '''then''' '''begin'''
writeon( "'''" );
'''for''' chPos := 0 '''until''' wLength - 1 '''do''' writeon( word( chPos // 1 ) );
writeon( "'''" )
'''end'''
'''else''' '''begin''' ''% identifier %''
'''for''' chPos := 0 '''until''' wLength - 1 '''do''' writeon( word( chPos // 1 ) )
'''end''' if_various_words
'''end''' identifierOrKeyword ;
s_w := 0; i_w := 1; ''% output formarting %''
MAX_TOKEN_LENGTH := 256;
nl := code( 10 );
lowerA := decode( "a" );
upperA := decode( "A" );
''% allow the program to continue after reaching end-of-file %''
ENDFILE := EXCEPTION( '''false''', 1, 0, '''false''', "EOF" );
''% ensure the first call to nextChar reads the first line %''
lineWidth := 256;
linePos := lineWidth + 1;
currChar := " ";
'''begin''' ''% keywords %''
'''procedure''' K ( '''string'''(9) '''value''' kwStr ) ; '''begin'''
kwMax := kwMax + 1;
kw( kwMax ) := kwStr
'''end''' K ;
kwMax := 0;
K("abs");K("algol");K("and");K("array");K("assert");K("begin");K("bits");
K("case");K("complex");K("div");K("do");K("else");K("end");K("false");
K("for");K("fortran");K("go");K("goto");K("if");K("integer");K("is");
K("logical");K("long");K("not");K("null");K("of");K("or");
K("procedure");K("real");K("record");K("reference");K("rem");K("result");
K("shl");K("short");K("shr");K("step");K("string");
K("then");K("to");K("true");K("until");K("value");K("while")
'''end''' keywords ;
inString := inComment := '''false''';
outAndNextChar;
'''while''' '''not''' XCPNOTED(ENDFILE) '''do''' '''begin'''
'''if''' inString '''then''' '''begin''' ''% in a string %''
inString := currChar '''not''' = """";
outAndNextChar;
'''end'''
'''else''' '''if''' inComment '''then''' '''begin''' ''% in a comment %''
inComment := currChar '''not''' = ";" '''and''' currChar '''not''' = commentEnd;
outAndNextChar;
'''if''' '''not''' inComment '''then''' writeon( "''" );
'''end'''
'''else''' '''if''' identifierStartChar '''then''' identifierOrKeyword
'''else''' '''if''' currChar = """" '''then''' '''begin''' ''% string literal %''
outAndNextChar;
inString := '''true'''
'''end'''
'''else''' '''if''' currChar = "%" '''then''' '''begin''' ''% brief comment %''
writeon( "''" );
commentEnd := "%";
inComment := '''true''';
outAndNextChar
'''end'''
'''else''' outAndNextChar
'''end''' while_not_ar_eof ;
'''if''' inComment '''then''' write( "**** unterminated comment" )
'''else''' '''if''' inString '''then''' write( "**** unterminated string" )
'''end'''.
=={{header|AWK}}==
Line 183 ⟶ 341:
'''BEGIN''' \
{
''# reserved word list as in gawk and treating getline as reserved ''
kw = "BEGIN/BEGINFILE/END/ENDFILE/" \
Line 197 ⟶ 354:
} ''# BEGIN''
{
printf( " " );
line = $0;
Line 225 ⟶ 382:
'''if'''( c == "\\" )
{
}
}
'''while'''( c != "\"" && c != "" );
Line 246 ⟶ 401:
''# pattern''
bracketDepth = 0;
'''while'''( c != "" && ( c != "/" || bracketDepth > 0 ) )
{
'''if'''( c == "\\" || c == "[" )
{
'''if'''
{
bracketDepth ++;
}
}
'''else''' '''if'''( c == "]" )
Line 263 ⟶ 416:
bracketDepth --;
}
}
'''if'''( c != "/" )
Line 295 ⟶ 447:
{
''# something else''
}
}
Line 303 ⟶ 454:
printf( "\n" );
}
'''function''' outAndNextChar()
{
printf( "%s", c );
nextChar();
}
Line 315 ⟶ 472:
{
''# at end of line''
}
'''else'''
Line 328 ⟶ 485:
=={{header|Julia}}==
''#= Keywords in Julia. Handles two word reserved keywords. #= Also
'''const''' KEYWORDS = map(
w -> Regex("^" * w * "\\W"),
Line 378 ⟶ 535:
either = Regex("$startcomment|$stopcomment", "sa")
depth, startpos, stoppos = 0, 0, 0
'''for'''
'''if''' m.match == startcomment
startpos = startpos == 0 ? m.match.offset : startpos
Line 399 ⟶ 556:
idx, len = 1, length(txt)
'''while''' idx <= len
'''if''' !isvalid(txt, idx) ''# exclude internal positions of multibyte Char''
idx += 1
'''continue'''
'''end'''
c = txt[idx]
'''if''' c == '\\' ''# escape the next char, send as is''
push!(outtxt, c, txt[idx+1])
idx += 2
'''elseif''' c == '\"' ''# quotation start''
'''if''' idx < len - 2 && c == txt[idx+1] == txt[idx+2] ''# """ quotes """''
qlen = findfirst(r"(?<!\\)\"\"\""sa, txt[idx+3:'''end'''])
qlen == nothing && error("error with terminator of quote at $idx")
app'''end'''!(outtxt, collect(replace(txt[idx:idx+qlen.stop+2], "\n" => "\n ")))
idx += qlen.stop + 3
'''else''' ''# " quote "''
qlen = findfirst(r"(?<!\\)\"", txt[idx+1:'''end'''])
qlen == nothing && error("error with terminator of quote at $idx")
app'''end'''!(outtxt, collect(replace(txt[idx:idx+qlen.stop+1], "\n" => "\n ")))
idx += qlen.stop + 2
'''end'''
'''elseif''' c == '#' && txt[max(1, idx - 1)] != ''' ''# start comment''
'''if''' idx < len && txt[idx+1] == '=' ''#= comment =#''
start, stop = nestedcommentlimits(txt[idx:'''end'''])
s = replace(txt[idx:idx+stop-1], "\n" => "
app'''end'''!(outtxt, collect("\'\'$s\'\'"))
idx += stop
'''else''' ''# found a line comment, like this comment''
newlinepos = something(findfirst(==('\n'), txt[idx+1:'''end''']), len - idx)
app'''end'''!(outtxt, collect("\'\'$(txt[idx:idx+newlinepos-1])\'\'"))
idx += newlinepos
'''end'''
'''elseif''' c ∈ 'a':'z' ''# lowercase char so check for keyword match''
'''for''' (j, reg) '''in''' enumerate(KEYWORDS)
m = match(reg, txt[idx:'''end'''])
'''if''' m != nothing
wlen = m.match.ncodeunits - 2
app'''end'''!(outtxt, collect("\'\'\'$(txt[idx:idx+wlen])\'\'\'"))
idx += wlen + 1
'''break'''
'''elseif''' j == lastindex(KEYWORDS) ''# no keyword found, send char to output''
push!(outtxt, c)
idx += 1
'''end'''
'''end'''
'''elseif''' c '''in''' [''', '&', '<', '>'] ''# \x26 is char & for HTML entity translation''
s = c == ''' ? "
app'''end'''!(outtxt, collect(s))
idx += 1
'''else''' ''# nothing special found, so pass char to output and increment index into input''
push!(outtxt, c)
idx += 1
Line 457 ⟶ 613:
'''end'''
println(partialhighlight(read(PROGRAM_FILE, String))
=={{header|Phix}}==
Line 538 ⟶ 694:
'''puts'''(1,out)
{} = '''wait_key'''()
=={{header|PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
Note that PL/M doesn't have in-built I/O or standard libraries, hence the need to define the various BDOS system calls.<br>
As CP/M doesn't have redirection, the source file and output file names must be specified on the command line, e.g. if the source is in D:SYNTAX.PLM and the desired output file is D:SYNTAX.OUT and the program is compiled to D:SYNTAX.COM, then the command:<br>
<code>D:SYNTAX D:SYNTAX.PLM D:SYNTAX.OUT</code><br> will create SYNTAX.OUT as a copy of SYNTAX.PLM with the markup for the highlighting. Note the output file must not exist before running the program.<br>
The output is also echoed to the console.
100H: ''/* SYNTAX HIGHLIGHT A PL/M SOURCE USING MEDIAWIKI MARKUP */''
'''DECLARE''' FALSE '''LITERALLY''' '0', TRUE '''LITERALLY''' '0FFH';
'''DECLARE''' NL$CHAR '''LITERALLY''' '0AH'; ''/* NEWLINE: CHAR 10 */''
'''DECLARE''' CR$CHAR '''LITERALLY''' '0DH'; ''/* CARRIAGE RETURN, CHAR 13 */''
'''DECLARE''' EOF$CHAR '''LITERALLY''' '26'; ''/* EOF: CTRL-Z */''
'''DECLARE''' AMP '''LITERALLY''' '026H'; ''/* AMPERSAND */''
'''DECLARE''' LCA '''LITERALLY''' '061H'; ''/* LOWER CASE 'A' */''
'''DECLARE''' LCG '''LITERALLY''' '067H'; ''/* LOWER CASE 'G' */''
'''DECLARE''' LCL '''LITERALLY''' '06CH'; ''/* LOWER CASE 'L' */''
'''DECLARE''' LCM '''LITERALLY''' '06DH'; ''/* LOWER CASE 'M' */''
'''DECLARE''' LCO '''LITERALLY''' '06FH'; ''/* LOWER CASE 'O' */''
'''DECLARE''' LCP '''LITERALLY''' '070H'; ''/* LOWER CASE 'P' */''
'''DECLARE''' LCS '''LITERALLY''' '073H'; ''/* LOWER CASE 'S' */''
'''DECLARE''' LCT '''LITERALLY''' '074H'; ''/* LOWER CASE 'T' */''
''/* CP/M BDOS SYSTEM CALL, RETURNS A VALUE */''
BDOS: '''PROCEDURE'''( FN, ARG )'''BYTE'''; '''DECLARE''' FN '''BYTE''', ARG '''ADDRESS'''; '''GOTO''' 5; '''END''';
''/* CP/M BDOS SYSTEM CALL, NO RETURN VALUE */''
BDOS$P: '''PROCEDURE'''( FN, ARG ); '''DECLARE''' FN '''BYTE''', ARG '''ADDRESS'''; '''GOTO''' 5; '''END''';
EXIT: '''PROCEDURE'''; '''CALL''' BDOS$P( 0, 0 ); '''END'''; ''/* CP/M SYSTEM RESET */''
PR$CHAR: '''PROCEDURE'''( C ); '''DECLARE''' C '''BYTE'''; '''CALL''' BDOS$P( 2, C ); '''END''';
PR$STRING: '''PROCEDURE'''( S ); '''DECLARE''' S '''ADDRESS'''; '''CALL''' BDOS$P( 9, S ); '''END''';
PR$NL: '''PROCEDURE'''; '''CALL''' PR$STRING( .( 0DH, NL$CHAR, '$' ) ); '''END''';
FL$EXISTS: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* RETURNS TRUE IF THE FILE NAMED IN THE */''
'''DECLARE''' FCB '''ADDRESS'''; ''/* FCB EXISTS */''
'''RETURN''' ( BDOS( 17, FCB ) < 4 );
'''END''' FL$EXISTS ;
FL$OPEN: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* OPEN THE FILE WITH THE SPECIFIED FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''RETURN''' ( BDOS( 15, FCB ) < 4 );
'''END''' FL$OPEN;
FL$MAKE: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* CREATE AND OPEN THE FILE WITH THE */''
'''DECLARE''' FCB '''ADDRESS'''; ''/* SPECIFIED FCB */''
'''RETURN''' ( BDOS( 22, FCB ) < 4 );
'''END''' FL$MAKE;
FL$READ: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* READ THE NEXT RECORD FROM FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''RETURN''' ( BDOS( 20, FCB ) = 0 );
'''END''' FL$READ;
FL$WRITE: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* WRITE A RECORD TO FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''RETURN''' ( BDOS( 21, FCB ) = 0 );
'''END''' FL$WRITE;
FL$CLOSE: '''PROCEDURE'''( FCB )'''BYTE'''; ''/* CLOSE THE FILE WITH THE SPECIFIED FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''RETURN''' ( BDOS( 16, FCB ) < 4 );
'''END''' FL$CLOSE;
DMA$SET: '''PROCEDURE'''( DMA ); ''/* SET THE DMA BUFFER ADDRESS FOR I/O */''
'''DECLARE''' DMA '''ADDRESS''';
'''CALL''' BDOS$P( 26, DMA );
'''END''' DMA$SET;
''/* I/O USES FILE CONTROL BLOCKS CONTAINING THE FILE-NAME, POSITION, ETC. */''
''/* WHEN THE PROGRAM IS RUN, THE CCP WILL FIRST PARSE THE COMMAND LINE AND */''
''/* PUT THE FIRST PARAMETER IN FCB1, THE SECOND PARAMETER IN FCB2 */''
''/* BUT FCB2 OVERLAYS THE END OF FCB1 AND THE DMA BUFFER OVERLAYS THE END */''
''/* OF FCB2 */''
'''DECLARE''' FCB$SIZE '''LITERALLY''' '36'; ''/* SIZE OF A FCB */''
'''DECLARE''' FCB1 '''LITERALLY''' '5CH'; ''/* ADDRESS OF FIRST FCB */''
'''DECLARE''' FCB2 '''LITERALLY''' '6CH'; ''/* ADDRESS OF SECOND FCB */''
'''DECLARE''' DMA$BUFFER '''LITERALLY''' '80H'; ''/* DEFAULT DMA BUFFER ADDRESS */''
'''DECLARE''' DMA$SIZE '''LITERALLY''' '128'; ''/* SIZE OF THE DMA BUFFER */''
INIT$FCB: '''PROCEDURE'''( FCB ); ''/* INITIALISE A FILE-CONTROL-BLOCK */''
'''DECLARE''' FCB '''ADDRESS''';
'''DECLARE''' F$PTR '''ADDRESS''';
'''DECLARE''' F '''BASED''' F$PTR '''BYTE''', P '''BYTE''';
F$PTR = FCB;
F = 0; ''/* DEFAULT DRIVE */''
'''DO''' F$PTR = FCB + 1 '''TO''' FCB + 11; ''/* NO NAME */''
F = ' ';
'''END''';
'''DO''' F$PTR = FCB + 12 '''TO''' FCB + ( FCB$SIZE - 1 ); ''/* OTHER FIELDS */''
F = 0;
'''END''';
'''END''' INIT$FCB;
MOVE$FCB: '''PROCEDURE'''( FROM$FCB, TO$FCB ); ''/* MOVE THE CONTENTS OF AN FCB */''
'''DECLARE''' ( FROM$FCB, TO$FCB ) '''ADDRESS''';
'''DECLARE''' ( F$PTR, T$PTR ) '''ADDRESS''';
'''DECLARE''' F '''BASED''' F$PTR '''BYTE''', T '''BASED''' T$PTR '''BYTE''', P '''BYTE''';
'''CALL''' INIT$FCB( TO$FCB );
F$PTR = FROM$FCB;
T$PTR = TO$FCB;
'''DO''' P = 0 '''TO''' 11; ''/* COPY DRIVE, FILENAME AND EXTENSION */''
T = F;
F$PTR = F$PTR + 1;
T$PTR = T$PTR + 1;
'''END''';
'''END''' MOVE$FCB;
SHOW$FCB: '''PROCEDURE'''( FCB ); ''/* SHOW THE CONTENTS OF AN FCB */''
'''DECLARE''' FCB '''ADDRESS''';
'''DECLARE''' F$PTR '''ADDRESS''';
'''DECLARE''' F '''BASED''' F$PTR '''BYTE''', P '''BYTE''';
F$PTR = FCB;
'''DO''' P = 0 '''TO''' 11; ''/* DRIVE, FILENAME AND EXTENSION */''
'''IF''' P = 9 '''THEN''' '''CALL''' PR$CHAR( '.' );
'''IF''' P = 1 '''THEN''' '''CALL''' PR$CHAR( ':' );
'''CALL''' PR$CHAR( F );
F$PTR = F$PTR + 1;
'''END''';
'''END''' SHOW$FCB;
'''DECLARE''' F$PTR '''ADDRESS''', F$CHAR '''BASED''' F$PTR '''BYTE''';
'''DECLARE''' W$PTR '''ADDRESS''', W$CHAR '''BASED''' W$PTR '''BYTE''';
'''DECLARE''' FCB$OUT$DATA ( FCB$SIZE )'''BYTE''';
'''DECLARE''' OUT$DMA ( DMA$SIZE )'''BYTE''';
'''DECLARE''' OUT$BUFFER '''LITERALLY''' '.OUT$DMA';
'''DECLARE''' FCB$IN '''LITERALLY''' 'FCB1';
'''DECLARE''' FCB$OUT '''LITERALLY''' '.FCB$OUT$DATA';
'''DECLARE''' K '''LITERALLY''' 'CALL ADDKW';
'''DECLARE''' KW ( 34 )'''ADDRESS''';
'''DECLARE''' KW$MAX '''BYTE''';
KW$MAX = -1;
ADDKW: '''PROCEDURE'''( ADDR ); ''/* ADDS A KEYWORD TO KW */''
'''DECLARE''' ADDR '''ADDRESS''';
KW( KW$MAX := KW$MAX + 1 ) = ADDR;
'''END''' ADDKW ;
K(.'ADDRESS$');K(.'AND$');K(.'BASED$');K(.'BY$');K(.'BYTE$');K(.'CALL$');
K(.'CASE$');K(.'DATA$');K(.'DECLARE$');K(.'DISABLE$');K(.'DO$');K(.'ELSE$');
K(.'ENABLE$');K(.'END$');K(.'EOF$');K(.'GO$');K(.'GOTO$');K(.'HALT$');
K(.'IF$');K(.'INITIAL$');K(.'INTERRUPT$');K(.'LABEL$');K(.'LITERALLY$');
K(.'MINUS$');K(.'MOD$');K(.'NOT$');K(.'OR$');K(.'PLUS$');K(.'PROCEDURE$');
K(.'RETURN$');K(.'THEN$');K(.'TO$');K(.'WHILE$');K(.'XOR$');
''/* MOVE THE SECOND FCB TO A NEW PLACE SO IT ISN'T OVERWRITTEN BY FCB1 */''
'''CALL''' MOVE$FCB( FCB2, FCB$OUT );
''/* CLEAR THE PARTS OF FCB1 OVERLAYED BY FCB2 */''
'''DO''' F$PTR = FCB1 + 12 '''TO''' FCB1 + ( FCB$SIZE - 1 );
F$CHAR = 0;
'''END''';
STR$EQUAL: '''PROCEDURE'''( S1, S2 )'''BYTE'''; ''/* RETURN TRUE IF S1 = S2 */''
'''DECLARE''' ( S1, S2 ) '''ADDRESS''';
'''DECLARE''' ( S1$PTR, S2$PTR ) '''ADDRESS''';
'''DECLARE''' C1 '''BASED''' S1$PTR '''BYTE''', C2 '''BASED''' S2$PTR '''BYTE''', SAME '''BYTE''';
S1$PTR = S1; S2$PTR = S2;
'''DO''' '''WHILE''' ( SAME := C1 = C2 ) '''AND''' C1 <> '$' '''AND''' C2 <> '$';
S1$PTR = S1$PTR + 1; S2$PTR = S2$PTR + 1;
'''END''';
'''RETURN''' SAME;
'''END''' STR$EQUAL ;
IS$WORD$CHAR: '''PROCEDURE'''( CH )'''BYTE'''; ''/* RETURN TRUE IF CH IS PART OF A WORD */''
'''DECLARE''' CH '''BYTE''';
'''RETURN''' ( CH >= 'A' '''AND''' CH <= 'Z' ) '''OR''' CH = '$'
'''OR''' ( CH >= '0' '''AND''' CH <= '9' );
'''END''' IS$WORD$CHAR ;
'''IF''' '''NOT''' FL$EXISTS( FCB$IN ) '''THEN''' '''DO''';
'''CALL''' SHOW$FCB( FCB$IN );
'''CALL''' PR$STRING( .': INPUT FILE NOT FOUND$' );'''CALL''' PR$NL;
'''END''';
'''ELSE''' '''IF''' FL$EXISTS( FCB$OUT ) '''THEN''' '''DO''';
'''CALL''' SHOW$FCB( FCB$OUT );
'''CALL''' PR$STRING( .': OUTPUT FILE ALREADY EXISTS$' );'''CALL''' PR$NL;
'''END''';
'''ELSE''' '''IF''' '''NOT''' FL$OPEN( FCB$IN ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO OPEN THE INPUT FILE$' );'''CALL''' PR$NL;
'''END''';
'''ELSE''' '''IF''' '''NOT''' FL$MAKE( FCB$OUT ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO OPEN THE OUTPUT FILE$' );'''CALL''' PR$NL;
'''IF''' '''NOT''' FL$CLOSE( FCB$IN ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO CLOSE THE INPUT FILE$' ); '''CALL''' PR$NL;
'''END''';
'''END''';
'''ELSE''' '''DO'''; ''/* FILES OPENED OK - ATTEMPT TO FORMAT THE SOURCE */''
'''DECLARE''' ( GOT$RCD, IS$HEADING ) '''BYTE''', ( DMA$END, OUT$END ) '''ADDRESS''';
'''DECLARE''' IN$STRING '''BYTE''', COMMENT$STATE '''ADDRESS''', GOT$NEXT '''BYTE''';
IN$CHAR: '''PROCEDURE''';
F$PTR = F$PTR + 1;
'''IF''' F$PTR > DMA$END '''THEN''' '''DO'''; ''/* END OF BUFFER */''
GOT$RCD = FL$READ( FCB$IN ); ''/* GET THE NEXT RECORDD */''
'''IF''' '''NOT''' GOT$RCD '''THEN''' F$CHAR = EOF$CHAR;
F$PTR = DMA$BUFFER;
'''END''';
'''END''' IN$CHAR ;
OUT$CHAR: '''PROCEDURE'''( CH ); ''/* OUTPUT A CHARECTER TO THE OUTPOUT FILE */''
'''DECLARE''' CH '''BYTE''';
'''IF''' CH <> EOF$CHAR '''THEN''' '''CALL''' PR$CHAR( CH );
W$CHAR = CH;
W$PTR = W$PTR + 1;
'''IF''' W$PTR > OUT$END '''OR''' CH = EOF$CHAR '''THEN''' '''DO''';
''/* THE OUTPUT BUFFER IS FULL OR WE ARE WRITTING EOF */''
'''IF''' CH = EOF$CHAR '''THEN''' '''DO'''; ''/* EOF - FILL THE BUFFER WITH NULS */''
'''DO''' '''WHILE''' W$PTR <= OUT$END;
W$CHAR = 0;
W$PTR = W$PTR + 1;
'''END''';
'''END''';
'''CALL''' DMA$SET( OUT$BUFFER ); ''/* SWITCH DMA TO THE OUTOUT BUFFER */''
'''IF''' '''NOT''' FL$WRITE( FCB$OUT ) '''THEN''' '''DO'''; ''/* I/O ERROR */''
'''CALL''' PR$STRING( .'I/O ERROR ON WRITING $' );
'''CALL''' SHOW$FCB( FCB$OUT );
'''CALL''' PR$NL;
'''CALL''' EXIT;
'''END''';
'''CALL''' DMA$SET( DMA$BUFFER ); ''/* RESET DMA TO THE DEFAULT BUFFER */''
W$PTR = OUT$BUFFER;
'''END''';
'''END''' OUT$CHAR;
OUT$STRING: '''PROCEDURE'''( STR ); ''/* OUTPUT A STRING */''
'''DECLARE''' STR '''ADDRESS''';
'''DECLARE''' S$PTR '''ADDRESS''';
'''DECLARE''' S$CHAR '''BASED''' S$PTR '''BYTE''';
S$PTR = STR;
'''DO''' '''WHILE''' S$CHAR <> '$';
'''CALL''' OUT$CHAR( S$CHAR );
S$PTR = S$PTR + 1;
'''END''';
'''END''' OUT$STRING;
DMA$END = DMA$BUFFER + ( DMA$SIZE - 1 );
OUT$END = OUT$BUFFER + ( DMA$SIZE - 1 );
GOT$RCD = FL$READ( FCB$IN ); ''/* GET THE FIRST RECORD */''
F$PTR = DMA$BUFFER;
W$PTR = OUT$BUFFER;
IN$STRING = FALSE;
GOT$NEXT = FALSE;
COMMENT$STATE = 0;
'''CALL''' OUT$CHAR( ' ' );
'''DO''' '''WHILE''' GOT$RCD;
'''IF''' F$CHAR = CR$CHAR '''THEN''' '''DO'''; ''/* CARRIAGE RETURN */''
'''IF''' COMMENT$STATE > 1 '''THEN''' '''DO''';
COMMENT$STATE = 2;
'''CALL''' OUT$STRING( .'''''$' );
'''END''';
'''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''ELSE''' '''IF''' F$CHAR = NL$CHAR '''THEN''' '''DO''';
'''CALL''' OUT$CHAR( F$CHAR );
'''CALL''' OUT$CHAR( ' ' );
'''IF''' COMMENT$STATE > 1 '''THEN''' '''CALL''' OUT$STRING( .'''''$' );
'''END''';
'''ELSE''' '''IF''' F$CHAR = AMP '''THEN''' '''DO''';
'''CALL''' OUT$STRING( .( AMP, LCA, LCM, LCP, ';$' ) );
'''END''';
'''ELSE''' '''IF''' F$CHAR = '''' '''THEN''' '''DO''';
'''CALL''' OUT$STRING( .( AMP, LCA, LCP, LCO, LCS, ';$' ) );
IN$STRING = COMMENT$STATE = 0 '''AND''' '''NOT''' IN$STRING;
'''END''';
'''ELSE''' '''IF''' F$CHAR = '<' '''THEN''' '''DO''';
'''CALL''' OUT$STRING( .( AMP, LCL, LCT, ';$' ) );
'''END''';
'''ELSE''' '''IF''' F$CHAR = '>' '''THEN''' '''DO''';
'''CALL''' OUT$STRING( .( AMP, LCG, LCT, ';$' ) );
'''END''';
'''ELSE''' '''IF''' IN$STRING '''THEN''' '''CALL''' OUT$CHAR( F$CHAR );
'''ELSE''' '''IF''' COMMENT$STATE = 1 '''THEN''' '''DO'''; ''/* HAVE A CHARACTER AFTER / */''
'''IF''' F$CHAR = '*' '''THEN''' '''DO''';
COMMENT$STATE = 2;
'''CALL''' OUT$STRING( .'''''/*$' );
'''END''';
'''ELSE''' '''DO''';
COMMENT$STATE = 0;
'''CALL''' OUT$CHAR( '/' );
'''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''END''';
'''ELSE''' '''IF''' COMMENT$STATE = 2 '''THEN''' '''DO'''; ''/* IN A COMMENT */''
'''IF''' F$CHAR = '*' '''THEN''' COMMENT$STATE = 3;
'''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''ELSE''' '''IF''' COMMENT$STATE = 3 '''THEN''' '''DO'''; ''/* IN A COMMENT, EXPECTING / */''
'''IF''' F$CHAR = '/' '''THEN''' '''DO'''; ''/* END OF COMMENT */''
'''CALL''' OUT$STRING( .'/''''$' );
COMMENT$STATE = 0;
'''END''';
'''ELSE''' '''DO'''; ''/* NOT END OF COMMENT */''
'''CALL''' OUT$CHAR( F$CHAR );
'''IF''' F$CHAR <> '*' '''THEN''' COMMENT$STATE = 2;
'''END''';
'''END''';
'''ELSE''' '''IF''' F$CHAR = '/' '''THEN''' '''DO''';
'''IF''' COMMENT$STATE = 0 '''THEN''' COMMENT$STATE = 1;
'''ELSE''' '''IF''' COMMENT$STATE = 3 '''THEN''' '''DO''';
''/* END OF COMMENT */''
'''CALL''' OUT$STRING( .'/''''$' );
COMMENT$STATE = 0;
'''END''';
'''ELSE''' '''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''ELSE''' '''IF''' F$CHAR = EOF$CHAR '''THEN''' GOT$RCD = FALSE; ''/* END OF FILE */''
'''ELSE''' '''IF''' F$CHAR >= 'A' '''AND''' F$CHAR <= 'Z' '''THEN''' '''DO'''; ''/* WORD */''
'''DECLARE''' W ( 10 )'''BYTE''', W$POS '''BYTE''', HAS$DOLLAR '''BYTE''';
OUT$WORD: '''PROCEDURE'''; ''/* OUTPUT W (WHICH MAY CONTAIN $ */''
'''DECLARE''' I '''BYTE''';
'''DO''' I = 0 '''TO''' W$POS - 1; '''CALL''' OUT$CHAR( W( I ) ); '''END''';
'''END''' OUT$WORD ;
W$POS = 0;
HAS$DOLLAR = FALSE;
'''DO''' '''WHILE''' W$POS < 9 '''AND''' IS$WORD$CHAR( F$CHAR );
'''IF''' F$CHAR = '$' '''THEN''' HAS$DOLLAR = TRUE;
W( W$POS ) = F$CHAR; W$POS = W$POS + 1; '''CALL''' IN$CHAR;
'''END''';
W( W$POS ) = '$';
'''IF''' IS$WORD$CHAR( F$CHAR ) '''THEN''' '''DO'''; ''/* WORD IS TOO LONG FOE A */''
'''CALL''' OUT$WORD; ''/* KEYWORD */''
'''DO''' '''WHILE''' IS$WORD$CHAR( F$CHAR );
'''CALL''' OUT$CHAR( F$CHAR );'''CALL''' IN$CHAR;
'''END''';
'''END''';
'''ELSE''' '''IF''' HAS$DOLLAR '''THEN''' '''DO'''; ''/* ASSUME IT ISN'T A KEYWORD */''
'''CALL''' OUT$WORD; ''/* I.E., THE PROGRAMMER HASN'T WRITTEN E.G.: */''
'''END'''; ''/* RE$TURN X; */''
'''ELSE''' '''DO'''; ''/* SHORT WORD - COULD BE A KEYWORD */''
'''DECLARE''' ( IS$KW, KW$POS ) '''BYTE''';
IS$KW = FALSE;
KW$POS = 0;
'''DO''' '''WHILE''' '''NOT''' IS$KW '''AND''' KW$POS <= KW$MAX;
IS$KW = STR$EQUAL( .W, KW( KW$POS ) );
KW$POS = KW$POS + 1;
'''END''';
'''IF''' IS$KW '''THEN''' '''CALL''' OUT$STRING( .'''''''$' );
'''CALL''' OUT$WORD;
'''IF''' IS$KW '''THEN''' '''CALL''' OUT$STRING( .'''''''$' );
'''END''';
GOT$NEXT = TRUE;
'''END''';
'''ELSE''' '''DO'''; ''/* HAVE ANOTHER CHARACTER */''
'''CALL''' OUT$CHAR( F$CHAR );
'''END''';
'''IF''' '''NOT''' GOT$NEXT '''THEN''' '''CALL''' IN$CHAR;
GOT$NEXT = FALSE;
'''END''';
'''CALL''' OUT$CHAR( EOF$CHAR );
''/* CLOSE THE FILES */''
'''IF''' '''NOT''' FL$CLOSE( FCB$IN ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO CLOSE THE INPUT FILE$' ); '''CALL''' PR$NL;
'''END''';
'''IF''' '''NOT''' FL$CLOSE( FCB$OUT ) '''THEN''' '''DO''';
'''CALL''' PR$STRING( .'UNABLE TO CLOSE THE OUTPUT FILE$' ); '''CALL''' PR$NL;
'''END''';
'''END''';
'''CALL''' EXIT;
'''EOF'''
=={{header|Python}}==
Line 746 ⟶ 1,253:
''/* this code should now be saved to''
'' /* a file named */''
''
=={{header|XPL0}}==
Key words in XPL0 are easy to distinguish from variable names because
they start with lowercase letters while variables start with uppercase
letters. This program highlights its own code properly, but it will not
properly highlight all possible cases, such as when key words appear
in quoted strings.
'''proc''' CharOut(Ch);
'''int''' Ch;
'''begin'''
'''case''' Ch '''of'''
^': Text(0, "&apos;");
^&: Text(0, "&amp;");
^<: Text(0, "&lt;");
^>: Text(0, "&gt;")
'''other''' ChOut(1, Ch);
'''end''';
'''int''' Ch;
'''loop''' '''begin'''
ChOut(1, $20); ''\leading space''
Ch:= ChIn(1);
'''loop''' '''begin'''
'''while''' Ch <= $20 '''do''' ''\pass whitespace to output''
'''begin'''
'''if''' Ch = $1A ''\EOF\'' '''then''' '''return''';
ChOut(1, Ch);
'''if''' Ch = $0A ''\LF\'' '''then''' '''quit''';
Ch:= ChIn(1);
'''end''';
'''if''' Ch = ^\ '''then''' ''\pass comment to output''
'''begin'''
Text(0, "''"); ''\in italics''
ChOut(1, Ch);
Ch:= ChIn(1);
'''while''' Ch#^\ & Ch#$0A ''\LF\'' '''do'''
'''begin'''
CharOut(Ch); Ch:= ChIn(1);
'''end''';
'''if''' Ch = ^\ '''then''' ChOut(1, Ch);
Text(0, "''");
'''if''' Ch = $0A ''\LF\'' '''then'''
'''begin'''
ChOut(1, Ch); '''quit''';
'''end''';
Ch:= ChIn(1);
'''end'''
'''else''' '''if''' Ch>=^a & Ch<=^z '''then''' ''\pass key words to output''
'''begin'''
Text(0, "'''"); ''\in bold''
'''while''' Ch>=^a & Ch<=^z '''do'''
'''begin'''
ChOut(1, Ch); Ch:= ChIn(1);
'''end''';
Text(0, "'''");
'''end'''
'''else''' '''begin''' ''\pass anything else''
'''repeat''' CharOut(Ch);
Ch:= ChIn(1);
'''until''' Ch <= $20; ''\until whitespace''
'''end''';
'''end''';
'''end'''
| |||