/* ***************************************************************************
# Compiled by:
# src/lib/tk/src/tk.sublib Annotated texts for the tk markup language.
$Date: 2001/03/30 13:38:57 $
$Revision: 3.0 $
Author: cxl (Last modification by $Author: 2cxl $)
(C) 1996, 1998, Bremen Institute for Safe Systems, Universitaet Bremen
************************************************************************** */
package live_text
: (weak) Live_Text # Live_Text is from src/lib/tk/src/live_text.api{
infix my 70 +++ ; # See below -- fixity decl's not allowed inside APIs
include package basic_tk_types;
include package basic_utilities;
# The two int's are the index to the last character/last row of the
# text. This index is calculated `lazily': If it is not given
# explicitly, it is only calculated if another annotated text with
# a non-empty list of annotations is appended to the text.
#
fun get_livetext_text (LIVE_TEXT { str, ... } )
=
str;
fun get_livetext_text_items (LIVE_TEXT { text_items, ... } )
=
text_items;
fun update_livetext_text_items (LIVE_TEXT { len=>x, str=>t, ... } ) a
=
LIVE_TEXT { len=>x, str=>t, text_items=>a };
# Adding rows -- a wee bit funny, since counting starts at one
# but we want to be graceful about line zero as well.
#
fun add_rows (r1, r2)
=
r1+ r2- (int::min (r1, 1));
fun add2mark (r, c) (MARK (rm, cm))
=>
if (rm <= 1 ) MARK (r, c+cm);
else MARK (add_rows (r, rm), cm); fi;
add2mark (r, c) (MARK_TO_END rm)
=>
MARK_TO_END (add_rows (r, rm));
add2mark (r, c) MARK_END
=> MARK_END;
end;
# A wee bit debatable-- we might want to adjust the
# "End" etc. marks in the text_items of the first
# text. Then again, end means end
fun pair f (x, y) = (f x, f y); # has gone into basic_utilities
fun map_mark f (TEXT_ITEM_TAG { text_item_id, marks, traits, event_callbacks } )
=>
TEXT_ITEM_TAG { text_item_id, marks=>map (pair f) marks,
traits, event_callbacks };
map_mark f (TEXT_ITEM_WIDGET { text_item_id, mark, subwidgets, traits,
event_callbacks } )
=>
TEXT_ITEM_WIDGET { text_item_id, mark=>f mark, subwidgets,
traits, event_callbacks }; end;
/* Concatenate two annotated texts with explicit length:
*/
fun cat ((rows, cols), s, a) ((rows0, cols0), t, b)
=
{ ann = a@(map (map_mark (add2mark (rows, cols))) b);
if (rows0 <= 1) # second text only has one line, we only add cols
LIVE_TEXT { len=>THE (rows, cols+cols0), str=>s$t, text_items=>ann };
else LIVE_TEXT { len=>THE (add_rows (rows, rows0), cols0),
str=>s$t, text_items=>ann };
fi;
};
# Count length of annotated text
fun livetext_length t
=
{ fun count (thischar, (line, char))
=
if (string_util::is_linefeed thischar)
(line+1, 0);
else (line, char+1); fi;
my (rows, cols)
=
substring::fold_forward count (1, 0) (substring::from_string t);
(int::max (rows, 1), cols);
};
fun get_livetext_rows_cols (LIVE_TEXT { len=>THE (r, c), ... } )
=>
{ rows=> r, cols=> c };
get_livetext_rows_cols (LIVE_TEXT { len=>NULL, str=>t, ... } )
=>
{ my (r, c)= livetext_length t;
{ rows=> r, cols=> c };
};
end;
fun ( (LIVE_TEXT { len=>NULL, str=>s, text_items => a } )
+++
(LIVE_TEXT { len=>NULL, str=>t, text_items => [] } )
)
=>
(LIVE_TEXT { len=>NULL, str=>s$t, text_items=>a } );
( (LIVE_TEXT { len=>len1, str=>s, text_items=>a } )
+++
(LIVE_TEXT { len=>len2, str=>t, text_items=>b } )
)
=>
{ fun get_len (THE (r, c), s, a) => ((r, c), s, a);
get_len (NULL, s, a) => (livetext_length s, s, a);
end;
cat (get_len (len1, s, a)) (get_len (len2, t, b));
};
end;
fun nl (LIVE_TEXT { len=>NULL, str=>s, text_items=>a } )
=>
LIVE_TEXT { len=>NULL, str=>s$"\n", text_items=>a };
nl (LIVE_TEXT { len=>THE (r, c), str=>s, text_items=>a } )
=>
LIVE_TEXT { len=>THE (r+1, 0), str=>s$"\n", text_items=>a };
end;
empty_livetext
=
LIVE_TEXT { len=>NULL, str=>"", text_items => [] };
fun adjust_marks { rows, cols } annos
=
map (map_mark (add2mark (rows, cols))) annos;
# Convert a string to an annotated text with no text_items
fun make str
=
LIVE_TEXT { len=>NULL, str, text_items => [] };
fun livetext_join str ls
=
join' ls
where
at = make str;
fun join' [] => empty_livetext;
join' [t] => t;
join' (t . ts) => at +++ at +++ (join' ts);
end;
end;
};