Path: utzoo!utgpu!water!watmath!clyde!att!osu-cis!tut.cis.ohio-state.edu!mailrus!ames!ucsd!ucsdhub!sdsu!caasi From: caasi@sdsu.UUCP (Richard Caasi) Newsgroups: comp.lang.pascal Subject: Re: Pascal Pretty Printer Keywords: pascal Message-ID: <3053@sdsu.UUCP> Date: 23 Jun 88 00:05:32 GMT Organization: San Diego State University, Math/Sciences Dept. Lines: 183 Trevor Luker writes: > It would be nice if I was able to print keywords etc in bold, and > standardise on indenting etc. While I could do this by hand, I am > sure someone out there has a tool that does this (pref Lex / Yacc) > If you have one, or know of one, can you send me details? > Thanks, treval The following Turbo Pascal program will capitalize keywords: PROGRAM UPCASE ; {$I routine.inc } CONST reservedwords1 = ' ARCTAN ASSIGN AUX AUXINPTR AUXOUTPTR BLOCKREAD BLOCKWRITE BOOLEAN BDOS ' ; reservedwords2 = ' BUFLEN BYTE CHAIN CHAR CHR CLOSE CLREOL CLRSCR CON CONINPTR HALT BIOS ' ; reservedwords3 = ' CONCAT CONSTPTR COPY COS CRTEXIT CRTINIT DELLINE DELAY DELETE LOWVIDEO ' ; reservedwords4 = ' EOF EOLN ERASE EXECUTE EXP FALSE FILEPOS FILESIZE FILLCHAR FLUSH INTR ' ; reservedwords5 = ' FRAC GETMEM GOTOXY HEAPPTR HI HIGHVIDEO IORESULT INPUT INSLINE INSERT ' ; reservedwords6 = ' INT INTEGER KBD KEYPRESSED LENGTH LN LO LST LSTOUTPTR MARK MAXINT MEM ' ; reservedwords7 = ' MEMAVAIL MOVE NEW NORMVIDEO ODD ORD OUTPUT PI PORT POS PRED PTR RANDOM ' ; reservedwords8 = ' RANDOMIZE READ READLN REAL RELEASE RENAME RESET REWRITE ROUND SEEK SIN ' ; reservedwords9 = ' SIZEOF SQR SQRT STR SUCC SWAP TEXT TRM TRUE TRUNC UPCASE USR USRINPTR ' ; reservedwords10= ' USROUTPTR VAL WRITE WRITELN ABSOLUTE AND ARRAY BEGIN CASE CONST DIV ADDR ' ; reservedwords11= ' DO DOWNTO ELSE END EXTERNAL FILE FOR FORWARD FUNCTION GOTO IF IN COLOR ' ; reservedwords12= ' INLINE LABEL MOD NIL NOT OF OR PACKED PROCEDURE PROGRAM RECORD REPEAT ' ; reservedwords13= ' SET SHL SHR STRING THEN TO TYPE UNTIL VAR WHILE WITH XOR OFS SEG MEM MEMW ' ; reservedwords14= ' OVERLAY DISPOSE DRAW FREEMEM HIRES PALLETTE PLOT SOUND WINDOW MAXAVAIL ' ; printstringdelimiter = #39 ; opencomment = '{' ; closecomment = '}' ; openparen = '(' ; closeparen = ')' ; null = '' ; TYPE caps = SET OF 'A' .. 'Z' ; nums = SET OF '0' .. '9' ; VAR characterposition, linenum : INTEGER ; programline, filename, tmpword, tmpwrd : universalstring ; rawword : STRING [100] ; inputfile, outputfile : TEXT ; identifier : SET OF CHAR ; PROCEDURE openfiles ; BEGIN WRITE ('What is the name of the source code file (RETURN to end) : ') ; READLN (filename) ; IF LENGTH (filename) = 0 THEN HALT ; IF POS ('.', filename) = 0 THEN filename := filename + '.PAS' ; ASSIGN (inputfile, filename) ; RESET (inputfile) ; WRITE ('Where do you want the output to be sent (RETURN for Screen) : ') ; READLN (filename) ; filename := upstring (filename) ; IF LENGTH (filename) = 0 THEN filename := 'CON:' ; ASSIGN (outputfile, filename) ; REWRITE (outputfile) ; CLRSCR ; WRITELN ; END ; { openfiles } PROCEDURE testforreservedwords ; VAR reservedwordflag : INTEGER ; BEGIN tmpwrd := upstring (rawword) ; tmpword := ' ' + tmpwrd + ' ' ; reservedwordflag := POS (tmpword, reservedwords1) + POS (tmpword, reservedwords2) + POS (tmpword, reservedwords3) + POS (tmpword, reservedwords4) + POS (tmpword, reservedwords5) + POS (tmpword, reservedwords6) + POS (tmpword, reservedwords7) + POS (tmpword, reservedwords8) + POS (tmpword, reservedwords9) + POS (tmpword, reservedwords10) + POS (tmpword, reservedwords11) + POS (tmpword, reservedwords12) + POS (tmpword, reservedwords13) + POS (tmpword, reservedwords14) ; IF reservedwordflag > 0 THEN BEGIN WRITE (outputfile, tmpwrd) ; END ELSE WRITE (outputfile, rawword) ; END ; { testforreservedwords } PROCEDURE outputonecharacter ; BEGIN WRITE (outputfile, programline [characterposition]) ; END ; { outputonecharacter } PROCEDURE processaword ; BEGIN rawword := '' ; WHILE (UPCASE (programline [characterposition]) IN identifier) AND (characterposition <= LENGTH (programline)) DO BEGIN rawword := rawword + programline [characterposition] ; characterposition := characterposition + 1 ; END ; testforreservedwords ; END ; { processaword } PROCEDURE scantill (searchchar : CHAR) ; BEGIN REPEAT outputonecharacter ; characterposition := characterposition + 1 ; IF characterposition > LENGTH (programline) THEN BEGIN WRITELN (outputfile) ; READLN (inputfile, programline) ; characterposition := 1 ; END ; UNTIL (programline [characterposition] = searchchar) OR (EOF (inputfile)) ; outputonecharacter ; characterposition := characterposition + 1 ; END ; { scantill } PROCEDURE passcommentsthroughunaltered ; BEGIN scantill (closecomment) ; END ; { passcommentthroughunaltered } PROCEDURE passprintstringthroughunaltered ; BEGIN scantill (printstringdelimiter) ; END ; { passprintstringthroughunaltered } PROCEDURE convert ; BEGIN linenum := 0 ; WHILE NOT EOF (inputfile) DO BEGIN characterposition := 1 ; READLN (inputfile, programline) ; IF LENGTH (programline) > 0 THEN BEGIN REPEAT CASE UPCASE (programline [characterposition]) OF 'A'..'Z', '0'..'9', '_' : processaword ; opencomment : passcommentsthroughunaltered ; printstringdelimiter : passprintstringthroughunaltered ; ELSE BEGIN outputonecharacter ; characterposition := characterposition + 1 ; END ; END ; UNTIL characterposition > LENGTH (programline) ; WRITELN (outputfile) ; IF filename <> 'CON:' THEN BEGIN GOTOXY (14, 3) ; WRITE ('Processing line: ', linenum) ; linenum := linenum + 1 ; END ; END ; IF LENGTH (programline) = 0 THEN WRITELN (outputfile) ; END ; CLOSE (inputfile) ; CLOSE (outputfile) ; END ; { convert } BEGIN { main } identifier := ['A'..'Z', '0'..'9', '_'] ; CLRSCR ; openfiles ; convert ; END.