line editor

factor/jedit/FactorPlugin.props

@@ -2,7 +2,7 @@
 plugin.factor.jedit.FactorPlugin.activate=startup
 
 plugin.factor.jedit.FactorPlugin.name=Factor
-plugin.factor.jedit.FactorPlugin.version=0.71
+plugin.factor.jedit.FactorPlugin.version=0.72
 plugin.factor.jedit.FactorPlugin.author=Slava Pestov
 plugin.factor.jedit.FactorPlugin.docs=/doc/jedit/index.html
 

library/bootstrap/boot-stage2.factor

@@ -137,7 +137,9 @@ USE: namespaces
     "/library/sdl/sdl-keyboard.factor"
     "/library/sdl/sdl-utils.factor"
     "/library/sdl/hsv.factor"
-    "/library/sdl/console.factor"
+
+    "/library/ui/line-editor.factor"
+    "/library/ui/console.factor"
 
     "/library/bootstrap/image.factor"
 

library/generic/traits.factor

@@ -38,7 +38,8 @@ USE: vectors
 
 ! Traits metaclass for user-defined classes based on hashtables
 
-: traits ( object -- symbol ) \ traits swap hash ;
+: traits ( object -- symbol )
+    dup vector? [ \ traits swap hash ] [ drop f ] ifte ;
 
 ! Hashtable slot holding an optional delegate. Any undefined
 ! methods are called on the delegate. The object can also

library/sbuf.factor

@@ -95,3 +95,6 @@ USE: strings
 : split-n ( n str -- list )
     #! Split a string into n-character chunks.
     [ 0 -rot (split-n) ] make-list ;
+
+: ch>str ( ch -- str )
+    1 <sbuf> [ sbuf-append ] keep sbuf>str ;

library/test/combinators.factor

@@ -32,4 +32,4 @@ USE: prettyprint
 [ "9\n" ] [ [ 3 f [ . ] [ sq . ] ?ifte ] with-string ] unit-test
 [ "4\n" ] [ [ 3 4 [ . ] ?when ] with-string ] unit-test
 [ 3 ] [ 3 f [ . ] ?when ] unit-test
-[ 3 ] [ 3 t [ . ] ?unless ] unit-test
+[ t ] [ 3 t [ . ] ?unless ] unit-test

library/test/crashes.factor

@@ -9,6 +9,7 @@ USE: test
 USE: vectors
 USE: lists
 USE: words
+USE: prettyprint
 
 ! Various things that broke CFactor at various times.
 ! This should run without issue (and tests nothing useful)
@@ -62,3 +63,6 @@ USE: words
 [ 1 { } vector-nth ] [ garbage-collection drop ] catch
 [ -1 { } set-vector-length ] [ garbage-collection drop ] catch
 [ 1 "" str-nth ] [ garbage-collection drop ] catch
+
+! ... and again
+[ "" 10 str/ ] [ . ] catch

library/test/test.factor

@@ -111,6 +111,7 @@ USE: unparser
         "interpreter"
         "hsv"
         "alien"
+        "line-editor"
     ] [
         test
     ] each

library/ui/console.factor

@@ -1,3 +1,30 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2004, 2005 Slava Pestov.
+! 
+! 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 ``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
+! DEVELOPERS AND 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.
+
 ! A graphical console.
 !
 ! To run this code, bootstrap Factor like so:
@@ -34,6 +61,7 @@ USE: listener
 USE: threads
 USE: stdio
 USE: errors
+USE: line-editor
 
 #! A namespace holding console state.
 SYMBOL: console
@@ -47,8 +75,8 @@ SYMBOL: x
 SYMBOL: y
 #! A string buffer.
 SYMBOL: output-line
-#! A string buffer.
+#! A line editor object.
-SYMBOL: line-editor
+SYMBOL: input-line
 
 ! Rendering
 : background HEX: 0000dbff ;
@@ -94,7 +122,7 @@ SYMBOL: line-editor
     output-line get sbuf>str draw-line ;
 
 : draw-input ( -- )
-    line-editor get sbuf>str draw-line draw-cursor ;
+    input-line get [ line-text get ] bind draw-line draw-cursor ;
 
 : draw-console ( -- )
     [
@@ -187,7 +215,7 @@ PREDICATE: integer return-key
 
 M: return-key key-down ( key -- )
     drop
-    line-editor get empty-buffer
+    input-line get [ line-text get line-clear ] bind
     dup console-write "\n" console-write
     input-continuation get call ;
 
@@ -195,14 +223,22 @@ PREDICATE: integer backspace-key
     SDLK_BACKSPACE = ;
 
 M: backspace-key key-down ( key -- )
-    line-editor get dup sbuf-length 0 = [
+    input-line get [ backspace ] bind ;
-        drop
+
-    ] [
+PREDICATE: integer left-key
-        [ sbuf-length 1 - ] keep set-sbuf-length
+    SDLK_LEFT = ;
-    ] ifte ;
+
+M: left-key key-down ( key -- )
+    input-line get [ left ] bind ;
+
+PREDICATE: integer right-key
+    SDLK_RIGHT = ;
+
+M: right-key key-down ( key -- )
+    input-line get [ right ] bind ;
 
 M: integer key-down ( key -- )
-    line-editor get sbuf-append ;
+    input-line get [ insert-char ] bind ;
 
 GENERIC: handle-event ( event -- ? )
 
@@ -234,7 +270,7 @@ M: alien handle-event ( event -- ? )
     <event> event set
     0 first-line set
     80 <vector> lines set
-    80 <sbuf> line-editor set
+    <line-editor> input-line set
     80 <sbuf> output-line set
     1 SDL_EnableUNICODE drop
     SDL_DEFAULT_REPEAT_DELAY SDL_DEFAULT_REPEAT_INTERVAL

library/ui/line-editor.factor

@@ -0,0 +1,91 @@
+! :folding=indent:collapseFolds=1:
+
+! $Id$
+!
+! Copyright (C) 2005 Slava Pestov.
+! 
+! 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 ``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
+! DEVELOPERS AND 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.
+
+IN: line-editor
+USE: namespaces
+USE: strings
+USE: kernel
+USE: math
+
+SYMBOL: line-text
+SYMBOL: caret
+
+: line-clear ( -- )
+    #! Call this in the line editor scope.
+    0 caret set "" line-text set ;
+
+: <line-editor> ( -- editor )
+    <namespace> [ line-clear ] extend ;
+
+: caret-insert ( str offset -- )
+    #! Call this in the line editor scope.
+    caret get <= [
+        str-length caret [ + ] change
+    ] [
+        drop
+    ] ifte ;
+
+: line-insert ( str offset -- )
+    #! Call this in the line editor scope.
+    2dup caret-insert
+    line-text get swap str/
+    swapd cat3 line-text set ;
+
+: insert-char ( ch -- )
+    #! Call this in the line editor scope.
+    ch>str caret get line-insert ;
+
+: caret-remove ( offset length -- )
+    #! Call this in the line editor scope.
+    2dup + caret get <= [
+        nip caret [ swap - ] change
+    ] [
+        caret get pick pick dupd + between? [
+            drop caret set
+        ] [
+            2drop
+        ] ifte
+    ] ifte ;
+
+: line-remove ( offset length -- )
+    #! Call this in the line editor scope.
+    2dup caret-remove
+    dupd + line-text get str-tail
+    >r line-text get str-head r> cat2
+    line-text set ;
+
+: backspace ( -- )
+    #! Call this in the line editor scope.
+    caret get dup 0 = [ drop ] [ 1 - 1 line-remove ] ifte ;
+
+: left ( -- )
+    #! Call this in the line editor scope.
+    caret [ 1 - 0 max ] change ;
+
+: right ( -- )
+    #! Call this in the line editor scope.
+    caret [ 1 + line-text str-length min ] change ;

native/string.c

@@ -273,10 +273,10 @@ INLINE F_STRING* substring(CELL start, CELL end, F_STRING* string)
 	F_STRING* result;
 
 	if(start < 0)
-		range_error(tag_object(string),0,to_fixnum(start),string->capacity);
+		range_error(tag_object(string),0,tag_fixnum(start),string->capacity);
 
 	if(end < start || end > string->capacity)
-		range_error(tag_object(string),0,to_fixnum(end),string->capacity);
+		range_error(tag_object(string),0,tag_fixnum(end),string->capacity);
 
 	result = allot_string(end - start);
 	memcpy(result + 1,