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

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

db4
Slava Pestov 2008-10-20 01:58:24 -05:00
parent f721105993 84a9a49416
commit a4f1d4f243
64 changed files with 672 additions and 317 deletions

7
basis/http/server/static/static.factor
View File

@ -59,8 +59,8 @@ TUPLE: file-responder root hook special allow-listings ;
\ serve-file NOTICE add-input-logging
: file. ( name dirp -- )
[ "/" append ] when
: file. ( name -- )
dup link-info directory? [ "/" append ] when
dup <a =href a> escape-string write </a> ;
: directory. ( path -- )
@ -68,8 +68,7 @@ TUPLE: file-responder root hook special allow-listings ;
[ <h1> file-name escape-string write </h1> ]
[
<ul>
directory sort-keys
[ <li> file. </li> ] assoc-each
directory-files [ <li> file. </li> ] each
</ul>
] bi
] simple-page ;

7
basis/io/monitors/recursive/recursive.factor
View File

@ -19,11 +19,14 @@ DEFER: add-child-monitor
: add-child-monitors ( path -- )
#! We yield since this directory scan might take a while.
directory* [ first add-child-monitor ] each yield ;
dup [
[ append-path ] with map
[ add-child-monitor ] each yield
] with-directory-files ;
: add-child-monitor ( path -- )
notify? [ dup { +add-file+ } monitor tget queue-change ] when
qualify-path dup link-info type>> +directory+ eq? [
qualify-path dup link-info directory? [
[ add-child-monitors ]
[
[

23
basis/io/unix/files/files.factor
View File

@ -6,7 +6,7 @@ math.bitwise byte-arrays alien combinators calendar
io.encodings.binary accessors sequences strings system
io.files.private destructors vocabs.loader calendar.unix
unix.stat alien.c-types arrays unix.users unix.groups
environment ;
environment fry io.encodings.utf8 alien.strings ;
IN: io.unix.files
M: unix cwd ( -- path )
@ -138,6 +138,27 @@ os {
{ linux [ ] }
} case
: with-unix-directory ( path quot -- )
[ opendir dup [ (io-error) ] unless ] dip
dupd curry swap '[ _ closedir io-error ] [ ] cleanup ; inline
: find-next-file ( DIR* -- byte-array )
"dirent" <c-object>
f <void*>
[ readdir_r 0 = [ (io-error) ] unless ] 2keep
*void* [ drop f ] unless ;
M: unix >directory-entry ( byte-array -- directory-entry )
[ dirent-d_name utf8 alien>string ]
[ dirent-d_type ] bi directory-entry boa ;
M: unix (directory-entries) ( path -- seq )
[
'[ _ find-next-file dup ]
[ >directory-entry ]
[ drop ] produce
] with-unix-directory ;
<PRIVATE
: stat-mode ( path -- mode )

36
basis/io/windows/files/files.factor
View File

@ -1,10 +1,11 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types io.binary io.backend io.files io.buffers
io.windows kernel math splitting
io.windows kernel math splitting fry alien.strings
windows windows.kernel32 windows.time calendar combinators
math.functions sequences namespaces make words symbols system
io.ports destructors accessors math.bitwise ;
io.ports destructors accessors math.bitwise continuations
windows.errors arrays ;
IN: io.windows.files
: open-file ( path access-mode create-mode flags -- handle )
@ -113,8 +114,35 @@ M: windows delete-directory ( path -- )
normalize-path
RemoveDirectory win32-error=0/f ;
M: windows normalize-directory ( string -- string )
normalize-path "\\" ?tail drop "\\*" append ;
M: windows >directory-entry ( byte-array -- directory-entry )
[ WIN32_FIND_DATA-cFileName utf16n alien>string ]
[ WIN32_FIND_DATA-dwFileAttributes ]
bi directory-entry boa ;
: find-first-file ( path -- WIN32_FIND_DATA handle )
"WIN32_FIND_DATA" <c-object> tuck
FindFirstFile
[ INVALID_HANDLE_VALUE = [ win32-error ] when ] keep ;
: find-next-file ( path -- WIN32_FIND_DATA/f )
"WIN32_FIND_DATA" <c-object> tuck
FindNextFile 0 = [
GetLastError ERROR_NO_MORE_FILES = [
win32-error
] unless drop f
] when ;
M: windows (directory-entries) ( path -- seq )
"\\" ?tail drop "\\*" append
find-first-file [ >directory-entry ] dip
[
'[
[ _ find-next-file dup ]
[ >directory-entry ]
[ drop ] produce
over name>> "." = [ nip ] [ swap prefix ] if
]
] [ '[ _ FindClose win32-error=0/f ] ] bi [ ] cleanup ;
SYMBOLS: +read-only+ +hidden+ +system+
+archive+ +device+ +normal+ +temporary+

2
basis/io/windows/files/unique/unique.factor
View File

@ -1,6 +1,6 @@
USING: kernel system io.files.unique.backend
windows.kernel32 io.windows io.windows.files io.ports windows
destructors ;
destructors environment ;
IN: io.windows.files.unique
M: windows (make-unique-file) ( path -- )

4
basis/io/windows/nt/launcher/launcher-tests.factor
View File

@ -1,7 +1,7 @@
IN: io.windows.launcher.nt.tests
USING: io.launcher tools.test calendar accessors
USING: io.launcher tools.test calendar accessors environment
namespaces kernel system arrays io io.files io.encodings.ascii
sequences parser assocs hashtables math continuations eval ;
IN: io.windows.launcher.nt.tests
[ ] [
<process>

7
basis/io/windows/nt/launcher/test/env.factor
View File

@ -1,3 +1,4 @@
USE: system
USE: prettyprint
os-envs .
USE: system
USE: prettyprint
USE: environment
os-envs .

2
basis/logging/server/server.factor
View File

@ -83,7 +83,7 @@ SYMBOL: log-files
: (rotate-logs) ( -- )
(close-logs)
log-root directory [ drop rotate-log ] assoc-each ;
log-root directory-files [ rotate-log ] each ;
: log-server-loop ( -- )
receive unclip {

2
basis/stack-checker/known-words/known-words.factor
View File

@ -396,8 +396,6 @@ do-primitive alien-invoke alien-indirect alien-callback
\ (exists?) { string } { object } define-primitive
\ (directory) { string } { array } define-primitive
\ gc { } { } define-primitive
\ gc-stats { } { array } define-primitive

11
basis/tools/vocabs/vocabs.factor
View File

@ -14,8 +14,7 @@ IN: tools.vocabs
: vocab-tests-dir ( vocab -- paths )
dup vocab-dir "tests" append-path vocab-append-path dup [
dup exists? [
dup directory keys
[ ".factor" tail? ] filter
dup directory-files [ ".factor" tail? ] filter
[ append-path ] with map
] [ drop f ] if
] [ drop f ] if ;
@ -208,11 +207,15 @@ M: vocab-link summary vocab-summary ;
dup vocab-authors-path set-vocab-file-contents ;
: subdirs ( dir -- dirs )
directory [ second ] filter keys natural-sort ;
[
[ link-info directory? ] filter
] with-directory-files natural-sort ;
: (all-child-vocabs) ( root name -- vocabs )
[ vocab-dir append-path subdirs ] keep
[
vocab-dir append-path dup exists?
[ subdirs ] [ drop { } ] if
] keep [
swap [ "." swap 3append ] with map
] unless-empty ;

12
basis/unix/bsd/bsd.factor
View File

@ -3,8 +3,6 @@
USING: alien.syntax combinators system vocabs.loader ;
IN: unix
! FreeBSD
: MAXPATHLEN 1024 ; inline
: O_RDONLY HEX: 0000 ; inline
@ -85,6 +83,16 @@ C-STRUCT: passwd
: SEEK_CUR 1 ; inline
: SEEK_END 2 ; inline
: DT_UNKNOWN 0 ; inline
: DT_FIFO 1 ; inline
: DT_CHR 2 ; inline
: DT_DIR 4 ; inline
: DT_BLK 6 ; inline
: DT_REG 8 ; inline
: DT_LNK 10 ; inline
: DT_SOCK 12 ; inline
: DT_WHT 14 ; inline
os {
{ macosx [ "unix.bsd.macosx" require ] }
{ freebsd [ "unix.bsd.freebsd" require ] }

7
basis/unix/bsd/freebsd/freebsd.factor
View File

@ -13,6 +13,13 @@ C-STRUCT: addrinfo
{ "void*" "addr" }
{ "addrinfo*" "next" } ;
C-STRUCT: dirent
{ "u_int32_t" "d_fileno" }
{ "u_int16_t" "d_reclen" }
{ "u_int8_t" "d_type" }
{ "u_int8_t" "d_namlen" }
{ { "char" 256 } "d_name" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

41
basis/unix/bsd/macosx/macosx.factor
View File

@ -13,6 +13,32 @@ C-STRUCT: addrinfo
{ "void*" "addr" }
{ "addrinfo*" "next" } ;
: _UTX_USERSIZE 256 ; inline
: _UTX_LINESIZE 32 ; inline
: _UTX_IDSIZE 4 ; inline
: _UTX_HOSTSIZE 256 ; inline
C-STRUCT: utmpx
{ { "char" _UTX_USERSIZE } "ut_user" }
{ { "char" _UTX_IDSIZE } "ut_id" }
{ { "char" _UTX_LINESIZE } "ut_line" }
{ "pid_t" "ut_pid" }
{ "short" "ut_type" }
{ "timeval" "ut_tv" }
{ { "char" _UTX_HOSTSIZE } "ut_host" }
{ { "uint" 16 } "ut_pad" } ;
: __DARWIN_MAXPATHLEN 1024 ; inline
: __DARWIN_MAXNAMELEN 255 ; inline
: __DARWIN_MAXNAMELEN+1 255 ; inline
C-STRUCT: dirent
{ "ino_t" "d_ino" }
{ "__uint16_t" "d_reclen" }
{ "__uint8_t" "d_type" }
{ "__uint8_t" "d_namlen" }
{ { "char" __DARWIN_MAXNAMELEN+1 } "d_name" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline
@ -117,18 +143,3 @@ C-STRUCT: addrinfo
: ETIME 101 ; inline
: EOPNOTSUPP 102 ; inline
: ENOPOLICY 103 ; inline
: _UTX_USERSIZE 256 ; inline
: _UTX_LINESIZE 32 ; inline
: _UTX_IDSIZE 4 ; inline
: _UTX_HOSTSIZE 256 ; inline
C-STRUCT: utmpx
{ { "char" _UTX_USERSIZE } "ut_user" }
{ { "char" _UTX_IDSIZE } "ut_id" }
{ { "char" _UTX_LINESIZE } "ut_line" }
{ "pid_t" "ut_pid" }
{ "short" "ut_type" }
{ "timeval" "ut_tv" }
{ { "char" _UTX_HOSTSIZE } "ut_host" }
{ { "uint" 16 } "ut_pad" } ;

7
basis/unix/bsd/netbsd/netbsd.factor
View File

@ -13,6 +13,13 @@ C-STRUCT: addrinfo
{ "void*" "addr" }
{ "addrinfo*" "next" } ;
C-STRUCT: dirent
{ "__uint32_t" "d_fileno" }
{ "__uint16_t" "d_reclen" }
{ "__uint8_t" "d_type" }
{ "__uint8_t" "d_namlen" }
{ { "char" 256 } "d_name" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

7
basis/unix/bsd/openbsd/openbsd.factor
View File

@ -13,6 +13,13 @@ C-STRUCT: addrinfo
{ "char*" "canonname" }
{ "addrinfo*" "next" } ;
C-STRUCT: dirent
{ "__uint32_t" "d_fileno" }
{ "__uint16_t" "d_reclen" }
{ "__uint8_t" "d_type" }
{ "__uint8_t" "d_namlen" }
{ { "char" 256 } "d_name" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

4
basis/unix/linux/fs/fs.factor
View File

@ -1,6 +1,4 @@
USING: alien.syntax ;
IN: unix.linux.fs
: MS_RDONLY 1 ; ! Mount read-only.
@ -22,4 +20,4 @@ FUNCTION: int mount
! FUNCTION: int umount2 ( char* file, int flags ) ;
FUNCTION: int umount ( char* file ) ;
FUNCTION: int umount ( char* file ) ;

7
basis/unix/linux/linux.factor
View File

@ -92,6 +92,13 @@ C-STRUCT: passwd
{ "char*" "pw_dir" }
{ "char*" "pw_shell" } ;
C-STRUCT: dirent
{ "__ino_t" "d_ino" }
{ "__off_t" "d_off" }
{ "ushort" "d_reclen" }
{ "uchar" "d_type" }
{ { "char" 256 } "d_name" } ;
: EPERM 1 ; inline
: ENOENT 2 ; inline
: ESRCH 3 ; inline

13
basis/unix/stat/linux/32/32.factor
View File

@ -1,6 +1,4 @@
USING: kernel alien.syntax math ;
IN: unix.stat
! Ubuntu 8.04 32-bit
@ -31,3 +29,14 @@ FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
: stat ( pathname buf -- int ) 3 -rot __xstat ;
: lstat ( pathname buf -- int ) 3 -rot __lxstat ;
C-STRUCT: statfs
{ "long" "f_type" }
{ "long" "f_bsize" }
{ "long" "f_blocks" }
{ "long" "f_bfree" }
{ "long" "f_bavail" }
{ "long" "f_files" }
{ "long" "f_ffree" }
{ "fsid_t" "f_fsid" }
{ "long" "f_namelen" } ;

24
basis/unix/stat/linux/64/64.factor
View File

@ -1,6 +1,5 @@
USING: kernel alien.syntax math ;
USING: kernel alien.syntax math sequences unix
alien.c-types arrays accessors combinators ;
IN: unix.stat
! Ubuntu 7.10 64-bit
@ -29,3 +28,22 @@ FUNCTION: int __lxstat ( int ver, char* pathname, stat* buf ) ;
: stat ( pathname buf -- int ) 1 -rot __xstat ;
: lstat ( pathname buf -- int ) 1 -rot __lxstat ;
TYPEDEF: ssize_t __SWORD_TYPE
TYPEDEF: ulonglong __fsblkcnt64_t
TYPEDEF: ulonglong __fsfilcnt64_t
C-STRUCT: statfs64
{ "__SWORD_TYPE" "f_type" }
{ "__SWORD_TYPE" "f_bsize" }
{ "__fsblkcnt64_t" "f_blocks" }
{ "__fsblkcnt64_t" "f_bfree" }
{ "__fsblkcnt64_t" "f_bavail" }
{ "__fsfilcnt64_t" "f_files" }
{ "__fsfilcnt64_t" "f_ffree" }
{ "__fsid_t" "f_fsid" }
{ "__SWORD_TYPE" "f_namelen" }
{ "__SWORD_TYPE" "f_frsize" }
{ { "__SWORD_TYPE" 5 } "f_spare" } ;
FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;

15
basis/unix/stat/linux/linux.factor
View File

@ -1,11 +1,14 @@
USING: layouts combinators vocabs.loader ;
USING: alien.syntax layouts combinators vocabs.loader ;
IN: unix.stat
C-STRUCT: fsid
{ { "int" 2 } "__val" } ;
TYPEDEF: fsid __fsid_t
TYPEDEF: fsid fsid_t
cell-bits
{
{
{ 32 [ "unix.stat.linux.32" require ] }
{ 64 [ "unix.stat.linux.64" require ] }
}
case
} case

114
basis/unix/stat/macosx/macosx.factor
View File

@ -1,4 +1,5 @@
USING: kernel alien.syntax math ;
USING: kernel alien.syntax math unix math.bitwise
alien.c-types alien sequences grouping accessors combinators ;
IN: unix.stat
! Mac OS X ppc
@ -30,3 +31,114 @@ FUNCTION: int lstat64 ( char* pathname, stat* buf ) ;
: stat ( path buf -- n ) stat64 ;
: lstat ( path buf -- n ) lstat64 ;
: MNT_RDONLY HEX: 00000001 ; inline
: MNT_SYNCHRONOUS HEX: 00000002 ; inline
: MNT_NOEXEC HEX: 00000004 ; inline
: MNT_NOSUID HEX: 00000008 ; inline
: MNT_NODEV HEX: 00000010 ; inline
: MNT_UNION HEX: 00000020 ; inline
: MNT_ASYNC HEX: 00000040 ; inline
: MNT_EXPORTED HEX: 00000100 ; inline
: MNT_QUARANTINE HEX: 00000400 ; inline
: MNT_LOCAL HEX: 00001000 ; inline
: MNT_QUOTA HEX: 00002000 ; inline
: MNT_ROOTFS HEX: 00004000 ; inline
: MNT_DOVOLFS HEX: 00008000 ; inline
: MNT_DONTBROWSE HEX: 00100000 ; inline
: MNT_IGNORE_OWNERSHIP HEX: 00200000 ; inline
: MNT_AUTOMOUNTED HEX: 00400000 ; inline
: MNT_JOURNALED HEX: 00800000 ; inline
: MNT_NOUSERXATTR HEX: 01000000 ; inline
: MNT_DEFWRITE HEX: 02000000 ; inline
: MNT_MULTILABEL HEX: 04000000 ; inline
: MNT_NOATIME HEX: 10000000 ; inline
: MNT_UNKNOWNPERMISSIONS MNT_IGNORE_OWNERSHIP ; inline
: MNT_VISFLAGMASK ( -- n )
{
MNT_RDONLY MNT_SYNCHRONOUS MNT_NOEXEC
MNT_NOSUID MNT_NODEV MNT_UNION
MNT_ASYNC MNT_EXPORTED MNT_QUARANTINE
MNT_LOCAL MNT_QUOTA
MNT_ROOTFS MNT_DOVOLFS MNT_DONTBROWSE
MNT_IGNORE_OWNERSHIP MNT_AUTOMOUNTED MNT_JOURNALED
MNT_NOUSERXATTR MNT_DEFWRITE MNT_MULTILABEL MNT_NOATIME
} flags ; inline
: MNT_UPDATE HEX: 00010000 ; inline
: MNT_RELOAD HEX: 00040000 ; inline
: MNT_FORCE HEX: 00080000 ; inline
: MNT_CMDFLAGS { MNT_UPDATE MNT_RELOAD MNT_FORCE } flags ; inline
: VFS_GENERIC 0 ; inline
: VFS_NUMMNTOPS 1 ; inline
: VFS_MAXTYPENUM 1 ; inline
: VFS_CONF 2 ; inline
: VFS_SET_PACKAGE_EXTS 3 ; inline
: MNT_WAIT 1 ; inline
: MNT_NOWAIT 2 ; inline
: VFS_CTL_VERS1 HEX: 01 ; inline
: VFS_CTL_STATFS HEX: 00010001 ; inline
: VFS_CTL_UMOUNT HEX: 00010002 ; inline
: VFS_CTL_QUERY HEX: 00010003 ; inline
: VFS_CTL_NEWADDR HEX: 00010004 ; inline
: VFS_CTL_TIMEO HEX: 00010005 ; inline
: VFS_CTL_NOLOCKS HEX: 00010006 ; inline
C-STRUCT: vfsquery
{ "uint32_t" "vq_flags" }
{ { "uint32_t" 31 } "vq_spare" } ;
: VQ_NOTRESP HEX: 0001 ; inline
: VQ_NEEDAUTH HEX: 0002 ; inline
: VQ_LOWDISK HEX: 0004 ; inline
: VQ_MOUNT HEX: 0008 ; inline
: VQ_UNMOUNT HEX: 0010 ; inline
: VQ_DEAD HEX: 0020 ; inline
: VQ_ASSIST HEX: 0040 ; inline
: VQ_NOTRESPLOCK HEX: 0080 ; inline
: VQ_UPDATE HEX: 0100 ; inline
: VQ_FLAG0200 HEX: 0200 ; inline
: VQ_FLAG0400 HEX: 0400 ; inline
: VQ_FLAG0800 HEX: 0800 ; inline
: VQ_FLAG1000 HEX: 1000 ; inline
: VQ_FLAG2000 HEX: 2000 ; inline
: VQ_FLAG4000 HEX: 4000 ; inline
: VQ_FLAG8000 HEX: 8000 ; inline
: NFSV4_MAX_FH_SIZE 128 ; inline
: NFSV3_MAX_FH_SIZE 64 ; inline
: NFSV2_MAX_FH_SIZE 32 ; inline
: NFS_MAX_FH_SIZE NFSV4_MAX_FH_SIZE ; inline
: MFSNAMELEN 15 ; inline
: MNAMELEN 90 ; inline
: MFSTYPENAMELEN 16 ; inline
C-STRUCT: fsid_t
{ { "int32_t" 2 } "val" } ;
C-STRUCT: statfs64
{ "uint32_t" "f_bsize" }
{ "int32_t" "f_iosize" }
{ "uint64_t" "f_blocks" }
{ "uint64_t" "f_bfree" }
{ "uint64_t" "f_bavail" }
{ "uint64_t" "f_files" }
{ "uint64_t" "f_ffree" }
{ "fsid_t" "f_fsid" }
{ "uid_t" "f_owner" }
{ "uint32_t" "f_type" }
{ "uint32_t" "f_flags" }
{ "uint32_t" "f_fssubtype" }
{ { "char" MFSTYPENAMELEN } "f_fstypename" }
{ { "char" MAXPATHLEN } "f_mntonname" }
{ { "char" MAXPATHLEN } "f_mntfromname" }
{ { "uint32_t" 8 } "f_reserved" } ;
FUNCTION: int statfs64 ( char* path, statfs64* buf ) ;
FUNCTION: int getmntinfo64 ( statfs64** mntbufp, int flags ) ;

8
basis/unix/stat/stat.factor
View File

@ -27,11 +27,7 @@ FUNCTION: int mkdir ( char* path, mode_t mode ) ;
} case >>
: file-status ( pathname -- stat )
"stat" <c-object> [
[ stat ] unix-system-call drop
] keep ;
"stat" <c-object> [ [ stat ] unix-system-call drop ] keep ;
: link-status ( pathname -- stat )
"stat" <c-object> [
[ lstat ] unix-system-call drop
] keep ;
"stat" <c-object> [ [ lstat ] unix-system-call drop ] keep ;

1
basis/unix/statfs/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

1
basis/unix/statfs/linux/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

4
basis/unix/statfs/linux/linux-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test unix.statfs.linux ;
IN: unix.statfs.linux.tests

34
basis/unix/statfs/linux/linux.factor Normal file
View File

@ -0,0 +1,34 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types combinators kernel io.files unix.stat
math accessors system unix io.backend ;
IN: unix.statfs.linux
TUPLE: linux-file-system-info < file-system-info
type bsize blocks bfree bavail files ffree fsid
namelen frsize spare ;
: statfs>file-system-info ( struct -- statfs )
[ \ linux-file-system-info new ] dip
{
[
[ statfs64-f_bsize ]
[ statfs64-f_bavail ] bi * >>free-space
]
[ statfs64-f_type >>type ]
[ statfs64-f_bsize >>bsize ]
[ statfs64-f_blocks >>blocks ]
[ statfs64-f_bfree >>bfree ]
[ statfs64-f_bavail >>bavail ]
[ statfs64-f_files >>files ]
[ statfs64-f_ffree >>ffree ]
[ statfs64-f_fsid >>fsid ]
[ statfs64-f_namelen >>namelen ]
[ statfs64-f_frsize >>frsize ]
[ statfs64-f_spare >>spare ]
} cleave ;
M: linux file-system-info ( path -- byte-array )
normalize-path
"statfs64" <c-object> tuck statfs64 io-error
statfs>file-system-info ;

1
basis/unix/statfs/linux/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

1
basis/unix/statfs/macosx/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

4
basis/unix/statfs/macosx/macosx-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test unix.statfs.macosx ;
IN: unix.statfs.macosx.tests

52
basis/unix/statfs/macosx/macosx.factor Normal file
View File

@ -0,0 +1,52 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: alien.c-types io.encodings.utf8 io.encodings.string
kernel sequences unix.stat accessors unix combinators math
grouping system unix.statfs io.files io.backend alien.strings ;
IN: unix.statfs.macosx
TUPLE: macosx-file-system-info < file-system-info
block-size io-size blocks blocks-free blocks-available files
files-free file-system-id owner type flags filesystem-subtype
file-system-type-name mount-from ;
M: macosx mounted* ( -- array )
f <void*> dup 0 getmntinfo64 dup io-error
[ *void* ] dip
"statfs64" heap-size [ * memory>byte-array ] keep group ;
: statfs64>file-system-info ( byte-array -- file-system-info )
[ \ macosx-file-system-info new ] dip
{
[
[ statfs64-f_bavail ] [ statfs64-f_bsize ] bi *
>>free-space
]
[ statfs64-f_mntonname utf8 alien>string >>mount-on ]
[ statfs64-f_bsize >>block-size ]
[ statfs64-f_iosize >>io-size ]
[ statfs64-f_blocks >>blocks ]
[ statfs64-f_bfree >>blocks-free ]
[ statfs64-f_bavail >>blocks-available ]
[ statfs64-f_files >>files ]
[ statfs64-f_ffree >>files-free ]
[ statfs64-f_fsid >>file-system-id ]
[ statfs64-f_owner >>owner ]
[ statfs64-f_type >>type ]
[ statfs64-f_flags >>flags ]
[ statfs64-f_fssubtype >>filesystem-subtype ]
[
statfs64-f_fstypename utf8 alien>string
>>file-system-type-name
]
[
statfs64-f_mntfromname
utf8 alien>string >>mount-from
]
} cleave ;
M: macosx file-system-info ( path -- file-system-info )
normalize-path
"statfs64" <c-object> tuck statfs64 io-error
statfs64>file-system-info ;

1
basis/unix/statfs/macosx/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

4
basis/unix/statfs/statfs-tests.factor Normal file
View File

@ -0,0 +1,4 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test unix.statfs ;
IN: unix.statfs.tests

31
basis/unix/statfs/statfs.factor Normal file
View File

@ -0,0 +1,31 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: sequences system vocabs.loader combinators accessors
kernel math.order sorting ;
IN: unix.statfs
TUPLE: mounted block-size io-size blocks blocks-free
blocks-available files files-free file-system-id owner type
flags filesystem-subtype file-system-type-name mount-on
mount-from ;
HOOK: mounted* os ( -- array )
HOOK: mounted-struct>mounted os ( byte-array -- mounted )
TUPLE: file-system-info root-directory total-free-size total-size ;
: mounted ( -- array )
mounted* [ mounted-struct>mounted ] map ;
: mounted-drive ( path -- mounted/f )
mounted
[ [ mount-on>> ] bi@ <=> ] sort <reversed>
[ mount-on>> head? ] with find nip ;
os {
{ linux [ "unix.statfs.linux" require ] }
{ macosx [ "unix.statfs.macosx" require ] }
! { freebsd [ "unix.statfs.freebsd" require ] }
! { netbsd [ "unix.statfs.netbsd" require ] }
! { openbsd [ "unix.statfs.openbsd" require ] }
} case

1
basis/unix/statfs/tags.txt Normal file
View File

@ -0,0 +1 @@
unportable

10
basis/unix/types/linux/linux.factor
View File

@ -1,10 +1,6 @@
USING: alien.syntax ;
IN: unix.types
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TYPEDEF: ulonglong __uquad_type
TYPEDEF: ulong __ulongword_type
TYPEDEF: long __sword_type
@ -13,17 +9,17 @@ TYPEDEF: long __slongword_type
TYPEDEF: uint __u32_type
TYPEDEF: int __s32_type
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
TYPEDEF: __uquad_type dev_t
TYPEDEF: __ulongword_type ino_t
TYPEDEF: ino_t __ino_t
TYPEDEF: __u32_type mode_t
TYPEDEF: __uword_type nlink_t
TYPEDEF: __u32_type uid_t
TYPEDEF: __u32_type gid_t
TYPEDEF: __slongword_type off_t
TYPEDEF: off_t __off_t
TYPEDEF: __slongword_type blksize_t
TYPEDEF: __slongword_type blkcnt_t
TYPEDEF: __sword_type ssize_t
TYPEDEF: __s32_type pid_t
TYPEDEF: __slongword_type time_t
TYPEDEF: __slongword_type time_t

13
basis/unix/types/netbsd/netbsd.factor
View File

@ -3,19 +3,6 @@ IN: unix.types
! NetBSD 4.0
TYPEDEF: short __int16_t
TYPEDEF: ushort __uint16_t
TYPEDEF: int __int32_t
TYPEDEF: uint __uint32_t
TYPEDEF: longlong __int64_t
TYPEDEF: longlong __uint64_t
TYPEDEF: int int32_t
TYPEDEF: uint uint32_t
TYPEDEF: uint u_int32_t
TYPEDEF: longlong int64_t
TYPEDEF: ulonglong u_int64_t
TYPEDEF: __uint32_t __dev_t
TYPEDEF: __uint32_t dev_t
TYPEDEF: __uint32_t mode_t

13
basis/unix/types/openbsd/openbsd.factor
View File

@ -3,19 +3,6 @@ IN: unix.types
! OpenBSD 4.2
TYPEDEF: short __int16_t
TYPEDEF: ushort __uint16_t
TYPEDEF: int __int32_t
TYPEDEF: uint __uint32_t
TYPEDEF: longlong __int64_t
TYPEDEF: longlong __uint64_t
TYPEDEF: int int32_t
TYPEDEF: uint u_int32_t
TYPEDEF: uint uint32_t
TYPEDEF: longlong int64_t
TYPEDEF: ulonglong u_int64_t
TYPEDEF: __uint32_t __dev_t
TYPEDEF: __uint32_t dev_t
TYPEDEF: __uint32_t ino_t

5
basis/unix/types/types.factor
View File

@ -16,6 +16,11 @@ TYPEDEF: ushort uint16_t
TYPEDEF: uint uint32_t
TYPEDEF: ulonglong uint64_t
TYPEDEF: uchar u_int8_t
TYPEDEF: ushort u_int16_t
TYPEDEF: uint u_int32_t
TYPEDEF: ulonglong u_int64_t
TYPEDEF: char __int8_t
TYPEDEF: short __int16_t
TYPEDEF: int __int32_t

5
basis/unix/unix.factor
View File

@ -81,6 +81,7 @@ FUNCTION: int chown ( char* path, uid_t owner, gid_t group ) ;
FUNCTION: int chroot ( char* path ) ;
FUNCTION: int close ( int fd ) ;
FUNCTION: int closedir ( DIR* dirp ) ;
: close-file ( fd -- ) [ close ] unix-system-call drop ;
@ -136,6 +137,8 @@ FUNCTION: int shutdown ( int fd, int how ) ;
FUNCTION: int open ( char* path, int flags, int prot ) ;
FUNCTION: DIR* opendir ( char* path ) ;
: open-file ( path flags mode -- fd ) [ open ] unix-system-call ;
C-STRUCT: utimbuf
@ -157,6 +160,8 @@ FUNCTION: int pipe ( int* filedes ) ;
FUNCTION: void* popen ( char* command, char* type ) ;
FUNCTION: ssize_t read ( int fd, void* buf, size_t nbytes ) ;
FUNCTION: int readdir_r ( void* dirp, dirent* entry, dirent** result ) ;
FUNCTION: ssize_t readlink ( char* path, char* buf, size_t bufsize ) ;
: PATH_MAX 1024 ; inline

2
basis/windows/errors/errors.factor
View File

@ -2,9 +2,9 @@ USING: kernel ;
IN: windows.errors
: ERROR_SUCCESS 0 ; inline
: ERROR_NO_MORE_FILES 18 ; inline
: ERROR_HANDLE_EOF 38 ; inline
: ERROR_BROKEN_PIPE 109 ; inline
: ERROR_ENVVAR_NOT_FOUND 203 ; inline
: ERROR_IO_INCOMPLETE 996 ; inline
: ERROR_IO_PENDING 997 ; inline

1
core/bootstrap/primitives.factor
View File

@ -434,7 +434,6 @@ tuple
{ "getenv" "kernel.private" }
{ "setenv" "kernel.private" }
{ "(exists?)" "io.files.private" }
{ "(directory)" "io.files.private" }
{ "gc" "memory" }
{ "gc-stats" "memory" }
{ "save-image" "memory" }

30
core/io/files/files-docs.factor
View File

@ -55,8 +55,9 @@ ARTICLE: "directories" "Directories"
"Home directory:"
{ $subsection home }
"Directory listing:"
{ $subsection directory }
{ $subsection directory* }
{ $subsection directory-entries }
{ $subsection directory-files }
{ $subsection with-directory-files }
"Creating directories:"
{ $subsection make-directory }
{ $subsection make-directories }
@ -304,23 +305,22 @@ HELP: directory?
{ $values { "file-info" file-info } { "?" "a boolean" } }
{ $description "Tests if " { $snippet "file-info" } " is a directory." } ;
HELP: (directory)
HELP: (directory-entries)
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
{ $notes "This is a low-level word, and user code should call " { $link directory } " instead." } ;
{ $notes "This is a low-level word, and user code should call one of the related words instead." } ;
HELP: directory
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ name dir? }" } " pairs" } }
HELP: directory-entries
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $link directory-entry } " objects" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
HELP: directory*
{ $values { "path" "a pathname string" } { "seq" "a sequence of " { $snippet "{ path dir? }" } " pairs" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." }
{ $notes "Unlike " { $link directory } ", this word prepends the directory's path to all file names in the list." } ;
HELP: directory-files
{ $values { "path" "a pathname string" } { "seq" "a sequence of filenames" } }
{ $description "Outputs the contents of a directory named by " { $snippet "path" } "." } ;
! HELP: file-modified
! { $values { "path" "a pathname string" } { "n" "a non-negative integer or " { $link f } } }
! { $description "Outputs a file's last modification time, since midnight January 1, 1970. If the file does not exist, outputs " { $link f } "." } ;
HELP: with-directory-files
{ $values { "path" "a pathname string" } { "quot" quotation } }
{ $description "Calls the quotation with the directory file names on the stack and with the directory set as the " { $link current-directory } ". Restores the current directory after the quotation is called." } ;
HELP: resource-path
{ $values { "path" "a pathname string" } { "newpath" "a pathname string" } }
@ -329,10 +329,6 @@ HELP: resource-path
HELP: pathname
{ $class-description "Class of path name objects. Path name objects can be created by calling " { $link <pathname> } "." } ;
HELP: normalize-directory
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
{ $description "Called by the " { $link directory } " word to prepare a pathname before passing it to the " { $link (directory) } " primitive." } ;
HELP: normalize-path
{ $values { "str" "a pathname string" } { "newstr" "a new pathname string" } }
{ $description "Called by words such as " { $link <file-reader> } " and " { $link <file-writer> } " to prepare a pathname before passing it to underlying code." } ;

14
core/io/files/files-tests.factor
View File

@ -151,18 +151,24 @@ USE: debugger.threads
"delete-tree-test" temp-file delete-tree
] unit-test
[ { { "kernel" t } } ] [
[ { "kernel" } ] [
"core" resource-path [
"." directory [ first "kernel" = ] filter
"." directory-files [ "kernel" = ] filter
] with-directory
] unit-test
[ { { "kernel" t } } ] [
[ { "kernel" } ] [
"resource:core" [
"." directory [ first "kernel" = ] filter
"." directory-files [ "kernel" = ] filter
] with-directory
] unit-test
[ { "kernel" } ] [
"resource:core" [
[ "kernel" = ] filter
] with-directory-files
] unit-test
[ ] [
"copy-tree-test/a/b/c" temp-file make-directories
] unit-test

50
core/io/files/files.factor
View File

@ -153,7 +153,8 @@ PRIVATE>
"." last-split1 nip ;
! File info
TUPLE: file-info type size permissions created modified accessed ;
TUPLE: file-info type size permissions created modified
accessed ;
HOOK: file-info io-backend ( path -- info )
@ -181,6 +182,12 @@ SYMBOL: +unknown+
: directory? ( file-info -- ? ) type>> +directory+ = ;
! File-system
TUPLE: file-system-info mount-on free-space ;
HOOK: file-system-info os ( path -- file-system-info )
<PRIVATE
HOOK: cd io-backend ( path -- )
@ -235,19 +242,22 @@ HOOK: make-directory io-backend ( path -- )
]
} cond drop ;
! Directory listings
: fixup-directory ( path seq -- newseq )
[
dup string?
[ tuck append-path file-info directory? 2array ] [ nip ] if
] with map
[ first { "." ".." } member? not ] filter ;
TUPLE: directory-entry name type ;
: directory ( path -- seq )
normalize-directory dup (directory) fixup-directory ;
HOOK: >directory-entry os ( byte-array -- directory-entry )
: directory* ( path -- seq )
dup directory [ first2 >r append-path r> 2array ] with map ;
HOOK: (directory-entries) os ( path -- seq )
: directory-entries ( path -- seq )
normalize-path
(directory-entries)
[ name>> { "." ".." } member? not ] filter ;
: directory-files ( path -- seq )
directory-entries [ name>> ] map ;
: with-directory-files ( path quot -- )
[ "" directory-files ] prepose with-directory ; inline
! Touching files
HOOK: touch-file io-backend ( path -- )
@ -259,12 +269,10 @@ HOOK: delete-directory io-backend ( path -- )
: delete-tree ( path -- )
dup link-info type>> +directory+ = [
dup directory over [
[ first delete-tree ] each
] with-directory delete-directory
] [
delete-file
] if ;
[ [ [ delete-tree ] each ] with-directory-files ]
[ delete-directory ]
bi
] [ delete-file ] if ;
: to-directory ( from to -- from to' )
over file-name append-path ;
@ -303,9 +311,9 @@ DEFER: copy-tree-into
{
{ +symbolic-link+ [ copy-link ] }
{ +directory+ [
>r dup directory r> rot [
[ >r first r> copy-tree-into ] curry each
] with-directory
swap [
[ swap copy-tree-into ] with each
] with-directory-files
] }
[ drop copy-file ]
} case ;

2
core/sequences/sequences-docs.factor
View File

@ -398,7 +398,7 @@ HELP: filter
{ $description "Applies the quotation to each element in turn, and outputs a new sequence containing the elements of the original sequence for which the quotation output a true value." } ;
HELP: filter-here
{ $values { "seq" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } { "subseq" "a new sequence" } }
{ $values { "seq" "a resizable mutable sequence" } { "quot" "a quotation with stack effect " { $snippet "( elt -- ? )" } } }
{ $description "Applies the quotation to each element in turn, and removes elements for which the quotation outputs a false value." }
{ $side-effects "seq" } ;

1
extra/crypto/passwd-md5/authors.txt Normal file
View File

@ -0,0 +1 @@
Doug Coleman

34
extra/crypto/passwd-md5/passwd-md5-docs.factor Normal file
View File

@ -0,0 +1,34 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: help.markup help.syntax io.streams.string strings ;
IN: crypto.passwd-md5
HELP: authenticate-password
{ $values
{ "shadow" string } { "password" string }
{ "?" "a boolean" } }
{ $description "Encodes the provided password and compares it to the encoded password entry from a shadowed password file." } ;
HELP: parse-shadow-password
{ $values
{ "string" string }
{ "magic" string } { "salt" string } { "password" string } }
{ $description "Splits a shadowed password entry into a magic string, a salt, and an encoded password string." } ;
HELP: passwd-md5
{ $values
{ "magic" string } { "salt" string } { "password" string }
{ "bytes" "an md5-shadowed password entry" } }
{ $description "Encodes the password with the given magic string and salt to an MD5-shadow password entry." } ;
ARTICLE: "crypto.passwd-md5" "MD5 shadow passwords"
"The " { $vocab-link "crypto.passwd-md5" } " vocabulary can encode passwords for use in an MD5 shadow password file." $nl
"Encoding a password:"
{ $subsection passwd-md5 }
"Parsing a shadowed password entry:"
{ $subsection parse-shadow-password }
"Authenticating against a shadowed password:"
{ $subsection authenticate-password } ;
ABOUT: "crypto.passwd-md5"

16
extra/crypto/passwd-md5/passwd-md5-tests.factor Normal file
View File

@ -0,0 +1,16 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: tools.test crypto.passwd-md5 ;
IN: crypto.passwd-md5.tests
[ "$1$npUpD5oQ$1.X7uXR2QG0FzPifVeZ2o1" ]
[ "$1$" "npUpD5oQ" "factor" passwd-md5 ] unit-test
[ "$1$Kilak4kR$wlEr5Dv5DcdqPjKjQtt430" ]
[
"$1$"
"Kilak4kR"
"longpassword12345678901234567890"
passwd-md5
] unit-test

47
extra/crypto/passwd-md5/passwd-md5.factor Normal file
View File

@ -0,0 +1,47 @@
! Copyright (C) 2008 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel base64 checksums.md5 symbols sequences checksums
locals prettyprint math math.bitwise grouping io combinators
fry make combinators.short-circuit math.functions splitting ;
IN: crypto.passwd-md5
<PRIVATE
: lookup-table ( n -- nth )
"./0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz" nth ; inline
: to64 ( v n -- string )
[ [ -6 shift ] [ 6 2^ 1- bitand lookup-table ] bi ]
replicate nip ; inline
PRIVATE>
:: passwd-md5 ( magic salt password -- bytes )
[let* | final! [ password magic salt 3append
salt password tuck 3append md5 checksum-bytes
password length
[ 16 / ceiling swap <repetition> concat ] keep
head-slice append
password [ length ] [ first ] bi
'[ [ CHAR: \0 _ ? , ] each-bit ] "" make append
md5 checksum-bytes ] |
1000 [
"" swap
{
[ 0 bit? password final ? append ]
[ 3 mod 0 > [ salt append ] when ]
[ 7 mod 0 > [ password append ] when ]
[ 0 bit? final password ? append ]
} cleave md5 checksum-bytes final!
] each
magic salt "$" 3append
{ 12 0 6 13 1 7 14 2 8 15 3 9 5 4 10 } final nths 3 group
[ first3 [ 16 shift ] [ 8 shift ] bi* + + 4 to64 ] map concat
11 final nth 2 to64 3append ] ;
: parse-shadow-password ( string -- magic salt password )
"$" split harvest first3 [ "$" tuck 3append ] 2dip ;
: authenticate-password ( shadow password -- ? )
'[ parse-shadow-password drop _ passwd-md5 ] keep = ;

2
extra/ftp/ftp.factor
View File

@ -59,5 +59,5 @@ TUPLE: ftp-response n strings parsed ;
3array " " join ;
: directory-list ( -- seq )
"" directory keys
"" directory-files
[ [ link-info ] keep file-info>string ] map ;

93
extra/html/parser/analyzer/analyzer.factor
View File

@ -3,7 +3,7 @@
USING: assocs html.parser kernel math sequences strings ascii
arrays generalizations shuffle unicode.case namespaces make
splitting http accessors io combinators http.client urls
urls.encoding fry ;
urls.encoding fry prettyprint ;
IN: html.parser.analyzer
TUPLE: link attributes clickable ;
@ -19,35 +19,34 @@ TUPLE: link attributes clickable ;
'[ _ [ second @ ] find-from rot drop swap 1+ ]
[ f 0 ] 2dip times drop first2 ; inline
: find-first-name ( str vector -- i/f tag/f )
[ >lower ] dip [ name>> = ] with find ; inline
: find-first-name ( vector string -- i/f tag/f )
>lower '[ name>> _ = ] find ; inline
: find-matching-close ( str vector -- i/f tag/f )
[ >lower ] dip
[ [ name>> = ] [ closing?>> ] bi and ] with find ; inline
: find-matching-close ( vector string -- i/f tag/f )
>lower
'[ [ name>> _ = ] [ closing?>> ] bi and ] find ; inline
: find-between* ( i/f tag/f vector -- vector )
pick integer? [
rot tail-slice
>r name>> r>
[ find-matching-close drop dup [ 1+ ] when ] keep
swap [ head ] [ first ] if*
: find-between* ( vector i/f tag/f -- vector )
over integer? [
[ tail-slice ] [ name>> ] bi*
dupd find-matching-close drop dup [ 1+ ] when
[ head ] [ first ] if*
] [
3drop V{ } clone
] if ; inline
: find-between ( i/f tag/f vector -- vector )
: find-between ( vector i/f tag/f -- vector )
find-between* dup length 3 >= [
[ rest-slice but-last-slice ] keep like
] when ; inline
: find-between-first ( string vector -- vector' )
[ find-first-name ] keep find-between ; inline
: find-between-first ( vector string -- vector' )
dupd find-first-name find-between ; inline
: find-between-all ( vector quot -- seq )
[ [ [ closing?>> not ] bi and ] curry find-all ] curry
[ [ >r first2 r> find-between* ] curry map ] bi ; inline
dupd
'[ _ [ closing?>> not ] bi and ] find-all
[ first2 find-between* ] with map ;
: remove-blank-text ( vector -- vector' )
[
@ -61,27 +60,40 @@ TUPLE: link attributes clickable ;
[ [ [ blank? ] trim ] change-text ] when
] map ;
: find-by-id ( id vector -- vector )
[ attributes>> "id" swap at = ] with filter ;
: find-by-id ( vector id -- vector' )
'[ attributes>> "id" at _ = ] find ;
: find-by-class ( vector id -- vector' )
'[ attributes>> "class" at _ = ] find ;
: find-by-class ( id vector -- vector )
[ attributes>> "class" swap at = ] with filter ;
: find-by-name ( vector string -- vector )
>lower '[ name>> _ = ] find ;
: find-by-name ( str vector -- vector )
[ >lower ] dip [ name>> = ] with filter ;
: find-by-id-between ( vector string -- vector' )
dupd
'[ attributes>> "id" swap at _ = ] find find-between* ;
: find-by-class-between ( vector string -- vector' )
dupd
'[ attributes>> "class" swap at _ = ] find find-between* ;
: find-by-class-id-between ( vector class id -- vector' )
'[
[ attributes>> "class" swap at _ = ]
[ attributes>> "id" swap at _ = ] bi and
] dupd find find-between* ;
: find-by-attribute-key ( key vector -- vector )
[ >lower ] dip
[ attributes>> at ] with filter
sift ;
: find-by-attribute-key ( vector key -- vector' )
>lower
[ attributes>> at _ = ] filter sift ;
: find-by-attribute-key-value ( value key vector -- vector )
[ >lower ] dip
: find-by-attribute-key-value ( vector value key -- vector' )
>lower
[ attributes>> at over = ] with filter nip
sift ;
: find-first-attribute-key-value ( value key vector -- i/f tag/f )
[ >lower ] dip
: find-first-attribute-key-value ( vector value key -- i/f tag/f )
>lower
[ attributes>> at over = ] with find rot drop ;
: tag-link ( tag -- link/f )
@ -121,9 +133,9 @@ TUPLE: link attributes clickable ;
swap [ >r first2 r> find-between* ] curry map
[ [ name>> { "form" "input" } member? ] filter ] map ;
: find-html-objects ( string vector -- vector' )
[ find-opening-tags-by-name ] keep
[ [ first2 ] dip find-between* ] curry map ;
: find-html-objects ( vector string -- vector' )
dupd find-opening-tags-by-name
[ first2 find-between* ] curry map ;
: form-action ( vector -- string )
[ name>> "form" = ] find nip
@ -150,3 +162,12 @@ TUPLE: link attributes clickable ;
: query>assoc* ( str -- hash )
"?" split1 nip query>assoc ;
: html-class? ( tag string -- ? )
swap attributes>> "class" swap at = ;
: html-id? ( tag string -- ? )
swap attributes>> "id" swap at = ;
: opening-tag? ( tag -- ? )
closing?>> not ;

4
extra/io/paths/paths.factor
View File

@ -7,7 +7,7 @@ IN: io.paths
TUPLE: directory-iterator path bfs queue ;
: qualified-directory ( path -- seq )
dup directory [ first2 [ append-path ] dip 2array ] with map ;
dup directory-files [ append-path ] with map ;
: push-directory ( path iter -- )
[ qualified-directory ] dip [
@ -21,7 +21,7 @@ TUPLE: directory-iterator path bfs queue ;
: next-file ( iter -- file/f )
dup queue>> deque-empty? [ drop f ] [
dup queue>> pop-back first2
dup queue>> pop-back dup link-info directory?
[ over push-directory next-file ] [ nip ] if
] if ;

2
extra/shell/shell.factor
View File

@ -39,7 +39,7 @@ METHOD: expand { variable-expr } expr>> os-env ;
METHOD: expand { glob-expr }
expr>>
dup "*" =
[ drop current-directory get directory [ first ] map ]
[ drop current-directory get directory-files ]
[ ]
if ;

25
extra/webapps/wiki/wiki.factor
View File

@ -374,15 +374,16 @@ M: revision feed-entry-url id>> revision-url ;
{ wiki "wiki-common" } >>template ;
: init-wiki ( -- )
"resource:extra/webapps/wiki/initial-content" directory* keys
[
dup file-name ".txt" ?tail [
swap ascii file-contents
f <revision>
swap >>content
swap >>title
"slava" >>author
now >>date
add-revision
] [ 2drop ] if
] each ;
"resource:extra/webapps/wiki/initial-content" [
[
dup ".txt" ?tail [
swap ascii file-contents
f <revision>
swap >>content
swap >>title
"slava" >>author
now >>date
add-revision
] [ 2drop ] if
] each
] with-directory-files ;

3
vm/os-freebsd.h
View File

@ -7,6 +7,3 @@ extern int getosreldate(void);
#ifndef KERN_PROC_PATHNAME
#define KERN_PROC_PATHNAME 12
#endif
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)

3
vm/os-linux.h
View File

@ -1,8 +1,5 @@
#include <sys/syscall.h>
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
int inotify_init(void);
int inotify_add_watch(int fd, const char *name, u32 mask);
int inotify_rm_watch(int fd, u32 wd);

2
vm/os-macosx.h
View File

@ -1,8 +1,6 @@
#define DLLEXPORT __attribute__((visibility("default")))
#define FACTOR_OS_STRING "macosx"
#define NULL_DLL "libfactor.dylib"
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)
void init_signals(void);
void early_init(void);

2
vm/os-openbsd.h
View File

@ -1,2 +0,0 @@
#define UNKNOWN_TYPE_P(file) ((file)->d_type == DT_UNKNOWN)
#define DIRECTORY_P(file) ((file)->d_type == DT_DIR)

2
vm/os-solaris.h
View File

@ -1,2 +0,0 @@
#define UNKNOWN_TYPE_P(file) 1
#define DIRECTORY_P(file) 0

38
vm/os-unix.c
View File

@ -61,44 +61,6 @@ DEFINE_PRIMITIVE(existsp)
box_boolean(stat(unbox_char_string(),&sb) >= 0);
}
/* Allocates memory */
CELL parse_dir_entry(struct dirent *file)
{
CELL name = tag_object(from_char_string(file->d_name));
if(UNKNOWN_TYPE_P(file))
return name;
else
{
CELL dirp = tag_boolean(DIRECTORY_P(file));
return allot_array_2(name,dirp);
}
}
DEFINE_PRIMITIVE(read_dir)
{
DIR* dir = opendir(unbox_char_string());
GROWABLE_ARRAY(result);
REGISTER_ROOT(result);
if(dir != NULL)
{
struct dirent* file;
while((file = readdir(dir)) != NULL)
{
CELL pair = parse_dir_entry(file);
GROWABLE_ARRAY_ADD(result,pair);
}
closedir(dir);
}
UNREGISTER_ROOT(result);
GROWABLE_ARRAY_TRIM(result);
dpush(result);
}
F_SEGMENT *alloc_segment(CELL size)
{
int pagesize = getpagesize();

29
vm/os-windows-nt.c
View File

@ -8,35 +8,6 @@ s64 current_millis(void)
- EPOCH_OFFSET) / 10000;
}
DEFINE_PRIMITIVE(os_envs)
{
GROWABLE_ARRAY(result);
REGISTER_ROOT(result);
TCHAR *env = GetEnvironmentStrings();
TCHAR *finger = env;
for(;;)
{
TCHAR *scan = finger;
while(*scan != '\0')
scan++;
if(scan == finger)
break;
CELL string = tag_object(from_u16_string(finger));
GROWABLE_ARRAY_ADD(result,string);
finger = scan + 1;
}
FreeEnvironmentStrings(env);
UNREGISTER_ROOT(result);
GROWABLE_ARRAY_TRIM(result);
dpush(result);
}
long exception_handler(PEXCEPTION_POINTERS pe)
{
PEXCEPTION_RECORD e = (PEXCEPTION_RECORD)pe->ExceptionRecord;

43
vm/os-windows.c
View File

@ -87,21 +87,6 @@ const F_CHAR *vm_executable_path(void)
return safe_strdup(full_path);
}
void find_file_stat(F_CHAR *path)
{
// FindFirstFile is the only call that can stat c:\pagefile.sys
WIN32_FIND_DATA st;
HANDLE h;
if(INVALID_HANDLE_VALUE == (h = FindFirstFile(path, &st)))
dpush(F);
else
{
FindClose(h);
dpush(T);
}
}
DEFINE_PRIMITIVE(existsp)
{
BY_HANDLE_FILE_INFORMATION bhfi;
@ -136,34 +121,6 @@ DEFINE_PRIMITIVE(existsp)
CloseHandle(h);
}
DEFINE_PRIMITIVE(read_dir)
{
HANDLE dir;
WIN32_FIND_DATA find_data;
F_CHAR *path = unbox_u16_string();
GROWABLE_ARRAY(result);
REGISTER_ROOT(result);
if(INVALID_HANDLE_VALUE != (dir = FindFirstFile(path, &find_data)))
{
do
{
CELL name = tag_object(from_u16_string(find_data.cFileName));
CELL dirp = tag_boolean(find_data.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY);
CELL pair = allot_array_2(name,dirp);
GROWABLE_ARRAY_ADD(result,pair);
}
while (FindNextFile(dir, &find_data));
FindClose(dir);
}
UNREGISTER_ROOT(result);
GROWABLE_ARRAY_TRIM(result);
dpush(result);
}
F_SEGMENT *alloc_segment(CELL size)
{
char *mem;

2
vm/platform.h
View File

@ -55,7 +55,6 @@
#endif
#elif defined(__OpenBSD__)
#define FACTOR_OS_STRING "openbsd"
#include "os-openbsd.h"
#if defined(FACTOR_X86)
#include "os-openbsd-x86.32.h"
@ -102,7 +101,6 @@
#error "Unsupported Solaris flavor"
#endif
#include "os-solaris.h"
#else
#error "Unsupported OS"
#endif

1
vm/primitives.c
View File

@ -57,7 +57,6 @@ void *primitives[] = {
primitive_getenv,
primitive_setenv,
primitive_existsp,
primitive_read_dir,
primitive_gc,
primitive_gc_stats,
primitive_save_image,