Category : Miscellaneous Language Source Code
Archive   : ADAXREF.ZIP
Filename : CMDLINE.PKG

--======================================================================

-- 8 DEC 84
-- LAST MODIFIED: 5 NOV 86

with UTIL; use UTIL;

package body CMDLINE is

-- A facility providing access to the arguments appearing on the
-- command line of a JANUS/Ada program. Because command line
-- arguments are frequently file specifications, functions to
-- decompose a file specification into its various parts are also
-- provided. See CMDLINE.LIB, the library unit for this package
-- for further details.

-- Modification Log

-- 13 DEC 84
-- 1. Bug fix: added code to handle empty command line tail.
-- 5 NOV 86 (RLB - RRS)
-- 1. Converted to 1.6.1.

ARG_BUFR : UTIL.COMMAND_STRING;
-- buffer for command line argument list
BUFR_MAX : constant NATURAL := UTIL.COMMAND_STRING'LAST;

-- variables used while searching ARG_BUFR
subtype BUFR_RANGE is NATURAL range 0 .. BUFR_MAX;
subtype BUFR_INDEX is BUFR_RANGE range 1 .. BUFR_MAX;
ARG_LIST_LEN : BUFR_RANGE; -- length of argument list
INDX1, INDX2 : BUFR_INDEX; -- character indexes

ARG_CNT : ARG_RANGE := 0;
-- number of arguments contained in command line argument list;
-- this is the value returned by the ARG_COUNT function

ARG_TABLE : array (1 .. MAX_ARGS) of ARGUMENT;
-- table used to store command line argurments after they have
-- been extracted from ARG_BUFR; entries in this array are
-- returned by the FETCH_ARG function

type STATE is (WHITE_SPACE, TOKEN, QUOTED_STRING);
-- state set for argument scanner

SCAN_STATE : STATE;

--------------------------------------------------------------------

function PATH_PART(STR : ARGUMENT) return ARGUMENT is

CHR : ARG_RANGE := 0;
RESULT : ARGUMENT;

begin

for CH in reverse 1 .. STR.LENGTH loop
if STR.TEXT(CH) = '\' or else STR.TEXT(CH) = ':' then
CHR := CH;
exit;
end if;
end loop;

RESULT := STR;
RESULT.LENGTH := CHR; -- This effectively trucates the string.
return RESULT;

end PATH_PART;

--------------------------------------------------------------------

function LOCAL_PART(STR : ARGUMENT) return ARGUMENT is

CHR : NATURAL := 1;
RESULT : ARGUMENT;

begin

for CH in reverse 1 .. STR.LENGTH loop
if STR.TEXT(CH) = '\' or else STR.TEXT(CH) = ':' then
CHR := CH;
exit;
end if;
end loop;

RESULT := STR;

RESULT.LENGTH := STR.LENGTH - CHR; -- Don't include '\' or ':'
RESULT.TEXT(1..RESULT.LENGTH) := STR.TEXT(CHR+1..STR.LENGTH);
return RESULT;

end LOCAL_PART;

--------------------------------------------------------------------

function NAME_PART(STR : ARGUMENT) return ARGUMENT is

CHR : NATURAL := STR.LENGTH;
RESULT : ARGUMENT;

begin

for CH in reverse 1 .. STR.LENGTH loop
if STR.TEXT(CH) = '.' then
CHR := CH;
exit;
end if;
end loop;

RESULT := STR;
RESULT.LENGTH := CHR; -- This effectively trucates the string.
return RESULT;

end NAME_PART;

--------------------------------------------------------------------

function EXT_PART(STR : ARGUMENT) return ARGUMENT is

CHR : NATURAL := STR.LENGTH;
RESULT : ARGUMENT;

begin

for CH in reverse 1 .. STR.LENGTH loop
exit when STR.TEXT(CH) = '.';
CHR := CH;
end loop;

RESULT := STR;

RESULT.LENGTH := STR.LENGTH - CHR; -- Don't include '.'
RESULT.TEXT(1..RESULT.LENGTH) := STR.TEXT(CHR+1..STR.LENGTH);
return RESULT;

end EXT_PART;

--------------------------------------------------------------------

function ARG_COUNT return ARG_RANGE is

begin

return ARG_CNT;

end ARG_COUNT;

--------------------------------------------------------------------

function FETCH_ARG(K : ARG_INDEX) return ARGUMENT is
NO_RESULT : ARGUMENT;
begin

if K in 1 .. ARG_CNT then
return ARG_TABLE(K);
else
NO_RESULT.LENGTH := 0;
return NO_RESULT;
end if;

end FETCH_ARG;

--------------------------------------------------------------------

procedure ARG_FOUND is

ARG_LEN : BUFR_RANGE := INDX2 - INDX1;

begin

if ARG_CNT >= MAX_ARGS then return; end if;
ARG_CNT := ARG_CNT + 1;

if INDX2 = ARG_LIST_LEN and then
ARG_BUFR(INDX2) /= ASCII.QUOTATION then
ARG_LEN := ARG_LEN + 1;
end if;
ARG_TABLE(ARG_CNT).LENGTH := ARG_LEN;
ARG_TABLE(ARG_CNT).TEXT(1..ARG_LEN) := ARG_BUFR(INDX1 .. INDX1 + ARG_LEN - 1);

end ARG_FOUND;

--------------------------------------------------------------------

begin

-- get the command line list and find its length
UTIL.COMMAND_LINE(ARG_BUFR,ARG_LIST_LEN);

-- initialize the scanner
INDX1 := 1;
SCAN_STATE := WHITE_SPACE;

SCANNER : loop
-- state transition controlled scan for arguments
exit SCANNER when ARG_LIST_LEN = 0;
case SCAN_STATE is
when WHITE_SPACE =>
case ARG_BUFR(INDX1) is
when ' ' | ASCII.HT =>
exit SCANNER when INDX1 = ARG_LIST_LEN;
INDX1 := INDX1 + 1;
when ASCII.QUOTATION =>
exit SCANNER when INDX1 = ARG_LIST_LEN;
INDX1 := INDX1 + 1;
INDX2 := INDX1;
SCAN_STATE := QUOTED_STRING;
when others =>
INDX2 := INDX1;
SCAN_STATE := TOKEN;
end case;
when TOKEN =>
case ARG_BUFR(INDX2) is
when ' ' | ASCII.HT =>
ARG_FOUND;
INDX1 := INDX2;
SCAN_STATE := WHITE_SPACE;
when others =>
if INDX2 = ARG_LIST_LEN then
ARG_FOUND;
exit SCANNER;
end if;
INDX2 := INDX2 + 1;
end case;
when QUOTED_STRING =>
case ARG_BUFR(INDX2) is
when ASCII.QUOTATION =>
ARG_FOUND;
ARG_BUFR(INDX2) := ' ';
INDX1 := INDX2;
SCAN_STATE := WHITE_SPACE;
when others =>
if INDX2 = ARG_LIST_LEN then
ARG_FOUND;
exit SCANNER;
end if;
INDX2 := INDX2 + 1;
end case;
end case;
end loop SCANNER;

end CMDLINE;

--======================================================================