{|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||} {|| ||} {|| DSRtoSDML ||} {|| ||} {|| Conversion Program that accepts DSR files and ||} {|| converts them to VAX Document V1.0 (SDML) files. ||} {|| ||} {|| Digital Equipment Corporation ||} {|| 110 Spit Brook Road ||} {|| Nashua, New Hampshire 03062 ||} {|| ||} {|| ||} {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||} { This program is written in VAX Pascal. The program can be } { compiled, linked, and run, by the following command sequence: } { } { $ PASCAL DSRtoSDML } { $ LINK DSRtoSDML } { $ DSRtoSDML := $ Disk:[dir]DSRtoSDML.EXE } { $ DSRtoSDML fname [/qual ... ] } { } { where "fname" designates a DSR input file whose full name is } { "fname.RNO". The program creates two output files, namely, } { "fname.SDML", which is the desired Document input file, and } { "fname.RNO_LIS", which contains errors and warnings generated } { during the conversion process. } { OutLine of Program { { DATA DECLARATIONS { Debugging Data { Interface Data { String Types { Argument Parsing Names { Input/Output Names { DSR Flags { Command Table { Conversion Table { Cursor Position Flags { Variables for Specific DSR Commands { ROUTINE DECLARATIONS { Forward Routine Declarations { Debugging Routines { String and Character Routines { Input/Output Routines { Parsing Utility Routines { Specialized Parsing Routines { Keyword Parsing Routines { Argument Parsing Routines { Command Parsing Routines { Utilities for Text Processing { Text Processing Routines { Command Processing Routines { Junk Processing Routines { Utilities for Individual Command Routines { Individual Command Routines { Dispatch Routine { Document Code Generation { Main Routines } { CWA/HW} [inherit('sys$library:starlet')] program DSRCON(Input,Output); const VersionID = ' DSRtoSDML (BL5) '; NameId = 'DSRtoSDML'; var DOCFileID : varying[132] of char; DateStamp : varying[132] of char; DateStr : packed array[1..11] of char; TimeStr : packed array[1..11] of char; {***************************************************************} {***************************************************************} {** **} {** DATA DECLARATIONS **} {***************************************************************} { } { Debugging Data } var EnableDebug: Boolean; { Controls DEBUG print; set by ?D } EnableInteraction: Boolean; { Controls interaction; set by /D } {***************************************************************} { } { Interface Data } const BufferLength = 255; LenShortSTring = 20; LenMedString = 56; LenFileSpec = 133; LogicalNameTable = 'LNM$PROCESS'; Spaces = ' '; type $word = [word] -32768..32767; ItemListType = record BufLen : [word] 0..65535; ItmCod : [word] 0..65535; BufAdr : unsigned; RetLen : unsigned; LastWd : unsigned; end; FileSpec = varying[LenFileSpec] of char; { General } ShortString = varying[LenShortString] of char; { Short } MedString = varying[LenMedString] of char; { Medium } {***************************************************************} { } { String Types } const LenAnyString = 255; WideLineSize = 255; RegularLineSize = 255; LongLineSize = 2056; type AnyString = varying[LenAnyString] of char; { General } WideLine = varying[WideLineSize] of char; { For printer } RegularLine = varying[RegularLineSize] of char; { For terminal } LongLine = varying[LongLineSize] of char; const OutMax = 120; {Length of outputline -- longer lines divided} MaxMax = 132; MaxFileIndex = 10; IndexMax = 20; QualMax = 10; ReferenceMax = 200; HoldTabMax = 1000; var ImplicitCaption: Boolean; { true allows reference to be promoted to caption } IncludeSource: Boolean; { true puts DSR in SDML as comments } RefSwitch: Boolean; { false suppresses reference recognition } FirstFile : Boolean; IllegalFile : Boolean; ListFileOpen : Boolean; Listing : Boolean; EquivalenceLength : [word] 0..65535; BufferForEquivalence : packed array [1..BufferLength] of char; ItemList : ItemListType; LogicalName : varying[133] of char; DirName : AnyString; FileName : AnyString; OrigFileName : AnyString; FilePart : AnyString; FileMessage : array[1..5] of varying[40] of char; ClLen : $word; LName : varying [80] of char; UPrompt : varying [24] of char; InFile : array[1..MaxFileIndex] of FileSpec; InFileVar : array[1..MaxFileIndex] of text; InputLineCount : array[1..MaxFileIndex] of [word] 0..65535; OutLine : varying [512] of char; OutFile : array[1..MaxFileIndex] of FileSpec; OutFileVar : array[1..MaxFileIndex] of text; ProFileName : FileSpec; ProFile : FileSpec; ProFileVar : text; OutLineCount : array[1..MaxFileIndex] of [word] 0..65535; ListFile : FileSpec; ListFileVar : text; LiteralFileVar : text; FileIndex : integer; OutFileIndex : integer; SysStatus : integer; SymSym : array[1..ReferenceMax] of ShortString; SymDef: array[1..ReferenceMax] of Boolean; SymRefCount : array[1..ReferenceMax] of Integer; ReferenceLimit : integer; var ParamString : WideLine; Unit : AnyString; QualTab : array[1..QualMax] of MedString; QualArg : array[1..QualMax] of MedString; QualFound : Array[1..QualMax] of Boolean; QualLim : integer; QualLoc : Integer; FoundVal : Boolean; IndexLim : Integer; IndexS : Array[1..IndexMax] of ShortString; IndexArg1 : Array[1..IndexMax] of AnyString; IndexArg2 : Array[1..IndexMax] of AnyString; IndexXP : Array[1..IndexMax] of Boolean; {***************************************************************} { } { Argument Parsing Names } type ReqOrOptType = (cREQ,cOPT); { Construct required or optional } const ArgEnd = chr(0); { Argument terminator } var OK: Boolean; { 1 construct found (req'd) or 0 or 1 (optional) } Present: Boolean; { 1 construct found } Absent: Boolean; { Nothing, not even start of construct, found } {***************************************************************} { } { Input/Output Names } const EOL = chr(0); { End of line mark } ENDOFLITERAL = chr(2); { End of literal } HORTAB = chr(9); { Tab } HTABC = 9; var Inputline: WideLine; { Unprocessed part of current line } LiteralLine: WideLine; SaveInputLine: WideLine; { Buffer for InputLine } OutputLine: LongLine; { Line for output file } P: integer; { Index of next character } SaveP : integer; TerminalInput: Boolean; { Input from terminal, not file } DocumentTitle : AnyString;{ Title of Book, if InProfile } {***************************************************************} { } { DSR Flags } const { These are the names used in DSR for flags. They describe } { the function of the flag when used alone, but do not } { suggest the function in cominbation. Thus, for example, } { the "uppercase" flag (default ^) is used with other flags } { flags to extend their function over a string of characters. } { Some extra codes are present. cNORMAL is used for a } { that, in a given context, is not a flag or a cliche } { character. cALL is not a flag name at all, but } { provides for the "ALL" keyword of the .FLAGS command. } { Finally, names of the form cZxxx are used for cliches } { NOTE: Names of the form cZxxx must be last; that is, they } { must have the highest values. That is because if a flag } { is the same as cliche character, the interpretation as a } { flag takes precedence. } cNORMAL = 0; cACCEPT = 1; cBOLD = 2; cBREAK = 3; cCAPITALIZE = 4; cHYPHENATE = 5; cINDEX = 6; cLOWERCASE = 7; cNOPERMUTE = 8; cOVERSTRIKE = 9; cPERIOD = 10; cSPACE = 11; cSUBINDEX = 12; cSUBSTITUTE = 13; cUNDERLINE = 14; cUPPERCASE = 15; cZKEY = 16; cZBAR = 17; cZREFSTART = 18; cZREFSTOP = 19; cALL = 20; cCOMMENT = 21; cCONTROL = 22; cVBAR = 17; cBSLASH = 20; cLPAREN = 21; cRPAREN = 22; cAMPRSND = 23; const FlagsSize = 22; type FlagsType = varying[FlagsSize] of char; var FlagsChar: FlagsType; { Recent flags, whether on or off } FlagsCur: FlagsType; { Current flag settings } FlagsSaved: FlagsType; { Saves cur flags during .NFL ALL } FlagsAllOff: FlagsType; { Setting for .NFL ALL (a constant) } var FlagsAllOn: Boolean; { Controlled by .FL ALL and .NFL ALL } CommentFlagCur: char; { Current Comment Flag setting } ControlFlagCur: char; { Current Control Flag setting } CommentFlagChar: char; { Recent Comment Flag char } ControlFlagChar: char; { Recent Control Flag char } var { Booleans controlled by the .ENABLE and .DISABLE flag commands } BoldingEnabled : Boolean; HyphenationEnabled : Boolean; IndexingEnabled : Boolean; OverstrikingEnabled : Boolean; UnderliningEnabled : Boolean; const NoCode=chr(0); { "current" value for a flag that is OFF } RefStartChar=chr(128); { Begin recognized ref: Ctrl-B or (for debug) '[' } RefStopChar=chr(129); { End recognized ref: Ctrl-C or (for debug) ']' } {***************************************************************} { } { Command Table } { } { These declarations create a table of DSR keywords. } { The table is named CommandTable and is an array of ranging } { from 1 to ComTableMax elements. Each element is a triple. } { The first member, ComTable[i].CN, contains a value of type } { ComType that provides an index for the command. The second } { member, ComTable[i].CS, is a string that contains the full } { name of the command. The third member, ComTable[i].CA, is } { a value of type ArgType that specifies the syntax of the } { zero or more arguments of the command. } { The first three values of ComType do not correspond to a } { DSR command. xUndef indicates a name that is not a valid } { command name. xNOP indicates a command that does nothing } { (DSR has no such command, but it is useful for management of } { the command pipeline.) xBANG indicates a comment, which } { sometimes begins with a bang (exclamation mark). } type ComType = ( xUndef, xNOP, xBANG, xAJ, xAP, xAST, xAT, xATI, xAX, xB, xBB, xBR, xBT, xC, xCC, xCH, xCOM, xD, xDAX, xDBB, xDBO, xDC, xDCH, xDCR, xDEX, xDFG, xDHL, xDHY, xDIX, xDLE, xDNM, xDOV, xDSP, xDT, xDTB, xDTC, xDUL, xDX, xDXP, xEB, xEBB, xEBO, xEFN, xEHY, xEI, xEIX, xEL, xELS, xELSE, xEN, xEOV, xES, xETC, xETN, xEUN, xEXP, xF, xFG, xFGD, xFL, xFN, xFT, xFTA, xHD, xHE, xHF, xHL, xHT, xI, xIF, xIN, xJ, xK, xLE, xLM, xLO, xLS, xLT, xNAJ, xNAP, xNAST, xNAT, xNATI, xNC, xNCC, xND, xNF, xNFL, xNHD, xNJ, xNK, xNMA, xNMCH, xNMEX, xNMF, xNMFG, xNMLS, xNMLV, xNMN, xNMPG, xNMR, xNMSPG, xNMTB, xNNMF, xNPA, xNPR, xNSP, xNST, xNT, xNTN, xP, xPA, xPG, xPR, xPS, xR, xREF, xREQ, xRES, xRM, xRPT, xS, xSALL, xSAVE, xSCNT, xSCO, xSDT, xSL, xSP, xSPG, xSPR, xST, xSTAX, xSTCH, xSTEX, xSTFG, xSTHL, xSTM, xSTTB, xSTXT, xT, xTN, xTP, xTS, xVR, xX, xXL, xXP, xXU, xY, xYP, xZWC, xZWD, xZCAP, xZBA, xZBE, xZBF, xZBP, xZBT, xZEA, xZEE, xZEF, xZEP, xZET, xZLT, xZQUAL ); ComBreakType = (NOBREAK, BREAK, SECBREAK); ComStringType = varying[21] of char; ArgType = ( aBANG, aATTR, azBB, aC, aCOND, aDC, aDCR, aDLE, aDHL, aDT, aDzz, aFL, aHD, aHL, aINT, aINTO, aINTM, aINTOM, aINTOPM, aINTPM, aLO, aLS, aREFNAME, aNMA, aNMLS, aNMLV, aNULL, aNCODE, aP, aPS, aQSTR, aQSTRO, aREQ, aR, aRPT, aSCNT, aSCO, aSTHL, aSzz, aSTXT, aTS, aTEXT, aTN, aVR, azP, aZCAP, aZLT, aZWx ); CommaListType = ( mDLE, mDHL, mDT, mDzz, mLO, mNMLS, mNMLV, mP, mPS, mSTHL, mSzz, mTS ); ComRecType = record CN: ComType; CB: ComBreakType; CS: ComStringType; CA: ArgType; end; var ComTable : array[ComType] of ComRecType; value ComTable := ( (xUndef, NOBREAK, '[undefined]' , aNULL ), (xNOP , NOBREAK, '[no operation]' , aNULL ), (xBANG , NOBREAK, '[comment]' , aTEXT ), (xAJ , NOBREAK, 'AUTOJUSTIFY' , aNULL ), (xAP , NOBREAK, 'AUTOPARAGRAPH' , aNULL ), (xAST , NOBREAK, 'AUTOSUBTITLE' , aINTOPM ), (xAT , NOBREAK, 'AUTOTABLE' , aNULL ), (xATI , NOBREAK, 'AUTOTITLE' , aINT ), (xAX , SECBREAK,'APPENDIX' , aTEXT ), (xB , BREAK , 'BLANK' , aINTOM ), (xBB , NOBREAK, 'BEGIN BAR' , azBB ), (xBR , BREAK , 'BREAK' , aNULL ), (xBT , NOBREAK, 'BEGIN TOPNOTE' , aINTO ), (xC , BREAK , 'CENTER' , aC ), (xCC , NOBREAK, 'CONTROL CHARACTERS' , aNULL ), (xCH , SECBREAK,'CHAPTER' , aTEXT ), (xCOM , NOBREAK, 'COMMENT' , aTEXT ), (xD , NOBREAK, 'DATE' , aNULL ), (xDAX , BREAK , 'DISPLAY APPENDIX' , aNCODE ), (xDBB , NOBREAK, 'DISABLE BAR' , aNULL ), (xDBO , NOBREAK, 'DISABLE BOLDING' , aNULL ), (xDC , NOBREAK, 'DO CONTENTS' , aQSTRO ), (xDCH , BREAK , 'DISPLAY CHAPTER' , aNCODE ), (xDCR , BREAK , 'DISPLAY COUNTER' , aDCR ), (xDEX , BREAK , 'DISPLAY EXAMPLE' , aDzz ), (xDFG , BREAK , 'DISPLAY FIGURE' , aDzz ), (xDHL , BREAK , 'DISPLAY LEVELS' , aDHL ), (xDHY , NOBREAK, 'DISABLE HYPHENATION' , aNULL ), (xDIX , NOBREAK, 'DISABLE INDEXING' , aNULL ), (xDLE , BREAK , 'DISPLAY ELEMENTS' , aDLE ), (xDNM , BREAK , 'DISPLAY NUMBER' , aNCODE ), (xDOV , NOBREAK, 'DISABLE OVERSTRIKING' , aNULL ), (xDSP , BREAK , 'DISPLAY SUBPAGE' , aNCODE ), (xDT , NOBREAK, 'DO TABLE' , aDT ), (xDTB , BREAK , 'DISPLAY TABLE' , aDzz ), (xDTC , BREAK , 'DISPLAY TOC' , aNULL ), (xDUL , NOBREAK, 'DISABLE UNDERLINING' , aNULL ), (xDX , NOBREAK, 'DO INDEX' , aQSTRO ), (xDXP , NOBREAK, 'DISABLE XPLUS' , aNULL ), (xEB , NOBREAK, 'END BAR' , aNULL ), (xEBB , NOBREAK, 'ENABLE BAR' , azBB ), (xEBO , NOBREAK, 'ENABLE BOLDING' , aNULL ), (xEFN , NOBREAK, 'END FOOTNOTE' , aNULL ), (xEHY , NOBREAK, 'ENABLE HYPHENATION' , aNULL ), (xEI , NOBREAK, 'ENDIF' , aCOND ), (xEIX , NOBREAK, 'ENABLE INDEXING' , aNULL ), (xEL , BREAK, 'END LITERAL' , aNULL ), (xELS , BREAK, 'END LIST' , aINTOM ), (xELSE , NOBREAK, 'ELSE' , aCOND ), (xEN , NOBREAK, 'END NOTE' , aINTOM ), (xEOV , NOBREAK, 'ENABLE OVERSTRIKING' , aNULL ), (xES , BREAK, 'END SUBPAGE' , aNULL ), (xETC , NOBREAK, 'ENABLE TOC' , aNULL ), (xETN , NOBREAK, 'END TOPNOTE' , aINTO ), (xEUN , NOBREAK, 'ENABLE UNDERLINING' , aNULL ), (xEXP , NOBREAK, 'ENABLE XPLUS' , aATTR ), (xF , BREAK , 'FILL' , aNULL ), (xFG , BREAK , 'FIGURE' , aINTO ), (xFGD , BREAK , 'FIGURE DEFERRED' , aINTO ), (xFL , NOBREAK, 'FLAGS' , aFL ), (xFN , NOBREAK, 'FOOTNOTE' , aINTO ), (xFT , NOBREAK, 'FIRST TITLE' , aNULL ), (xFTA , NOBREAK, 'FIRST TITLE ALWAYS' , aNULL ), (xHD , NOBREAK, 'HEADERS' , aHD ), (xHE , NOBREAK, 'HEADER EXAMPLE' , aTEXT ), (xHF , NOBREAK, 'HEADER FIGURE' , aTEXT ), (xHL , SECBREAK,'HEADER LEVEL' , aHL ), (xHT , NOBREAK, 'HEADER TABLE' , aTEXT ), (xI , BREAK , 'INDENT' , aINTOM ), (xIF , NOBREAK, 'IF' , aCOND ), (xIN , NOBREAK, 'IFNOT' , aCOND ), (xJ , NOBREAK, 'JUSTIFY' , aNULL ), (xK , NOBREAK, 'KEEP' , aNULL ), (xLE , BREAK , 'LIST ELEMENT' , aNULL ), (xLM , NOBREAK, 'LEFT MARGIN' , aINTOPM ), (xLO , BREAK , 'LAYOUT' , aLO ), (xLS , BREAK , 'LIST' , aLS ), (xLT , BREAK, 'LITERAL' , aINTO ), (xNAJ , NOBREAK, 'NO AUTOJUSTIFY' , aNULL ), (xNAP , NOBREAK, 'NO AUTOPARAGRAPH' , aNULL ), (xNAST , NOBREAK, 'NO AUTOSUBTITLE' , aNULL ), (xNAT , NOBREAK, 'NO AUTOTABLE' , aNULL ), (xNATI , NOBREAK, 'NO AUTOAUTOTITLE' , aNULL ), (xNC , NOBREAK, 'NO CHAPTER' , aNULL ), (xNCC , NOBREAK, 'NO CONTROL CHARACTERS', aNULL ), (xND , NOBREAK, 'NO DATE' , aNULL ), (xNF , BREAK , 'NO FILL' , aNULL ), (xNFL , NOBREAK, 'NO FLAGS' , aFL ), (xNHD , NOBREAK, 'NO HEADERS' , aNULL ), (xNJ , NOBREAK, 'NO JUSTIFY' , aNULL ), (xNK , NOBREAK, 'NO KEEP' , aNULL ), (xNMA , NOBREAK, 'NUMBER APPENDIX' , aNMA ), (xNMCH , NOBREAK, 'NUMBER CHAPTER' , aINTOPM ), (xNMEX , NOBREAK, 'NUMBER EXAMPLE' , aINTOPM ), (xNMF , NOBREAK, 'NUMBER FOOTNOTE' , aNULL ), (xNMFG , NOBREAK, 'NUMBER FIGURE' , aINTOPM ), (xNMLS , NOBREAK, 'NUMBER LIST' , aNMLS ), (xNMLV , NOBREAK, 'NUMBER LEVEL' , aNMLV ), (xNMN , NOBREAK, 'NO NUMBER' , aNULL ), (xNMPG , NOBREAK, 'NUMBER PAGE' , aINTOPM ), (xNMR , NOBREAK, 'NUMBER RUNNING' , aINTOPM ), (xNMSPG, NOBREAK, 'NUMBER SUBPAGE' , aINTOPM ), (xNMTB , NOBREAK, 'NUMBER TABLE' , aINTOPM ), (xNNMF , NOBREAK, 'NO NUMBER FOOTNOTE' , aNULL ), (xNPA , NOBREAK, 'NO PAGING' , aNULL ), (xNPR , NOBREAK, 'NO PERIOD' , aNULL ), (xNSP , NOBREAK, 'NO SPACE' , aNULL ), (xNST , NOBREAK, 'NO SUBTITLE' , aNULL ), (xNT , BREAK, 'NOTE' , aTEXT ), (xNTN , NOBREAK, 'NO TOPNOTE' , aINTO ), (xP , BREAK , 'PARAGRAPH' , aP ), (xPA , NOBREAK, 'PAGING' , aNULL ), (xPG , NOBREAK, 'PAGE' , aNULL ), (xPR , NOBREAK, 'PERIOD' , aNULL ), (xPS , BREAK , 'PAGE SIZE' , aPS ), (xR , BREAK , 'RIGHT' , aR ), (xREF , NOBREAK, 'REFERENCEPOINT' , aREFNAME), (xREQ , NOBREAK, 'REQUIRE' , aREQ ), (xRES , NOBREAK, 'RESTORE' , aNULL ), (xRM , BREAK , 'RIGHT MARGIN' , aINTOPM ), (xRPT , NOBREAK, 'REPEAT' , aRPT ), (xS , BREAK , 'SKIP' , aINTOPM ), (xSALL , NOBREAK, 'SAVE ALL' , aNULL ), (xSAVE , NOBREAK, 'SAVE' , aNULL ), (xSCNT , NOBREAK, 'SET COUNTER' , aSCNT ), (xSCO , NOBREAK, 'SEND CONTENTS' , aSCO ), (xSDT , BREAK , 'SET DATE' , aSzz ), (xSL , NOBREAK, 'SET LEVEL' , aINTPM ), (xSP , NOBREAK, 'SPACING' , aINT ), (xSPG , BREAK , 'SUBPAGE' , aNULL ), (xSPR , NOBREAK, 'SET PARAGRAPH' , aP ), (xST , NOBREAK, 'SUBTITLE' , aTEXT ), (xSTAX , BREAK , 'STYLE APPENDIX' , aATTR ), (xSTCH , BREAK , 'STYLE CHAPTER' , aATTR ), (xSTEX , BREAK , 'STYLE EXAMPLE' , aATTR ), (xSTFG , BREAK , 'STYLE FIGURE' , aATTR ), (xSTHL , BREAK , 'STYLE HEADERS' , aSTHL ), (xSTM , NOBREAK, 'SET TIME' , aSzz ), (xSTTB , BREAK , 'STYLE TABLE' , aATTR ), (xSTXT , NOBREAK, 'SET TEXTSTRING' , aSTXT ), (xT , BREAK , 'TITLE' , aTEXT ), (xTN , NOBREAK, 'TOPNOTE' , aTN ), (xTP , BREAK , 'TEST PAGE' , aINT ), (xTS , NOBREAK, 'TAB STOPS' , aTS ), (xVR , NOBREAK, 'VARIABLE' , aVR ), (xX , NOBREAK, 'INDEX' , aTEXT ), (xXL , NOBREAK, 'XLOWER' , aNULL ), (xXP , NOBREAK, 'XPLUS' , azP ), (xXU , NOBREAK, 'XUPPER' , aNULL ), (xY , NOBREAK, 'ENTRY' , aTEXT ), (xYP , NOBREAK, 'YPLUS' , azP ), (xZWC , NOBREAK, 'ZWORD CREATE' , aZWx ), (xZWD , NOBREAK, 'ZWORD DELETE' , aZWx ), (xZCAP , NOBREAK, 'ZCAPTION' , aZCAP ), (xZBA , NOBREAK, 'ZBEGIN ABSTRACT' , aNULL ), (xZBE , NOBREAK, 'ZBEGIN EXAMPLE' , aNULL ), (xZBF , NOBREAK, 'ZBEGIN FIGURE' , aNULL ), (xZBP , NOBREAK, 'ZBEGIN PREFACE' , aNULL ), (xZBT , NOBREAK, 'ZBEGIN TABLE' , aNULL ), (xZEA , NOBREAK, 'ZEND ABSTRACT' , aNULL ), (xZEE , NOBREAK, 'ZEND EXAMPLE' , aNULL ), (xZEF , NOBREAK, 'ZEND FIGURE' , aNULL ), (xZEP , NOBREAK, 'ZEND PREFACE' , aNULL ), (xZET , NOBREAK, 'ZEND TABLE' , aNULL ), (xZLT , BREAK, 'ZLITERAL' , aZLT ), (xZQUAL, NOBREAK, 'ZQUALIFIERS' , aQSTR ) ); var { These four items describe the current command. } CurLineNumber: integer; { Source line number of command } CurComNumber: ComType; { Command number } CurArgCount: integer; { Number of arguments } CurArgList: AnyString; { List of arguments } var { First three argument of current command } Arg1: AnyString; Arg2: AnyString; Arg3: AnyString; {***************************************************************} { } { Pipeline Table } type PipeType = record LineNumber: integer; ComNumber: ComType; ArgCount: integer; ArgList: AnyString; end; const MaxPipe = 100; var Pipe: array[1..MaxPipe] of PipeType; PipeSize: integer; PipePtr: integer; TestCount: integer; {count --returned by TestPipe} TestLoc : integer; {position in PipeLine --returned by TestPipe} {***************************************************************} { } { Cursor Position Flags } var Preface : Boolean; { cursor in preface } FrontMatter : Boolean; { cursor in front matter } Abstract : Boolean; { cursor in abstract } AbstractWritten : Boolean; PrefaceWritten : Boolean; ChapterFlag : Boolean; { cursor in a chapter } BackMatter : Boolean; { cursor in backmatter } AppendixFlag : Boolean; { cursor in an appendix } Glossary : Boolean; { cussor in a glossary } FigureFlag : Boolean; { cursor in a figure } TableFlag : Boolean; InFootNote : Boolean; { curson in footnote } IfFlag : Boolean; { cursor in condition } InTable : Boolean; InLiteral : Boolean; LiteralInPipe : Boolean; InAlign : Boolean; InEmphasis : Boolean; InUnderline : Boolean; InNoFill : Boolean; InQual : Boolean; InProfile : Boolean; InElement : Boolean; InDefList : Boolean; { cursor in a definition list cliche } NoDefList : Boolean; { determines whether DefList cliche translated} NoKey : Boolean; { determines whether keys are translated} StartLine : Boolean; { cursor in first column part of ^ } Table : Boolean; { cursor in a table } RowOpen : Boolean; { cursor in row of table } SeriousError : Boolean; ContTab : Boolean; XPlusHit : Boolean; {determines whether DSR or DSRPLUS hit} IndexHitsWaiting : Boolean; RTBFile : Boolean; {set when processing RTB table file} ZLit : Boolean; {set when ZLit recognized } MoreLines : Boolean; LineWaiting : Boolean; ErrorsInList : Boolean; {set true if errors are reported in list file} NullCaption : Boolean; PagingOn : Boolean; SubsequentLine : Boolean; {used to indent lines in RTB tables} TableAbort : Boolean; CodeExWaiting : Boolean; {used to prevent generating empty code examples} InTopNote : Boolean; { used to comment out material in Top notes} Implicit : Boolean; { distinguishes between .ht and .zcap} NoRevisionYet : Boolean; { prevents generation of multiple revision tags } {***************************************************************} { } { Variables for Specific DSR Commands } const SizeRefWordWord = 40; MaxRefWordTable = 100; ElementTabLim = 100; RefWdMax = 5; TabStopMax = 10; type TypeRefWordCode = char; TypeRefWordWord = varying[SizeRefWordWord] of char; RefWordRecord = record Code: TypeRefWordCode; Word: TypeRefWordWord; end; var RefWordTable: array[1..MaxRefWordTable] of RefWordRecord; RefWordFree: integer; RefWd: array[1..RefWdMax] of ShortString; ElementTab: array[1..ElementTabLim] of AnyString; ElementTabMax : Integer; ElementSuffix : ANyString; ElementFileName : AnyString; ElementCode : char; FigureSpace : ShortString; FigureCaption : AnyString; FigureTitle : AnyString; FigureSym : ShortSTring; FigExName : ShortString; RealCaption : Boolean; Lit : Array[1..9999] of WideLine; LitMax : Integer; LitPtr : Integer; HoldTab : Array[1..HoldTabMax] of AnyString; HoldTabPtr : Integer; RowMax : integer; HLCounter : integer; ChapterCount : integer; ChapterSym : ShortString; ChapterNum : ShortString; AppendixCount : integer; AppendixSym : ShortString; TabCounter : Integer; FigCounter : integer; ExCounter : integer; IfNest : integer; ListDepth : integer; ListType : ShortString; CurMargin : integer; OldMargin : integer; DefListCount : integer; HColPos : Array[1..9] of integer; HeadColPos : Array[1..9] of integer; ColPos : Array[1..9] of integer; Col : Array[1..9] of LongLine; NewCol : LongLine; HeadColCount : integer; ColCount : integer; NewColCount : integer; NumCols : Integer; DataPresent : Boolean; TableHead : Boolean; SetupInfo : AnyString; TpCount : Integer; AutoPara : Boolean; KeepOn : Boolean; ConditionName : AnyString; Attr : AnyString; Attr2 : AnyString; AttrList : AnyString; BarCount : integer; TabStop : Array[1..TabStopMax] of Integer; TabStopLim : Integer; IndexType : ShortString; {***************************************************************} { } { SAVE/RESTORE Stack } { This stack saves the status of the flags, the FILL and KEEP } { switches, the current tab stops, and (for SAVE ALL only) the } { AUTOPARAGRAPH switch. } type SaveStackType = record QSaveAll: Boolean; { True if created by SAVEALL command } QFlagsChar: FlagsType; { Recent flags, whether on or off } QFlagsCur: FlagsType; { Current flag settings } QFlagsSaved: FlagsType; { Saves cur flags during .NFL ALL } QFlagsAllOn: Boolean; { Controlled by .FL ALL and .NFL ALL } QCommentFlagCur: char; { Current Comment Flag setting } QControlFlagCur: char; { Current Control Flag setting } QCommentFlagChar: char; { Recent Comment Flag char } QControlFlagChar: char; { Recent Control Flag char } QBoldingEnabled: Boolean; { Switches for enabling } QHyphenationEnabled: Boolean; { and disabling flags } QIndexingEnabled: Boolean; QOverstrikingEnabled: Boolean; QUnderliningEnabled: Boolean; QInNoFill: Boolean; { True if FILL is on } QKeepOn: Boolean; { True if KEEP is on } QTabStop: array[1..TabStopMax] of integer; { TabStop } QTabStopLim: integer; QAutoPara: Boolean; { True if AUTOPARAGRPH is on } end; const MaxSaveStack = 20; var SaveStack: array[1..MaxSaveStack] of SaveStackType; SaveStackSize: integer; {***************************************************************} {***************************************************************} {** **} {** ROUTINE DECLARATIONS **} {***************************************************************} { } { Forward Routine Declarations } procedure TrimRight(var S:AnyString); forward; procedure AddRefDef(RefDef:ShortString); forward; procedure PutPipe; forward; function SubPos(S,Pattern:AnyString;Start:Integer):integer; forward; function Mid(S:AnyString;Start,CharCount:integer):AnyString; forward; function CheckPipe(TargetCom:ComType) : Boolean; forward; procedure UnpackCommand(I:integer); forward; procedure Dispatch; forward; procedure PutLine(S:AnyString); forward; function ToUpper(C:char): char; forward; procedure PutElement(S:AnyString); forward; procedure Delete(var S:varying[Len] of char;Pos:integer;CharCount:integer); forward; procedure Insert(var S:varying[Len] of char;Pos:integer;Ins:AnyString); forward; procedure IndexPlusCom(S:ShortString); forward; procedure IndexCom(S:ShortString); forward; procedure ErrorPrint(ErrorText : varying [l1] of char); forward; procedure Caption; forward; procedure ClearSection; forward; function CapLine: Boolean; forward; procedure PutTabLine(S:LongLine); forward; procedure RestoreState; forward; procedure ProcessCol(S:LongLine); forward; {***************************************************************} { } { Debugging Routines } { } { To shut down all debugging output, Set EnableDebug to False. } { To remove debugging code, take out the Debugging Data part } { and the Debugging Subroutines part (this part); also remove } { every procedure call that has 'Debug' in its procedure name; } { and take out the special stuff that calls the dump routines. } procedure InitDebug; begin TerminalInput:=true; EnableDebug:=true; end; procedure DumpRefWordTable; var I: integer; begin writeln('Dump.... Table of Reference Words:'); for I:= 1 to RefWordFree-1 do begin writeln( 'Code = ',RefWordTable[I].Code, ' Word = ',RefWordTable[I].Word); end; writeln('ImplicitCaption=',ImplicitCaption); writeln('IncludeSource=',IncludeSource); end; procedure DumpComTab; var SSink: AnyString; I: ComType; More: Boolean; begin EnableDebug := false; I := xUndef; More := true; writeln('Dump.... Table of DSR Commands'); while More do begin writeln( ' ',ord(I):3, ' CA=',ord(ComTable[I].CA):1, ' CS=',ComTable[I].CS, ' CN=',ord(ComTable[I].CN):1); if (I <> ComTable[I].CN) then begin writeln('Dump.... INTERNAL ERROR: ComTable.CN <> index'); writeln(' Press RETURN to continue'); readln(SSink); end; if I = xZQUAL then More := false else I:=succ(I); end; end; procedure DecodeFlag(var Arg: AnyString); begin case ord(Arg[1]) of cACCEPT: Arg:='ACCEPT'; cBOLD: Arg:='BOLD'; cBREAK: Arg:='BREAK'; cCAPITALIZE: Arg:='CAPITALIZE'; cCOMMENT: Arg:='COMMENT'; cCONTROL: Arg:='CONTROL'; cHYPHENATE: Arg:='HYPHENATE'; cINDEX: Arg:='INDEX'; cLOWERCASE: Arg:='LOWERCASE'; cNOPERMUTE: Arg:='NOPERMUTE'; cOVERSTRIKE: Arg:='OVERSTRIKE'; cPERIOD: Arg:='PERIOD'; cSPACE: Arg:='SPACE'; cSUBINDEX: Arg:='SUBINDEX'; cSUBSTITUTE: Arg:='SUBSTITUTE'; cUNDERLINE: Arg:='UNDERLINE'; cUPPERCASE: Arg:='UPPERCASE'; end; end; procedure DumpSaveStack; var I,J: integer; begin for I:=1 to SaveStackSize do begin with SaveStack[I] do begin writeln('I=',I:1,' SaveAll= ',QSaveAll,' FlagsChar= ',QFlagsChar); writeln(' FlagsCur= ',QFlagsCur,' FlagsSaved= ',QFlagsSaved); writeln(' FlagsAllOn= ',QFlagsAllOn); writeln(' CommentFlagCur= ',QCommentFlagCur, ' ControlFlagCur= ',QControlFlagCur); writeln(' CommentFlagChar= ',QCommentFlagChar, ' ControlFlagChar= ',QControlFlagChar); writeln(' BoldingEnabled= ',QBoldingEnabled, ' HyphenationEnabled= ',QHyphenationEnabled, ' IndexingEnabled= ',QIndexingEnabled); writeln(' Overstrikingenabled= ',QOverstrikingEnabled, ' UnderliningEnabled= ',QUnderliningEnabled); writeln(' InNoFill= ',QInNoFill, ' KeepOn= ',QKeepOn, ' AutoPara= ',QAutoPara, ' TabStopLim= ',QTabStopLim:1); for J:=1 to QTabStopLim do begin writeln(' TabStop[',J:1,']=',QTabStop[J]:1); end; writeln; end end; end; procedure DumpCom( XLineNumber: integer; XComNumber: ComType; XArgCount: integer; XArgList: AnyString); var I: integer; Arg: AnyString; ComText: AnyString; BreakString: AnyString; ArgText: AnyString; Start,Stop: integer; begin if ComTable[XComNumber].CB=BREAK then BreakString:='break' else BreakString:='nobrk'; writev(ComText, 'Line ',XLineNumber:1,': ', ComTable[XComNumber].CS, '(',ord(ComTable[XComNumber].CN):1,' ',BreakString,') ', XArgCount:1,' '); Start := 1; for I := 1 to XArgCount do begin Stop := SubPos(XArgList,ArgEnd,Start); Arg := Mid(XArgList,Start,Stop-Start); if (I=1) and ((XComNumber=xFL) or (XComNumber=xNFL)) then DecodeFlag(Arg); writev(ArgText,'<',Arg,'> '); if Length(ComText)+Length(ArgText) > RegularLineSize-3 then begin writeln(ComText+ArgText); ComText := ' '; end else ComText := ComText+ArgText; Start := Stop+1; end; if Length(ComText) > 8 then writeln(ComText); end; procedure DumpPipe; var I: integer; SaveEnableDebug: Boolean; begin SaveEnableDebug := EnableDebug; EnableDebug := false; writeln('Dump.... Command Pipeline: '); for I := 1 to PipeSize do begin write(' ',I:2,' '); DumpCom( Pipe[I].LineNumber, Pipe[I].ComNumber, Pipe[I].ArgCount, Pipe[I].ArgList); end; EnableDebug := SaveEnableDebug; end; Function FixNull(C:char): char; begin if C=chr(0) then FixNull:='0' else FixNull:=C; end; procedure DumpOneFlag(S:AnyString;I:integer); begin writeln(' ', S:10,' ', FixNull(FlagsChar[I]),' ', FixNull(FlagsCur[I]),' ', FixNull(FlagsSaved[I])); end; procedure DumpFlagValues; begin EnableDebug := false; writeln('Dump.... ',' Flag':8,' Char Cur Saved'); DumpOneFlag('ACCEPT',cACCEPT); DumpOneFlag('BOLD',cBOLD); DumpOneFlag('BREAK',cBREAK); DumpOneFlag('CAPITALIZE',cCAPITALIZE); DumpOneFlag('HYPHENATE',cHYPHENATE); DumpOneFlag('INDEX',cINDEX); DumpOneFlag('LOWERCASE',cLOWERCASE); DumpOneFlag('NOPERMUTE',cNOPERMUTE); DumpOneFlag('OVERSTRIKE',cOVERSTRIKE); DumpOneFlag('PERIOD',cPERIOD); DumpOneFlag('SPACE',cSPACE); DumpOneFlag('SUBINDEX',cSUBINDEX); DumpOneFlag('SUBSTITUTE',cSUBSTITUTE); DumpOneFlag('UNDERLINE',cUNDERLINE); DumpOneFlag('UPPERCASE',cUPPERCASE); writeln(' ', 'CONTROL':10,' ', FixNull(ControlFlagChar),' ', FixNull(ControlFlagCur)); writeln(' ', 'COMMENT':10,' ', FixNull(CommentFlagChar),' ', FixNull(CommentFlagCur)); end; procedure Test; var S:AnyString; begin write('Enter string: '); readln(S); TrimRight(S); writeln('Trimmed string: <',S,'>'); end; function DebugCommand: Boolean; begin DebugCommand := false; if Length(InputLine) >= 1 then begin if InputLine[1] = '?' then begin DebugCommand := true; if Length(InputLine) >= 2 then begin case ToUpper(InputLine[2]) of 'C': DumpComTab; 'D': EnableDebug := true; 'F': TerminalInput := false; 'I': ImplicitCaption := not ImplicitCaption; 'P': DumpPipe; 'Q': EnableDebug := false; 'S': IncludeSource := not IncludeSource; 'T': TerminalInput := true; 'V': DumpFlagValues; 'W': DumpRefWordTable; 'A': DumpSaveStack; 'Z': Test; otherwise writeln(' Type ? and RETURN for help'); end; end else begin writeln('Help.... ?F (Input from file) ?D (Debug output) ?Q (No debug output)'); writeln(' ?P (Dump PipeLine) ?C (Dump ComTable) ?V (Dump flag table)'); writeln(' ?W (Dump Ref Words) ?I (Toggle ImpCap) ?S (Toggle IncSource)'); writeln(' ?A (Dump Saved State)'); end; end; end; end; {***************************************************************} { } { String and Character Routines } { } { These routines are general; that is, they have nothing in } { particular to do with the process of converting DSR files to } { Document file. } function IsDigit(C:char): Boolean; { Returns true iff C is a digit } begin IsDigit := (C in ['0'..'9']); end; function IsLetter(C:char): Boolean; { Returns true iff C is an upper or lower case letter } begin IsLetter := (C in ['A'..'Z','a'..'z']); end; function IsLetterOrDigit(C:char): Boolean; { Returns true iff C is an upper, lower case letter, or digit } begin IsLetterOrDigit := (C in ['A'..'Z','a'..'z','0'..'9']); end; function ControlChar(C:char): Boolean; { Returns true iff C is an upper, lower case letter, or digit } begin ControlChar := (C in [chr(0)..chr(31),chr(127)..chr(255)]); end; function IsEOL: Boolean; { Returns true if current letter is End-of-Line char; P must } { be a valid index of InputLine (ie, current char must exit) } var Result: Boolean; begin IsEOL := (InputLine[P]=EOL); end; function ToUpper{(C:char): char}; { Returns true iff C is an upper case letter } begin if C in ['a'..'z'] then ToUpper := chr(ord(C)-32) else ToUpper := C; end; function ToLower(C:char): char; { Returns true iff C is an lower case letter } begin if C in ['A'..'Z'] then ToLower := chr(ord(C)+32) else ToLower := C; end; function StringToUpper(S:AnyString): AnyString; { Returns argument with all letters capitalized } var J: integer; STemp: AnyString; begin STemp:=S; for J:=1 to Length(STemp) do STemp[J]:=ToUpper(STemp[J]); StringToUpper:=STemp; end; function StringToInteger(S:AnyString): integer; { Converts a string that begins with an optionally signed integer to } { a value of type integer. If the integer is greater than 32759, the } { returned value will be incorrect; however, no error is reported and } { the routine does not crash. Any chars that follow the integer are } { ignored. The routine assumes that the given string ends with a } { character that is not a sign or a digit; otherwise, it may crash. } var I: integer; Sign: integer; Val: integer; begin I:=1; Sign:=+1; Val:=0; if S[I]='+' then I:=I+1 else if S[I]='-' then begin Sign:=-1; I:=I+1; end; while IsDigit(S[I]) do begin if Val <= 3275 then begin Val:=10*Val+Index('0123456789',S[I])-1; end; I:=I+1; end; StringToInteger:=Sign*Val; end; function SubPos{(S,Pattern:AnyString;Start:Integer): integer}; { Checks the portion of S beginning at position Start for the } { instance of Pattern. Returns 0 if Pattern is not found; } { otherwise, returns the position of the first matched char. } { Start must lie in the range from 1 through Length(S). } var Object: AnyString; Len: integer; Result: integer; begin if (Start<1) or (Start>Length(S)) then begin SubPos := 0; ErrorPrint('Internal Error -- SubPos'); end else begin Result := Index(SubStr(S,Start,Length(S)-Start+1),Pattern); if Result <> 0 then SubPos := Result+Start-1 else SubPos := 0; end; end; function UpCase(InString:AnyString):AnyString; var TempString : AnyString; i, ordc : Integer; c : char; begin TempSTring := InString; InString := ''; for i := 1 to length(TempString) do begin c := TempString[i]; ordc := ord(c); if (ordc>96) and (ordc<123) then c := chr(ordc -32); InString := Instring +c; end; UpCase := InString; end; function Left(S:LongLine;CharCount:integer): LongLine; { Returns the string that is the first CharCount chars of S. } { CharCount must lie in the range from 0 through Length(S). } begin if CharCount <= 0 then Left := '' else begin if CharCount>Length(S) then Left := S else Left := Substr(S,1,CharCount); end; end; function Mid{(S:AnyString;Start,CharCount:integer): AnyString}; { Returns the string that begins at position Start a is } { CharCount characters in length. Start must be in the range } { 1 through Length(S), and CharCount must be in the range 0 } { through Length(S)-Start+1. (The upper limit calls for the } { remainder of the string S.) } begin if (CharCount = 0) or (Start>=length(S)) then Mid:='' else Mid:=Substr(S,Start,CharCount); end; function Right(S:LongLine;Start:integer): LongLine; { Returns the string that begins at position Start and } { contains the remainder of the characters in S. Start must } { lie in the range from 1 through Length(S)+1. } begin if Start>=Length(S)+1 then Right := '' else Right := Substr(S,Start,Length(S)-Start+1); end; procedure Delete{(var S:varying[Len] of char;Pos:integer;CharCount:integer)}; begin if CharCount > 0 then begin if Pos <= Length(S) then begin if Pos > 1 then begin if Pos+CharCount <= Length(S) then begin S := substr(S,1,Pos-1) + substr(S,Pos+CharCount,Length(S)-Pos-CharCount+1); end else S := substr(S,1,Pos-1); end else begin if CharCount < Length(S) then begin S := substr(S,CharCount+1,Length(S)-CharCount); end else S:=''; end; end; end; end; procedure Insert{(var S:varying[Len] of char;Pos:integer;Ins:AnyString)}; var HeadLength: integer; TailLength: integer; begin HeadLength:=Pos-1; TailLength := Length(S)-HeadLength; if HeadLength > 0 then begin if TailLength > 0 then begin S := substr(S,1,HeadLength) + Ins + substr(S,Pos,TailLength); end else S := S + Ins end else if HeadLength = 0 then S := Ins + S; end; procedure TrimRight{(var S:AnyString)}; label Done; begin while Length(S) > 0 do begin if S[Length(S)] in [' ',HORTAB] then begin S:=substr(S,1,Length(S)-1); end else goto Done; end; Done: end; {***************************************************************} { } { Input/Output Routines } { } { These routines manage the input from the DSR file, the } { output to the Document file, and the output to the error } { message file. } [ASYNCHRONOUS,EXTERNAL(LIB$GET_FOREIGN)] function $GET_FOREIGN ( getstr : [CLASS_S] PACKED ARRAY [$l1..$u1:INTEGER] OF CHAR := %IMMED 0; uprompt : [CLASS_S] PACKED ARRAY [$l2..$u2:INTEGER] OF CHAR; %REF outlen : $word := %IMMED 0; %REF fprompt : integer := %immed 0):INTEGER; { Declares routine that gets the command line } external; procedure SeriousErrorPrint( S: varying[I1] of char); begin SeriousError := true; ErrorPrint(S); SeriousError := false; end; procedure PutList(S:AnyString); begin if ListFileOpen then writeln(ListFileVar,S) else writeln(S); end; procedure ErrorPrint2(ErrorText : varying [l1] of char); begin If ListFileOpen then writeln(listFileVar,ErrorText) else writeln(errorText); end; procedure ErrorPrint{( ErrorText : varying [l1] of char)}; { Writes File, Line, and error message } var ErrorMessage: varying[255] of char; ErrorMessage2: varying[255] of char; procedure WriteTerm; begin writeln; writeln('*** '+ErrorText); writeln(ErrorMessage2); writeln(ErrorMessage); end; begin ErrorsInList := true; if OutLineCount[OutFileIndex] =0 then ErrorMessage:='' else writev(ErrorMessage,'Output File '+OutFile[OutFileIndex]+', Line ', OutLineCount[OutFileIndex]:1); if InputLineCount[FileIndex]=0 then ErrorMessage2:='' else writev(ErrorMessage2,'Input File '+InFile[FileIndex]+', Line ', InputLineCount[FileIndex]:1); if EnableInteraction then begin writeln('ToErr... ',ErrorMessage); writeln(' ',' ***'+ErrorText); end; if ListFileOpen then begin writeln(ListFileVar,''); writeln(ListFileVar,'*** '+ErrorText); writeln(ListFileVar,ErrorMessage2); writeln(ListFileVar,ErrorMessage); if SeriousError then WriteTerm; end else WriteTerm; end; procedure ErrorEx(S1:MedString;I1:integer;S2:MedString;I2:integer); begin if EnableInteraction then begin writeln('ToErr... ',S1,I1,S2,I2); end; if ListFileOpen then begin writeln(ListFileVar,S1,I1,S2,I2); end else writeln(S1,I1,S2,I2); end; procedure Xwriteln(S1:MedString;I1:integer); begin if EnableInteraction then begin writeln('ToErr... ',S1,I1); end; if ListFileOpen then begin writeln(ListFileVar,S1,I1); end else writeln(S1,I1); end; procedure CheckExtension; { Checks FileName and adds extension, produces FilePart } var I1,I2,I3: integer; FileExt : AnyString; begin IllegalFile := false; I1 := index(FileName,']'); DirName := Left(FileName,I1); FileName := Right(FileName,I1+1); I2 := index(FileName,'.'); if I2 <> 0 then begin FileExt := right(FileName,i2+1); if UpCase(FileExt) <> 'RNO' then if UpCase(FileExt)= 'RTB' then RTBFile := true else IllegalFile := true; FilePart := DirName + Left(FileName,I2-1); FileName := DirName + FileName; end else begin FilePart := DirName+FileName; if not RTBFile then FileName := FilePart+'.rno' else FileName := FilePart+'.rtb'; end; end; procedure WriteListTerm(S:AnyString); begin writeln(S); if Listing and ListFileOpen then writeln(ListFileVar,S); end; procedure OpenFiles; { Opens Input and Output Files } label GetFile, GetProFile, OpenEx; var FileStatus : integer; function CheckStatus(FStatus:Integer) : Boolean; { Checks for file errors } begin FileStatus := FStatus; if FileStatus > 0 then begin CheckStatus := false; if FileStatus > 4 then FileStatus := 5 end else CheckStatus := true; end; procedure SkipFile(S: AnyString); begin SeriousErrorPrint(S); if not InProfile then OutFileIndex := OutFileIndex-1; FileIndex := FileIndex-1; if RTBFile then RTBFile := false; end; begin GetFile: CheckExtension; if IllegalFile then begin if FirstFile then begin writeln('Not a .RNO file -- please enter filename:'); readln(FileName); goto GetFile; end else begin SkipFile('Not a .RNO file -- Ignoring -- '+FileName); goto OpenEx; end; end; InputLineCount[FileIndex]:=0; InFile[FileIndex] := FileName; OutFile[OutFileIndex] := FilePart +'.sdml'; open(InFileVar[FileIndex], InFile[FileIndex], readonly, error := continue ); if CheckStatus(Status(InFileVar[FileIndex])) = false then begin if FirstFile then begin writeln ('File '+FileMessage[FileStatus]+' -- please enter filename:'); readln (FileName); goto GetFile; end else begin SkipFile('Required file '+filename+'-- '+FileMessage[FileStatus]); goto OpenEx; end; end; reset(InFileVar[FileIndex]); DOCFileID := 'Created by '+VersionID+'from file '+InFile[FileIndex]; Date(DateStr); Time(TimeStr); DateStamp := ' on '+DateStr + ' at '+TimeStr; If not InProfile then begin OutLineCount[OutFileIndex] := 0; open(OutFileVar[OutFileIndex], OutFile[OutFileIndex], record_length := 255 ); rewrite(OutFileVar[OutFileIndex]); writeln(OutFileVar[OutFileIndex],'('+DOCFileID+')'); writeln(OutFileVar[OutFileIndex],'('+DateStamp+')'); end else if InElement then writeln(OutFileVar[OutFileIndex], '('+DOCFileID+')'); if FirstFile then begin OrigFileName := FileName; if InProfile then begin GetProfile: ProFile := ProFileName + '.SDML'; open(ProFileVar, ProFile, record_length := 255, error := continue ); if checkstatus(Status(ProFileVar))=false then begin writeln ('Profile File '+FileMessage[FileStatus]+' -- please reenter:'); readln (ProFileName); goto GetProFile; end; rewrite(ProFileVar); writeln(ProfileVar,'('+DOCFileID+')'); writeln(Profilevar,''); ElementSuffix := 'FRONT'; ElementFileName := ProfileName+'_'+ElementSuffix+'.SDML'; PutElement('('+ElementFileName+')'); writeln(ProFileVar,''); OutFile[OutFileIndex] := ElementFileName; OutLineCount[OutFileIndex] := 0; open(OutFileVar[OutFileIndex], OutFile[OutFileIndex], record_length := 255 ); rewrite(OutFileVar[OutFileIndex]); writeln(OUtFileVar[OutFileIndex],'(front)'); writeln(OutFileVar[OutFileIndex],'('+DocumentTitle+')'); writeln(OutFileVar[OutFileIndex],'<ABSTRACT>(<DATE>)'); end; ListFile := FileName+'_lis'; if Listing then begin open(ListFileVar, ListFile, record_length := 255 ); rewrite(ListFileVar); writeln(ListFileVar,DOCFileId); writeln(ListFileVar,DateStamp); writeln(ListFileVar,VersionID+paramstring); writeln(ListFileVar); ListFileOpen := true; end; open(LiteralFileVar,FileName+'_literal', record_length := 255, Disposition:=DELETE); FirstFile := false; end; WriteListTerm('Opening File: "'+FileName+'"'); OpenEx: end; procedure OutFront1; begin writeln(OutFileVar[OutFileIndex],'<ENDABSTRACT>'); writeln(OutFileVar[OutFileIndex],'<REVISION_INFO>(Revision\New or Updated Manual)'); writeln(OutFileVar[OutFileIndex],'<ENDTITLE_PAGE>'); writeln(OutFileVar[OutFileIndex],'<COPYRIGHT_PAGE>'); writeln(OutFileVar[OutFileIndex],'<PRINT_DATE>(Insert date here)'); writeln(OutFileVar[OutFileIndex],'<COPYRIGHT_DATE>(Insert copyright date here)'); writeln(OutFileVar[OutFileIndex],'<ENDCOPYRIGHT_PAGE>'); writeln(OutFileVar[OutFileIndex],'<PREFACE>'); end; procedure OutFront2; begin writeln(OutFileVar[OutFileIndex],'<ENDPREFACE>'); writeln(OutFileVar[OutFileIndex],'<ENDFRONT_MATTER>'); close (OutFileVar[OutFileIndex]); end; procedure TranslateLogicalName; { Looks up LogicalName and returns FileName } begin with ItemList do begin BufLen := BufferLength; ItmCod := LNM$_STRING; BufAdr := iaddress(BufferForEquivalence); RetLen := iaddress(EquivalenceLength); LastWd := 0; end; if $TRNLNM(LNM$M_CASE_BLIND,LogicalNameTable,LogicalName,,ItemList) = SS$_NORMAL then begin FileName := substr(BufferForEquivalence,1,EquivalenceLength); end else FileName := LogicalName; end; procedure EndUnit; var n1 : integer; begin if length(unit)>0 then if InQual then if QualLim < QualMax then begin QualLim := QualLim + 1; n1:=index(unit,'='); if n1<>0 then begin QualTab[QualLim] := left(unit,n1-1); QualArg[QualLim] := right(unit,n1+1); end else begin QualTab[QualLim] := unit; QualArg[QualLim] := ''; end; InQual := false; end else writeln('Too many qualifiers') else if LogicalName='' then LogicalName := unit; unit:=''; end; procedure GetQualifiers; var i : integer; c : char; InQuote : boolean; BlankFound : Boolean; EqualFound : Boolean; begin EqualFound := false; BlankFound := false; InQual := false; InQuote := false; Unit := ''; QualLim := 0; for i := 1 to length(ParamString) do begin c := ParamString[i]; if (c = ' ') and not Inquote then BlankFound := True else if (c = '/') and not Inquote then begin EndUnit; InQual := true; end else if c='"' then InQuote := not Inquote else if c='=' then begin EqualFound := true; unit:=unit+ToUpper(c); end else if Equalfound then begin EqualFound := false; unit := unit + ToUpper(c); BlankFound := false; end else begin if BlankFound then begin BlankFound := false; EndUnit; end; unit := unit + ToUpper(c); end; end; EndUnit; end; function CheckQual(S:ShortString): boolean; var QualCount : integer; procedure SearchQual(S:ShortString); var i : integer; n1 : integer; begin for i := 1 to QualLim do begin n1 := index(S,QualTab[i]); if n1=1 then begin QualCount := QualCount+1; QualLoc := i; end; end; end; begin FoundVal := true; QualCount := 0; SearchQual(S); if QualCount=0 then begin FoundVal := false; SearchQual('NO'+S); end; if QualCount=1 then begin QualFound[QualLoc] := true; CheckQual := true; end else begin if QualCount>1 then writeln('Ambiguous qualifier -- '+S); CheckQual := false; end; end; procedure StartUp; { Gets command line and opens main file } var ParamArray : packed array [1..132] of char; i : integer; begin for i:= 1 to 132 do ParamArray:=' '; FirstFile := true; ListFileOpen := false; SysStatus := $get_foreign(ParamArray,UPrompt,ClLen,); ParamString := Left(ParamArray,ClLen); LogicalName := ''; GetQualifiers; for i := 1 to QualLim do QualFound[i] := false; {if CheckQual('DEBUG') then EnableInteraction := FoundVal else} EnableInteraction := false; if CheckQual('LIST') then Listing := FoundVal else Listing := true; if CheckQual('DEFLIST') then NoDefList := not FoundVal else NoDefList := false; if CheckQual('KEY') then NoKey := not FoundVal else Nokey := true; If CheckQual('IMPLICIT_CAPTION') then ImplicitCaption := FoundVal else ImplicitCaption := true; if CHeckQual('PAGE') then PagingON := FoundVal else PagingOn := false; if CheckQual('INCLUDE_DSR') then IncludeSource := FoundVal else IncludeSource := false; if CheckQual('TABLE') then RTBFile := true else RTBFile := false; if (CheckQual('PROFILE')) and FoundVal then begin ProFileName:= QualArg[QualLoc]; InProfile := true; end; if (CheckQual('TITLE')) and FoundVal then DocumentTitle := QualArg[Qualloc]; for I := 1 to QualLim do if not QualFound[i] then writeln('Unrecognized Qualifier -- '+QualTab[i]); if EnableInteraction and (LogicalName='') then LogicalName :='DSRTEST.RNO'; { EnableDebug:=false; } TranslateLogicalName; FileIndex := 1; OutFileIndex := 1; OpenFiles; end; function CountSize(Count:Integer):Integer; begin if Count<10 then CountSize := 1 else if Count<100 then CountSize := 2 else if Count<1000 then CountSize := 3 else CountSize := 4; end; procedure WrapUp; { Close out sections } var i:integer; Undefined : Boolean; SymCountStr : ShortString; LastErr : AnyString; begin ClearSection; if Glossary then PutLine('<ENDGLOSSARY>'); if AppendixFlag then PutLine('<ENDAPPENDIX>'); if InDefList then ErrorPrint('Unterminated Table Generated'); if InProfile then begin writeln(ProFileVar,'<INDEX_FILE>'); writeln(ProFileVar,'<ENDPROFILE>'); Close(ProFileVar); end; close(LiteralFileVar); delete_file(FileName+'_literal'); undefined := false; for i := 1 to ReferenceLimit do if not SymDef[i] then begin if not Undefined then begin Undefined := true; PutList(''); PutList(''); PutList(' UNDEFINED REFERENCES'); PutList(''); PutList('Symbol No. of References'); PutList(''); end; writev(SymCountStr,SymRefCount[i]:CountSize(SymRefCount[i])); PutList(Right(SymSym[i],2)+left(spaces,20-length(SymSym[i]))+ SymCountStr); end; LastErr:=''; if Undefined then LastErr := 'Undefined References --'; if (Undefined or ErrorsInList) and (ListFileOpen) then writeln('*** '+LastErr+' See List File ('+OrigFileName+'_LIS)'); end; procedure ControlCharWarning; label TabEx; var J,i,TabCol,NumSpaces: integer; S: AnyString; begin J := 1; while J <= Length(InputLine) do begin if InputLine[J] in [chr(0),HORTAB,RefStartChar,RefStopChar] then begin if InputLine[J]=HORTAB then begin for i := 1 to TabStopLim do begin if TabStop[i]>j then begin TabCol := TabStop[i]; Goto Tabex; end; end; TabCol := j+1; TabEx: NumSpaces := TabCol-j; InputLine[J] := ' '; Insert(InputLine,J,Left(spaces,numspaces)); J := J+NumSpaces+1; end else if InputLine[J]=chr(0) then begin Delete(InputLine,J,1); end else begin writev(S,ord(InputLine[J]):1); ErrorPrint( 'ASCII character '+S+' decimal ignored '); Delete(InputLine,J,1); end; end else J := J+1; end; end; function GetLine: Boolean; var GotLine: Boolean; ReadNextLine: Boolean; begin ReadNextLine:=True; while ReadNextLine do begin ReadNextLine:=false; GotLine:=true; if TerminalInput and EnableInteraction then begin write('FrTerm.. '); if eof then begin writeln('[End of File (Control-Z)]'); GotLine:=false; end else begin readln(InputLine); TrimRight(InputLine); if (InputLine='EXIT') or (InputLine='exit') then GotLine:=false; end; end else begin if eof(InFileVar[FileIndex]) then GotLine:=false else begin readln(InFileVar[FileIndex],InputLine); TrimRight(InputLine); end end; if GotLine then begin if EnableInteraction then begin if not TerminalInput then writeln('FrFile.. ',InputLineCount[FileIndex]+1:1,': ',InputLine); if DebugCommand then ReadNextLine:=true else InputLineCount[FileIndex] := InputLineCount[FileIndex]+1; end else InputLineCount[FileIndex] := InputLineCount[FileIndex]+1; ControlCharWarning; InputLine:=InputLine+EOL; P:=1; end else begin if PipeSize > 0 then PutPipe; if FileIndex = 1 then WrapUp; close (InFileVar[FileIndex]); if not InProfile then close (OutFileVar[OutFileIndex]); if FileIndex > 1 then begin ReadNextLine:=true; FileIndex := FileIndex-1; DOCFileID := 'Created by '+VersionID+'from file '+InFile[FileIndex]; If InElement then writeln(OutFileVar[OutFileIndex],'<comment>('+ DOCFileID+')'); if not InProfile then OutFileIndex := OutFileIndex-1; end; end end; GetLine:=GotLine; end; procedure DeleteControlChars; var J: integer; S: AnyString; begin J := 1; while J <= Length(OutputLine) do begin if OutputLine[J] in [chr(0)..chr(31)] then begin writev(S,ord(OutputLine[J]):1); ErrorPrint( 'ASCII character '+S+' decimal ignored'); Delete(OutputLine,J,1); end else J := J+1; end; end; procedure PutEOL; { Writes InputLine to the appropriate file } var OutLineString : AnyString; ErrorStatus : Real; BlanksStripped : Boolean; begin DeleteControlChars; if AutoPara then begin BlanksStripped := false; while (left(OutputLine,1)=' ') and (length(OutputLine)>1) do begin OutputLine := right(Outputline,2); BlanksStripped := true; end; if BlanksStripped then if not InLiteral then OutputLIne := '<P>'+OutputLine; end; if CodeExWaiting then begin OutputLine := '<CODE_EXAMPLE>'+OutPutLine; CodeExWaiting := false; end; if (InProfile and not (Abstract or Preface or ChapterFlag or AppendixFlag)) or (InTopNote) then OutputLine := '<COMMENT>('+OutputLine+')'; writeln(OutFileVar[OutFileIndex],OutputLine, error := continue); ErrorStatus := status(OutFileVar[OutFileIndex]); if ErrorStatus>0 then begin writev(OutLineString,OutLineCount[OutFileIndex]); ErrorPrint('Error writing line '+OutLineString); end; if EnableInteraction then writeln('ToFile.. ',OutputLine); OutLineCount[OutFileIndex] := OutLineCount[OutFileIndex]+1; OutputLine:=''; end; {***************************************************************} { } { Parsing Utility Routines } { } { Each routines tries to get a construct from InputLine and } { advance P from the beginning of the construct to the char } { that follows the construct. The Get routine gets a letter } { equal to its argument; the other routines get a construct } { that is specified in the name of the routine. Each routine } { returns true or false, if it succeeds or fails. } function Get(C:char): Boolean; { Try to get a character equal to C. } Var Result: Boolean; begin if (C=ToUpper(InputLine[P])) then begin P:=P+1; Result:=true; end else Result:=false; Get:=Result; end; function GetLetter: Boolean; { Try to get a letter. } var Result:Boolean; begin if IsLetter(InputLine[P]) then begin P:=P+1; Result:=true; end else Result:=false; GetLetter:=Result; end; function GetDigit: Boolean; { Try to get a digit. } var Result: Boolean; begin if IsDigit(InputLine[P]) then begin Result:=true; P:=P+1; end else Result:=false; GetDigit:=Result; end; function GetSep: Boolean; { Try to get a sequence of zero or more spaces and tabs. } var SaveP: integer; More: Boolean; begin SaveP:=P; More:=true; while More do begin if Get(' ') then else if Get(chr(9)) then else More:=false; end; GetSep:=(SaveP<P); end; function GetChar:Boolean; { Try to get any char except the end-of-line mark. } var Result: Boolean; begin if InputLine[P] <> EOL then begin P:=P+1; Result:=true; end else Result:=false; GetChar:=Result; end; function GetPMInt:Boolean; { Try to get an integer preceded by an optional sign. } var OldP: integer; Result: Boolean; begin OldP:=P; if Get('-') then else if Get('+') then; if GetDigit then begin while GetDigit do; Result:=true end else Result:=false; { The previous line was previously "else Result:=(P=OldP);" It is unclear how the program ran without this change; certainly the GetAttr would hang in a loop. } GetPMInt:=Result; end; function GetName:Boolean; { Try to get a letter followed by a sequence of zero or more } { letter or digit characters. } var Result: Boolean; begin if GetLetter then begin Result:=true; while IsLetterOrDigit(InputLine[P]) do P:=P+1; end else Result:=false; GetName:=Result; end; function GetRefName:Boolean; { Try to get a letter followed by a sequence of zero or more } { letter, digit, or underline characters. } var Result: Boolean; More: Boolean; begin if GetLetter then begin Result:=true; More:=true; while More do if GetLetter then else if GetDigit then else if Get('_') then else More:=false; end else Result:=false; GetRefName:=Result; end; function GetQStr: Boolean; { Try to get a quoted string, "s" or 's', where s is any } { sequence of characters other than the appropriate quote. } var C:char; Res:Boolean; More:Boolean; begin Res:=true; if Get('"') then C:='"' else if Get('''') then C:='''' else Res:=false; if Res then begin More:=true; while More do begin if IsEOL then begin More:=false; Res:=false; end else if Get(C) then More:=false else Res:=GetChar; end; end; GetQStr:=Res; end; {***************************************************************} { } { Specialized Parsing Routines } { } { These routines are designed mostly for use in the two big } { routines that parse the command keyword(s). InChar gets a } { character from InputLine for use in a switch. The remaining } { routines check the final characters of a keyword to see if } { they are leading characters of the given Param. } function InChar : char; { Get one character from InputLine. Advance P unless the } { character is the End-of-Line character. } var Result : char; begin Result:=ToUpper(InputLine[P]); if not IsEOL then P:=P+1; InChar:=Result; end; function NoTail : Boolean; { Return true if the next letter is not a letter. } var Result : Boolean; begin Result:=not IsLetter(InputLine[P]); NoTail:=Result; end; function GTailn(N:integer;S:AnyString) : Boolean; { Try to get a head string at P in InputLine that is a head } { string of the argument S and is not followed by a letter. } { Advance P to the character following the head string and } { return true if the string is N characters long; othersize, } { leave P alone and return false. } label LoopExit; var Result : Boolean; I : integer; begin Result:=false; for I := 1 to Length(S) do begin if ToUpper(InputLine[P+I-1]) <> S[I] then begin if (I > N) and not IsLetter(InputLine[P+I-1]) then begin Result:=true; P:=P+I-1; end; goto LoopExit; end; end; if not IsLetter(InputLine[P+Length(S)]) then begin Result:=true; P:=P+Length(S); end; LoopExit: GTailn:=Result; end; function GTail0(S:AnyString) : Boolean; { Special case of GTailn. } begin GTail0:=GTailn(0,S); end; function GTail1(S:AnyString): Boolean; { Special case of GTailn. } begin GTail1:=GTailn(1,S); end; {***************************************************************} { } { Keyword Parsing Routines } { } { These routines parse the keywords and return the value that } { designates the command. } function NoCom: ComType; { This routine is called whenever GetComName finds NO } { It looks for an optional separator followed by an } { appropriate keyword. Thus both NO DATE and NODATE are OK. } var C:ComType; begin C:=xUndef; if GetSep then; case InChar of 'A':if GTailn(4,'UTOJUSTIFY') then C:=xNAJ else {NO AUTOJUSTIFY} if GTailn(4,'UTOPARAGRAPH') then C:=xNAP else {NO AUTOPARAGRAPH} if GTailn(4,'UTOSUBTITLE') then C:=xNAST else {NO AUTOSUBTITLE} if GTailn(5,'UTOTABLE') then C:=xNAT else {NO AUTOTABLE} if GTailn(5,'UTOTITLE') then C:=xNATI; {NO AUTOTITLE} 'C':if GTail1('ONTROL') then begin if GetSep then if GTail1('CHARACTERS') then C:=xNCC {NO CONTROL CHARACTERS} end else if GTail1('HAPTER') then C:=xNC; {NO CHAPTER} 'D':if GTail0('ATE') then C:=xND; {NO DATE} 'F':if GTail1('ILL') then C:=xNF else {NO FILL} if GTail1('LAGS') then C:=xNFL; {NO FLAGS} 'H':if GTail0('EADERS') then C:=xNHD; {NO HEADERS} 'J':if GTail0('USTIFY') then C:=xNJ; {NO JUSTIFY} 'K':if GTail0('EEP') then C:=xNK; {NO KEEP} 'N':if GTail0('UMBER') then begin C:=xNMN; {NO NUMBER} if GetSep then if GTail1('FOOTNOTE') then C:=xNNMF; {NO NUMBER FOOTNOTE} end; 'P':if GTail1('AGING') then C:=xNPA else {NO PAGING} if GTail1('ERIOD') then C:=xNPR; {NO PERIOD} 'S':if GTail1('PACE') then C:=xNSP else {NO SPACE} if GTail1('UBTITLE') then C:=xNST; {NO SUBTITLE} 'T':if GTail1('OPNOTE') then C:=xNTN; {NO TOPNOTE} end; NoCom:=C; end; function GetComName: Boolean; { Tries to find a command keyword. The first character is } { recognized by a switch that stretches across the entire } { subroutine. In many cases, the second character is also } { recognized by a switch. } var C:ComType; begin C:=xUndef; if NoTail then C:=xBR else {empty command=BR} case InChar of 'A':case InChar of 'J':if NoTail then C:=xAJ; {AJ.*} 'P':if NoTail then C:=xAP else {AP.*} if GTail1('PENDIX') then C:=xAX; {APPENDIX} 'S':if GTail0('T') then C:=xAST; {AST.*} 'T':if NoTail then C:=xAT else {AT.*} if GTail1('I') then C:=xATI; {ATI.*} 'U':if GTailn(3,'TOJUSTIFY') then C:=xAJ else {AUTOJUSTIFY} if GTailn(3,'TOPARAGRAPH') then C:=xAP else {AUTOPARAGRAPH} if GTailn(3,'TOSUBTITLE') then C:=xAST else {AUTOSUBTITLE} if GTailn(4,'TOTABLE') then C:=xAT else {AUTOTABLE} if GTailn(4,'TOTITLE') then C:=xATI; {AUTOTITLE} 'X':if NoTail then C:=xAX; {AX.} end; 'B':if NoTail then C:=xB else {B.} case InChar of 'B':if NoTail then C:=xBB; {BB.} 'E':if GTail0('GIN') then if GetSep then begin if GTail1('BAR') then C:=xBB else {BEGIN BAR} if GTail1('TOPNOTE') then C:=xBT; {BEGIN TOPNOTE} end; 'L':if GTail0('ANK') then C:=xB; {BLANK} 'R':if GTail0('EAK') then C:=xBR; {BR. or BREAK} 'T':if NoTail then C:=xBT; {BT.} end; 'C':if NoTail then C:=xC else {C.} case InChar of 'C':if NoTail then C:=xCC; {CC.*} 'E':if GTail0('NTER') then C:=xC else {CENTER} if GTail0('NTRE') then C:=xC; {CENTRE} 'H':if GTail0('APTER') then C:=xCH; {CH. or CHAPTER} 'O':if GTail1('MMENT') then C:=xCOM else {COMMENT} if GTail1('NTROL') then if GetSep then if GTail1('CHARACTERS') then C:=xCC; {CONTROL CHARACTERS} end; 'D':if NoTail then C:=xD else {D.*} case InChar of 'A':if GTail1('TE') then C:=xD else {DATE} if GTail1('X') then C:=xDAX; {DAX.} 'B':if GTail1('B') then C:=xDBB else {DBB.} if GTail1('O') then C:=xDBO; {DBO.} 'C':if NoTail then C:=xDC else {DC.} if GTail1('H') then C:=xDCH; {DCH.} 'E':if GTail0('X') then C:=xDEX; {DEX.} 'F':if GTail0('G') then C:=xDFG; {DFG.} 'H':if GTail1('L') then C:=xDHL else {DHL.} if GTail1('Y') then C:=xDHY; {DHY.} 'I':if GTailn(2,'SABLE') then begin if GetSep then begin if GTail1('BAR') then C:=xDBB else {DIS BAR} if GTail1('BOLDING') then C:=xDBO else {DIS BOLDING} if GTail1('HYPHENATION') then C:=xDHY else {DIS HYPHENATION} if GTail1('INDEXING') then C:=xDIX else {DIS INDEXING} if GTail1('OVERSTRIKING') then C:=xDOV else {DIS OVERSTRIKING} if GTail1('TOC') then C:=xDTC else {DIS TOC} if GTail1('XPLUS') then C:=xDXP else {DIS XPLUS} if GTail1('UNDERLINING') then C:=xDUL; {DIS UNDERLINING} end end else if GTailn(2,'SPLAY') then begin if GetSep then begin if GTail1('APPENDIX') then C:=xDAX else {DISPLAY APPENDIX} if GTail1('CHAPTER') then C:=xDCH else {DISPLAY CHAPTER} if GTail1('COUNTER') then C:=xDCR else {DISPLAY COUNTER} if GTail1('ELEMENTS') then C:=xDLE else {DISPLAY ELEMENT} if GTail1('EXAMPLE') then C:=xDEX else {DISPLAY EXAMPLE} if GTail1('FIGURE') then C:=xDFG else {DISPLAY FIGURE} if GTail1('LEVELS') then C:=xDHL else {DISPLAY LEVELS} if GTail1('NUMBER') then C:=xDNM else {DISPLAY NUMBER} if GTail1('SUBPAGE') then C:=xDSP else {DISPLAY SUBPAGE} if GTail1('TABLE') then C:=xDTB; {DISPLAY TABLE} end end else if GTail1('X') then C:=xDIX; {DIX.} 'L':if GTail0('E') then C:=xDLE; {DLE.} 'N':if GTail0('M') then C:=xDNM; {DNM.} 'O':if GTail1('V') then C:=xDOV else {DOV.} if GetSep then begin if GTail1('CONTENTS') then C:=xDC else {DO CONTENTS} if GTail1('INDEX') then C:=xDX else {DO INDEX} if GTail1('TABLE') then C:=xDT; {DO TABLE} end; 'S':if GTail0('P') then C:=xDSP; {DSP.} 'T':if NoTail then C:=xDT else {DT.} if GTail1('B') then C:=xDTB else {DTB.} if GTail1('C') then C:=xDTC; {DTC.} 'U':if GTail0('L') then C:=xDUL; {DUL.} 'X':if NoTail then C:=xDX else {DX.} if GTail1('P') then C:=xDXP; {DXP.} end; 'E':case InChar of 'B':if NoTail then C:=xEB else {EB.} if GTail1('B') then C:=xEBB else {EBB.} if GTail1('O') then C:=xEBO; {EBO.} 'F':if GTail0('N') then C:=xEFN; {EFN.} 'H':if GTail0('Y') then C:=xEHY; {EHY.} 'I':if NoTail then C:=xEI else {EI.} if GTail1('X') then C:=xEIX; {EIX.} 'L':if NoTail then C:=xEL else {EL.} if GTail1('I') then C:=xEL else {ELI.} if GTail1('S') then C:=xELS else {ELS.} if GTailn(2,'SE') then C:=xELSE; {ELSE} 'N':if NoTail then C:=xEN else {EN.} if GTail1('ABLE') then begin if GetSep then begin if GTail1('BAR') then C:=xEBB else {EN BAR} if GTail1('BOLDING') then C:=xEBO else {EN BOLDING} if GTail1('HYPHENATION') then C:=xEHY else {EN HYPHENATION} if GTail1('INDEXING') then C:=xEIX else {EN INDEXING} if GTail1('OVERSTRIKING') then C:=xEOV else {EN OVERSTRIKING} if GTail1('TOC') then C:=xETC else {EN TOC} if GTail1('UNDERLINING') then C:=xEUN else {EN UNDERLINING} if GTail1('XPLUS') then C:=xEXP; {EN XPLUS} end end else if GTail1('D') then begin if GetSep then begin if GTail1('BAR') then C:=xEB else {END BAR} if GTail1('FOOTNOTE') then C:=xEFN else {END FOOTNOTE} if GTailn(3,'LIST') then C:=xELS else {END LIST} if GTailn(3,'LITERAL') then C:=xEL else {END LITERAL} if GTail1('NOTE') then C:=xEN else {END NOTE} if GTail1('SUBPAGE') then C:=xES else {END SUBPAGE} if GTail1('TOPNOTE') then C:=xETN; {END TOPNOTE} end end else if GTailn(2,'DIF') then C:=xEI else {ENDIF} if GTail1('TRY') then C:=xY; {ENTRY} 'O':if GTail0('V') then C:=xEOV; {EOV.} 'S':if NoTail then C:=xES; {ES.} 'T':if GTail1('C') then C:=xETC else {ETC.} if GTail1('N') then C:=xETN; {ETN.} 'U':if GTail0('N') then C:=xEUN; {EUN.} 'X':if GTail0('P') then C:=xEXP; {EXP.} end; 'F':if NoTail then C:=xF else {F.*} case InChar of 'G':if NoTail then C:=xFG else {FG.} if GTail1('D') then C:=xFGD; {FGD.} 'I':if GTail1('GURE') then begin C:=xFG; {FIGURE} if GetSep then if GTail1('DEFERRED') then C:=xFGD; {FIGURE DEFERRED} end else if GTail1('LL') then C:=xF else {FILL} if GTail1('RST') then begin if GetSep then if GTail1('TITLE') then begin C:=xFT; {FIRST TITLE} if GetSep then if GTail1('ALWAYS') then C:=xFTA; {FIRST TITLE ALWAYS} end; end; 'L':if NoTail then C:=xFL else {FL.} if GTail1('AGS') then C:=xFL; {FLAGS} 'N':if NoTail then C:=xFN; {FN.} 'O':if GTail0('OTNOTE') then C:=xFN; {FOOTNOTE} 'T':if NoTail then C:=xFT else {FT.} if GTail1('A') then C:=xFTA; {FTA.} end; 'H':case InChar of 'D':if NoTail then C:=xHD; {HD.*} 'E':if NoTail then C:=xHE else {HE.} if GTail0('ADER') then begin if GetSep then begin if GTail1('EXAMPLE') then C:=xHE else {HEADER EXAMPLE} if GTail1('FIGURE') then C:=xHF else {HEADER FIGURE} if GTail1('LEVEL') then C:=xHL else {HEADER LEVEL} if GTail1('TABLE') then C:=xHT; {HEADER TABLE} end end else if GTail0('ADERS') then C:=xHD; {HEADERS} 'F':if NoTail then C:=xHF; {HF.} 'L':if NoTail then C:=xHL; {HL.} 'T':if NoTail then C:=xHT; {HT.} end; 'I':if NoTail then C:=xI else {I.} case InChar of 'F':if NoTail then C:=xIF else {IF} if GTail1('NOT') then C:=xIN; {IFNOT} 'N':if NoTail then C:=xIN else {IN.} if GTailn(3,'DENT') then C:=xI else {INDENT} if GTailn(3,'DEX') then C:=xX; {INDEX} end; 'J':if GTail0('USTIFY') then C:=xJ; {J.* and JUSTIFY} 'K':if GTail0('EEP') then C:=xK; {K.* and KEEP} 'L':case InChar of 'A':if GTail0('YOUT') then C:=xLO; {LAYOUT} 'E':if NoTail then C:=xLE else {LE.} if GTail1('FT') then if GetSep then if GTail1('MARGIN') then C:=xLM; {LEFT MARGIN} 'I':if GTail1('ST') then begin C:=xLS; {LIST} if GetSep then if GTail1('ELEMENT') then C:=xLE; {LIST ELEMENT} end else if GTail1('TERAL') then C:=xLT; {LITERAL} 'M':if NoTail then C:=xLM; {LM.} 'O':if NoTail then C:=xLO; {LO.} 'S':if NoTail then C:=xLS; {LS.} 'T':if NoTail then C:=xLT; {LT.} end; 'N':if NoTail then C:=xNT else {N.} case InChar of 'A':if GTail1('J') then C:=xNAJ else {NAJ.} if GTail1('P') then C:=xNAP else {NAP.} if GTail1('ST') then C:=xNAST else {NAST.} if GTail1('T') then C:=xNAT else {NAT.} if GTail1('TI') then C:=xNATI; {NATI.} 'C':if NoTail then C:=xNC else {NC.} if GTail1('C') then C:=xNCC; {NCC.} 'D':if NoTail then C:=xND; {ND.} 'F':if NoTail then C:=xNF else {NF.} if GTail1('L') then C:=xNFL; {NFL.} 'H':if GTail0('D') then C:=xNHD; {NHD.} 'J':if NoTail then C:=xNJ; {NJ.} 'K':if NoTail then C:=xNK; {NK.} 'M':if GTail1('A') then C:=xNMA else {NMA.} if GTail1('CH') then C:=xNMCH else {NMCH.} if GTail1('EX') then C:=xNMEX else {NMEX.} if GTail1('FG') then C:=xNMFG else {NMFG.} if GTailn(2,'LS') then C:=xNMLS else {NMLS.} if GTailn(2,'LV') then C:=xNMLV else {NMLV.} if GTail1('N') then C:=xNMN else {NMN. for NO NUMBER} if GTail1('PG') then C:=xNMPG else {NMPG.} if GTail1('R') then C:=xNMR else {NMR.} if GTail1('SPG') then C:=xNMSPG else {NMSPG.} if GTail1('TB') then C:=xNMTB; {NMTB.} 'O':if GTail1('TE') then C:=xNT else {NOTE} C:=NoCom; {No xxx or NOxxx} 'P':if GTail1('A') then C:=xNPA else {NPA.} if GTail1('R') then C:=xNPR; {NPR.} 'S':if GTail0('P') then C:=xNSP else {NSP. with NO only} if GTail0('T') then C:=xNST; {NST.} 'T':if NoTail then C:=xNT else {NT.} if GTail1('N') then C:=xNTN; {NTN.} 'U':if GTail0('MBER') then begin C:=xNMPG; {NUMBER} if GetSep then begin if GTail1('APPENDIX') then C:=xNMA else {NUMBER APPENDIX} if GTail1('CHAPTER') then C:=xNMCH else {NUMBER CHAPTER} if GTail1('EXAMPLE') then C:=xNMEX else {NUMBER EXAMPLE} if GTailn(2,'FIGURE') then C:=xNMFG else {NUMBER FIGURE} if GTailn(2,'FOOTNOTE') then C:=xNMF else {NUMBER FOOTNOTE} if GTailn(2,'LEVEL') then C:=xNMLV else {NUMBER LEVEL} if GTailn(2,'LIST') then C:=xNMLS else {NUMBER LIST} if GTail1('PAGE') then C:=xNMPG else {NUMBER PAGE} if GTail1('RUNNING') then C:=xNMR else {NUMBER RUNNING} if GTail1('SUBPAGE') then C:=xNMSPG else {NUMBER SUBPAGE} if GTail1('TABLE') then C:=xNMTB; {NUMBER TABLE} end end; end; 'P':if NoTail then C:=xP else {P.} case InChar of 'A':if NoTail then C:=xPA else {PA.*} if GTailn(2,'GE') then begin C:=xPG; {PAGE} if GetSep then if GTail1('SIZE') then C:=xPS; {PAGE SIZE} end else if GTailn(2,'GING') then C:=xPA else {PAGING} if GTail1('RAGRAPH') then C:=xP; {PARAGRAPH} 'E':if GTail0('RIOD') then C:=xPR; {PERIOD} 'G':if NoTail then C:=xPG; {PG.} 'R':if NoTail then C:=xPR; {PR.*} 'S':if NoTail then C:=xPS; {PS.} end; 'R':if NoTail then C:=xR else {R.} case InChar of 'E':if GTail1('FERENCEPOINT') then C:=xREF else {REFERENCEPOINT} if GTail1('PEAT') then C:=xRPT else {REPEAT} if GTail1('QUIRE') then C:=xREQ else {REQ or REQUIRE} if GTail1('STORE') then C:=xRES; {RESTORE} 'I':if GTail0('GHT') then begin C:=xR; {RIGHT} if GetSep then if GTail1('MARGIN') then C:=xRM; {RIGHT MARGIN} end; 'M':if NoTail then C:=xRM; {RM.} 'P':if GTail0('T') then C:=xRPT; {RPT.} end; 'S':if NoTail then C:=xS else {S.} case InChar of 'A':if GTail0('VE') then begin C:=xSAVE; {SAVE} if GetSep then if GTail1('ALL') then C:=xSALL; {SAVE ALL} end; 'C':if GTail1('NT') then C:=xSCNT else {SCNT.} if GTail1('O') then C:=xSCO; {SCO.} 'D':if GTail0('T') then C:=xSDT; {SDT.} 'E':if GTail0('ND') then begin if GetSep then begin if GTail1('TOC') then C:=xSCO else {SEND TOC} if GTail1('CONTENTS') then C:=xSCO; {SEND CONTENTS} end end else if GTail1('T') then begin if GetSep then begin if GTail1('COUNTER') then C:=xSCNT else {SET COUNTER} if GTail1('DATE') then C:=xSDT else {SET DATE} if GTail1('LEVEL') then C:=xSL else {SET LEVEL} if GTail1('PARAGRAPH') then C:=xSPR else {SET PARAGRAPH} if GTailn(2,'TEXTSTRING') then C:=xSTXT else {SET TEXTSTRING} if GTailn(2,'TIME') then C:=xSTM; {SET TIME} end end; 'K':if GTail0('IP') then C:=xS; {SKIP} 'L':if NoTail then C:=xSL; {SL.} 'P':if NoTail then C:=xSP else {SP.} if GTailn(3,'ACE') then C:=xNSP else {SPACE /NSP (with NO only)} if GTailn(3,'ACING') then C:=xSP else {SPACING} if GTail1('G') then C:=xSPG else {SPG.} if GTail0('R') then C:=xSPR; {SPR.} 'T':if NoTail then C:=xST else {ST.*} if GTail1('AP') then C:=xSTAX else {STAP.} {extra name} if GTail1('AX') then C:=xSTAX else {STAX.} if GTailn(2,'CH') then C:=xSTCH else {STCH.} if GTail1('C') then C:=xSCO else {STC.} {new name} if GTail1('EX') then C:=xSTEX else {STEX.} if GTail1('FG') then C:=xSTFG else {STFG.} if GTail1('HL') then C:=xSTHL else {STHL.} if GTail1('M') then C:=xSTM else {STM.} if GTail1('TB') then C:=xSTTB else {STTB.} if GTail1('XT') then C:=xSTXT else {STXT.} if GTail1('YLE') then begin if GetSep then begin if GTail1('APPENDIX') then C:=xSTAX else {STYLE APPENDIX} if GTail1('CHAPTER') then C:=xSTCH else {STYLE CHAPTER} if GTail1('EXAMPLE') then C:=xSTEX else {STYLE EXAMPLE} if GTail1('FIGURE') then C:=xSTFG else {STYLE FIGURE} if GTail1('HEADERS') then C:=xSTHL else {STYLE HEADERS} if GTail1('TABLE') then C:=xSTTB; {STYLE TABLE} end end; 'U':if GTailn(2,'BPAGE') then C:=xSPG else {SUBPAGE} if GTailn(2,'BTITLE') then C:=xST; {SUBTITLE} end; 'T':if NoTail then C:=xT else {T.} case InChar of 'A':if GTail0('B') then if GetSep then if GTail1('STOPS') then C:=xTS; {TAB STOPS} 'E':if GTail0('ST') then if GetSep then if GTail1('PAGE') then C:=xTP; {TEST PAGE} 'I':if GTail0('TLE') then C:=xT; {TITLE} 'N':if NoTail then C:=xTN; {TN.*} 'O':if GTail0('PNOTE') then C:=xTN; {TOPNOTE} 'P':if NoTail then C:=xTP; {TP.} 'S':if NoTail then C:=xTS; {TS.} end; 'V':if GTail0('ARIABLE') then C:=xVR else {VARIABLE} if GTail0('R') then C:=xVR; {VR.} 'X':if NoTail then C:=xX else {X.} if GTail1('L') then C:=xXL else {XL.} if GTailn(2,'LOWER') then C:=xXL else {XLOWER} if GTail1('P') then C:=xXP else {XP.} if GTailn(2,'PLUS') then C:=xXP else {XPLUS} if GTail1('U') then C:=xXU else {XU.} if GTailn(2,'UPPER') then C:=xXU; {XUPPER} 'Y':if NoTail then C:=xY else {Y.} if GTail1('P') then C:=xYP else {YP.} if GTailn(2,'PLUS') then C:=xYP; {YPLUS} 'Z':case InChar of 'B':if GTail1('A') then C:=xZBA else {ZBA.} if GTail1('E') then C:=xZBE else {ZBE.} if GTail1('F') then C:=xZBF else {ZBF.} if GTail1('P') then C:=xZBP else {ZBP.} if GTail1('T') then C:=xZBT; {ZBT.} 'C':if GTail1('AP') then C:=xZCAP; {ZCAP.} 'E':if GTail1('A') then C:=xZEA else {ZEA.} if GTail1('E') then C:=xZEE else {ZEE.} if GTail1('F') then C:=xZEF else {ZEF.} if GTail1('P') then C:=xZEP else {ZEP.} if GTail1('T') then C:=xZET; {ZET.} 'L':if GTail1('T') then C:=xZLT else {ZLT.} if GTail1('ITERAL') then C:=xZLT; {ZLITERAL} 'Q':if GTail0('UAL') then C:=xZQUAL; {ZQUAL.} 'W':if GTailn(2,'C') then C:=xZWC else {ZWC.} if GTailn(2,'D') then C:=xZWD; {ZWD.} end; end; {main case statement} CurComNumber:=C; GetComName:=(C<>xUndef); end; {***************************************************************} { } { Argument Parsing Routines } { } { These routines parse the argument of a command. AppendArg } { puts an argument at the end of the argument list. Optional } { juggles the result of recognition. GetArgs (the last of the } { routines) contains a big switch that decides which arguments } { to look for. All the other routines get a particular kind } { of argument. } procedure AppendArg(S:AnyString); { Puts argument, S, at the end of ArgList and puts the } { argument terminator after it. } begin CurArgList:=CurArgList+S+ArgEnd; CurArgCount:=CurArgCount+1; end; procedure PopEmptyArg; { Removes empty parameter from end of CurArgList and decrements } { CurArgCount. } begin CurArgList:=substr(CurArgList,1,Length(CurArgList)-1); CurArgCount:=CurArgCount-1; end; procedure GetEmptyArg; { Puts an empty parameter at the end of CurArgList. } begin CurArgList:=CurArgList+chr(0); CurArgCount:=CurArgCount+1; end; procedure Optional(RO:ReqOrOptType;OldP:integer); { Sets Absent to true if P did not move during the attempt to find } { the desired item; otherwise, sets Absent to false. Thus Absent } { means the item wasn't found AND no characters were scanned in } { finding this out. Sets Present to OK. Thus Present means an } { instance of the item was actually found (since that is what OK } { means at entry to this routine). Sets OK to true if the item is } { optional and P did not move; otherwise, leaves OK as it is. } { Thus OK now means that the attempt succeded, either because the } { item was found or because it was optional and no scan occurred. } { Note that if one or more characters were scanned and the item } { was not found, then all three variables (Absent, Present, and OK) } { are false. As a side effect, this routine adds an empty arg to } { ArgList if the item was optional and no scan occurred. } begin Absent:=(OldP=P); Present:=OK; if (RO=cOPT) and (P=OldP) then begin OK:=true; { AppendArg(''); } end; end; procedure GetArgSep; { Try to get a separator, leaves indicators alone. } var BSink : Boolean; begin BSink:=GetSep; end; procedure GetComma(RO:ReqOrOptType); { Try to get comma surrounded by optional separators. } var OldP: integer; begin GetArgSep; OldP:=P; OK:=Get(','); GetArgSep; Absent:=(OldP=P); Present:=OK; if (RO=cOPT) and (P=OldP) then OK:=true; end; procedure GetCharArg(RO:ReqOrOptType); { Try to get a character other than End-of-Line. } var OldP: integer; begin OldP:=P; if GetChar then begin AppendArg(InputLine[P-1]); OK:=true; end else OK:=false; Optional(RO,OldP); end; procedure GetFlagCharArg(RO:ReqOrOptType); { Try to get a character other than End-of-Line. } var C: char; OldP: integer; begin OldP:=P; C:=InputLine[P]; if (C=EOL) or (C=ControlFlagCur) or (C=CommentFlagCur) then OK:=false else begin P:=P+1; AppendArg(C); OK:=true; end; Optional(RO,OldP); end; procedure GetIntArg(RO:ReqOrOptType); { Try to get an unsigned integer. } var OldP: integer; begin OldP:=P; if GetDigit then begin while GetDigit do; AppendArg(Mid(InputLine,OldP,P-OldP)); OK:=not IsLetterOrDigit(InputLine[P]); end else OK:=false; Optional(RO,OldP); end; procedure GetMIntArg(RO:ReqOrOptType); { Try to get an integer optionally preceded by a minus. } var OldP: integer; begin OldP:=P; if Get('-') then; if GetDigit then begin while GetDigit do; AppendArg(Mid(InputLine,OldP,P-OldP)); OK:=not IsLetterOrDigit(InputLine[P]); end else OK:=False; Optional(RO,OldP); end; procedure GetPMIntArg(RO:ReqOrOptType); { Try to get an integer optionally preceded by a sign. } var OldP: integer; begin OldP:=P; if Get('+') then else if Get('-') then; if GetDigit then begin while GetDigit do; AppendArg(Mid(InputLine,OldP,P-OldP)); OK:=not IsLetterOrDigit(InputLine[P]); end else OK:=False; Optional(RO,OldP); end; procedure GetQCharArg(RO:ReqOrOptType); { Try to get a quoted character. } var C: char; OldP: integer; begin OldP:=P; OK:=true; if Get('"') then C:='"' else if Get('''') then C:='''' else OK:=false; if OK then begin if C <> InputLine[P] then GetChar; if Get(C) then begin OK:=true; AppendArg(Mid(InputLine,OldP+1,P-OldP-2)); end else OK:=false; end; Optional(RO,OldP); end; procedure GetQStrArg(RO:ReqOrOptType); { Try to get a quoted string. } var OldP: integer; begin OldP:=P; if GetQStr then begin OK:=true; AppendArg(Mid(InputLine,OldP+1,P-OldP-2)); end else OK:=false; Optional(RO,OldP); end; procedure GetSQStrArg(RO:ReqOrOptType); { Try to get a quoted string of no more than 5 chars. } var OldP: integer; begin OldP:=P; if GetQStr then begin if (P-OldP)-2 <= 5 then begin OK:=true; AppendArg(Mid(InputLine,OldP+1,P-OldP-2)); end else OK:=false; end else OK:=false; Optional(RO,OldP); end; procedure GetAttrArg(RO:ReqOrOptType); { Try to get a parenthesized list of attributes. } var RightGrouperChar : char; More : Boolean; OldP : integer; begin OldP:=P; if Get('(') then begin OK:=true; RightGrouperChar := ')'; end else if Get('[') then begin OK:=true; RightGrouperChar := ']'; end else if Get('{') then begin OK:=true; RightGrouperChar := '}'; end else if Get('<') then begin OK:=true; RightGrouperChar := '>'; end else OK:=false; if OK then begin More:=true; while More do begin GetArgSep; if GetQStr then {nothing} else if GetName then {nothing} else if GetPMInt then {nothing} else if Get(',') then {nothing} else if Get('=') then {nothing} else if Get(':') then {nothing} else More:=false; end; if Get(RightGrouperChar) then begin OK:=true; AppendArg(Mid(InputLine,OldP,P-OldP)); end else OK:=false; end; Optional(RO,OldP); end; procedure GetNameArg(RO:ReqOrOptType); { Try to get a name. } var OldP: integer; begin OldP:=P; OK:=GetName; if OK then AppendArg(Mid(InputLine,OldP,P-OldP)); Optional(RO,OldP); end; procedure GetRefNameArg(RO:ReqOrOptType); { Try to get a name. } var OldP: integer; begin OldP:=P; OK:=GetRefName; if OK then AppendArg(Mid(InputLine,OldP,P-OldP)); Optional(RO,OldP); end; procedure GetAxNameArg(RO:ReqOrOptType); { Try to get an appendix name (one or more letters). } VAR OldP: integer; begin OldP:=P; OK:=false; while GetLetter do OK:=true; if OK then OK:=not IsLetterOrDigit(InputLine[P]); if OK then AppendArg(Mid(InputLine,OldP,P-OldP)); Optional(RO,OldP); end; procedure GetNCodeArg(RO:ReqOrOptType); { Try to get a number code argument. } var OldP: integer; STemp: AnyString; J: integer; begin OldP:=P; OK:=true; if Get('D') then else if Get('O') then else if Get('H') then else if Get('R') then begin if Get('U') then else if Get('L') then else if Get('M') then else OK:=false; end else if Get('L') then begin if Get('U') then else if Get('L') then else if Get('M') then else OK:=false; end else OK:=false; if OK then OK:=not IsLetterOrDigit(InputLine[P]); if OK then begin STemp:=''; for J:=OldP to P-1 do STemp:=STemp+InputLine[J]; AppendArg(StringToUpper(Mid(InputLine,OldP,P-OldP))); end; Optional(RO,OldP); end; procedure GetTTextArg(RO:ReqOrOptType); { Try to get trailing text. } var OldP: integer; begin OldP:=P; P:=Length(InputLine); AppendArg(Mid(InputLine,OldP,P-OldP)); OK:=true; Optional(RO,OldP); end; { procedure GetListOptArg(Low,High:integer;RO:ReqOrOptType); } { Get the following construct: } { [ pm-integer ] [ o,o [ pm-integer ] ]Low:High } { Var I: integer; More: Boolean; OldP: integer; begin I:=0; GetPMIntArg(cOPT); if Absent then PopEmptyArg else begin if OK then begin More:=true; while More do begin GetComma(cOPT); if Present then begin I:=I+1; GetPMIntArg(cOPT); More:=OK; end else More:=false; end; end; end; OK:=OK and (Low<=I) and (I<=High); Optional(RO,OldP); end; } procedure GetWordnArg(S:AnyString;RO:ReqOrOptType); { Get a specified sequence of characters using GTailn. } var OldP: integer; begin OldP:=P; OK:=GTailn(1,S); if OK then OK:=not IsLetterOrDigit(InputLine[P]); if OK then AppendArg(S); Optional(RO,OldP); end; procedure GetCommaListArg(Param:CommaListType;MaxCount:integer); type StateType = ( sStart, sParamSeen, sCommaSeen, sDone ); var BSink: Boolean; State: StateType; ParamCount: integer; begin State:=sStart; ParamCount:=0; while State <> sDone do begin BSink:=GetSep; Present:=false; case Param of mDHL: GetNCodeArg(cOPT); mDT: GetQStrArg(cOPT); mLO: GetIntArg(cOPT); mNMLS: GetIntArg(cOPT); mNMLV: GetPMIntArg(cOPT); mP: GetMIntArg(cOPT); mPS: GetPMIntArg(cOPT); mSzz: GetIntArg(cOPT); mSTHL: GetPMIntArg(cOPT); mTS: GetPMIntArg(cOPT); end; if Present then begin State:=sParamSeen; ParamCount:=ParamCount+1; end else if InputLine[P]=',' then begin P:=P+1; if State <> sParamSeen then begin GetEmptyArg; ParamCount:=ParamCount+1; end; State:=sCommaSeen; end else begin if State = sCommaSeen then begin GetEmptyArg; ParamCount:=ParamCount+1; end; State:=sDone; end; end; if ParamCount > MaxCount then OK:=False; end; function GetArgs: Boolean; { Use the ComTable to find what kind of arguments go with the } { current command, and then get those arguments. } { With a few exceptions, this routines breaks off arguments } { of the command and copies them, without change, into the } { argument list being formed in ArgList. One exception is } { for quoted strings, from which the delimiting quotes or } { apostrophes are removed. An important exception is for } { in which the first argumnet, a flag name, is translated } { into a cXXX code which is then entered as a one-character } { argument. } var N: integer; More: Boolean; I:integer; begin GetArgSep; case ComTable[CurComNumber].CA of aNULL: OK:=true; aINT: GetIntArg(cREQ); aINTO: GetIntArg(cOPT); aINTM: GetMIntArg(cREQ); aINTOM: GetMIntArg(cOPT); aINTPM: GetPMIntArg(cREQ); aINTOPM: GetPMIntArg(cOPT); aREFNAME: GetRefNameArg(cREQ); aQSTR: GetQStrArg(cREQ); aQSTRO: GetQStrArg(cOPT); aTEXT: GetTTextArg(cREQ); aNCODE: GetNCodeArg(cREQ); aATTR: GetAttrArg(cREQ); aC: begin { [ pm-integer ] o [;|eol]1:1 trailing-text } GetPMIntArg(cOPT); if Absent then GetEmptyArg; if OK then begin GetArgSep; if Get(';') then else if IsEOL then OK:=GetLine else OK:=false; if OK then GetTTextArg(cREQ); end else GetEmptyArg; end; aCOND: GetNameArg(cREQ); aDCR: begin { name o number-code } GetNameArg(cREQ); if Absent then GetEmptyArg; if OK then begin GetComma(cOPT); GetNCodeArg(cREQ); end else GetEmptyArg; end; aDLE: begin { [ quoted-char o,o ] number-code [ o,o quoted-char ] } GetQCharArg(cOPT); if Present then GetComma(cOPT); if OK then begin GetNCodeArg(cREQ); if OK then begin GetComma(cOPT); if Present then GetQCharArg(cREQ); end; end; end; aDHL: GetCommaListArg(mDHL,6); aDT: GetCommaListArg(mDT,2); aDzz: begin { [ short-quoted-string o,o ] number-code [ o,o short-quoted-string ] } GetSQStrArg(cOPT); if Present then GetComma(cOPT); if OK then begin GetNCodeArg(cREQ); if OK then begin GetComma(cOPT); if Present then GetSQStrArg(cREQ); end; end; end; azBB: GetQCharArg(cOPT); aFL: begin { [ name [ o char ] ] } OK:=true; GetArgSep; N:=cALL; if GTail1('ALL') then N:=cALL else if GTail1('ACCEPT') then N:=cACCEPT else if GTail1('BOLD') then N:=cBOLD else if GTail1('BREAK') then N:=cBREAK else if GTail1('CAPITALIZE') then N:=cCAPITALIZE else if GTail1('COMMENT') then N:=cCOMMENT else if GTail1('CONTROL') then N:=cCONTROL else if GTail1('HYPHENATE') then N:=cHYPHENATE else if GTail1('INDEX') then N:=cINDEX else if GTail1('LOWERCASE') then N:=cLOWERCASE else if GTail1('NOPERMUTE') then N:=cNOPERMUTE else if GTail1('OVERSTRIKE') then N:=cOVERSTRIKE else if GTail1('PERIOD') then N:=cPERIOD else if GTail1('SPACE') then N:=cSPACE else if GTail1('SUBINDEX') then N:=cSUBINDEX else if GTail1('SUBSTITUTE') then N:=cSUBSTITUTE else if GTail1('UNDERLINE') then N:=cUNDERLINE else if GTail1('UPPERCASE') then N:=cUPPERCASE; AppendArg(chr(N)); if (CurComNumber = xFL) and (N <> cALL) then begin GetArgSep; GetFlagCharArg(cOPT); end; end; aHD: begin { [ ON | UPPER | LOWER | MIXED ] } GetWordnArg('ON',cREQ); if Absent then GetWordnArg('UPPER',cREQ); if Absent then GetWordnArg('LOWER',cREQ); if Absent then GetWordnArg('MIXED',cOPT); end; aHL: begin { [ pm-integer ] o trailing-text } GetPMIntArg(cOPT); if Absent then GetEmptyArg; if OK then begin GetArgSep; GetTTextArg(cREQ); end; end; aLO: GetCommaListArg(mLO,2); aLS: begin { [ m-integer ] o[,o] [ char ] } GetMIntArg(cOPT); if Absent then GetEmptyArg; if OK then begin GetComma(cOPT); GetQCharArg(cOPT); end; end; aNMA: begin { pm-integer | letter ... } GetPMIntArg(cOPT); if Absent then GetAxNameArg(cOPT); end; aNMLS: GetCommaListArg(mNMLS,2); aNMLV: GetCommaListArg(mNMLV,6); aP: GetCommaListArg(mP,3); aPS: GetCommaListArg(mPS,2); aR: begin { [ m-integer ] o [;|eol]1:1 trailing-text } GetMIntArg(cOPT); if Absent then GetEmptyArg; if OK then begin GetArgSep; if Get(';') then else if IsEOL then OK:=GetLine else OK:=false; if OK then GetTTextArg(cREQ); end; end; aREQ: GetQStrArg(cREQ); aRPT: begin { integer o quoted-char } GetIntArg(cREQ); if Absent then GetEmptyArg; if OK then begin GetComma(cOPT); GetQStrArg(cREQ); end; end; aSCO: begin { [ attribute-list ] o text } GetAttrArg(cOPT); if Absent then GetEmptyArg; if OK then begin GetComma(cOPT); GetTTextArg(cREQ); end; end; aSCNT: begin { name o pm-integer } GetNameArg(cREQ); if Absent then GetEmptyArg; if OK then begin GetComma(cOPT); GetPMIntArg(cREQ); end; end; aSTHL: begin { attr | intlist } GetAttrArg(cREQ); if Absent then GetCommaListArg(mSTHL,9); end; aSzz: GetCommaListArg(mSzz,3); aSTXT: begin { name o quoted-string } GetNameArg(cREQ); if Absent then GetEmptyArg; if OK then begin GetComma(cOPT); GetQStrArg(cREQ); end end; aTS: GetCommaListArg(mTS,32); aTN: begin { [ ON ] o [ integer ] } GetWordnArg('ON',cOPT); if Absent then GetEmptyArg; if OK then begin GetComma(cOPT); GetIntArg(cOPT); end; end; aVR: begin { name o char o,o char } GetNameArg(cREQ); if OK then begin GetArgSep; GetCharArg(cREQ); if OK then begin GetComma(cREQ); if OK then begin GetCharArg(cREQ); end; end; end; end; azP: begin { attribute-list o text } GetAttrArg(cOPT); if Absent then GetEmptyArg; if OK then begin GetArgSep; GetTTextArg(cREQ); end; end; aZWx: begin { name o text } GetNameArg(cREQ); if OK then begin GetArgSep; GetTTextArg(cREQ); end; end; aZCAP: begin { integer o trailing-text } GetNameArg(cREQ); if OK then begin GetArgSep; GetTTextArg(cREQ); end; end; aZLT: begin { [ integer ] } GetIntArg(cOPT); AppendArg('Z'); CurComNumber:=xLT; end; end; GetArgs:=OK; end; {***************************************************************} { } { Command Parsing Routines } procedure QueueCommand; { If the command is .CENTER or .RIGHT, the CapLine routine is } { is applied to the second argument of the command. If } { CapLine succeeds, the command becomes a ZCAP command. } { Put current command at the inflow of the pipe. } { If the command is .ZWC or .ZWD, take it right back off the } { queue and execute it. } { If the pipeline is full, take a command from the outflow of } { the pipe, execute it, and move the commands down the pipe } { to fill the outflow position and leave an empty inflow } { position. } var MidPoint: integer; I: integer; Com2: AnyString; SaveInputLine: AnyString; SaveArgListHead: AnyString; begin if (CurComNumber = xC) or (CurComNumber = xR) then begin if CurComNumber = xC then Com2 := 'C' else Com2 := 'R'; SaveInputLine := InputLine; MidPoint := Index(CurArgList,chr(0)); InputLine := Right(CurArgList,MidPoint+1); SaveArgListHead := Left(CurArgList,MidPoint); if CapLine then begin CurComNumber := xZCAP; CurArgList:=Com2+SaveArgListHead+InputLine; end; InputLine := SaveInputLine; end; PipeSize:=PipeSize+1; Pipe[PipeSize].LineNumber:=InputLineCount[FileIndex]; Pipe[PipeSize].ComNumber:=CurComNumber; Pipe[PipeSize].ArgCount:=CurArgCount; Pipe[PipeSize].ArgList:=CurArgList; if (CurComNumber = xZWC) or (CurComNumber = xZWD) then begin PipePtr := PipeSize; Dispatch; PipeSize:=PipeSize-1; end; if PipeSize = MaxPipe then begin if EnableInteraction then begin write('FrPipe.. Pipe full; the following command must be executed:'); end; PipePtr := 1; Dispatch; for I:=2 to PipeSize do begin Pipe[I-1] := Pipe[I]; end; PipeSize:=PipeSize-1; end; end; procedure GetCommand; var ErrPos: AnyString; OKComName:Boolean; OKArgs:Boolean; ComStart: integer; ArgStart: integer; Start,Stop: integer; begin CurArgCount:=0; CurArgList:=''; ComStart:=P; OKComName:=GetComName; if InLiteral then OKComName:=false; ArgStart:=P; if OKComName then begin if (CurComNumber=xLT) or (CurComNumber=xZLT) then begin InLiteral:=true; if not LiteralInPipe then begin rewrite(LiteralFileVar); LiteralInPipe:=true; end; end; OKArgs:=GetArgs; if OKArgs then QueueCommand; end else OKArgs:=true; if EnableInteraction then begin write('Parse... '); DumpCom( InputLineCount[FileIndex], CurComNumber, CurArgCount, CurArgList); end; if not OKComName then begin writev(ErrPos,Argstart:1); ErrorPrint('Bad Command at position '+ErrPos+' -- '+InputLine); end else if not OKArgs then begin writev(ErrPos,Argstart:1); ErrorPrint('Bad Command at position '+ErrPos+' -- '+InputLine); end else if CurComNumber=xREQ then PutPipe; end; {***************************************************************} { } { Utilities for Text Processing } procedure PutText(S:LongLine); var OutBreak : integer; LineTemp : LongLine; LinePart : AnyString; LineLength : Integer; function BreakLine(LineMax:Integer) : Boolean; label BreakOut; var i: Integer; begin if length(LineTemp)<LineMax then LineLength := length(LineTemp) else LineLength := LineMax; for i := LineLength downto 1 do begin if (LineTemp[i]=' ') or (LineTemp[i]='#') then begin OutBreak := i; BreakLine := true; goto BreakOut; end; OutBreak := LineLength; BreakLine := false; end; BreakOut: end; procedure ExamineLength; begin while length(LineTemp) > OutMax do begin if not BreakLine(OutMax) then begin if not BreakLine(MaxMax) then begin ErrorPrint('Cannot find good line break '); OutBreak := LineLength; end; end; if OutBreak=Length(LineTemp) then begin OutputLine := LineTemp; LineTemp :=''; end else begin LinePart := left(LineTemp,OutBreak-1); OutputLine := LinePart; LineTemp := right(LineTemp,OutBreak+1); end; PutEOL; end; end; begin LineTemp := OutputLine + S; if not InLiteral then ExamineLength; OutputLine := LineTemp; end; procedure PutLine{(S:AnyString)}; begin PutText(S); if InEmphasis then PutText('\BOLD)'); PutEOL; if InEmphasis then PutText('<EMPHASIS>('); end; procedure PutElement{(S:AnyString)}; { Writes Profile File } var OutLineString : AnyString; ErrorStatus : Real; begin writeln(ProFileVar,S, error := continue); ErrorStatus := status(ProFileVar); if ErrorStatus>0 then begin ErrorPrint('Error writing Profile File' ); end; end; procedure PutCol(C:char); begin NewCol := NewCol + c; end; procedure PutCol2(S:ShortString); begin NewCol := NewCol + S; end; procedure PutNext(C:Char); begin NewCol := NewCol +c; P := P+1; end; procedure Ignore(S:AnyString); begin end; procedure Warning(S:AnyString); begin end; {***************************************************************} { } { Utilities for Text Processing Routines } function GetC(C:char): Boolean; begin if InputLine[p]=EOL then GetC:=false else begin if InputLine[P]=C then begin P:=P+1; GetC:=true; end else GetC:=false; end; end; function GetS(S:AnyString): Boolean; var More: Boolean; I: integer; Found: Boolean; begin More:=true; Found:=true; I:=0; while More do begin if I+1 > Length(S) then More:=false else begin if InputLine[P+I] = S[I+1] then I:=I+1 else begin Found:=false; More:=false; end; end; end; if Found then P:=P+I; GetS:=Found; end; function IsEndLiteral: Boolean; var SaveP: integer; begin SaveP := P; IsEndLiteral := false; if GetC(ControlFlagCur) then begin if GTailn(2,'EL') then IsEndLiteral:=true else if GTailn(3,'ELI') then IsEndLiteral:=true else if GTailn(3,'END') then begin if GetSep then begin if GTailn(3,'LITERAL') then IsEndLiteral:=true end; end; end; P := SaveP; end; {***************************************************************} { } { Text Processing Routines } { } { These routines, taken together, do the entire job of } { converting DSR text to the corresponding Document text. } { They translate the flags that occur in the text. They apply } { not only to the ordinary text in the file, but also to most } { text that appears as an argument in a DSR command. } procedure Capitalize; { Handle Capitalize Flag (default <) } begin end; procedure IndexWord; { Handle Index Flag (default >) } var OldP : integer; IndexHit : AnyString; begin OldP:=P; while not (InputLine[P] in [' ','.',',',';',EOL]) do P:=P+1; IndexHit:=Mid(InputLine,OldP,P-OldP); Arg1:=INdexHit; Arg2:=''; Indexcom('<X>'); P:=OldP; end; procedure LowerCase; { Handle LowerCase Flag (default \) and sequences that begin } { with the LowerCase flag. } var Pattern: AnyString; begin if GetC(FlagsCur[cBOLD]) then begin if BoldingEnabled and InEmphasis then begin PutText('\BOLD)'); InEmphasis := false; end; end else if GetC(FlagsCur[cUNDERLINE]) then begin if UnderliningEnabled and InUnderline then begin PutText(')'); InUnderline := false; end; end else if GetChar then PutText(ToLower(InputLine[P-1])); end; procedure NoPermute; { Handle NoPermute Flag (default ~) } begin end; procedure Subindex; { Handle SubIndex Flag (default >) } begin PutText('<XS>'); end; procedure Substitute(C:Char); { Handle Substitute Flag (default $) } var n1:integer; i1,i2,i3,i4,i5: integer; c1:char; RefW,RefSym: AnyString; UpLine :WideLine; FoundRefSym : Boolean; CheckDefine : Boolean; procedure ParseRefSym; label EndLoop, EndLoop2; begin UpLine := UpCase(InputLine); RefW:=''; for i1 := P to length(UpLine) do begin c1 := UpLIne[i1]; if (c1='(') or (c1 in [' ','.',',',';',':','!','?']) then begin i2 := i1; goto EndLoop; end else RefW := RefW+c1; end; i2 := length(UpLine); EndLoop: RefSym := ''; for i1 := i2 to length(UpLine) do begin c1 := UpLine[i1]; if c1<>' ' then begin if c1='(' then begin i5 := i1+1; i4 := SubPos(UpLine,')',i5); if i4=0 then goto EndLoop2 else begin RefSym := substr(UpLine,i5,i4-i5); FoundRefSym := true; end; end else begin i3 := i1; FoundRefSym := false; end; goto EndLoop2; end; end; EndLoop2: end; procedure FindRefSym; label MatchFound; begin if not FoundRefSym then begin if RefW = 'DATE' then begin PutText('<DATE>'); P := P+4; goto MatchFound; end end else begin if CheckDefine then begin for i1 := 1 to RefWdMax do begin if Index(RefWd[i1],RefW)=1 then begin PutText('<REFERENCE>('+RefSym+'\VALUE)'); P := i4+1; goto MatchFound; end; end; end else begin PutText('<REFERENCE>('+RefW+')'); P := i4+1; goto MatchFound; end; end; ErrorPrint('Unrecognized substitution: '+InputLine); If CHeckDefine then PutText(C+C) else PutText(C); MatchFound: end; begin if InputLine[P]=C then begin P := P+1; CheckDefine := true end else CheckDefine := false; ParseRefSym; FindRefSym; end; procedure UpperCase; { Handle UpperCase Flag (default ^) } var Pattern: AnyString; begin if GetC(FlagsCur[cBOLD]) then begin if BoldingEnabled and not InEmphasis then begin PutText('<EMPHASIS>('); InEmphasis := true; end; end else if GetC(FlagsCur[cUNDERLINE]) then begin if UnderliningEnabled and not InUnderline then begin PutText('<EMPHASIS>('); InUnderline := true; end; end else if GetChar then PutText(ToUpper(InputLine[P-1])); end; procedure ZKey(Npos:integer); { Called by CheckText Analyzes the tail of InputLine that begins at NPos and replaces it with a string that is closer to the Document form of the string. In the following rules, s and t are strings that do not contain < or >, and u is the remainder of InputLine. Rules are tried in order. When a rule succeeds, the routine returns. Replace <u with <literal>(<)u if u does not contain > Replace <sARROWt>u with <arrow>(s)u Replace <sCTRLt>u with <ctrl>(t)u Replace <s>u with <literal>(<)s>u if s is more than 20 chars long or contains a space. Replace <s:t>u with <bitmap>(s:t)u. Replace <s>u with <key>(s)u. } var StartKey: integer; EndKey: integer; StartArrow: integer; StartCtrl: integer; n1 : integer; Insertion : AnyString; Key: AnyString; procedure PutKey(S:ShortString); begin PutText('<'+S+'>('+Key+')'); P := P + Length(Key)+1; end; procedure PutLitKey; begin PutText('<LITERAL>(<)'); end; begin StartKey:=NPos; EndKey:=SubPos(InputLine,'>',StartKey); if (EndKey=0) or NoKey then PutLitKey else begin Key:=mid(InputLine,StartKey,EndKey-StartKey); if (Length(Key)>20) or (SubPos(Key,' ',1)<>0) then PutLitKey else begin StartArrow:=SubPos(UpCase(Key),'ARROW',1); if StartArrow <> 0 then PutKey('MATH_CHAR') else begin if SubPos(Key,':',1) <> 0 then PutKey('BITMAP') else PutKey('KEY'); end; end; end; end; procedure ZBar; begin PutText('<VBAR>'); end; procedure RefStart; begin PutText('<REFERENCE>('); SaveP := P; end; procedure RefStop; begin PutText(')'); FigureSym := '\'+substr(InputLine, SaveP, P-SaveP-1); AddRefDef('REF'); end; procedure RefStart2; begin PutCol2('<REFERENCE>('); SaveP := P; end; procedure RefStop2; begin PutCol(')'); FigureSym := '\'+substr(InputLine, SaveP, P-SaveP-1); AddRefDef('REF'); end; function FlagOneChar(Flag:char;Left,Right:AnyString): AnyString; begin if InputLine[P] <> EOL then begin FlagOneChar := Left+InputLine[P]+Right; P:=P+1; end else begin ErrorPrint('Flag '+Flag+' used at end of a line'); FlagOneChar := ''; end; end; procedure PutAlignChar(C:char); begin if InNoFill then PutText(' ') else if not InAlign then begin InALign := true; PutText('<ALIGN_CHAR>('+c+')'+c); end else PutText(c); end; procedure PutAlignChar2(C:char); begin If not InAlign then begin InALign := true; PutCol2('<ALIGN_CHAR>('+c+')'+c); end else PutCol(c); end; procedure PutBold(C:char); begin if not InEmphasis then begin PutText(FlagOneChar(C,'<EMPHASIS>(','\BOLD)')); end; end; procedure PutUnderline(C:char); begin if not InUnderline then begin PutText(FlagOneChar(C,'<EMPHASIS>(',')')); end; end; procedure PutAccept(C:char); begin if InputLine[P] <> EOL then begin if InUnderLine and (InputLine[p]='_') then PutText(' ') else PutText(InputLine[P]); P:=P+1; end else begin ErrorPrint('Flag '+C+' used at end of a line'); end; end; procedure ProcessText; { Copies text from InputLine to OutputLine. A character that } { is not a flag or the beginning of a cliche is "normal". } { The routine is optimized for normal characters, passing } { them through without calling any program routine and only } { one standard routine. On the other hand, each kind of non- } { normal character has its own routine to handle it. } label EndLine; var I: integer; C: char; begin if InputLine[P] = EOL then begin if AutoPara then if InNoFill then PutLine('') else PutLine('<P>'); goto EndLine; end; while true do begin C:=InputLine[P]; if C = EOL then goto EndLine; P:=P+1; case Index(FlagsCur,C) of cNORMAL: PutText(C); {_} cACCEPT: PutAccept(C); {*} cBOLD: PutBold(C); {|} cBREAK: Ignore('Break Flag'); {<} cCAPITALIZE: Capitalize; {=} cHYPHENATE: Ignore('Hyphenate Flag'); {>} cINDEX: IndexWord; {\} cLOWERCASE: LowerCase; {~} cNOPERMUTE: NoPermute; {%} cOVERSTRIKE: Warning('OverStrike Flag'); {+} cPERIOD: Ignore('Period Flag'); {#} cSPACE: PutAlignChar(C); {>} cSUBINDEX: PutText(C); {$} cSUBSTITUTE: Substitute(C); {&} cUNDERLINE: PutUnderline(C); {^} cUPPERCASE: Uppercase; cZKEY: ZKey(P); cZBAR: ZBar; cZREFSTART: RefStart; cZREFSTOP: RefStop; end; end; EndLine: end; procedure ProcessArg(ArgLine: AnyString); { Saves InputLine so that InputLine and P can be used to process } { an argument of a DSR command. Restores after processing } var SaveP: integer; SaveInputLine : WideLine; begin SaveInputLine := InputLine; SaveP := P; P := 1; InputLine := ArgLine+eol; ProcessText; InputLine := SaveInputLine; P := SaveP; end; procedure ProcessIndexArg(ArgLine: AnyString); { Saves InputLine so that InputLine and P can be used to process } { an index hit of a DSR command. Rstores after processing } label endline; var C: char; SaveP: integer; begin SaveInputLine := InputLine; saveP := P; P := 1; InputLine := ArgLine+eol; while true do begin C:=InputLine[P]; if C = EOL then goto EndLine; P:=P+1; case Index(FlagsCur,C) of cNORMAL: PutText(C); {_} cACCEPT: PutText(FlagOneChar(C,'','')); {*} cBOLD: PutBold(C); {|} cBREAK: Ignore('Break Flag'); {<} cCAPITALIZE: Capitalize; {=} cHYPHENATE: Ignore('Hyphenate Flag'); {>} cINDEX: Subindex; {\} cLOWERCASE: LowerCase; {~} cNOPERMUTE: NoPermute; {%} cOVERSTRIKE: Warning('OverStrike Flag'); {+} cPERIOD: Ignore('Period Flag'); {#} cSPACE: PutText(' '); {>} cSUBINDEX: Subindex; {$} cSUBSTITUTE: Substitute(C); {&} cUNDERLINE: PutUnderline(C); {^} cUPPERCASE: Uppercase; cZKEY: ZKey(P); cZBAR: ZBar; end; end; EndLine: InputLine := SaveInputLine; P := SaveP; end; procedure ProcessText2(S:WideLine); begin InputLine := S+EOL; P:=1; ProcessText; end; procedure SplitLine; label ProcessExit; var LeftLine : AnyString; RightLine : AnyString; BlankCount : Integer; I : Integer; begin BlankCount:=0; for i := 1 to length(InputLine) do begin if (InputLine[i] in [' ','-']) or (InputLine[i]=Flagscur[cSpace]) then begin BlankCount := BlankCount+1 end else if BLankCount>1 then begin LeftLine:=Left(InputLine,i-blankcount-1); RightLine := Right(InputLine,i); RightLine := Left(rightLine,length(RightLine)-1); goto ProcessExit; end else BlankCount:=0; end; LeftLine:=left(InputLine,length(InputLine)-1); RightLine:=''; ErrorPrint('Cannot find column separation in Definition List'); ProcessExit: StartLine := false; if Glossary then begin PutText('<GTERM>('); ProcessText2(LeftLine); PutLine(')'); PutText('<GDEF>('); ProcessText2(RightLine); end else begin ProcessCol(LeftLine); PutText(NewCol+'\'); ProcessCol(RightLine); PutText(NewCol); end; end; {***************************************************************} { } { Comment Processing Routine } Procedure GetComment; var OutComment: AnyString; begin OutComment:=''; while (InputLine[P]<>';') and (InputLine[P] <> EOL) do begin OutComment:=OutComment+InputLine[P]; P:=P+1; end; CurComNumber:=xBANG; CurArgCount:=1; CurArgList:=OutComment+ArgEnd; QueueCommand; end; {**************************************************************} { } { Junk Processing Routine } procedure GetJunk; var OutJunk: AnyString; RealJunk: Boolean; C: char; begin OutJunk:=''; RealJunk:=false; C:=InputLine[P]; while (C <> ControlFlagCur) and (C <> ';') and (C <> CommentFlagCur) and (C <> EOL) do begin OutJunk:=OutJunk+C; if C <> ' ' then RealJunk:=true; P:=P+1; C:=InputLine[P]; end; if RealJunk then begin ErrorPrint('Cannot interpret this part of line: <'+OutJunk+'>'); end; end; {***************************************************************) { } { Utilities for Individual Command Routines } { } { These routines are specifically designed for use in } { generating the Document output. Most of them are called for } { two or more commands, but they are nevertheless specialized. } function RefPointValue: AnyString; begin if CheckPipe(XREF) then RefPointValue := '\'+arg1 else RefPointValue:=''; end; function AutoP : ShortString; label AutoPEx; var I : integer; begin for I := PipePtr+1 to PipeSize do if ComTable[Pipe[I].ComNumber].CB in [BREAK,SECBREAK] then begin AutoP:=''; goto AutoPEx; end; AutoP := '<P>'; AutoPEx: end; procedure PutArg(s1,s2,s3:AnyString); var SaveBolding : Boolean; SaveUnderlining : Boolean; begin Saveunderlining := UnderliningEnabled; SaveBolding := BoldingEnabled; BoldingEnabled := false; UnderliningEnabled := false; PutText(s1); ProcessArg(s2); BoldingEnabled := SaveBolding; UnderliningEnabled := SaveUnderlining; PutLine(s3); end; function CheckPipe{(TargetCom:ComType): Boolean}; label Leave; var I: integer; begin for I:=PipePtr+1 to PipeSize do begin if Pipe[I].ComNumber = TargetCom then begin UnpackCommand(I); Pipe[I].ComNumber := xNOP; CheckPipe := true; goto Leave; end else if ComTable[Pipe[I].ComNumber].CB=SECBREAK then begin CheckPipe := false; goto Leave; end; end; CheckPipe := false; Leave: end; function TestPipe(TargetCom:ComType): Boolean; label EndSub; var I: integer; begin TestLoc := 0; TestPipe := false; for I:=PipePtr+1 to PipeSize do begin if Pipe[I].ComNumber = TargetCom then begin TestCount := TestCount+1; if Testcount <= 1 then TestLoc := I; TestPipe := true; end else if ComTable[Pipe[I].ComNumber].CB=SECBREAK then goto EndSub; end; EndSub: end; function TestPipeForBlanks(MinVal:integer): Boolean; label EndSub; var I: integer; BlankCount: integer; begin TestLoc := 0; TestPipeForBlanks := false; for I:=PipePtr+1 to PipeSize do begin if Pipe[I].ComNumber = xB then begin if Length(Pipe[I].ArgList)=0 then BlankCount:=1 else BlankCount:=StringToInteger(Pipe[I].ArgList); if BlankCount >= MinVal then begin TestCount := TestCount+1; if Testcount <= 1 then TestLoc := I; TestPipeForBlanks := true; end; end else if ComTable[Pipe[I].ComNumber].CB=SECBREAK then goto EndSub; end; EndSub: end; procedure ClearFlagState; begin If InEmphasis then begin PutText('\BOLD)'); InEmphasis := false; end; If InUnderLine then begin PutText(')'); InUnderline := false; end; end; procedure ClearState; begin if InNoFill then begin InNoFill := false; ClearFlagState; If CodeExWaiting then CodeExWaiting := false else PutLine('<ENDCODE_EXAMPLE>'); end; end; procedure ClearDefList; begin while InDefList do begin if GLossary then putline(')') else putline(')<ENDTABLE>'+AutoP); DefListCount := DefListCount -1; if DefListCount=0 then InDefList := false; end; end; procedure ClearBlock; begin ClearSection; if Preface then begin PutLine('<ENDPREFACE>'); PutLine('<ENDFRONT_MATTER>'); Preface := false; end; end; procedure ClearSection; begin ClearState; if InAlign then begin PutLine('<ENDALIGN_CHAR>'); InAlign := false; end; If FigureFlag then begin Putline ('<END'+FigExName+'>'); FigureFlag := false; end; ClearDefList; if InFootNote then begin PutLine(')'); InFootNote := false; end; end; {***************************************************************} { } { Ignored Command Routines } procedure IgnoreCom; begin end; procedure InvalidCom; begin ErrorPrint('Invalid Command '+InputLine); IgnoreCom; end; procedure DecideLater; begin IgnoreCom; end; procedure ForbiddenCommand; begin IgnoreCom; end; {***************************************************************} { } { Individual Command Routines } procedure CondOutput(Com:AnyString); begin if InDefList then begin if AutoPara then begin if RowOpen then PutLine(')') else RowOpen := true; if not Glossary then PutText('<TABLE_ROW>('); StartLine := true; end; end else if not Table then begin if InNoFill then PutLine(' ') else PutLine(Com); end; end; procedure PutFigure(S:ShortString); begin ClearState; PutLine('<'+FigExName+'>'+FigureCaption); PutLine('<'+figExName+'_ATTRIBUTES>('+s+')'); PutLine('<'+FigExName+'_SPACE>('+FigureSpace+')'); PutLine('<END'+FigExName+'>'+AutoP); FigureFlag := false; end; function FirstLetter: integer; label leave; var I: integer; begin FirstLetter := 0; for I := 1 to length(Arg2) do if Arg2[i] in ['A'..'Z','a'..'z'] then begin FirstLetter := i; goto Leave; end; Leave: end; procedure DeFlag; label EndLine; var c,c2:char; NewArg: Wideline; i : integer; SaveBolding : Boolean; SaveUnderlining : Boolean; procedure ChangeCase(S:ShortString); begin c2 := Arg2[i]; i := i+1; if not ((c2=FlagsChar[cBold]) or (c2=FlagsChar[cUnderline])) then begin if S='LOWER' then NewArg := NewArg+ToLower(c2) else NewArg := NewArg+ToUpper(c2); end; end; begin Saveunderlining := UnderliningEnabled; SaveBolding := BoldingEnabled; BoldingEnabled := false; UnderliningEnabled := false; Arg2 := Arg2+eol; NewArg := ''; i := 1; while true do begin C:=Arg2[i]; if C = EOL then goto EndLine; i := i+1; case Index(FlagsCur,C) of cNORMAL: NewArg := NewArg + C; {_} cACCEPT: begin c:=Arg2[i]; i:=i+1; if c=EOL then goto EndLine else NewArg := NewArg + c; end; {*} cBOLD: {nothing}; {|} cBREAK: {Ignore('Break Flag')}; {<} cCAPITALIZE: {Capitalize}; {=} cHYPHENATE: Ignore('Hyphenate Flag'); {>} cINDEX: ; {IndexWord}; {\} cLOWERCASE: ChangeCase('LOWER'); {~} cNOPERMUTE: {NoPermute}; {%} cOVERSTRIKE: Warning('OverStrike Flag'); {+} cPERIOD: Ignore('Period Flag'); {#} cSPACE: {PutText('#') ??? TEMPORARY FIx}; {>} cSUBINDEX: {PutText(C)}; {$} cSUBSTITUTE: Substitute(C); {&} cUNDERLINE: {PutText(FlagOneChar(C,'<EMPHASIS>(',')'))}; {^} cUPPERCASE: ChangeCase('UPPER'); cZKEY: ZKey(P); cZBAR: ZBar; cZREFSTART: NewArg := NewArg+c; cZREFSTOP: NewArg := NewArg+c; end; end; EndLine: Arg2 := NewArg; BoldingEnabled := SaveBolding; UnderliningEnabled := SaveUnderlining; end; procedure AddNewSym(Definition:ShortString); begin ReferenceLimit := ReferenceLimit +1; if ReferenceLimit < ReferenceMax then begin SymSym[ReferenceLimit] := FigureSym; if Definition='DEF' then SymDef[ReferenceLimit] := True else SymRefCount[ReferenceLimit] := 1; end else ErrorPrint('Reference Table Size exceeded'); end; procedure AddRefDef{(RefDef:ShortString)}; label SymFound; var i : integer; begin ContTab := false; for i := 1 to ReferenceLimit do begin if SymSym[i]=FigureSym then begin if RefDef='DEF' then begin if SymDef[i] then begin if index(Upcase(FigureTitle),'(CONT')<>0 then ContTab := true else ErrorPrint('Multiple Definition of '+FigureSym); end else SymDef[i] := true; end else SymRefCount[i] := SymRefCount[i] + 1; goto SymFound; end; end; AddNewSym(RefDef); SymFound: end; procedure FormCaption(S:ShortString); begin FigureCaption := '(' +FigureTitle +FigureSym+')'; FigureFlag := true; FigExName := S; AddRefDef('DEF'); end; procedure TabPutLine(S:AnyString); begin if RTBFile or InDefList then PutLine(S) else begin if HoldTabPtr < HoldTabMax then HoldTab[HoldTabPtr]:=HoldTab[HoldTabPtr]+S else begin ErrorPrint('Holding Table capacity exceeded'); TableABort := true; end; HoldTabPtr := HoldTabPtr + 1; HoldTab[HoldTabPtr] := ''; end; end; procedure PutTable; begin HoldTabPtr := 1; HoldTab[1] := ''; if NullCaption then TabPutLine('<TABLE>') else begin TabPutLine('<TABLE>(' +FigureTitle +FigureSym+')'); if not ContTab then AddRefDef('DEF'); end; TableFlag := true; LitPtr := 1; InTable := false; LitMax := 0; RowMax := 0; end; procedure FormZCAP; var n1,n2,i : integer; CapType : ShortString; begin DeFlag; n1:=index(Arg2,RefStartChar); n2:=index(Arg2,RefStopChar); CapType := mid(Arg2,n1+1,1); FigureSym := '\'+mid(Arg2,n1+1,n2-n1-1); Arg2 := right(Arg2,n2+1); i := FirstLetter; if i<>0 then Arg2 := right(Arg2,i); FigureTitle := Arg2; if FlagsCur[cSPACE]<>NoCode then begin while left(FigureTitle,1)=FlagsCur[cSPACE] do FigureTitle := right(FigureTitle,2); end; if CapType='F' then FormCaption('FIGURE') else if CapType = 'E' then FormCaption('EXAMPLE') else if CapType = 'T' then TableFlag := true; Implicit := true; end; procedure FormHT; var TabStr : ShortString; begin TabCounter := TabCounter +1; Arg2 := Arg1; DeFlag; FigureTitle := Arg2; writev(TabStr,TabCounter:CountSize(TabCounter)); FigureSym := RefPointValue; if FigureSym='' then FigureSym := '\T'+ ChapterNum+'P'+TabStr; TableFlag := true; NullCaption := false; Implicit := false; end; procedure FormHF; var FigStr : ShortString; begin FigCounter := FigCounter +1; Arg2 := Arg1; DeFlag; FigureTitle := Arg2; writev(FigStr,FigCounter:CountSize(FigCounter)); FigureSym := RefPointValue; if FigureSym='' then FigureSym := '\F'+ ChapterNum+'P'+FigStr; FormCaption('FIGURE'); end; procedure FormHE; var ExStr : ShortString; begin ExCounter := ExCounter +1; Arg2 := Arg1; DeFlag; FigureTitle := Arg2; writev(ExStr,ExCounter:CountSize(ExCounter)); FigureSym := '\E'+ ChapterNum+'P'+ExStr; FormCaption('EXAMPLE'); end; procedure Blanks; var IntArg1 : integer; begin if Arg1='' then Arg1 := '2'; readv(Arg1,IntArg1); if IntArg1<2 then CondOutput('<CP>') else if IntArg1<5 then CondOutput('<P>') else begin FigureSpace := Arg1; if not FigureFlag then if CheckPipe(XZCAP) then FormZCAP else if CheckPipe(XHF) then FormHF else if CheckPipe(XHE) then FormHE else FigureCaption := ''; PutFigure('KEEP') end; end; procedure LeftMargin; label LMex; var MarginIncr : Integer; SignPos : varying[10] of Char; MarginIndent : varying[5] of char; begin if NoDefList then goto LMex; OldMargin := CurMargin; if length(arg1)=0 then arg1 := '0'; SignPos := left(arg1,1); readv(arg1,MarginIncr); if (SignPos='+') or (SignPos = '-') then begin CurMargin := CurMargin + MarginIncr; arg1 := right(arg1,2); end else CurMargin := MarginIncr; MarginIndent := arg1; if CurMargin=0 then begin ClearDefList end else begin if (OldMargin > CurMargin) then begin {moving back} if (InDefList) then begin ClearState; if Glossary then PutLine(')') else PutLine(')<ENDTABLE>'+AutoP); DefListCount := DefListCount-1; if DefListCount=0 then InDefList := false; end else end else if (OldMargin < CurMargin) then begin {moving out} if CheckPipe(XI) or CheckPipe(XSPR) then begin ClearState; if not GLossary then begin PutLine('<TABLE>'); PutLine('<TABLE_SETUP>(2\'+MarginIndent+')'); end; InDefList := true; DefListCount := DefListCount+1; StartLine := true; RowOpen := true; If not GLossary then PutText('<TABLE_ROW>('); end; end; end; LMex: end; procedure Indent; begin ClearState; if not InDefList then PutLine('<LINE>') else begin if RowOpen then PutLine(')') else RowOpen := true; if not Glossary then PutText('<TABLE_ROW>('); StartLine := true; end; end; procedure Just(s:AnyString); begin ClearState; ClearDefList; PutText('<'+S+'_LINE>('); ProcessArg(Arg2); PutLine(')'); end; procedure FindSuffix(S2:AnyString); label CheckElementName; var i : integer; TempElementCode : char; S : AnySTring; c : char; begin S:=''; for I := 1 to length(S2) do begin c := S2[i]; if c =' ' then S:= S + '_' else if (c in ['A'..'Z']) or (c in ['0'..'1']) or (C in ['a'..'z']) then S := S + c; end; If length(S)>8 then ElementSuffix := Left(S,8) else ElementSuffix := S; TempElementCode := ElementCode; CheckElementName: For i := 1 to ElementTabMax do begin if ElementSuffix = ElementTab[i] then begin ElementSuffix := ElementSuffix + TempElementCode; TempElementCode := chr(ord(TempElementCode)+1); goto CheckElementName; end; end; if ElementTabMax < ElementTabLim then begin ElementTabMax := ElementTabMax +1; ElementTab[ElementTabMax] := ElementSuffix; end else ErrorPrint('Element Table Exceeded'); end; procedure CheckProfile; begin if InProfile then begin if not InElement then if PrefaceWritten then OutFront2 else begin OutFront1; OutFront2; end; InElement := true; if ChapterFlag or AppendixFlag then begin if barcount>0 then PutLine('<ENDMARK>'); close (OutFileVar[OutFileIndex]); end; FindSuffix(Arg1); ElementFileName := ProfileName+'_'+ElementSuffix+'.SDML'; PutElement('<ELEMENT>('+ElementFileName+')'); OutFile[OutFileIndex] := ElementFileName; open(OutFileVar[OutFileIndex], OutFile[OutFileIndex], record_length := 255 ); rewrite(OutFileVar[OutFileIndex]); writeln(OutFileVar[OutFileIndex],'<comment>('+DOCFileID+')'); if barcount>0 then PutLine('<MARK>'); end; end; procedure SetTextString; begin PutLine('<DEFINE_SYMBOL>('+arg1+'\'+arg2+')'); end; procedure CommentCom; begin end; procedure ChapterNumber; begin if CurArgCount=0 then Arg1:='0'; PutLine('<SET_CHAPTER_NUMBER>('+arg1+')'); readv(Arg1,ChapterCount); ChapterCount := ChapterCount -1; end; Procedure ChapterName; var ChapterTitle: AnyString; begin ChapterCount := ChapterCount +1; ChapterTitle := Arg1; ChapterSym := RefPointvalue; if ChapterSym='' then begin writev(ChapterNum,ChapterCount:CountSize(ChapterCount)); ChapterSym := '\C'+ChapterNum; end; FigureSym := ChapterSym; AddRefDef('DEF'); TabCounter := 0; FigCounter := 0; ExCounter := 0; ClearBlock; CheckProfile; if not InProfile and Preface then begin PutLine('<ENDPREFACE>'); PutLine('<ENDFRONT_MATTER>'); Preface:=false end; chapterflag := true; PutArg('<CHAPTER>(',ChapterTitle,ChapterSym+')'+AutoP); end; procedure AppendixLetter; begin PutLine('<SET_APPENDIX_LETTER>('+arg1+')'); end; procedure AppendixName; var AppendixTitle: AnyString; AppendixLet : ShortString; begin AppendixLet := 'ABCDEFGHIJKLMNOP'; AppendixCount := AppendixCount +1; AppendixTitle := Arg1; AppendixSym := RefPointvalue; if AppendixSym='' then begin if AppendixCount<16 then AppendixSym := '\A'+AppendixLet[AppendixCount] else AppendixSym := '\AZZZ'; end; FigureSym := AppendixSym; AddRefDef('DEF'); TabCounter := 0; FigCounter := 0; ExCounter := 0; ClearBlock; if Glossary then begin PutLine('<ENDGLOSSARY>'); Glossary:=false end; if AppendixFlag then PutLine('<ENDAPPENDIX>'); CheckProfile; AppendixFlag:=true; PutArg('<APPENDIX>(',AppendixTitle,AppendixSym+')'+AutoP); end; procedure IfCondition(S:AnyString); begin ClearState; if IfFlag then begin IfNest := IfNest + 1; ErrorPrint('Nested Ifs not translated'); end else begin IfFlag := true; IfNest := 1; if RowOpen then begin PutLine(')'); RowOpen := false; end; ConditionName := S+arg1; PutLine('<CONDITION>('+ConditionName+')'); end; end; procedure ElseCondition; begin ClearState; if IfFlag then begin PutLine('<ENDCONDITION>'); PutLine('<CONDITION>(NOT'+ConditionName+')'); end else ErrorPrint('.ELSE encountered outside .If context'); end; procedure EndIfCondition; begin ClearState; IfNest := IfNest -1; if IfNest = 0 then begin PutLine('<ENDCONDITION>'); IfFlag := false; end else if IfNest < 0 then begin ErrorPrint('Unmatched .ENDIF'); IfNest := 0; end; end; procedure ConsiderLater(Message:AnyString); begin end; procedure DefList(SubCom:AnyString); begin end; procedure DoLater; begin end; procedure ExampleSearch; begin if TestPipe(XLT) or TestPipeforBlanks(5) then FigureFlag := true else begin FigureSpace := '1'; PutFigure('KEEP'); end end; procedure TableSearch; begin if not TestPipe(XLT) then begin if Implicit then begin PutLine ('<P><REFERENCE>('+right(FigureSym,2)+') '+FigureTitle +'<P>'); end else begin PutLine('<TABLE>(' +FigureTitle +FigureSym+')'); if not ContTab then AddRefDef('DEF'); PutLine('<TABLE_SETUP>(2\10)'); PutLIne('<TABLE_ROW>(\)'); PutLine('<ENDTABLE>'+AutoP); end; TableFlag := False; end; end; procedure FigureSearch; begin if TestPipe(XLT) or TestPipeForBlanks(5) or TestPipe(XFG) or TestPipe(XFGD) then begin FigureFlag := true; end else begin FigureSpace := '1'; PutFigure('KEEP'); end end; procedure ProcessCol{(S:LongLine)}; label EndLine; var i:integer; c:char; ColChar : AnyString; begin NewCol:=''; S := S+EOL; P := 1; ColChar := left(FlagsCur,19)+'\()&'; while true do begin C:=S[P]; if C = EOL then goto EndLine; P:=P+1; case Index(ColChar,C) of cNORMAL: PutCol(C); {_} cACCEPT: PutNext(S[P]); {*} cBOLD: Ignore('Bold Flag'); {|} cBREAK: Ignore('Break Flag'); {<} cCAPITALIZE: Capitalize; {=} cHYPHENATE: Ignore('Hyphenate Flag'); {>} cINDEX: Ignore('IndexWord'); {\} cLOWERCASE: Ignore('LowerCase'); {~} cNOPERMUTE: NoPermute; {%} cOVERSTRIKE: Warning('OverStrike Flag'); {+} cPERIOD: Ignore('Period Flag'); {#} cSPACE: PutAlignChar2(C); {>} cSUBINDEX: PutCol(c); {$} cSUBSTITUTE: Ignore('Substitute(C)'); {&} cUNDERLINE: Ignore('PutUnderline(C)'); {^} cUPPERCASE: Ignore('Uppercase'); cZKEY: PutCol2('<LITERAL>(<)'); cZBAR: PutCol2('<VBAR>'); cZREFSTART: RefStart2; cZREFSTOP: RefStop2; cBSLASH: PutCol2('<BACKSLASH>'); cLPAREN: PutCol2('<OPAREN>'); cRPAREN: PutCol2('<CPAREN>'); cAMPRSND: PutCol2('<AMPERSAND>'); end; end; EndLine: end; procedure ClearCols; var i : Integer; begin for i := 1 to ColCount do Col[i]:=''; end; procedure TabPutText(S:Anystring); begin if RTBfile then PutText(S) else begin HoldTab[HoldTabPtr] := HoldTab[HoldTabPtr] + S; end; end; procedure PutTabLine { (S:LongLine)}; label BreakOut; var ColTemp : LongLine; i,OutBreak : integer; begin ProcessCol(S); {if RTBFile or ZLit or InDefList then ProcessCol(S) else NewCol := S;} while length(NewCol) > OutMax-2 do begin for i := OutMax-2 downto 1 do begin if (NewCol[i]=' ') or (NewCol[i]='#') then begin OutBreak := i; goto BreakOut; end; end; ErrorPrint('Cannot find good line break '); OutBreak := OutMax-2; BreakOut: coltemp := left(NewCol,OutBreak); TabPutLine(coltemp); NewCol := right(NewCol,OutBreak+1); end; TabPutLine(NewCol); end; procedure WriteRow; var i : integer; begin DataPresent := false; for i := 1 to ColCount do begin if col[i]<>'' then DataPresent := true; end; if DataPresent then begin if TableHead then begin TabPutText('<table_heads>('); TableHead := false; end else TabPutText('<table_row>('); PutTabLine(col[1]); for i := 2 to ColCount do begin TabPutText('\'); PutTabLine(col[i]); end; TabPutLine(')'); ClearCols; end; end; procedure WriteHeader; var i : Integer; temp : Anystring; begin writev(SetupInfo,colcount:1); for i := 2 to colcount do begin writev(temp,(colpos[i]-colpos[i-1]):2); SetupInfo := SetupInfo + '\' + temp; end; TabPutLine('<TABLE_ATTRIBUTES>(WIDE)'); TabPutLine('<TABLE_SETUP>('+ SetupInfo +')'); TableHead := true; end; procedure ProcessRTB; label ExRTB; var i: Integer; RTBError : Boolean; function FindRTBCols : Integer; var j : Integer; begin j := 1; if InputLine[1]= '+' then begin for i := 1 to length(InputLine) do begin if InputLine[i]='+' then begin ColPos[j] := i; j := j + 1; end; end; FindRTBCols := j-2; end else begin ErrorPrint('Unexpected Format in RTB table -- cannot find + line'); RTBError:=true; end; end; procedure Fill2; var i,j : integer; bcount : integer; c : char; txt : ShortString; TextOnLine : Boolean; begin if not LineWaiting then GetLine; TextOnLine := false; bcount := 0; j:=0; for i := 1 to length(InputLine) do begin c := InputLine[i]; if c ='|' then begin bcount := 0; j := j+1 end else if c=' ' then bcount := bcount+1 else begin if bcount>0 then begin if ((c='#') or (bcount>5)) and SubsequentLine then txt := '<line>'+c else begin txt := ' '+c ; TextOnLine := true; end; end else txt := c; bcount := 0; if (j>0) and (j<9) then col[j] := col[j]+txt; end; end; if (not SubsequentLine) and TextOnLine then SubsequentLine := true; end; procedure FindTestPage; label start; var TpArg : AnyString; begin start: GetLine; if (length(InputLine)>10) and (left(InputLine,10)='.TEST PAGE') then begin TParg := Right(InputLine,11); readv(TpArg,TPCount); MoreLines := true; end else goto start; end; procedure CheckTestPage; var TpArg : AnyString; begin GetLine; if (length(InputLine)>8) and (left(InputLine,8)='.RESTORE') then begin MoreLines := false; InputLine := ''+EOL; end else MoreLines := true; if (length(InputLine)>10) and (left(InputLine,10)='.TEST PAGE') then begin TParg := Right(InputLine,11); readv(TpArg,TPCount); LineWaiting := false; end else begin TPCount := 1; LineWaiting := true; end; end; procedure FindEndRTB; begin MoreLines := true; while MoreLines do begin GetLine; if (length(InputLine)>8) and (left(InputLine,8)='.RESTORE') then MoreLines := false; end; SeriousErrorPrint('Cannot convert RTB table'); PutLine('<TABLE_SETUP>(2\10)'); PutLIne('<TABLE_ROW>(\)'); PutLine('<ENDTABLE>'+AutoP); end; begin {ProcessRTB} RTBError := false; PutTable; if NullCaption then readv(Arg1,TpCount) else begin if CheckPipe(XTP) then readv(arg1,TPcount) Else begin ErrorPrint('Unexpected RTB table format--cannot find .TEST PAGE'); FindEndRTB; Goto ExRTB; end; end; ColCount := FindRTBCols; if RTBError then begin FindEndRTB; Goto ExRTB; end; while ColCount<2 do begin GetLine; if InputLine[1]='+' then ColCount := FindRTBCols else if left(InputLine,10)='.BEGIN TOP' then begin RTBError := true; ErrorPrint('Less than two columns in table'); FindEndRTB; goto ExRTB; end; end; ClearCols; SubsequentLine := false; for i := 1 to TPCount-2 do fill2; WriteHeader; WriteRow; FindTestPage; while MoreLines do begin SubsequentLine := false; for i := 1 to TPCount do fill2; WriteRow; CheckTestPage; end; PutLine('<ENDTABLE>'+AutoP); ExRTB: RestoreState; RTBFile := false; TableFlag := false; P := 1; end; procedure DoRTBTable; begin ErrorPrint('DO TABLE not supported'); end; procedure HeaderTable; begin ClearState; FormHT; if RTBFile then ProcessRTB else TableSearch; end; procedure HeaderExample; begin ClearState; FormHE; ExampleSearch; end; procedure HeaderFigure; begin ClearState; FormHF; FigureSearch; end; procedure Figure(S : ShortString); begin ClearDefList; FigureSpace := Arg1; if not FigureFlag then if CheckPipe(XZCAP) then FormZCAP else if CheckPipe(XHF) then FormHF else begin FigureCaption:=''; FigExName := 'FIGURE'; end; PutFigure(S); end; procedure ClearIndexHits; var i: integer; begin for i := 1 to IndexLim do begin IndexType := IndexS[I]; Arg1 := IndexArg1[I]; Arg2 := IndexArg2[I]; XPlusHit := IndexXP[I]; If XPlusHit then IndexPlusCom(IndexType) else IndexCom(IndexType); end; IndexLim := 0; end; procedure PutIndexHit( S1:ShortString;A1,A2:AnyString;XP:Boolean); begin if IndexLim < IndexMax then begin IndexLim := IndexLim + 1; IndexS[IndexLim] := S1; IndexArg1[IndexLim] := A1; IndexArg2[IndexLim] := A2; IndexXP[IndexLim] := XP; end else begin InNoFill := false; if CodeExWaiting then ClearIndexHits else begin PutLine('<ENDCODE_EXAMPLE>'); ClearIndexHits; CodeExWaiting := true; end; InNoFill := true; end; end; procedure Fill; begin if InNoFill then begin if CodeExWaiting then CodeExWaiting := false else begin ClearFlagState; PutLine('<ENDCODE_EXAMPLE>'+AutoP); end; InNoFill := false; if IndexHitsWaiting then ClearIndexHits; end; end; procedure NoFill; begin if not InNoFill then begin ClearDefList; CodeExWaiting := true; InNoFill := true; end; end; procedure Flags; var FlagCharErr: Boolean; I: integer; J: integer; begin I:=ord(Arg1[1]); if Arg2='' then FlagCharErr:=false else begin for J:=cACCEPT to cUPPERCASE do begin if I <> J then begin if Arg2=FlagsCur[J] then FlagCharErr:=true; end; end; end; if FlagCharErr then begin ErrorPrint('Command ".FLAGS flagname char" is illegal: char is already a flag'); end else begin if I=cALL then begin if not FlagsAllOn then begin FlagsAllOn:=true; FlagsCur:=FlagsSaved; end; end else if I=cCONTROL then begin if Arg2 <> '' then ControlFlagChar:=Arg2[1]; ControlFlagCur:=ControlFlagChar; end else if I=cCOMMENT then begin if Arg2 <> '' then CommentFlagChar:=Arg2[1]; CommentFlagCur:=CommentFlagChar; end else begin if Arg2 <> '' then FlagsChar[I]:=Arg2[1]; if FlagsAllOn then FlagsCur[I]:=FlagsChar[I] else FlagsSaved[I]:=FlagsChar[I]; end; end; end; procedure FlagsOff; var I: integer; begin I:=ord(Arg1[1]); if (I=cSpace) and InAlign then begin PutLine('<ENDALIGN_CHAR>'); InAlign := false; end; if I=cALL then begin if FlagsAllOn then begin FlagsAllOn:=false; FlagsSaved:=FlagsCur; FlagsCur:=FlagsAllOff; end; end else if I=cCONTROL then ControlFlagCur:=NoCode else if I=cCOMMENT then CommentFlagCur:=NoCode else begin if FlagsAllOn then FlagsCur[I]:=NoCode else FlagsSaved[I]:=NoCode; end; end; procedure RepeatString; var i : integer; IntArg1: integer; begin readv(Arg1,IntArg1); for i := 1 to IntArg1 do if InNoFill then PutLine(arg2) else PutText(Arg2); end; procedure SetHeaderlevel; var IntArg1: integer; begin readv(Arg1,IntArg1); if IsDigit(Arg1[1]) then HLCounter:=IntArg1 else HLCounter:=HLCounter+IntArg1; end; procedure HeaderLevel; var StrArg1: AnyString; HeaderText: AnyString; begin ClearSection; if Arg1='' then Arg1:='+0'; SetHeaderLevel; writev(StrArg1,HLCounter:1); HeaderText := arg2; PutArg('<HEAD'+StrArg1+'>(',HeaderText,RefPointValue+')'+AutoP); end; procedure IndexCom {(S:ShortString)}; begin if InNofill then begin PutIndexHit(S,Arg1,Arg2,false); IndexHitsWaiting := true; end else begin PutText(S+'('); ProcessIndexArg(arg1); PutLine(')'); end; end; function CheckAt2(S:AnyString) : Boolean; var n1,n2,n2a,n3 : integer; Txt : AnyString; nc: char; procedure FindDelim; begin n2 := index(Attr2,'"'); n2a := index(attr2,''''); if (n2<>0) and (n2a<>0) then begin if n2<n2a then nc:='"' else begin nc:=''''; n2:=n2a; end; end else begin if n2<>0 then nc:='"' else begin if n2a<>0 then begin nc:= ''''; n2 := n2a; end else ErrorPrint('Index Problem cannot find delimiter'); end; end; end; begin n1 := index(Attr,S); if n1<>0 then begin CheckAt2 := false; Txt := ''; FindDelim; Txt := right(Attr2,n2+1); n3 := index(Txt,nc); if n3<>0 then Txt := left(Txt,n3-1); AttrList := AttrList + '\<X'+S+'>('+Txt+')'; end else CheckAt2 := true; end; function CheckAt(S:AnyString) : Boolean; begin if index(attr,S)<>0 then begin AttrList := AttrList +'\'+S; CheckAt := false; end else CheckAt := true; end; procedure CheckAttribute; begin if CheckAt2('APPEND') then if CheckAt2('SORT') then if CheckAt('BEGIN') then if CheckAt('END') then if CheckAt('MASTER') then; end; procedure IndexPlusCom {(S:ShortString)}; var arg : AnyString; ucarg : AnyString; n1 : integer; begin if InNoFill then begin PutIndexHit(S,Arg1,Arg2,true); IndexHitsWaiting := true; end else begin ClearState; PutText(S+'('); ProcessIndexArg(arg2); AttrList := ''; arg := arg1; ucarg := UpCase(arg1); n1 := index(ucarg,','); while n1<>0 do begin Attr := left(ucarg,n1-1); Attr2 := left(arg,n1-1); UcArg := right(ucarg,n1+1); Arg := right(arg,n1+1); CheckAttribute; n1 := index(ucarg,','); end; Attr := UcArg; Attr2 := Arg; CheckAttribute; PutLine(AttrList+')'); end; end; procedure SetElement; var Arg : AnyString; begin if CurArgCount>1 then Arg := Arg2 else Arg := Arg1; if arg='RU' then ListType := 'ROMAN\UPPERCASE' else if arg = 'RL' then Listtype := 'ROMAN' else if arg ='LL' then ListType := 'ALPHABETIC' else if arg = 'LU' then ListType := 'ALPHABETIC\UPPERCASE' else ListType := 'NUMBERED'; end; procedure List; var ListEnumerator : AnyString; begin ClearState; ListDepth := ListDepth + 1; if arg2 ='' then PutLine('<LIST>('+ListType+')') else begin if arg2 = 'o' then ListEnumerator := '' else ListEnumerator := '\'+arg2; PutLine('<LIST>(UNNUMBERED'+ListENumerator+')'); end; end; procedure NumberList; var ListNum : ShortString; begin if ListDepth >0 then begin PutLine('<ENDLIST>'); If CurArgCount =2 then ListNum := arg2 else ListNum := arg1; PutLine('<LIST>(NUMBERED\'+ListNum+')'); end else ErrorPrint('.NMLS encountered outside a list'); end; procedure ListElement; begin ClearState; PutText('<LE>'); end; procedure EndList; begin ClearState; ListDepth := ListDepth - 1; If ListDepth < 0 then begin ErrorPrint('Unmatched .ELS'); ListDepth := 0; end else begin PutLine('<ENDLIST>'+AutoP); end; end; function RowSeparator(LitLine:WideLine) : Boolean; label RowSeparatorX; var i : integer; RowS : Boolean; begin RowS := false; if LitLine='' then RowS := true else begin for i:= 1 to length(LitLine) do begin if not (LitLine[i] in ['-','+','_','|',' ']) then goto RowSeparatorX; end; RowS := true; end; RowSeparatorX: RowSeparator := RowS; end; procedure ProcessTable; label HeadOne; var i,j,k : Integer; Guess : Integer; SplitWord : Boolean; function FindCols(LitLine:WideLine) : Integer; var j, savej : integer; BlankCount : integer; TextSeen : Boolean; begin Textseen:=false; BlankCount := 0; k := 1; ColPos[1] := 1; for j := 1 to length(litLine) do begin if LitLine[j] in [' ','|'] then begin BlankCount := BlankCount+1; end else begin if Textseen then begin if BlankCount >1 then begin k := k+1; if k<=9 then ColPos[k] := j else ErrorPrint('Maximum number of columns for DOCUMENT is 9'); end; end else TextSeen := true; BlankCount := 0; end; end; FindCols := k; end; function Trim(S:LongLine) : LongLine; label out1, out2; var i: Integer; begin for i := 1 to length(S) do begin if not (S[i] in [' ','|']) then begin S := right(S,i); goto out1; end; end; S:=''; goto out2; out1: for i := length(S) downto 1 do begin if not (S[i] in [' ','|']) then begin S := left(S,i); goto out2; end; end; out2: Trim := S; end; procedure Fill(colno:integer); label FillEx; var LitLength : Integer; p1,p1L,p1R,p2 : LongLine; c1,c2 : ShortString; LastCol : Boolean; begin LastCol := false; LitLength := length(Lit[LitPtr]); ColPos[colcount+1]:=LitLength+1; if colpos[colno] < LitLength then begin if colpos[colno+1] <LitLength then numcols := colpos[colno+1]-colpos[colno] else begin numcols := LitLength - ColPos[colno]+1; LastCol := true; end; if numcols <1 then begin ErrorPrint('Cannot determine number of columns'); TableAbort := true; goto FillEx; end; p1 := substr(Lit[Litptr],colpos[colno],numcols); if colno<>1 then p1L := left(Lit[LitPtr],colpos[colno]-1) else p1L:= ' '; if (length(p1L)>1) then c1 := right(p1L,length(P1L)) else c1 := ' '; if (not LastCol) and (colno<>colcount) and (length(p1)>1) then c2:= right(p1,length(p1)) else c2:=' '; if (c1<>' ') or (c2<>' ') then begin SplitWord := true; TableAbort := true; end; p1 := trim(p1); p2 := trim(col[colno]); if length(p1)+length(p2)+1 > LongLineSize then begin ErrorPrint('Excessively long text -- indicates error'); TableAbort := true end else col[colno] := p2+' '+p1+' '; end; FillEx: end; procedure SplitErr; var i,j:integer; LocString : WideLine; begin ErrorPrint('Column division requires splitting in mid-word '); Errorprint2(Lit[LitPtr]); LocString :='^'; for j := 1 to ColCount-1 do begin for i := ColPos[j]+1 to ColPos[j+1]-1 do LocString := LocString+' '; LocString := LocString+'^'; end; ErrorPrint2(LocString); end; procedure Divide; var i,j : Integer; begin ClearCols; for LitPtr := 1 to LitMax do begin if RowSeparator(Lit[LitPtr]) then WriteRow else begin if (RowMax<3) then writerow; SplitWord := false; for j := 1 to ColCount do Fill(j); If SplitWord then SplitErr; end; end; WriteRow; end; procedure SaveColPos; var i : Integer; begin ColCount := NewColCount; for i := 1 to ColCount do HColPos[i] := ColPos[i]; end; procedure PutTabLit; var i: integer; begin ErrorPrint('Cannot create table -- using code example'); PutLine(HoldTab[1]); Putline('<TABLE_SETUP>(2\10)'); PutLine('<TABLE_ROW>(\)'); PutLine('<ENDTABLE>'); PutLine('<CODE_EXAMPLE>'); if not Zlit then PutLine('<LITERAL>'); for i := 1 to LitMax do begin LiteralLine := Lit[i]; if ZLit then begin P :=1; InputLine := LiteralLine+EOL; ProcessText; PutEol; end else PutLine(LiteralLine); end; TableFlag := false; for i := 1 to HoldTabPtr do writeln(ListFileVar,HoldTab[i]); end; procedure PutTabTab; begin for i := 1 to HoldTabPtr do begin PutLine(HoldTab[i]); end; end; var ColStr : ShortString; begin {ProcessTable} TableAbort := false; SaveP := P; Guess := 0; ColCount := 0; for i := 1 to LitMax do begin case guess of 0: if not RowSeparator(Lit[i]) then begin Guess := 1; NewColCount := FindCols(Lit[i]); if ColCount<=NewColCount then SaveColPos; end; 1: if RowSeparator(Lit[i]) then Guess:= 2 else begin NewColCount := FindCols(Lit[i]); if ColCount<=NewColCount then SaveColPos; end; 2: if not RowSeparator(Lit[i]) then begin HeadColCount := ColCount; for j := 1 to ColCount do HeadColPos[j]:=ColPos[j]; Guess := 3; NewColCount := FindCols(Lit[i]); if ColCount=NewColCount then SaveColPos; end; 3: if Rowseparator(lit[i]) then begin goto HeadONe; end else begin NewColCount := FindCols(Lit[i]); if ColCount=NewColCount then SaveColPos; end; end; end; HeadOne: if (guess <3) then begin TableAbort := true; ErrorPrint('Table does not have heading and first row'); end else if (colcount<2) or (colcount>9) then begin TableAbort := true; writev(ColStr,ColCount); ErrorPrint('Column estimate '+ColStr +' not acceptable'); end else begin if HeadColCount=ColCount then begin for i:=1 to ColCount do if HeadColPos[i]<ColPos[i] then ColPos[i]:=HeadColPos[i]; end else begin ColCount := HeadColCount; for i := 1 to ColCount do ColPos[i]:=HeadColPos[i]; end; WriteHeader; Divide; end; if TableAbort then PutTabLit else PutTabTab; TableAbort := false; P := SaveP; end; procedure TestPage; begin If RTBFile then begin ClearState; NullCaption := true; ProcessRTB; end; end; procedure StartFigure; begin PutLine('<'+FigExName+'>'+FigureCaption); PutLine('<'+FigExName+'_ATTRIBUTES>(KEEP)'); PutLine('<LINE_ART>'); end; procedure PutTableLine; var LitLine : WideLine; begin LitLine:= Left(LiteralLine,Length(LiteralLine)-1); if RowSeparator(LitLine) then begin if InTable then begin RowMax := RowMax+1; end; end else InTable := true; if InTable then begin Lit[LitPtr] := LitLine; LitPtr := LitPtr+1; end; end; procedure Literal; var More: Boolean; begin InLiteral := true; ClearState; if (arg1='Z') or (arg2='Z') then ZLit := true else ZLit := false; if not FigureFlag and not TableFlag then begin if CheckPipe(XZCAP) then FormZCAP else if CheckPipe(XHF) then FormHF else if CheckPipe(XHE) then FormHE else if CheckPipe(XHT) then FormHT; end; if FigureFlag then StartFigure else if TableFlag then PutTable else if ZLit then PutLine('<CODE_EXAMPLE>') else PutLIne('<CODE_EXAMPLE><LITERAL>'); More:=true; if ZLit then begin SaveInputLine := InputLine; SaveP := P; end; while More do begin if eof(LiteralFileVar) then More:=false else begin readln(LiteralFileVar,LiteralLine); if LiteralLine[1] = ENDOFLITERAL then More:=false else if TableFlag then PutTableLine else if ZLit then begin P :=1; InputLine := Left(LiteralLine,Length(LiteralLine)-1)+EOL; ProcessText; PutEol; end else PutLine(Left(LiteralLine,Length(LiteralLine)-1)); end; end; if TableFlag then begin LitMax := LitPtr-1; ProcessTable; end; if ZLit then begin P := SaveP; InputLine := SaveInputLine; end; end; procedure EndLiteral; begin ClearState; ClearFlagState; if FigureFlag then begin PutLine('<ENDLINE_ART>'); PutLine('<END'+FigExName+'>'+AutoP); FigureFlag := false; end else if TableFlag then begin Putline('<ENDTABLE>'+AutoP); TableFlag := false; end else if ZLit then PutLine ('<ENDCODE_EXAMPLE>'+AutoP) else PutLIne('<ENDLITERAL><ENDCODE_EXAMPLE>'+AutoP); InLiteral := false; end; procedure FootNote; var I,LineLim : integer; begin PutLine('<FOOTNOTE>(1\'); if CurArgCount=1 then begin readv(Arg1,LineLim); ProcessText; PutEOL; for i:=1 to LineLim-1 do begin GetLine; ProcessText; PutEOL; end; PutLine(')'); end else InFootNote := true; end; procedure EndFootNote; begin if InFootNote then begin PutLine(')'); InFootNote := false; end else ErrorPrint('.EFN without .FN'); end; procedure Note; var NoteWord : AnyString; begin ClearState; if arg1='' then NoteWord := '' else NoteWord := '('+arg1+')'; PutArg('<NOTE>',Noteword,''); end; procedure EndNote; begin PutLine('<ENDNOTE>'+AutoP); end; procedure Para; begin If InNoFill then PutLine(' ') else PutLine('<P>'); end; procedure Require; var NewExt : SHortString; begin FileName := arg1; LogicalName := arg1; TranslateLogicalName; CheckExtension; if not InProfile then begin NewExt := '.SDML'; PutLine('<INCLUDE>('+FilePart+NewExt +')'); end; if FileIndex < MaxFileIndex then begin FileIndex := FileIndex+1; If not InProfile then OutFileIndex := OutFileIndex + 1; OpenFiles; end else ErrorPrint('Require file too deeply nested; Skipped it'); end; procedure SendTableOfContents; begin if UpCase(arg2) = 'PREFACE' then begin if FrontMatter=false then Begin PutLine('<FRONT_MATTER>'); FrontMatter := true; end; Putline('<PREFACE>'); Preface := true; end else if UpCase(arg2) = 'GLOSSARY' then begin ClearBlock; PutLine('<GLOSSARY>'); Glossary := true; end; end; procedure Caption; begin FormZCAP; if FigureFlag then begin FigureSearch; end else if Tableflag then TableSearch else begin ProcessArg(Arg1); PutLine(''); end; end; procedure BeginBars; begin BarCount := BarCount +1; if BarCount = 1 then PutLine('<MARK>') else ErrorPrint('Nested bars ignored'); end; procedure Revision; begin if NoRevisionYet then begin PutLIne('<REVISION>'); NoRevisionYet := False; end; end; procedure EndBars; begin if BarCount <> 0 then begin BarCount := BarCount -1; if BarCount = 0 then PutLine('<ENDMARK>') else Errorprint('Nested endbars ignored'); end; end; procedure Qualifiers; begin ErrorPrint('Changing Qualifier Settings -- '+Arg1); { ParamString := arg1; if CheckQual('DEFLIST') then NoDefList := false; if CheckQual('NODEFLIST') then NoDefList := true; if CheckQual('KEY') then NoKey := false; if CheckQual('NOKEY') then NoKey := true; if CheckQual('LIST') then Listing := false; if CheckQual('NOLIST') then Listing := true; } end; procedure SetTabs; var i,n1 : Integer; begin TabStopLim := CurArgCount; for i := 1 to curargcount do begin n1 := index(curarglist,EOL); if (n1>1) and (i<=TabStopMax) then readv(left(Curarglist,n1-1),TabStop[i]); CurArgList := right(CurArgList,n1+1); end; end; procedure RefPoint; begin end; procedure RefWord(Com:char); var FoundIndex: integer; TempCode: TypeRefWordCode; OK: Boolean; I: integer; begin OK:=true; if arg1='Figure' then TempCode:='F' else if arg1='Table' then TempCode:='T' else if arg1='Example' then TempCode:='E' else if arg1='Chapter' then TempCode:='C' else if arg1='Appendix' then TempCode:='A' else if arg1='Section' then TempCode:='S' else begin OK:=false; ErrorPrint('Invalid .ZW'+Com+': first argument not a reference word'); end; if arg2='' then begin OK:=false; ErrorPrint('Invalid .ZW'+Com+': second parameter missing'); end; if OK then begin FoundIndex:=0; for I := 1 to RefWordFree-1 do begin if (RefWordTable[I].Code = TempCode) and (RefWordTable[I].Word = Arg2) then begin FoundIndex:=I; end; end; if Com='C' then begin if FoundIndex = 0 then begin if RefWordFree <= MaxRefWordTable then begin RefWordTable[RefWordFree].Code := TempCode; RefWordTable[RefWordFree].Word := Arg2; RefWordFree:=RefWordFree+1; end else ErrorPrint('Cannot do .ZWC because reference word table is full'); end else ErrorPrint('Ignored .ZWC because refword is already in table'); end else begin if FoundIndex <> 0 then begin RefWordFree:=RefWordFree-1; for I:=FoundIndex to RefWordFree-1 do begin RefWordTable[I]:=RefWordTable[I+1]; end; end else ErrorPrint('Invalid .ZWD: given parameter pair is not in table'); end; end; end; procedure BeginAbstract; begin if InProfile then begin if not InElement and not PrefaceWritten then begin Abstract := true; end; end; end; procedure BeginPreface; begin if InProfile then begin Preface := true; OutFront1; end; end; procedure EndAbstract; begin if InProfile then begin if Abstract then begin Abstract := false; AbstractWritten := true; end; end; end; procedure EndPreface; begin if InProfile then begin if Preface then begin Preface := false; PrefaceWritten := true; end; end; end; procedure SaveState(C:char); var I: integer; begin if SaveStackSize < MaxSaveStack then begin SaveStackSize := SaveStackSize+1; with SaveStack[SaveStackSize] do begin QSaveAll := (C='A'); QFlagsChar := FlagsChar; QFlagsCur := FlagsCur; QFlagsSaved := FlagsSaved; QFlagsAllOn := FlagsAllOn; QCommentFlagCur := CommentFlagCur; QControlFlagCur := ControlFlagCur; QCommentFlagChar := CommentFlagChar; QControlFlagChar := ControlFlagChar; QBoldingEnabled := BoldingEnabled; QHyphenationEnabled := HyphenationEnabled; QIndexingEnabled := IndexingEnabled; QOverstrikingEnabled := OverstrikingEnabled; QUnderliningEnabled := UnderliningEnabled; QInNoFill := InNoFill; QKeepOn := KeepOn; for I:=1 to TabStopMax do begin QTabStop[I] := TabStop[I]; end; QTabStopLim := TabStopLim; QAutoPara := AutoPara; end; end else ErrorPrint('Stack for SAVE command overflowed'); end; procedure RestoreState; var I: integer; begin if SaveStackSize > 0 then begin with SaveStack[SaveStackSize] do begin FlagsChar := QFlagsChar; FlagsCur := QFlagsCur; FlagsSaved := QFlagsSaved; FlagsAllOn := QFlagsAllOn; CommentFlagCur := QCommentFlagCur; ControlFlagCur := QControlFlagCur; CommentFlagChar := QCommentFlagChar; ControlFlagChar := QControlFlagChar; BoldingEnabled := QBoldingEnabled; HyphenationEnabled := QHyphenationEnabled; IndexingEnabled := QIndexingEnabled; OverstrikingEnabled := QOverstrikingEnabled; UnderliningEnabled := QUnderliningEnabled; InNoFill := QInNoFill; KeepOn := QKeepOn; for I:=1 to TabStopMax do begin TabStop[I] := QTabStop[I]; end; TabStopLim := QTabStopLim; if QSaveAll then AutoPara := QAutoPara; end; SaveStackSize := SaveStackSize-1; ClearDefList; end else ErrorPrint('Save Stack empty when RESTORE command occurred'); end; {***************************************************************} { } { Dispatch Routine } procedure Dispatch; begin UnpackCommand(PipePtr); if EnableInteraction then begin write('FrPipe.. '); DumpCom(CurLineNumber,CurComNumber,CurArgCount,CurArgList); end; case CurComNumber of xUnDef: InvalidCom; xBANG : If not IncludeSource then PutLine('<COMMENT>('+Arg1+')') ; xAJ : IgnoreCom; xAP : AutoPara := true; xAST : IgnoreCom; xAT : IgnoreCom; xATI : IgnoreCom; xAX : AppendixName; xB : Blanks; xBB : BeginBars; xBR : CondOutput('<LINE>'); xBT : DecideLater; xC : Just('CENTER'); xCC : DecideLater; xCH : ChapterName; xCOM : CommentCom; xD : IgnoreCom; xDAX : IgnoreCom; xDBB : DoLater; xDBO : BoldingEnabled:=false; xDC : DecideLater; xDCH : IgnoreCom; xDCR : IgnoreCom; xDEX : IgnoreCom; xDFG : IgnoreCom; xDHL : IgnoreCom; xDHY : HyphenationEnabled:=false; xDIX : IndexingEnabled:=false; xDLE : SetElement; xDNM : IgnoreCom; xDOV : OverstrikingEnabled:=false; xDSP : IgnoreCom; xDT : DoRTBTable; xDTB : DoRTBTable; xDTC : DecideLater; xDUL : UnderliningEnabled:=false; xDX : IgnoreCom; xDXP : DecideLater; xEB : EndBars; xEBB : Revision; xEBO : BoldingEnabled:=true; xEFN : EndFootNote; xEHY : HyphenationEnabled:=true; xEI : EndIfCondition; xEIX : IndexingEnabled:=true; xEL : EndLiteral; xELS : EndList; xELSE : ElseCondition; xEN : EndNote; xEOV : OverstrikingEnabled:=true; xES : IgnoreCom; xETC : DecideLater; xETN : If InTopNote then InTopNote := false; xEUN : UnderliningEnabled:=true; xEXP : DecideLater; xF : Fill ; xFG : Figure('KEEP'); xFGD : Figure('FLOAT'); xFL : Flags; xFN : FootNote; xFT : IgnoreCom; xFTA : IgnoreCom; xHD : IgnoreCom; xHE : HeaderExample; xHF : HeaderFigure; xHL : HeaderLevel; xHT : HeaderTable; xI : Indent; xIF : IfCondition(''); xIN : IfCondition('NOT'); xJ : IgnoreCom; xK : KeepOn := true; xLE : ListElement; xLM : LeftMargin; xLO : IgnoreCom; xLS : List; xLT : Literal; xNAJ : IgnoreCom; xNAP : AutoPara := False; xNAST : IgnoreCom; xNAT : IgnoreCom; xNATI : IgnoreCom; xNC : IgnoreCom; xNCC : IgnoreCom; xND : IgnoreCom; xNF : NoFill; xNFL : FlagsOff; xNHD : IgnoreCom; xNJ : IgnoreCom; xNK : KeepOn := false; xNMA : AppendixLetter; xNMCH : ChapterNumber; xNMEX : DecideLater; xNMF : DecideLater; xNMFG : DecideLater; xNMLS : NumberList; xNMLV : ForbiddenCommand; xNMN : IgnoreCom; xNMPG : IgnoreCom; xNMR : IgnoreCom; xNMSPG: IgnoreCom; xNMTB : DecideLater; xNNMF : DecideLater; xNPA : IgnoreCom; xNPR : IgnoreCom; xNSP : IgnoreCom; xNST : IgnoreCom; xNT : Note; xNTN : DecideLater; xP : Para; xPA : IgnoreCom; xPG : if PagingOn then PutLine('<PAGE>'); xPR : IgnoreCom; xPS : IgnoreCom; xR : Just('RIGHT'); xREF : ForbiddenCommand; xREQ : Require; xRES : RestoreState; xRM : ForbiddenCommand; xRPT : RepeatString; xS : Para; xSALL : SaveState('A'); xSAVE : SaveState(' '); xSCNT : ForbiddenCommand; xSCO : SendTableOfContents; xSDT : DecideLater; xSL : SetHeaderLevel; xSP : IgnoreCom; xSPG : IgnoreCom; xSPR : Indent; xST : IgnoreCom; xSTAX : IgnoreCom; xSTCH : IgnoreCom; xSTEX : IgnoreCom; xSTFG : IgnoreCom; xSTHL : IgnoreCom; xSTM : DecideLater; xSTTB : IgnoreCom; xSTXT : SetTextString; xT : IgnoreCom; xTN : InTopNote := true; xTP : TestPage; xTS : SetTabs; xVR : DecideLater; xX : IndexCom('<X>'); xXL : DecideLater; xXP : IndexPlusCom('<X>'); xXU : DecideLater; xY : IndexCom('<Y>'); xYP : IndexPlusCom('<Y>'); xZBA : BeginAbstract; xZBP : BeginPreface; xZEA : EndAbstract; xZEP : EndPreface; xZWC : RefWord('C'); xZWD : RefWord('D'); xZCAP : Caption; xZQUAL: Qualifiers; end; end; {***************************************************************} { } { Document Code Generation } procedure UnpackCommand{(I:integer)}; var Start,Stop : integer; J: integer; Temp: AnyString; ComString: AnyString; begin CurLineNumber:=Pipe[I].LineNumber; CurComNumber:=Pipe[I].ComNumber; ComString:=ComTable[CurComNumber].CS; CurArgCount:=Pipe[I].ArgCount; CurArgList:=Pipe[I].ArgList; if CurArgCount > 0 then begin Stop:=Index(CurArgList,ArgEnd); Arg1:=substr(CurArgList,1,Stop-1); if CurArgCount > 1 then begin Temp:=substr(CurArgList,Stop+1,Length(CurArgList)-Stop); Stop:=Index(Temp,ArgEnd); Arg2:=substr(Temp,1,Stop-1); if CurArgCount > 2 then begin Temp:=substr(Temp,Stop+1,Length(Temp)-Stop); Stop:=Index(Temp,ArgEnd); Arg3:=substr(Temp,1,Stop-1); end else Arg3:=''; end else Arg2:=''; end else Arg1:=''; end; procedure PutPipe; { If running interactively, display contents of pipe. { If a literal has been written to the literal file, "rewind" the { file and prepare it for reading (within the Literal routine). { Scan the pipe for false ZCap commands. Each time one it found, { process the preceding commands (since the beginning or the last { false ZCap) with PipePtr selecting the current line of the { pipeline and PipeSize pointing the the line before the false { ZCap (and thus providing a "false bottom" for the pipeline). { Then process the false ZCap itself, treating its argument as { a line of text, and resume the scan. { When the scan is complete, process any commands that were in the { pipe between the last false ZCAP (or, if none, the beginning of { the pipeline) and the end of the pipe. { Set size of pipe to 0 (showing it has been emptied) { If the literal file was used, "rewind" it and prepare it for writing { out of the next literal. } var J: integer; I: integer; IsTrueSize: integer; TruePipeSize: integer; MorePipe: Boolean; SavePipeSize: integer; PrevBreak: Boolean; PrevBreakLoc : Integer; PostBreak: Boolean; PostBreakLoc : Integer; BlankCount : Integer; StartI: integer; function IsTrueZCap: Boolean; { Assumes that the current command is a ZCAP. Otherwise returns { true if the current command is a ZCap that derives from a CENTER or { RIGHT command. Otherwise, returns true if ZCap is both preceded by { and followed by a command that causes a break. Otherwise, returns { false. In looking for a command that causes a break, another ZCap { may be encountered; in this case, the ZCap causes a break if it { derives from a CENTER or RIGHT command and does not cause a break if { it derives from a line of text. } label Done; begin if Pipe[I].ArgList[1] <> 'T' then begin IsTrueZCap:=true; PrevBreak := false; PostBreak := false; end else begin PostBreak:=false; for J:=I+1 to TruePipeSize do begin if ComTable[Pipe[J].ComNumber].CB in [BREAK,SECBREAK] then begin PostBreakLoc := j; PostBreak := true; goto Done; end; if Pipe[J].ComNumber=xZCAP then begin PostBreak := (Pipe[J].ArgList[1] <> 'T'); goto Done; end; end; Done: IsTrueZCap := PrevBreak and PostBreak; end; end; procedure DoFalseZCap; var SaveInputLine: AnyString; SaveP: integer; K: integer; begin SaveInputLine := InputLine; SaveP := P; UnpackCommand(I); InputLine := Arg2+EOL; P := 1; ProcessText; PutEOL; P := SaveP; InputLine := SaveInputLine; end; begin if EnableInteraction then DumpPipe; if LiteralInPipe then reset(LiteralFileVar); StartI:=1; TruePipeSize:=PipeSize; PrevBreak:=false; for I := 1 to TruePipeSize do begin if ComTable[Pipe[I].ComNumber].CB in [BREAK,SECBREAK] then begin PrevBreak:=true; PrevBreakLoc := i; end; if Pipe[I].ComNumber=xZCAP then begin if not IsTrueZCap then begin PipeSize:=I-1; for PipePtr := StartI to PipeSize do begin Dispatch; end; DoFalseZCap; StartI:=I+1; PrevBreak:=false; end else begin if (PrevBreak) then begin if (Pipe[prevBreakLoc].ComNumber=XB) or (Pipe[PrevBreakLoc].ComNumber=xS) then Pipe[PrevBreakLoc].ComNumber := xNOP; end; if (PostBreak) then begin if (Pipe[PostBreakLoc].ComNumber=XB) or (Pipe[PostBreakLoc].ComNumber=xS) then begin if Length(Pipe[I].ArgList)=0 then BlankCount:=1 else BlankCount:=StringToInteger(Pipe[I].ArgList); if BlankCount<3 then Pipe[PostBreakLoc].ComNumber := xNOP; end; end; end; end; end; PipeSize:=TruePipeSize; for PipePtr := StartI to TruePipeSize do begin Dispatch; end; if LiteralInPipe then begin rewrite(LiteralFileVar); LiteralInPipe:=false; end; PipeSize := 0; end; function CapLine{: Boolean}; var Pos: integer; P: integer; Front: AnyString; Middle: AnyString; Back: AnyString; I: integer; function RefOK: Boolean; function MoveDigit: Boolean; begin if IsDigit(Back[P]) then begin Middle:=Middle+Back[P]; P:=P+1; MoveDigit:=true; end else MoveDigit:=false; end; var OK: Boolean; Sep: char; begin Middle:=RefWordTable[I].Code; P:=Pos+Length(RefWordTable[I].Word); if Pos > 1 then begin OK := not IsLetterOrDigit(Back[Pos-1]); end else OK := true; if OK then begin if Back[P]<>EOL then begin if Back[P] in [' ',FlagsCur[cSPACE] ] then begin P:=P+1; if Back[P]<>EOL then begin if Back[P] in [' ',FlagsCur[cSPACE] ] then P:=P+1; end; if IsLetterOrDigit(Back[P]) then begin if IsDigit(Back[P]) then while MoveDigit do else begin Middle:=Middle+Back[P]; P:=P+1; end; while OK and ((Back[P]='.') or (Back[P]='-')) do begin if Back[P]='.' then Sep:='P' else Sep:='H'; P:=P+1; if IsDigit(Back[P]) then begin Middle:=Middle+Sep; while MoveDigit do; end else OK:=false; end; if (not OK) and (Sep='P') then begin P:=P-1; OK:=true; end else if OK and IsDigit(Back[P-1]) then begin if IsLetter(Back[P]) then begin Middle:=Middle+Back[P]; P:=P+1; end; end; if IsLetterOrDigit(Back[P]) then OK:=false; end else OK:=false end else OK:=false; end else OK:= false; end; RefOK:=OK; end; var More: Boolean; RefWordCount: integer; SaveRefCode: char; SavePos: integer; Code: char; begin RefWordCount := 0; for I := 1 to RefWordFree-1 do begin Front := ''; Back := InputLine; More := true; while More do begin Pos:=index(Back,RefWordTable[I].Word); if Pos = 0 then More := false else begin if RefOK then begin Front:=Front+Left(Back,Pos-1)+RefStartChar+Middle+RefStopChar; RefWordCount := RefWordCount+1; SaveRefCode := RefWordTable[I].Code; SavePos := Pos; end else Front:=Front+Left(Back,P-1); Back := Right(Back,P); end; end; InputLine := Front+Back; end; if ImplicitCaption and (RefWordCount=1) and ( (SaveRefCode='F') or (SaveRefCode='E') or (SaveRefCode='T') ) then begin CapLine:=true; for I:=1 to SavePos-1 do begin if IsLetterOrDigit(InputLine[I]) then CapLine:=false; end; end else CapLine:=false; end; {***************************************************************} { } { Main Routines } procedure GetDoc; var More : Boolean; { Called by Main. { Begins by setting pipeline to empty. { Processes the input (DSR) file one line at a time, as follows: { If InLiteral is true, { if .END LITERAL, negate InLiteral and redo, else send straight out. { Interprets the beginning of each line as follows: { Two control-flag characters (..): Entire line is text. { Control-flag and comment-flag (.!): Begins with a comment. { Control-flag and semicolon (.;): Begins with a comment. { Control-flag and anything else: Begins with a command. { Does not begin with control-flag: Entire line is text. { When the line begins with a command or comment, the routine { processes that construct and then interprets the beginning { of the remainder of the line as follows: { End-of-line character (EOL): Line finished. { Semicolon: Remainder of line (after semicolon) is text. { Comment-flag: Begins with a comment. { Control-flag: Begins with a command. { Anything else: Begins with junk. { This interpretation is applied repeatedly to the remainder { of the line until it begins with an EOL. { Before processing text or literal, the command pipeline is { flushed, and after the last line is processed, it is flushed { again. } procedure AllText; { Discard portion of InputLine before P. { If the line begins with a reference, make it into a ZCap command, { and take that as the new input line; { otherwise, if blank line , get a new input line { otherwise, process pipe, output current line as text, and get a { new input line. } begin if Length(InputLine) > P-1 then begin InputLine:=substr(InputLine,P,Length(InputLine)-(P-1)); P:=1; end; if (Length(InputLine)=1) then begin if AutoPara then begin if InNofill then begin Putline(''); More := GetLine; end else InputLine := '.B'+EOL; end else begin if InNofill and KeepOn then PutLine(''); More := GetLine; end end else if CapLine then begin InputLine := '.ZCAP T0 '+InputLine; end else begin if PipeSize > 0 then PutPipe; if InDefList and StartLine then SplitLine else ProcessText; PutLine(''); More:=GetLine; end; end; procedure OutputComs; var Count: integer; begin Count:=P; if Count > Length(InputLine)-1 then Count:=Length(InputLine)-1; if Count > 0 then begin PutText('<COMMENT>('); PutText(Left(InputLine,Count)); PutLine(')'); end; end; begin PipeSize:=0; More:=GetLine; while More do begin if InLiteral then begin if IsEndLiteral then begin InLiteral := false; writeln(LiteralFileVar,ENDOFLITERAL); end else begin writeln(LiteralFileVar,InputLine); More:=GetLine; end; end else if GetC(ControlFlagCur) then begin if GetC(ControlFlagCur) then AllText else begin if GetC(';') then GetComment else if GetC(CommentFlagCur) then GetComment else GetCommand; while (InputLine[P] <> EOL) and (InputLine[P] <> ';') do begin if GetC(CommentFlagCur) then GetComment else if GetC(ControlFlagCur) then GetCommand else GetJunk; end; if IncludeSource then OutputComs; if GetC(';') then {nothing} else More:=GetLine; end; end else AllText; end; if PipeSize > 0 then PutPipe; end; procedure Init; { Called by Main. { Initialize variables. } var I: integer; begin SaveStackSize := 0; KeepOn := false; EnableInteraction := false; ErrorsInList := false; CommentFlagChar := '!'; ControlFlagChar := '.'; FlagsChar:='_*|<=>\~%+#>$&^<|'+RefStartChar+RefStopChar; FlagsAllOn :=true; CommentFlagCur := CommentFlagChar; ControlFlagCur := ControlFlagChar; FlagsCur:=FlagsChar; FlagsCur[cBOLD] :=NoCode; FlagsCur[cBREAK] :=NoCode; FlagsCur[cCAPITALIZE] :=NoCode; FlagsCur[cHYPHENATE] :=NoCode; FlagsCur[cINDEX] :=NoCode; FlagsCur[cNOPERMUTE] :=NoCode; FlagsCur[cOVERSTRIKE] :=NoCode; FlagsCur[cPERIOD] :=NoCode; FlagsCur[cSUBSTITUTE] :=NoCode; FlagsSaved:=FlagsCur; FlagsAllOff:=FlagsChar; FlagsAllOff[cACCEPT] :=NoCode; FlagsAllOff[cBOLD] :=NoCode; FlagsAllOff[cBREAK] :=NoCode; FlagsAllOff[cCAPITALIZE] :=NoCode; FlagsAllOff[cHYPHENATE] :=NoCode; FlagsAllOff[cINDEX] :=NoCode; FlagsAllOff[cLOWERCASE] :=NoCode; FlagsAllOff[cNOPERMUTE] :=NoCode; FlagsAllOff[cOVERSTRIKE] :=NoCode; FlagsAllOff[cPERIOD] :=NoCode; FlagsAllOff[cSPACE] :=NoCode; FlagsAllOff[cSUBINDEX] :=NoCode; FlagsAllOff[cSUBSTITUTE] :=NoCode; FlagsAllOff[cUNDERLINE] :=NoCode; FlagsAllOff[cUPPERCASE] :=NoCode; BoldingEnabled :=true; HyphenationEnabled :=true; IndexingEnabled :=true; OverstrikingEnabled :=true; UnderliningEnabled :=true; InAlign := false; InEmphasis := false; InUnderline := false; OK:=false; FigExName := 'FIGURE'; ListType := 'NUMBERED'; Preface:=false; ChapterFlag:=false; ChapterCount := 0; ChapterNUm := '0'; AppendixCount := 0; HLCounter := 1; TabCounter := 0; FigCounter := 0; ExCounter := 0; BackMatter:=false; Abstract := false; Preface := false; AbstractWritten := false; PrefaceWritten := false; AppendixFlag:=false; Glossary:=false; InDefList:=false; DefListCount := 0; Table:=false; InLiteral:=false; InFootNote := false; InNoFill := false; CodeExWaiting := false; InTopNote := false; InputLine:=''; OutputLine:=''; PipeSize:=0; RowOpen := false; SeriousError := false; NoRevisionYet := true; AutoPara := false; CurMargin := 0; RefWordTable[1]:= RefWordRecord ('F','Figure'); RefWordTable[2]:= RefWordRecord ('T','Table'); RefWordTable[3]:= RefWordRecord ('E','Example'); RefWordTable[4]:= RefWordRecord ('C','Chapter'); RefWordTable[5]:= RefWordRecord ('A','Appendix'); RefWordTable[6]:= RefWordRecord ('S','Section'); RefWordFree:=7; RefWD[1] := 'FIGURE'; RefWd[2] := 'TABLE'; RefWd[3] := 'CHAPTER'; RefWD[4] := 'APPENDIX'; RefWd[5] := 'SECTION'; for i := 1 to TabStopMax do Tabstop[i] := 8*i; TabStopLim := TabStopMax; ElementCode := 'A'; ElementTabMax := 1; InProfile := false; InElement := false; FileMessage[1] := 'is already open'; FileMessage[2] := 'has open error'; FileMessage[3] := 'not found'; FileMessage[4] := 'has invalid syntax'; FileMessage[5] := 'has unexpected error'; BarCount := 0; ReferenceLimit := 0; IndexLim := 0; IndexHitsWaiting := false; InitDebug; end; procedure Main; { Called by the main program block. { Initializes variables, salutes user, interprets command { that invoked this program, processes files, and signs off. } begin Init; writeln(NameId ); StartUp; GetDoc; end; begin Main; end.