From 8761885287b5502af6572d1faf01211bc1b54c02 Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@factorcode.org>
Date: Wed, 10 Oct 2007 01:53:41 -0400
Subject: [PATCH] Fix problem with out-of-bounds hand-click#
---
extra/ui/gadgets/editors/editors-tests.factor | 11 ++++++++++-
extra/ui/gadgets/editors/editors.factor | 12 ++++++------
2 files changed, 16 insertions(+), 7 deletions(-)
diff --git a/extra/ui/gadgets/editors/editors-tests.factor b/extra/ui/gadgets/editors/editors-tests.factor
index 7c60536605..daaeac6fad 100644
--- a/extra/ui/gadgets/editors/editors-tests.factor
+++ b/extra/ui/gadgets/editors/editors-tests.factor
@@ -1,6 +1,6 @@
USING: ui.gadgets.editors tools.test kernel io io.streams.plain
io.streams.string definitions namespaces ui.gadgets
-ui.gadgets.grids prettyprint documents ;
+ui.gadgets.grids prettyprint documents ui.gestures ;
[ t ] [
<editor> "editor" set
@@ -27,3 +27,12 @@ ui.gadgets.grids prettyprint documents ;
"editor" get gadget-selection
"editor" get ungraft*
] unit-test
+
+[ ] [
+ <editor> "editor" set
+ "editor" get graft*
+ "foo bar\nbaz quux" "editor" get set-editor-string
+ 4 hand-click# set
+ "editor" get position-caret
+ "editor" get ungraft*
+] unit-test
diff --git a/extra/ui/gadgets/editors/editors.factor b/extra/ui/gadgets/editors/editors.factor
index abf26f3f81..214572b0d8 100644
--- a/extra/ui/gadgets/editors/editors.factor
+++ b/extra/ui/gadgets/editors/editors.factor
@@ -5,7 +5,7 @@ ui.gadgets.borders ui.gadgets.buttons ui.gadgets.labels
ui.gadgets.scrollers ui.gadgets.theme ui.gadgets.controls
ui.render ui.gestures io kernel math models namespaces opengl
opengl.gl sequences strings io.styles math.vectors sorting
-colors ;
+colors combinators ;
IN: ui.gadgets.editors
TUPLE: editor
@@ -292,11 +292,11 @@ M: editor gadget-text* editor-string % ;
: position-caret ( editor -- )
hand-click# get {
- [ ]
- [ dup (position-caret) ]
- [ dup T{ one-word-elt } select-elt ]
- [ dup T{ one-line-elt } select-elt ]
- } ?nth call drop ;
+ { 1 [ (position-caret) ] }
+ { 2 [ T{ one-word-elt } select-elt ] }
+ { 3 [ T{ one-line-elt } select-elt ] }
+ [ 2drop ]
+ } case ;
: insert-newline "\n" swap user-input ;