home *** CD-ROM | disk | FTP | other *** search
Text File | 1990-05-29 | 73.9 KB | 2,416 lines |
- $MACRO_FILE DOCUMENT;
- {******************************************************************************
- MULTI-EDIT MACRO FILE DOCUMENT
- FPRINT - The print formatter
- FCMD - Top level menu for inserting print formatter
- F_CODE_SUBMENU - Sub level menu for inserting print formatter codes
- INSERT_F_CODES - Inserts codes for the print formatter
-
- (C) Copyright 1989 by American Cybernetics, Inc.
- ******************************************************************************}
-
- $MACRO FPRINT TRANS;
- {******************************************************************************
- MULTI-EDIT MACRO
-
- Name: FPRINT
-
- Description: This macro is a pretty printer utility which decodes special
- formatting chars to perform word processing formatting.
-
- Current Formatting Commands:
-
- Command Default Function
-
- .pb n n=+1 Page break(start page number n)
- The form feed character(ASCII 12) will also perform a page break. The
- difference is there is no page number parameter. Instead, there is an optional
- parameter that will force the next printed page to be even or odd. If it is a
- 1 then it will be odd. If 2, it will be even. If omitted or anything else, it
- will paginate normally. A closely related command is the ".bp".
-
- .ff n n=0 Use form feed characters at the end of each page. 0 = off
- anything else = on.
- .bp n n=0 Put headers an footers on blank pages due to forced even/
- odd parameter after form feed page break. 0 means no, 1
- means yes.
- .ce Center this line
- .df n str Empty Define footer. if n = 2 then footer will be footer 2
- .dh n str Empty Define header. if n = 2 then header will be header 2
- .sf Supress footer this page
- .sh Supress header this page
- .ls n n=1 Line spacing is n
- .pl n n=66 Set page length to n
- .rm n n=80 Set right margin to n
- .lm n n=1 Set left margin to n
- .ig Ignore, do not decode this line.
- .tm n n=5 Set top margin to n
- .bm n n=60 Set bottom margin to n
- .hm n n=2 Set header margin to n
- .fm n n=64 Set footer margin to n
- .np Don't print this line
-
- User definable formatting commands:
- These are "macro" type formatting commands which the user can define. Since
- they are processed in a "search and replace" type manner, they can be very
- versitile. In defining, everything to the right of the command is considered
- to be part of the definition. Whenever a mactching execute command is
- encountered, the command is replaced by the definition string. Anything(normal
- text, other commands, etc.) will be processed as though it were imbedded at
- the point of the execution command. The value of n can be from 1 to 10.
- One caution: If the insertion of the definition string results in a string
- length which exeeds 255, the definition string will be truncated until it fits,
- yielding unpredictable results.
-
- .du n n=1 Define user formatting command n
- .ud n n=1 Execute user formmating command n
-
- Printer specific formatting commands:
- These commands are used in conjuction with the global variable "Printer_Type".
- These codes are set up via the Modify Printer Codes option in either the Print
- macro or the Install macro. Typical examples would be:
- .ub Underline begin
- .ue Underline end
-
- These correspond to printer specific control codes set up by the user. Any code
- in the text which matches a code set up for the current printer type will be
- replaced by that code. Since these are completely user definable, it is the
- responsibility of the user to put the correct codes as defined in his printer
- type, and to insure there are no conflicts between user defined printer codes
- and fprint's formatting codes. As it stands right now, fprint's codes will
- take precedence.
-
- Current Formatting variables:
-
- Code Name
-
- .fn File name
- .ti Time
- .da Date
- .pa Page number
-
- Table of contents generator:
- To create a table of contents, the user must define a table of contents, then
- add table entry codes.
-
- .tc Define table of contents. At least 2 parameters are expected, and up
- to 12 will be recognized. The first parameter will determine the
- right margin for all levels. The second will determine whether or
- not to pad the void between each table entry and the corresponding
- page number with spaces or with periods(.). The third will determine
- the amount of indenting for the first level. The fourth determines
- the format of the first level. The 3rd and 4th are repeated for each
- of the 5 possible levels, and are read by the program as pairs.
-
- 0 = plain EXAMPLE: COMPILING A MACRO 10
- 1 = numeric EXAMPLE: 1. COMPILING A MACRO 10
- 2 = alpha EXAMPLE: A. COMPILING A MACRO 10
- 3 = roman numeral EXAMPLE: I. COMPILING A MACRO 10
-
- .te One parameter is expected, which is the table level of the current
- Table entry. Everything on this line beginning with the first word
- after the parameter and up to the delimiter "(" or more than one
- space will be considered part of the table entry.
-
- INDEX GENERATOR
- We have started an index generator. Although too primitive to mention in the
- manual, it does have the ability to create an unformatted index. The index
- generator is activated automatically by the first occurance of an index
- definition:
-
- .X[heading^sub heading]
-
- Whatever is inside the [] will appear in the index. The entire definition will
- be stripped from the body of the document. Subheadings are optional, but there
- must be a main heading before the caret^. The format of the generated index
- is:
-
- heading (page number)
- subheading1 (page number)
- subheading2 (page number)
-
- The index is sorted in alphabetically by heading and by subheading.
-
- (C) Copyright 1989 by American Cybernetics, Inc.
- ******************************************************************************}
-
- Def_Str(Line_In[2048],Line_Out,Command[2],Commands[80],Header1,Header2,Footer1,
- Footer2,Cur_Time[7],Cur_Date[8],Cur_File_Name[40],Blank_Line,Temp_String,
- Temp_Line_Out,Table_Line,Table_Page_Str[4],Temp_Param[10],
- Printer_Type[20],Attribute_Commands[40],Table_Delimits[40],
- Index_Main[80],Index_Sub[80],Percentage[4]);
-
- Def_Char(Code_Delimiter);
-
- Def_Int(End_Of_File,Cur_Page_Num,Text_Length,Val_Error,Param_Space,
- Page_Length,Cur_Line_Num,Top_Margin,Bottom_Margin,Left_Margin,
- Rght_Margin,Header_Margin,Footer_Margin,Comment,Supress_Header,
- Supress_Footer,Page_Break,Line_Spacing,New_Page_Num,Param_Pos,
- Delimiter_Pos,Temp_Integer,Text_Window,Print_Window,Move_Count,
- Making_Margin,Print_HF,Table_Window,Table_Style,Table_Indent,
- Table_Level,Table_Count,Table_Margin,Table_Count1,Table_Indent1,
- Table_Style1,Table_Count2,Table_Indent2,Table_Style2,Table_Count3,
- Table_Indent3,Table_Style3,Table_Count4,Table_Indent4,Table_Style4,
- Table_Count5,Table_Indent5,Table_Style5,Table_Defined,Periods,
- Table_Line_Num,Table_Page_Num,Abort,Todds_Jx,Todds_Jx2,Todds_Jx3,
- Todds_Jx4,HF_Toggle,For_Table,Parameter,Default,Temp_Flag,
- Leave_Blank,Blank_Page,Jx,Jy,Temp_Undo,Form_Feed,T_Reg_Exp_Stat,
- T_Insert_Mode,Index_Window,Footer_Set,Bottom_Set,Header_Copied,
- Footer_Copied,Supress_Table_Header,Supress_Table_Footer,F_Mode);
-
- Temp_Undo := Undo_Stat;
- Undo_Stat := False;
- T_Reg_Exp_Stat := Reg_Exp_Stat;
- Reg_Exp_Stat := True;
- T_Insert_Mode := Insert_Mode;
- Insert_Mode := True;
- Refresh := False;
- Messages := False;
- Abort := False;
- F_Mode := Parse_Int('/M=',MParm_Str);
- Code_Delimiter := Global_Str('Format_Code_Delimit');
- IF (Code_Delimiter = '|0') THEN
- Code_Delimiter := '.';
- END;
- Table_Delimits := '!@#^&()[]`"~\|<>{}*';
- Jx := XPos(Code_Delimiter,Table_Delimits,1);
- IF (Jx) THEN
- Table_Delimits := Str_Del(Table_Delimits,Jx,1);
- END;
- Working;
-
-
- Blank_Line := ' ';
- Printer_Type := Parse_Str('PT=',Global_Str('PRINTER_TYPE'));
- Put_Box(2,4,61,10,0,M_B_Color,'PRINT FORMATTER',True);
- Set_Global_Str('@PFEV#1','/T=Cancel/KC=<ESC>/K1=27/K2=1/R=1/W=11/X=25/Y=9');
- RM('CheckEvents /M=2/G=@PFEV#/#=1');
- If (Printer_Type = '') Then
- Write('Warning! Printer type is unspecified.',4,5,0,M_B_Color);
- Else
- Write('Printer type: ' + Printer_Type,4,5,0,M_B_Color);
- End;
- Write('Format code delimiter: ' + Code_Delimiter,4,6,0,M_B_Color);
- Write('Formatting: ' + Truncate_Path(File_Name) + ' for printing. ',4,7,0,M_B_Color);
- Write('░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░ 0% Complete.',4,8,0,M_B_Color);
-
- EOF;
- {Store last line of the file into a variable}
- End_Of_File := C_LINE;
- TOF;
- {Initialize Variables to defaults}
- Header1 := '';
- Header2 := '';
- Footer1 := '';
- Footer2 := '';
- HF_Toggle := True;
- Cur_Page_Num := 1;
- Cur_Line_Num := 1;
- Page_Length := 66;
- Left_Margin := 0;
- Rght_Margin := 80;
- Top_Margin := 5;
- Bottom_Margin := 60;
- Header_Margin := 2;
- Footer_Margin := 64;
- Footer_Set := False;
- Bottom_Set := False;
- Line_Spacing := 1;
- Supress_Header := False;
- Supress_Footer := False;
- Page_Break := False;
- Cur_File_Name := Caps(File_Name);
- Cur_Date := Date;
- Cur_Time := Copy(Time,1,5) + Copy(Time,9,2);
- Making_Margin := False;
- {Defaults for table of contents}
- Table_Defined := False;
- Table_Margin := 75;
- Periods := False;
- Table_Count1 := 0;
- Table_Count2 := 0;
- Table_Count3 := 0;
- Table_Count4 := 0;
- Table_Count5 := 0;
- Table_Indent1 := 0;
- Table_Indent2 := 5;
- Table_Indent3 := 10;
- Table_Indent4 := 15;
- Table_Indent5 := 20;
- Table_Style1 := 0;
- Table_Style2 := 0;
- Table_Style3 := 0;
- Table_Style4 := 0;
- Table_Style5 := 0;
- For_Table := False;
- Leave_Blank := 0;
- Blank_Page := 0;
- Form_Feed := 0;
- Print_HF := False;
- Supress_Table_Header := False;
- Supress_Table_Footer := False;
-
- {This is a global you would initialize in STARTUP if you wanted different
- defaults}
- IF (Global_Str('@FPRINT_DEFAULT@') <> '') THEN
- Line_In := Global_Str('@FPRINT_DEFAULT@');
- IF (XPos('/MODE=',Line_In,1)) THEN
- F_MODE := Parse_Int('/MODE=',Line_In);
- END;
- IF (XPos('/PL=',Line_In,1)) THEN
- Page_Length := Parse_Int('/PL=',Line_In);
- END;
- IF (XPos('/LM=',Line_In,1)) THEN
- Left_Margin := Parse_Int('/LM=',Line_In);
- END;
- IF (XPos('/RM=',Line_In,1)) THEN
- Rght_Margin := Parse_Int('/RM=',Line_In);
- END;
- IF (XPos('/TM=',Line_In,1)) THEN
- Top_Margin := Parse_Int('/TM=',Line_In);
- END;
- IF (XPos('/BM=',Line_In,1)) THEN
- Bottom_Margin := Parse_Int('/BM=',Line_In);
- END;
- IF (XPos('/HM=',Line_In,1)) THEN
- Header_Margin := Parse_Int('/HM=',Line_In);
- END;
- IF (XPos('/FM=',Line_In,1)) THEN
- Footer_Margin := Parse_Int('/FM=',Line_In);
- END;
- IF (XPos('/LS=',Line_In,1)) THEN
- Line_Spacing := Parse_Int('/LS=',Line_In);
- END;
- IF (XPos('/FF=',Line_In,1)) THEN
- Form_Feed := Parse_Int('/FF=',Line_In);
- END;
- IF (XPos('/DH1=',Line_In,1)) THEN
- Header1 := Parse_Str('/DH1=',Line_In);
- Header2 := Header1;
- END;
- IF (XPos('/DF1=',Line_In,1)) THEN
- Footer1 := Parse_Str('/DF1=',Line_In);
- Footer2 := Footer1;
- END;
- END;
-
- {The ascii 127 char delimiting the commands is there to prevent false
- interpretation of commands}
- IF (F_MODE) THEN
- Commands := '';
- ELSE
- Commands := 'PBDFDHSHSFLSPLRMLMNPTMBMHMFMTCTEIGBPDUUDFFX[';
- END;
- Text_Window := Window_Id;
- Temp_String := Caps(Truncate_Extension(File_Name));
- Line_In := Format_Line;
-
- {Create a window for the printable file if one does not already exist}
- Jx := 0;
-
- SEEK_PRT_WINDOW:
- ++Jx;
- Switch_Window(Jx);
- IF ((File_Name <> (Temp_String + '.PRT')) and
- (Jx < Window_Count)) THEN
- Goto SEEK_PRT_WINDOW;
- END;
-
- IF ((File_Name = (Temp_String + '.PRT')) and
- (Window_Id <> Text_Window)) THEN
- Erase_Window;
- ELSE
- Create_Window;
- END;
-
- Format_Line := Line_In;
- Print_Window := Window_Id;
- Line_Terminator := '|13';
- File_Name := Temp_String + '.PRT';
- Create_Window;
- Line_Terminator := '|13';
- Index_Window := Window_Id;
- File_Name := Temp_String + '.NDX';
- {Get printer specific data}
- {Add a trailing "" character to help in parsing later}
- {Create a string of all printer commands for this printer to use when stripping
- them out of a line}
- Attribute_Commands := '';
- IF (F_Mode = 0) THEN
- Jx := 1;
- WHILE (Jx < 19) DO
- Attribute_Commands := Attribute_Commands + Parse_Str('F' + Str(Jx) + '=',
- Global_Str('PRINTER_TYPE'));
- ++Jx;
- END;
- Attribute_Commands := Caps(Attribute_Commands);
- END;
-
- { special development code for testing execution time
- Def_Int(Start_Minutes,Start_Seconds,End_Minutes,End_Seconds);
- If ((Val(Start_Minutes,Copy(Time,4,2))) and (Val(Start_Seconds,Copy(Time,7,2)))) Then
- End;
- }
- Switch_Win_Id(Text_Window);
-
- {Set up variables for reporting percentage done}
- Todds_Jx3 := End_Of_File;
- If Todds_Jx3 < 20 then
- Todds_Jx3 := 20;
- END;
- Todds_Jx3 := Todds_Jx3 / 20;
-
- Todds_Jx4 := 0;
-
- {Main program loop}
-
- While (C_Line <= End_Of_File) Do
- {Report percentage done}
- ++Todds_Jx4;
- If Todds_Jx4 > 4 THEN
- Todds_Jx := (C_line * 5) / Todds_Jx3;
- If (Todds_Jx > 99) Then Todds_Jx := 99; End;
- Todds_Jx2 := (Todds_Jx * 2) / 5;
- Percentage := Str(Todds_jx);
-
- Write(Copy('▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓',1,Todds_Jx2) +
- Copy('░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░░',1,40 - Todds_Jx2) + ' ' +
- Copy(' ',1,3 - Svl(Percentage)) + Percentage + '% Complete.',4,8,0,M_B_Color);
- Todds_jx4 := 0;
- end;
-
- {Check for the user pressing <ESC>}
- If (Check_Key) Then
- If (Key1 = 27) Then
- MOU_ESC:
- Abort := True;
- Kill_Box;
- Goto END_OF_MAC;
- ELSif (key1 = 0) AND (key2 = 250) THEN
- RM('CheckEvents /G=@PFEV#/M=1/#=1');
- IF (Return_Int) THEN
- Goto MOU_ESC;
- END;
- End;
- End;
-
- Line_Out := '';
- Comment := False;
- Line_In := Get_Line;
- {Strip out HARD_CR if present}
- IF (Hard_Cr <> '|0') THEN
- STRIP_HARD_CR:
- Jx := XPos(Hard_Cr,Line_In,1);
- IF (Jx) THEN
- Line_In := Str_Del(Line_In,Jx,1);
- Goto STRIP_HARD_CR;
- END;
- END;
-
- {Page break char}
- If (XPos('|12',Line_In,1)) Then
- {This is the part that can force a new page to start on an even or odd page number}
- Default := 0;
- Line_In := Str_Del(Line_In,1,1);
- Call GET_PARAMETER;
- New_Page_Num := Cur_Page_Num + 1;
- Blank_Page := False;
- IF (Parameter = 2) THEN
- IF (New_Page_Num MOD 2) THEN
- Blank_Page := True;
- END;
- END;
- IF (Parameter = 1) THEN
- IF ((New_Page_Num MOD 2) = 0) THEN
- Blank_Page := True;
- END;
- END;
- Page_Break := True;
- Goto SKIP_PRINTING;
- End;
-
- {If the format code delimiter('.' default) is not in the line of text, bypass
- all this stuff and use as is.}
- If (XPos(Code_Delimiter,Line_In,1) = 0) Then
- Line_Out := Line_In;
-
- Goto NO_COMMAND;
- End;
-
- Temp_Integer := XPos(Code_Delimiter + 'IG',Caps(Line_In),1);
- If (Temp_Integer) Then {Ignore}
- If (Temp_Integer = XPos(Code_Delimiter,Line_In,1)) Then
- {If there is some text before this command, then output the line so far}
- If (Temp_Integer > 1) Then
- Temp_String := Copy(Line_In,1,Temp_Integer - 1);
- Line_Out := Line_Out + Temp_String;
- End;
- Line_In := Copy(Line_In,Temp_Integer + 3,SVL(Line_In) - Temp_Integer - 2);
- If (Line_Out <> '') Then
- Call Print_Line;
- End;
-
- {We put the formatted lines into a second window instead of sending directly to
- the printer or altering the original file. It would be possible to alter this
- macro to do either option. Feel especially ambitious today?}
-
- SWITCH_WIN_Id(Print_Window);
- Put_Line('|10' + Copy(Blank_Line,1,Left_Margin) + Line_In);
- DOWN;
- ++Cur_Line_Num;
- GOTO_COL(1);
- SWITCH_WIN_Id(Text_Window);
- Goto SKIP_PRINTING;
- End;
- End;
-
- While (SVL(Line_In) > 0) Do
- Delimiter_Pos := XPos(Code_Delimiter,Line_In,1);
- If (Delimiter_Pos = 0) Then
- Line_Out := Line_Out + Line_In;
- Line_In := '';
- Goto NO_COMMAND;
- Else
- {When a format code delimiter is detected, see if it is a command.}
- Line_Out := Line_Out + Copy(Line_In,1,Delimiter_Pos - 1);
- Temp_String := Copy(Line_In,Delimiter_Pos + 1,2);
- Line_In := Str_Del(Line_In,1,Delimiter_Pos + 2);
- Command := Caps(Temp_String);
- If ((XPos('' + Command + '',Commands,1) = 0) or (Command = '')) Then
- {If the suspected command is invalid, then treat it as if it were text.}
- Line_Out := Line_Out + Code_Delimiter + Temp_String;
- Else
- {At this point we are certain that we have a valid command}
-
- If (Command = 'DU') Then {Define user formatting command}
- {The remainder of the line is assumed to be part of the command definition so
- output the line so far}
- If (Line_Out <> '') and Not(Comment) Then
- Call Print_Line;
- End;
- Default := 1;
- Call GET_PARAMETER;
- If ((Parameter > 0) and (Parameter < 11)) Then
- Set_Global_Str(Code_Delimiter + 'UD' + Str(Parameter),Line_In);
- End;
- Line_Out := '';
- Goto SKIP_PRINTING;
- End;
-
- If (Command = 'UD') Then {Execute user formatting command}
- Default := 1;
- Call GET_PARAMETER;
- If ((Parameter > 0) and (Parameter < 11)) Then
- Line_In := Copy(Global_Str(Code_Delimiter + 'UD' + Str(Parameter)),1,255 - SVL(Line_In)) + Line_In;
- End;
- Goto COMMAND_DECODED;
- End;
-
- If Command = 'NP' Then {Comment}
- Comment := TRUE;
- {If there is some text before the comment, then output the line so far}
- If (Line_Out <> '') Then
- Call Print_Line;
- Line_Out := '';
- End;
- Goto COMMAND_DECODED;
- End;
- If (Command = 'PB') Then {Page break}
- Default := Cur_Page_Num + 1;
- Call GET_PARAMETER;
- New_Page_Num := Parameter;
- Page_Break := True;
- Goto COMMAND_DECODED;
- End;
-
- If (Command = 'X[') Then {INDEX}
- {Parse out index definition, process it, then print out line}
- Call PROCESS_INDEX;
- Goto COMMAND_DECODED;
- End;
-
-
- If (Command = 'DF') Then {Define footer}
- {The remainder of the line is assumed to be part of the footer definition so
- output the line so far}
- If (Line_Out <> '') and Not(Comment) Then
- Call Print_Line;
- End;
- Default := 1;
- Call GET_PARAMETER;
- If (Parameter = 2) Then
- Footer_Copied := False;
- Footer2 := Line_In;
- Else
- Footer1 := Line_In;
- If ((Footer2 = '') or (Footer_Copied = True)) Then
- Footer_Copied := True;
- Footer2 := Line_In;
- End;
- End;
- Line_Out := '';
- Goto SKIP_PRINTING;
- End;
- If (Command = 'DH') Then {Define header}
- {The remainder of the line is assumed to be part of the header definition so
- output the line so far}
- If (Line_Out <> '') and Not(Comment) Then
- Call Print_Line;
- End;
- Default := 1;
- Call GET_PARAMETER;
- If (Parameter = 2) Then
- Header2 := Line_In;
- Header_Copied := False;
- Else
- Header1 := Line_In;
- If ((Header2 = '') or (Header_Copied = True)) Then
- Header_Copied := True;
- Header2 := Line_In;
- End;
- End;
- Line_Out := '';
- Goto SKIP_PRINTING;
- End;
-
- If (Command = 'SF') Then {Supress footer}
- Supress_Footer := True;
- Goto COMMAND_DECODED;
- End;
- If (Command = 'SH') Then {Supress header}
- Supress_Header := True;
- Goto COMMAND_DECODED;
- End;
- If (Command = 'LS') Then {Line spacing}
- {See if we have a parameter}
- Default := 1;
- Call GET_PARAMETER;
- Line_Spacing := Parameter;
- Goto COMMAND_DECODED;
- End;
- If (Command = 'BP') Then {print Headers/Footers on blank pages}
- Default := 0;
- Call GET_PARAMETER;
- Leave_Blank := Parameter;
- Goto COMMAND_DECODED;
- End;
- If (Command = 'FF') Then {insert form feed characters at page break}
- Default := 0;
- Call GET_PARAMETER;
- Form_Feed := Parameter;
- Goto COMMAND_DECODED;
- End;
-
- {This is the table of contents stuff}
-
- If (Command = 'TE') Then {Table entry}
- {Ignore table entry if table is not defined}
- If (Table_Defined = False) Then
- Goto SKIP_ENTRY;
- End;
-
- Default := 1;
- Call GET_PARAMETER;
-
- Table_Level := Parameter;
-
- Table_Line := Line_In;
-
- {Delete leading spaces}
- While (Copy(Table_Line,1,1) = ' ') Do
- Table_Line := Str_Del(Table_Line,1,1);
- End;
- {This is a special case of striping out any index entry, although later on
- a routine is run to strip out all codes, the [ character of the index code
- is striped out beforehand, which will confuse the code stripping routine.}
- STRIP_IDX:
- Jx := XPos('.X[',Caps(Table_Line),1);
- IF (Jx) THEN
- Jy := XPos(']',Table_Line,Jx);
- IF (Jy = 0) THEN
- Jy := Svl(Table_Line);
- END;
- Table_Line := Str_Del(Table_Line,Jx,Jy - Jx + 1);
- Goto STRIP_IDX;
- END;
-
- {Truncate line according to the presense of certain delimiters}
- {The following are considered by M.E. to be word delimiters !@#$^&()[]''`"~\|,<>
- also the curly braces used to enclose this comment.}
- {We had to remove the $ char and add the * char for the macro manual}
- Temp_Integer := Svl(Table_Delimits);
- While (Temp_Integer > 0) Do
- If XPos(Copy(Table_Delimits,Temp_Integer,1),Table_Line,1) Then
- Table_Line := Copy(Table_Line,1,XPos(Copy(Table_Delimits,
- Temp_Integer,1),Table_Line,1) - 1);
- End;
- --Temp_Integer;
- End;
- {We want to truncate if there is more than one consecutive space char}
- If XPos(' ',Table_Line,1) Then
- Table_Line := Copy(Table_Line,1,XPos(' ',Table_Line,1) - 1);
- End;
-
- IF ((Table_Level < 1) or (Table_Level > 5)) THEN
- Table_Level := 1;
- END;
-
- If Table_Level = 1 Then
- Table_Count := Table_Count1;
- Table_Indent := Table_Indent1;
- Table_Style := Table_Style1;
- {We must reset all subseqent Table_Counts}
- Table_Count2 := 0;
- Table_Count3 := 0;
- Table_Count4 := 0;
- Table_Count5 := 0;
- End;
- If Table_Level = 2 Then
- Table_Count := Table_Count2;
- Table_Indent := Table_Indent2;
- Table_Style := Table_Style2;
- Table_Count3 := 0;
- Table_Count4 := 0;
- Table_Count5 := 0;
- End;
- If Table_Level = 3 Then
- Table_Count := Table_Count3;
- Table_Indent := Table_Indent3;
- Table_Style := Table_Style3;
- Table_Count4 := 0;
- Table_Count5 := 0;
- End;
- If Table_Level = 4 Then
- Table_Count := Table_Count4;
- Table_Indent := Table_Indent4;
- Table_Style := Table_Style4;
- Table_Count5 := 0;
- End;
- If Table_Level = 5 Then
- Table_Count := Table_Count5;
- Table_Indent := Table_Indent5;
- Table_Style := Table_Style5;
- End;
-
- If (Table_Style = 1) Then
- Table_Line := Str(Table_Count + 1) + '. ' + Table_Line;
- Line_In := Str(Table_Count + 1) + '. ' + Line_In;
- End;
-
- If (Table_Style = 2) Then
- Table_Line := Char(Table_Count + 65) + '. ' + Table_Line;
- Line_In := Char(Table_Count + 65) + '. ' + Line_In;
- End;
-
- If (Table_Style = 3) Then
- Table_Line := Remove_Space(Copy(
- 'I. II. III. IV. V. VI. VII. VIII.IX. X. XI. ',
- (Table_Count * 5) + 1,5)) + ' ' + Table_Line;
- Line_In := Remove_Space(Copy(
- 'I. II. III. IV. V. VI. VII. VIII.IX. X. XI. ',
- (Table_Count * 5) + 1,5)) + ' ' + Line_In;
- End;
-
- ++Table_Count;
- If Table_Level = 1 Then
- Table_Count1 := Table_Count;
- End;
- If Table_Level = 2 Then
- Table_Count2 := Table_Count;
- End;
- If Table_Level = 3 Then
- Table_Count3 := Table_Count;
- End;
- If Table_Level = 4 Then
- Table_Count4 := Table_Count;
- End;
- If Table_Level = 5 Then
- Table_Count5 := Table_Count;
- End;
- Switch_Win_Id(Table_Window);
-
-
- If (Table_Line_Num = Bottom_Margin) Then
- IF ((Footer_Margin > (Page_Length + 1)) or
- (Supress_Table_Footer = True)) THEN
- Goto NO_TABLE_FOOTER;
- END;
-
- IF (XPos('|10',Get_Line,1) = 0) THEN
- Goto_Col(1);
- Text('|10');
- END;
- While ((Table_Line_Num < (Footer_Margin - 1)) and
- (Table_Line_Num < Page_Length)) Do
- Down;
- Put_Line('|10');
- ++Table_Line_Num;
- End;
- If (Table_Line_Num <= Page_Length) Then
- Temp_Line_Out := Line_Out;
- If (Table_Page_Num = ((Table_Page_Num / 2) * 2)) Then
- Line_Out := Footer2;
- Else
- Line_Out := Footer1;
- End;
-
- Temp_String := Caps(Line_Out);
-
- If (XPos(Code_Delimiter + 'PA',Temp_String,1)) Then
- Table_Page_Str := Remove_Space(Copy(
- 'i ii iii iv v vi vii viiiix x xi ',
- ((Table_Page_Num - 1) * 4) + 1,4));
-
- Line_Out := Copy(Line_Out,1,XPos(Code_Delimiter + 'PA',Temp_String,1) - 1)
- + Table_Page_Str +
- Copy(Line_Out,XPos(Code_Delimiter + 'PA',Temp_String,1) + 3,254);
- End;
- For_Table := True;
- Call PRINT_LINE;
- Jx := XPos(Code_Delimiter + 'CE',Temp_String,1);
- IF (Jx) THEN
- Line_Out := Str_Del(Line_Out,Jx,3);
- Call CENTER_LINE;
- END;
- Switch_Win_Id(Table_Window);
-
- Put_Line('|10' + Copy(Blank_Line,1,Left_Margin) + Line_Out);
- Line_Out := Temp_Line_Out;
- End;
- NO_TABLE_FOOTER:
- IF (Form_Feed) THEN
- Eol;
- Text('|12|13');
- ELSE
- While (Table_Line_Num <= Page_Length) Do
- Down;
- Put_Line('|10');
- ++Table_Line_Num;
- End;
- END;
- ++Table_Page_Num;
- Table_Line_Num := 1;
- End;
-
- If (Table_Line_Num = 1) Then
- While ((Table_Line_Num <= Header_Margin) and
- (Table_Line_Num < Page_Length)) Do
- Down;
- Put_Line('|10');
- ++Table_Line_Num;
- End;
- Goto_Col(1);
- Temp_Line_Out := Line_Out;
- IF (Supress_Table_Header) THEN
- Line_Out := '';
- ELSE
- If (Table_Page_Num = ((Table_Page_Num / 2) * 2)) Then
- Line_Out := Header2;
- Else
- Line_Out := Header1;
- End;
- Temp_String := Caps(Line_Out);
- If (XPos(Code_Delimiter + 'PA',Temp_String,1)) Then
- Table_Page_Str := Remove_Space(Copy(
- 'i ii iii iv v vi vii viiiix x xi ',
- ((Table_Page_Num - 1) * 4) + 1,4));
- Line_Out := Copy(Line_Out,1,XPos(Code_Delimiter + 'PA',Temp_String,1) - 1)
- + Table_Page_Str +
- Copy(Line_Out,XPos(Code_Delimiter + 'PA',Temp_String,1) + 3,254);
- End;
- END;
- For_Table := True;
- Call PRINT_LINE;
- Jx := XPos(Code_Delimiter + 'CE',Temp_String,1);
- IF (Jx) THEN
- Line_Out := Str_Del(Line_Out,Jx,3);
- Call CENTER_LINE;
- END;
- Eol;
-
- Text(Copy(Blank_Line,1,Left_Margin) + Line_Out);
-
- Line_Out := Temp_Line_Out;
- While ((Table_Line_Num <= Top_Margin) and
- (Table_Line_Num < Page_Length)) Do
- ++Table_Line_Num;
- Down;
- Put_Line('|10');
- End;
- If (Table_Page_Num = 1) Then
- Line_Out := 'Table of Contents';
- Call CENTER_LINE;
- Put_Line('|10' + Copy(Blank_Line,1,Left_Margin) + Line_Out);
- Down;
- Put_Line('|10');
- Down;
- Table_Line_Num := Table_Line_Num + 2;
- Line_Out := Temp_Line_Out;
- End;
- End;
- {Strip out any remaining formatting codes}
- Temp_String := Table_Line;
- Call STRIP_CODES;
- Table_Line := Temp_String;
- Put_Line('|10' + Copy(Blank_Line,1,Left_Margin + Table_Indent) + Temp_String);
- Eol;
- If (Periods) Then
- Text(Copy('...................................................................................'
- ,1,(Table_Margin - Table_Indent) - SVL(Table_Line) -
- Left_Margin - Length(Str(Cur_Page_Num)) - 2));
- End;
- Table_Line := Str(Cur_Page_Num);
- Goto_Col(Table_Margin - SVL(Table_Line) + 1);
- Text(Table_Line);
- ++Table_Line_Num;
- Down;
- Goto_Col(1);
- Switch_Win_Id(Text_Window);
- Goto COMMAND_DECODED;
-
- SKIP_ENTRY:
- End;
-
- If (Command = 'TC') Then {Define table of contents}
- {Ignore table definition if table is already defined}
- If (Table_Defined) Then
- Goto SKIP_DEFINITION;
- Else
- Table_Defined := True;
- End;
-
- Table_Line_Num := 1;
- Table_Page_Num := 1;
- Temp_String := File_Name;
-
- {Create a window for the Table of contents}
- Create_Window;
- Line_Terminator := '|13';
- Table_Window := Window_Id;
- File_Name := Truncate_Extension(Temp_String) + '.TOC';
- Switch_Win_Id(Text_Window);
-
- {See if we have a parameter}
- Default := 75;
- Call GET_PARAMETER;
- Table_Margin := Parameter;
- {See if user wants to pad between table entry and page number with spaces or
- periods}
- Default := 0;
- Call GET_PARAMETER;
- Periods := Parameter;
-
- Default := 0;
- Call GET_PARAMETER;
- Supress_Table_Header := Parameter > 0;
- Default := 0;
- Call GET_PARAMETER;
- Supress_Table_Footer := Parameter > 0;
-
- Default := 0;
- Call GET_PARAMETER;
- Table_Indent1 := Parameter;
- Default := 0;
- Call GET_PARAMETER;
- Table_Style1 := Parameter;
- Default := 5;
- Call GET_PARAMETER;
- Table_Indent2 := Table_Indent1 + Parameter;
- Default := 0;
- Call GET_PARAMETER;
- Table_Style2 := Parameter;
- Default := 5;
- Call GET_PARAMETER;
- Table_Indent3 := Table_Indent2 + Parameter;
- Default := 0;
- Call GET_PARAMETER;
- Table_Style3 := Parameter;
- Default := 5;
- Call GET_PARAMETER;
- Table_Indent4 := Table_Indent3 + Parameter;
- Default := 0;
- Call GET_PARAMETER;
- Table_Style4 := Parameter;
- Default := 5;
- Call GET_PARAMETER;
- Table_Indent5 := Table_Indent4 + Parameter;
- Default := 0;
- Call GET_PARAMETER;
- Table_Style5 := Parameter;
- Goto COMMAND_DECODED;
- SKIP_DEFINITION:
- End;
-
-
- If (Command = 'TM') Then {Top Margin}
- {See if we have a parameter}
- Default := 5;
- Call GET_PARAMETER;
- Top_Margin := Parameter;
- Call CHECK_MARGINS;
- Goto COMMAND_DECODED;
- End;
-
- If (Command = 'BM') Then {Bottom Margin}
- {See if we have a parameter}
- Default := Page_Length - 6;
- Call GET_PARAMETER;
- Bottom_Margin := Parameter;
- Call CHECK_MARGINS;
- Bottom_Set := True;
- Goto COMMAND_DECODED;
- End;
-
- If (Command = 'PL') Then {Page Length}
- {See if we have a parameter}
- Default := 66;
- Call GET_PARAMETER;
- Page_Length := Parameter;
- IF (Bottom_Set = False) THEN
- Bottom_Margin := Page_Length - 6;
- END;
- IF (Footer_Set = False) THEN
- Footer_Margin := Page_Length - 2;
- END;
- Call CHECK_MARGINS;
- Goto COMMAND_DECODED;
- End;
- If (Command = 'RM') Then {Right Margin}
- {See if we have a parameter}
- Default := 80;
- Call GET_PARAMETER;
- Rght_Margin := Parameter;
- Goto COMMAND_DECODED;
- End;
- If (Command = 'LM') Then {Left Margin}
- {See if we have a parameter}
- Print_margin := 0;
- Default := 1;
- Call GET_PARAMETER;
- Left_Margin := Parameter - 1;
- Goto COMMAND_DECODED;
- End;
- If (Command = 'HM') Then {Header Margin}
- {See if we have a parameter}
- Default := 2;
- Call GET_PARAMETER;
- Header_Margin := Parameter;
- Call CHECK_MARGINS;
- Goto COMMAND_DECODED;
- End;
-
- If (Command = 'FM') Then {Footer Margin}
- {See if we have a parameter}
- Default := Page_Length - 2;
- Call GET_PARAMETER;
- Footer_Margin := Parameter;
- Call CHECK_MARGINS;
- Footer_Set := True;
- Goto COMMAND_DECODED;
- End;
-
- COMMAND_DECODED:
- End;
- End;
- End;
-
- NO_COMMAND:
- {Process top and header margins, print header}
- If ((Cur_Line_Num = 1) and (Comment = false)) Then
- {If we have an unprinted line in memory, we need to save it}
- Temp_Line_Out := Line_Out;
- Temp_Flag := Comment;
- {Put in header(if header is null, just another blank line will be printed)}
- Comment := False;
- If Header_Margin < 0 then
- Goto NO_HEADER;
- End;
- {fill in header margin}
- Move_Count := Header_Margin;
- Call MOVE_DOWN;
- If (Supress_Header = False) Then
- {If on an even numbered page then}
- If (Cur_Page_Num = ((Cur_Page_Num / 2) * 2)) Then
- Line_Out := Header2;
- Else
- Line_Out := Header1;
- End;
- Else
- Line_Out := '';
- End;
- Supress_Header := False;
- Print_HF := True;
- Call PRINT_LINE;
- NO_HEADER:
- {fill in top margin}
- Move_Count := (Top_Margin - Cur_Line_Num) + 1;
- Call MOVE_DOWN;
- Line_Out := Temp_Line_Out;
- Comment := Temp_Flag;
- If Line_Out = '' Then
- Goto SKIP_PRINTING;
- End;
- End;
- HERE:
- If (Comment) Then
- Goto SKIP_PRINTING;
- End;
-
- PREPARE_TO_PRINT:
- Call PRINT_LINE;
- If Line_Spacing > 1 Then
- Move_Count := Line_Spacing - 1;
- Call MOVE_DOWN;
- End;
-
- SKIP_PRINTING:
- If ((Cur_Line_Num >= Bottom_Margin) or ((Page_Break = True) and (Cur_Line_Num > 1)))Then
- {fill in footer margin}
- {
- If ((Footer_Margin > (Page_Length)) or (Supress_Footer = True) or
- ((Footer1 = '') and (Footer2 = ''))) Then
- Goto NO_FOOTER;
- End;
- }
-
- If ((Footer_Margin > (Page_Length + 1)) or (Supress_Footer = True) or
- ((Footer1 = '') and (Footer2 = ''))) Then
- Goto NO_FOOTER;
- End;
-
- Making_Margin := True;
- Move_Count := (Footer_Margin - Cur_Line_Num) - 1;
- Call MOVE_DOWN;
- {If on an even numbered page then}
- If (Cur_Page_Num = ((Cur_Page_Num / 2) * 2)) Then
- Line_Out := Footer2;
- Else
- Line_Out := Footer1;
- End;
- Print_HF := True;
- {Put in footer(if footer is null, just another blank line will be printed)}
- Call PRINT_LINE;
- NO_FOOTER:
- Supress_Footer := False;
- {fill in bottom margin}
- {we go one line beyond the page length to get on line one of the next page}
- IF (Form_Feed) THEN
- Print_HF := True;
- IF (Switch_Win_Id(Print_Window)) THEN
- Up;
- Eol;
- Text('|12|13');
- END;
- ELSE
- Move_Count := (Page_Length - Cur_Line_Num) + 1;
- Call MOVE_DOWN;
- END;
-
- If (Page_Break) Then
- Cur_Page_Num := New_Page_Num;
- Page_Break := False;
- Else
- ++Cur_Page_Num;
- End;
- Cur_Line_Num := 1;
- Making_Margin := False;
- HF_Toggle := Not(HF_Toggle);
- {This is the part for the forced odd/even page numbers}
- If (Blank_Page) Then
- HF_Toggle := Not(HF_Toggle);
- If (Leave_Blank) Then
- Page_Break := True;
- Blank_Page := False;
- Goto NO_COMMAND;
- Else
- ++Cur_Page_Num;
-
- IF (Form_Feed) THEN
- Print_HF := True;
- IF (Switch_Win_Id(Print_Window)) THEN
- Up;
- Eol;
- Text('|12|13');
- END;
- ELSE
- Move_Count := Page_Length;
- Call MOVE_DOWN;
- END;
-
- Blank_Page := False;
- Cur_Line_Num := 1;
- End;
- End;
- ELSE
- Page_Break := False;
- End;
- Switch_Win_Id(Text_Window);
- Down;
- Goto_Col(1);
- End;
-
- {End of main program loop}
- IF (Line_Out = '|12') THEN
- Line_Out := '';
- END;
-
- If ((Cur_Line_Num = 1) and (Line_Out <> '')) Then
- {If we have an unprinted line in memory, we need to save it}
- Temp_Line_Out := Line_Out;
- Temp_Flag := Comment;
- {Put in header(if header is null, just another blank line will be printed)}
- Comment := False;
- If ((Header_Margin < 0) or (Header1 = '')) then
- Goto NO_LAST_HEADER;
- End;
- {fill in header margin}
- Move_Count := Header_Margin;
- Call MOVE_DOWN;
- If (Supress_Header = False) Then
- {If on an even numbered page then}
- If (Cur_Page_Num = ((Cur_Page_Num / 2) * 2)) Then
- Line_Out := Header2;
- Else
- Line_Out := Header1;
- End;
- Else
- Line_Out := '';
- End;
- Supress_Header := False;
- Print_HF := True;
- Call PRINT_LINE;
- NO_LAST_HEADER:
- {fill in top margin}
- Move_Count := (Top_Margin - Cur_Line_Num) + 1;
- Call MOVE_DOWN;
- Line_Out := Temp_Line_Out;
- Comment := Temp_Flag;
- End;
-
- If Cur_Line_Num > 1 Then
- {
- If ((Footer_Margin > (Page_Length)) or (Footer1 = '')) Then
- Goto DONE;
- End;
- }
-
- If ((Footer_Margin > (Page_Length + 1)) or (Footer1 = '')) Then
- Goto DONE;
- End;
-
- {fill in bottom margin and footer for last page}
- Making_Margin := True;
- Move_Count := (Footer_Margin - Cur_Line_Num) - 1;
- Call MOVE_DOWN;
-
- If (Supress_Footer = False) Then
- {If on an even numbered page then}
- If (Cur_Page_Num = ((Cur_Page_Num / 2) * 2)) Then
- Line_Out := Footer2;
- Else
- Line_Out := Footer1;
- End;
- Else
- Line_Out := '';
- End;
- Print_HF := True;
- Supress_Footer := False;
- {Put in footer(if footer is null, just another blank line will be printed)}
- Call PRINT_LINE;
- End;
-
- DONE:
- {Get rid of blank lines at the end this is a kludge, but I don't have time
- right now to fix it right}
- SWITCH_WIN_Id(Print_Window);
- KILL_BLANKS:
- EOL;
- IF ((C_Col = 1) and (C_Line > 1)) THEN
- Back_Space;
- Goto KILL_BLANKS;
- END;
- Temp_Flag := (Get_Line = '|12');
- Cr;
- SWITCH_WIN_Id(Text_Window);
- IF ((Form_Feed) and (Temp_Flag = False)) THEN
- Print_HF := True;
- IF (Switch_Win_Id(Print_Window)) THEN
- Up;
- Eol;
- Text('|12|13');
- END;
- END;
-
- If (Table_Defined) Then
- Switch_Win_Id(Table_Window);
-
- IF (XPos('|10',Get_Line,1) = 0) THEN
- Goto_Col(1);
- Text('|10');
- END;
- While ((Table_Line_Num < (Footer_Margin - 1)) and
- (Table_Line_Num < Page_Length)) Do
- Down;
- Put_Line('|10');
- ++Table_Line_Num;
- End;
- If (Table_Line_Num <= Page_Length) Then
- If ((Footer_Margin > (Page_Length + 1)) or
- (Footer1 = '') or (Supress_Table_Footer = true)) Then
- {
- IF (Footer_Margin >= Page_Length) THEN
- }
- Goto NO_LAST_TABLE_FOOTER;
- END;
- If (Table_Page_Num = ((Table_Page_Num / 2) * 2)) Then
- Line_Out := Footer2;
- Else
- Line_Out := Footer1;
- End;
-
- Temp_String := Caps(Line_Out);
-
- If (XPos(Code_Delimiter + 'PA',Temp_String,1)) Then
- Table_Page_Str := Remove_Space(Copy(
- 'i ii iii iv v vi vii viiiix x xi ',
- ((Table_Page_Num - 1) * 4) + 1,4));
- Line_Out := Copy(Line_Out,1,XPos(Code_Delimiter + 'PA',Temp_String,1) - 1)
- + Table_Page_Str +
- Copy(Line_Out,XPos(Code_Delimiter + 'PA',Temp_String,1) + 3,254);
-
- End;
-
- For_Table := True;
- Call PRINT_LINE;
- Jx := XPos(Code_Delimiter + 'CE',Temp_String,1);
- IF (Jx) THEN
- Line_Out := Str_Del(Line_Out,Jx,3);
- Call CENTER_LINE;
- END;
- Switch_Win_Id(Table_Window);
- Put_Line('|10' + Copy(Blank_Line,1,Left_Margin) + Line_Out);
-
- NO_LAST_TABLE_FOOTER:
- IF (Form_Feed) THEN
- Eol;
- Text('|12|13');
- ELSE
- While (Table_Line_Num < Page_Length) Do
- Down;
- Put_Line('|10');
- ++Table_Line_Num;
- END;
- END;
- End;
- Block_Begin;
- Tof;
- Block_End;
- Jx := Cur_Window;
- Switch_Win_Id(Print_Window);
- Tof;
-
- Window_Move(Jx);
- IF (Form_Feed) THEN
- Goto_Line(Block_Line2);
- Eol;
- Del_Char;
- Del_Char;
- END;
-
- Block_Off;
- Tof;
-
- Switch_Win_Id(Table_Window);
- Delete_Window;
- End;
- Write('▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓▓ 100% Complete.',4,8,0,M_B_Color);
- {If an index was generated, merge it to the bottom of the document.}
- IF (Switch_Win_Id(Index_Window)) THEN
- Tof;
- IF (Not(At_Eof)) THEN
- Cr;
- Up;
- Put_Line('|10' + '******INDEX******');
- Block_Begin;
- Eof;
- Block_End;
- Jx := Cur_Window;
- Switch_Win_Id(Print_Window);
- Eof;
- IF (C_Col > 1) THEN
- Down;
- END;
- Window_Move(Jx);
- Block_Off;
- END;
- IF (Switch_Win_Id(Index_Window)) THEN
- Delete_Window;
- END;
- END;
- Kill_Box;
- Switch_Win_Id(Text_Window);
- Tof;
- Switch_Win_Id(Print_Window);
- Tof;
- IF (Cur_Char = '|10') THEN
- Del_Char;
- END;
- Refresh := True;
- New_Screen;
- Make_Message('Formatting complete. Print document file name is: ' +
- File_Name);
- Goto END_OF_MAC;
-
- {********************************** SUBROUTINES ******************************}
-
- PROCESS_INDEX:
- Jx := XPos(']',Line_In,1);
- IF (Jx = 0) THEN
- Index_Main := Line_In;
- Line_In := '';
- ELSE
- Index_Main := Copy(Line_In,1,Jx - 1);
- Line_In := Str_Del(Line_In,1,Jx);
- END;
- IF (Svl(Index_Main)) THEN
- IF (Switch_Win_Id(Index_Window)) THEN
- Jx := XPos('^',Index_Main,1);
- IF (Jx) THEN
- IF (Jx < Svl(Index_Main)) THEN
- Index_Sub := ' ' + Copy(Index_Main,Jx + 1,75);
- ELSE
- Index_Sub := '';
- END;
- Index_Main := Copy(Index_Main,1,Jx - 1);
- ELSE
- Index_Sub := '';
- END;
- IF (Svl(Index_Main)) THEN
- Tof;
- IF (At_Eof) THEN
- {If this is the first entry, skip the unnecessary garbage and put the stuff in}
- Put_Line('|10' + Caps(Index_Main));
- IF (Svl(Index_Sub)) THEN
- Down;
- Goto_Col(1);
- Text('|10' + Caps(Index_Sub));
- END;
- Text(' (' + Str(Cur_Page_Num) + ')');
- RET;
- END;
-
- IF (Search_Fwd('%|10' + Index_Main + '{ (}||$',0)) THEN
- {If we found an identical index entry, simply add the page number to it}
-
- IF (Svl(Index_Sub)) THEN
- Down;
- FIND_SUB:
-
- IF ((Caps(Copy(Get_Line,2,Svl(Index_Sub))) <= Caps(Index_Sub)) and
- (At_Eof = False)) THEN
- IF (Copy(Get_Line,2,5) = ' ') THEN
- Down;
- Goto FIND_SUB;
- END;
- ELSE
- Up;
- END;
- IF (Caps(Copy(Get_Line,2,Svl(Index_Sub))) <> Caps(Index_Sub)) THEN
- Eol;
- Cr;
- Text('|10' + Caps(Index_Sub) + ' (' + Str(Cur_Page_Num) + ')');
- END;
- END;
- IF (XPos('(' + Str(Cur_Page_Num) + ')',Get_Line,1) = 0) THEN
- Eol;
- {If we already have a page number on this main heading, put in a comma}
- IF (Copy(Get_Line,Length(Get_Line),1) = ')') THEN
- Text(',');
- END;
- Text(' (' + Str(Cur_Page_Num) + ')');
- END;
- ELSE
- {Search for the closest thing to our entry}
- FIND_MAIN:
- IF (Caps(Copy(Get_Line,2,Svl(Index_Main))) < Caps(Index_Main)) THEN
- Down;
- WHILE (Copy(Get_Line,2,5) = ' ') DO
- Down;
- END;
- IF (Not(At_Eof)) THEN
- Goto FIND_MAIN;
- END;
- END;
- {We should now be at the line below where we want to insert the new index}
- Cr;
- Up;
- Text('|10' + Caps(Index_Main));
- IF (Svl(Index_Sub)) THEN
- Eol;
- Cr;
- Text('|10' + Caps(Index_Sub));
- END;
- Text(' (' + Str(Cur_Page_Num) + ')');
- END;
- END;
- END;
-
- Switch_Win_Id(Text_Window);
- END;
- RET;
-
- PRINT_LINE:
- IF ((F_MODE = 0) or (PRINT_HF = TRUE)) THEN
- {the following lines will decode any variables imbedded in the line}
- If XPos(Code_Delimiter,Line_Out,1) Then
- Temp_String := Caps(Line_Out);
-
- While XPos(Code_Delimiter + 'PA',Temp_String,1) Do
- Line_Out := Copy(Line_Out,1,XPos(Code_Delimiter + 'PA',Temp_String,1) - 1) +
- Str(Cur_Page_Num) +
- Copy(Line_Out,XPos(Code_Delimiter + 'PA',Temp_String,1) + 3,
- SVL(Line_Out) - (XPos(Code_Delimiter + 'PA',Temp_String,1)) - 2);
- Temp_String := Caps(Line_Out);
- End;
- While XPos(Code_Delimiter + 'DA',Temp_String,1) Do
- Line_Out := Copy(Line_Out,1,XPos(Code_Delimiter + 'DA',Temp_String,1) - 1) + Cur_Date + Copy(Line_Out,Pos(Code_Delimiter + 'DA',Temp_String) + 3,SVL(Line_Out) - (XPos(Code_Delimiter + 'DA',Temp_String,1)) - 2);
- Temp_String := Caps(Line_Out);
- End;
- While XPos(Code_Delimiter + 'FN',Temp_String,1) Do
- Line_Out := Copy(Line_Out,1,XPos(Code_Delimiter + 'FN',Temp_String,1) - 1) + Cur_File_Name + Copy(Line_Out,Pos(Code_Delimiter + 'FN',Temp_String) + 3,SVL(Line_Out) - (XPos(Code_Delimiter + 'FN',Temp_String,1)) - 2);
- Temp_String := Caps(Line_Out);
- End;
- While XPos(Code_Delimiter + 'TI',Temp_String,1) Do
- Line_Out := Copy(Line_Out,1,XPos(Code_Delimiter + 'TI',Temp_String,1) - 1) + Cur_Time + Copy(Line_Out,XPos(Code_Delimiter + 'TI',Temp_String,1) + 3,SVL(Line_Out) - (XPos(Code_Delimiter + 'TI',Temp_String,1)) - 2);
- Temp_String := Caps(Line_Out);
- End;
-
- While XPos(Code_Delimiter + 'CE',Temp_String,1) Do
- Line_Out := Copy(Line_Out,1,XPos(Code_Delimiter + 'CE',Temp_String,1) - 1) +
- Copy(Line_Out,XPos(Code_Delimiter + 'CE',Temp_String,1) + 3,SVL(Line_Out) -
- (XPos(Code_Delimiter + 'CE',Temp_String,1)) - 2);
- Call CENTER_LINE;
- Temp_String := Caps(Line_Out);
- End;
-
- {Decode any possible printer specific codes}
- Temp_Integer := 1;
- GET_PS_CODE:
- Delimiter_Pos := XPos(Code_Delimiter,Line_Out,Temp_Integer);
- IF ((Delimiter_Pos > 0) and (Delimiter_Pos < (Svl(Line_Out) - 1))) THEN
- Temp_Integer := Delimiter_Pos + 1;
- Command := Caps(Copy(Line_Out,Temp_Integer,2));
- Call GET_PRINTER_CODE;
- IF (Return_Int) THEN
- Line_Out := Copy(Line_Out,1,Delimiter_Pos - 1) + Return_Str
- + Copy(Line_Out,Delimiter_Pos + 3,255);
- END;
- Goto GET_PS_CODE;
- END;
- End;
- END;
-
- If (For_Table) Then
- For_Table := False;
- RET;
- End;
- SWITCH_WIN_Id(Print_Window);
- Tabs_To_Spaces(Line_Out); {convert tabs to spaces}
- {Add in margin unless we are printing a header or a footer}
- Eol;
- IF (C_Col = 1) THEN
- Put_Line('|10' + Copy(Blank_Line,1,Left_Margin) + Line_Out);
- ELSE
- TEXT(Copy(Blank_Line,1,Left_Margin) + Line_Out);
- END;
- DOWN;
- GOTO_COL(1);
-
- Print_HF := False;
- ++Cur_Line_Num;
- SWITCH_WIN_Id(Text_Window);
- RET;
-
- MOVE_DOWN:
- SWITCH_WIN_Id(Print_Window);
- IF (Xpos('|10',Get_Line,1) = 0) THEN
- Goto_Col(1);
- Text('|10');
- END;
- While (Move_Count > 0) Do
- DOWN;
- Put_Line('|10');
- --Move_Count;
- ++Cur_Line_Num;
- If ((Cur_Line_Num = Bottom_Margin) and Not(Making_Margin) and (Blank_Page = 0)) Then
- Goto NO_MORE_SPACES;
- End;
- End;
-
- NO_MORE_SPACES:
- Goto_Col(1);
- SWITCH_WIN_Id(Text_Window);
- RET;
-
- GET_PARAMETER:
- If (Line_In = '') Then
- Parameter := Default;
- Ret;
- End;
- Temp_Param := '';
- If (Copy(Line_In,1,1) = ' ') Then
- {Strip off leading space}
- Line_In := Str_Del(Line_In,1,1);
- Param_Space := True;
- Else
- Param_Space := False;
- End;
- Temp_Integer := Val(Parameter,Line_In);
- IF (Temp_Integer = 0) THEN
- Temp_Integer := SVL(Line_In) + 1;
- END;
- If (Temp_Integer > 1) Then
- Val_Error := Val(Parameter,Copy(Line_In,1,Temp_Integer - 1));
- Line_In := Str_Del(Line_In,1,Temp_Integer - 1);
- Else
- Parameter := Default;
- If (Param_Space) Then
- Line_In := ' ' + Line_In;
- End;
- End;
- RET;
-
- IMBEDDED_PARAMETER:
- Temp_Param := '';
- If Line_Out = '' Then
- Parameter := Default;
- Ret;
- End;
- If (Copy(Line_Out,Param_Pos,1) = ' ') Then
- {Strip off leading space}
- Line_Out := Str_Del(Line_Out,Param_Pos,1);
- Param_Space := True;
- Else
- Param_Space := False;
- End;
- While ((XPos(Copy(Line_Out,Param_Pos,1),'0123456789',1) > 0) and (Line_Out <> '') and (Copy(Line_Out,Param_Pos,1) <> '')) Do
- Temp_Param := Temp_Param + Copy(Line_Out,Param_Pos,1);
- Line_Out := Str_Del(Line_Out,Param_Pos,1);
- End;
- {If no parameter, then add the space back in if there was one before}
- If (Temp_Param = '') Then
- Parameter := Default;
- If (Param_Space) Then
- Line_Out := Str_Ins(' ',Line_Out,Param_Pos + 1);
- End;
- Else
- Val_Error := Val(Parameter,Temp_Param);
- End;
- RET;
-
- CENTER_LINE:
- {Determine the length of the text}
- If (Line_Out = '') Then
- RET;
- End;
- If (Print_HF) Then
- SWITCH_WIN_Id(Print_Window);
- Goto_Col(Left_Margin + 1);
- SWITCH_WIN_Id(Text_Window);
- End;
- {Strip Out leading spaces}
-
-
- {We must strip out any printer specific formatting codes and any associated
- parameters to calculate the proper text length}
- Temp_String := Caps(Line_Out);
- CALL STRIP_ATTRIBUTES;
- While (Copy(Temp_String,1,1) = ' ') DO
- Temp_String := Str_Del(Temp_String,1,1);
- END;
- While (Copy(Line_Out,1,1) = ' ') DO
- Line_Out := Str_Del(Line_Out,1,1);
- END;
- Return_Str := Line_Out;
- Call FIND_TEXT_BEGINNING;
- While (Copy(Line_Out,Return_Int,1) = ' ') DO
- Line_Out := Str_Del(Line_Out,Return_Int,1);
- END;
-
- Text_Length := SVL(Temp_String);
-
- If Text_Length > (Rght_Margin - Left_Margin - 2) Then
- RET;
- End;
- Line_Out := Copy(Blank_Line,1,((((Rght_Margin - Left_Margin) - Text_Length) / 2))) + Line_Out;
- {
- Line_Out := Copy(Blank_Line,1,((((Rght_Margin - Left_Margin) - Text_Length) / 2) - 1)) + Line_Out;
- }
- RET;
-
- STRIP_CODES:
- {This subroutine strips out all legal fprint codes from Temp_String}
- If XPos(Code_Delimiter,Temp_String,1) Then
- {Strip out all codes which use no parameters}
- Temp_Integer := 0;
- WHILE (Temp_Integer < 9) DO
- STRIP_NO_PARAM:
- Jx := XPos(Code_Delimiter + Copy('THCESFSHIGFNTIDAPA',(Temp_Integer * 2) + 1,2),
- Caps(Temp_String),1);
- If (Jx) Then
- Temp_String := Str_Del(Temp_String,Jx,3);
- Goto STRIP_NO_PARAM;
- End;
- ++Temp_Integer;
- END;
-
- {Strip out all codes wich use 1 parameter}
- Temp_Integer := 0;
- WHILE (Temp_Integer < 19) DO
- STRIP_1_PARAM:
- Jx := XPos(Code_Delimiter + Copy('TMBMHMFMNPPBDFDHLSPLRMLMULEMITDWTEDUUD'
- ,(Temp_Integer * 2) + 1,2),Caps(Temp_String),1);
- If (Jx) Then
- Temp_String := Str_Del(Temp_String,Jx,3);
- {Strip out parameter if present}
- If (XPos(' ',Temp_String,Jx) = Jx) Then
- Param_Space := True;
- Temp_String := Str_Del(Temp_String,Jx,1);
- Else
- Param_Space := False;
- End;
- STRIP_1_NUMERIC:
- IF ((XPos(Copy(Temp_String,Jx,1),'1234567890-',1) > 0)
- and (Jx <= SVL(Temp_String))) THEN
- Temp_String := Str_Del(Temp_String,Jx,1);
- Param_Space := False;
- Goto STRIP_1_NUMERIC;
- End;
- If (Param_Space) Then
- Temp_String := Str_Ins(' ',Temp_String,Jx);
- End;
- Goto STRIP_1_PARAM;
- End;
- ++Temp_Integer;
- END;
-
- {Strip out .tc which has up to 12 paramters}
- STRIP_TC:
- Jx := XPos(Code_Delimiter + 'TC',Caps(Temp_String),1);
- IF (Jx) THEN
- Temp_String := Str_Del(Temp_String,Jx,3);
- {Strip out parameters if present}
- WHILE ((XPos(Copy(Temp_String,Jx,1),'1234567890- ',1) > 0)
- and (Jx <= SVL(Temp_String))) DO
- Temp_String := Str_Del(Temp_String,Jx,1);
- END;
- GOTO STRIP_TC;
- END;
- End;
-
- {Strip out any printer specific commands}
- STRIP_ATTRIBUTES:
- If XPos(Code_Delimiter,Temp_String,1) Then
- Jx := 0;
- WHILE (Jx < (SVL(Attribute_Commands) / 2)) DO
- STRIP_ATTR:
- Jy := XPos(Code_Delimiter + Copy(Attribute_Commands,(Jx * 2) + 1,2),Caps(Temp_String),1);
- IF (Jy) THEN
- Temp_String := Str_Del(Temp_String,Jy,3);
- Goto STRIP_ATTR;
- END;
- ++Jx
- END;
- End;
- {Strip out index entry}
- Jx := XPos(Code_Delimiter + 'X[',Caps(Temp_String),1);
- IF (Jx) THEN
- Jy := XPos(']',Temp_String,Jx);
- IF (Jy = 0) THEN
- Jy := Svl(Temp_String);
- END;
- Temp_String := Str_Del(Temp_String,Jx,Jy - Jx + 1);
- END;
- RET;
-
- CHECK_MARGINS:
- {This checks to make sure that all margins and the page length are all in
- proper numeric order}
- IF (Header_Margin >= Top_Margin) THEN
- Header_Margin := Top_Margin - 1;
- END;
- IF (Top_Margin >= Bottom_Margin) THEN
- Bottom_Margin := Top_Margin + 1;
- END;
- IF (Bottom_Margin >= Footer_Margin) THEN
- Footer_Margin := Bottom_Margin + 1;
- END;
- RET;
-
- GET_PRINTER_CODE:
- Return_Int := False;
- {See if the print formatter code is in the printer code list}
- Jx := XPos('=' + Caps(Command) + '',Caps(Global_Str('PRINTER_TYPE') + ''),1);
-
- IF (Jx) THEN
- Jy := -1;
- WHILE (Copy(Global_Str('PRINTER_TYPE'),Jx,1) <> 'F') DO
- --Jx;
- ++Jy;
- END;
- {Get numeric part of the field name}
- IF (Val(Jx,Copy(Global_Str('PRINTER_TYPE'),Jx + 1,Jy))) THEN
- RET;
- END;
- {Now, parse out the corresponding printer code}
- Return_Str := Parse_Str('C' + Str(Jx) + '=',Global_Str('PRINTER_TYPE'));
- Return_Int := True;
- END;
- RET;
-
- FIND_TEXT_BEGINNING:
- {This routine finds the position of the first non-code character}
- Return_Str := Caps(Return_Str);
- Return_Int := 1;
- IF (Xpos(Code_Delimiter,Return_Str,1) = 0) THEN
- Ret;
- END;
-
- {Skip over printer attribute commands}
- LOOK_AGAIN:
- Temp_Integer := 0;
- While (Temp_Integer < (SVL(Attribute_Commands) / 2)) Do
- IF (Copy(Return_Str,Return_Int,3) = (Code_Delimiter + Copy(Attribute_Commands,(Temp_Integer * 2) + 1,2))) THEN
- Return_Int := Return_Int + 3;
- Goto LOOK_AGAIN;
- END;
- ++Temp_Integer;
- End;
- RET;
-
- END_OF_MAC:
- {Deallocate user defined commands}
- Temp_Integer := 1;
- WHILE (Temp_Integer < 11) DO
- Set_Global_Str('.UD' + Str(Temp_Integer),'');
- ++Temp_Integer;
- END;
- If (Abort) Then
- Refresh := True;
- Redraw;
- Make_Message('Print formatter aborted by user.');
- End;
- Refresh := True;
- Messages := True;
- Undo_Stat := Temp_Undo;
-
- Reg_Exp_Stat := T_Reg_Exp_Stat;
- Insert_Mode := T_Insert_Mode;
- return_int := 100;
- error_level := 0;
-
- { special development code for testing execution time
- If ((Val(End_Minutes,Copy(Time,4,2))) and (Val(End_Seconds,Copy(Time,7,2)))) Then
- End;
- If (Start_Seconds > End_Seconds) Then
- End_Seconds := End_Seconds + 60;
- --End_Minutes;
- End;
- If (Start_Minutes > End_Minutes) Then
- End_Minutes := End_Minutes + 60;
- End;
- Switch_Win_Id(Print_Window);
- Text('Elapsed time ' + Str(End_Minutes - Start_Minutes) + ':' + Str(End_Seconds - Start_Seconds));
- }
- END_MACRO;
-
- $MACRO FCMD TRANS;
- {******************************************************************************
- MULTI-EDIT MACRO
-
- Name: FCMD
-
- Description: The top level menu for inserting print formatting codes.
-
- (C) Copyright 1989 by American Cybernetics, Inc.
- ******************************************************************************}
- Set_Global_Str('FCT_1','/H=PRNFORM^FMTCODEMISC/M=F_CODE_SUBMENU /MC=1');
- Set_Global_Str('XFCT_1','Misc');
- Set_Global_Str('FCT_2','/H=PRNFORM^FMTCODEVAR/M=F_CODE_SUBMENU /MC=2');
- Set_Global_Str('XFCT_2','Variables');
- Set_Global_Str('FCT_3','/H=PRNFORM^FMTCODEATT/M=F_CODE_SUBMENU /MC=3');
- Set_Global_Str('XFCT_3','Attributes');
- Set_Global_Str('FCT_4','/H=PRNFORM^FMTCODEPGSTUP/M=F_CODE_SUBMENU /MC=4');
- Set_Global_Str('XFCT_4','Page-setup');
- Set_Global_Str('FCT_5','/H=PRNFORM^FMTCODEHDRFTR/M=F_CODE_SUBMENU /MC=5');
- Set_Global_Str('XFCT_5','Headers-footers');
- Set_Global_Str('FCT_6','/H=PRNFORM^TOFC/M=F_CODE_SUBMENU /MC=6');
- Set_Global_Str('XFCT_6','Table-of-contents');
-
- RM('USERIN^TOPMENU /M=XFCT_/G=FCT_/#=6/X=3/S=1/BC=1/L=INSERT PRINT FORMATTER CODES/Y=4');
-
- Set_Global_Str('FCT_1','');
- Set_Global_Str('XFCT_1','');
- Set_Global_Str('FCT_2','');
- Set_Global_Str('XFCT_2','');
- Set_Global_Str('FCT_3','');
- Set_Global_Str('XFCT_3','');
- Set_Global_Str('FCT_4','');
- Set_Global_Str('XFCT_4','');
- Set_Global_Str('FCT_5','');
- Set_Global_Str('XFCT_5','');
- Set_Global_Str('FCT_6','');
- Set_Global_Str('XFCT_6','');
- return_int := 100;
- END_MACRO;
-
- $MACRO F_CODE_SUBMENU;
- {******************************************************************************
- MULTI-EDIT MACRO
-
- Name: F_CODE_SUBMENU
-
- Description: The sub level menu for inserting print formatting codes.
-
- (C) Copyright 1989 by American Cybernetics, Inc.
- ******************************************************************************}
- Def_Int(Main_Choice,Sub_Count);
- Def_Str(Sub_Str,Sub_Title);
-
- Main_Choice := Parse_Int('/MC=',MParm_Str);
-
- If (Main_Choice = 1) Then
- Set_Global_Str('FCS_1','/H=PRNFORM^FMTCODEMISC/M=INSERT_F_CODES /MC=1/SC=1');
- Set_Global_Str('XFCS_1','page Break');
- Set_Global_Str('FCS_2','/M=INSERT_F_CODES /MC=1/SC=2');
- Set_Global_Str('XFCS_2','Center');
- Set_Global_Str('FCS_3','/M=INSERT_F_CODES /MC=1/SC=3');
- Set_Global_Str('XFCS_3','cOmment');
- Set_Global_Str('FCS_4','/M=INSERT_F_CODES /MC=1/SC=4');
- Set_Global_Str('XFCS_4','iGnore');
- Set_Global_Str('FCS_5','/M=INSERT_F_CODES /MC=1/SC=5');
- Set_Global_Str('XFCS_5','Define user code');
- Set_Global_Str('FCS_6','/M=INSERT_F_CODES /MC=1/SC=6');
- Set_Global_Str('XFCS_6','Execute user code');
- Sub_Count := 6;
- Sub_Title := 'MISCELLANEOUS';
- End;
-
- If (Main_Choice = 2) Then
- Set_Global_Str('FCS_1','/H=PRNFORM^FMTCODEVAR/M=INSERT_F_CODES /MC=2/SC=1');
- Set_Global_Str('XFCS_1','File name');
- Set_Global_Str('FCS_2','/M=INSERT_F_CODES /MC=2/SC=2');
- Set_Global_Str('XFCS_2','Time');
- Set_Global_Str('FCS_3','/M=INSERT_F_CODES /MC=2/SC=3');
- Set_Global_Str('XFCS_3','Date');
- Set_Global_Str('FCS_4','/M=INSERT_F_CODES /MC=2/SC=4');
- Set_Global_Str('XFCS_4','Page number');
- Sub_Count := 4;
- Sub_Title := 'VARIABLES';
- End;
-
- If (Main_Choice = 3) Then
- RM('INSERT_F_CODES /MC=3' + mparm_str);
-
- IF (return_int < 1) THEN
- Goto EXIT2;
- END;
- Goto EXIT;
- End;
-
-
- If (Main_Choice = 4) Then
- Set_Global_Str('FCS_1','/H=PRNFORM^FMTCODEPGSTUP/M=INSERT_F_CODES /MC=4/SC=1');
- Set_Global_Str('XFCS_1','line Spacing');
- Set_Global_Str('FCS_2','/M=INSERT_F_CODES /MC=4/SC=2');
- Set_Global_Str('XFCS_2','Page length');
- Set_Global_Str('FCS_3','/M=INSERT_F_CODES /MC=4/SC=3');
- Set_Global_Str('XFCS_3','Right margin');
- Set_Global_Str('FCS_4','/M=INSERT_F_CODES /MC=4/SC=4');
- Set_Global_Str('XFCS_4','Left margin');
- Set_Global_Str('FCS_5','/M=INSERT_F_CODES /MC=4/SC=5');
- Set_Global_Str('XFCS_5','Top margin');
- Set_Global_Str('FCS_6','/M=INSERT_F_CODES /MC=4/SC=6');
- Set_Global_Str('XFCS_6','Bottom margin');
- Set_Global_Str('FCS_7','/M=INSERT_F_CODES /MC=4/SC=7');
- Set_Global_Str('XFCS_7','Form feeds');
- Sub_Count := 7;
- Sub_Title := 'PAGE SETUP';
- End;
-
- If (Main_Choice = 5) Then
- Set_Global_Str('FCS_1','/H=PRNFORM^FMTCODEHDRFTR/M=INSERT_F_CODES /MC=5/SC=1');
- Set_Global_Str('XFCS_1','define Header');
- Set_Global_Str('FCS_2','/M=INSERT_F_CODES /MC=5/SC=2');
- Set_Global_Str('XFCS_2','define Footer');
- Set_Global_Str('FCS_3','/M=INSERT_F_CODES /MC=5/SC=3');
- Set_Global_Str('XFCS_3','Suppress header');
- Set_Global_Str('FCS_4','/M=INSERT_F_CODES /MC=5/SC=4');
- Set_Global_Str('XFCS_4','sUpress footer');
- Set_Global_Str('FCS_5','/M=INSERT_F_CODES /MC=5/SC=5');
- Set_Global_Str('XFCS_5','header Margin');
- Set_Global_Str('FCS_6','/M=INSERT_F_CODES /MC=5/SC=6');
- Set_Global_Str('XFCS_6','footer mArgin');
- Sub_Count := 6;
- Sub_Title := 'HEADERS//FOOTERS';
- End;
-
- If (Main_Choice = 6) Then
- Set_Global_Str('FCS_1','/H=PRNFORM^TOFC/M=INSERT_F_CODES /MC=6/SC=1');
- Set_Global_Str('XFCS_1','Define table');
- Set_Global_Str('FCS_2','/M=INSERT_F_CODES /MC=6/SC=2');
- Set_Global_Str('XFCS_2','table Entry');
- Sub_Count := 2;
- Sub_Title := 'TABLE OF CONTENTS';
- End;
-
- RM('USERIN^SUBMENU /GCLR=1/M=XFCS_/G=FCS_/S=1/L=' + Sub_Title + '/#='
- + Str(Sub_Count) + '/X=' + Parse_Str('/X=',MParm_Str) + '/Y=' +
- Parse_Str('/Y=',MParm_Str));
- IF (Return_Int < 1) THEN
- { IF (Return_int = -1) THEN
- Key1 := 0;
- Key2 := 72;
- END;
- Return_int := 0; }
- Goto EXIT2;
- END;
-
- EXIT:
- return_int := 100;
- EXIT2:
- Sub_Count := 7;
- WHILE (Sub_Count) DO
- Set_Global_Str('FCS_' + Str(Sub_Count),'');
- Set_Global_Str('XFCS_' + Str(Sub_Count),'');
- --Sub_Count;
- END;
-
- END_MACRO;
-
- $MACRO INSERT_F_CODES TRANS;
- {******************************************************************************
- MULTI-EDIT MACRO
-
- Name: INSERT_F_CODES
-
- Description: Inserts print formatting codes based on menu choices from
- F_CODE_SUBMENU.
-
- (C) Copyright 1989 by American Cybernetics, Inc.
- ******************************************************************************}
-
- Def_Int(Temp_Integer,Main_Choice,Sub_Choice,Jx,Jy,Temp_Refresh,
- Temp_Insert_Mode);
- Def_Str(Temp_String,Temp_String2,Printer_Type[20]{,Temp_Word_Delimits[40]});
- Def_Char(Code_Delimiter);
-
- Temp_Refresh := Refresh;
- Refresh := False;
- Temp_Insert_Mode := Insert_Mode;
- Printer_Type := Parse_Str('PT=',Global_Str('Printer_Type'));
- Main_Choice := 1;
- Sub_Choice := 1;
- Code_Delimiter := Global_Str('Format_Code_Delimit');
- IF (Code_Delimiter = '') THEN
- Code_Delimiter := '.';
- END;
-
- Main_Choice := Parse_Int('/MC=',MParm_Str);
- Sub_Choice := Parse_Int('/SC=',MParm_Str);
-
- If (Main_Choice = 1) Then
- If (Sub_Choice = 0) Then
- Goto DONT_INSERT_CODE;
- End;
-
- Temp_String := '';
- If (Sub_Choice = 1) Then
- {Querybox is a general purpose "boxed" prompt.}
- Return_Int := 0;
- RM('QUERYBOX /N=1/P=Enter new page number:/H=PRNFORM^FMTCODEMISC/C=5/L=7/W=4' +
- '/T=PAGE BREAK/MIN=0');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- If (Sub_Choice = 5) Then
- Return_Int := 1;
- RM('QUERYBOX /N=1/P=Enter number of user code(1-10):/H=PRNFORM^FMTCODEMISC/C=5' +
- '/L=7/W=2/T=DEFINE USER CODE/MIN=1/MAX=10');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- If (Sub_Choice = 6) Then
- Return_Int := 1;
- RM('QUERYBOX /N=1/P=Enter number of user code(1-10):/H=PRNFORM^FMTCODEMISC/C=5' +
- '/L=7/W=2/T=DEFINE USER CODE/MIN=1/MAX=10');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- Temp_String := Copy('pbcenpigduud',((Sub_Choice - 1) * 2) + 1,2) +
- Temp_String;
- Goto INSERT_CODE;
- End;
-
- If (Main_Choice = 2) Then
- If (Sub_Choice = 0) Then
- Kill_Box;
- Goto DONT_INSERT_CODE;
- End;
- Temp_String := Copy('fntidapa',((Sub_Choice - 1) * 2) + 1,2);
- Goto INSERT_CODE;
- End;
-
- If (Main_Choice = 3) Then
- IF (Printer_Type = '') THEN
- RM('MEERROR^Beeps /C=1');
- Make_Message('Printer type not specified! Use Install or Print. Press any key.');
- Goto DONT_INSERT_CODE;
- END;
-
- RM('MEUTIL3^PRINT_CODE_MENU /F=1' + MParm_Str);
-
- IF (Return_Int < 1) THEN
- Goto ATTRIBUTE_EXIT;
- END;
- IF (Parse_Str('/F=',Return_Str) = '') THEN
- Goto BACK_UP;
- ELSE
- Temp_String := Parse_Str('/F=',Return_Str);
- Goto INSERT_CODE;
- END;
- End;
-
-
- If (Main_Choice = 4) Then
- If (Sub_Choice = 0) Then
- Kill_Box;
- Goto DONT_INSERT_CODE;
- End;
-
- Temp_String := '';
- If (Sub_Choice = 1) Then
- Return_Int := 1;
- RM('QUERYBOX /N=1/P=Enter line spacing:/H=PRNFORM^FMTCODEPGSTUP/C=31/L=7/W=2' +
- '/T=LINE SPACING/MIN=1');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- If (Sub_Choice = 2) Then
- Return_Int := 66;
- RM('QUERYBOX /N=1/P=Enter page length:/H=PRNFORM^FMTCODEPGSTUP/C=31/L=7/W=3' +
- '/T=PAGE LENGTH/MIN=1');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- If (Sub_Choice = 3) Then
- Return_Int := 80;
- RM('QUERYBOX /N=1/P=Enter right margin:/H=PRNFORM^FMTCODEPGSTUP/C=31/L=7/W=3' +
- '/T=RIGHT MARGIN/MIN=2/MAX=254');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- If (Sub_Choice = 4) Then
- Return_Int := 0;
- RM('QUERYBOX /N=1/P=Enter left margin:/H=PRNFORM^FMTCODEPGSTUP/C=31/L=7/W=2' +
- '/T=LEFT MARGIN/MIN=1');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- If (Sub_Choice = 5) Then
- Return_Int := 5;
- RM('QUERYBOX /N=1/P=Enter top margin:/H=PRNFORM^FMTCODEPGSTUP/C=31/L=7/W=2' +
- '/T=TOP MARGIN/MIN=-1');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- If (Sub_Choice = 6) Then
- Return_Int := 60;
- RM('QUERYBOX /N=1/P=Enter bottom margin:/H=PRNFORM^FMTCODEPGSTUP/C=31/L=7/W=3' +
- '/T=BOTTOM MARGIN/MIN=1');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- If (Sub_Choice = 7) Then
- Put_Box(31,7,67,10,0,M_B_Color,'FORM FEEDS',True);
- Write('Form feeds at page breaks:',32,8,0,M_B_Color);
- RM('USERIN^XMENU /T=0/X=59/Y=8/S=2/M=On(PRNFORM^FMTCODEPGSTUP)oFf()');
- Temp_Integer := Return_Int;
- Kill_Box;
- If (Temp_Integer < 1) Then
- Goto BACK_UP;
- End;
- Temp_String := Copy('10',Temp_Integer,1);
- End;
-
- Temp_String := Copy('lsplrmlmtmbmff',((Sub_Choice - 1) * 2) + 1,2) + Temp_String;
- Goto INSERT_CODE;
- End;
-
- If (Main_Choice = 5) Then
- If (Sub_Choice = 0) Then
- Kill_Box;
- Goto DONT_INSERT_CODE;
- End;
- Temp_String := '';
- If (Sub_Choice = 1) Then
- Put_Box(42,7,76,10,0,M_B_Color,'DEFINE HEADER',True);
- Write('Which header?',43,8,0,M_B_Color);
- RM('USERIN^XMENU /T=0/X=57/Y=8/S=1/M=Primary(PRNFORM^FMTCODEHDRFTR)Secondary()');
- Temp_Integer := Return_Int;
- Kill_Box;
- If (Temp_Integer < 1) Then
- Goto BACK_UP;
- End;
- Temp_String := Copy('12',Temp_Integer,1);
- End;
-
- If (Sub_Choice = 2) Then
- Put_Box(42,7,76,10,0,M_B_Color,'DEFINE FOOTER',True);
- Write('Which footer?',43,8,0,M_B_Color);
- RM('USERIN^XMENU /T=0/X=57/Y=8/S=1/M=Primary(PRNFORM^FMTCODEHDRFTR)Secondary()');
- Temp_Integer := Return_Int;
- Kill_Box;
- If (Temp_Integer < 1) Then
- Goto BACK_UP;
- End;
- Temp_String := Copy('12',Temp_Integer,1);
- End;
-
- If (Sub_Choice = 5) Then
- Return_Int := 2;
- RM('QUERYBOX /N=1/P=Enter header margin:/H=PRNFORM^FMTCODEHDRFTR/C=42/L=7/W=2' +
- '/T=HEADER MARGIN/MIN=-1');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
-
- If (Sub_Choice = 6) Then
- Return_Int := 64;
- RM('QUERYBOX /N=1/P=Enter footer margin:/H=PRNFORM^FMTCODEHDRFTR/C=42/L=7/W=3' +
- '/T=FOOTER MARGIN/MIN=2');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- Temp_String := Copy('dhdfshsfhmfm',((Sub_Choice - 1) * 2) + 1,2) + Temp_String;
- Goto INSERT_CODE;
- End;
-
- If (Main_Choice = 6) Then
- If (Sub_Choice = 0) Then
- Kill_Box;
- Goto DONT_INSERT_CODE;
- End;
-
- Temp_String := '';
- If (Sub_Choice = 1) Then
- Set_Global_Int('IINT_1',75);
- Set_Global_Str('IPARM_1','/T=Right margin for page numbers /TP=1/C=1/L=1/W=3/H=PRNFORM^TOFC');
- Set_Global_Str('ISTR_2','/T=Yes/F=No');
- Set_Global_Str('IPARM_2','/T=Use periods between table entry and page number /TP=5/C=1/L=2/W=3/H=PRNFORM^TOFC');
- Set_Global_Int('IINT_2',0);
-
- Set_Global_Str('ISTR_3','/T=Yes/F=No');
- Set_Global_Str('IPARM_3','/T=Include headers in table of contents /TP=5/C=1/L=3/W=3/H=PRNFORM^TOFC');
- Set_Global_Int('IINT_3',1);
- Set_Global_Str('ISTR_4','/T=Yes/F=No');
- Set_Global_Str('IPARM_4','/T=Include footers in table of contents /TP=5/C=1/L=4/W=3/H=PRNFORM^TOFC');
- Set_Global_Int('IINT_4',1);
-
- Set_Global_Int('IINT_5',0);
- Set_Global_Str('IPARM_5','/T=Amount of indenting from left margin for level 1 /TP=1/C=1/L=6/W=2/H=PRNFORM^TOFC');
- Set_Global_Str('ISTR_6','Plain(PRNFORM^TOFC)Numeric()Alpha()Roman numeral()');
- Set_Global_Int('IINT_6',1);
- Set_Global_Str('IPARM_6','/T=Level 1 table style /TP=3/C=1/L=7/W=13/H=PRNFORM^TOFC');
-
- Set_Global_Int('IINT_7',5);
- Set_Global_Str('IPARM_7','/T=Amount of indenting from level 1 for level 2 /TP=1/C=1/L=9/W=2/H=PRNFORM^TOFC');
- Set_Global_Str('ISTR_8','Plain(PRNFORM^TOFC)Numeric()Alpha()Roman numeral()');
- Set_Global_Int('IINT_8',1);
- Set_Global_Str('IPARM_8','/T=Level 2 table style /TP=3/C=1/L=10/W=13/H=PRNFORM^TOFC');
-
- Set_Global_Int('IINT_9',5);
- Set_Global_Str('IPARM_9','/T=Amount of indenting from level 2 for level 3 /TP=1/C=1/L=12/W=2/H=PRNFORM^TOFC');
- Set_Global_Str('ISTR_10','Plain(PRNFORM^TOFC)Numeric()Alpha()Roman numeral()');
- Set_Global_Int('IINT_10',1);
- Set_Global_Str('IPARM_10','/T=Level 3 table style /TP=3/C=1/L=13/W=13/H=PRNFORM^TOFC');
-
- Set_Global_Int('IINT_11',5);
- Set_Global_Str('IPARM_11','/T=Amount of indenting from level 3 for level 4 /TP=1/C=1/L=15/W=2/H=PRNFORM^TOFC');
- Set_Global_Str('ISTR_12','Plain(PRNFORM^TOFC)Numeric()Alpha()Roman numeral()');
- Set_Global_Int('IINT_12',1);
- Set_Global_Str('IPARM_12','/T=Level 4 table style /TP=3/C=1/L=16/W=13/H=PRNFORM^TOFC');
-
- Set_Global_Int('IINT_13',5);
- Set_Global_Str('IPARM_13','/T=Amount of indenting from level 4 for level 5 /TP=1/C=1/L=18/W=2/H=PRNFORM^TOFC');
- Set_Global_Str('ISTR_14','Plain(PRNFORM^TOFC)Numeric()Alpha()Roman numeral()');
- Set_Global_Int('IINT_14',1);
- Set_Global_Str('IPARM_14','/T=Level 5 table style /TP=3/C=1/L=19/W=13/H=PRNFORM^TOFC');
-
-
- RM( 'USERIN^DATA_IN /A=2/#=14/S=1/X=3/T=DEFINE TABLE OF CONTENTS/X=17/Y=4');
-
- Temp_String := ' ' + Str(Global_Int('IINT_1')) +
- ' ' + Str(Global_Int('IINT_2')) +
- ' ' + Str(Not(Global_Int('IINT_3'))) +
- ' ' + Str(Not(Global_Int('IINT_4'))) +
- ' ' + Str(Global_Int('IINT_5')) +
- ' ' + Str(Global_Int('IINT_6') - 1) +
- ' ' + Str(Global_Int('IINT_7')) +
- ' ' + Str(Global_Int('IINT_8') - 1) +
- ' ' + Str(Global_Int('IINT_9')) +
- ' ' + Str(Global_Int('IINT_10') - 1) +
- ' ' + Str(Global_Int('IINT_11')) +
- ' ' + Str(Global_Int('IINT_12') - 1) +
- ' ' + Str(Global_Int('IINT_13')) +
- ' ' + Str(Global_Int('IINT_14') - 1);
-
- {
- Put_Box(19,7,80,10,0,M_B_Color,'DEFINE TABLE',True);
-
- return_Int := 75;
- RM( 'USERIN^QUERYBOX /NB=1/N=1/MIN=5/MAX=254/P=Enter right margin for table: /W=3/C=19/L=7/H=PRNFORM^TOFC' );
- temp_string := Str(Return_Int);
- IF (return_str = 'TRUE') THEN
- Temp_String := ' ' + Temp_String;
- Else
- Kill_Box;
- Goto BACK_UP;
- End;
-
- {
- Write('Enter right margin for table: ',20,8,0,M_B_Color);
- return_str := temp_string;
- RM( 'USERIN^USERSTR /W=3/X=49/Y=8/H=PRNFORM^TOFC' );
- temp_string := return_str;
- IF return_int THEN
- Temp_String := ' ' + Temp_String;
- Else
- Kill_Box;
- Goto BACK_UP;
- End;
- }
-
- Write('Press <ESC> to default the remaining table parameters',23,9,0,M_B_Color);
- Write('Use periods between table entry and page number?',20,8,0,M_B_Color);
- RM('USERIN^XMENU /T=0/X=71/Y=8/S=1/M=No(PRNFORM^TOFC)Yes()');
- IF (Return_int < 1) THEN
- Goto NO_MORE_LEVELS;
- END;
- Temp_String := Temp_String + Copy(' 0 1',((Return_int - 1) * 2) + 1,2);
-
- Draw_Char(32,20,8,M_B_Color,58);
- Write('Allow header to be printed in table of contents?',20,8,0,M_B_Color);
- RM('USERIN^XMENU /T=0/X=69/Y=8/S=1/M=Yes(PRNFORM^TOFC)No()');
- IF (Return_int < 1) THEN
- Goto NO_MORE_LEVELS;
- END;
- Temp_String := Temp_String + Copy(' 0 1',((Return_int - 1) * 2) + 1,2);
- Write('Allow footer to be printed in table of contents?',20,8,0,M_B_Color);
- RM('USERIN^XMENU /T=0/X=69/Y=8/S=1/M=Yes(PRNFORM^TOFC)No()');
- IF (Return_int < 1) THEN
- Goto NO_MORE_LEVELS;
- END;
- Temp_String := Temp_String + Copy(' 0 1',((Return_int - 1) * 2) + 1,2);
-
- Temp_Integer := 1;
- Draw_Char(32,20,8,M_B_Color,58);
- MORE_LEVELS:
- Write('Enter amount of indenting for table level ' + Str(Temp_Integer) + ':',20,8,0,M_B_Color);
- Temp_String2 := '';
- Return_Str := Temp_String2;
- RM( 'USERIN^USERSTR /W=3/X=64/Y=8/H=PRNFORM^TOFC' );
- temp_string2 := return_str;
- IF not( return_int ) THEN
- Goto NO_MORE_LEVELS;
- End;
- If (Temp_String2 <> '') Then
- Temp_String := Temp_String + ' ' + Temp_String2;
- End;
- Draw_Char(32,20,8,M_B_Color,58);
-
- Write('Enter style for table level ' + Str(Temp_Integer) + ':',20,8,0,M_B_Color);
- RM('USERIN^XMENU /T=0/X=51/Y=8/S=1/M=Plain(PRNFORM^TOFC)Numeric()Alpha()Roman numeral()');
- IF (return_int < 1) THEN
- Goto NO_MORE_LEVELS;
- End;
- Temp_String := Temp_String + ' ' + Str(Return_Int - 1);
- {
- Write('Enter format for table level ' + Str(Temp_Integer) + ':',20,8,0,M_B_Color);
- Return_Str := Temp_String2;
- RM( 'USERIN^USERSTR /W=3/X=51/Y=8/H=PRNFORM^TOFC' );
- temp_string2 := return_str;
- IF NOT(return_int) THEN
- Goto NO_MORE_LEVELS;
- End;
- If (Temp_String2 <> '') Then
- Temp_String := Temp_String + ' ' + Temp_String2;
- End;
- }
-
- Temp_Integer := Temp_Integer + 1;
- If (Temp_Integer > 5) Then
- Goto NO_MORE_LEVELS;
- Else
- Goto MORE_LEVELS;
- End;
- NO_MORE_LEVELS:
- Kill_Box;
- }
- End;
-
- If (Sub_Choice = 2) Then
- Return_Int := 1;
- RM('QUERYBOX /N=1/P=Enter table indent level:/H=PRNFORM^TOFC/C=50/L=7/W=1' +
- '/T=TABLE ENTRY/MIN=1/MAX=5');
- IF (Return_Str = 'FALSE') THEN
- Goto BACK_UP;
- END;
- Temp_String := Str(Return_Int);
- End;
- Temp_String := Copy('tcte',((Sub_Choice - 1) * 2) + 1,2) + Temp_String;
- Goto INSERT_CODE;
- End;
-
- GOTO DONT_INSERT_CODE;
-
- BACK_UP:
- Return_Int := 0;
- Goto BACK_UP_EXIT;
-
- INSERT_CODE:
- Insert_Mode := True;
- Text(Code_Delimiter + Temp_String);
- DONT_INSERT_CODE:
- Return_Int := 1;
- BACK_UP_EXIT:
- Goto END_OF_MAC;
-
- END_OF_MAC:
- return_int := 100;
- ATTRIBUTE_EXIT:
- Refresh := Temp_Refresh;
- Insert_Mode := Temp_Insert_Mode;
- END_MACRO;