steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
John Benediktsson 2009-02-20 17:00:30 -08:00
parent fc5b985728 6eaa5aee24
commit 5f409d0e9d
6 changed files with 56 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
basis/db/sqlite/sqlite-tests.factor
View File

@ -123,12 +123,8 @@ hi "HELLO" {
] with-db ] with-db
] unit-test ] unit-test
[ ] [
test.db [ ! Test SQLite triggers
hi create-table
hi drop-table
] with-db
] unit-test
TUPLE: show id ; TUPLE: show id ;
TUPLE: user username data ; TUPLE: user username data ;
@ -144,10 +140,10 @@ show "SHOW" {
} define-persistent } define-persistent
watch "WATCH" { 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 } define-persistent
[ T{ user { username "littledan" } { data "foo" } } ] [ [ T{ user { username "littledan" } { data "foo" } } ] [
@ -160,7 +156,7 @@ watch "WATCH" {
show new insert-tuple show new insert-tuple
show new select-tuple show new select-tuple
"littledan" f user boa select-tuple "littledan" f user boa select-tuple
swap [ username>> ] [ id>> ] bi* [ id>> ] [ username>> ] bi*
watch boa insert-tuple watch boa insert-tuple
watch new select-tuple watch new select-tuple
user>> f user boa select-tuple user>> f user boa select-tuple

29
basis/db/sqlite/sqlite.factor
View File

@ -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 CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE INSERT ON ${table-name} BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN 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; WHERE (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END; END;
"> interpolate "> 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 CREATE TRIGGER fki_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE INSERT ON ${table-name} BEFORE INSERT ON ${table-name}
FOR EACH ROW BEGIN 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; AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END; END;
"> interpolate "> 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 CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE UPDATE ON ${table-name} BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN 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; END;
"> interpolate "> interpolate
] with-string-writer ; ] 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 CREATE TRIGGER fku_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE UPDATE ON ${table-name} BEFORE UPDATE ON ${table-name}
FOR EACH ROW BEGIN 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; AND (SELECT ${foreign-table-id} FROM ${foreign-table-name} WHERE ${foreign-table-id} = NEW.${table-id}) IS NULL;
END; END;
"> interpolate "> 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 CREATE TRIGGER fkd_${table-name}_${table-id}_${foreign-table-name}_${foreign-table-id}_id
BEFORE DELETE ON ${foreign-table-name} BEFORE DELETE ON ${foreign-table-name}
FOR EACH ROW BEGIN 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; END;
"> interpolate "> interpolate
] with-string-writer ; ] with-string-writer ;
@ -336,17 +336,19 @@ M: sqlite-db-connection persistent-table ( -- assoc )
[ modifiers>> [ +foreign-id+ = ] deep-any? ] filter [ modifiers>> [ +foreign-id+ = ] deep-any? ] filter
[ [
[ class>> db-table-name "db-table" set ] [ 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 modifiers>> [ [ +foreign-id+ = ] deep-any? ] filter
[ [
[ second db-table-name "foreign-table-name" set ] [ second db-table-name "foreign-table-name" set ]
[ third "foreign-table-id" set ] bi [ third "foreign-table-id" set ] bi
_ execute _ execute
] each ] each
] tri ] bi
] each ] each
] call ; ] call ; inline
: sqlite-create-table ( sql-specs class-name -- ) : 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 ) 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 ; ] query-make ;
M: sqlite-db-connection compound ( string seq -- new-string ) M: sqlite-db-connection compound ( string seq -- new-string )

19
basis/editors/emacs/emacs.factor
View File

@ -1,17 +1,24 @@
USING: definitions io.launcher kernel parser words sequences math 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 IN: editors.emacs
SYMBOL: emacsclient-path
HOOK: default-emacsclient os ( -- path )
M: object default-emacsclient ( -- path ) "emacsclient" ;
: emacsclient ( file line -- ) : 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 -- ) : emacs ( word -- )
where first2 emacsclient ; where first2 emacsclient ;
[ emacsclient ] edit-hook set-global [ emacsclient ] edit-hook set-global

1
basis/editors/emacs/windows/authors.txt Executable file
View File

@ -0,0 +1 @@
Doug Coleman

12
basis/editors/emacs/windows/windows.factor Executable file
View File

@ -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|| ;

8
basis/io/directories/search/search.factor
View File

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