summaryrefslogtreecommitdiff
path: root/ieditor.pl
blob: 8c6d3abd12b02a0c10ae62977b8442f2e9d6c42e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
:- use_module(library(pce)).
:- consult(ieditor_gesture).

:- pce_begin_class(iview, view, "Improved view").

initialise(V, L:label=[name], S:size=[size], D:display=[display],
	   E:editor=[editor]) :->
	send_super(V, initialise, L, S, D, when(E == @default,
						new(ieditor),
						E)),
	send(V, wrap, word).

:- pce_end_class(iview).

:- pce_begin_class(ieditor, editor, "Improved editor").

initialise(E, T:text=[text_buffer], W:width=[int],
	   H:height=[int], M:margin=[int]) :->
	send_super(E, initialise, T, W, H, M),
	send(E, wrap, word),
	send(E, key_binding, '\\ed', message(E, kill_word)),
	send(E, key_binding, '\\e\\C-h', message(E, backward_kill_word)).

% Fix invisible terminals in some characters and fonts.

insert_self(E, Times:[int], Character:[char]) :->
	send_super(E, insert_self, Times, Character),
	send(E, redraw_line_before, E?caret).

redraw_line_before(E, Index:int) :->
	"Redraw entire line before character at index"::
	get(E?image, character_position, Index, Point),
	get(E?image, line, Index, Line),
	get(E?image, start, Line - 1, C0),
	get(E?image, character_position, C0, Point0),
	get(Point0, y, Y0),
	get(Point, y, Y),
	(   Y == Y0
	->  Height = Y
	;   Height is Y - Y0		% Calculate line height.
	),
	new(A, area(0, Y - Height, Point?x, Height)),
	send(E?image, redraw, A).

% Fix default (mis)behavior of keyboard-based selection.

cursor_left(E, Arg:[int]) :->
	get(E, selection_save_mark, M),
	send_super(E, cursor_left, Arg),
	send(E, mark, M).
cursor_right(E, Arg:[int]) :->
	get(E, selection_save_mark, M),
	send_super(E, cursor_right, Arg),
	send(E, mark, M).
cursor_home(E, Arg:[int]) :->
	get(E, selection_save_mark, M),
	send_super(E, cursor_home, Arg),
	send(E, mark, M).
cursor_end(E, Arg:[int]) :->
	get(E, selection_save_mark, M),
	send_super(E, cursor_end, Arg),
	send(E, mark, M).
cursor_page_up(E, Arg:[int]) :->
	get(E, selection_save_mark, M),
	send_super(E, cursor_page_up, Arg),
	send(E, mark, M).
cursor_page_down(E, Arg:[int]) :->
	get(E, selection_save_mark, M),
	send_super(E, cursor_page_down, Arg),
	send(E, mark, M).

selection_save_mark(E, M) :<-
	(   get(E, mark_status, active)
        ->  get(E, mark, M)			% Already selecting.
        ;   get(E, caret, C),
	    send(E, selection_origin, C),	% Start new selection.
	    M = C
	).

% Line up/down is handled specially, in order to attempt to move to the
% character closest to the character at the caret's original position.

cursor_up(E, Arg:[int]) :->
	"Handle cursor up-arrow"::
	send(E, cursor_updown, cursor_up, Arg).
cursor_down(E, Arg:[int]) :->
	"Handle cursor down-arrow"::
	send(E, cursor_updown, cursor_down, Arg).

cursor_updown(E, Msg, Arg:[int]) :->
	char_x(E, E?caret, X0),
	get(E, selection_save_mark, M),
	(   Msg == cursor_up -> send_super(E, cursor_up, Arg)
	;   Msg == cursor_down -> send_super(E, cursor_down, Arg)
	),
	send(E, mark, M),
	char_x(E, E?caret, X),
	char_x(E, E?caret - 1, X_prev),
	char_x(E, E?caret + 1, X_next),
	D is abs(X - X0),
	D_prev is abs(X_prev - X0),
	D_next is abs(X_next - X0),
	(   D_next < D_prev,
	    D_next < D
	->  send(E, forward_char)
	;   (   D_prev < D_next,
		D_prev < D
	    ->	send(E, backward_char)
	    ;	true
	    )
	).

char_x(E, Index, X) :-
	get(E?image, character_position, Index, Point),
	get(Point, x, X).

:- pce_end_class.