PreviousUpNext

15.4.1290  src/lib/tk/src/toolkit/standard-markup-tags-g.pkg

## standard-markup-tags-g.pkg

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




# **************************************************************************
#  The standard Markup language, extendible 
#  There is a ready-to-use version below    
# ***************************************************************************

# The tk Standard Markup Language.
#
# This module offers a standard markup language for use with tk. It is 
# still generic with respect to the event_callbacks, since these need to be 
# compiled rather than generated.
#
# This has the disadvantage that the standard tags implemented by the
# StdExMarkup module below (eg. em) can't have event_callbacks, and on the
# other hand the naming tags will find it hard to use the
# font-changing tags provided by said module. On the other hand, it
# is a clear separation of concerns.
#
# $Date: 2001/03/30 13:39:50 $
# $Revision: 3.0 $
#



###          "Every tool carries with it
###              the spirit by which it has been created."
###
###                         -- Werner Karl Heisenberg



api Bind_Tags {

         Bind_Tag;
         Widget_Info;
        
        #  matchingBTag returns a bindTag matching the given string 
        matching_btag:       String -> Null_Or( Bind_Tag );


        # annotationForBTag returns an annotation for a given BTag. 
        # It may raise exception BTAG_ERROR (below) if an error occurs

         annotation_for_btag:  Bind_Tag -> List( String ) -> Widget_Info ->
                                        ((tk::Mark, tk::Mark)) -> tk::Text_Item;
                                                            
        exception BTAG_ERROR  String;


        #  Additional customized escape sequences 

         Escape;

         escape:    String -> Null_Or( Escape );

         text_for_esc:        Escape -> String;    

         annotation_for_esc:  Escape -> ((tk::Mark, tk::Mark))
                                          -> null_or::Null_Or( tk::Text_Item );

        #  The exception to be raised by the parser if an error occurs 
         parsing_error:       String -> Exception;

    };

generic package standard_markup_tags_g (naming_tags:  Bind_Tags)                # Bind_Tags     is from   src/lib/tk/src/toolkit/standard-markup-tags-g.pkg

: (weak) Tags           # Tags  is from   src/lib/tk/src/toolkit/markup.api
# where type Widget_Info= namingTags::Widget_Info

{
    include tk;
    include basic_utilities;

    error= naming_tags::parsing_error;

    exception TEXT_ITEM_ERROR  String;

     Tag = 
        FONT_TAG |                              # Fonts.
        RAISE_TAG | BOX_TAG  |                  # Raised/lowered boxes.
        BIND_TAG  naming_tags::Bind_Tag;        # Naming tags.
        #  Derived tags 
        #  SUPER_TAG | SUB_TAG 

    fun matching_tag "font"  => THE FONT_TAG;
        matching_tag "raise" => THE RAISE_TAG;
        matching_tag "box"   => THE BOX_TAG;
      /*                
      | matching_tag "super" = THE SUPER_TAG
      | matching_tag "sub"   = THE SUB_TAG
       */
        matching_tag  str
            =>
            case (naming_tags::matching_btag str)   
                THE bt => THE (bind_tag bt);
                NULL    => NULL;
            esac;
    end;

    fun font_annotation args w_here
        = 
        {   exception NO_CONF_FONT;

            fun font_conf "bf"    => BOLD;
                font_conf "bold"  => BOLD;
                font_conf "it"    => ITALIC;
                font_conf "em"    => ITALIC;
                font_conf "tiny"  => TINY;
                font_conf "small" => SMALL;
                font_conf "large" => LARGE;
                font_conf "huge"  => HUGE; 

                font_conf str
                    => 
                    if (string::is_prefix "size=" str)
                        
                          fstr  = substring (str, 5, (size str)-5);

                          factor= case (float::from_string fstr)   
                                              THE f=> f;
                                             NULL  => raise exception (TEXT_ITEM_ERROR "No argument for SCALE trait");
                                  esac;
                          SCALE factor;
                    else
                         raise exception NO_CONF_FONT;
                    fi;
            end;

            fun font_name "tt"    => TYPEWRITER;
                font_name "sf"    => SANS_SERIF;
                font_name "symb"  => SYMBOL;
                font_name  _      => raise exception NO_CONF_FONT;
            end;

            fun fold_config (c, r)
                =
                (font_conf c) . r 
                except NO_CONF_FONT = r;

            fun get_font a
                =
                font_name (list::last a)
                except
                    NO_CONF_FONT => NORMAL_FONT;
                    EMPTY        => NORMAL_FONT;
                end;

            font = (get_font args) 
                       (fold_backward fold_config ([]: List( Font_Trait )) args);

            TEXT_ITEM_TAG { text_item_id=> make_text_item_id(), 
                  marks=> [w_here], traits=> [FONT font], event_callbacks=> [] };
        };


    fun get_first_arg nm []     => raise exception (TEXT_ITEM_ERROR
                                      ("No argument for " $ nm $ " tag"));
       get_first_arg _  (r . _) => r; end;

     Widget_Info   = naming_tags::Widget_Info;

    fun text_item_for_tag FONT_TAG args wi wh
        =>
        font_annotation args wh;

       text_item_for_tag RAISE_TAG r wi wh
        => 
        TEXT_ITEM_TAG { text_item_id=> make_text_item_id(), marks=> [wh],
                               traits=> [OFFSET (string_util::to_int 
                                                 (get_first_arg "RAISE" r))],

                               event_callbacks=> [] };

       text_item_for_tag BOX_TAG r wi wh
        => 
        TEXT_ITEM_TAG {
            text_item_id  => make_text_item_id(),
            marks  => [wh],
            traits => [RELIEF GROOVE, BORDER_THICKNESS 1], 
            event_callbacks => []
        };

       text_item_for_tag (bind_tag btag) args wi wh
        => 
        naming_tags::annotation_for_btag btag args wi wh; end;


     Escape = BT_ESC  naming_tags::Escape 
                | FONT   (Font, String); 

    fun makechr fspec s = THE (font (fspec, string::from_char (char::from_int s)));
    fun makestr fspec s = THE (font (fspec, string::implode (map char::from_int s)));

    symbchr    = makechr (SYMBOL []);
    symbstr    = makestr (SYMBOL []);
    bigsymbchr = makechr (SYMBOL [HUGE]);

    /* The following escape sequences by and large follow TeX's 
     * naming, except where I find these very inappropriate (vee, wedge,
     * cup and cap are called or, and, union and intersect, respectively);
     * but in particular with respect to the greek letters (varphi, varrho,
     * varepsislon etc.) 
     * Also, I _know_ the following is not the greek alphabet -- it's the 
     * order in which the letters appear in the symbol font.
     */

    fun #  grk letters, lowercase 
        escape "alpha" => symbchr 97;
       escape "beta"  => symbchr 98;
       escape "chi"   => symbchr 99;
       escape "delta" => symbchr 100;       
       escape "epsilon"=> symbchr 101;
       escape "phi"   => symbchr 102;
       escape "gamma" => symbchr 103;
       escape "eta"   => symbchr 104;
       escape "varphi"=> symbchr 106;
       escape "iota"  => symbchr 105;
       escape "kappa" => symbchr 107;
       escape "lambda"=> symbchr 108;
       escape "mu"    => symbchr 109;
       escape "nu"    => symbchr 110;
       escape "omikron"=> symbchr 111; 
       escape "pi"    => symbchr 112;
       escape "theta" => symbchr 113; 
       escape "vartheta"=> symbchr 74; 
       escape "rho"   => symbchr 114;
       escape "sigma" => symbchr 115;
       escape "varsigma"=> symbchr 86;
       escape "tau"   => symbchr 116;
       escape "upsilon" => symbchr 117;
       escape "varpi" => symbchr 118;
       escape "omega" => symbchr 119;
       escape "xi"    => symbchr 120;
       escape "psi"   => symbchr 121;
       escape "zeta"  => symbchr 122;

        #  grk letters, uppercase 
       escape "Alpha" => symbchr 65;
       escape "Beta"  => symbchr 66;
       escape "Chi"   => symbchr 67;
       escape "Delta" => symbchr 68;
       escape "Eps"   => symbchr 69; 
       escape "Phi"   => symbchr 70; 
       escape "Gamma" => symbchr 71; 
       escape "Eta"   => symbchr 72; 
       escape "Iota"  => symbchr 73; 
       escape "Kappa" => symbchr 75; 
       escape "Lambda"=> symbchr 76; 
       escape "Mu"    => symbchr 77; 
       escape "Nu"    => symbchr 78; 
       escape "Omikron" => symbchr 79;  
       escape "Pi"    => symbchr 80; 
       escape "Theta" => symbchr 81;   
       escape "Rho"   => symbchr 82;
       escape "Sigma" => symbchr 83;
       escape "Tau"   => symbchr 84;
       escape "Upsilon" => symbchr 85; 
       escape "Omega" => symbchr 87;
       escape "Xi"    => symbchr 88;
       escape "Psi"   => symbchr 89;
       escape "Zeta"  => symbchr 90;

        #  quantifiers and junctors 
       escape "forall" => symbchr 34;
       escape "exists" => symbchr 36;
       escape "Forall" => bigsymbchr 34;
       escape "Exists" => bigsymbchr 36;
       escape "existsone" => symbstr [36, 33];
       escape "not"    => symbchr 216;
       escape "and"    => symbchr 217;
       escape "or"     => symbchr 218;

        #  other operations 
       escape "times"  => symbchr 180;
       escape "sum"    => symbchr 229; #  NB. not the same as            
       escape "prod"   => symbchr 213; #  Π and Σ respectively! 
       escape "comp"   => symbchr 183; #  fat dot, a wee dot is 215 
       escape "bullet" => symbchr 183; 
       escape "tensor" => symbchr 196;
       escape "otimes" => symbchr 196;
       escape "oplus"  => symbchr 197;

       escape "bot"    => symbchr 94;

        #  Arrows 
       escape "rightarrow" => symbchr 174;
       escape "Rightarrow" => symbchr 222;
       escape "longrightarrow" => symbstr [190, 174];
       escape "Longrightarrow" => symbstr [61, 222]; #  looks ugly  
       escape "leftrightarrow" => symbchr 171;
       escape "Leftrightarrow" => symbchr 219;
       escape "Downarrow"      => symbchr 223;
       escape "Uparrow"        => symbchr 221;
       escape "vline"          => symbchr 189;
       escape "hline"          => symbchr 190;

       escape "rbrace1"     => symbchr 236;
       escape "rbrace2"     => symbchr 237;  #  these three make a large 
       escape "rbrace3"     => symbchr 238;  #  right brace 

        #  set operations 
       escape "emptyset" => symbchr 198;
       escape "in"       => symbchr 206;
       escape "notin"    => symbchr 207;
       escape "intersect" => symbchr 199;
       escape "union"    => symbchr 200;
       escape "subset"   => symbchr 204;
       escape "subseteq" => symbchr 205;
       escape "setminus" => symbchr 164;
#         | escape "powerset" = makechr (Normalfont [Bold]) 82 
       escape "powerset" => symbchr 195;
       escape "inf"      => symbchr 165;

       escape "Intersect" => bigsymbchr 199;
       escape "Union"    => bigsymbchr 200; 

        #  relations 
       escape "equiv"    => symbchr 186;
       escape "neq"      => symbchr 185;
       escape "leq"      => symbchr 163;
       escape "grteq"    => symbchr 179;

       escape "lsem"     => symbstr [91, 91]; #  "semantic" 
       escape "rsem"     => symbstr [93, 93]; #  Brackets ''[[ ... ]]'' 

        #  misc other symbols 
       escape "dots"     => symbchr 188;
       escape "copyright"=> symbchr 227;

       escape str     => null_or::map bt_esc (naming_tags::escape str); end;

    fun text_for_esc (font(_, s))=> s;
       text_for_esc (bt_esc  e)  => naming_tags::text_for_esc e; end;

    fun annotation_for_esc (font (fspec, _)) wh
        => 
        THE (TEXT_ITEM_TAG { text_item_id=> make_text_item_id(), 
                    marks=> [wh], traits=> [FONT fspec], event_callbacks=> [] } );

       annotation_for_esc (bt_esc s)  wh
        =>
        naming_tags::annotation_for_esc s wh; end;


    fun warning w = file::write (file::stdout, 
                                  "tk Markup warning: " $ w $ "\n");
                    # should use the warning window from utilwin
                    # -- no it bloody shouldn't, since parsing can 
                    #    occur at compile time.


};



package standard_markup {

    stipulate
        package s
            = 
            tk_markup_g (
                standard_markup_tags_g (
                    package {            
                        Bind_Tag    = Void;
                        Widget_Info = Void;                             #  tk::Widget_ID 

                        exception BTAG_ERROR  String;
                        exception STANDARD_MARKUP_PARSE_ERROR  String;

                        parsing_error =   STANDARD_MARKUP_PARSE_ERROR; 

                        fun matching_btag _
                            =
                            NULL;

                        fun annotation_for_btag () _ _ _
                            =
                            raise exception (BTAG_ERROR 
                                   "Illegal annotation in annotationForBTag");

                        Escape = Void;

                        fun  escape _ = NULL;
                        fun  annotation_for_esc () _ = NULL;
                        fun  text_for_esc () = "";
                    }
                )
            );
    herein 
        get_livetext =   s::get_livetext ();
    end;
};



Comments and suggestions to: bugs@mythryl.org

PreviousUpNext