Merge branch 'master' of git://factorcode.org/git/factor

basis/editors/notepad/tags.txt

@@ -0,0 +1 @@
+unportable

basis/farkup/authors.txt

@@ -1,2 +1,2 @@
 Doug Coleman
-Slava Pestov
+Daniel Ehrenberg

basis/images/bitmap/bitmap.factor

@@ -83,14 +83,15 @@ ERROR: bmp-not-supported n ;
 
 :: fixup-color-index ( loading-bitmap -- loading-bitmap )
     loading-bitmap width>> :> width
+    width 3 * :> width*3
     loading-bitmap height>> abs :> height
     loading-bitmap color-index>> length :> color-index-length
-    height 3 * :> height*3
-    color-index-length width height*3 * - height*3 /i :> misaligned
-    misaligned 0 > [
+    color-index-length height /i :> stride
+    color-index-length width*3 height * - height /i :> padding
+    padding 0 > [
         loading-bitmap [
-            loading-bitmap width>> misaligned + 3 * <sliced-groups>
-            [ 3 misaligned * head* ] map concat
+            stride <sliced-groups>
+            [ width*3 head-slice ] map concat
         ] change-color-index
     ] [
         loading-bitmap

basis/images/tiff/tiff.factor

@@ -477,26 +477,24 @@ ERROR: unknown-component-order ifd ;
         [ unknown-component-order ]
     } case ;
 
+: normalize-alpha-data ( seq -- byte-array )
+    ! [ normalize-alpha-data ] change-bitmap
+    B{ } like dup
+    byte-array>float-array
+    4 <sliced-groups>
+    [
+        dup fourth dup 0 = [
+            2drop
+        ] [
+            [ 3 head-slice ] dip '[ _ / ] change-each
+        ] if
+    ] each ;
+
 : handle-alpha-data ( ifd -- ifd )
     dup extra-samples find-tag {
-        { extra-samples-associated-alpha-data [
-            [
-                B{ } like dup
-                byte-array>float-array
-                4 <sliced-groups>
-                [
-                    dup fourth dup 0 = [
-                        2drop
-                    ] [
-                        [ 3 head-slice ] dip '[ _ / ] change-each
-                    ] if
-                ] each
-            ] change-bitmap
-        ] }
-        { extra-samples-unspecified-alpha-data [
-        ] }
-        { extra-samples-unassociated-alpha-data [
-        ] }
+        { extra-samples-associated-alpha-data [ ] }
+        { extra-samples-unspecified-alpha-data [ ] }
+        { extra-samples-unassociated-alpha-data [ ] }
         [ bad-extra-samples ]
     } case ;
 

basis/peg/ebnf/ebnf.factor

@@ -530,7 +530,7 @@ M: ebnf-non-terminal (transform) ( ast -- parser )
 
 : EBNF: 
   reset-tokenizer CREATE-WORD dup ";EBNF" parse-multiline-string  
-  ebnf>quot swapd 1 1 <effect> define-declared "ebnf-parser" set-word-prop 
+  ebnf>quot swapd (( input -- ast )) define-declared "ebnf-parser" set-word-prop 
   reset-tokenizer ; parsing
 
 

basis/regexp/compiler/compiler.factor

@@ -107,13 +107,11 @@ C: <box> box
     transitions>quot ;
 
 : states>code ( words dfa -- )
-    [
-        '[
-            dup _ word>quot
-            (( last-match index string -- ? ))
-            define-declared
-        ] each
-    ] with-compilation-unit ;
+    '[
+        dup _ word>quot
+        (( last-match index string -- ? ))
+        define-declared
+    ] each ;
 
 : states>words ( dfa -- words dfa )
     dup transitions>> keys [ gensym ] H{ } map>assoc
@@ -126,12 +124,9 @@ C: <box> box
 
 PRIVATE>
 
-: simple-define-temp ( quot effect -- word )
-    [ define-temp ] with-compilation-unit ;
-
 : dfa>word ( dfa -- quot )
     dfa>main-word execution-quot '[ drop [ f ] 2dip @ ]
-    (( start-index string regexp -- i/f )) simple-define-temp ;
+    (( start-index string regexp -- i/f )) define-temp ;
 
 : dfa>shortest-word ( dfa -- word )
     t shortest? [ dfa>word ] with-variable ;

basis/regexp/regexp.factor

@@ -4,7 +4,7 @@ USING: accessors combinators kernel kernel.private math sequences
 sequences.private strings sets assocs prettyprint.backend
 prettyprint.custom make lexer namespaces parser arrays fry locals
 regexp.parser splitting sorting regexp.ast regexp.negation
-regexp.compiler words call call.private math.ranges ;
+regexp.compiler compiler.units words call call.private math.ranges ;
 IN: regexp
 
 TUPLE: regexp
@@ -35,7 +35,7 @@ M: lookbehind question>quot ! Returns ( index string -- ? )
 : match-index-from ( i string regexp -- index/f )
     ! This word is unsafe. It assumes that i is a fixnum
     ! and that string is a string.
-    dup dfa>> execute-unsafe( index string regexp -- i/f ) ;
+    dup dfa>> execute-unsafe( index string regexp -- i/f ) ; inline
 
 GENERIC: end/start ( string regexp -- end start )
 M: regexp end/start drop length 0 ;
@@ -129,31 +129,28 @@ PRIVATE>
 GENERIC: compile-regexp ( regex -- regexp )
 
 : regexp-initial-word ( i string regexp -- i/f )
-    compile-regexp match-index-from ;
+    [ compile-regexp ] with-compilation-unit match-index-from ;
 
-: do-compile-regexp ( regexp -- regexp )
+M: regexp compile-regexp ( regexp -- regexp )
     dup '[
         dup \ regexp-initial-word =
         [ drop _ get-ast ast>dfa dfa>word ] when
     ] change-dfa ;
 
-M: regexp compile-regexp ( regexp -- regexp )
-    do-compile-regexp ;
-
 M: reverse-regexp compile-regexp ( regexp -- regexp )
-    t backwards? [ do-compile-regexp ] with-variable ;
+    t backwards? [ call-next-method ] with-variable ;
 
 DEFER: compile-next-match
 
 : next-initial-word ( i string regexp -- i start end string )
-    compile-next-match do-next-match ;
+    [ compile-next-match ] with-compilation-unit do-next-match ;
 
 : compile-next-match ( regexp -- regexp )
     dup '[
         dup \ next-initial-word = [
             drop _ [ compile-regexp dfa>> def>> ] [ reverse-regexp? ] bi
             '[ { array-capacity string regexp } declare _ _ next-match ]
-            (( i string regexp -- i start end string )) simple-define-temp
+            (( i string regexp -- i start end string )) define-temp
         ] when
     ] change-next-match ;
 

basis/ui/backend/cocoa/cocoa.factor

@@ -8,7 +8,7 @@ ui.backend ui.clipboards ui.gadgets ui.gadgets.worlds
 ui.backend.cocoa.views core-foundation core-foundation.run-loop
 core-graphics.types threads math.rectangles fry libc
 generalizations alien.c-types cocoa.views
-combinators io.thread locals ;
+combinators io.thread locals call ;
 IN: ui.backend.cocoa
 
 TUPLE: handle ;
@@ -152,7 +152,7 @@ M: cocoa-ui-backend (with-ui)
     "UI" assert.app [
         [
             init-clipboard
-            cocoa-init-hook get call
+            cocoa-init-hook get call( -- )
             start-ui
             f io-thread-running? set-global
             init-thread-timer

basis/ui/ui.factor

@@ -153,7 +153,7 @@ PRIVATE>
     "UI update" spawn drop ;
 
 : start-ui ( quot -- )
-    call notify-ui-thread start-ui-thread ;
+    call( -- ) notify-ui-thread start-ui-thread ;
 
 : restore-windows ( -- )
     [
@@ -193,6 +193,6 @@ M: object close-window
 ] "ui" add-init-hook
 
 : with-ui ( quot -- )
-    ui-running? [ call ] [ '[ init-ui @ ] (with-ui) ] if ;
+    ui-running? [ call( -- ) ] [ '[ init-ui @ ] (with-ui) ] if ;
 
 HOOK: beep ui-backend ( -- )

extra/drills/drills.factor

@@ -1,17 +1,18 @@
 USING: accessors arrays cocoa.dialogs combinators continuations
 fry grouping io.encodings.utf8 io.files io.styles kernel math
-math.parser models models.filter models.history namespaces random
+math.parser models models.arrow models.history namespaces random
 sequences splitting ui ui.gadgets.alerts ui.gadgets.book-extras
 ui.gadgets.books ui.gadgets.buttons ui.gadgets.frames
-ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks ui.gestures ;
+ui.gadgets.grids ui.gadgets.labels ui.gadgets.tracks ui.gestures
+ui.gadgets.corners ;
 
 IN: drills
 SYMBOLS: it startLength ;
 : big ( gadget -- gadget ) { "sans-serif" plain 30 } >>font ;
-: card ( model quot -- button ) <filter> <label-control> big [ next ] <book-btn> ;
+: card ( model quot -- button ) <arrow> <label-control> big [ next ] <book-btn> ;
 : op ( quot str -- gadget ) <label> big swap <book-bevel-btn> ;
 
-: show ( model -- gadget ) dup it set-global [ random ] <filter>
+: show ( model -- gadget ) dup it set-global [ random ] <arrow>
    { [ [ first ] card ]
    [ [ [ second ] [ drop [ "malformed input" throw ] "Malformed Input" alert ] recover ] card ]
    [ '[ |<< [ it get [
@@ -20,8 +21,8 @@ SYMBOLS: it startLength ;
    ] change-model ] with-return ] "Yes" op ]
    [ '[ |<< it get _ model-changed ] "No" op ] } cleave
 2array { 1 0 } <track> swap [ 0.5 track-add ] each
-3array <book*> <frame> { 450 175 } >>pref-dim swap @center grid-add
-it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <filter> <label-control> @bottom grid-add ;
+3array <book*> 3 3 <frame> { 450 175 } >>pref-dim swap @center grid-add
+it get [ length startLength get swap - number>string "/" startLength get number>string 3append ] <arrow> <label-control> @bottom grid-add ;
 
 : drill ( -- ) [ 
    open-panel [

extra/drills/tags.txt

@@ -0,0 +1 @@
+unportable

extra/peg-lexer/peg-lexer-docs.factor

@@ -1,14 +1,14 @@
 USING: peg.ebnf help.syntax help.markup strings ;
 IN: peg-lexer
-ABOUT: "peg-lexer"
 
 HELP: ON-BNF:
 { $syntax "ON-BNF: word ... ;ON-BNF" }
 { $description "Creates a parsing word using a parser for lexer control, adding the resulting ast to the stack.  Parser syntax is as in " { $link POSTPONE: EBNF: } } ;
 
 HELP: create-bnf
-{ $values { "word" string } { "parser" parser } }
+{ $values { "name" string } { "parser" parser } }
 { $description "Runtime equivalent of " { $link POSTPONE: ON-BNF: } " also useful with manually constructed parsers." } ;
 
 HELP: factor
+{ $values { "input" string } { "ast" "a sequence of tokens" } }
 { $description "Tokenizer that acts like standard factor lexer, separating tokens by whitespace." } ;

extra/slides/slides.factor

@@ -1,9 +1,9 @@
-! Copyright (C) 2007, 2008 Slava Pestov.
+! Copyright (C) 2007, 2009 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays hashtables help.markup help.stylesheet io
 io.styles kernel math models namespaces sequences ui ui.gadgets
 ui.gadgets.books ui.gadgets.panes ui.gestures ui.pens.gradient
-parser accessors colors ;
+parser accessors colors fry ;
 IN: slides
 
 CONSTANT: stylesheet
@@ -104,4 +104,4 @@ TUPLE: slides < book ;
 } set-gestures
 
 : slides-window ( slides -- )
-    [ <slides> "Slides" open-window ] with-ui ;
+    '[ _ <slides> "Slides" open-window ] with-ui ;

extra/ui/gadgets/alerts/alerts.factor

@@ -1,4 +1,4 @@
 USING: accessors ui ui.gadgets ui.gadgets.labels ui.gadgets.buttons ui.gadgets.packs locals sequences io.styles ;
 IN: ui.gadgets.alerts
 :: alert ( quot string -- ) <pile> { 10 10 } >>gap 1 >>align string <label> { "sans-serif" plain 18 } >>font { 200 100 } >>pref-dim add-gadget 
-   "okay" [ close-window ] quot append <bevel-button> add-gadget "" open-window ;
+   "okay" [ close-window ] quot append <border-button> add-gadget "" open-window ;

extra/ui/gadgets/book-extras/book-extras.factor

@@ -6,6 +6,6 @@ IN: ui.gadgets.book-extras
 : prev ( book -- ) model>> [ 1 - ] change-model ;
 : (book-t) ( quot -- quot ) '[ : owner ( gadget -- book ) parent>> dup book? [ owner ] unless ; owner @ ] ;
 : <book-btn> ( label quot -- button ) (book-t) <button> ;
-: <book-bevel-btn> ( label quot -- button ) (book-t) <bevel-button> ;
+: <book-bevel-btn> ( label quot -- button ) (book-t) <border-button> ;
 : >>> ( label -- button ) [ next ] <book-btn> ;
 : <<< ( label -- button ) [ prev ] <book-btn> ;

extra/ui/utils/utils.factor

@@ -1,6 +1,6 @@
-USING: accessors sequences namespaces ui.render opengl fry ;
+USING: accessors sequences namespaces ui.render opengl fry kernel ;
 IN: ui.utils
 SYMBOLS: width height ;
 : store-dim ( gadget -- ) dim>> [ first width set ] [ second height set ] bi ;
-: with-dim ( gadget quot -- ) '[ _ store-dim @ ] with-scope ;
-: with-w/h ( gadget quot -- ) '[ origin get _ with-translation ] with-dim ;
+: with-dim ( gadget quot -- ) '[ _ store-dim @ ] with-scope ; inline
+: with-w/h ( gadget quot -- ) '[ origin get _ with-translation ] with-dim ; inline

extra/webapps/wiki/view.xml

@@ -5,7 +5,7 @@
 	<t:title><t:label t:name="title" /></t:title>
 
 	<div class="description">
-		<t:farkup t:name="parsed" t:parsed="true" />
+		<t:farkup t:name="content" />
 	</div>
 
 	<p>

extra/webapps/wiki/wiki.factor

@@ -47,7 +47,7 @@ article "ARTICLES" {
 
 : <article> ( title -- article ) article new swap >>title ;
 
-TUPLE: revision id title author date content parsed description ;
+TUPLE: revision id title author date content description ;
 
 revision "REVISIONS" {
     { "id" "ID" INTEGER +db-assigned-id+ }
@@ -55,7 +55,6 @@ revision "REVISIONS" {
     { "author" "AUTHOR" { VARCHAR 256 } +not-null+ } ! uid
     { "date" "DATE" TIMESTAMP +not-null+ }
     { "content" "CONTENT" TEXT +not-null+ }
-    { "parsed" "PARSED" FACTOR-BLOB +not-null+ } ! Farkup AST
     { "description" "DESCRIPTION" TEXT }
 } define-persistent
 
@@ -72,9 +71,6 @@ M: revision feed-entry-url id>> revision-url ;
 : <revision> ( id -- revision )
     revision new swap >>id ;
 
-: compute-html ( revision -- )
-    dup content>> parse-farkup >>parsed drop ;
-
 : validate-title ( -- )
     { { "title" [ v-one-line ] } } validate-params ;
 
@@ -141,13 +137,12 @@ M: revision feed-entry-url id>> revision-url ;
     [ title>> ] [ id>> ] bi article boa insert-tuple ;
 
 : add-revision ( revision -- )
-    [ compute-html ]
     [ insert-tuple ]
     [
         dup title>> <article> select-tuple
         [ amend-article ] [ add-article ] if*
     ]
-    tri ;
+    bi ;
 
 : <edit-article-action> ( -- action )
     <page-action>