string-compare ==> lexi, string> ==> lexi>

diff --git a/CHANGES.txt b/CHANGES.txt
index 50fa49453a0b177b6e40a8a7d5d269db323c4031..d49954aba24d17772305b9c9d2ca8e014ab180ea 100644 (file)
--- a/CHANGES.txt
+++ b/CHANGES.txt
@@ -27,7 +27,11 @@ Factor 0.76:
   [ "Hello" % " world" % ] make-string
   
   Now, the former raises a type error.
-  
+
+- The string-compare primitive has been replaced with the lexi word
+  which now operates on any pair of sequences of numbers. The
+  string> word has been replaced with lexi>.
+
 - The stream-write, stream-write-attr, write and write-attr generic   
   words no longer accept a character as an argument. Use the new
   stream-write1 and write1 generic words to write single characters.

diff --git a/TODO.FACTOR.txt b/TODO.FACTOR.txt
index 718d764facba359fbe8806ffac8642d57437ee50..1c1425ee3b5878f8cb839fdf034b628f87821659 100644 (file)
--- a/TODO.FACTOR.txt
+++ b/TODO.FACTOR.txt
@@ -7,12 +7,11 @@
 - rollovers broken with menus\r
 - menu dragging\r
 - fix up the min thumb size hack\r
-- bevel borders\r
 - nicer scrollbars with up/down buttons\r
 - gaps in pack layout\r
 - fix listener prompt display after presentation commands invoked\r
 - stack display bugs\r
-- simple tutorial\r
+- tutorial: clickable code snippets\r
 - parser::skip clean up\r
 \r
 + misc\r

diff --git a/library/bootstrap/primitives.factor b/library/bootstrap/primitives.factor
index 9834480f5e1a22255c24cf431d618eebcf7ad51b..a73264b410db3273e067e20ef6746ab7180e6558 100644 (file)
--- a/library/bootstrap/primitives.factor
+++ b/library/bootstrap/primitives.factor
@@ -44,7 +44,6 @@ vocabularies get [
     [ "dispatch" "kernel-internals"           [ [ fixnum vector ] [ ] ] ]
     [ "cons" "lists"                          [ [ object object ] [ cons ] ] ]
     [ "<vector>" "vectors"                    [ [ integer ] [ vector ] ] ]
-    [ "string-compare" "strings"              [ [ string string ] [ integer ] ] ]
     [ "rehash-string" "strings"               [ [ string ] [ ] ] ]
     [ "<sbuf>" "strings"                      [ [ integer ] [ sbuf ] ] ]
     [ "sbuf>string" "strings"                 [ [ sbuf ] [ string ] ] ]

diff --git a/library/collections/sequence-eq.factor b/library/collections/sequence-eq.factor
index cc132010d1c8fafe51e08336970c37fe3e240ac0..049c2e6cdca39d59ee28d17d7defca69dc3bdab8 100644 (file)
--- a/library/collections/sequence-eq.factor
+++ b/library/collections/sequence-eq.factor
@@ -31,3 +31,11 @@ M: sequence = ( obj seq -- ? )
     ] [
         over type over type eq? [ sequence= ] [ 2drop f ] ifte
     ] ifte ;
+
+M: string = ( obj str -- ? )
+    over string? [
+        over hashcode over hashcode number=
+        [ sequence= ] [ 2drop f ] ifte
+    ] [
+        2drop f
+    ] ifte ;

diff --git a/library/collections/sequences-epilogue.factor b/library/collections/sequences-epilogue.factor
index 86f352d1e7cf051baee5a74c7cecf0b6a6493ddb..843f6fea03a5cee4dfcfba28399c4315cd2ede23 100644 (file)
--- a/library/collections/sequences-epilogue.factor
+++ b/library/collections/sequences-epilogue.factor
@@ -211,6 +211,29 @@ M: object reverse ( seq -- seq ) [ <reversed> ] keep like ;
     #! Is every element of seq1 in seq2
     swap [ swap member? ] all-with? ;
 
+! Lexicographic comparison
+: (lexi) ( seq seq i limit -- n )
+    2dup >= [
+        2drop swap length swap length -
+    ] [
+        >r 3dup 2nth 2dup = [
+            2drop 1 + r> (lexi)
+        ] [
+            r> drop - >r 3drop r>
+        ] ifte
+    ] ifte ;
+
+: lexi ( s1 s2 -- n )
+    #! Lexicographically compare two sequences of numbers
+    #! (usually strings). Negative if s1<s2, zero if s1=s2,
+    #! positive if s1>s2.
+    0 pick length pick length min (lexi) ;
+
+: lexi> ( seq seq -- ? )
+    #! Test if the first sequence follows the second
+    #! lexicographically.
+    lexi 0 > ;
+
 IN: kernel
 
 : depth ( -- n )

diff --git a/library/collections/strings-epilogue.factor b/library/collections/strings-epilogue.factor
index 4bb36a4e359464e8aa36a7435db517c087f99675..35d0ee0f5a81261bf84f7764ef0561de618bb7da 100644 (file)
--- a/library/collections/strings-epilogue.factor
+++ b/library/collections/strings-epilogue.factor
@@ -4,8 +4,7 @@ IN: strings
 USING: generic kernel kernel-internals lists math namespaces
 sequences strings ;
 
-: empty-sbuf ( len -- sbuf )
-    dup <sbuf> [ set-length ] keep ;
+: empty-sbuf ( len -- sbuf ) dup <sbuf> [ set-length ] keep ;
 
 : fill ( count char -- string ) <repeated> >string ;
 
@@ -28,7 +27,6 @@ M: string thaw >sbuf ;
 
 M: string like ( seq sbuf -- string ) drop >string ;
 
-M: sbuf clone ( sbuf -- sbuf )
-    [ length <sbuf> dup ] keep nappend ;
+M: sbuf clone ( sbuf -- sbuf ) >sbuf ;
 
 M: sbuf like ( seq sbuf -- sbuf ) drop >sbuf ;

diff --git a/library/collections/strings.factor b/library/collections/strings.factor
index e1d23fb8f446712427bf13dbe50b583a0a042a17..871f2e6fe852561c1f192a49bbb0af6441bc137d 100644 (file)
--- a/library/collections/strings.factor
+++ b/library/collections/strings.factor
@@ -7,28 +7,12 @@ USING: generic kernel kernel-internals lists math sequences ;
 DEFER: string?
 BUILTIN: string 12 string? [ 1 length f ] [ 2 hashcode f ] ;
 
-M: string =
-    over string? [
-        over hashcode over hashcode number= [
-            string-compare 0 eq?
-        ] [
-            2drop f
-        ] ifte
-    ] [
-        2drop f
-    ] ifte ;
-
-M: string nth ( n str -- ch )
-    bounds-check char-slot ;
+M: string nth ( n str -- ch ) bounds-check char-slot ;
 
 GENERIC: >string ( seq -- string )
 
 M: string >string ;
 
-: string> ( str1 str2 -- ? )
-    ! Returns if the first string lexicographically follows str2
-    string-compare 0 > ;
-
 ! Characters
 PREDICATE: integer blank     " \t\n\r" member? ;
 PREDICATE: integer letter    CHAR: a CHAR: z between? ;

diff --git a/library/collections/vectors-epilogue.factor b/library/collections/vectors-epilogue.factor
index b1f7a72c1848927e0eb7edd7147fb96fc9e0b5ce..9fdcd677e4da9b0281c1ed96639b92d81b09e563 100644 (file)
--- a/library/collections/vectors-epilogue.factor
+++ b/library/collections/vectors-epilogue.factor
@@ -5,22 +5,16 @@ math-internals sequences ;
 
 IN: vectors
 
-: empty-vector ( len -- vec )
-    #! Creates a vector with 'len' elements set to f. Unlike
-    #! <vector>, which gives an empty vector with a certain
-    #! capacity.
-    dup <vector> [ set-length ] keep ;
+: empty-vector ( len -- vec ) dup <vector> [ set-length ] keep ;
 
 : >vector ( list -- vector )
     dup length <vector> [ swap nappend ] keep ;
 
 M: repeated thaw >vector ;
 
-M: vector clone ( vector -- vector )
-    >vector ;
+M: vector clone ( vector -- vector ) >vector ;
 
-: zero-vector ( n -- vector )
-    0 <repeated> >vector ;
+: zero-vector ( n -- vector ) 0 <repeated> >vector ;
 
 M: general-list thaw >vector ;
 

diff --git a/library/httpd/browser-responder.factor b/library/httpd/browser-responder.factor
index a8e65854e411823bb965dbc079da72b9292f41e9..f6807faf9ba0071341e725cf2b1bb9084adab309 100644 (file)
--- a/library/httpd/browser-responder.factor
+++ b/library/httpd/browser-responder.factor
@@ -57,7 +57,7 @@ sequences ;
   #! Write out the HTML for the list of words in a vocabulary.
   <select name= "words" style= "width: 200" size= "20" onchange= "document.forms.main.submit()" select> 
     words [ 
-      word-name dup "current-word" get [ "" ] unless* string-compare 0 = [
+      word-name dup "current-word" get [ "" ] unless* = [
       "<option selected>" write
      ] [
         "<option>" write

diff --git a/library/io/files.factor b/library/io/files.factor
index 2543dbdab761719cf92bec0830391ee57da9f91a..1793e68a989930bcb0e89d79ae2d59e27f9d56c2 100644 (file)
--- a/library/io/files.factor
+++ b/library/io/files.factor
@@ -8,7 +8,7 @@ USING: kernel lists namespaces sequences strings ;
 : path+ ( path path -- path ) "/" swap append3 ;
 : exists? ( file -- ? ) stat >boolean ;
 : directory? ( file -- ? ) stat car ;
-: directory ( dir -- list ) (directory) [ string> ] sort ;
+: directory ( dir -- list ) (directory) [ lexi> ] sort ;
 : file-length ( file -- length ) stat third ;
 : file-extension ( filename -- extension )
     "." split cdr dup [ peek ] when ;

diff --git a/library/test/lists/combinators.factor b/library/test/lists/combinators.factor
index d144b93afd10b8a8282268c7572f7475ad82bbcf..40f195c1d94cc4b243a751016bee7d8025f89fe0 100644 (file)
--- a/library/test/lists/combinators.factor
+++ b/library/test/lists/combinators.factor
@@ -14,7 +14,7 @@ USE: sequences
 
 [ "fdsfs" [ > ] sort ] unit-test-fails
 [ [ ] ] [ [ ] [ > ] sort ] unit-test
-[ [ "2 + 2" ] ] [ [ "2 + 2" ] [ string> ] sort ] unit-test
+[ [ "2 + 2" ] ] [ [ "2 + 2" ] [ lexi> ] sort ] unit-test
 [ [ 1 2 3 4 5 6 7 ] ] [ [ 6 4 5 7 2 1 3 ] [ > ] sort ] unit-test
 
 [ f ] [ [ { } { } "Hello" ] [ = ] fiber? ] unit-test

diff --git a/library/test/strings.factor b/library/test/strings.factor
index bdda2e0030799de6b6d355af66bae11f75e30bcd..24f600ce4a37cd15568a278d600a358e3e548ac3 100644 (file)
--- a/library/test/strings.factor
+++ b/library/test/strings.factor
@@ -71,8 +71,8 @@ unit-test
 [ t ] [ CHAR: 0 digit? ] unit-test
 [ f ] [ CHAR: x digit? ] unit-test
 
-[ t ] [ "abc" "abd" string-compare 0 < ] unit-test
-[ t ] [ "z" "abd" string-compare 0 > ] unit-test
+[ t ] [ "abc" "abd" lexi 0 < ] unit-test
+[ t ] [ "z" "abd" lexi 0 > ] unit-test
 
 [ f ] [ [ 0 10 "hello" subseq ] [ not ] catch ] unit-test
 

diff --git a/library/test/words.factor b/library/test/words.factor
index d6c5082e543c1a5c51b476b7f76998c8e3429ce1..d53d06e45e452ff4b067e55c5d7c8b79aa00bd8b 100644 (file)
--- a/library/test/words.factor
+++ b/library/test/words.factor
@@ -58,6 +58,22 @@ GENERIC: testing
 
 [ f ] [ \ testing generic? ] unit-test
 
+[ f ] [ gensym interned? ] unit-test
+
+: forgotten ;
+: another-forgotten ;
+
+[ f ] [ \ forgotten interned? ] unit-test
+
+FORGET: forgotten
+
+[ f ] [ \ another-forgotten interned? ] unit-test
+
+FORGET: another-forgotten
+: another-forgotten ;
+
+[ t ] [ \ car interned? ] unit-test
+
 ! This has to be the last test in the file.
 : test-last ( -- ) ;
 word word-name "last-word-test" set

diff --git a/library/tools/inspector.factor b/library/tools/inspector.factor
index d0ba46eb8af7787577d8e3f4c0d321807559ee3e..92af6846567e6ea393f3c4361ecfc49a54183f50 100644 (file)
--- a/library/tools/inspector.factor
+++ b/library/tools/inspector.factor
@@ -48,9 +48,6 @@ M: hashtable sheet hash>alist unzip 2list ;
     seq-transpose
     [ " | " join ] map ;
 
-: interned? ( word -- ? )
-    dup word-name swap word-vocabulary vocab hash ;
-
 : class-banner ( word -- )
     dup metaclass dup [
         "This is a class whose behavior is specifed by the " write

diff --git a/library/tools/memory.factor b/library/tools/memory.factor
index 4d29426d82c8ea08004547252b8e155195809c2b..9d6076c08c1550144718e191ed88e647111d3af8 100644 (file)
--- a/library/tools/memory.factor
+++ b/library/tools/memory.factor
@@ -106,14 +106,6 @@ M: object (each-slot) ( quot obj -- )
     #! Print heap allocation breakdown.
     0 heap-stats [ dupd uncons heap-stat. 1 + ] each drop ;
 
-: orphan? ( word -- ? )
-    #! Test if the word is not a member of its vocabulary.
-    dup dup word-name swap word-vocabulary dup [
-        vocab dup [ hash eq? not ] [ 3drop t ] ifte
-    ] [
-        3drop t
-    ] ifte ;
-
 : orphans ( word -- list )
     #! Orphans are forgotten but still referenced.
-    [ word? ] instances [ orphan? ] subset ;
+    [ word? ] instances [ interned? not ] subset ;

diff --git a/library/ui/books.factor b/library/ui/books.factor
index 382bbc4d1da5258207eeae043d7b352b8008f228..eade0aef97ac65d1fa189e6fb1331a4772a4f088 100644 (file)
--- a/library/ui/books.factor
+++ b/library/ui/books.factor
@@ -14,9 +14,9 @@ M: book pref-dim ( book -- dim )
     gadget-children { 0 0 0 } [ pref-dim vmax ] reduce ;
 
 M: book layout* ( book -- )
-    dup shape-dim over gadget-children [
+    dup rectangle-dim over gadget-children [
         f over set-gadget-visible?
-        { 0 0 0 } over set-shape-loc
+        { 0 0 0 } over set-rectangle-loc
         set-gadget-dim
     ] each-with
     dup book-page swap gadget-children nth

diff --git a/library/ui/borders.factor b/library/ui/borders.factor
index 3600e9edb42ed018fd6297c15baac40193989741..8df8922dd02dbc5f74b3b10e8e0a74952ccdca61 100644 (file)
--- a/library/ui/borders.factor
+++ b/library/ui/borders.factor
@@ -21,10 +21,10 @@ C: border ( child delegate size -- border )
     <bevel-gadget> { 5 5 0 } <border> ;
 
 : layout-border-loc ( border -- )
-    dup border-size swap gadget-child set-shape-loc ;
+    dup border-size swap gadget-child set-rectangle-loc ;
 
 : layout-border-dim ( border -- )
-    dup shape-dim over border-size 2 v*n v-
+    dup rectangle-dim over border-size 2 v*n v-
     swap gadget-child set-gadget-dim ;
 
 M: border pref-dim ( border -- dim )

diff --git a/library/ui/editors.factor b/library/ui/editors.factor
index 891a9848cc6f6dc39a61a7a8afa6fe7a681af8eb..0ac783f0ad5007361835f512aaa6a17e84de0bd0 100644 (file)
--- a/library/ui/editors.factor
+++ b/library/ui/editors.factor
@@ -50,7 +50,7 @@ TUPLE: editor line caret ;
     ] with-editor ;
 
 : click-editor ( editor -- )
-    dup hand relative shape-x over set-caret-x request-focus ;
+    dup hand relative first over set-caret-x request-focus ;
 
 : editor-actions ( editor -- )
     [
@@ -81,7 +81,7 @@ C: editor ( text -- )
     0 0 3vector ;
 
 : caret-dim ( editor -- w h )
-    shape-dim { 0 1 1 } v* { 1 0 0 } v+ ;
+    rectangle-dim { 0 1 1 } v* { 1 0 0 } v+ ;
 
 M: editor user-input* ( ch editor -- ? )
     [ insert-char ] with-editor  t ;
@@ -91,7 +91,7 @@ M: editor pref-dim ( editor -- dim )
 
 M: editor layout* ( editor -- )
     dup editor-caret over caret-dim swap set-gadget-dim
-    dup editor-caret swap caret-loc swap set-shape-loc ;
+    dup editor-caret swap caret-loc swap set-rectangle-loc ;
 
 M: editor draw-gadget* ( editor -- )
     dup delegate draw-gadget*

diff --git a/library/ui/frames.factor b/library/ui/frames.factor
index 6dc1dbba94f41c00570b4dfdae0332c9aa8aa1bc..b17ea029d0f2d9240fff75d9b7023352ee8e311e 100644 (file)
--- a/library/ui/frames.factor
+++ b/library/ui/frames.factor
@@ -83,7 +83,7 @@ SYMBOL: frame-bottom-run
     var-frame-bottom ;
 
 : move-gadget ( x y gadget -- )
-    >r 0 3vector r> set-shape-loc ;
+    >r 0 3vector r> set-rectangle-loc ;
 
 : reshape-gadget ( x y w h gadget -- )
     [ >r 0 3vector r> set-gadget-dim ] keep move-gadget ;

diff --git a/library/ui/gadgets.factor b/library/ui/gadgets.factor
index 7fca229cff59a8d418273b928dc816cc24ccfb03..f49cb68b2285c9e24417e67df6a9423a71e6f9e6 100644 (file)
--- a/library/ui/gadgets.factor
+++ b/library/ui/gadgets.factor
@@ -42,12 +42,12 @@ DEFER: add-invalid
     dup add-invalid (relayout-down) ;
 
 : set-gadget-dim ( dim gadget -- )
-    2dup shape-dim =
-    [ 2drop ] [ [ set-shape-dim ] keep relayout-down ] ifte ;
+    2dup rectangle-dim =
+    [ 2drop ] [ [ set-rectangle-dim ] keep relayout-down ] ifte ;
 
 GENERIC: pref-dim ( gadget -- dim )
 
-M: gadget pref-dim shape-dim ;
+M: gadget pref-dim rectangle-dim ;
 
 GENERIC: layout* ( gadget -- )
 

diff --git a/library/ui/gestures.factor b/library/ui/gestures.factor
index 5912756aca5731cf6a82adc40bc1158f2271884a..723ecf6b81f2e7123d0721ce9b14e4ea8a8a01b2 100644 (file)
--- a/library/ui/gestures.factor
+++ b/library/ui/gestures.factor
@@ -44,7 +44,7 @@ SYMBOL: button-down
     #! enter gesture, since the mouse did not enter. Otherwise,
     #! fire an enter gesture and go on to the parent.
     [
-        [ shape-loc v+ ] keep
+        [ rectangle-loc v+ ] keep
         2dup inside? [ mouse-enter ] hierarchy-gesture
     ] each-parent 2drop ;
 
@@ -53,7 +53,7 @@ SYMBOL: button-down
     #! leave gesture, since the mouse did not leave. Otherwise,
     #! fire a leave gesture and go on to the parent.
     [
-        [ shape-loc v+ ] keep
+        [ rectangle-loc v+ ] keep
         2dup inside? [ mouse-leave ] hierarchy-gesture
     ] each-parent 2drop ;
 

diff --git a/library/ui/hand.factor b/library/ui/hand.factor
index 6cad50343ffea4757a0e810c93772392563edb9d..ba334110c4da9470f1cb0e7864d35a2f020f40f4 100644 (file)
--- a/library/ui/hand.factor
+++ b/library/ui/hand.factor
@@ -13,7 +13,7 @@ prettyprint sdl sequences vectors ;
     #! in any subgadget. If not, see if it is contained in the
     #! box delegate.
     dup gadget-visible? >r 2dup inside? r> drop [
-        [ translate ] keep 2dup
+        [ rectangle-loc v- ] keep 2dup
         (pick-up) [ pick-up ] [ nip ] ?ifte
     ] [
         2drop f
@@ -45,13 +45,13 @@ C: hand ( world -- hand )
     [ hand-buttons remove ] keep set-hand-buttons ;
 
 : fire-leave ( hand gadget -- )
-    [ swap shape-loc swap screen-loc v- ] keep mouse-leave ;
+    [ swap rectangle-loc swap screen-loc v- ] keep mouse-leave ;
 
 : fire-enter ( oldpos hand -- )
     hand-gadget [ screen-loc v- ] keep mouse-enter ;
 
 : update-hand-gadget ( hand -- )
-    [ world get pick-up ] keep set-hand-gadget ;
+    [ rectangle-loc world get pick-up ] keep set-hand-gadget ;
 
 : motion-gesture ( hand gadget gesture -- )
     #! Send a gesture like [ drag 2 ].
@@ -66,8 +66,8 @@ C: hand ( world -- hand )
     [ dup hand-clicked [ drag ] motion-gesture ] [ drop ] ifte ;
 
 : move-hand ( loc hand -- )
-    dup shape-loc >r
-    [ set-shape-loc ] keep
+    dup rectangle-loc >r
+    [ set-rectangle-loc ] keep
     dup hand-gadget >r
     dup update-hand-gadget
     dup r> fire-leave
@@ -76,7 +76,7 @@ C: hand ( world -- hand )
 
 : update-hand ( hand -- )
     #! Called when a gadget is removed or added.
-    dup shape-loc swap move-hand ;
+    dup rectangle-loc swap move-hand ;
 
 : request-focus ( gadget -- )
     focusable-child

diff --git a/library/ui/hierarchy.factor b/library/ui/hierarchy.factor
index d13985e765b1f7d95ce7175aba71e354d0fd3f26..58d32f3871e2f9022887d0dd83ea3308fac955d5 100644 (file)
--- a/library/ui/hierarchy.factor
+++ b/library/ui/hierarchy.factor
@@ -40,6 +40,9 @@ sequences vectors ;
     #! is the gadget itself.
     dup [ dup gadget-parent parents cons ] when ;
 
+: find-parent ( gadget quot -- ? )
+    >r parents r> find nip ;
+
 : each-parent ( gadget quot -- ? )
     #! Keep executing the quotation on higher and higher
     #! parents until it returns f.
@@ -47,7 +50,7 @@ sequences vectors ;
 
 : screen-loc ( gadget -- point )
     #! The position of the gadget on the screen.
-    parents { 0 0 0 } [ shape-loc v+ ] reduce ;
+    parents { 0 0 0 } [ rectangle-loc v+ ] reduce ;
 
 : relative ( g1 g2 -- g2-g1 )
     screen-loc swap screen-loc v- ;

diff --git a/library/ui/incremental.factor b/library/ui/incremental.factor
index ddc6c09f5ab2982415fd205797d41fe342dd34bb..abac6168c30752e35cc791910bfd7f782ec0ea74 100644 (file)
--- a/library/ui/incremental.factor
+++ b/library/ui/incremental.factor
@@ -24,7 +24,7 @@ M: incremental layout* drop ;
 
 : next-cursor ( gadget incremental -- cursor )
     [
-        swap shape-dim swap incremental-cursor
+        swap rectangle-dim swap incremental-cursor
         2dup v+ >r vmax r>
     ] keep  pack-vector set-axis ;
 
@@ -33,10 +33,10 @@ M: incremental layout* drop ;
 
 : incremental-loc ( gadget incremental -- )
     dup incremental-cursor swap pack-vector v*
-    swap set-shape-loc ;
+    swap set-rectangle-loc ;
 
 : prefer-incremental ( gadget -- )
-    dup pref-dim swap set-shape-dim ;
+    dup pref-dim swap set-rectangle-dim ;
 
 : add-incremental ( gadget incremental -- )
     2dup (add-gadget)
@@ -46,4 +46,6 @@ M: incremental layout* drop ;
     prefer-incremental ;
 
 : clear-incremental ( incremental -- )
-    dup (clear-gadget) { 0 0 0 } swap set-incremental-cursor ;
+    dup (clear-gadget)
+    { 0 0 0 } over set-incremental-cursor
+    gadget-parent [ relayout ] when* ;

diff --git a/library/ui/init-world.factor b/library/ui/init-world.factor
index 88a41fb7041ff2b2bd4967af4c4d0a46ab84ca8a..f7d9b281969ea2aede715634b89dcea0d3bc75db 100644 (file)
--- a/library/ui/init-world.factor
+++ b/library/ui/init-world.factor
@@ -2,7 +2,7 @@
 ! See http://factor.sf.net/license.txt for BSD license.
 IN: gadgets
 USING: generic io kernel listener math namespaces prettyprint
-sequences styles threads ;
+sequences styles threads words ;
 
 SYMBOL: stack-display
 
@@ -38,7 +38,9 @@ SYMBOL: stack-display
         [
             pane get [
                 [ ui.s ] listener-hook set
-                clear print-banner listener
+                clear print-banner
+                "Tutorial" [ [ tutorial ] pane get pane-call ] <button> gadget.
+                listener
             ] with-stream
         ] in-thread
         

diff --git a/library/ui/layouts.factor b/library/ui/layouts.factor
index fbf0c7c20a3bce15883a1abe276975293627be6d..f6440210c519f8df393e137e1b2bc3b96eaf325b 100644 (file)
--- a/library/ui/layouts.factor
+++ b/library/ui/layouts.factor
@@ -27,7 +27,7 @@ TUPLE: pack align fill vector ;
 
 : packed-dim-2 ( gadget sizes -- list )
     [
-        over shape-dim { 1 1 1 } vmax over v-
+        over rectangle-dim { 1 1 1 } vmax over v-
         rot pack-fill v*n v+
     ] map-with ;
 
@@ -42,9 +42,9 @@ TUPLE: pack align fill vector ;
     { 0 0 0 } [ v+ ] accumulate ;
 
 : packed-loc-2 ( gadget sizes -- list )
-    >r dup shape-dim { 1 1 1 } vmax over r>
+    >r dup rectangle-dim { 1 1 1 } vmax over r>
     packed-dim-2 [ v- ] map-with
-    >r dup pack-align swap shape-dim { 1 1 1 } vmax r>
+    >r dup pack-align swap rectangle-dim { 1 1 1 } vmax r>
     [ >r 2dup r> v- n*v ] map 2nip ;
 
 : (packed-locs) ( gadget sizes -- list )
@@ -52,7 +52,7 @@ TUPLE: pack align fill vector ;
 
 : packed-locs ( gadget sizes -- )
     over gadget-children >list >r (packed-locs) r>
-    zip [ uncons set-shape-loc ] each ;
+    zip [ uncons set-rectangle-loc ] each ;
 
 : packed-layout ( gadget sizes -- )
     2dup packed-locs packed-dims ;

diff --git a/library/ui/menus.factor b/library/ui/menus.factor
index 3ca24829b82d18f827478d2d23508d413092f183..21b500ccf6f20748cd3889f8d17180382425e366 100644 (file)
--- a/library/ui/menus.factor
+++ b/library/ui/menus.factor
@@ -4,7 +4,7 @@ IN: gadgets
 USING: generic kernel lists math namespaces sequences ;
 
 : show-menu ( menu -- )
-    hand screen-loc over set-shape-loc show-glass ;
+    hand screen-loc over set-rectangle-loc show-glass ;
 
 : menu-item-border ( child -- border )
     <plain-gadget> { 1 1 0 } <border> ;

diff --git a/library/ui/paint.factor b/library/ui/paint.factor
index 31f3021f06aa706d237a1cc9e3cbb951237e5d5c..01a18e4b6806faa727400f8c1246ed2f372c454d 100644 (file)
--- a/library/ui/paint.factor
+++ b/library/ui/paint.factor
@@ -114,7 +114,7 @@ TUPLE: gradient vector from to ;
     dup first [ 3dup gradient-y ] repeat 2drop ;
 
 M: gradient draw-interior ( gadget gradient -- )
-    swap shape-dim { 1 1 1 } vmax
+    swap rectangle-dim { 1 1 1 } vmax
     over gradient-vector { 1 0 0 } =
     [ horiz-gradient ] [ vert-gradient ] ifte ;
 
@@ -146,7 +146,7 @@ M: bevel draw-boundary ( gadget boundary -- )
     #! Ugly code.
     bevel-width [
         [
-            >r x get y get 0 3vector over shape-dim over v+ r>
+            >r origin over rectangle-dim over v+ r>
             { 1 1 0 } n*v tuck v- { 1 1 0 } v- >r v+ r>
             rot draw-bevel
         ] 2keep

diff --git a/library/ui/scrolling.factor b/library/ui/scrolling.factor
index db072359fbdaa9061e05880b56787d8efe5c9a04..adc27c25b7246826b6bf191d5aaa59395400a62e 100644 (file)
--- a/library/ui/scrolling.factor
+++ b/library/ui/scrolling.factor
@@ -11,7 +11,7 @@ TUPLE: viewport origin bottom? ;
 : viewport-dim gadget-child pref-dim ;
 
 : fix-scroll ( origin viewport -- origin )
-    dup shape-dim swap viewport-dim v- vmax { 0 0 0 } vmin ;
+    dup rectangle-dim swap viewport-dim v- vmax { 0 0 0 } vmin ;
 
 : scroll ( origin viewport -- )
     [ fix-scroll ] keep [ set-viewport-origin ] keep relayout ;
@@ -35,13 +35,13 @@ M: viewport pref-dim gadget-child pref-dim ;
 
 M: viewport layout* ( viewport -- )
     dup gadget-child dup prefer
-    >r viewport-origin* r> set-shape-loc ;
+    >r viewport-origin* r> set-rectangle-loc ;
 
 M: viewport focusable-child* ( viewport -- gadget )
     gadget-child ;
 
 : visible-portion ( viewport -- vector )
-    dup shape-dim { 1 1 1 } vmax
+    dup rectangle-dim { 1 1 1 } vmax
     swap viewport-dim { 1 1 1 } vmax
     v/ { 1 1 1 } vmin ;
 
@@ -106,13 +106,13 @@ C: slider ( viewport vector -- slider )
 : slider-dim { 16 16 16 } ;
 
 : thumb-dim ( slider -- h )
-    [ shape-dim dup ] keep >thumb slider-dim vmax vmin ;
+    [ rectangle-dim dup ] keep >thumb slider-dim vmax vmin ;
 
 M: slider pref-dim drop slider-dim ;
 
 M: slider layout* ( slider -- )
     dup thumb-loc over slider-vector v*
-    over slider-thumb set-shape-loc
+    over slider-thumb set-rectangle-loc
     dup thumb-dim over slider-vector v* slider-dim vmax
     swap slider-thumb set-gadget-dim ;
 

diff --git a/library/ui/shapes.factor b/library/ui/shapes.factor
index 5e70c73167a5c7185e05ac9dc6c390ae2b496c02..78277db37fa1e0587b1f79a49abaa4220d23a08e 100644 (file)
--- a/library/ui/shapes.factor
+++ b/library/ui/shapes.factor
@@ -9,16 +9,14 @@ SYMBOL: y
 
 : origin ( -- loc ) x get y get 0 3vector ;
 
+TUPLE: rectangle loc dim ;
+
 GENERIC: inside? ( loc shape -- ? )
-GENERIC: shape-loc ( shape -- loc )
-GENERIC: set-shape-loc ( loc shape -- )
-GENERIC: shape-dim ( shape -- dim )
-GENERIC: set-shape-dim ( dim shape -- )
 
-: shape-x shape-loc first ;
-: shape-y shape-loc second ;
-: shape-w shape-dim first ;
-: shape-h shape-dim second ;
+: shape-x rectangle-loc first ;
+: shape-y rectangle-loc second ;
+: shape-w rectangle-dim first ;
+: shape-h rectangle-dim second ;
 
 : with-trans ( shape quot -- )
     #! All drawing done inside the quotation is translated
@@ -30,29 +28,11 @@ GENERIC: set-shape-dim ( dim shape -- )
         r> call
     ] with-scope ; inline
 
-: shape-pos ( shape -- pos )
-    dup shape-x swap shape-y rect> ;
-
 : shape-bounds ( shape -- loc dim )
-    dup shape-loc swap shape-dim ;
+    dup rectangle-loc swap rectangle-dim ;
 
 : shape-extent ( shape -- loc dim )
-    dup shape-loc dup rot shape-dim v+ ;
-
-: translate ( shape shape -- point )
-    #! Translate a point relative to the shape.
-    swap shape-loc swap shape-loc v- ;
-
-M: vector shape-loc ;
-M: vector shape-dim drop { 0 0 0 } ;
-
-TUPLE: rectangle loc dim ;
-
-M: rectangle shape-loc rectangle-loc ;
-M: rectangle set-shape-loc set-rectangle-loc ;
-
-M: rectangle shape-dim rectangle-dim ;
-M: rectangle set-shape-dim set-rectangle-dim ;
+    dup rectangle-loc dup rot rectangle-dim v+ ;
 
 : screen-bounds ( shape -- rect )
     shape-bounds >r origin v+ r> <rectangle> ;

diff --git a/library/ui/splitters.factor b/library/ui/splitters.factor
index 4dfb74369f8409e05ed58ba79d56feb453fdb168..525a67726eb209fafbfa48cd15685420446aa1fd 100644 (file)
--- a/library/ui/splitters.factor
+++ b/library/ui/splitters.factor
@@ -17,7 +17,7 @@ TUPLE: splitter split ;
 
 : divider-motion ( splitter -- )
     dup hand>split
-    over shape-dim { 1 1 1 } vmax v/ over pack-vector v.
+    over rectangle-dim { 1 1 1 } vmax v/ over pack-vector v.
     0 max 1 min over set-splitter-split relayout ;
 
 : divider-actions ( thumb -- )
@@ -45,14 +45,14 @@ C: splitter ( first second split vector -- splitter )
     { 1 0 0 } <splitter> ;
 
 : splitter-part ( splitter -- vec )
-    dup splitter-split swap shape-dim
+    dup splitter-split swap rectangle-dim
     n*v divider-size 1/2 v*n v- ;
 
 : splitter-layout ( splitter -- [ a b c ] )
     [
         dup splitter-part ,
         divider-size ,
-        dup shape-dim divider-size v- swap splitter-part v- ,
+        dup rectangle-dim divider-size v- swap splitter-part v- ,
     ] make-list ;
 
 M: splitter layout* ( splitter -- )

diff --git a/library/ui/tutorial.factor b/library/ui/tutorial.factor
index 6dd92abfc100c5be585bbbb8ddb58c2d10aeacef..e9fe9d9d48b468e973ff9c64c00d6348d523bade 100644 (file)
--- a/library/ui/tutorial.factor
+++ b/library/ui/tutorial.factor
@@ -320,4 +320,5 @@ sequences styles ;
     dup 18 font-size set-paint-prop\r
     <book-browser> ;\r
 \r
-: tutorial <tutorial> gadget. ;\r
+: tutorial ( -- )\r
+    ensure-ui <tutorial> gadget. ;\r

diff --git a/library/ui/ui.factor b/library/ui/ui.factor
index fb27a9bae50dce45c6b968bf46b0f67d890d8705..316162a22e64ba31fedd61f4f8806afdd5553d09 100644 (file)
--- a/library/ui/ui.factor
+++ b/library/ui/ui.factor
@@ -10,7 +10,7 @@ IN: shells
     #! dimensions.
     ttf-init
     ?init-world
-    world get shape-dim 2unseq 0 SDL_RESIZABLE [
+    world get rectangle-dim 2unseq 0 SDL_RESIZABLE [
         0 x set 0 y set [
             "Factor " version append dup SDL_WM_SetCaption
             start-world

diff --git a/library/vocabularies.factor b/library/vocabularies.factor
index 7f145703aec84a566f82ddf3ae1049591248450a..b7c8db3c4b5a257881857df9ce8717a5e41af368 100644 (file)
--- a/library/vocabularies.factor
+++ b/library/vocabularies.factor
@@ -1,7 +1,7 @@
 ! Copyright (C) 2004, 2005 Slava Pestov.
 ! See http://factor.sf.net/license.txt for BSD license.
-IN: words USING: hashtables kernel lists namespaces strings
-sequences ;
+IN: words
+USING: hashtables kernel lists namespaces strings sequences ;
 
 SYMBOL: vocabularies
 
@@ -10,7 +10,7 @@ SYMBOL: vocabularies
 
 : vocabs ( -- list )
     #! Push a list of vocabularies.
-    vocabularies get hash-keys [ string> ] sort ;
+    vocabularies get hash-keys [ lexi> ] sort ;
 
 : vocab ( name -- vocab )
     #! Get a vocabulary.
@@ -86,6 +86,14 @@ SYMBOL: vocabularies
     dup uncrossref
     dup word-vocabulary vocab [ word-name off ] bind ;
 
+: interned? ( word -- ? )
+    #! Test if the word is a member of its vocabulary.
+    dup dup word-name swap word-vocabulary dup [
+        vocab dup [ hash eq? ] [ 3drop f ] ifte
+    ] [
+        3drop f
+    ] ifte ;
+
 : init-search-path ( -- )
     ! For files
     "scratchpad" "file-in" set

diff --git a/library/words.factor b/library/words.factor
index 3157620f72624f9c3f9e68086272864890b28cfb..f3fb69b62b7a1dcb407cedd42d9a63ab6d807edc 100644 (file)
--- a/library/words.factor
+++ b/library/words.factor
@@ -33,7 +33,7 @@ M: word set-word-primitive ( n w -- )
 
 : word-sort ( list -- list )
     #! Sort a list of words by name.
-    [ swap word-name swap word-name string> ] sort ;
+    [ swap word-name swap word-name lexi> ] sort ;
 
 ! The cross-referencer keeps track of word dependencies, so that
 ! words can be recompiled when redefined.

diff --git a/native/debug.c b/native/debug.c
index 674eb1c6ecc3661b90a374da144d1b1368ded8f3..8da5eeb3246b36d973a001cff67fcf3faaef4511 100644 (file)
--- a/native/debug.c
+++ b/native/debug.c
@@ -1,5 +1,25 @@
 #include "factor.h"
 
+F_FIXNUM string_compare(F_STRING* s1, F_STRING* s2)
+{
+       CELL len1 = string_capacity(s1);
+       CELL len2 = string_capacity(s2);
+
+       CELL limit = (len1 < len2 ? len1 : len2);
+
+       CELL i = 0;
+       while(i < limit)
+       {
+               u16 c1 = string_nth(s1,i);
+               u16 c2 = string_nth(s2,i);
+               if(c1 != c2)
+                       return c1 - c2;
+               i++;
+       }
+
+       return len1 - len2;
+}
+
 /* Implements some Factor library words in C, to dump a stack in a semi-human-readable
 form without any Factor code executing.. This is not used during normal execution, only
 when the runtime dies. */

diff --git a/native/primitives.c b/native/primitives.c
index d4a1f5407e09b1ee9ad4e95bcc7cce4c07ee8c27..52d8b044d765238fec4eabd381aed38b44f3b01a 100644 (file)
--- a/native/primitives.c
+++ b/native/primitives.c
@@ -10,7 +10,6 @@ void* primitives[] = {
        primitive_dispatch,
        primitive_cons,
        primitive_vector,
-       primitive_string_compare,
        primitive_rehash_string,
        primitive_sbuf,
        primitive_sbuf_to_string,

diff --git a/native/string.c b/native/string.c
index 0947adcce2943307762dbed6160ca76c128311cb..555c81b605609edfccdf89da8c1ce9479aabec8b 100644 (file)
--- a/native/string.c
+++ b/native/string.c
@@ -177,31 +177,3 @@ void primitive_set_char_slot(void)
        CELL value = untag_fixnum_fast(dpop());
        set_string_nth(string,index,value);
 }
-
-F_FIXNUM string_compare(F_STRING* s1, F_STRING* s2)
-{
-       CELL len1 = string_capacity(s1);
-       CELL len2 = string_capacity(s2);
-
-       CELL limit = (len1 < len2 ? len1 : len2);
-
-       CELL i = 0;
-       while(i < limit)
-       {
-               u16 c1 = string_nth(s1,i);
-               u16 c2 = string_nth(s2,i);
-               if(c1 != c2)
-                       return c1 - c2;
-               i++;
-       }
-
-       return len1 - len2;
-}
-
-void primitive_string_compare(void)
-{
-       F_STRING* s2 = untag_string(dpop());
-       F_STRING* s1 = untag_string(dpop());
-
-       dpush(tag_fixnum(string_compare(s1,s2)));
-}

diff --git a/native/string.h b/native/string.h
index 93bc61c13907c221e9f5a7a903e8aefaa4147870..b664a7574377e5cf1d304580ac0b15e12c257282 100644 (file)
--- a/native/string.h
+++ b/native/string.h
@@ -60,5 +60,3 @@ INLINE void set_string_nth(F_STRING* string, CELL index, u16 value)
 
 void primitive_char_slot(void);
 void primitive_set_char_slot(void);
-F_FIXNUM string_compare(F_STRING* s1, F_STRING* s2);
-void primitive_string_compare(void);