diff --git a/factor/jedit/FactorPlugin.props b/factor/jedit/FactorPlugin.props index 7d36660d79..811bb4557f 100644 --- a/factor/jedit/FactorPlugin.props +++ b/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 diff --git a/library/bootstrap/boot-stage2.factor b/library/bootstrap/boot-stage2.factor index b8b569c475..9d1ddb8729 100644 --- a/library/bootstrap/boot-stage2.factor +++ b/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" diff --git a/library/generic/traits.factor b/library/generic/traits.factor index 65cb3e72b0..3240fb16f0 100644 --- a/library/generic/traits.factor +++ b/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 diff --git a/library/sbuf.factor b/library/sbuf.factor index c56f4c506d..d8c8ad6953 100644 --- a/library/sbuf.factor +++ b/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-append ] keep sbuf>str ; diff --git a/library/test/combinators.factor b/library/test/combinators.factor index fd8eb776bf..620658900d 100644 --- a/library/test/combinators.factor +++ b/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 diff --git a/library/test/crashes.factor b/library/test/crashes.factor index c6a280851e..2a1bcb3fe4 100644 --- a/library/test/crashes.factor +++ b/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 diff --git a/library/test/test.factor b/library/test/test.factor index 5757e6213d..54496d8c70 100644 --- a/library/test/test.factor +++ b/library/test/test.factor @@ -111,6 +111,7 @@ USE: unparser "interpreter" "hsv" "alien" + "line-editor" ] [ test ] each diff --git a/library/sdl/console.factor b/library/ui/console.factor similarity index 74% rename from library/sdl/console.factor rename to library/ui/console.factor index 66664500c0..144b86aa00 100644 --- a/library/sdl/console.factor +++ b/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. -SYMBOL: line-editor +#! A line editor object. +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 = [ - drop - ] [ - [ sbuf-length 1 - ] keep set-sbuf-length - ] ifte ; + input-line get [ backspace ] bind ; + +PREDICATE: integer left-key + SDLK_LEFT = ; + +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 set 0 first-line set 80 lines set - 80 line-editor set + input-line set 80 output-line set 1 SDL_EnableUNICODE drop SDL_DEFAULT_REPEAT_DELAY SDL_DEFAULT_REPEAT_INTERVAL diff --git a/library/ui/line-editor.factor b/library/ui/line-editor.factor new file mode 100644 index 0000000000..5a6d0062fe --- /dev/null +++ b/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 ; + +: ( -- editor ) + [ 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 ; diff --git a/native/string.c b/native/string.c index 3c947e35d6..54a1accfbf 100644 --- a/native/string.c +++ b/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,