From 298ea392f74311e42045202c3a8f2e67c45985aa Mon Sep 17 00:00:00 2001
From: Slava Pestov <slava@slava-pestovs-macbook-pro.local>
Date: Mon, 16 Feb 2009 01:03:50 -0600
Subject: [PATCH] ui.gadgets.editors: Add page up/down

---
 basis/ui/gadgets/editors/editors-tests.factor | 12 ++++++++--
 basis/ui/gadgets/editors/editors.factor       | 24 +++++++++++++++----
 .../gadgets/line-support/line-support.factor  |  7 ++++--
 3 files changed, 35 insertions(+), 8 deletions(-)

diff --git a/basis/ui/gadgets/editors/editors-tests.factor b/basis/ui/gadgets/editors/editors-tests.factor
index ec2f39f009..f8dc5b91c9 100644
--- a/basis/ui/gadgets/editors/editors-tests.factor
+++ b/basis/ui/gadgets/editors/editors-tests.factor
@@ -1,7 +1,8 @@
 USING: accessors ui.gadgets.editors tools.test kernel io
 io.streams.plain definitions namespaces ui.gadgets
 ui.gadgets.grids prettyprint documents ui.gestures tools.test.ui
-models documents.elements ui.gadgets.scrollers sequences ;
+models documents.elements ui.gadgets.scrollers ui.gadgets.line-support
+sequences ;
 IN: ui.gadgets.editors.tests
 
 [ "foo bar" ] [
@@ -57,4 +58,11 @@ IN: ui.gadgets.editors.tests
 [ ] [ <editor> "A" over set-editor-string com-join-lines ] unit-test
 [ "A B" ] [ <editor> "A\nB" over set-editor-string [ com-join-lines ] [ editor-string ] bi ] unit-test
 
-[ 2 ] [ <editor> 20 >>min-rows 20 >>min-cols pref-viewport-dim length ] unit-test
\ No newline at end of file
+[ 2 ] [ <editor> 20 >>min-rows 20 >>min-cols pref-viewport-dim length ] unit-test
+
+[ 20 ] [
+    <editor> 20 >>min-rows 20 >>min-cols
+    dup pref-viewport-dim >>dim
+    visible-lines
+] unit-test
+
diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 7724e262ae..d7aa6056f8 100755
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -480,11 +480,23 @@ TUPLE: multiline-editor < editor ;
 
 : next-line ( editor -- ) line-elt editor-next ;
 
-: select-previous-line ( editor -- ) 
-    line-elt editor-select-prev ;
+<PRIVATE
 
-: select-next-line ( editor -- ) 
-    line-elt editor-select-next ;
+: page-elt ( editor -- editor element ) dup visible-lines <page-elt> ;
+
+PRIVATE>
+
+: previous-page ( editor -- ) page-elt editor-prev ;
+
+: next-page ( editor -- ) page-elt editor-next ;
+
+: select-previous-line ( editor -- ) line-elt editor-select-prev ;
+
+: select-next-line ( editor -- ) line-elt editor-select-next ;
+
+: select-previous-page ( editor -- ) page-elt editor-select-prev ;
+
+: select-next-page ( editor -- ) page-elt editor-select-next ;
 
 : insert-newline ( editor -- )
     "\n" swap user-input* drop ;
@@ -522,6 +534,10 @@ multiline-editor "multiline" f {
     { T{ key-down f f "DOWN" } next-line }
     { T{ key-down f { S+ } "UP" } select-previous-line }
     { T{ key-down f { S+ } "DOWN" } select-next-line }
+    { T{ key-down f f "PAGE_UP" } previous-page }
+    { T{ key-down f f "PAGE_DOWN" } next-page }
+    { T{ key-down f { S+ } "PAGE_UP" } select-previous-page }
+    { T{ key-down f { S+ } "PAGE_DOWN" } select-next-page }
     { T{ key-down f f "RET" } insert-newline }
     { T{ key-down f { S+ } "RET" } insert-newline }
     { T{ key-down f f "ENTER" } insert-newline }
diff --git a/basis/ui/gadgets/line-support/line-support.factor b/basis/ui/gadgets/line-support/line-support.factor
index b5f969da11..ab44d45839 100644
--- a/basis/ui/gadgets/line-support/line-support.factor
+++ b/basis/ui/gadgets/line-support/line-support.factor
@@ -2,7 +2,7 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays combinators fry kernel math math.functions math.order
 math.ranges math.vectors namespaces opengl sequences ui.gadgets
-ui.render ui.text ui.gadgets.scrollers ;
+ui.render ui.text ui.gadgets.scrollers ui.gadgets.viewports ;
 IN: ui.gadgets.line-support
 
 ! Some code shared by table and editor gadgets
@@ -77,4 +77,7 @@ M: line-gadget pref-viewport-dim
     [ pref-dim ] keep
     [ line-gadget-width ]
     [ line-gadget-height ]
-    2bi 2array ;
\ No newline at end of file
+    2bi 2array ;
+
+: visible-lines ( gadget -- n )
+    [ visible-dim second ] [ line-height ] bi /i 1- ;
\ No newline at end of file