DataMuseum.dk

top - metrics - download

    Length: 5885 (0x16fd)
    Types: TextFile
    Names: »B«

└─⟦180fe333a⟧ Bits:30000405 8mm tape, Rational 1000, SW CATALOG, 10_20_0
└─⟦180fe333a⟧ Bits:30000537 8mm tape, Rational 1000, SW Catalog 10_20_0
    └─⟦5cb1d1d7f⟧ »DATA« 
        └─⟦3b1ee7bd8⟧ 
            └─⟦this⟧ 

TextFile

with Source_Instrumenter_Declarations;

package body Change_Text is
    --| Subprograms for the manipulation of source text

    --| Overview

    --| Change_Text, Change_Sharp and String_Value are all functions which which
    --| take a parameter of type PD.Source_Text which is an access to a string
    --| type and return a string.  Each dereferences its parameter, performs the
    --| appropriate manipulations and returns the manipulated string.

    package Sid renames Source_Instrumenter_Declarations;

    -----------------------------------------------------------------------
    -- Local Subprogram Specifications
    -----------------------------------------------------------------------

    function Uppercase (Char : Character) return Character;
    --| Returns the uppercase value of the passed in character

    --| Effects

    --| If Char is alphabetic, its uppercase value is returned.  Otherwise,
    --| Char is returned unchanged.

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

    function Lowercase (Char : Character) return Character;
    --| Returns the lowercase value of the passed in character

    --| Effects

    --| If Char is alphabetic, its lowercase value is returned.  Otherwise,
    --| Char is returned unchanged.

    -----------------------------------------------------------------------
    -- External Subprogram Bodies
    -----------------------------------------------------------------------

    function Change_Case (Token_Text : Pd.Source_Text; To_Case : Case_Name)
                         return String is

        Preceding_Underscore : Boolean := True;
        --| Flags that the preceding character is an underscore, indicating
        --| that the following character should be capitalized.  Initialized
        --| to True so that the first character of the Token will be
        --| capitalized.

    begin

        -- case selectors match enumeration type Case_Name
        case To_Case is
            when Uppercase =>
                for I in Token_Text.all'First .. Token_Text.all'Last loop
                    Token_Text.all (I) := Uppercase (Token_Text.all (I));
                end loop;
                return Token_Text.all;
            when Lowercase =>
                for I in Token_Text.all'First .. Token_Text.all'Last loop
                    Token_Text.all (I) := Lowercase (Token_Text.all (I));
                end loop;
                return Token_Text.all;
        end case;
    end Change_Case;

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

    function Change_Sharp (Token_Text : Pd.Source_Text) return String is
    begin
        for I in Token_Text.all'First .. Token_Text.all'Last loop
            if Token_Text.all (I) = '#' then
                Token_Text.all (I) := ':';
            end if;
        end loop;
        return Token_Text.all;
    end Change_Sharp;

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

    function String_Value (Token_Text : Pd.Source_Text) return String is
        Mark : Positive; --| Marks a point in the input string as the start of
        --| where to copy the next section of string.
        String_Text : Pd.Source_Text; --| String being built
        Delimiter_Character : Character := '"'; --| String delimiter character
        Delimiter_String : String (1 .. 1) := """";
        --| String to insert into the string being built as delimiter character

    begin
        if Sid.Delimiters = Sid.Basic then
            Delimiter_Character := '%';
            Delimiter_String := "%";
        else
            Delimiter_Character := '"';
            Delimiter_String := """";
        end if;
        String_Text := new String'(Delimiter_String);
        Mark := Token_Text'First;
        for I in Token_Text'First .. Token_Text'Last loop
            if Token_Text.all (I) = Delimiter_Character then
                String_Text := new String'(String_Text.all &
                                           Token_Text.all (Mark .. I) &
                                           Delimiter_String);
                Mark := I + 1;
            end if;
        end loop;
        return String_Text.all & Token_Text.all (Mark .. Token_Text.all'Last) &
                  Delimiter_String;
    end String_Value;

    -----------------------------------------------------------------------
    -- Local Subprogram Bodies
    -----------------------------------------------------------------------

    function Uppercase (Char : Character) return Character is
    begin
        if Char in 'a' .. 'z' then
            return Character'Val (Character'Pos (Char) -
                                  Character'Pos ('a') + Character'Pos ('A'));
        else
            return Char;
        end if;
    end Uppercase;

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

    function Lowercase (Char : Character) return Character is
    begin
        if Char in 'A' .. 'Z' then
            return Character'Val (Character'Pos (Char) -
                                  Character'Pos ('A') + Character'Pos ('a'));
        else
            return Char;
        end if;
    end Lowercase;

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

    function Convert_Periods_To_Underscores
                (Input_String : in String) return String is
        Output_String : String (1 .. Input_String'Length);
    begin
        for Index in Input_String'Range loop
            if Input_String (Index) = '.' then
                Output_String (Index) := '_';
            else
                Output_String (Index) := Input_String (Index);
            end if;
        end loop;
        return Output_String;
    end Convert_Periods_To_Underscores;

end Change_Text;

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