diff options
| -rw-r--r-- | ieditor.pl | 104 | ||||
| -rw-r--r-- | ieditor_gesture.pl | 134 | ||||
| -rw-r--r-- | save.pl | 5 |
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. +*/ @@ -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)), |