ProfitPress Mega CDROM2 Shareware Freeware (MSDOS)(1992)(Eng)

home *** CD-ROM | disk | FTP | other *** search

/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / MISC / PAGER2.ZIP / PAGER2.SRC < prev

Wrap

Text File | 1989-06-16 | 103.5 KB | 3,274 lines

--:::::::::: --pager2.inc --:::::::::: -- Include file for PAGER2 Release pager2.inc -- Documentation on PAGER2 (PRF file is raw ASCII, DOC file is formatted) pager2.prf pager2.doc -- The package spec to CLI cli.ada -- Select one of these package -- bodies, depending on your compiler cli_alsys.ada cli_cais.ada cli_general.ada cli_integr.ada cli_verdix.ada cli_vms.ada -- Source code in Ada for PAGER2 pager2.ada --:::::::::: --pager2.prf --:::::::::: .lm 10 .rm 70 .ce 100 PAGER2 by Richard Conn .ce 0 .he //PAGER2// .fo /Richard Conn//Page #/ .de LIST .nr c 0 .in +8 .rm -8 .en .de ELIST .rm +8 .in -8 .en .de LE .sp 1 .ti -2 .nr c +1 @nc. .en .de section .sp 4 .ne 10 .nr a +1 .nr b 0 @na. .en .de subsection .sp 2 .ne 10 .nr b +1 @na.@nb. .en .nr a 0 .de PP .sp 1 .ti +5 .en .in +3 .rm -3 .PP PAGER2 is a tool for creating paged files, extracting the component files from a paged file, and scanning paged files, where a paged file is a file composed of one or more files prefixed by banners. PAGER2 is based in concept on the UNPAGE tool submitted to the Ada Software Repository on SIMTEL20 by Mitre Corporation. .PP Paged files are convenient mechanisms for storing related files. They reduce cluttering in the directories and simplify the file transfer process by requiring the user to transfer only one file in order to obtain all files pertinent to a particular project or tool. Additionally, paged files are text files which can be handled more readily than the 8-bit binary images associated with other file grouping mechanisms (see the file OILBR.DOC in the directory PD2:<ADA.GENERAL> in the Ada Software Repository). Paged files may be manipulated by a text editor if necessary. .PP For these reasons, paged files have been adopted as a standard for file storage in the Ada Software Repository. The file type of SRC (as in MYFILE.SRC) indicates that a file is paged. .rm +3 .in -3 .section PAGED FILE FORMAT .PP A paged file is a file composed of one or more files prefixed by banners of the form: .sp 1 .ne 10 .nf .nj :::::::::: filename :::::::::: or --:::::::::: --filename --:::::::::: .ju .fi .PP The first banner conforms to the PAGE standard employed on UNIX. The second banner is an adaptation of the first form which resembles Ada comments. The second banner is convenient when the paged file contains several files associated with a particular Ada program and they are placed in the paged file in compilation order. The resulting paged file may then be compiled without being disassembled first. .section PAGER2 COMMANDS .PP PAGER2 responds to the following commands: .LIST .LE PAGE or P - create a paged file .LE UNPAGE or U - extract the components of a paged file into their separate files .LE LIST or L - list components of a paged file to the screen .LE INCLUDE or I - list components of a paged file into an include file .LE HELP or H - print a command summary .LE EXIT or X - exit PAGER2 .ELIST .PP The case used to enter these command verbs is not significant. The case used to enter the file names referenced as arguments to the command verbs is significant if the host operating system distinguishes case in file names, as does UNIX (but not MSDOS). .subsection PAGE Command .PP The PAGE function is used to created a paged file from one or more component files. The syntax of the PAGE command is: .sp 1 .nf .nj PAGE [filename | @include__filename]+ paged__file__name .ju .fi .PP Two or more file names may be specified after the PAGE verb. The last file name is the name of the paged file to be created. The other file names are the names of files to be placed into the paged file or the names of include files from which the names of files to be placed into the paged file are to be extracted. .PP If the user prefixes the name of a component file with an atsign character (_@), the indicated file is processed as an include file. An include file is a file which contains the names of zero or more component files, one name per line starting in the first column. Other include files may be referenced within an include file by prefixing their names with the atsign character. Comments may be placed within an include file by placing two dashes in the first two columns of a line. The following is an example of an include file: .sp 1 .ne 15 .nf .nj Example Comments ======= ======== -- -- This is an include file for Comment at the beginning -- my favorite tool -- Blank lines are allowed -- -- The following include file -- contains the names of the Another comment -- Ada source files in compilation -- order -- @mytool.cmp -- -- The following are the documentation -- files -- mytool.ref mytool.doc mytool.idx .fi .ju .PP A single letter "P" may be used rather than the full "PAGE" verb. An example of the execution of the PAGE command is: .sp 1 .ne 8 .nf .nj PAGER2> page PAGE Command requires the name of the paged file and include file Syntax: page [@include__file__name|file__name]+ paged__file__name PAGER2> p @demo.inc demo.src Adding demo.inc -- 8 Lines Adding demo1.txt -- 1 Lines Adding demo2.txt -- 1 Lines .ju .fi .subsection UNPAGE Command .PP The UNPAGE function extracts the components from the indicated paged file, leaving the original paged file intact. The syntax of UNPAGE is: .sp 1 .nf .nj UNPAGE paged__filename .ju .fi .PP The single letter "U" may be used rather than the full "UNPAGE" verb. An example of the execution of the UNPAGE command is: .sp 1 .ne 8 .nf .nj PAGER2> unpage UNPAGE Command requires the name of a paged file Syntax: unpage paged__file__name PAGER2> u demo.src Extracting demo.inc -- 8 Lines Extracting demo1.txt -- 1 Lines Extracting demo2.txt -- 1 Lines .ju .fi .subsection LIST Command .PP The LIST function is used to create a text file containing the names of the component files within a paged file. The syntax of the LIST command is: .sp 1 .nf .nj LIST paged__file__name .ju .fi .PP The single letter "L" may be used rather than the full "LIST" verb. An example of the execution of the LIST command is: .sp 1 .ne 8 .nf .nj PAGER2> list LIST Command requires the name of a paged file Syntax: list paged__file__name PAGER2> list demo.src demo.inc -- 8 Lines demo1.txt -- 1 Lines demo2.txt -- 1 Lines .ju .fi .subsection INCLUDE Command .PP The INCLUDE command performs the same function of the LIST command, but it places the output into an include file which is suitable for building a new paged file. Its syntax is: .sp 1 .nf .nj INCLUDE paged__file__name include__file__name .ju .fi .PP The single letter "I" may be used rather than the full "INCLUDE" verb. An example of the execution of the INCLUDE command is: .sp 1 .ne 8 .nf .nj PAGER2> include INCLUDE Command requires the name of a paged file Syntax: include paged__file__name output__include__file PAGER2> include demo.src demo2.inc demo.inc -- 8 Lines demo1.txt -- 1 Lines demo2.txt -- 1 Lines .ju .fi .subsection HELP Command .PP The HELP command displays a brief help text to the user. The syntax of this command is: .sp 1 .nf .nj HELP .ju .fi .PP The single letter "H" may be used rather than the full "HELP" verb. .subsection EXIT Command .PP The EXIT command exits PAGER. Its syntax is: .sp 1 .nf .nj EXIT .ju .fi .PP The single letter "X" may be used rather than the full "EXIT" verb. .section INVOKING PAGER2 FROM THE COMMAND LINE .PP PAGER2 may also be run from the command line. The PAGER2 verb may be followed by a conventional PAGER2 command, in which case the PAGER2 command alone will be executed and then PAGER2 will exit. In addition, the verb recognized by PAGER2 (like HELP or UNPAGE) may be prefixed with a dash (-), making the syntax of the PAGER2 command line similar to a conventional UNIX command line. For example, to obtain a display of the brief help message, either of these commands may be used: .sp 1 .ne 4 .nf .nj PAGER2 HELP PAGER2 H PAGER2 -H PAGER2 -help .ju .fi .PP Likewise, to create a paged file, named MYFILES.SRC, from the component files FILE1.TXT, FILE2.TXT, and FILE3.TXT, a command like the following could be issued: .sp 1 .ne 4 .nf .nj PAGER2 -PAGE FILE1.TXT FILE2.TXT FILE3.TXT MYFILES.SRC .ju .fi .section SAMPLE SESSION .PP The following is a sample PAGER2 session. It was run on a SUN 3 Model 260 running SunOS 3.5. .sp 1 .nf .nj ifsun0/xanadu> ls -l total 3 -rw-r--r-- 1 xanadu 166 Jun 16 10:23 demo.inc -rw-r--r-- 1 xanadu 23 Jun 16 10:23 demo1.txt -rw-r--r-- 1 xanadu 23 Jun 16 10:23 demo2.txt ifsun0/xanadu> cat demo.inc -- This is a demonstration of the PAGER2 program -- The include file is named DEMO.INC demo.inc -- The source files are DEMO1.TXT and DEMO2.TXT demo1.txt demo2.txt ifsun0/xanadu> cat demo1.txt This is file DEMO1.TXT ifsun0/xanadu> cat demo2.txt This is file DEMO2.TXT ifsun0/xanadu> pager2 PAGER2, Ada Version 1.1 Type 'h' for Help PAGER2> page PAGE Command requires the name of the paged file and include file Syntax: page [@include_file_name|file_name]+ paged_file_name PAGER2> p @demo.inc demo.src Adding demo.inc -- 8 Lines Adding demo1.txt -- 1 Lines Adding demo2.txt -- 1 Lines PAGER2> list LIST Command requires the name of a paged file Syntax: list paged_file_name PAGER2> list demo.src demo.inc -- 8 Lines demo1.txt -- 1 Lines demo2.txt -- 1 Lines PAGER2> include INCLUDE Command requires the name of a paged file Syntax: include paged_file_name output_include_file PAGER2> include demo.src demo2.inc demo.inc -- 8 Lines demo1.txt -- 1 Lines demo2.txt -- 1 Lines PAGER2> x ifsun0/xanadu> cat demo.src --:::::::::: --demo.inc --:::::::::: -- This is a demonstration of the PAGER2 program -- The include file is named DEMO.INC demo.inc -- The source files are DEMO1.TXT and DEMO2.TXT demo1.txt demo2.txt --:::::::::: --demo1.txt --:::::::::: This is file DEMO1.TXT --:::::::::: --demo2.txt --:::::::::: This is file DEMO2.TXT ifsun0/xanadu> cat demo2.inc -- Include file for demo.src demo.inc demo1.txt demo2.txt ifsun0/xanadu> pager2 PAGER2, Ada Version 1.1 Type 'h' for Help PAGER2> u demo.src Extracting demo.inc -- 8 Lines Extracting demo1.txt -- 1 Lines Extracting demo2.txt -- 1 Lines PAGER2> unpage UNPAGE Command requires the name of a paged file Syntax: unpage paged_file_name PAGER2> u demo.src Extracting demo.inc -- 8 Lines Extracting demo1.txt -- 1 Lines Extracting demo2.txt -- 1 Lines PAGER2> x ifsun0/xanadu> ls -l total 5 -rw-r--r-- 1 xanadu 166 Jun 16 10:26 demo.inc -rw-r--r-- 1 xanadu 325 Jun 16 10:25 demo.src -rw-r--r-- 1 xanadu 23 Jun 16 10:26 demo1.txt -rw-r--r-- 1 xanadu 58 Jun 16 10:25 demo2.inc -rw-r--r-- 1 xanadu 23 Jun 16 10:26 demo2.txt .ju .fi --:::::::::: --pager2.doc --:::::::::: PAGER2 by Richard Conn PAGER2 is a tool for creating paged files, extracting the component files from a paged file, and scanning paged files, where a paged file is a file composed of one or more files prefixed by banners. PAGER2 is based in concept on the UNPAGE tool submitted to the Ada Software Repository on SIMTEL20 by Mitre Corporation. Paged files are convenient mechanisms for storing related files. They reduce cluttering in the directories and simplify the file transfer process by requiring the user to transfer only one file in order to obtain all files pertinent to a particular project or tool. Additionally, paged files are text files which can be handled more readily than the 8-bit binary images associated with other file grouping mechanisms (see the file OILBR.DOC in the directory PD2:<ADA.GENERAL> in the Ada Software Repository). Paged files may be manipulated by a text editor if necessary. For these reasons, paged files have been adopted as a standard for file storage in the Ada Software Repository. The file type of SRC (as in MYFILE.SRC) indicates that a file is paged. 1. PAGED FILE FORMAT A paged file is a file composed of one or more files prefixed by banners of the form: :::::::::: filename :::::::::: or --:::::::::: --filename --:::::::::: The first banner conforms to the PAGE standard employed on UNIX. The second banner is an adaptation of the first form which resembles Ada comments. The second banner is convenient when the paged file contains several files associated with a particular Ada program and they are placed in the paged file in compilation Richard Conn Page 1 PAGER2 order. The resulting paged file may then be compiled without being disassembled first. 2. PAGER2 COMMANDS PAGER2 responds to the following commands: 1. PAGE or P - create a paged file 2. UNPAGE or U - extract the components of a paged file into their separate files 3. LIST or L - list components of a paged file to the screen 4. INCLUDE or I - list components of a paged file into an include file 5. HELP or H - print a command summary 6. EXIT or X - exit PAGER2 The case used to enter these command verbs is not significant. The case used to enter the file names referenced as arguments to the command verbs is significant if the host operating system distinguishes case in file names, as does UNIX (but not MSDOS). 2.1. PAGE Command The PAGE function is used to created a paged file from one or more component files. The syntax of the PAGE command is: PAGE [filename | @include_filename]+ paged_file_name Two or more file names may be specified after the PAGE verb. The last file name is the name of the paged file to be created. The other file names are the names of files to be placed into the paged file or the names of include files from which the names of files to be placed into the paged file are to be extracted. If the user prefixes the name of a component file with an atsign character (@), the indicated file is processed as an include file. An include file is a file which contains the names of zero or more component files, one name per line starting in the first column. Other Richard Conn Page 2 PAGER2 include files may be referenced within an include file by prefixing their names with the atsign character. Comments may be placed within an include file by placing two dashes in the first two columns of a line. The following is an example of an include file: Example Comments ======= ======== -- -- This is an include file for Comment at the beginning -- my favorite tool -- Blank lines are allowed -- -- The following include file -- contains the names of the Another comment -- Ada source files in compilation -- order -- @mytool.cmp -- -- The following are the documentation -- files -- mytool.ref mytool.doc mytool.idx A single letter "P" may be used rather than the full "PAGE" verb. An example of the execution of the PAGE command is: PAGER2> page PAGE Command requires the name of the paged file and include file Syntax: page [@include_file_name|file_name]+ paged_file_name PAGER2> p @demo.inc demo.src Adding demo.inc -- 8 Lines Adding demo1.txt -- 1 Lines Adding demo2.txt -- 1 Lines 2.2. UNPAGE Command The UNPAGE function extracts the components from the indicated paged file, leaving the original paged file intact. The syntax of UNPAGE is: UNPAGE paged_filename The single letter "U" may be used rather than the full "UNPAGE" verb. An example of the execution of the UNPAGE command is: Richard Conn Page 3 PAGER2 PAGER2> unpage UNPAGE Command requires the name of a paged file Syntax: unpage paged_file_name PAGER2> u demo.src Extracting demo.inc -- 8 Lines Extracting demo1.txt -- 1 Lines Extracting demo2.txt -- 1 Lines 2.3. LIST Command The LIST function is used to create a text file containing the names of the component files within a paged file. The syntax of the LIST command is: LIST paged_file_name The single letter "L" may be used rather than the full "LIST" verb. An example of the execution of the LIST command is: PAGER2> list LIST Command requires the name of a paged file Syntax: list paged_file_name PAGER2> list demo.src demo.inc -- 8 Lines demo1.txt -- 1 Lines demo2.txt -- 1 Lines 2.4. INCLUDE Command The INCLUDE command performs the same function of the LIST command, but it places the output into an include file which is suitable for building a new paged file. Its syntax is: INCLUDE paged_file_name include_file_name The single letter "I" may be used rather than the full "INCLUDE" verb. An example of the execution of the INCLUDE command is: PAGER2> include INCLUDE Command requires the name of a paged file Syntax: include paged_file_name output_include_file PAGER2> include demo.src demo2.inc demo.inc -- 8 Lines demo1.txt -- 1 Lines demo2.txt -- 1 Lines Richard Conn Page 4 PAGER2 2.5. HELP Command The HELP command displays a brief help text to the user. The syntax of this command is: HELP The single letter "H" may be used rather than the full "HELP" verb. 2.6. EXIT Command The EXIT command exits PAGER. Its syntax is: EXIT The single letter "X" may be used rather than the full "EXIT" verb. 3. INVOKING PAGER2 FROM THE COMMAND LINE PAGER2 may also be run from the command line. The PAGER2 verb may be followed by a conventional PAGER2 command, in which case the PAGER2 command alone will be executed and then PAGER2 will exit. In addition, the verb recognized by PAGER2 (like HELP or UNPAGE) may be prefixed with a dash (-), making the syntax of the PAGER2 command line similar to a conventional UNIX command line. For example, to obtain a display of the brief help message, either of these commands may be used: PAGER2 HELP PAGER2 H PAGER2 -H PAGER2 -help Likewise, to create a paged file, named MYFILES.SRC, from the component files FILE1.TXT, FILE2.TXT, and FILE3.TXT, a command like the following could be issued: PAGER2 -PAGE FILE1.TXT FILE2.TXT FILE3.TXT MYFILES.SRC Richard Conn Page 5 PAGER2 4. SAMPLE SESSION The following is a sample PAGER2 session. It was run on a SUN 3 Model 260 running SunOS 3.5. ifsun0/xanadu> ls -l total 3 -rw-r--r-- 1 xanadu 166 Jun 16 10:23 demo.inc -rw-r--r-- 1 xanadu 23 Jun 16 10:23 demo1.txt -rw-r--r-- 1 xanadu 23 Jun 16 10:23 demo2.txt ifsun0/xanadu> cat demo.inc -- This is a demonstration of the PAGER2 program -- The include file is named DEMO.INC demo.inc -- The source files are DEMO1.TXT and DEMO2.TXT demo1.txt demo2.txt ifsun0/xanadu> cat demo1.txt This is file DEMO1.TXT ifsun0/xanadu> cat demo2.txt This is file DEMO2.TXT ifsun0/xanadu> pager2 PAGER2, Ada Version 1.1 Type 'h' for Help PAGER2> page PAGE Command requires the name of the paged file and include file Syntax: page [@includefilename|filename]+ pagedfilename PAGER2> p @demo.inc demo.src Adding demo.inc -- 8 Lines Adding demo1.txt -- 1 Lines Adding demo2.txt -- 1 Lines PAGER2> list LIST Command requires the name of a paged file Syntax: list pagedfilename PAGER2> list demo.src demo.inc -- 8 Lines demo1.txt -- 1 Lines demo2.txt -- 1 Lines PAGER2> include INCLUDE Command requires the name of a paged file Syntax: include pagedfilename outputincludefile Richard Conn Page 6 PAGER2 PAGER2> include demo.src demo2.inc demo.inc -- 8 Lines demo1.txt -- 1 Lines demo2.txt -- 1 Lines PAGER2> x ifsun0/xanadu> cat demo.src --:::::::::: --demo.inc --:::::::::: -- This is a demonstration of the PAGER2 program -- The include file is named DEMO.INC demo.inc -- The source files are DEMO1.TXT and DEMO2.TXT demo1.txt demo2.txt --:::::::::: --demo1.txt --:::::::::: This is file DEMO1.TXT --:::::::::: --demo2.txt --:::::::::: This is file DEMO2.TXT ifsun0/xanadu> cat demo2.inc -- Include file for demo.src demo.inc demo1.txt demo2.txt ifsun0/xanadu> pager2 PAGER2, Ada Version 1.1 Type 'h' for Help PAGER2> u demo.src Extracting demo.inc -- 8 Lines Extracting demo1.txt -- 1 Lines Extracting demo2.txt -- 1 Lines PAGER2> unpage UNPAGE Command requires the name of a paged file Syntax: unpage pagedfilename PAGER2> u demo.src Extracting demo.inc -- 8 Lines Extracting demo1.txt -- 1 Lines Extracting demo2.txt -- 1 Lines Richard Conn Page 7 PAGER2 PAGER2> x ifsun0/xanadu> ls -l total 5 -rw-r--r-- 1 xanadu 166 Jun 16 10:26 demo.inc -rw-r--r-- 1 xanadu 325 Jun 16 10:25 demo.src -rw-r--r-- 1 xanadu 23 Jun 16 10:26 demo1.txt -rw-r--r-- 1 xanadu 58 Jun 16 10:25 demo2.inc -rw-r--r-- 1 xanadu 23 Jun 16 10:26 demo2.txt Richard Conn Page 8 --:::::::::: --cli.ada --:::::::::: package CLI is -------------------------------------------------------------------------- --| BEGIN PROLOGUE --| DESCRIPTION : CLI is a package which implements a Command --| : Line Interface. It mirrors the UNIX/C --| : command line interface, providing an argument --| : count and the arguments themselves. --| : --| REQUIREMENTS SUPPORTED : Command Line Interface --| : --| LIMITATIONS : Compiler limit on string length and dynamic --| : memory. --| : INITIALIZE must be called once, and only once, --| : during the execution of the main Ada proc. --| : --| AUTHOR(S) : Richard Conn (RLC) --| CHANGE LOG : 02/25/88 RLC Initial Version --| : 05/12/89 RLC Review and upgrade --| END PROLOGUE -------------------------------------------------------------------------- procedure INITIALIZE (PROGRAM_NAME : in STRING; COMMAND_LINE_PROMPT : in STRING); -- Initialize this package (this routine must be called before any other -- routines or objects are called or referenced); CALL THIS PROCEDURE -- ONLY ONE TIME function ARGC return NATURAL; -- Number (1 to N) of command line arguments -- ARGC is at least 1 because the name of the program/process -- is always ARGV(0) function ARGV (INDEX : in NATURAL) return STRING; -- Return the INDEXth (0 <= INDEX < ARGC) command line argument -- Example: if ARGC = 1, ARGV(0) is the only valid argument string -- ARGV(0) is always the name of the program/process INVALID_INDEX : exception; -- raised by ARGV if INDEX >= ARGC UNEXPECTED_ERROR : exception; end CLI; --:::::::::: --cli_alsys.ada --:::::::::: -- This implementation of Package Body CLI is Alsys-specific (SUN). -- It requires the Alsys package SYSTEM_ENVIRONMENT. -- Alsys Ada, Version 3.2 with TEXT_IO; with SYSTEM_ENVIRONMENT; package body CLI is LOCAL_ARGC : NATURAL := SYSTEM_ENVIRONMENT.ARG_COUNT; -- Value of ARGC as stored internally procedure INITIALIZE (PROGRAM_NAME : in STRING; COMMAND_LINE_PROMPT : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| INITIALIZE performs necessary initializations. --|DESIGN DESCRIPTION: --| No initialization needed --========================================================= begin null; end INITIALIZE; function ARGC return NATURAL is --========================= PDL =========================== --|ABSTRACT: --| ARGC returns the argument count. --|DESIGN DESCRIPTION: --| Return LOCAL_ARGC --========================================================= begin return LOCAL_ARGC; end ARGC; function ARGV (INDEX : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| ARGV returns the indicated argument string. --|DESIGN DESCRIPTION: --| If INDEX is out of range, raise INVALID_INDEX --| Return GET_FROM_LIST(INDEX) --========================================================= begin if INDEX >= LOCAL_ARGC then raise INVALID_INDEX; end if; return SYSTEM_ENVIRONMENT.ARG_VALUE (INDEX); exception when INVALID_INDEX => raise ; when others => raise UNEXPECTED_ERROR; end ARGV; end CLI; --:::::::::: --cli_cais.ada --:::::::::: -- This implementation of Package Body CLI interfaces thru a CAIS -- (CAIS = Common APSE Interface Set, where APSE = Ada Programming -- Support Environment). -- The definition of CAIS used was DoD-STD-1838, dated 9 October 1986. -- Note: THIS IS UNTESTED BUT BELIEVED TO BE CORRECT (no working CAIS -- implementation was available to test this against). with CAIS_PROCESS_DEFINITIONS; with CAIS_PROCESS_MANAGEMENT; with CAIS_LIST_MANAGEMENT; package body CLI is LOCAL_ARGC : NATURAL := 1; -- Local ARGC value used internally package STRING_LIST is NUMBER_OF_STRINGS : NATURAL := 0; procedure ADD_TO_LIST (ITEM : in STRING); function GET_FROM_LIST (ITEM : in NATURAL) return STRING; end STRING_LIST; package body STRING_LIST is type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL); type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT; type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is record DS : STRING (1 .. LENGTH); NEXT : DYNAMIC_STRING; end record; FIRST : DYNAMIC_STRING := null; LAST : DYNAMIC_STRING := null; procedure ADD_TO_LIST (ITEM : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| ADD_TO_LIST adds the ITEM string to the linked list --| of dynamic strings implemented by this package. --|DESIGN DESCRIPTION: --| Create new DYNAMIC_STRING_OBJECT of the proper length --| Set DS field of new object to the ITEM string --| Set the NEXT field of the new object to NULL --| If FIRST pointer is null --| Set FIRST and LAST to point to the new object --| Else --| Set LAST.NEXT to point to the new object --| Set LAST to point to the new object --| End if --| Increment NUMBER_OF_STRINGS --========================================================= TEMP : DYNAMIC_STRING; begin TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH); TEMP.DS (1 .. ITEM'LENGTH) := ITEM; TEMP.NEXT := null; if FIRST = null then FIRST := TEMP; LAST := TEMP; else LAST.NEXT := TEMP; LAST := TEMP; end if; NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1; end ADD_TO_LIST; function GET_FROM_LIST (ITEM : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| GET_FROM_LIST returns the ITEM string from the linked list --| of dynamic strings implemented by this package. --|DESIGN DESCRIPTION: --| If ITEM > 0 --| Advance to desired item --| End If --| Return the DS field of the desired item --========================================================= ROVER : DYNAMIC_STRING := FIRST; begin if ITEM > 0 then for I in 1 .. ITEM loop ROVER := ROVER.NEXT; end loop; end if; return ROVER.DS; end GET_FROM_LIST; end STRING_LIST; procedure INITIALIZE (PROGRAM_NAME : in STRING; COMMAND_LINE_PROMPT : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| INITIALIZE prompts the user for the command line --| arguments and loads the linked list with them. --|DESIGN DESCRIPTION: --| Set the first list object to PROGRAM_NAME --| Get the list of parameters for the process --| For each parameter, loop --| Extract the next parameter (item) --| Convert the parameter (item) to text --| Add text to the list --| End Loop --| Set LOCAL_ARGC to NUMBER_OF_STRINGS --========================================================= PARAMETERS : CAIS_PROCESS_DEFINITIONS.PARAMETER_LIST; CURRENT_PARAMETER : CAIS_PROCESS_DEFINITIONS.PARAMETER_LIST; NUMBER_OF_PARAMETERS : CAIS_LIST_MANAGEMENT.LIST_SIZE; begin STRING_LIST.ADD_TO_LIST(PROGRAM_NAME); CAIS_PROCESS_MANAGEMENT.GET_PARAMETERS (PARAMETERS); NUMBER_OF_PARAMETERS := CAIS_LIST_MANAGEMENT.NUMBER_OF_ITEMS (PARAMETERS); for I in 1 .. NUMBER_OF_PARAMETERS loop CAIS_LIST_MANAGEMENT.CAIS_LIST_ITEM.EXTRACT_VALUE (FROM_LIST => PARAMETERS, ITEM_POSITION => I, VALUE => CURRENT_PARAMETER); STRING_LIST.ADD_TO_LIST (CAIS_LIST_MANAGEMENT.TEXT_FORM(CURRENT_PARAMETER)); end loop; LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS; end INITIALIZE; function ARGC return NATURAL is --========================= PDL =========================== --|ABSTRACT: --| ARGC returns the argument count. --|DESIGN DESCRIPTION: --| Return LOCAL_ARGC --========================================================= begin return LOCAL_ARGC; end ARGC; function ARGV (INDEX : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| ARGV returns the indicated argument string. --|DESIGN DESCRIPTION: --| If INDEX is out of range, raise INVALID_INDEX --| Return GET_FROM_LIST(INDEX) --========================================================= begin if INDEX >= ARGC then raise INVALID_INDEX; end if; return STRING_LIST.GET_FROM_LIST (INDEX); exception when INVALID_INDEX => raise ; when others => raise UNEXPECTED_ERROR; end ARGV; end CLI; --:::::::::: --cli_general.ada --:::::::::: -- This implementation of Package Body CLI is general-purpose. -- Using TEXT_IO, it prompts the user for input arguments and -- accepts these arguments via a GET_LINE call. with TEXT_IO; package body CLI is LOCAL_ARGC : NATURAL := 0; package STRING_LIST is NUMBER_OF_STRINGS : NATURAL := 0; procedure ADD_TO_LIST (ITEM : in STRING); function GET_FROM_LIST (ITEM : in NATURAL) return STRING; end STRING_LIST; package body STRING_LIST is type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL); type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT; type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is record DS : STRING (1 .. LENGTH); NEXT : DYNAMIC_STRING; end record; FIRST : DYNAMIC_STRING := null; LAST : DYNAMIC_STRING := null; procedure ADD_TO_LIST (ITEM : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| ADD_TO_LIST adds the ITEM string to the linked list --| of dynamic strings implemented by this package. --|DESIGN DESCRIPTION: --| Create new DYNAMIC_STRING_OBJECT of the proper length --| Set DS field of new object to the ITEM string --| Set the NEXT field of the new object to NULL --| If FIRST pointer is null --| Set FIRST and LAST to point to the new object --| Else --| Set LAST.NEXT to point to the new object --| Set LAST to point to the new object --| End if --| Increment NUMBER_OF_STRINGS --========================================================= TEMP : DYNAMIC_STRING; begin TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH); TEMP.DS (1 .. ITEM'LENGTH) := ITEM; TEMP.NEXT := null; if FIRST = null then FIRST := TEMP; LAST := TEMP; else LAST.NEXT := TEMP; LAST := TEMP; end if; NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1; end ADD_TO_LIST; function GET_FROM_LIST (ITEM : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| GET_FROM_LIST returns the ITEM string from the linked list --| of dynamic strings implemented by this package. --|DESIGN DESCRIPTION: --| If ITEM > 0 --| Advance to desired item --| End If --| Return the DS field of the desired item --========================================================= ROVER : DYNAMIC_STRING := FIRST; begin if ITEM > 0 then for I in 1 .. ITEM loop ROVER := ROVER.NEXT; end loop; end if; return ROVER.DS; end GET_FROM_LIST; end STRING_LIST; procedure INITIALIZE (PROGRAM_NAME : in STRING; COMMAND_LINE_PROMPT : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| INITIALIZE prompts the user for the command line --| arguments and loads the linked list with them. --|DESIGN DESCRIPTION: --| Set CURRENT_STATE to LOOKING_FOR_TOKEN --| Set the first list object to PROGRAM_NAME --| Prompt the user with COMMAND_LINE_PROMPT and --| get his response --| Over number of characters in line, loop --| Case CURRENT_STATE --| When LOOKING_FOR_TOKEN --| If character is not white-space --| Set CURRENT_STATE to IN_TOKEN --| If character is quote (") --| Set QUOTED to TRUE --| Set START to the character's index + 1 --| Else --| Set QUOTED to FALSE --| Set START to the character's index --| End IF --| End If --| When IN_TOKEN --| If QUOTED --| If character is quote (") --| Set STOP to the previous character's index --| Add slice from START to STOP to list --| Set CURRENT_STATE to LOOKING_FOR_TOKEN --| End If --| ElsIF character is white-space --| Set STOP to the previous character's index --| Add slice from START to STOP to list --| Set CURRENT_STATE to LOOKING_FOR_TOKEN --| End If --| End Case --| End Loop --| If CURRENT_STATE is IN_TOKEN --| Set STOP to the previous character's index --| Add slice from START to STOP to list --| End if --| Set LOCAL_ARGC to NUMBER_OF_STRINGS --| Output NEW_LINE (to reset column count in TEXT_IO) --========================================================= ARGCOUNT : NATURAL := 1; INLINE : STRING (1 .. 400); LAST : NATURAL; START : NATURAL; STOP : NATURAL; QUOTED : BOOLEAN; type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN); CURRENT_STATE : STATE := LOOKING_FOR_TOKEN; begin STRING_LIST.ADD_TO_LIST (PROGRAM_NAME); TEXT_IO.PUT (COMMAND_LINE_PROMPT); TEXT_IO.GET_LINE (INLINE, LAST); for I in 1 .. LAST loop case CURRENT_STATE is when LOOKING_FOR_TOKEN => if INLINE (I) > ' ' then CURRENT_STATE := IN_TOKEN; if INLINE (I) = '"' then QUOTED := TRUE; START := I; else QUOTED := FALSE; START := I; end if; end if; when IN_TOKEN => if QUOTED then if INLINE (I) = '"' then STOP := I; STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP)); CURRENT_STATE := LOOKING_FOR_TOKEN; end if; elsif INLINE (I) <= ' ' then STOP := I - 1; STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP)); CURRENT_STATE := LOOKING_FOR_TOKEN; end if; end case; end loop; if CURRENT_STATE = IN_TOKEN then STOP := LAST; STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP)); end if; LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS; TEXT_IO.NEW_LINE; end INITIALIZE; function ARGC return NATURAL is --========================= PDL =========================== --|ABSTRACT: --| ARGC returns the argument count. --|DESIGN DESCRIPTION: --| Return LOCAL_ARGC --========================================================= begin return LOCAL_ARGC; end ARGC; function ARGV (INDEX : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| ARGV returns the indicated argument string. --|DESIGN DESCRIPTION: --| If INDEX is out of range, raise INVALID_INDEX --| Return GET_FROM_LIST(INDEX) --========================================================= begin if INDEX >= LOCAL_ARGC then raise INVALID_INDEX; end if; return STRING_LIST.GET_FROM_LIST (INDEX); exception when INVALID_INDEX => raise ; when others => raise UNEXPECTED_ERROR; end ARGV; end CLI; --:::::::::: --cli_integr.ada --:::::::::: -- This implementation of Package Body CLI is for IntegrAda. -- It has been tested under IntegrAda 4.0.1 using MSDOS 3.3. with UTIL; package body CLI is LOCAL_ARGC : NATURAL := 1; -- Local ARGC value stored internally package STRING_LIST is NUMBER_OF_STRINGS : NATURAL := 0; procedure ADD_TO_LIST (ITEM : in STRING); function GET_FROM_LIST (ITEM : in NATURAL) return STRING; end STRING_LIST; package body STRING_LIST is type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL); type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT; type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is record DS : STRING (1 .. LENGTH); NEXT : DYNAMIC_STRING; end record; FIRST : DYNAMIC_STRING := null; LAST : DYNAMIC_STRING := null; procedure ADD_TO_LIST (ITEM : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| ADD_TO_LIST adds the ITEM string to the linked list --| of dynamic strings implemented by this package. --|DESIGN DESCRIPTION: --| Create new DYNAMIC_STRING_OBJECT of the proper length --| Set DS field of new object to the ITEM string --| Set the NEXT field of the new object to NULL --| If FIRST pointer is null --| Set FIRST and LAST to point to the new object --| Else --| Set LAST.NEXT to point to the new object --| Set LAST to point to the new object --| End if --| Increment NUMBER_OF_STRINGS --========================================================= TEMP : DYNAMIC_STRING; begin TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH); TEMP.DS (1 .. ITEM'LENGTH) := ITEM; TEMP.NEXT := null; if FIRST = null then FIRST := TEMP; LAST := TEMP; else LAST.NEXT := TEMP; LAST := TEMP; end if; NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1; end ADD_TO_LIST; function GET_FROM_LIST (ITEM : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| GET_FROM_LIST returns the ITEM string from the linked list --| of dynamic strings implemented by this package. --|DESIGN DESCRIPTION: --| If ITEM > 0 --| Advance to desired item --| End If --| Return the DS field of the desired item --========================================================= ROVER : DYNAMIC_STRING := FIRST; begin if ITEM > 0 then for I in 1 .. ITEM loop ROVER := ROVER.NEXT; end loop; end if; return ROVER.DS; end GET_FROM_LIST; end STRING_LIST; procedure INITIALIZE (PROGRAM_NAME : in STRING; COMMAND_LINE_PROMPT : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| INITIALIZE prompts the user for the command line --| arguments and loads the linked list with them. --|DESIGN DESCRIPTION: --| Set CURRENT_STATE to LOOKING_FOR_TOKEN --| Set PROGRAM_NAME as first token --| Obtain the command line string from VAX/VMS --| Over number of characters in line, loop --| Case CURRENT_STATE --| When LOOKING_FOR_TOKEN --| If character is not white-space --| Set CURRENT_STATE to IN_TOKEN --| If character is quote (") --| Set QUOTED to TRUE --| Set START to the character's index + 1 --| Else --| Set QUOTED to FALSE --| Set START to the character's index --| End IF --| End If --| When IN_TOKEN --| If QUOTED --| If character is quote (") --| Set STOP to the previous character's index --| Add slice from START to STOP to list --| Set CURRENT_STATE to LOOKING_FOR_TOKEN --| End If --| ElsIF character is white-space --| Set STOP to the previous character's index --| Add slice from START to STOP to list --| Set CURRENT_STATE to LOOKING_FOR_TOKEN --| End If --| End Case --| End Loop --| If CURRENT_STATE is IN_TOKEN --| Set STOP to the previous character's index --| Add slice from START to STOP to list --| End if --| Set LOCAL_ARGC to NUMBER_OF_STRINGS --========================================================= ARGCOUNT : NATURAL := 1; INLINE : UTIL.COMMAND_STRING; -- for IntegrAda INLEN : NATURAL; -- for IntegrAda START : NATURAL; STOP : NATURAL; QUOTED : BOOLEAN; type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN); CURRENT_STATE : STATE := LOOKING_FOR_TOKEN; begin STRING_LIST.ADD_TO_LIST (PROGRAM_NAME); UTIL.COMMAND_LINE (INLINE, INLEN); -- INLINE is command line for I in 1 .. INLEN loop case CURRENT_STATE is when LOOKING_FOR_TOKEN => if INLINE (I) > ' ' then CURRENT_STATE := IN_TOKEN; if INLINE (I) = '"' then QUOTED := TRUE; START := I; else QUOTED := FALSE; START := I; end if; end if; when IN_TOKEN => if QUOTED then if INLINE (I) = '"' then STOP := I; STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP)); CURRENT_STATE := LOOKING_FOR_TOKEN; end if; elsif INLINE (I) <= ' ' then STOP := I - 1; STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP)); CURRENT_STATE := LOOKING_FOR_TOKEN; end if; end case; end loop; if CURRENT_STATE = IN_TOKEN then STOP := INLEN; STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP)); end if; LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS; end INITIALIZE; function ARGC return NATURAL is --========================= PDL =========================== --|ABSTRACT: --| ARGC returns the argument count. --|DESIGN DESCRIPTION: --| Return LOCAL_ARGC --========================================================= begin return LOCAL_ARGC; end ARGC; function ARGV (INDEX : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| ARGV returns the indicated argument string. --|DESIGN DESCRIPTION: --| If INDEX is out of range, raise INVALID_INDEX --| Return GET_FROM_LIST(INDEX) --========================================================= begin if INDEX >= LOCAL_ARGC then raise INVALID_INDEX; end if; return STRING_LIST.GET_FROM_LIST (INDEX); exception when INVALID_INDEX => raise ; when others => raise UNEXPECTED_ERROR; end ARGV; end CLI; --:::::::::: --cli_verdix.ada --:::::::::: -- This implementation of Package Body CLI is Verdix-specific (SUN). -- The following Verdix Ada packages must be compiled into -- the Ada library or an Ada program unit library containing these -- packages must be placed in the library search path before this -- package body is compiled: -- standard/a_strings.a -- standard/a_strings_b.a -- standard/c_strings.a -- standard/c_strings_b.a -- verdixlib/cmd_line_s.a -- verdixlib/cmd_line_b.a -- Verdix Ada Development System, Version 5.41 and 5.5 with COMMAND_LINE; with A_STRINGS; package body CLI is LOCAL_ARGC : NATURAL := NATURAL (COMMAND_LINE.ARGC); -- Local value of ARGC stored internally procedure INITIALIZE (PROGRAM_NAME : in STRING; COMMAND_LINE_PROMPT : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| INITIALIZE prompts the user for the command line --| arguments and loads the linked list with them. --|DESIGN DESCRIPTION: --| Do nothing (no initialization required) --========================================================= begin null; end INITIALIZE; function ARGC return NATURAL is --========================= PDL =========================== --|ABSTRACT: --| ARGC returns the argument count. --|DESIGN DESCRIPTION: --| Return LOCAL_ARGC --========================================================= begin return LOCAL_ARGC; end ARGC; function ARGV (INDEX : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| ARGV returns the indicated argument string. --|DESIGN DESCRIPTION: --| If INDEX is out of range, raise INVALID_INDEX --| Return COMMAND_LINE.ARGV.all (INTEGER (INDEX)).all.S --========================================================= begin if INDEX >= LOCAL_ARGC then raise INVALID_INDEX; end if; return COMMAND_LINE.ARGV.all (INTEGER (INDEX)).all.S; exception when INVALID_INDEX => raise ; when others => raise UNEXPECTED_ERROR; end ARGV; end CLI; --:::::::::: --cli_vms.ada --:::::::::: -- This implementation of Package Body CLI is for DEC Ada using VAX/VMS. -- It has been tested under VAX/VMS 4.5 using DEC Ada Version 1.3-24. -- Note: any executable produced which uses this package must be able to -- read the command line parameters. To do this, after producing the EXE -- file via ACS LINK, you have to define a symbol like: -- $ symbol:==$disk:[dir]exe-file-name -- and then run the program by using the symbol: -- $ symbol this is a test package body CLI is LOCAL_ARGC : NATURAL := 1; -- Local ARGC value stored internally package STRING_LIST is NUMBER_OF_STRINGS : NATURAL := 0; procedure ADD_TO_LIST (ITEM : in STRING); function GET_FROM_LIST (ITEM : in NATURAL) return STRING; end STRING_LIST; package body STRING_LIST is type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL); type DYNAMIC_STRING is access DYNAMIC_STRING_OBJECT; type DYNAMIC_STRING_OBJECT (LENGTH : NATURAL) is record DS : STRING (1 .. LENGTH); NEXT : DYNAMIC_STRING; end record; FIRST : DYNAMIC_STRING := null; LAST : DYNAMIC_STRING := null; procedure ADD_TO_LIST (ITEM : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| ADD_TO_LIST adds the ITEM string to the linked list --| of dynamic strings implemented by this package. --|DESIGN DESCRIPTION: --| Create new DYNAMIC_STRING_OBJECT of the proper length --| Set DS field of new object to the ITEM string --| Set the NEXT field of the new object to NULL --| If FIRST pointer is null --| Set FIRST and LAST to point to the new object --| Else --| Set LAST.NEXT to point to the new object --| Set LAST to point to the new object --| End if --| Increment NUMBER_OF_STRINGS --========================================================= TEMP : DYNAMIC_STRING; begin TEMP := new DYNAMIC_STRING_OBJECT (ITEM'LENGTH); TEMP.DS (1 .. ITEM'LENGTH) := ITEM; TEMP.NEXT := null; if FIRST = null then FIRST := TEMP; LAST := TEMP; else LAST.NEXT := TEMP; LAST := TEMP; end if; NUMBER_OF_STRINGS := NUMBER_OF_STRINGS + 1; end ADD_TO_LIST; function GET_FROM_LIST (ITEM : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| GET_FROM_LIST returns the ITEM string from the linked list --| of dynamic strings implemented by this package. --|DESIGN DESCRIPTION: --| If ITEM > 0 --| Advance to desired item --| End If --| Return the DS field of the desired item --========================================================= ROVER : DYNAMIC_STRING := FIRST; begin if ITEM > 0 then for I in 1 .. ITEM loop ROVER := ROVER.NEXT; end loop; end if; return ROVER.DS; end GET_FROM_LIST; end STRING_LIST; procedure INITIALIZE (PROGRAM_NAME : in STRING; COMMAND_LINE_PROMPT : in STRING) is --========================= PDL =========================== --|ABSTRACT: --| INITIALIZE prompts the user for the command line --| arguments and loads the linked list with them. --|DESIGN DESCRIPTION: --| Set CURRENT_STATE to LOOKING_FOR_TOKEN --| Set PROGRAM_NAME as first token --| Obtain the command line string from VAX/VMS --| Over number of characters in line, loop --| Case CURRENT_STATE --| When LOOKING_FOR_TOKEN --| If character is not white-space --| Set CURRENT_STATE to IN_TOKEN --| If character is quote (") --| Set QUOTED to TRUE --| Set START to the character's index + 1 --| Else --| Set QUOTED to FALSE --| Set START to the character's index --| End IF --| End If --| When IN_TOKEN --| If QUOTED --| If character is quote (") --| Set STOP to the previous character's index --| Add slice from START to STOP to list --| Set CURRENT_STATE to LOOKING_FOR_TOKEN --| End If --| ElsIF character is white-space --| Set STOP to the previous character's index --| Add slice from START to STOP to list --| Set CURRENT_STATE to LOOKING_FOR_TOKEN --| End If --| End Case --| End Loop --| If CURRENT_STATE is IN_TOKEN --| Set STOP to the previous character's index --| Add slice from START to STOP to list --| End if --| Set LOCAL_ARGC to NUMBER_OF_STRINGS --========================================================= ARGCOUNT : NATURAL := 1; INLINE : STRING (1 .. 132); -- for VAX/VMS START : NATURAL; STOP : NATURAL; QUOTED : BOOLEAN; type STATE is (LOOKING_FOR_TOKEN, IN_TOKEN); CURRENT_STATE : STATE := LOOKING_FOR_TOKEN; -- Get command line from VAX/VMS procedure GET_FOREIGN (LINE : out STRING); pragma INTERFACE (EXTERNAL, GET_FOREIGN); pragma IMPORT_VALUED_PROCEDURE (GET_FOREIGN, "LIB$GET_FOREIGN", (STRING), (DESCRIPTOR(S))); begin STRING_LIST.ADD_TO_LIST (PROGRAM_NAME); GET_FOREIGN (INLINE); -- INLINE is command line from VAX/VMS for I in INLINE'RANGE loop case CURRENT_STATE is when LOOKING_FOR_TOKEN => if INLINE (I) > ' ' then CURRENT_STATE := IN_TOKEN; if INLINE (I) = '"' then QUOTED := TRUE; START := I; else QUOTED := FALSE; START := I; end if; end if; when IN_TOKEN => if QUOTED then if INLINE (I) = '"' then STOP := I; STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP)); CURRENT_STATE := LOOKING_FOR_TOKEN; end if; elsif INLINE (I) <= ' ' then STOP := I - 1; STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP)); CURRENT_STATE := LOOKING_FOR_TOKEN; end if; end case; end loop; if CURRENT_STATE = IN_TOKEN then STOP := INLINE'LAST; STRING_LIST.ADD_TO_LIST (INLINE (START .. STOP)); end if; LOCAL_ARGC := STRING_LIST.NUMBER_OF_STRINGS; end INITIALIZE; function ARGC return NATURAL is --========================= PDL =========================== --|ABSTRACT: --| ARGC returns the argument count. --|DESIGN DESCRIPTION: --| Return LOCAL_ARGC --========================================================= begin return LOCAL_ARGC; end ARGC; function ARGV (INDEX : in NATURAL) return STRING is --========================= PDL =========================== --|ABSTRACT: --| ARGV returns the indicated argument string. --|DESIGN DESCRIPTION: --| If INDEX is out of range, raise INVALID_INDEX --| Return GET_FROM_LIST(INDEX) --========================================================= begin if INDEX >= LOCAL_ARGC then raise INVALID_INDEX; end if; return STRING_LIST.GET_FROM_LIST (INDEX); exception when INVALID_INDEX => raise ; when others => raise UNEXPECTED_ERROR; end ARGV; end CLI; --:::::::::: --pager2.ada --:::::::::: -- PROGRAM/CODE BODY NAME: PAGER2 -- AUTHOR: Richard Conn -- VERSION: 1.1 -- DATE: 6/12/89 -- REVISION HISTORY - -- Version Date Author Comments -- 1.0 8/28/87 Richard Conn Initial -- 1.1 6/12/89 Richard Conn CLI interface added -- KEYWORDS - -- pager, pager2, paged files, page, unpage -- CALLING SYNTAX - -- From the command line: pager2 -- From the command line: pager2 verb arguments -- EXTERNAL ROUTINES - -- Package CLI -- Package TEXT_IO -- DESCRIPTION - -- PAGER2 assembles, extracts elements from, and lists paged files. -- Paged files are text files which contain one or more component files -- prefixed by a banner like: -- -- :::::::::: -- filename -- :::::::::: -- -- or -- -- --:::::::::: -- --filename -- --:::::::::: -- -- PAGER2 will manipulate paged files whose components -- are prefixed with either banner, but it assembles paged files with only -- the second banner (beginning with the Ada comment characters). --=========================================================================== -------------------------- PACKAGE LINE_DEFINITION -------------------------- --=========================================================================== -- The following package defines an object of type LINE package LINE_DEFINITION is -- The maximum length of a line MAX_LINE_LENGTH : constant NATURAL := 200; -- Type definition for LINE type LINE is record CONTENT : STRING(1 .. MAX_LINE_LENGTH); LAST : NATURAL; end record; type LINE_LIST_ELEMENT; type LINE_LIST is access LINE_LIST_ELEMENT; type LINE_LIST_ELEMENT is record CONTENT : LINE; NEXT : LINE_LIST; end record; -- Banners COMMENT_BANNER : constant STRING := "--::::::::::"; BANNER : constant STRING := "::::::::::"; -- Convert strings to LINEs and back function CONVERT(FROM : in STRING) return LINE; function CONVERT(FROM : in LINE) return STRING; -- Convert a LINE to lower-case characters procedure TOLOWER(ITEM : in out LINE); function TOLOWER(ITEM : in LINE) return LINE; end LINE_DEFINITION; package body LINE_DEFINITION is -- Convert strings to LINEs function CONVERT(FROM : in STRING) return LINE is TO : LINE_DEFINITION.LINE; begin TO.CONTENT(TO.CONTENT'FIRST .. TO.CONTENT'FIRST + FROM'LENGTH - 1) := FROM; TO.LAST := FROM'LENGTH; return TO; end CONVERT; function CONVERT(FROM : in LINE) return STRING is begin return FROM.CONTENT(FROM.CONTENT'FIRST .. FROM.LAST); end CONVERT; procedure TOLOWER(ITEM : in out LINE) is begin for I in ITEM.CONTENT'FIRST .. ITEM.LAST loop if ITEM.CONTENT(I) in 'A' .. 'Z' then ITEM.CONTENT(I) := CHARACTER'VAL(CHARACTER'POS(ITEM.CONTENT(I)) - CHARACTER'POS('A') + CHARACTER'POS('a')); end if; end loop; end TOLOWER; function TOLOWER(ITEM : in LINE) return LINE is MYLINE : LINE; begin MYLINE := ITEM; TOLOWER(MYLINE); return MYLINE; end TOLOWER; end LINE_DEFINITION; --=========================================================================== -------------------------- PACKAGE INPUT_FILE ------------------------------- --=========================================================================== -- The following package manipulates an object called an INPUT_FILE, -- which is a text file that is composed of objects of type LINE. -- LINEs can only be read from an INPUT_FILE. with LINE_DEFINITION; package INPUT_FILE is -- Open the input file -- Exceptions which may be raised: FILE_NOT_FOUND, FILE_ALREADY_OPEN procedure OPEN(FILE_NAME : in STRING); procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE); -- Close the input file -- Exceptions which may be raised: FILE_NOT_OPEN procedure CLOSE; -- Read a line from the input file -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE procedure READ(TO : out LINE_DEFINITION.LINE); -- Return TRUE if the input file is empty (no more lines remain) -- Exceptions which may be raised: FILE_NOT_OPEN function END_OF_FILE return BOOLEAN; -- Exceptional conditions FILE_NOT_FOUND : exception; FILE_ALREADY_OPEN : exception; FILE_NOT_OPEN : exception; READ_PAST_END_OF_FILE : exception; end INPUT_FILE; with TEXT_IO; package body INPUT_FILE is -- The file descriptor for the input file FD : TEXT_IO.FILE_TYPE; -- Open the input file procedure OPEN(FILE_NAME : in STRING) is begin TEXT_IO.OPEN(FD, TEXT_IO.IN_FILE, FILE_NAME); exception when TEXT_IO.NAME_ERROR => raise FILE_NOT_FOUND; when TEXT_IO.STATUS_ERROR => raise FILE_ALREADY_OPEN; end OPEN; procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is begin OPEN(LINE_DEFINITION.CONVERT(FILE_NAME)); end OPEN; -- Close the input file procedure CLOSE is begin TEXT_IO.CLOSE(FD); exception when TEXT_IO.STATUS_ERROR => raise FILE_NOT_OPEN; end CLOSE; -- Read a line from the input file procedure READ(TO : out LINE_DEFINITION.LINE) is begin TEXT_IO.GET_LINE(FD, TO.CONTENT, TO.LAST); exception when TEXT_IO.END_ERROR => raise READ_PAST_END_OF_FILE; when TEXT_IO.STATUS_ERROR => raise FILE_NOT_OPEN; end READ; -- Return TRUE if the input file is empty (no more lines remain) function END_OF_FILE return BOOLEAN is begin return TEXT_IO.END_OF_FILE(FD); exception when TEXT_IO.STATUS_ERROR => raise FILE_NOT_OPEN; end END_OF_FILE; end INPUT_FILE; --=========================================================================== -------------------------- PACKAGE OUTPUT_FILE ------------------------------ --=========================================================================== -- The following package manipulates an object called an OUTPUT_FILE, -- which is a text file that is composed of objects of type LINE. -- LINEs can only be written to an OUTPUT_FILE. with LINE_DEFINITION; package OUTPUT_FILE is -- Open the output file -- Exceptions which may be raised: CANNOT_CREATE_FILE, FILE_ALREADY_OPEN procedure OPEN(FILE_NAME : in STRING); procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE); -- Close the output file -- Exceptions which may be raised: FILE_NOT_OPEN procedure CLOSE; -- Write a line to the output file -- Exceptions which may be raised: FILE_NOT_OPEN, DISK_FULL procedure WRITE(FROM : in LINE_DEFINITION.LINE); procedure WRITE(FROM : in STRING); -- Exceptional conditions CANNOT_CREATE_FILE : exception; FILE_ALREADY_OPEN : exception; FILE_NOT_OPEN : exception; DISK_FULL : exception; end OUTPUT_FILE; with TEXT_IO; package body OUTPUT_FILE is -- File descriptor for the output file FD : TEXT_IO.FILE_TYPE; -- Open the output file procedure OPEN(FILE_NAME : in STRING) is INLINE : STRING(1 .. 80); LAST : NATURAL; begin TEXT_IO.CREATE(FD, TEXT_IO.OUT_FILE, FILE_NAME); exception when TEXT_IO.STATUS_ERROR => raise FILE_ALREADY_OPEN; when TEXT_IO.USE_ERROR => raise CANNOT_CREATE_FILE; when TEXT_IO.NAME_ERROR => TEXT_IO.PUT_LINE(" Cannot create " & FILE_NAME); loop begin TEXT_IO.PUT(" Enter New File Name: "); TEXT_IO.GET_LINE(INLINE, LAST); TEXT_IO.CREATE(FD, TEXT_IO.OUT_FILE, INLINE(INLINE'FIRST .. LAST)); exit; exception when TEXT_IO.NAME_ERROR => TEXT_IO.PUT_LINE(" Cannot create " & INLINE(INLINE'FIRST .. LAST)); when others => raise ; end; end loop; end OPEN; procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is begin OPEN(LINE_DEFINITION.CONVERT(FILE_NAME)); end OPEN; -- Close the output file procedure CLOSE is begin TEXT_IO.CLOSE(FD); exception when TEXT_IO.STATUS_ERROR => raise FILE_NOT_OPEN; end CLOSE; -- Write a line to the output file procedure WRITE(FROM : in LINE_DEFINITION.LINE) is begin TEXT_IO.PUT_LINE(FD, LINE_DEFINITION.CONVERT(FROM)); exception when TEXT_IO.STATUS_ERROR => raise FILE_NOT_OPEN; when others => raise DISK_FULL; end WRITE; procedure WRITE(FROM : in STRING) is begin WRITE(LINE_DEFINITION.CONVERT(FROM)); end WRITE; end OUTPUT_FILE; --=========================================================================== -------------------------- PACKAGE INCLUDE_FILE ----------------------------- --=========================================================================== -- The following package manipulates an object called an INCLUDE_FILE, -- which is a text file that is composed of objects of type LINE. -- LINEs can only be read from an INCLUDE_FILE. An INCLUDE_FILE contains -- the following types of LINE objects: -- blank lines -- comment lines ('-' is the first character in the line) -- file names (a string of non-blank characters which does not -- begin with the character '-' or '@') -- include file names (a string of non-blank characters which -- begins with the character '@', where the '@' is used to -- prefix the file name within the include file and is not -- a part of the file name of the actual disk file) -- Include files may be nested several levels (defined by the constant -- NESTING_DEPTH). with LINE_DEFINITION; package INCLUDE_FILE is -- Maximum number of levels include files may be nested NESTING_DEPTH : constant NATURAL := 40; -- Character which begins an include file name INCLUDE_CHARACTER : constant CHARACTER := '@'; -- Character which begins a comment line COMMENT_CHARACTER : constant CHARACTER := '-'; -- Open the include file (the LINE input string contains the leading '@') -- Exceptions which may be raised: FILE_NOT_FOUND, NESTING_LEVEL_EXCEEDED procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE); procedure OPEN(FILE_NAME : in STRING); -- Read a LINE containing a file name from the include file -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE procedure READ(TO : out LINE_DEFINITION.LINE); -- Abort processing the include file (close all open files) -- Exceptions which may be raised: FILE_NOT_OPEN procedure STOP; -- Exceptional conditions FILE_NOT_FOUND : exception; NESTING_LEVEL_EXCEEDED : exception; FILE_NOT_OPEN : exception; READ_PAST_END_OF_FILE : exception; INCLUDE_FILE_EMPTY : exception; end INCLUDE_FILE; with TEXT_IO; package body INCLUDE_FILE is -- File Descriptor for main include file FD : array(1 .. NESTING_DEPTH) of TEXT_IO.FILE_TYPE; CURRENT_LEVEL : NATURAL := 0; NEXT_LINE : LINE_DEFINITION.LINE; -- next line to return by READ NEXT_LINE_READY : BOOLEAN := FALSE; -- indicates next line is -- available -- Open the include file (the LINE input string contains the leading '@') -- Exceptions which may be raised: FILE_NOT_FOUND, NESTING_LEVEL_EXCEEDED procedure OPEN(FILE_NAME : in LINE_DEFINITION.LINE) is begin if CURRENT_LEVEL = NESTING_DEPTH then raise NESTING_LEVEL_EXCEEDED; else CURRENT_LEVEL := CURRENT_LEVEL + 1; TEXT_IO.OPEN(FD(CURRENT_LEVEL), TEXT_IO.IN_FILE, FILE_NAME.CONTENT(2..FILE_NAME.LAST)); end if; exception when TEXT_IO.NAME_ERROR => TEXT_IO.PUT_LINE("Include File " & LINE_DEFINITION.CONVERT(FILE_NAME) & " not Found"); raise FILE_NOT_FOUND; when others => TEXT_IO.PUT_LINE("Unexpected error with Include File " & LINE_DEFINITION.CONVERT(FILE_NAME)); raise FILE_NOT_FOUND; end OPEN; procedure OPEN(FILE_NAME : in STRING) is begin OPEN(LINE_DEFINITION.CONVERT(FILE_NAME)); end OPEN; -- Close the include file -- Exceptions which may be raised: FILE_NOT_OPEN procedure CLOSE is begin TEXT_IO.CLOSE(FD(CURRENT_LEVEL)); CURRENT_LEVEL := CURRENT_LEVEL - 1; if CURRENT_LEVEL = 0 then raise INCLUDE_FILE_EMPTY; end if; end CLOSE; -- Abort processing the include file procedure STOP is begin while CURRENT_LEVEL > 0 loop TEXT_IO.CLOSE(FD(CURRENT_LEVEL)); CURRENT_LEVEL := CURRENT_LEVEL - 1; end loop; end STOP; -- Read a LINE containing a file name from the include file -- Exceptions which may be raised: FILE_NOT_OPEN, READ_PAST_END_OF_FILE procedure READ(TO : out LINE_DEFINITION.LINE) is INLINE : LINE_DEFINITION.LINE; begin loop begin TEXT_IO.GET_LINE(FD(CURRENT_LEVEL), INLINE.CONTENT, INLINE.LAST); if INLINE.LAST > 0 and INLINE.CONTENT(1) = INCLUDE_CHARACTER then OPEN(INLINE); elsif (INLINE.LAST > 0 and INLINE.CONTENT(1) = COMMENT_CHARACTER) or (INLINE.LAST = 0) then null; -- skip comment lines and empty lines else exit; end if; exception when TEXT_IO.END_ERROR => CLOSE; end; end loop; TO := INLINE; end READ; end INCLUDE_FILE; --=========================================================================== ---------------------------- PROCEDURE PARSER ------------------------------- --=========================================================================== -- PARSER parses a LINE and returns the number of tokens in that LINE -- and the first token as COMMAND (converted to lower-case) with the -- rest of the tokens in ARGS (a linked list of argument LINEs) with LINE_DEFINITION; use LINE_DEFINITION; procedure PARSER(INLINE : in LINE_DEFINITION.LINE; NARGS : out NATURAL; COMMAND : out LINE_DEFINITION.LINE; ARGS : in out LINE_DEFINITION.LINE_LIST) is ROVER : NATURAL; LROVER : LINE_DEFINITION.LINE_LIST := null; LFIRST : LINE_DEFINITION.LINE_LIST := null; LCOMMAND : LINE_DEFINITION.LINE; LTEMP : LINE_DEFINITION.LINE; LARGS : NATURAL := 0; procedure SKIP_SPACES is begin while INLINE.CONTENT(ROVER) <= ' ' and ROVER <= INLINE.LAST loop ROVER := ROVER + 1; end loop; end SKIP_SPACES; procedure EXTRACT(ITEM : out LINE_DEFINITION.LINE) is EXTRACT_ROVER : NATURAL := 0; begin while INLINE.CONTENT(ROVER) > ' ' and ROVER <= INLINE.LAST loop EXTRACT_ROVER := EXTRACT_ROVER + 1; ITEM.CONTENT(EXTRACT_ROVER) := INLINE.CONTENT(ROVER); ROVER := ROVER + 1; end loop; ITEM.LAST := EXTRACT_ROVER; end EXTRACT; begin COMMAND.LAST := 0; ROVER := INLINE.CONTENT'FIRST; SKIP_SPACES; if ROVER <= INLINE.LAST then EXTRACT(LCOMMAND); LCOMMAND.LAST := LCOMMAND.LAST + 1; LCOMMAND.CONTENT(LCOMMAND.LAST) := ' '; COMMAND := LINE_DEFINITION.TOLOWER(LCOMMAND); LARGS := 1; LROVER := ARGS; while ROVER <= INLINE.LAST loop SKIP_SPACES; if ROVER <= INLINE.LAST then EXTRACT(LTEMP); if ARGS = null then ARGS := new LINE_DEFINITION.LINE_LIST_ELEMENT; LROVER := ARGS; LROVER.NEXT := null; end if; LROVER.CONTENT := LTEMP; LARGS := LARGS + 1; if LROVER.NEXT = null then LROVER.NEXT := new LINE_DEFINITION.LINE_LIST_ELEMENT; end if; LROVER := LROVER.NEXT; end if; end loop; end if; NARGS := LARGS; end PARSER; --=========================================================================== ---------------------------- PACKAGE PAGED_FILE ----------------------------- --=========================================================================== with LINE_DEFINITION; package PAGED_FILE is procedure COMPUTE_CHECKSUM (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST); -- Compute the checksum of a paged file procedure MAKE_INCLUDE_FILE (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST); -- Create an include file which names the elements of a paged file procedure LIST (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST); -- List the names of the elements of a paged file procedure CREATE (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST); -- Create a paged file procedure UNPAGE (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST); -- Extract the elements of a paged file end PAGED_FILE; with INCLUDE_FILE, INPUT_FILE, OUTPUT_FILE, PARSER; with TEXT_IO; package body PAGED_FILE is INLINE : LINE_DEFINITION.LINE; --======================================================================= -- PAGED_FILE, Support Utilities --======================================================================= use LINE_DEFINITION; -- Determine if ITEM contains a BANNER or COMMENT_BANNER function IS_BANNER(ITEM : in LINE_DEFINITION.LINE) return BOOLEAN is RESULT : BOOLEAN; begin if ITEM.LAST >= LINE_DEFINITION.BANNER'LENGTH and then ITEM.CONTENT(1 .. LINE_DEFINITION.BANNER'LENGTH) = LINE_DEFINITION.BANNER then RESULT := TRUE; elsif ITEM.LAST >= LINE_DEFINITION.COMMENT_BANNER'LENGTH and then ITEM.CONTENT(1 .. LINE_DEFINITION.COMMENT_BANNER'LENGTH) = LINE_DEFINITION.COMMENT_BANNER then RESULT := TRUE; else RESULT := FALSE; end if; return RESULT; end IS_BANNER; -- Package to handle line counting package COUNTER is -- Reset the Counter procedure SET; -- Increment the Counter procedure INCREMENT; -- Print the counter procedure PRINT; end COUNTER; package body COUNTER is type LINE_COUNT is range 0 .. 10001; package LINE_COUNT_IO is new TEXT_IO.INTEGER_IO(LINE_COUNT); LCOUNT : LINE_COUNT; -- Reset the LCOUNT variable procedure SET is begin LCOUNT := 0; end SET; -- Increment the LCOUNT variable procedure INCREMENT is begin if LCOUNT < LINE_COUNT'LAST then LCOUNT := LCOUNT + 1; end if; end INCREMENT; -- Print a count of the number of lines and reset the LCOUNT variable procedure PRINT is begin TEXT_IO.PUT(" -- "); if LCOUNT = LINE_COUNT'LAST then TEXT_IO.PUT("More Than" & LINE_COUNT'IMAGE(LINE_COUNT'LAST - 1)); else LINE_COUNT_IO.PUT(LCOUNT, 1); end if; TEXT_IO.PUT_LINE(" Lines"); LCOUNT := 0; end PRINT; end COUNTER; --======================================================================= -- PAGED_FILE, COMPUTE_CHECKSUM Command --======================================================================= procedure COMPUTE_CHECKSUM (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST) is CHECKSUM : INTEGER; package VALUE_IO is new TEXT_IO.INTEGER_IO(INTEGER); begin if NARGS = 1 then TEXT_IO.PUT_LINE(" CHECK Command requires the name of a file"); TEXT_IO.PUT_LINE(" Syntax: list file_name"); else -- Step 1: Open the input file INPUT_FILE.OPEN(ARGLIST.CONTENT); -- Step 2: Compute the Hash (Checksum) CHECKSUM := 0; while not INPUT_FILE.END_OF_FILE loop INPUT_FILE.READ(INLINE); for I in 1 .. INLINE.LAST loop if INLINE.CONTENT(I) > ' ' then CHECKSUM := CHECKSUM + CHARACTER'POS(INLINE.CONTENT(I)); if CHECKSUM >= 128 then CHECKSUM := CHECKSUM - 128; end if; end if; end loop; end loop; INPUT_FILE.CLOSE; -- Step 3: Print the result TEXT_IO.PUT(" Pager Checksum (Hash) of " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) & " is "); VALUE_IO.PUT(CHECKSUM, 1); TEXT_IO.NEW_LINE; end if; exception when INPUT_FILE.FILE_NOT_FOUND => TEXT_IO.PUT(" CHECK:"); TEXT_IO.PUT_LINE(" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) & " not Found"); when INPUT_FILE.READ_PAST_END_OF_FILE => TEXT_IO.PUT(" CHECK:"); TEXT_IO.PUT_LINE(" Premature EOF on " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT)); INPUT_FILE.CLOSE; when others => TEXT_IO.PUT(" CHECK:"); TEXT_IO.PUT_LINE(" Unexpected Error"); INPUT_FILE.CLOSE; end COMPUTE_CHECKSUM; --======================================================================= -- PAGED_FILE, MAKE_INCLUDE_FILE Command --======================================================================= procedure MAKE_INCLUDE_FILE (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST) is IN_FILE : BOOLEAN; ARG_ROVER : LINE_DEFINITION.LINE_LIST; begin if NARGS < 3 then TEXT_IO.PUT_LINE (" INCLUDE Command requires the name of a paged file"); TEXT_IO.PUT_LINE (" Syntax: include paged_file_name output_include_file"); else -- Step 1: Open the input and output files COUNTER.SET; ARG_ROVER := ARGLIST.NEXT; INPUT_FILE.OPEN(ARGLIST.CONTENT); OUTPUT_FILE.OPEN(ARG_ROVER.CONTENT); OUTPUT_FILE.WRITE("-- Include file for " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT)); -- Step 2: Look for the first banner in the paged file IN_FILE := TRUE; while not INPUT_FILE.END_OF_FILE loop INPUT_FILE.READ(INLINE); if IS_BANNER(INLINE) then IN_FILE := FALSE; exit; end if; end loop; -- Step 3: If first banner not found, issue error message, -- else process component files if IN_FILE then TEXT_IO.PUT_LINE (" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) & " does not contain any components"); else -- Loop until the end of the input paged file while not INPUT_FILE.END_OF_FILE loop -- Read the next line from the input paged file INPUT_FILE.READ(INLINE); -- If we are not in the text of the file, the line just -- read contains the name of a new file, else it contains -- a line of the current component file if not IN_FILE then -- Remove leading comment character if any and print the -- name of the component file if INLINE.CONTENT(1 .. 2) = "--" then TEXT_IO.PUT(" " & INLINE.CONTENT(3 .. INLINE.LAST)); OUTPUT_FILE.WRITE (INLINE.CONTENT(3 .. INLINE.LAST)); else TEXT_IO.PUT(" " & INLINE.CONTENT(1 .. INLINE.LAST)); OUTPUT_FILE.WRITE (INLINE.CONTENT(1 .. INLINE.LAST)); end if; -- Flush the trailing banner line and note that we are -- now within the text of a component file INPUT_FILE.READ(INLINE); COUNTER.SET; IN_FILE := TRUE; else -- We are within the text of a component file, so check -- for a banner in order to determine if we are at the end -- of the component file if IS_BANNER(INLINE) then IN_FILE := FALSE; COUNTER.PRINT; else COUNTER.INCREMENT; end if; end if; end loop; end if; COUNTER.PRINT; INPUT_FILE.CLOSE; OUTPUT_FILE.CLOSE; end if; exception when OUTPUT_FILE.CANNOT_CREATE_FILE => TEXT_IO.PUT(" INCLUDE:"); TEXT_IO.PUT_LINE(" Cannot create " & LINE_DEFINITION.CONVERT(ARG_ROVER.CONTENT)); when INPUT_FILE.FILE_NOT_FOUND => TEXT_IO.PUT(" INCLUDE:"); TEXT_IO.PUT_LINE (" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) & " not Found"); when INPUT_FILE.READ_PAST_END_OF_FILE => TEXT_IO.PUT(" INCLUDE:"); TEXT_IO.PUT_LINE(" Premature EOF on " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT)); INPUT_FILE.CLOSE; when others => TEXT_IO.PUT(" INCLUDE:"); TEXT_IO.PUT_LINE(" Unexpected Error"); INPUT_FILE.CLOSE; end MAKE_INCLUDE_FILE; --======================================================================= -- PAGED_FILE, LIST Command --======================================================================= procedure LIST (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST) is IN_FILE : BOOLEAN; begin if NARGS = 1 then TEXT_IO.PUT_LINE (" LIST Command requires the name of a paged file"); TEXT_IO.PUT_LINE (" Syntax: list paged_file_name"); else -- Step 1: Open the input file COUNTER.SET; INPUT_FILE.OPEN(ARGLIST.CONTENT); -- Step 2: Look for the first banner in the paged file IN_FILE := TRUE; while not INPUT_FILE.END_OF_FILE loop INPUT_FILE.READ(INLINE); if IS_BANNER(INLINE) then IN_FILE := FALSE; exit; end if; end loop; -- Step 3: If first banner not found, issue error message, -- else process component files if IN_FILE then TEXT_IO.PUT_LINE (" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) & " does not contain any components"); else -- Loop until the end of the input paged file while not INPUT_FILE.END_OF_FILE loop -- Read the next line from the input paged file INPUT_FILE.READ(INLINE); -- If we are not in the text of the file, the line just -- read contains the name of a new file, else it contains -- a line of the current component file if not IN_FILE then -- Remove leading comment character if any and print -- the name of the component file if INLINE.CONTENT(1 .. 2) = "--" then TEXT_IO.PUT(" " & INLINE.CONTENT(3 .. INLINE.LAST)); else TEXT_IO.PUT(" " & INLINE.CONTENT(1 .. INLINE.LAST)); end if; -- Flush the trailing banner line and note that we are -- now within the text of a component file INPUT_FILE.READ(INLINE); COUNTER.SET; IN_FILE := TRUE; else -- We are within the text of a component file, so -- check for a banner in order to determine if we -- are at the end of the component file if IS_BANNER(INLINE) then IN_FILE := FALSE; COUNTER.PRINT; else COUNTER.INCREMENT; end if; end if; end loop; end if; COUNTER.PRINT; INPUT_FILE.CLOSE; end if; exception when INPUT_FILE.FILE_NOT_FOUND => TEXT_IO.PUT(" LIST:"); TEXT_IO.PUT_LINE (" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) & " not Found"); when INPUT_FILE.READ_PAST_END_OF_FILE => TEXT_IO.PUT(" LIST:"); TEXT_IO.PUT_LINE(" Premature EOF on " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT)); INPUT_FILE.CLOSE; when others => TEXT_IO.PUT(" LIST:"); TEXT_IO.PUT_LINE(" Unexpected Error"); INPUT_FILE.CLOSE; end LIST; --======================================================================= -- PAGED_FILE, CREATE Command --======================================================================= procedure CREATE (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST) is COMPONENT_FILE_NAME : LINE_DEFINITION.LINE; OUTPUT_FILE_NAME : LINE_DEFINITION.LINE; ARG_ROVER : LINE_DEFINITION.LINE_LIST; begin if NARGS < 3 then TEXT_IO.PUT_LINE (" PAGE Command requires the name of the paged file and include file"); TEXT_IO.PUT_LINE (" Syntax: page [@include_file_name|file_name]+ paged_file_name"); else ARG_ROVER := ARGLIST; for I in 1 .. NARGS-2 loop ARG_ROVER := ARG_ROVER.NEXT; end loop; OUTPUT_FILE_NAME := ARG_ROVER.CONTENT; OUTPUT_FILE.OPEN(OUTPUT_FILE_NAME); ARG_ROVER := ARGLIST; for I in 1 .. NARGS-2 loop if ARG_ROVER.CONTENT.CONTENT(1) = INCLUDE_FILE.INCLUDE_CHARACTER then INCLUDE_FILE.OPEN (LINE_DEFINITION.CONVERT(ARG_ROVER.CONTENT)); begin loop INCLUDE_FILE.READ(COMPONENT_FILE_NAME); INPUT_FILE.OPEN(COMPONENT_FILE_NAME); OUTPUT_FILE.WRITE(LINE_DEFINITION.COMMENT_BANNER); OUTPUT_FILE.WRITE("--" & LINE_DEFINITION.CONVERT(COMPONENT_FILE_NAME)); OUTPUT_FILE.WRITE(LINE_DEFINITION.COMMENT_BANNER); TEXT_IO.PUT(" Adding " & LINE_DEFINITION.CONVERT(COMPONENT_FILE_NAME)); COUNTER.SET; while not INPUT_FILE.END_OF_FILE loop INPUT_FILE.READ(INLINE); OUTPUT_FILE.WRITE(INLINE); COUNTER.INCREMENT; end loop; COUNTER.PRINT; INPUT_FILE.CLOSE; end loop; exception when INCLUDE_FILE.READ_PAST_END_OF_FILE | INCLUDE_FILE.INCLUDE_FILE_EMPTY | INCLUDE_FILE.NESTING_LEVEL_EXCEEDED => INCLUDE_FILE.STOP; when INPUT_FILE.FILE_NOT_FOUND => TEXT_IO.PUT_LINE(" File " & LINE_DEFINITION.CONVERT(COMPONENT_FILE_NAME) & " not Found"); INCLUDE_FILE.STOP; when others => TEXT_IO.PUT_LINE (" Unexpected Error During Processing " & "of Component File " & LINE_DEFINITION.CONVERT(COMPONENT_FILE_NAME)); INCLUDE_FILE.STOP; end; else INPUT_FILE.OPEN(ARG_ROVER.CONTENT); OUTPUT_FILE.WRITE(LINE_DEFINITION.COMMENT_BANNER); OUTPUT_FILE.WRITE("--" & LINE_DEFINITION.CONVERT(ARG_ROVER.CONTENT)); OUTPUT_FILE.WRITE(LINE_DEFINITION.COMMENT_BANNER); TEXT_IO.PUT(" Adding " & LINE_DEFINITION.CONVERT(ARG_ROVER.CONTENT)); COUNTER.SET; while not INPUT_FILE.END_OF_FILE loop INPUT_FILE.READ(INLINE); OUTPUT_FILE.WRITE(INLINE); COUNTER.INCREMENT; end loop; COUNTER.PRINT; INPUT_FILE.CLOSE; end if; ARG_ROVER := ARG_ROVER.NEXT; end loop; OUTPUT_FILE.CLOSE; end if; exception when OUTPUT_FILE.CANNOT_CREATE_FILE => TEXT_IO.PUT(" PAGE:"); TEXT_IO.PUT_LINE(" Cannot create " & LINE_DEFINITION.CONVERT(OUTPUT_FILE_NAME)); when INCLUDE_FILE.FILE_NOT_FOUND => TEXT_IO.PUT(" PAGE:"); TEXT_IO.PUT_LINE(" Cannot open include file"); when others => TEXT_IO.PUT(" PAGE:"); TEXT_IO.PUT_LINE(" Unexpected Error"); INPUT_FILE.CLOSE; end CREATE; --======================================================================= -- PAGED_FILE, UNPAGE Command --======================================================================= procedure UNPAGE (NARGS : in NATURAL; ARGLIST : in LINE_DEFINITION.LINE_LIST) is IN_FILE : BOOLEAN; OUTPUT_FILE_NAME : LINE_DEFINITION.LINE; begin if NARGS = 1 then TEXT_IO.PUT_LINE (" UNPAGE Command requires the name of a paged file"); TEXT_IO.PUT_LINE(" Syntax: unpage paged_file_name"); else -- Step 1: Open the input file COUNTER.SET; INPUT_FILE.OPEN(ARGLIST.CONTENT); -- Step 2: Look for the first banner in the paged file IN_FILE := TRUE; while not INPUT_FILE.END_OF_FILE loop INPUT_FILE.READ(INLINE); if IS_BANNER(INLINE) then IN_FILE := FALSE; exit; end if; end loop; -- Step 3: If first banner not found, issue error message, -- else process component files if IN_FILE then TEXT_IO.PUT_LINE(" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) & " does not contain any components"); else -- Loop until the end of the input paged file while not INPUT_FILE.END_OF_FILE loop -- Read the next line from the input paged file INPUT_FILE.READ(INLINE); -- If we are not in the text of the file, the line just -- read contains the name of a new file, else it contains -- a line of the current component file if not IN_FILE then -- Remove leading comment character if any and -- store the name of the component file if INLINE.CONTENT(1 .. 2) = "--" then OUTPUT_FILE_NAME := LINE_DEFINITION.CONVERT (INLINE.CONTENT(3 .. INLINE.LAST)); else OUTPUT_FILE_NAME := LINE_DEFINITION.CONVERT (INLINE.CONTENT(1 .. INLINE.LAST)); end if; -- Open the new component file OUTPUT_FILE.OPEN(OUTPUT_FILE_NAME); TEXT_IO.PUT(" Extracting " & LINE_DEFINITION.CONVERT(OUTPUT_FILE_NAME)); -- Flush the trailing banner line and note that we are -- now within the text of a component file INPUT_FILE.READ(INLINE); IN_FILE := TRUE; COUNTER.SET; else -- We are within the text of a component file, so -- check for a banner in order to determine if we -- are at the end of the component file if IS_BANNER(INLINE) then OUTPUT_FILE.CLOSE; IN_FILE := FALSE; COUNTER.PRINT; else OUTPUT_FILE.WRITE(INLINE); COUNTER.INCREMENT; end if; end if; end loop; OUTPUT_FILE.CLOSE; end if; COUNTER.PRINT; INPUT_FILE.CLOSE; end if; exception when OUTPUT_FILE.CANNOT_CREATE_FILE => TEXT_IO.PUT(" UNPAGE:"); TEXT_IO.PUT_LINE(" Cannot create " & LINE_DEFINITION.CONVERT(OUTPUT_FILE_NAME)); when INPUT_FILE.FILE_NOT_FOUND => TEXT_IO.PUT(" UNPAGE:"); TEXT_IO.PUT_LINE(" File " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT) & " not Found"); when INPUT_FILE.READ_PAST_END_OF_FILE => TEXT_IO.PUT(" UNPAGE:"); TEXT_IO.PUT_LINE(" Premature EOF on " & LINE_DEFINITION.CONVERT(ARGLIST.CONTENT)); INPUT_FILE.CLOSE; when others => TEXT_IO.PUT(" UNPAGE:"); TEXT_IO.PUT_LINE(" Unexpected Error"); INPUT_FILE.CLOSE; end UNPAGE; end PAGED_FILE; --=========================================================================== --------------------------------- MAINLINE ---------------------------------- --=========================================================================== with LINE_DEFINITION, PAGED_FILE, PARSER; use LINE_DEFINITION; with TEXT_IO; with CLI; procedure PAGER2 is TITLE : constant STRING := "PAGER2, Ada Version 1.1"; INLINE : LINE_DEFINITION.LINE; NARGS : NATURAL; COMMAND : LINE_DEFINITION.LINE; ARGLIST : LINE_DEFINITION.LINE_LIST; ARG_ROVER : LINE_DEFINITION.LINE_LIST; -- Command Verbs HELP_COMMAND : constant STRING := "help "; H_COMMAND : constant STRING := "h "; EXIT_COMMAND : constant STRING := "exit "; X_COMMAND : constant STRING := "x "; -- same as exit CHECK_COMMAND : constant STRING := "check "; C_COMMAND : constant STRING := "c "; -- same as check INCLUDE_COMMAND : constant STRING := "include "; I_COMMAND : constant STRING := "i "; -- same as include LIST_COMMAND : constant STRING := "list "; L_COMMAND : constant STRING := "l "; -- same as list PAGE_COMMAND : constant STRING := "page "; P_COMMAND : constant STRING := "p "; -- same as page UNPAGE_COMMAND : constant STRING := "unpage "; U_COMMAND : constant STRING := "u "; -- same as unpage --======================================================================= -- PAGER2, Support Utilities --======================================================================= -- Determine if COMMAND contains one of the two target command strings function IS_COMMAND(TARGET1_COMMAND, TARGET2_COMMAND : in STRING) return BOOLEAN is START : NATURAL; begin if COMMAND.CONTENT(1) = '-' then START := 2; else START := 1; end if; if COMMAND.CONTENT(START .. TARGET1_COMMAND'LENGTH + START - 1) = TARGET1_COMMAND or COMMAND.CONTENT(START .. TARGET2_COMMAND'LENGTH + START - 1) = TARGET2_COMMAND then return TRUE; else return FALSE; end if; end IS_COMMAND; --======================================================================= -- PAGER2, HELP Command --======================================================================= procedure HELP is procedure SPACER is begin TEXT_IO.PUT(" "); end SPACER; begin TEXT_IO.PUT_LINE(" Command Summary"); TEXT_IO.PUT_LINE(" help or h - this summary"); SPACER; TEXT_IO.PUT_LINE("Syntax: help"); TEXT_IO.PUT_LINE(" exit or x - exit from program"); SPACER; TEXT_IO.PUT_LINE("Syntax: exit"); TEXT_IO.PUT_LINE (" include or i- list components into an include file"); SPACER; TEXT_IO.PUT_LINE ("Syntax: include paged_file_name output_include_file"); TEXT_IO.PUT_LINE(" list or l - list components of paged file"); SPACER; TEXT_IO.PUT_LINE("Syntax: list paged_file_name"); TEXT_IO.PUT_LINE (" page or p - create paged file from include file"); SPACER; TEXT_IO.PUT_LINE ("Syntax: page [@include_file_name|file_name]+ paged_file_name"); TEXT_IO.PUT_LINE (" unpage or u - extract components from paged file"); SPACER; TEXT_IO.PUT_LINE("Syntax: unpage paged_file_name"); end HELP; --======================================================================= -- PAGER2, Mainline --======================================================================= begin CLI.INITIALIZE ("PAGER2", "Enter verb and arguments: "); -- Interactive mode if no arguments if CLI.ARGC = 1 then TEXT_IO.PUT_LINE(TITLE); TEXT_IO.PUT_LINE("Type 'h' for Help"); loop begin TEXT_IO.PUT("PAGER2> "); TEXT_IO.GET_LINE(INLINE.CONTENT, INLINE.LAST); PARSER(INLINE, NARGS, COMMAND, ARGLIST); if NARGS > 0 then exit when IS_COMMAND(EXIT_COMMAND, X_COMMAND); if IS_COMMAND(HELP_COMMAND, H_COMMAND) then HELP; elsif IS_COMMAND(CHECK_COMMAND, C_COMMAND) then PAGED_FILE.COMPUTE_CHECKSUM (NARGS, ARGLIST); elsif IS_COMMAND(INCLUDE_COMMAND, I_COMMAND) then PAGED_FILE.MAKE_INCLUDE_FILE (NARGS, ARGLIST); elsif IS_COMMAND(LIST_COMMAND, L_COMMAND) then PAGED_FILE.LIST (NARGS, ARGLIST); elsif IS_COMMAND(PAGE_COMMAND, P_COMMAND) then PAGED_FILE.CREATE (NARGS, ARGLIST); elsif IS_COMMAND(UNPAGE_COMMAND, U_COMMAND) then PAGED_FILE.UNPAGE (NARGS, ARGLIST); else TEXT_IO.PUT_LINE(" Invalid Command: " & LINE_DEFINITION.CONVERT(COMMAND)); end if; end if; exception when others => null; end; end loop; -- Non-interactive mode if one or more arguments else COMMAND := TOLOWER(LINE_DEFINITION.CONVERT(CLI.ARGV(1) & " ")); NARGS := CLI.ARGC - 1; ARGLIST := null; for I in 2 .. CLI.ARGC - 1 loop if I = 2 then ARGLIST := new LINE_DEFINITION.LINE_LIST_ELEMENT; ARG_ROVER := ARGLIST; else ARG_ROVER.NEXT := new LINE_DEFINITION.LINE_LIST_ELEMENT; ARG_ROVER := ARG_ROVER.NEXT; end if; ARG_ROVER.NEXT := null; ARG_ROVER.CONTENT := LINE_DEFINITION.CONVERT(CLI.ARGV(I)); end loop; if NARGS > 0 then if IS_COMMAND(HELP_COMMAND, H_COMMAND) then HELP; elsif IS_COMMAND(CHECK_COMMAND, C_COMMAND) then PAGED_FILE.COMPUTE_CHECKSUM (NARGS, ARGLIST); elsif IS_COMMAND(INCLUDE_COMMAND, I_COMMAND) then PAGED_FILE.MAKE_INCLUDE_FILE (NARGS, ARGLIST); elsif IS_COMMAND(LIST_COMMAND, L_COMMAND) then PAGED_FILE.LIST (NARGS, ARGLIST); elsif IS_COMMAND(PAGE_COMMAND, P_COMMAND) then PAGED_FILE.CREATE (NARGS, ARGLIST); elsif IS_COMMAND(UNPAGE_COMMAND, U_COMMAND) then PAGED_FILE.UNPAGE (NARGS, ARGLIST); elsif IS_COMMAND(EXIT_COMMAND, X_COMMAND) then null; else TEXT_IO.PUT_LINE(" Invalid Command: " & LINE_DEFINITION.CONVERT(COMMAND)); end if; end if; end if; exception when others => null; end PAGER2;