15.4.1328  src/lib/tk/src/toolkit/tests+examples/markup_ex.pkg

## markup_ex.pkg
## (C) 1996, Bremen Institute for Safe Systems, Universitaet Bremen
## Author: cxl (Last modification by $Author: 2cxl $)

# Compiled by:
#     src/lib/tk/src/toolkit/tests+examples/sources.sublib



# ***************************************************************************
# 
# tk Markup Languages: an example.
#
# $Date: 2001/03/30 13:40:03 $
# $Revision: 3.0 $
#
# 
# **************************************************************************



package markup_ex: (weak)    api {
                            go:  Void -> Void;
                       }

{

    include package   tk;
    include package   tk_21;

    package colour_tags
        =
        package {

             Widget_Info = Widget_Id;

            exception TEXT_ITEM_ERROR  String;

             Tag
                =
                RED_TAG | BLUE_TAG | GREEN_TAG | BOX_TAG;

            fun matching_tag "red"     =>   THE RED_TAG;
               matching_tag "blue"    =>   THE BLUE_TAG;
               matching_tag "green"   =>   THE GREEN_TAG;
               matching_tag "box"     =>   THE BOX_TAG;
               matching_tag  _        =>   NULL; end;


            fun anno col w_here
                =
                tatag(
                    make_text_item_id(),
                    [w_here],
                    [RELIEF RAISED, FOREGROUND col],
                    []
                );

            fun text_item_for_tag RED_TAG   _ _ marx   => anno RED   marx;
               text_item_for_tag BLUE_TAG  _ _ marx   => anno BLUE  marx; 
               text_item_for_tag GREEN_TAG _ _ marx   => anno GREEN marx;
               text_item_for_tag BOX_TAG   _ _ marx
                  => 
                  tatag (make_text_item_id(), [marx],
                                       [RELIEF RAISED, BORDER_THICKNESS 2], []); end;

             Escape  = Void;

            fun escape _
                =
                NULL;

            fun annotation_for_esc () marx
                =
                NULL;

            fun text_for_esc ()
                =
                "";

            fun escape_sequence x
                =
                x;

            fun warning w
                =
                debug::warning ("Mythryl Warning: " $ w);

            error= DIE;

        };

    package taggit
        =
        tk_markup_g( colour_tags );
                                                                            my
    some_text
        = 
        "In this <red>wonderful<\\red> test text,\n" $ 
        "You should see <blue>blue<\\blue> and <green>green<\\green> bits,\n" $
        "never " $ "mind the <box>boxed<\\box> ones." $
        "\n\n\n1234<red>5<\\red>6789<blue>0<\\blue>12345.\n" $
        "Here's some special characters: +&<*! 1 &lt; 2 " $
        "Rock&amp;roll or what?\n" $
        "\n\n\n<red>Thank you for <blue>your<\\red> attention.<\\blue>\n";

#       $"Here's some erroneous markup code:  Can you &see; this? <closing lt missing, &no semicolon, <blue>No closing tag, <\\closing lt missing." 

    fun text_widget window
        =
        {                                                                 my
            twid      = make_widget_id();                                       my
            ann       = taggit::get_livetext twid some_text;

            text_wid (twid, NOWHERE, ann, [FILL ONLY_X, PACK_AT TOP], 
                    [ACTIVE FALSE], []);
        };


    fun quit_button window
        =
        button (
            make_widget_id(),
                   [PACK_AT BOTTOM, FILL ONLY_X, EXPAND TRUE],
                   [RELIEF RIDGE, BORDER_THICKNESS 2,
                    TEXT "Quit", CALLBACK (\\ () = close_window window)], []); 

                                                                            my
    main_window
        =
        {                                                                 my
            wid = make_window_id ();

            make_window {
                window_id => wid, 
                traits => [WINDOW_TITLE "Colour Tag Test Window"], 
                subwidgets => PACKED [text_widget wid, quit_button wid],
                event_callbacks => [],
                init => null_callback
            };
        };

    fun go ()
        =
        file::write (file::stdout, tk::start_tcl_and_trap_tcl_exceptions [ main_window ]);

};