A .gitignoreHEADmaster

A  ieditor.pl
A  ieditor_gesture.pl
A  test.pl

4 files changed, 263 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..c013716
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+*~
+*.lnk
\ No newline at end of file
diff --git a/ieditor.pl b/ieditor.pl
new file mode 100644
index 0000000..8c6d3ab
--- /dev/null
+++ b/ieditor.pl
@@ -0,0 +1,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.
diff --git a/ieditor_gesture.pl b/ieditor_gesture.pl
new file mode 100644
index 0000000..fe5d68c
--- /dev/null
+++ b/ieditor_gesture.pl
@@ -0,0 +1,134 @@
+/*
+ *  This file contains minor patches to the select_editor_text_gesture
+ *  class included with XPCE to bring the behavior closer to UI
+ *  standards.
+ *
+ */
+
+:- use_module(library(pce)).
+
+% Override the default @editor_recogniser. This affects the default
+% editor class too!
+
+ieditor_gesture_override :-
+	free(@editor_recogniser),
+	new(@editor_recogniser, handler_group(new(ieditor_gesture))).
+
+:- pce_begin_class(ieditor_gesture, select_editor_text_gesture).
+
+% Get the index of the clicked character -- but if the user clicked
+% close to the next character, get that character's index instead.
+%
+% (If the mouse is dragged above the editor, though, the pointer's x
+% position should not be accounted for whatsoever.)
+
+index(_, Ev, Index) :<-
+	"Calculate index of clicked character."::
+	get(Ev, receiver, Editor),
+	get(Editor, image, Image),
+	get(Image, index, Ev, Index0),
+	get(Ev, y, Y_ev),
+	(   Y_ev > 1,
+	    get(Image, character_position, Index0, Point1),
+	    get(Image, character_position, Index0 + 1, Point2),
+	    get(Ev, x, X_ev),
+	    get(Image, x, X_image),
+	    get(Point1, x, X1),
+	    get(Point2, x, X2),
+	    D1 is X_ev - X_image - X1,
+	    D2 is X2 - (X_ev - X_image),
+	    D1 > abs(D2),
+	    Index is Index0 + 1
+	;   Index = Index0
+	).
+
+initiate(G, Ev:event) :->
+	"Set caret and prepare for selectiong"::
+	send(G, slot, down_position, Ev?position),
+	get(Ev, receiver, Editor),
+	send(G, slot, editor, Editor),
+	get(G, index, Ev, Index),		% Use sane index.
+	send(Editor, caret, Index),
+	get(Ev, multiclick, Multi),
+	selection_unit(Multi, Unit),
+	send(G, slot, unit, Unit),
+	(   Multi == single
+	->  send(G, slot, origin, Index),
+	    send(G, selecting, @off)
+	;   send(G, selecting, @on)
+	).
+
+selection_unit(single, character).
+selection_unit(double, word).
+selection_unit(triple, line).
+
+drag(G, Ev:event) :->
+	"Extend the selection if selecting"::
+	get(Ev, receiver, Editor),
+	(   (   get(G, selecting, @on)
+	    ->  true
+	    ;   get(G, down_position, DownPos),
+		get(Ev, position, EvPos),
+		get(DownPos, distance, EvPos, D),
+		D > 5				% Default is 25.
+	    ->  send(G, selecting, @on)
+	    )
+	->  (   get(G, index, Ev, Index)	% Use sane index.
+	    ->  (   get(G, unit, character)	% Fix mark after char selection.
+		->  get(G, selection_save_mark, Editor, M),
+		    send(Editor, selection_extend, Index),
+		    send(Editor, mark, M)
+		;   send(Editor, selection_extend, Index)
+		)
+	    ;   true
+	    )
+	;   true
+	).
+
+selection_save_mark(G, Editor, M) :<-
+	(   (   get(Editor, mark_status, active)
+	    ;   get(G, selecting, @on)
+	    )
+	->  get(Editor, mark, M)		% Already selecting.
+	;   get(Editor, caret, C),
+	    send(Editor, selection_origin, C),	% Start new selection.
+	    M = C
+	).
+
+:- pce_end_class.
+
+/*  Based on code included with XPCE --- The SWI-Prolog GUI toolkit
+
+    Original file: xpce/prolog/boot/pce_editor.pl
+
+    Author:        Jan Wielemaker and Anjo Anjewierden
+    E-mail:        jan@swi.psy.uva.nl
+    WWW:           http://www.swi.psy.uva.nl/projects/xpce/
+    Copyright (c)  1985-2002, University of Amsterdam
+    All rights reserved.
+
+    Redistribution and use in source and binary forms, with or without
+    modification, are permitted provided that the following conditions
+    are met:
+
+    1. Redistributions of source code must retain the above copyright
+       notice, this list of conditions and the following disclaimer.
+
+    2. Redistributions in binary form must reproduce the above copyright
+       notice, this list of conditions and the following disclaimer in
+       the documentation and/or other materials provided with the
+       distribution.
+
+    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
+    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
+    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
+    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
+    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
+    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
+    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
+    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
+    POSSIBILITY OF SUCH DAMAGE.
+*/
diff --git a/test.pl b/test.pl
new file mode 100644
index 0000000..b95ba61
--- /dev/null
+++ b/test.pl
@@ -0,0 +1,10 @@
+:- use_module(library(pce)).
+:- consult(ieditor).
+:- consult(ieditor_gesture).
+:- ieditor_gesture_override.
+:- initialization(init).
+
+init :-
+	new(V, iview),
+	send(V, font, font('Times New Roman', roman, 14, '')),
+	send(V, open).