Piper's Pit BBS/FTP: ibm 0010 - 0019/ibm0010-0019/ibm0010.tar/ibm0010/ME494-6.ZIP/INTERCEP.SRC

Text File | 1990-04-17 | 12.7 KB | 419 lines

$MACRO_FILE INTERCEP;
{******************************************************************************
Contains a means of intercepting and filtering keystrokes for various purposes.

    INTERCEP - The main intercept macro.

The remaining macros are simply examples of just a few things that can be done
with INTERCEP:

    ASCICODE - Constantly displays the ASCII code of the current character.
    CURCOLOR - An interface for setting the color for HIGHLITE.
    HILITE - Displays the cursor line in a different color.
    ASM_CAPS - Provides an interesting language support for Assembly.

                                Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}

$MACRO INTERCEP;
{******************************************************************************
                                                             MULTI-EDIT MACRO

NAME:  INTERCEP

DESCRIPTION:  Intercepts all keystrokes and can be used to process keystrokes
based on whatever conditions the user wishes to add.  Once inside this macro,
the only way you can get out is by exiting the editor, or pressing a special
"hot" key currently defined as <ALTQ>.

                             (C) Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}

{This simply initializes the color for the macro HILITE}
IF (GLOBAL_INT('Cursor_Line_Color') = 0) THEN
    SET_GLOBAL_INT('Cursor_Line_Color',Error_Color);
END;

DO_READ_KEY:

{Here is a macro that unconditionally gets run after every keystroke. It
displays the ASCII code of the character at the cursor in decimal and Hex.  If
you don't like it, simply comment out the following line and the similar line
before the GOTO EXIT statement.}
    Run_Macro('ASCICODE /D=Y');

{Here is another macro that unconditionally gets run after every keystroke. It
displays the Line the Cursor is on in a user defined color.  Here again, you
may wish to comment it out, along with the matching exit call.
    Run_Macro('HILITE /D=Y');
}
    Read_Key;

{Here is the "escape hatch"}
    IF ((Key1 = 0) and (Key2 = 16)) THEN                                    {if ALT-Q was pressed}
        Run_Macro('ASCICODE /D=N');
{        Run_Macro('HILITE /D=N');}
        Goto EXIT;
    END;

{The following is an example of a special condition to process keystrokes if the
extension is .ASM for assembly language editing.  If you don't like this one,
comment out the next 3 lines plus the 6th line down.
    IF (Caps(Get_Extension(File_Name)) = 'ASM') THEN
        Run_Macro('ASM_CAPS');
    ELSE}
{Otherwise, the keystroke will be passed to the editor normally}
        Pass_Key(Key1,Key2);
{    END;}

{This is to trap any errors generated by macros}
    IF (Error_Level) THEN
        Run_Macro('Meerror');
    END;

    Goto DO_READ_KEY;

EXIT:
END_MACRO;

$MACRO ASCICODE;
{******************************************************************************
                                                             MULTI-EDIT MACRO

NAME:  ASCICODE

DESCRIPTION:  Constantly displays the decimal and hex ASCII code of the
character at the cursor.

                             (C) Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}

    Def_Int(ASCII_Code,X_Offset);
    Def_Str(Ascii_String);
{Set up X coordinate according to window coordinates and whether or not window
is in document mode}
        X_Offset := Win_X1 + (Doc_Mode * 7) + 3;

{Check to see if parameter was passed to turn display off}
    IF (Parse_Str('/D=',MParm_Str) = 'N') THEN
        Write('───────────────────',X_Offset,Win_Y1,0,B_color);
        Goto EXIT;
    END;

{Store decimal ascii value in integer and string variables}
        ASCII_Code := Ascii(Cur_Char);
        Ascii_String := Str(Ascii_Code);
{Write outlines and zero character padding for decimal}
        Write('D:   ─H:',X_Offset,Win_Y1,0,B_color);
        Write('000',X_Offset + 2,3,0,S_color);
{Write decimal value}
        Write(Ascii_String,X_Offset + 5 - Length(Ascii_String),Win_Y1,0,
                                                                                                                                    S_color);
{Write hex value}
        Write(Copy('0123456789ABCDEF',(ASCII_Code SHR 4) + 1,1) +
                                                        Copy('0123456789ABCDEF',(ASCII_Code and 15) + 1,1),
                                                                        X_Offset + 8,Win_Y1,0,S_color);
EXIT:
END_MACRO;

$MACRO CURCOLOR;
{******************************************************************************
                                                             MULTI-EDIT MACRO

NAME:  CURCOLOR

DESCRIPTION:  Allows the user to set the background and foreground colors for
the macro HILITE

                             (C) Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}
    Def_Int(X1,Y1,Temp_Fore,Temp_Back);

{Initialize variables}
    X1 := 20;
    Y1 := 4;
    Temp_Fore := GLOBAL_INT('Cursor_Line_Color') and $0F;
    Temp_Back := GLOBAL_INT('Cursor_Line_Color') shr 4;
    Put_Box(X1,Y1 - 1,X1 + 34,Y1 + 4,0,M_B_Color,'CURSOR LINE COLOR',true);

COLOR_LOOP:
    write(' to change foreground color  ',X1 + 1,Y1,0,(Temp_Back shl 4) or (Temp_Fore and $0F));
    write('|27 to change background color. ',X1 + 1,Y1 + 1,0,(Temp_Back shl 4) or (Temp_Fore and $0F));
    write('<ENTER> to accept, <ESC> aborts',X1 + 1,Y1 + 2,0,(Temp_Back shl 4) or (Temp_Fore and $0F));

    Read_Key;

    IF (Key1 = 27) THEN
        Goto EXIT;
    END;
    IF (Key1 = 13) THEN
        SET_GLOBAL_INT('Cursor_Line_Color',(Temp_Back shl 4) or (Temp_Fore and $0F));
        Goto EXIT;
    END;
    IF (Key1 = 0) THEN
        IF (Key2 = 72) THEN
            --Temp_Fore;
        END;
        IF (Key2 = 80) THEN
            ++Temp_Fore;
        END;
        IF (Key2 = 75) THEN
            --Temp_Back;
        END;
        IF (Key2 = 77) THEN
            ++Temp_Back;
        END;
    END;
    Goto Color_LOOP;

EXIT:
    Kill_Box;

END_MACRO;

$MACRO HILITE;
{******************************************************************************
                                                             MULTI-EDIT MACRO

NAME:  HILITE

DESCRIPTION:  Constantly displays the line the cursor is on in a user
definable color.  This macro cannot address the problem of horizontal
scrolling or changed lines.

                             (C) Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}

    IF (Parse_Str('/D=',MParm_Str) = 'N') THEN
{Exit routine, sets display back to normal}
        Redraw;
        Goto EXIT;
    END;

    IF (Marking) THEN
        Goto EXIT;
    END;

    Def_Str(Temp_String[132]);
    Def_Int(Width,Jx,Jy,Jz,Reverse);

    Reverse := ((Global_Int('Cursor_Line_Color') and $0F) Shl 4) or (GLOBAL_INT('Cursor_Line_Color') shr 4);

    Width := Win_X2 - Win_X1 - 1;

{If an arrow key was pressed, then write the previously hilited line in normal
colors}
    IF ((Key1 = 0) and (Key2 = 72)) THEN {Up Arrow}
{Go to the line below}
        Down;
{Store displayable part of the line into a variable with enough space padding
to allow for blank lines.  The padding is neccesary if the background color is
different than the regular background color}
        Temp_String := Copy(Get_Line +
                '                                                                  ' +
                '                                                                  '
                                                                                                            ,1,Width);
{Change the tab characters to space characters}
        IF Not(Display_Tabs) THEN
            Tabs_To_Spaces(Temp_String);
        END;
{Write it}
        IF (Line_Changed) THEN
            Write(Temp_String,Win_X1 + 1,WhereY,0,C_Color);
        ELSE
            Write(Temp_String,Win_X1 + 1,WhereY,0,T_Color);
        END;
{If we happen to be on a line with a block defined, then write the block in
reverse video}
        IF (Block_Stat) THEN
            IF ((C_Line >= Block_Line1) and (C_Line <= Block_Line2)) THEN
                IF (Block_Stat = 1) THEN {Line blocks}
                    Write(Temp_String,Win_X1 + 1,WhereY,0,H_Color);
                END;
                IF (Block_Stat = 2) THEN {Column blocks}
                    IF (Block_Col1 <= Width) THEN
                        Jx := Block_Col2;
                        IF (Jx > Width) THEN
                            Jx := Width;
                        END;
                        Write(Copy(Temp_String,Block_Col1,Jx - Block_Col1 + 1),
                                                                            Block_Col1,WhereY,0,H_Color);
                    END;
                END;
                IF (Block_Stat = 3) THEN {Stream blocks}
                    Jx := 1;
                    Jy := Width;
                    Jz := Jx;
                    IF (C_Line = Block_Line1) THEN
                        IF (Block_Col1 <= Width) THEN
                            Jx := Block_Col1;
                            Jy := Width - Block_Col1 + 1;
                            Jz := Block_Col1;
                        ELSE
                            Goto SKIP1;
                        END;
                    END;
                    IF (C_Line = Block_Line2) THEN
                        IF (Block_Col2 <= Width) THEN
                            Jy := Block_Col2 - Jx + 1;
                        ELSE
                            Jy := Width - Jx + 1;
                        END;
                    END;
                    Write(Copy(Temp_String,Jx,Jy),Jz,WhereY,0,H_Color);
                END;
            END;
        END;
SKIP1:
{Now, move back where your supposed to be!}
        Up;
    END;
    IF ((Key1 = 0) and (Key2 = 80)) THEN {Down Arrow}
        Up;
        Temp_String := Copy(Get_Line +
                '                                                                  ' +
                '                                                                  '
                                                                                                            ,1,Width);
        IF Not(Display_Tabs) THEN
            Tabs_To_Spaces(Temp_String);
        END;
        IF (Line_Changed) THEN
            Write(Temp_String,Win_X1 + 1,WhereY,0,C_Color);
        ELSE
            Write(Temp_String,Win_X1 + 1,WhereY,0,T_Color);
        END;
        IF (Block_Stat) THEN
            IF ((C_Line >= Block_Line1) and (C_Line <= Block_Line2)) THEN
                IF (Block_Stat = 1) THEN {Line blocks}
                    Write(Temp_String,Win_X1 + 1,WhereY,0,H_Color);
                END;
                IF (Block_Stat = 2) THEN {Column blocks}
                    IF (Block_Col1 <= Width) THEN
                        Jx := Block_Col2;
                        IF (Jx > Width) THEN
                            Jx := Width;
                        END;
                        Write(Copy(Temp_String,Block_Col1,Jx - Block_Col1 + 1),
                                                                            Block_Col1,WhereY,0,H_Color);
                    END;
                END;
                IF (Block_Stat = 3) THEN {Stream blocks}
                    Jx := 1;
                    Jy := Width;
                    Jz := Jx;
                    IF (C_Line = Block_Line1) THEN
                        IF (Block_Col1 <= Width) THEN
                            Jx := Block_Col1;
                            Jy := Width - Block_Col1 + 1;
                            Jz := Block_Col1;
                        ELSE
                            Goto SKIP2;
                        END;
                    END;
                    IF (C_Line = Block_Line2) THEN
                        IF (Block_Col2 <= Width) THEN
                            Jy := Block_Col2 - Jx + 1;
                        ELSE
                            Jy := Width - Jx + 1;
                        END;
                    END;
                    Write(Copy(Temp_String,Jx,Jy),Jz,WhereY,0,H_Color);
                END;
            END;
        END;
SKIP2:
        Down;
    END;
{This is the same as above, except it is written to the screen in the alternate
color}
        Temp_String := Copy(Get_Line +
                '                                                                  ' +
                '                                                                  '
                                                                                                            ,1,Width);
        IF Not(Display_Tabs) THEN
            Tabs_To_Spaces(Temp_String);
        END;
    Write(Temp_String,Win_X1 + 1,WhereY,0,Global_Int('Cursor_Line_Color'));
        IF (Block_Stat) THEN
            IF ((C_Line >= Block_Line1) and (C_Line <= Block_Line2)) THEN
                IF (Block_Stat = 1) THEN {Line blocks}
                    Write(Temp_String,Win_X1 + 1,WhereY,0,Reverse);
                END;
                IF (Block_Stat = 2) THEN {Column blocks}
                    IF (Block_Col1 <= Width) THEN
                        Jx := Block_Col2;
                        IF (Jx > Width) THEN
                            Jx := Width;
                        END;
                        Write(Copy(Temp_String,Block_Col1,Jx - Block_Col1 + 1),
                                                                            Block_Col1,WhereY,0,Reverse);
                    END;
                END;
                IF (Block_Stat = 3) THEN {Stream blocks}
                    Jx := 1;
                    Jy := Width;
                    Jz := Jx;
                    IF (C_Line = Block_Line1) THEN
                        IF (Block_Col1 <= Width) THEN
                            Jx := Block_Col1;
                            Jy := Width - Block_Col1 + 1;
                            Jz := Block_Col1;
                        ELSE
                            Goto SKIP3;
                        END;
                    END;
                    IF (C_Line = Block_Line2) THEN
                        IF (Block_Col2 <= Width) THEN
                            Jy := Block_Col2 - Jx + 1;
                        ELSE
                            Jy := Width - Jx + 1;
                        END;
                    END;
                    Write(Copy(Temp_String,Jx,Jy),Jz,WhereY,0,Reverse);
                END;
            END;
        END;
SKIP3:
EXIT:
END_MACRO;

$MACRO ASM_CAPS;
{******************************************************************************
                                                             MULTI-EDIT MACRO

NAME:  ASM_CAPS

DESCRIPTION:  This macro is called by INTERCEP.MAC.  It will simulate a forced
"Caps Lock" until a ';' comment delimiter is encountered.  Then it will pass
the keystrokes unaltered.  When <ENTER> is pressed, it will go back to caps lock.

                             (C) Copyright 1989 by American Cybernetics, Inc.
******************************************************************************}

    Def_Int(New_Key1,Caps_Lock);

{Initialize Caps_Lock flag}
    IF (First_Run) THEN
        Set_Global_Int('Caps_Lock',True);
    END;

{Save keycode into a variable}
    New_Key1 := Key1;
    IF (New_Key1 = 13) THEN                                                            {if <ENTER> was pressed}
        Set_Global_Int('Caps_Lock',True);
    END;
    IF (New_Key1 = 59) THEN                                                                        {if ; was pressed}
        Set_Global_Int('Caps_Lock',False);
    END;
{Check status of Caps_Lock flag}
    IF (Global_Int('Caps_Lock')) THEN
        IF (New_Key1 > 96) and (New_Key1 < 123) THEN
{"Upper case" the key code}
            New_Key1 := New_Key1 - 32;
        END;
    END;
{Pass the altered keystoke to the editor}
    Pass_Key(New_Key1,Key2);

END_MACRO;