## 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 package tk;
include package 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;
};