Delete empty unit tests files, remove 1- and 1+, reorder IN: lines in a lot of places...

[factor.git] / basis / ui / gadgets / editors / editors.factor

diff --git a/basis/ui/gadgets/editors/editors.factor b/basis/ui/gadgets/editors/editors.factor
index 1cb2e2a51de904379a85dd315ed1513720bbd452..b1b82a054235513845001cbdbad6801ec7a28e8a 100755 (executable)
--- a/basis/ui/gadgets/editors/editors.factor
+++ b/basis/ui/gadgets/editors/editors.factor
@@ -1,14 +1,15 @@
 ! Copyright (C) 2006, 2009 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
 USING: accessors arrays documents documents.elements kernel math
-math.ranges models models.filter namespaces locals fry make opengl
+math.ranges models models.arrow namespaces locals fry make opengl
 opengl.gl sequences strings math.vectors math.functions sorting colors
-colors.constants combinators assocs math.order fry calendar alarms
+colors.constants combinators assocs math.order calendar alarms
 continuations ui.clipboards ui.commands ui.gadgets ui.gadgets.borders
 ui.gadgets.buttons ui.gadgets.labels ui.gadgets.scrollers
 ui.gadgets.menus ui.gadgets.wrappers ui.render ui.pens.solid
 ui.gadgets.line-support ui.text ui.gestures ui.baseline-alignment
-math.rectangles splitting unicode.categories fonts grouping ;
+math.rectangles splitting unicode.categories grouping ;
+EXCLUDE: fonts => selection ;
 IN: ui.gadgets.editors
 
 TUPLE: editor < line-gadget
@@ -140,7 +141,7 @@ M: editor ungraft*
 : scroll>caret ( editor -- )
     dup graft-state>> second [
         [
-            [ caret-loc ] [ caret-dim { 1 0 } v+ ] bi <rect>
+            [ caret-loc ] [ caret-dim { 2 1 } v+ ] bi <rect>
         ] keep scroll>rect
     ] [ drop ] if ;
 
@@ -169,22 +170,25 @@ TUPLE: selected-line start end first? last? ;
         '[ [ _ _ ] keep _ start/end-on-line 2array ] H{ } map>assoc
     ] [ drop f ] if ;
 
-:: draw-empty-selection ( line pair editor -- )
-    editor font>> :> font
-    pair first font line offset>x 0 2array [
-        editor selection-color>> gl-color
-        1 font font-metrics height>> 2array gl-fill-rect
-    ] with-translation ;
+:: draw-selection ( line pair editor -- )
+    pair [ editor font>> line offset>x ] map :> pair
+    editor selection-color>> gl-color
+    pair first 0 2array
+    pair second pair first - round 1 max editor line-height 2array
+    gl-fill-rect ;
 
 : draw-unselected-line ( line editor -- )
     font>> swap draw-text ;
 
 : draw-selected-line ( line pair editor -- )
     over all-equal? [
-        [ nip draw-unselected-line ] [ draw-empty-selection ] 3bi
+        [ nip draw-unselected-line ] [ draw-selection ] 3bi
     ] [
-        [ [ first2 ] [ selection-color>> ] bi* <selection> ] keep
-        draw-unselected-line
+        [ draw-selection ]
+        [
+            [ [ first2 ] [ selection-color>> ] bi* <selection> ] keep
+            draw-unselected-line
+        ] 3bi
     ] if ;
 
 M: editor draw-line ( line index editor -- )
@@ -197,7 +201,8 @@ M: editor draw-gadget*
     ] with-variable ;
 
 M: editor pref-dim*
-    [ font>> ] [ control-value ] bi text-dim ;
+    ! Add some space for the caret.
+    [ font>> ] [ control-value ] bi text-dim { 1 0 } v+ ;
 
 M: editor baseline font>> font-metrics ascent>> ;
 
@@ -357,18 +362,18 @@ editor "editing" f {
     { T{ key-down f { A+ } "BACKSPACE" } delete-to-end-of-line }
 } define-command-map
 
-: paste ( editor -- ) clipboard get paste-clipboard ;
+: com-paste ( editor -- ) clipboard get paste-clipboard ;
 
 : paste-selection ( editor -- ) selection get paste-clipboard ;
 
-: cut ( editor -- ) clipboard get editor-cut ;
+: com-cut ( editor -- ) clipboard get editor-cut ;
 
 editor "clipboard" f {
-    { paste-action paste }
+    { cut-action com-cut }
     { copy-action com-copy }
-    { cut-action cut }
-    { T{ button-up f f 2 } paste-selection }
+    { paste-action com-paste }
     { T{ button-up } com-copy-selection }
+    { T{ button-up f f 2 } paste-selection }
 } define-command-map
 
 : previous-character ( editor -- )
@@ -408,8 +413,7 @@ editor "caret-motion" f {
 } define-command-map
 
 : clear-editor ( editor -- )
-    #! The with-datastack is a kludge to make it infer. Stupid.
-    model>> 1array [ clear-doc ] with-datastack drop ;
+    model>> clear-doc ;
 
 : select-all ( editor -- ) doc-elt select-elt ;
 
@@ -448,6 +452,7 @@ editor "caret-motion" f {
 
 editor "selection" f {
     { T{ button-down f { S+ } 1 } extend-selection }
+    { T{ button-up f { S+ } 1 } com-copy-selection }
     { T{ drag } drag-selection }
     { gain-focus focus-editor }
     { lose-focus unfocus-editor }
@@ -465,7 +470,14 @@ editor "selection" f {
 } define-command-map
 
 : editor-menu ( editor -- )
-    { com-undo com-redo cut com-copy paste } show-commands-menu ;
+    {
+        com-undo
+        com-redo
+        ----
+        com-cut
+        com-copy
+        com-paste
+    } show-commands-menu ;
 
 editor "misc" f {
     { T{ button-down f f 3 } editor-menu }
@@ -483,7 +495,7 @@ TUPLE: multiline-editor < editor ;
 
 <PRIVATE
 
-: page-elt ( editor -- editor element ) dup visible-lines 1- <page-elt> ;
+: page-elt ( editor -- editor element ) dup visible-lines 1 - <page-elt> ;
 
 PRIVATE>
 
@@ -514,7 +526,7 @@ PRIVATE>
 
 : this-line-and-next ( document line -- start end )
     [ nip 0 swap 2array ]
-    [ [ nip 1+ ] [ 1+ swap doc-line length ] 2bi 2array ]
+    [ [ nip 1 + ] [ 1 + swap doc-line length ] 2bi 2array ]
     2bi ;
 
 : last-line? ( document line -- ? )
@@ -553,7 +565,7 @@ TUPLE: source-editor < multiline-editor ;
 ! A useful model
 : <element-model> ( editor element -- model )
     [ [ caret>> ] [ model>> ] bi ] dip
-    '[ _ _ elt-string ] <filter> ;
+    '[ _ _ elt-string ] <arrow> ;
 
 ! Fields wrap an editor
 TUPLE: field < border editor min-cols max-cols ;
@@ -607,7 +619,7 @@ TUPLE: action-field < field quot ;
     [ editor>> editor-string ]
     [ editor>> clear-editor ]
     [ quot>> ]
-    tri call ;
+    tri call( string -- ) ;
 
 action-field H{
     { T{ key-down f f "RET" } [ invoke-action-field ] }