~ chicken-core (chicken-5) 3316b9da28a6ebde974996ad65227b68f46e79b7
commit 3316b9da28a6ebde974996ad65227b68f46e79b7
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Fri Oct 22 03:05:30 2010 -0400
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Fri Oct 22 03:05:30 2010 -0400
read-symbolic-link returns non-link without error (suggested by Jim Ursetto); delete-directory allows optionally removing directory contents
diff --git a/manual/Unit posix b/manual/Unit posix
index 44c7f319..59861bef 100644
--- a/manual/Unit posix
+++ b/manual/Unit posix
@@ -100,10 +100,10 @@ is given and not false, any nonexistent parent directories are also created.
==== delete-directory
-<procedure>(delete-directory NAME)</procedure>
+<procedure>(delete-directory NAME [RECURSIVE])</procedure>
-Deletes the directory with the pathname {{NAME}}. The directory has
-to be empty.
+Deletes the directory with the pathname {{NAME}}. If {{RECURSIVE}} is
+not given or false, then the directory has to be empty.
==== directory
diff --git a/posix-common.scm b/posix-common.scm
index 3c329946..40eb2293 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -56,6 +56,50 @@ EOF
(include "common-declarations.scm")
+;;; Error codes:
+
+(define-foreign-variable _errno int "errno")
+
+(define-foreign-variable _eperm int "EPERM")
+(define-foreign-variable _enoent int "ENOENT")
+(define-foreign-variable _esrch int "ESRCH")
+(define-foreign-variable _eintr int "EINTR")
+(define-foreign-variable _eio int "EIO")
+(define-foreign-variable _enoexec int "ENOEXEC")
+(define-foreign-variable _ebadf int "EBADF")
+(define-foreign-variable _echild int "ECHILD")
+(define-foreign-variable _enomem int "ENOMEM")
+(define-foreign-variable _eacces int "EACCES")
+(define-foreign-variable _efault int "EFAULT")
+(define-foreign-variable _ebusy int "EBUSY")
+(define-foreign-variable _eexist int "EEXIST")
+(define-foreign-variable _enotdir int "ENOTDIR")
+(define-foreign-variable _eisdir int "EISDIR")
+(define-foreign-variable _einval int "EINVAL")
+(define-foreign-variable _emfile int "EMFILE")
+(define-foreign-variable _enospc int "ENOSPC")
+(define-foreign-variable _espipe int "ESPIPE")
+(define-foreign-variable _epipe int "EPIPE")
+(define-foreign-variable _eagain int "EAGAIN")
+(define-foreign-variable _erofs int "EROFS")
+(define-foreign-variable _enxio int "ENXIO")
+(define-foreign-variable _e2big int "E2BIG")
+(define-foreign-variable _exdev int "EXDEV")
+(define-foreign-variable _enodev int "ENODEV")
+(define-foreign-variable _enfile int "ENFILE")
+(define-foreign-variable _enotty int "ENOTTY")
+(define-foreign-variable _efbig int "EFBIG")
+(define-foreign-variable _emlink int "EMLINK")
+(define-foreign-variable _edom int "EDOM")
+(define-foreign-variable _erange int "ERANGE")
+(define-foreign-variable _edeadlk int "EDEADLK")
+(define-foreign-variable _enametoolong int "ENAMETOOLONG")
+(define-foreign-variable _enolck int "ENOLCK")
+(define-foreign-variable _enosys int "ENOSYS")
+(define-foreign-variable _enotempty int "ENOTEMPTY")
+(define-foreign-variable _eilseq int "EILSEQ")
+(define-foreign-variable _ewouldblock int "EWOULDBLOCK")
+
(define posix-error
(let ([strerror (foreign-lambda c-string "strerror" int)]
[string-append string-append] )
@@ -194,12 +238,21 @@ EOF
'current-directory "cannot retrieve current directory") ) ) ) ) )
(define delete-directory
- (lambda (name)
+ (lambda (name #!optional recursive)
+ (define (rmdir dir)
+ (let ((sname (##sys#make-c-string dir)))
+ (unless (fx= 0 (##core#inline "C_rmdir" sname))
+ (posix-error #:file-error 'delete-directory "cannot delete directory" dir) )))
(##sys#check-string name 'delete-directory)
- (let ((sname (##sys#make-c-string (##sys#expand-home-path name) 'delete-directory)))
- (unless (fx= 0 (##core#inline "C_rmdir" sname))
- (posix-error #:file-error 'delete-directory "cannot delete directory" name) )
- name)))
+ (let ((name (##sys#expand-home-path name)))
+ (if recursive
+ (let ((files (find-files name))) ; relies on `find-files' lists dir-contents before dir
+ (for-each
+ (lambda (f)
+ ((if (directory? f) rmdir delete-file) f))
+ files)
+ (rmdir name))
+ (rmdir name)))))
(define directory
(lambda (#!optional (spec (current-directory)) show-dotfiles?)
diff --git a/posixunix.scm b/posixunix.scm
index fd21fd58..847394fa 100644
--- a/posixunix.scm
+++ b/posixunix.scm
@@ -1150,32 +1150,6 @@ EOF
;;; More errno codes:
-(define-foreign-variable _errno int "errno")
-
-(define-foreign-variable _eperm int "EPERM")
-(define-foreign-variable _enoent int "ENOENT")
-(define-foreign-variable _esrch int "ESRCH")
-(define-foreign-variable _eintr int "EINTR")
-(define-foreign-variable _eio int "EIO")
-(define-foreign-variable _efault int "EFAULT")
-(define-foreign-variable _echild int "ECHILD")
-(define-foreign-variable _enoexec int "ENOEXEC")
-(define-foreign-variable _ebadf int "EBADF")
-(define-foreign-variable _enomem int "ENOMEM")
-(define-foreign-variable _eacces int "EACCES")
-(define-foreign-variable _ebusy int "EBUSY")
-(define-foreign-variable _eexist int "EEXIST")
-(define-foreign-variable _enotdir int "ENOTDIR")
-(define-foreign-variable _eisdir int "EISDIR")
-(define-foreign-variable _einval int "EINVAL")
-(define-foreign-variable _emfile int "EMFILE")
-(define-foreign-variable _enospc int "ENOSPC")
-(define-foreign-variable _espipe int "ESPIPE")
-(define-foreign-variable _epipe int "EPIPE")
-(define-foreign-variable _eagain int "EAGAIN")
-(define-foreign-variable _erofs int "EROFS")
-(define-foreign-variable _ewouldblock int "EWOULDBLOCK")
-
(define errno/perm _eperm)
(define errno/noent _enoent)
(define errno/srch _esrch)
@@ -1289,16 +1263,20 @@ EOF
(define-foreign-variable _filename_max int "FILENAME_MAX")
(define read-symbolic-link
- (let ([buf (make-string (fx+ _filename_max 1))] )
+ (let ((buf (make-string (fx+ _filename_max 1))))
(lambda (fname #!optional canonicalize)
(##sys#check-string fname 'read-symbolic-link)
- (let ([len (##core#inline "C_do_readlink" (##sys#make-c-string (##sys#expand-home-path fname) 'read-symbolic-link) buf)])
- (when (fx< len 0)
- (posix-error #:file-error 'read-symbolic-link "cannot read symbolic link" fname) )
- (let ((pathname (substring buf 0 len)))
- (if (and canonicalize (symbolic-link? pathname))
- (read-symbolic-link pathname 'canonicalize)
- pathname ) ) ) ) ) )
+ (let ((len (##core#inline
+ "C_do_readlink"
+ (##sys#make-c-string (##sys#expand-home-path fname) 'read-symbolic-link) buf)))
+ (if (fx< len 0)
+ (if canonicalize
+ fname
+ (posix-error #:file-error 'read-symbolic-link "cannot read symbolic link" fname))
+ (let ((pathname (substring buf 0 len)))
+ (if (and canonicalize (symbolic-link? pathname))
+ (read-symbolic-link pathname 'canonicalize)
+ pathname ) ) ) ) ) ) )
(define file-link
(let ([link (foreign-lambda int "link" c-string c-string)])
diff --git a/posixwin.scm b/posixwin.scm
index ad2b97ec..0d012da2 100644
--- a/posixwin.scm
+++ b/posixwin.scm
@@ -1289,46 +1289,6 @@ EOF
;;; More errno codes:
-(define-foreign-variable _errno int "errno")
-
-(define-foreign-variable _eperm int "EPERM")
-(define-foreign-variable _enoent int "ENOENT")
-(define-foreign-variable _esrch int "ESRCH")
-(define-foreign-variable _eintr int "EINTR")
-(define-foreign-variable _eio int "EIO")
-(define-foreign-variable _enoexec int "ENOEXEC")
-(define-foreign-variable _ebadf int "EBADF")
-(define-foreign-variable _echild int "ECHILD")
-(define-foreign-variable _enomem int "ENOMEM")
-(define-foreign-variable _eacces int "EACCES")
-(define-foreign-variable _efault int "EFAULT")
-(define-foreign-variable _ebusy int "EBUSY")
-(define-foreign-variable _eexist int "EEXIST")
-(define-foreign-variable _enotdir int "ENOTDIR")
-(define-foreign-variable _eisdir int "EISDIR")
-(define-foreign-variable _einval int "EINVAL")
-(define-foreign-variable _emfile int "EMFILE")
-(define-foreign-variable _enospc int "ENOSPC")
-(define-foreign-variable _espipe int "ESPIPE")
-(define-foreign-variable _epipe int "EPIPE")
-(define-foreign-variable _eagain int "EAGAIN")
-(define-foreign-variable _erofs int "EROFS")
-(define-foreign-variable _enxio int "ENXIO")
-(define-foreign-variable _e2big int "E2BIG")
-(define-foreign-variable _exdev int "EXDEV")
-(define-foreign-variable _enodev int "ENODEV")
-(define-foreign-variable _enfile int "ENFILE")
-(define-foreign-variable _enotty int "ENOTTY")
-(define-foreign-variable _efbig int "EFBIG")
-(define-foreign-variable _emlink int "EMLINK")
-(define-foreign-variable _edom int "EDOM")
-(define-foreign-variable _erange int "ERANGE")
-(define-foreign-variable _edeadlk int "EDEADLK")
-(define-foreign-variable _enametoolong int "ENAMETOOLONG")
-(define-foreign-variable _enolck int "ENOLCK")
-(define-foreign-variable _enosys int "ENOSYS")
-(define-foreign-variable _enotempty int "ENOTEMPTY")
-(define-foreign-variable _eilseq int "EILSEQ")
(define errno/perm _eperm)
(define errno/noent _enoent)
Trap