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

basis/db/sqlite/sqlite-tests.factor

@@ -123,12 +123,8 @@ hi "HELLO" {
     ] with-db
 ] unit-test
 
-[ ] [
+
-    test.db [
+! Test SQLite triggers
-        hi create-table
-        hi drop-table
-    ] with-db
-] unit-test
 
 TUPLE: show id ;
 TUPLE: user username data ;
@@ -144,12 +140,12 @@ show "SHOW" {
 } define-persistent
 
 watch "WATCH" {
-    { "user" "USER" TEXT +not-null+
+    { "user" "USER" TEXT +not-null+ +user-assigned-id+
-        { +foreign-id+ user "USERNAME" } +user-assigned-id+ }
+        { +foreign-id+ user "USERNAME" } }
-    { "show" "SHOW" BIG-INTEGER +not-null+
+    { "show" "SHOW" BIG-INTEGER +not-null+ +user-assigned-id+
-        { +foreign-id+ show "ID" } +user-assigned-id+ }
+        { +foreign-id+ show "ID" } }
 } define-persistent
-
+    
 [ T{ user { username "littledan" } { data "foo" } } ] [
     test.db [
         user create-table
@@ -160,7 +156,7 @@ watch "WATCH" {
         show new insert-tuple
         show new select-tuple
         "littledan" f user boa select-tuple
-        swap [ username>> ] [ id>> ] bi*
+        [ id>> ] [ username>> ] bi*
         watch boa insert-tuple
         watch new select-tuple
         user>> f user boa select-tuple

basis/db/sqlite/sqlite.factor

@@ -204,7 +204,7 @@ M: sqlite-db-connection persistent-table ( -- assoc )
         CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
         BEFORE INSERT ON ${table-name}
         FOR EACH ROW BEGIN
-            SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
+            SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fki_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
             WHERE  (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
         END;
     "> interpolate
@@ -216,8 +216,8 @@ M: sqlite-db-connection persistent-table ( -- assoc )
         CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
         BEFORE INSERT ON ${table-name}
         FOR EACH ROW BEGIN
-            SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
+            SELECT RAISE(ROLLBACK, 'insert on table "${table-name}" violates foreign key constraint "fki_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
-            WHERE NEW.${foreign-table-id} IS NOT NULL
+            WHERE NEW.${table-id} IS NOT NULL
                 AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
         END;
     "> interpolate
@@ -236,8 +236,8 @@ M: sqlite-db-connection persistent-table ( -- assoc )
         CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
         BEFORE UPDATE ON ${table-name}
         FOR EACH ROW BEGIN
-            SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
+            SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fku_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
-            WHERE  (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
+            WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
         END;
     "> interpolate
     ] with-string-writer ;
@@ -248,8 +248,8 @@ M: sqlite-db-connection persistent-table ( -- assoc )
         CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
         BEFORE UPDATE ON ${table-name}
         FOR EACH ROW BEGIN
-            SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
+            SELECT RAISE(ROLLBACK, 'update on table "${table-name}" violates foreign key constraint "fku_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
-            WHERE NEW.${foreign-table-id} IS NOT NULL
+            WHERE NEW.${table-id} IS NOT NULL
                 AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
         END;
     "> interpolate
@@ -268,8 +268,8 @@ M: sqlite-db-connection persistent-table ( -- assoc )
         CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
         BEFORE DELETE ON ${foreign-table-name}
         FOR EACH ROW BEGIN
-            SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fk_${foreign-table-name}_id"')
+            SELECT RAISE(ROLLBACK, 'delete on table "${foreign-table-name}" violates foreign key constraint "fkd_${table-name}_$table-id}_${foreign-table-name}_${foreign-table-id}_id"')
-            WHERE  (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL;
+            WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = OLD.${foreign-table-id}) IS NOT NULL;
         END;
     "> interpolate
     ] with-string-writer ;
@@ -336,17 +336,19 @@ M: sqlite-db-connection persistent-table ( -- assoc )
         [ modifiers>> [ +foreign-id+ = ] deep-any? ] filter
         [
             [ class>> db-table-name "db-table" set ]
-            [ column-name>> "table-id" set ]
             [
+                [ "sql-spec" set ]
+                [ column-name>> "table-id" set ]
+                [ ] tri
                 modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter
                 [
                     [ second db-table-name "foreign-table-name" set ]
                     [ third "foreign-table-id" set ] bi
                     _ execute
                 ] each
-            ] tri
+            ] bi
         ] each
-    ] call ;
+    ] call ; inline
 
 : sqlite-create-table ( sql-specs class-name -- )
     [
@@ -378,8 +380,7 @@ M: sqlite-db-connection create-sql-statement ( class -- statement )
 
 M: sqlite-db-connection drop-sql-statement ( class -- statements )
     [
-        [ nip "drop table " 0% 0% ";" 0% ]
+        nip "drop table " 0% 0% ";" 0%
-        [ drop \ drop-sqlite-triggers db-triggers ] 2bi
     ] query-make ;
 
 M: sqlite-db-connection compound ( string seq -- new-string )

basis/editors/emacs/emacs.factor

@@ -1,17 +1,24 @@
 USING: definitions io.launcher kernel parser words sequences math
-math.parser namespaces editors make system ;
+math.parser namespaces editors make system combinators.short-circuit
+fry threads ;
 IN: editors.emacs
 
+SYMBOL: emacsclient-path
+
+HOOK: default-emacsclient os ( -- path )
+
+M: object default-emacsclient ( -- path ) "emacsclient" ;
+
 : emacsclient ( file line -- )
     [
-        \ emacsclient get "emacsclient" or ,
+        { [ \ emacsclient-path get ] [ default-emacsclient ] } 0|| ,
-        os windows? [ "--no-wait" , ] unless
+        "--no-wait" ,
-        "+" swap number>string append ,
+        number>string "+" prepend ,
         ,
-    ] { } make try-process ;
+    ] { } make
+    os windows? [ run-detached drop ] [ try-process ] if ;
 
 : emacs ( word -- )
     where first2 emacsclient ;
 
 [ emacsclient ] edit-hook set-global
-

basis/editors/emacs/windows/authors.txt

@@ -0,0 +1 @@
+Doug Coleman

basis/editors/emacs/windows/windows.factor

@@ -0,0 +1,12 @@
+! Copyright (C) 2009 Doug Coleman.
+! See http://factorcode.org/license.txt for BSD license.
+USING: editors.emacs io.directories.search.windows kernel sequences
+system combinators.short-circuit ;
+IN: editors.emacs.windows
+
+M: windows default-emacsclient
+    {
+        [ "Emacs" t [ "emacsclientw.exe" tail? ] find-in-program-files ]
+        [ "Emacs" t [ "emacsclient.exe" tail? ] find-in-program-files ]
+        [ "emacsclient.exe" ]
+    } 0|| ;

basis/io/directories/search/search.factor

@@ -57,8 +57,14 @@ PRIVATE>
         pusher [ [ f ] compose iterate-directory drop ] dip
     ] [ drop f ] recover ; inline
 
+ERROR: file-not-found ;
+
 : find-in-directories ( directories bfs? quot: ( obj -- ? ) -- path'/f )
-    '[ _ _ find-file ] attempt-all ;
+    [
+        '[ _ _ find-file [ file-not-found ] unless* ] attempt-all
+    ] [
+        drop f
+    ] recover ;
 
 : find-all-in-directories ( directories bfs? quot: ( obj -- ? ) -- paths/f )
     '[ _ _ find-all-files ] map concat ;

extra/math/dual/dual-docs.factor

@@ -10,84 +10,6 @@ HELP: <dual>
 }
 { $description "Creates a dual number from its ordinary and epsilon parts." } ;
 
-HELP: d*
-{ $values
-    { "x" dual } { "y" dual }
-    { "x*y" dual }
-}
-{ $description "Multiply dual numbers." } ;
-
-HELP: d+
-{ $values
-    { "x" dual } { "y" dual }
-    { "x+y" dual }
-}
-{ $description "Add dual numbers." } ;
-
-HELP: d-
-{ $values
-    { "x" dual } { "y" dual }
-    { "x-y" dual }
-}
-{ $description "Subtract dual numbers." } ;
-
-HELP: d/
-{ $values
-    { "x" dual } { "y" dual }
-    { "x/y" dual }
-}
-{ $description "Divide dual numbers." } 
-{ $errors "Throws an error if the ordinary part of " { $snippet "x" } " is zero." } ;
-
-HELP: d^
-{ $values
-    { "x" dual } { "y" dual }
-    { "x^y" dual }
-}
-{ $description "Raise a dual number to a (possibly dual) power" } ;
-
-HELP: dabs
-{ $values
-     { "x" dual }
-     { "|x|" dual }
-}
-{ $description "Absolute value of a dual number." } ;
-
-HELP: dacosh
-{ $values
-     { "x" dual }
-     { "y" dual }
-}
-{ $description "Inverse hyberbolic cosine of a dual number." } ;
-
-HELP: dasinh
-{ $values
-     { "x" dual }
-     { "y" dual }
-}
-{ $description "Inverse hyberbolic sine of a dual number." } ;
-
-HELP: datanh
-{ $values
-     { "x" dual }
-     { "y" dual }
-}
-{ $description "Inverse hyberbolic tangent of a dual number." } ;
-
-HELP: dneg
-{ $values
-     { "x" dual }
-     { "-x" dual }
-}
-{ $description "Negative of a dual number." } ;
-
-HELP: drecip
-{ $values
-     { "x" dual }
-     { "1/x" dual }
-}
-{ $description "Reciprocal of a dual number." } ;
-
 HELP: define-dual
 { $values
     { "word" word }
@@ -128,5 +50,4 @@ $nl
 "Dual numbers are ordered pairs " { $snippet "<o,e>"} "--an ordinary part and an epsilon part--with component-wise addition and multiplication defined by "{ $snippet "<o1,e1>*<o2,e2> = <o1*o2,e1*o2 + e2*o1>" } ". They are analagous to complex numbers with " { $snippet "i^2 = 0" } "instead of " { $snippet "i^2 = -1" } ". For well-behaved functions " { $snippet "f" } ", " { $snippet "f(<o1,e1>) = f(o1) + e1*f'(o1)" } ", where " { $snippet "f'"} " is the derivative of " { $snippet "f" } "."
 ;
 
-
 ABOUT: "math.dual"

extra/math/dual/dual.factor

@@ -1,8 +1,9 @@
 ! Copyright (C) 2009 Jason W. Merrill.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math math.functions math.derivatives accessors
-    macros words effects vocabs sequences generalizations fry
+    macros generic compiler.units words effects vocabs
-    combinators.smart generic compiler.units ;
+    sequences arrays assocs generalizations fry make
+    combinators.smart help help.markup ;
 
 IN: math.dual
 
@@ -48,6 +49,19 @@ MACRO: chain-rule ( word -- e )
     tri
     '[ [ @ _ @ ] sum-outputs ] ;
 
+: set-dual-help ( word dword -- ) 
+    [ swap
+        [ stack-effect [ in>> ] [ out>> ] bi append 
+            [ dual ] { } map>assoc { $values } prepend
+        ]
+        [ [ { $description } % "Version of " , 
+                   { $link } swap suffix , 
+                   " extended to work on dual numbers." , ] 
+            { } make
+        ]
+        bi* 2array
+    ] keep set-word-help ;
+
 PRIVATE>
 
 MACRO: dual-op ( word -- )
@@ -58,13 +72,11 @@ MACRO: dual-op ( word -- )
     '[ _ @ @ <dual> ] ;
 
 : define-dual ( word -- )
-    [ 
+    dup name>> "d" prepend "math.dual" create
-        [ stack-effect ] 
+    [ [ stack-effect ] dip set-stack-effect ]
-        [ name>> "d" prepend "math.dual" create ]
+    [ set-dual-help ]
-        bi [ set-stack-effect ] keep
+    [ swap '[ _ dual-op ] define ]
-    ]
+    2tri ;
-    keep
-    '[ _ dual-op ] define ;
 
 ! Specialize math functions to operate on dual numbers.
 [ all-words [ "derivative" word-prop ] filter