summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--ieditor.pl104
-rw-r--r--ieditor_gesture.pl134
-rw-r--r--save.pl5
3 files changed, 242 insertions, 1 deletions
diff --git a/ieditor.pl b/ieditor.pl
new file mode 100644
index 0000000..a1cd173
--- /dev/null
+++ b/ieditor.pl
@@ -0,0 +1,104 @@
+:- use_module(library(pce)).
+:- consult(ieditor_gesture).
+:- 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, 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"::
+ cursor_updown(E, cursor_up, Arg).
+cursor_down(E, Arg:[int]) :->
+ "Handle cursor down-arrow"::
+ cursor_updown(E, cursor_down, Arg).
+
+cursor_updown(E, Msg, Arg:[int]) :-
+ get(E, char_x, 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/save.pl b/save.pl
index 517193e..7eaec84 100644
--- a/save.pl
+++ b/save.pl
@@ -1,6 +1,8 @@
:- consult(pce_file_search_path).
:- consult(library(pce)).
:- consult(library(process)).
+:- consult(ieditor).
+:- ieditor_gesture_override.
:- op(920,fy, *).
*_.
@@ -16,7 +18,7 @@ unlink(D) :->
:- pce_global(@dialog, new(save_dialog('Save'))).
:- pce_global(@files, new(chain)).
:- pce_global(@commits, new(chain)).
-:- pce_global(@editor, new(editor)).
+:- pce_global(@editor, new(ieditor)).
:- pce_global(@file_browser, new(browser)).
:- pce_global(@commit_browser, new(browser)).
:- pce_global(@save_button,
@@ -59,6 +61,7 @@ added(_) :-
send(@dialog, open).
refresh :-
+ shell("git add ."),
send(@files, clear),
status(@files),
send(@file_browser, members(@files)),