## screenline.pkg
#
# Display one line of textfile contents in a textpane display.
#
# Here we just handle re/display of one line.
# The editing process proper happens mainly in
#
# src/lib/x-kit/widget/edit/fundamental-mode.pkg#
# with toplevel dispatch done from
#
# src/lib/x-kit/widget/edit/textpane.pkg#
# and major support from
#
# src/lib/x-kit/widget/edit/textmill.pkg#
# See also:
# src/lib/x-kit/widget/edit/textpane.pkg# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublib# This package gets used in:
#
#
stipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg include package geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg #
package chr = char; # char is from src/lib/std/char.pkg package evt = gui_event_types; # gui_event_types is from src/lib/x-kit/widget/gui/gui-event-types.pkg package g2p = gadget_to_pixmap; # gadget_to_pixmap is from src/lib/x-kit/widget/theme/gadget-to-pixmap.pkg package gd = gui_displaylist; # gui_displaylist is from src/lib/x-kit/widget/theme/gui-displaylist.pkg package gt = guiboss_types; # guiboss_types is from src/lib/x-kit/widget/gui/guiboss-types.pkg package wt = widget_theme; # widget_theme is from src/lib/x-kit/widget/theme/widget/widget-theme.pkg package wti = widget_theme_imp; # widget_theme_imp is from src/lib/x-kit/widget/xkit/theme/widget/default/widget-theme-imp.pkg package r8 = rgb8; # rgb8 is from src/lib/x-kit/xclient/src/color/rgb8.pkg package r64 = rgb; # rgb is from src/lib/x-kit/xclient/src/color/rgb.pkg package wi = widget_imp; # widget_imp is from src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package g2j = geometry2d_junk; # geometry2d_junk is from src/lib/std/2d/geometry2d-junk.pkg package mtx = rw_matrix; # rw_matrix is from src/lib/std/src/rw-matrix.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package gtg = guiboss_to_guishim; # guiboss_to_guishim is from src/lib/x-kit/widget/theme/guiboss-to-guishim.pkg package p2l = textpane_to_screenline; # textpane_to_screenline is from src/lib/x-kit/widget/edit/textpane-to-screenline.pkg package l2p = screenline_to_textpane; # screenline_to_textpane is from src/lib/x-kit/widget/edit/screenline-to-textpane.pkg package tpt = textpane_types; # textpane_types is from src/lib/x-kit/widget/edit/textpane-types.pkg package mt = millboss_types; # millboss_types is from src/lib/x-kit/widget/edit/millboss-types.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package slt = screenline_types; # screenline_types is from src/lib/x-kit/widget/edit/screenline-types.pkgDummy1 = slt::Redraw_Fn_Arg; # XXX SUCKO DELETEME. This is a quick hack to make sure the package compiles during early development of it.
nb = log::note_on_stderr; # log is from src/lib/std/src/log.pkgherein
package screenline
: Screenline # Screenline is from src/lib/x-kit/widget/edit/screenline.api {
include package screenline_types;
#
Option = PIXELS_SQUARE Int
#
| PIXELS_HIGH_MIN Int
| PIXELS_WIDE_MIN Int
#
| PIXELS_HIGH_CUT Float
| PIXELS_WIDE_CUT Float
#
| INITIALLY_ACTIVE Bool
#
| BODY_COLOR rgb::Rgb
| BODY_COLOR_WITH_MOUSEFOCUS rgb::Rgb
| BODY_COLOR_WHEN_ON rgb::Rgb
| BODY_COLOR_WHEN_ON_WITH_MOUSEFOCUS rgb::Rgb
#
| ID Id
| DOC String
#
| STATE p2l::Linestate # What to display in screenline.
#
| FONT_SIZE Int # Show any text in this pointsize. Default is 12.
| FONTS List(String) # Override theme font: Font to use for text label, e.g. "-*-courier-bold-r-*-*-20-*-*-*-*-*-*-*". We'll use the first font in list which is found on X server, else "9x15" (which X guarantees to have).
#
| ROMAN # Show any text in plain font from widget-theme. This is the default.
| ITALIC # Show any text in italic font from widget-theme.
| BOLD # Show any text in bold font from widget-theme. NB: Text is either bold or italic, not both.
#
| REDRAW_FN Redraw_Fn # Application-specific handler for widget redraw.
| MOUSE_CLICK_FN Mouse_Click_Fn # Application-specific handler for mousebutton clicks.
| MOUSE_DRAG_FN Mouse_Drag_Fn # Application-specific handler for mouse drags.
| MOUSE_TRANSIT_FN Mouse_Transit_Fn # Application-specific handler for mouse crossings.
#
| STATEWATCHER (p2l::Linestate -> Void) # Widget's current state will be sent to these fns each time state changes.
# | PORTWATCHER (Null_Or(Textpane_To_Lineditor) -> Void) # Widget's app port will be sent to these fns at widget startup.
| SITEWATCHER (Null_Or((Id,g2d::Box)) -> Void) # Widget's site in window coordinates will be sent to these fns each time it changes.
; # To help prevent deadlock, watcher fns should be fast and nonblocking, typically just setting a var or entering something into a mailqueue.
fun process_options
( options: List(Option),
#
{ body_color,
body_color_with_mousefocus,
body_color_when_on,
body_color_when_on_with_mousefocus,
#
screenline_id,
widget_doc,
#
state,
#
fonts,
font_weight,
font_size,
#
redraw_fn,
mouse_click_fn,
mouse_drag_fn,
mouse_transit_fn,
#
initially_active,
#
pixels_high_min,
pixels_high_cut,
widget_options,
#
# portwatchers,
statewatchers,
sitewatchers
}
)
=
{ my_body_color = REF body_color;
my_body_color_with_mousefocus = REF body_color_with_mousefocus;
my_body_color_when_on = REF body_color_when_on;
my_body_color_when_on_with_mousefocus = REF body_color_when_on_with_mousefocus;
#
my_screenline_id = REF screenline_id;
my_widget_doc = REF widget_doc;
#
my_state = REF state;
#
my_fonts = REF fonts;
my_font_weight = REF font_weight;
my_font_size = REF font_size;
#
my_redraw_fn = REF redraw_fn;
my_mouse_click_fn = REF mouse_click_fn;
my_mouse_drag_fn = REF mouse_drag_fn;
my_mouse_transit_fn = REF mouse_transit_fn;
#
my_initially_active = REF initially_active;
#
my_pixels_high_min = REF pixels_high_min;
my_pixels_high_cut = REF pixels_high_cut;
my_widget_options = REF widget_options;
#
# my_portwatchers = REF portwatchers;
my_statewatchers = REF statewatchers;
my_sitewatchers = REF sitewatchers;
#
apply do_option options
where
fun do_option (INITIALLY_ACTIVE b) => my_initially_active := b;
#
do_option (BODY_COLOR c) => my_body_color := THE c;
do_option (BODY_COLOR_WITH_MOUSEFOCUS c) => my_body_color_with_mousefocus := THE c;
do_option (BODY_COLOR_WHEN_ON c) => my_body_color_when_on := THE c;
do_option (BODY_COLOR_WHEN_ON_WITH_MOUSEFOCUS c) => my_body_color_when_on_with_mousefocus := THE c;
#
do_option (ID i) => my_screenline_id := THE i;
do_option (DOC d) => my_widget_doc := d;
#
do_option (STATE t) => my_state := t;
#
do_option (FONTS t) => my_fonts := t;
#
do_option (ROMAN ) => my_font_weight := THE wt::ROMAN_FONT;
do_option (ITALIC ) => my_font_weight := THE wt::ITALIC_FONT;
do_option (BOLD ) => my_font_weight := THE wt::BOLD_FONT;
#
do_option (FONT_SIZE i) => my_font_size := THE i;
#
do_option (REDRAW_FN f) => my_redraw_fn := f;
do_option (MOUSE_CLICK_FN f) => my_mouse_click_fn := f;
do_option (MOUSE_DRAG_FN f) => my_mouse_drag_fn := THE f;
do_option (MOUSE_TRANSIT_FN f) => my_mouse_transit_fn := f;
#
# do_option (PORTWATCHER c) => my_portwatchers := c ! *my_portwatchers;
do_option (STATEWATCHER c) => my_statewatchers := c ! *my_statewatchers;
do_option (SITEWATCHER c) => my_sitewatchers := c ! *my_sitewatchers;
#
#
do_option (PIXELS_HIGH_MIN i) => my_pixels_high_min := i;
do_option (PIXELS_WIDE_MIN i) => my_widget_options := (wi::PIXELS_WIDE_MIN i) ! *my_widget_options;
#
do_option (PIXELS_HIGH_CUT f) => my_pixels_high_cut := f;
do_option (PIXELS_WIDE_CUT f) => my_widget_options := (wi::PIXELS_WIDE_CUT f) ! *my_widget_options;
#
do_option (PIXELS_SQUARE i) => my_widget_options := (wi::PIXELS_HIGH_MIN i)
! (wi::PIXELS_WIDE_MIN i)
! (wi::PIXELS_HIGH_CUT 0.0)
! (wi::PIXELS_WIDE_CUT 0.0)
! *my_widget_options;
end;
end;
{ body_color => *my_body_color,
body_color_with_mousefocus => *my_body_color_with_mousefocus,
body_color_when_on => *my_body_color_when_on,
body_color_when_on_with_mousefocus => *my_body_color_when_on_with_mousefocus,
#
screenline_id => *my_screenline_id,
widget_doc => *my_widget_doc,
#
state => *my_state,
#
fonts => *my_fonts,
font_weight => *my_font_weight,
font_size => *my_font_size,
#
redraw_fn => *my_redraw_fn,
mouse_click_fn => *my_mouse_click_fn,
mouse_drag_fn => *my_mouse_drag_fn,
mouse_transit_fn => *my_mouse_transit_fn,
#
initially_active => *my_initially_active,
#
pixels_high_min => *my_pixels_high_min,
pixels_high_cut => *my_pixels_high_cut,
widget_options => *my_widget_options,
#
# portwatchers => *my_portwatchers,
statewatchers => *my_statewatchers,
#
sitewatchers => *my_sitewatchers
};
};
fun default_redraw_fn (REDRAW_FN_ARG a) # Handle a guiboss request to redraw ourself.
=
{
font_size = a.font_size;
font_weight = a.font_weight;
fonts = a.fonts;
gadget_mode = a.gadget_mode;
palette = a.palette;
site = a.site;
state = a.state;
theme = a.theme;
screencol0 = state.screencol0; # Do not display text to left of this screen column. Used to scroll display horizontally. Must be nonnegative.
background_box = site;
text_color = palette.text_color;
# body_color = palette.body_color; # Commented out in favor of whiter and more varied background colors under control of textpane.pkg.
body_color = case gadget_mode.has_mouse_focus # Make background color just a little bit brighter on mouseover.
#
TRUE => state.background ;
FALSE => rgb::rgb_mix01 (0.98, rgb::black, state.background);
esac;
fun get_fontnames ()
=
{ font_size_to_use
=
case font_size THE i => i;
NULL => *theme.default_font_size;
esac;
fontname_to_use
=
case font_weight THE wt::ROMAN_FONT => *theme.get_roman_fontname font_size_to_use;
THE wt::ITALIC_FONT => *theme.get_italic_fontname font_size_to_use;
THE wt::BOLD_FONT => *theme.get_bold_fontname font_size_to_use;
NULL => *theme.get_roman_fontname font_size_to_use;
esac;
fontnames = fonts @ [ fontname_to_use, "9x15" ];
fontnames;
};
stipulate
g = wti::get__guiboss_to_hostwindow theme;
#
font = g.get_font (get_fontnames ());
herein
fun get_text_dimensions (text: String)
=
{
{ font_ascent => font.font_height.ascent,
font_descent => font.font_height.descent,
length_in_pixels => font.string_length_in_pixels text
};
};
end;
(get_text_dimensions "m")
->
{ length_in_pixels => m_width_in_pixels, ... };
m_width_in_pixels = max (3, m_width_in_pixels); # Daft check to avoid possible divide by zero if text dimensions are crazy.
Color_As = NORMAL_TEXT # Text is not part of the active region nor is the cursor on it, so color text normally.
| REGION_TEXT # Text is part of the active region delimited by 'mark' and 'point' -- color it region (green background).
| CURSOR_TEXT # Text is under the cursor -- color it accordingly (reverse video).
| CURION_TEXT # Text is part of the active region with the cursor at the start of the region -- color it region and draw cursor as an unfilled black box.
;
fun region_color (body_color: rgb::Rgb, text_color: rgb::Rgb) # Construct background color for selected region (delimited by 'mark' and 'point'). Currently region_color is same as body_color except less red, leaving a cyan.
=
{ red => (body_color.red + text_color.red) * 0.5, # Typically text color is black and body color is white(ish) -- in this case the region background here will wind up cyan-ish. (Emacs uses yellow here.)
green => body_color.green, # (This hack should probably be a fn in the widget-theme rather than hardwired here.)
blue => body_color.blue
};
fun append_text_to_displaylist
(
displaylist_so_far: gd::Gui_Displaylist,
chars_to_skip: Int, # Support for scrolling textpane horizontally.
text_indent: Int, # Draw our text starting at this horizontal pixel coordinate. We use this to concatenate multiple strings sanely on a line.
text: String, # Text to draw. Tabs and control chars have been expanded out.
text_box: g2d::Box,
color_as: Color_As
)
=
if (text == "")
(displaylist_so_far, chars_to_skip, text_indent); # ... nothing to do.
else
charlen = string::length_in_chars text;
# # If start of cursor is out of sight off left or right side of display, let textpane know that it needs to scroll horizontally to bring it into view.
case color_as
#
(CURSOR_TEXT | CURION_TEXT) # We DO have start-of-cursor at start of 'text'.
=> #
if (chars_to_skip > 0) # Start of text is out of view to left of textpane.
# # Hence, cursor is out of sight off left side of display.
panewidth_in_cols = text_box.wide / m_width_in_pixels;
out_by_in_cols = -chars_to_skip;
a.screenline_to_textpane.cursor_offscreen # Notify textpane.pkg.
{
out_by_in_cols,
panewidth_in_cols,
screencol0
};
elif (text_indent > text_box.wide) #
# # Start of text is out of view to right of textpane.
panewidth_in_cols = text_box.wide / m_width_in_pixels;
out_by_in_cols = (text_indent - text_box.wide) / m_width_in_pixels;
a.screenline_to_textpane.cursor_offscreen # Notify textpane.pkg.
{
out_by_in_cols,
panewidth_in_cols,
screencol0
};
fi;
_ => ();
esac;
if (charlen <= chars_to_skip) # The string 'text' is entirely out of view to left of visible textpane, so ...
#
(displaylist_so_far, chars_to_skip - charlen, text_indent); # ... nothing to do.
else
my (text, charlen)
=
if (chars_to_skip == 0)
#
(text, charlen);
else # Drop 'chars_to_skip' chars from start of 'text'.
bytes_to_skip = string::prefix_length_in_bytes (text, chars_to_skip); #
# # NB: Tabs and control chars are not an issue here because they've already been expanded into regular ascii (tabs into blank sequences, control chars into "^A" style sequences.
text' = string::extract (text, bytes_to_skip, NULL); #
charlen' = string::length_in_chars text';
#
(text', charlen'); # NB: 'text' is guaranteed to be nonempty because we know chars_to_skip < charlen.
fi;
my (boxcursor, text_color, body_color)
=
case color_as
#
CURSOR_TEXT => (FALSE, body_color, text_color);
NORMAL_TEXT => (FALSE, text_color, body_color);
REGION_TEXT => (FALSE, text_color, region_color (body_color, text_color));
CURION_TEXT => (TRUE, text_color, region_color (body_color, text_color));
esac;
text_dimensions = get_text_dimensions text;
fontnames = get_fontnames ();
box_corners = g2d::box::box_corners text_box;
#
(g2d::point::mean [ box_corners.upper_left, box_corners.lower_left ])
->
{ row, col };
# Indent text a bit and also also center
# it properly vertically -- most fonts
# have ascent > descent:
#
row = row - text_dimensions.font_descent + ((text_dimensions.font_ascent + text_dimensions.font_descent) / 2);
col = col + text_indent; # In general we're starting somewhere within the line, after other stuff has been rendered.
draw_point = { row, col };
#
textbox = { row => box_corners.upper_left.row, # Area behind text.
col => col,
high => box_corners.lower_left.row - box_corners.upper_left.row,
# wide => text_dimensions.length_in_pixels # Currently length_in_pixels seems broken for multibyte utf8 chars, so ...
wide => charlen * m_width_in_pixels # ... I'm doing this instead, which works fine for the fixed-width fonts we (currently) use for programming.
};
displaylist = [ gd::COLOR
( body_color,
[ gd::FILLED_BOXES [ textbox ] ]
), # Clear area behind text to correct color (which varies depending on color_as).
#
gd::COLOR
( text_color,
[ gd::FONT ( fontnames, # Draw relevant text atop it.
[ gd::PUT_TEXT ( gd::TO_RIGHT_OF_POINT,
[ gd::TEXT (draw_point, text) ]
)
]
)
]
)
];
displaylist = if (not boxcursor)
#
displaylist;
else
cursorbox = { row => textbox.row,
col => textbox.col,
high => textbox.high - 1, # Need these '-1's because otherwise right and bottom of cursorbox get overwritten by subsequent stuff. This must represent an off-by-one error in the way we compute textboxes. XXX SUCKO FIXME.
wide => textbox.wide - 1
};
displaylist
@
[ gd::COLOR # Draw hollow box representing cursor.
( text_color,
[ gd::BOXES [ cursorbox ] ]
) #
];
fi;
displaylist_so_far
=
displaylist_so_far @ displaylist;
( displaylist_so_far,
0, # chars_to_skip
text_indent + (charlen * m_width_in_pixels) # As above, avoiding text_dimensions.length_in_pixels which seems broken for multibyte utf8 chars.
);
fi;
fi;
displaylist = [ gd::COLOR (body_color, [ gd::FILLED_BOXES [ background_box ] ] ) ]; # Interior of widget.
text_box = background_box;
text_indent = 3; # For readability, insert some space between frame and start of text. (In pixels.)
fun expand_tabs_and_control_chars { utf8text: String, col: Int }
=
{ (string::expand_tabs_and_control_chars
{
utf8text,
startcol => col,
screencol1 => -1, # Don't-care.
screencol2 => -1, # Don't-care.
utf8byte => -1 # Don't-care.
})
->
{ screentext => text,
startcol => col,
...
};
{ text, col };
};
displaylist
= # XXX SUCKO FIXME It would be nice to find a better factorization of the below code so that we don't have such a maze of nested cases. (Preferably without changing performance from O(N) -> O(N**2)!)
case state.selected # state.selected tells us the screen columns occupied on this line by the selected 'region' is (which includes the cursor if it is on current line), which should be shown in reverse video.
#
THE (col1, NULL) # We're given start screen column of region, which runs to end of line.
=>
{
(string::expand_tabs_and_control_chars
{
utf8text => state.text,
startcol => 0,
screencol1 => col1,
screencol2 => -1, # Don't-care.
utf8byte => -1 # Don't-care.
})
->
{ screentext,
startcol => col,
#
screencol1_byteoffset_in_screentext,
screencol1_bytescount_in_screentext,
...
};
screencols = string::length_in_chars screentext;
# NB: 'region' is just the cursor, if mark isn't set.
(string::expand_tabs_and_control_chars
{
utf8text => state.text,
startcol => 0,
screencol1 => col1,
screencol2 => screencols - 1,
utf8byte => -1 # Don't-care.
})
->
{ screentext,
startcol => col,
#
screencol1_byteoffset_in_screentext,
screencol1_bytescount_in_screentext,
#
screencol2_byteoffset_in_screentext,
screencol2_bytescount_in_screentext,
...
};
my { text_before_region, # Our game here is to show the char that the cursor is on in reverse video.
text_within_cursr1,
text_within_region, # This is complicated by three details:
text_within_cursr2,
text_beyond_region # 1. UTF-8 chars occupy one screen column but 1-6 bytes in string.
} # 2. Control chars occupy one byte in input string but two screen columns ("^A" etc) and two bytes in output string.
= # 3. Tabs occupy one byte in input string but 1-8 screen columns (as blanks) and 1-8 bytes in output string.
{
if (col1 >= screencols) # In the latter two cases this means we are showing more than one visible char in reverse video, even though it represents a single byte in input string.
#
msg = sprintf "default_redraw_fn/CCC0: col1(%d) >= screencols(%d)!!" col1 screencols;
log::fatal msg;
raise exception DIE msg;
fi;
case state.cursor_at
#
p2l::NO_CURSOR
=>
{ text_before_region => string::substring (screentext, 0, screencol1_byteoffset_in_screentext),
text_within_cursr1 => "",
text_within_region => string::extract (screentext, screencol1_byteoffset_in_screentext, NULL) except INDEX_OUT_OF_BOUNDS = "",
text_within_cursr2 => "",
text_beyond_region => "" #
};
p2l::CURSOR_AT_START
=>
{ text_before_region => string::substring (screentext, 0, screencol1_byteoffset_in_screentext),
text_within_cursr1 => string::substring (screentext, screencol1_byteoffset_in_screentext, screencol1_bytescount_in_screentext) except INDEX_OUT_OF_BOUNDS = "",
text_within_region => string::extract (screentext, screencol1_byteoffset_in_screentext+screencol1_bytescount_in_screentext, NULL) except INDEX_OUT_OF_BOUNDS = "",
text_within_cursr2 => "",
text_beyond_region => "" #
};
p2l::CURSOR_AT_END # We treat this identically to above.
=>
{ text_before_region => string::substring (screentext, 0, screencol1_byteoffset_in_screentext),
text_within_cursr1 => "",
text_within_region => string::substring (screentext, screencol1_byteoffset_in_screentext, screencol2_byteoffset_in_screentext-screencol1_byteoffset_in_screentext) except INDEX_OUT_OF_BOUNDS = "",
text_within_cursr2 => string::substring (screentext, screencol2_byteoffset_in_screentext, screencol2_bytescount_in_screentext) except INDEX_OUT_OF_BOUNDS = "",
text_beyond_region => "" #
};
esac;
};
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, screencol0, text_indent, state.prompt, text_box, NORMAL_TEXT); # Eventually we'll probably want to run state.prompt through string::expand_tabs_and_control_chars... XXX SUCKO FIXME
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_before_region, text_box, NORMAL_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_within_cursr1, text_box, CURION_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_within_region, text_box, REGION_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_within_cursr2, text_box, CURSOR_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_beyond_region, text_box, NORMAL_TEXT);
displaylist;
};
THE (col1, THE col2) # We are given both start and end screeen columns for the region.
=>
{
(string::expand_tabs_and_control_chars
{
utf8text => state.text,
startcol => 0,
screencol1 => col1,
screencol2 => col2,
utf8byte => -1 # Don't-care.
})
->
{ screentext,
startcol => col,
#
screencol1_byteoffset_in_screentext,
screencol1_bytescount_in_screentext,
#
screencol2_byteoffset_in_screentext,
screencol2_bytescount_in_screentext,
...
};
screencols = string::length_in_chars screentext;
# NB: 'region' is just the cursor, if mark isn't set.
my { text_before_region, # Our game here is to show the region in reverse video.
text_within_cursr1,
text_within_region, # This is complicated by three details:
text_within_cursr2,
text_beyond_region # 1. UTF-8 chars occupy one screen column but 1-6 bytes in string.
} # 2. Control chars occupy one byte in input string but two screen columns ("^A" etc) and two bytes in output string.
= # 3. Tabs occupy one byte in input string but 1-8 screen columns (as blanks) and 1-8 bytes in output string.
{
if (col1 >= screencols) # In the latter two cases this means we are showing more than one visible char in reverse video, even though it represents a single byte in input string.
#
msg = sprintf "default_redraw_fn/ccc: col1(%d) >= screencols(%d)!!" col1 screencols;
log::fatal msg;
raise exception DIE msg;
fi;
if (col2 >= screencols) # Region starts within input string but extends beyond actual end of line in input string.
#
msg = sprintf "default_redraw_fn/ddd: col2(%d) >= screencols(%d)!!" col1 screencols;
log::fatal msg;
raise exception DIE msg;
fi;
case state.cursor_at
#
p2l::NO_CURSOR
=>
{ text_before_region => string::substring (screentext, 0, screencol1_byteoffset_in_screentext),
text_within_cursr1 => "",
text_within_region => string::substring (screentext, screencol1_byteoffset_in_screentext, (screencol2_byteoffset_in_screentext + screencol2_bytescount_in_screentext) - screencol1_byteoffset_in_screentext),
text_within_cursr2 => "",
text_beyond_region => string::extract (screentext, screencol2_byteoffset_in_screentext + screencol2_bytescount_in_screentext, NULL ) except INDEX_OUT_OF_BOUNDS = ""
};
p2l::CURSOR_AT_START
=>
{ text_before_region => string::substring (screentext, 0, screencol1_byteoffset_in_screentext),
text_within_cursr1 => string::substring (screentext, screencol1_byteoffset_in_screentext, screencol1_bytescount_in_screentext),
text_within_region => string::substring (screentext, screencol1_byteoffset_in_screentext + screencol1_bytescount_in_screentext, (screencol2_byteoffset_in_screentext + screencol2_bytescount_in_screentext) - (screencol1_byteoffset_in_screentext + screencol1_bytescount_in_screentext)),
text_within_cursr2 => "",
text_beyond_region => string::extract (screentext, screencol2_byteoffset_in_screentext + screencol2_bytescount_in_screentext, NULL ) except INDEX_OUT_OF_BOUNDS = ""
};
p2l::CURSOR_AT_END #
=>
{ text_before_region => string::substring (screentext, 0, screencol1_byteoffset_in_screentext),
text_within_cursr1 => "",
text_within_region => string::substring (screentext, screencol1_byteoffset_in_screentext, screencol2_byteoffset_in_screentext - screencol1_byteoffset_in_screentext),
text_within_cursr2 => string::substring (screentext, screencol2_byteoffset_in_screentext, screencol2_bytescount_in_screentext),
text_beyond_region => string::extract (screentext, screencol2_byteoffset_in_screentext + screencol2_bytescount_in_screentext, NULL ) except INDEX_OUT_OF_BOUNDS = ""
};
esac;
};
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, screencol0, text_indent, state.prompt, text_box, NORMAL_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_before_region, text_box, NORMAL_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_within_cursr1, text_box, CURION_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_within_region, text_box, REGION_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_within_cursr2, text_box, CURSOR_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, text_beyond_region, text_box, NORMAL_TEXT);
displaylist;
};
NULL => # Region does not show on line.
{
(string::expand_tabs_and_control_chars
{
utf8text => state.text,
startcol => 0,
screencol1 => -1, # Don't-care.
screencol2 => -1, # Don't-care.
utf8byte => -1 # Don't-care.
})
->
{ screentext,
startcol => col,
...
};
screencols = string::length_in_chars screentext;
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, screencol0, text_indent, state.prompt, text_box, NORMAL_TEXT);
my (displaylist, chars_to_skip, text_indent) = append_text_to_displaylist (displaylist, chars_to_skip, text_indent, screentext, text_box, NORMAL_TEXT);
displaylist;
};
esac;
displaylist = [ gd::CLIP_TO (text_box, displaylist) ];
fun point_in_gadget (point: g2d::Point)
=
g2d::point::in_box (point, text_box);
point_in_gadget = THE point_in_gadget;
{ displaylist,
point_in_gadget,
pixels_high_min => 0,
pixels_wide_min => 0
};
};
fun default_mouse_transit_fn (MOUSE_TRANSIT_FN_ARG a)
=
case a.transit
#
gt::CAME => a.needs_redraw_gadget_request (); # So screenline will lighten when mouse enters it.
gt::LEFT => a.needs_redraw_gadget_request (); # So screenline will revert when mosue leaves it.
_ => ();
esac;
fun default_mouse_click_fn (MOUSE_CLICK_FN_ARG a)
=
{ screenline_to_textpane = a.screenline_to_textpane;
#
mouse_click_arg # Construct a generic tpt::Mouse_Click_Fn arg from our screenline-specialized one.
=
{
id => a.id,
doc => a.doc,
event => a.event,
button => a.button,
point => a.point,
widget_layout_hint => a.widget_layout_hint,
frame_indent_hint => a.frame_indent_hint,
site => a.site,
modifier_keys_state => a.modifier_keys_state,
mousebuttons_state => a.mousebuttons_state,
widget_to_guiboss => a.widget_to_guiboss,
theme => a.theme
}: tpt::Mouse_Click_Fn_Arg;
screenline_to_textpane.mouse_click_fn mouse_click_arg;
};
fun with # PUBLIC. The point of the 'with' name is that GUI coders can write 'screenline::with { this => that, foo => bar, ... }.'
{ paneline: Int,
textpane_id: Id, # The textpane to which we belong. Caller provides this so we can register outself with it via millboss_imp.
options: List(Option)
}
=
{
#######################################
# Top of per-imp state variable section
#
screenline_to_textpane__global = REF (NULL: Null_Or(l2p::Screenline_To_Textpane));
widget_to_guiboss__global = REF (NULL: Null_Or( { widget_to_guiboss: gt::Widget_To_Guiboss, screenline_id: Id }));
stateref = REF { selected => NULL, # Part of line to show with (typically) greenish background -- selected region. (Part may be overwritten by the cursor.)
cursor_at => p2l::NO_CURSOR, # Does cursor appear at start or end of 'selected' part -- or neither?
text => "",
prompt => "",
screencol0 => 0,
background => rgb::white
};
bogus_site
=
{ col => -1, wide => -1,
row => -1, high => -1
}: g2d::Box;
last_known_site
=
REF bogus_site;
button_active
=
REF TRUE;
#
#######################################
#
(process_options
(
options,
#
{ body_color => NULL,
body_color_with_mousefocus => NULL,
body_color_when_on => NULL,
body_color_when_on_with_mousefocus => NULL,
#
screenline_id => NULL,
widget_doc => "<screenline>",
#
state => *stateref,
#
fonts => [],
font_weight => (THE wt::BOLD_FONT: Null_Or(wt::Font_Weight)),
font_size => (NULL: Null_Or(Int)),
#
redraw_fn => default_redraw_fn,
mouse_click_fn => default_mouse_click_fn,
mouse_drag_fn => NULL,
mouse_transit_fn => default_mouse_transit_fn,
#
initially_active => *button_active,
#
pixels_high_min => 0, # Setting this to 16 resulted in an infinite loop of vertical site expansion in textpane.pkg. So currently we leave the driving to textpane.pkg.
pixels_high_cut => 1.0, # So main screenlines will evenly divide up all space left after modeline has taken its fixed allotment.
widget_options => [],
#
# portwatchers => [],
statewatchers => [],
sitewatchers => []
}
) )
->
{ # These values are globally visible to the subsequenc fns, which can lock them in as needed.
body_color,
body_color_with_mousefocus,
body_color_when_on,
body_color_when_on_with_mousefocus,
#
screenline_id,
widget_doc,
#
state,
#
fonts,
font_weight,
font_size,
#
redraw_fn,
mouse_click_fn,
mouse_drag_fn,
mouse_transit_fn,
#
initially_active,
#
pixels_high_min,
pixels_high_cut,
widget_options,
#
# portwatchers,
statewatchers,
sitewatchers
};
stateref := state;
button_active := initially_active;
fun note_changed_gadget_activity (is_active: Bool)
=
case (*widget_to_guiboss__global)
#
THE { widget_to_guiboss, screenline_id } => widget_to_guiboss.g.note_changed_gadget_activity { id => screenline_id, is_active };
NULL => ();
esac;
fun needs_redraw_gadget_request ()
=
case (*widget_to_guiboss__global)
#
THE { widget_to_guiboss, screenline_id } => widget_to_guiboss.g.needs_redraw_gadget_request(screenline_id);
NULL => ();
esac;
fun note_site
(arg as
{ screenline_id: Id,
site: g2d::Box
}
)
=
if(*last_known_site != site)
last_known_site := site;
#
apply tell_watcher sitewatchers
where
fun tell_watcher sitewatcher
=
sitewatcher (THE (screenline_id,site));
end;
fi;
fun notify_statewatchers ()
=
apply tell_watcher statewatchers
where
fun tell_watcher statewatcher
=
statewatcher *stateref;
end;
fun note_state (state: p2l::Linestate)
=
if(*stateref != state)
#
# Blinking the cursor seemed like a great idea, but in practice
# it means no feedback on cursor position half the time, which
# slows down fast typing, so I've commented it out. (Note that
# emacs doesn't blink its cursor either.)
#
# fun flip_blink (wa: gt::Wakeup_Arg)
# =
# { cursoronref := not *cursoronref;
# #
# needs_redraw_gadget_request ();
# };
#
# case (*widget_to_guiboss__global) # Turn cursorblink-driving wakeme call on or off as necessary.
# #
# (THE { widget_to_guiboss, screenline_id })
# =>
# case ((*stateref).cursor, state.cursor)
# #
# (THE _, THE _) => (); # Cursorblink was on, still on, nothing to do here.
# (NULL , NULL ) => (); # Cursorblink was off, still off, nothing to do here.
#
# (THE _, NULL ) # Cursorblink was on, need to turn it off.
# =>
# widget_to_guiboss.g.wake_me
# {
# id => screenline_id,
# options => [ gt::EVERY_N_FRAMES (NULL ) ]
# };
#
# (NULL, THE _) # Cursorblink was off, need to turn it on.
# =>
# widget_to_guiboss.g.wake_me
# {
# id => screenline_id,
# options => [ gt::EVERY_N_FRAMES (THE (40, flip_blink)) ]
# };
# esac;
#
# _ => (); # We don't expect this to happen. Should probably log an error or warning if it does...
# esac;
stateref := state;
needs_redraw_gadget_request ();
notify_statewatchers ();
fi;
#
# End of state variable section
###############################
###############################
# Top of widget hook fn section
#
# These fns get called by widget_imp logic, ultimately # widget_imp is from src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg # in response to user mouseclicks and keypresses etc:
fun startup_fn
{
id: Id, # Unique Id for widget.
doc: String, # Human-readable description of this widget, for debug and inspection.
widget_to_guiboss: gt::Widget_To_Guiboss,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue
}
=
{
#####################
# Top of port section
#
# Here we implement our Textpane_To_Lineditor port:
fun set_active_to (is_active: Bool) # PUBLIC.
=
do {. # The 'do' switches us from executing in microthread of caller to our own microthread.
button_active := is_active;
#
note_changed_gadget_activity is_active;
};
fun set_state_to (state: p2l::Linestate) # PUBLIC.
=
do {. # The 'do' switches us from executing in microthread of caller to our own microthread.
note_state state;
};
fun get_active () # PUBLIC.
=
*button_active; # We don't really need the 'do' dance here, since this call is read-only functionality. (Avoiding needless 'do's also reduces deadlock risks.)
fun get_state () # PUBLIC.
=
*stateref; # We don't really need the 'do' dance here, since this call is read-only functionality. (Avoiding needless 'do's also reduces deadlock risks.)
#
# End of port section
#####################
widget_to_guiboss__global
:=
THE { widget_to_guiboss, screenline_id => id };
(mt::get__mill_to_millboss "screenline::startup_fn") # Find our port to src/lib/x-kit/widget/edit/millboss-imp.pkg ->
mt::MILL_TO_MILLBOSS mb;
# nb {. sprintf "startup_fn: screenline id=%d (%s) registering with textpane id=%d --screenline.pkg" (id_to_int id) doc (id_to_int textpane_id); };
mb.mail_pane (textpane_id, crypt) # Register ourself with our textpane.pkg instance.
where
fun note__screenline_to_textpane
(
screenline_to_textpane: l2p::Screenline_To_Textpane
)
=
do {. # The 'do' switches us from executing in microthread of caller to our own microthread.
screenline_to_textpane__global := THE screenline_to_textpane; # Note port to our textpane.pkg instance.
};
textpane_to_screenline
=
{ screenline_id => id,
paneline,
textpane_id,
#
get_active,
get_state,
#
set_active_to,
set_state_to,
#
note__screenline_to_textpane
}: p2l::Textpane_To_Screenline;
crypt = { id => issue_unique_id (),
type => "millboss_types::TEXTPANE_TO_SCREENLINE__CRYPT",
info => "Initialization from screenline.pkg for textpane.pkg.",
data => mt::TEXTPANE_TO_SCREENLINE__CRYPT textpane_to_screenline
};
end;
# apply tell_watcher portwatchers # We do this here rather than (say) above this fn because we don't want the port in circulation until we're running.
# where
# fun tell_watcher portwatcher
# =
# portwatcher (THE app_to_button);
# end;
();
};
fun shutdown_fn () # Return to widget_imp an exception packaging up our state; this will be returned to guiboss_imp, saved in the
= # Paused_Gui tree, and passed to our startup_fn when/if gui is restarted. This exception will never be raised;
{ apply tell_watcher sitewatchers
where
fun tell_watcher sitewatcher
=
sitewatcher NULL;
end;
# apply tell_watcher portwatchers #
# where
# fun tell_watcher portwatcher
# =
# portwatcher NULL;
# end;
};
fun initialize_gadget_fn
{
id: Id, # Unique Id for widget.
doc: String, # Human-readable description of this widget, for debug and inspection.
site: g2d::Box, # Window rectangle in which to draw.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
pass_font: List(String) -> Replyqueue
-> (evt::Font -> Void) -> Void, # Nonblocking version of next, for use in imps.
get_font: List(String) -> evt::Font, # Accepts a list of font names which are tried in order.
make_rw_pixmap: g2d::Size -> g2p::Gadget_To_Rw_Pixmap,
#
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue # Used to call 'pass_*' methods in other imps.
}
=
{ note_site { screenline_id => id, site };
#
();
};
fun redraw_request_fn_wrapper
{
id: Id, # Unique Id for widget.
doc: String, # Human-readable description of this widget, for debug and inspection.
frame_number: Int, # 1,2,3,... Purely for convenience of widget-imp, guiboss-imp makes no use of this.
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Window rectangle in which to draw.
popup_nesting_depth: Int, # 0 for gadgets on basewindow, 1 for gadgets on popup on basewindow, 2 for gadgets on popup on popup, etc.
#
duration_in_seconds: Float, # If state has changed widget-imp should call redraw_gadget() before this time is up. Also useful for motionblur.
widget_to_guiboss: gt::Widget_To_Guiboss,
gadget_mode: gt::Gadget_Mode,
#
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void,
to: Replyqueue # Used to call 'pass_*' methods in other imps.
}
=
{ note_site { screenline_id => id, site };
#
case (*screenline_to_textpane__global)
#
THE screenline_to_textpane
=>
{
palette = *theme.current_gadget_colors { gadget_is_on => FALSE, # We're not a button, we don't have ON/OFF state. (But maybe click-to-focus should work like ON, if/when we implement it?)
gadget_mode,
popup_nesting_depth,
#
body_color,
body_color_when_on,
body_color_with_mousefocus,
body_color_when_on_with_mousefocus
};
redraw_fn_arg
=
REDRAW_FN_ARG
{ id,
doc,
frame_number,
frame_indent_hint,
site,
popup_nesting_depth,
duration_in_seconds,
widget_to_guiboss,
screenline_to_textpane,
gadget_mode,
theme,
do,
to,
palette,
#
default_redraw_fn,
#
state => *stateref,
fonts,
font_weight,
font_size
};
(redraw_fn redraw_fn_arg)
->
{ displaylist,
point_in_gadget,
pixels_high_min,
pixels_wide_min
};
widget_to_guiboss.g.redraw_gadget { id, site, displaylist, point_in_gadget };
};
NULL => (); # We don't expect this -- we should be fully wired well before any redraw requests have time to arrive. Possibly we should log a warning or even fatal error.
esac;
};
fun mouse_drag_fn_wrapper # This a callback we hand to src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg (
{ id: Id, # Unique Id for widget.
doc: String, # Human-readable description of this widget, for debug and inspection.
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue # Used to call 'pass_*' methods in other imps.
}
)
=
{ note_site { screenline_id => id, site };
#
mouse_drag_fn_arg
=
MOUSE_DRAG_FN_ARG
{
id,
doc,
event_point,
start_point,
last_point,
widget_layout_hint,
frame_indent_hint,
site,
phase,
button,
modifier_keys_state,
mousebuttons_state,
widget_to_guiboss,
theme,
do,
to,
#
default_mouse_drag_fn => \\ _ = (), # Default drag behavior for buttons is to do absolutely nothing.
#
state => stateref, # We don't pass the refcell here because we want client code to make state changes via note_state(), which will properly notify all state-watchers.
#
notify_statewatchers,
needs_redraw_gadget_request
};
case mouse_drag_fn
#
THE mouse_drag_fn => mouse_drag_fn mouse_drag_fn_arg;
NULL => (); # We do not expect this case to happen: If mouse_drag_fn is NULL mouse_drag_fn_wrapper should not have been registered with widget-imp so we should never get called.
esac;
};
fun mouse_transit_fn_wrapper
#
( arg as
{
id: Id, # Unique Id for widget.
doc: String, # Human-readable description of this widget, for debug and inspection.
event_point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
transit: gt::Gadget_Transit, # Mouse is entering (CAME) or leaving (LEFT) widget, or moving (MOVE) across it.
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue # Used to call 'pass_*' methods in other imps.
}
)
=
{ note_site { screenline_id => id, site };
#
mouse_transit_fn_arg
=
MOUSE_TRANSIT_FN_ARG
{
id,
doc,
event_point,
widget_layout_hint,
frame_indent_hint,
site,
transit,
modifier_keys_state,
widget_to_guiboss,
theme,
do,
to,
#
default_mouse_transit_fn, #
#
state => stateref, # We don't pass the refcell here because we want client code to make state changes via note_state(), which will properly notify all state-watchers.
#
notify_statewatchers,
needs_redraw_gadget_request
};
mouse_transit_fn mouse_transit_fn_arg;
();
};
fun mouse_click_fn_wrapper # This a callback we hand to src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg {
id: Id, # Unique Id for widget.
doc: String, # Human-readable description of this widget, for debug and inspection.
event: gt::Mousebutton_Event, # MOUSEBUTTON_PRESS or MOUSEBUTTON_RELEASE.
button: evt::Mousebutton,
point: g2d::Point,
widget_layout_hint: gt::Widget_Layout_Hint,
frame_indent_hint: gt::Frame_Indent_Hint,
site: g2d::Box, # Widget's assigned area in window coordinates.
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
widget_to_guiboss: gt::Widget_To_Guiboss,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void, # Used by widget subthreads to execute code in main widget microthread.
to: Replyqueue # Used to call 'pass_*' methods in other imps.
}
=
{ note_site { screenline_id => id, site };
#
case (*screenline_to_textpane__global)
#
THE screenline_to_textpane
=>
{
mouse_click_fn_arg
=
MOUSE_CLICK_FN_ARG
{
id,
doc,
event,
button,
point,
widget_layout_hint,
frame_indent_hint,
site,
modifier_keys_state,
mousebuttons_state,
widget_to_guiboss,
theme,
do,
to,
#
default_mouse_click_fn,
#
state => stateref, # We don't pass the refcell here because we want client code to make state changes via note_state(), which will properly notify all state-watchers.
#
notify_statewatchers,
needs_redraw_gadget_request,
screenline_to_textpane
};
mouse_click_fn mouse_click_fn_arg;
};
NULL => (); # We don't expect this -- we should be fully wired well before any keystrokes have time to arrive. Possibly we should log a warning or even fatal error.
esac;
};
#
# End of widget hook fn section
###############################
widget_options
=
case mouse_drag_fn
#
THE _ => (wi::MOUSE_DRAG_FN mouse_drag_fn_wrapper) ! widget_options; # Register for drag events only if we are going to use them.
NULL => widget_options;
esac;
widget_options
=
case screenline_id
#
THE id => (wi::ID id) ! widget_options; #
NULL => widget_options;
esac;
widget_options
=
[ wi::STARTUP_FN startup_fn, # We always register for these five because our base behavior depends on them.
wi::SHUTDOWN_FN shutdown_fn,
wi::INITIALIZE_GADGET_FN initialize_gadget_fn,
wi::REDRAW_REQUEST_FN redraw_request_fn_wrapper,
wi::MOUSE_CLICK_FN mouse_click_fn_wrapper,
wi::MOUSE_TRANSIT_FN mouse_transit_fn_wrapper,
wi::PIXELS_HIGH_MIN pixels_high_min,
wi::PIXELS_HIGH_CUT pixels_high_cut,
wi::DOC widget_doc
]
@
widget_options
;
make_widget_fn = wi::make_widget_start_fn widget_options;
gt::WIDGET make_widget_fn; # So caller can write guiplan = gt::ROW [ button::with [...], button::with [...], ... ];
}; # PUBLIC
};
end;