February 2004 - osicat-cvs@common-lisp.net

[osicat-cvs] CVS update: src/release.txt src/test-osicat.lisp src/version.txt
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv27531 Modified Files: release.txt test-osicat.lisp version.txt Log Message: Last minute fixes for 0.3.5 release. Date: Sun Feb 29 18:52:23 2004 Author: nsiivola Index: src/release.txt diff -u src/release.txt:1.4 src/release.txt:1.5 --- src/release.txt:1.4 Sun Feb 29 06:29:14 2004 +++ src/release.txt Sun Feb 29 18:52:23 2004 @@ -5,5 +5,8 @@ packages.lisp osicat.lisp osicat-glue.c +version.txt +test-tools.lisp +test-osicat.lisp LICENSE README Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.4 src/test-osicat.lisp:1.5 --- src/test-osicat.lisp:1.4 Sun Feb 29 18:28:22 2004 +++ src/test-osicat.lisp Sun Feb 29 18:52:23 2004 @@ -22,12 +22,6 @@ (in-package :osicat-test) (deftest current-directory.1 - (equal (current-directory) - #.(make-pathname :name nil :type nil :version nil - :defaults *compile-file-truename*)) - t) - -(deftest current-directory.2 (let ((old (current-directory))) (unwind-protect (progn Index: src/version.txt diff -u src/version.txt:1.7 src/version.txt:1.8 --- src/version.txt:1.7 Sun Feb 29 07:44:47 2004 +++ src/version.txt Sun Feb 29 18:52:23 2004 @@ -1 +1 @@ -0.3.4 +0.3.5

1 0

[osicat-cvs] CVS update: src/packages.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv27299 Modified Files: packages.lisp Log Message: * Documentation fixes. Date: Sun Feb 29 18:43:09 2004 Author: nsiivola Index: src/packages.lisp diff -u src/packages.lisp:1.5 src/packages.lisp:1.6 --- src/packages.lisp:1.5 Sun Feb 29 18:41:50 2004 +++ src/packages.lisp Sun Feb 29 18:43:09 2004 @@ -33,7 +33,7 @@ Designated directory When a relative pathname designator is used as a directory designator - it is first resolved agains *default-pathname-default*, and the + it is first resolved agains *default-pathname-default*, and then against the current directory. (With MERGE-PATHNAMES in both cases.)") (:export ;;; Evironment

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv19329 Modified Files: osicat.lisp packages.lisp Log Message: * Documentation fixes. Date: Sun Feb 29 18:41:50 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.15 src/osicat.lisp:1.16 --- src/osicat.lisp:1.15 Sun Feb 29 18:28:22 2004 +++ src/osicat.lisp Sun Feb 29 18:41:50 2004 @@ -148,9 +148,7 @@ (defmacro with-directory-iterator ((iterator pathspec) &body body) "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value -If pathspec is relative, it is resolved against *default-pathname-defaults*. -If the resulting pathname is still relative, it is further resolved against -current directory. The resulting pathname is then bound to +The directory designated by pathspec is then bound to *default-pathname-defaults* for the dynamic scope of the body. Within the lexical scope of the body, iterator is defined via macrolet @@ -195,7 +193,9 @@ "function MAPDIR function pathspec => list Applies function to each entry in directory designated by pathspec in -turn and returns a list of the results. +turn and returns a list of the results. Binds +*default-pathname-defaults* to the directory designated by pathspec +round to function call. If pathspec designates a symbolic link, it is implicitly resolved. @@ -354,9 +354,9 @@ If pathspec designates a symbolic link, that link is implicitly resolved. -Permission symbols consist of :USER-READ, :USER-WRITE, :USER-EXEC, -:GROUP-READ, :GROUP-WRITE, :GROUP-EXEC, :OTHER-READ, :OTHER-WRITE, -:OTHER-EXEC, :SET-USER-ID, :SET-GROUP-ID, and :STICKY. +Permission symbols consist of :user-read, :user-write, :user-exec, +:group-read, :group-write, :group-exec, :other-read, :other-write, +:other-exec, :set-user-id, :set-group-id, and :sticky. Both signal an error is pathspec is wild, or doesn't designate an exiting file." Index: src/packages.lisp diff -u src/packages.lisp:1.4 src/packages.lisp:1.5 --- src/packages.lisp:1.4 Sun Feb 29 13:10:41 2004 +++ src/packages.lisp Sun Feb 29 18:41:50 2004 @@ -26,7 +26,15 @@ on Unix-platforms. It is not a POSIX-style API, but rather a simple lispy accompaniment to the standard ANSI facilities. -Osicat homepage: http://www.common-lisp.net/project/osicat") +Osicat homepage: http://www.common-lisp.net/project/osicat + +Concepts: + + Designated directory + + When a relative pathname designator is used as a directory designator + it is first resolved agains *default-pathname-default*, and the + against the current directory. (With MERGE-PATHNAMES in both cases.)") (:export ;;; Evironment #:environment

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp src/test-tools.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv20785 Modified Files: osicat.lisp test-osicat.lisp test-tools.lisp Log Message: * More tests. * Miscellaneous fixes. * Dithering around the MAPDIR and W-D-I interfaces: should they bind *d-p-d* or not? Should only one of them do that? Date: Sun Feb 29 18:28:22 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.14 src/osicat.lisp:1.15 --- src/osicat.lisp:1.14 Sun Feb 29 15:52:37 2004 +++ src/osicat.lisp Sun Feb 29 18:28:22 2004 @@ -71,16 +71,28 @@ (defun relative-pathname-p (pathspec) (not (eq :absolute (car (pathname-directory pathspec))))) -(defun merge-directories - (pathspec &optional (other *default-pathname-defaults*)) - (let ((tmp (merge-pathnames pathspec - (make-pathname :name nil :type nil :version nil - :defaults other)))) - (if (relative-pathname-p tmp) - (merge-pathnames tmp (current-directory)) - tmp))) +(defun absolute-pathname + (pathspec &optional (default *default-pathname-defaults*)) + (if (relative-pathname-p pathspec) + (let ((tmp (merge-pathnames + pathspec + (make-pathname :name nil :type nil :version nil + :defaults default)))) + (if (relative-pathname-p tmp) + (merge-pathnames tmp (current-directory)) + tmp)) + pathspec)) + +(defun unmerge-pathnames + (pathspec &optional (known *default-pathname-defaults*)) + (let* ((dir (pathname-directory pathspec)) + (mismatch (mismatch dir (pathname-directory known) :test #'equal))) + (make-pathname + :directory (when mismatch + `(:relative ,@(subseq dir mismatch))) + :defaults pathspec))) -(defun normpath (pathspec &optional merge) +(defun normpath (pathspec &optional absolute) (flet ((fixedname (path) (let ((name (pathname-name path))) (cond ((equal ".." name) :up) @@ -94,22 +106,23 @@ (if (member (car dir) '(:absolute :relative)) dir (cons :relative dir))))) - (let ((path (if (and merge (relative-pathname-p pathspec)) - (merge-directories pathspec) - pathspec))) + (let ((path (absolute-pathname pathspec))) (when (wild-pathname-p path) (error "Pathname is wild: ~S." path)) (with-cstring (cfile (namestring path)) - (if (eq :directory (c-file-kind cfile t)) - (make-pathname :name nil :type nil - :directory - (append (fixeddir path) - (remove-if - #'null - (list (fixedname path) - (fixedtype path)))) - :defaults path) - path))))) + (let ((abspath (if (eq :directory (c-file-kind cfile t)) + (make-pathname :name nil :type nil + :directory + (append (fixeddir path) + (remove-if + #'null + (list (fixedname path) + (fixedtype path)))) + :defaults path) + path))) + (if absolute + abspath + (unmerge-pathnames abspath))))))) ;;;; FILE-KIND @@ -191,7 +204,7 @@ (loop for entry = (next) while entry collect (funcall function entry)))) - + (defun delete-directory (pathspec) "function DELETE-DIRECTORY pathspec => T Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.3 src/test-osicat.lisp:1.4 --- src/test-osicat.lisp:1.3 Sun Feb 29 15:52:37 2004 +++ src/test-osicat.lisp Sun Feb 29 18:28:22 2004 @@ -165,3 +165,46 @@ t) (setf (environment-variable :path) old))) t) + +(deftest mapdir.1 + (let* ((dir (ensure-directories-exist + (merge-pathnames "mapdir-test/" *test-dir*))) + (file1 (ensure-file "file1" dir)) + (file2 (ensure-file "file2.txt" dir)) + (subdir (ensure-directories-exist + (merge-pathnames "subdir/" dir)))) + (unwind-protect + (remove-if #'null (mapdir #'pathname-name dir)) + (delete-file file1) + (delete-file file2) + (delete-directory subdir) + (delete-directory dir))) + ("file1" "file2")) + +(deftest mapdir.2 + (let* ((dir (ensure-directories-exist + (merge-pathnames "mapdir-test/" *test-dir*))) + (file1 (ensure-file "file1" dir)) + (file2 (ensure-file "file2.txt" dir)) + (subdir (ensure-directories-exist + (merge-pathnames "subdir/" dir)))) + (unwind-protect + (mapdir #'namestring dir) + (delete-file file1) + (delete-file file2) + (delete-directory subdir) + (delete-directory dir))) + ("file1" "file2.txt" "subdir/")) + +(deftest mapdir.3 + (let* ((dir (ensure-directories-exist + (merge-pathnames "mapdir-test/" *test-dir*))) + (file (ensure-file "foo" dir))) + (unwind-protect + (let ((*default-directory-defaults* (truename "/tmp/"))) + (mapdir (lambda (x) + (pathname-directory (merge-pathnames x))) + dir)) + (delete-file file) + (delete-directory dir))) + (#.(pathname-directory (merge-pathnames "mapdir-test/" *test-dir*)))) Index: src/test-tools.lisp diff -u src/test-tools.lisp:1.1 src/test-tools.lisp:1.2 --- src/test-tools.lisp:1.1 Sun Feb 29 15:29:35 2004 +++ src/test-tools.lisp Sun Feb 29 18:28:22 2004 @@ -35,8 +35,8 @@ (make-pathname :directory (pathname-directory #.*compile-file-truename*)))) -(defun ensure-file (file) - (let ((file (merge-pathnames file *test-dir*))) +(defun ensure-file (file &optional (dir *test-dir*)) + (let ((file (merge-pathnames file dir))) (or (probe-file file) (with-open-file (f file :direction :output) (probe-file f)))))

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv7831 Modified Files: osicat.lisp test-osicat.lisp Log Message: * Fixed return value from MAKUNBOUND-ENVIRONMENT-VARIABLE * More tests Date: Sun Feb 29 15:52:37 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.13 src/osicat.lisp:1.14 --- src/osicat.lisp:1.13 Sun Feb 29 15:29:35 2004 +++ src/osicat.lisp Sun Feb 29 15:52:37 2004 @@ -234,7 +234,7 @@ string designated by name. Signals an error on failure." (with-c-name (cname name) (if (zerop (unsetenv cname)) - nil + (string name) (error "Could not remove environment variable ~S." name)))) (defun environment () Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.2 src/test-osicat.lisp:1.3 --- src/test-osicat.lisp:1.2 Sun Feb 29 15:29:35 2004 +++ src/test-osicat.lisp Sun Feb 29 15:52:37 2004 @@ -21,6 +21,21 @@ (in-package :osicat-test) +(deftest current-directory.1 + (equal (current-directory) + #.(make-pathname :name nil :type nil :version nil + :defaults *compile-file-truename*)) + t) + +(deftest current-directory.2 + (let ((old (current-directory))) + (unwind-protect + (progn + (setf (current-directory) "/tmp/") + (equal (current-directory) (truename "/tmp/"))) + (setf (current-directory) old))) + t) + (deftest delete-directory.1 (let ((dir (merge-pathnames "delete-directory/" *test-dir*))) (ensure-directories-exist dir) @@ -41,6 +56,10 @@ t) (deftest environment.1 + (cdr (assoc "HOME" (environment) :test #'equal)) + #.(namestring (user-homedir-pathname))) + +(deftest environment.2 (unwind-protect (progn (setf (environment-variable 'test-variable) "TEST-VALUE") @@ -100,6 +119,21 @@ (delete-file file))) :regular-file) +(deftest file-permissions.1 + (and (member :other-read (file-permissions "/tmp/")) + t) + t) + +(deftest file-permissions.2 + (let ((file (ensure-file "tmp-exec"))) + (unwind-protect + (and (not (member :user-exec (file-permissions file))) + (push :user-exec (file-permissions file)) + (member :user-exec (file-permissions file)) + t) + (delete-file file))) + t) + (deftest make-link.1 (let ((link (merge-pathnames "make-link-test-link" *test-dir*)) (file (ensure-file "tmp-file"))) @@ -121,4 +155,13 @@ (delete-file file) (delete-file link))) :symbolic-link) - \ No newline at end of file + +(deftest maunbound-environment-variable.1 + (let ((old (environment-variable :path))) + (unwind-protect + (and old + (makunbound-environment-variable :path) + (null (environment-variable :path)) + t) + (setf (environment-variable :path) old))) + t)

1 0

[osicat-cvs] CVS update: src/test-tools.lisp src/osicat.asd src/osicat.lisp src/test-osicat.lisp src/test-setup.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv5965 Modified Files: osicat.asd osicat.lisp test-osicat.lisp Added Files: test-tools.lisp Removed Files: test-setup.lisp Log Message: * Turn ENVIRONMENT into a function. * Fix tests, nicer test-suite. Date: Sun Feb 29 15:29:35 2004 Author: nsiivola Index: src/osicat.asd diff -u src/osicat.asd:1.5 src/osicat.asd:1.6 --- src/osicat.asd:1.5 Sun Feb 29 13:10:41 2004 +++ src/osicat.asd Sun Feb 29 15:29:35 2004 @@ -83,12 +83,15 @@ (defsystem :osicat-test :depends-on (:osicat :rt) - :components ((:file "test-setup") - (:file "test-osicat" :depends-on ("test-setup")))) + :components ((:file "test-tools") + (:file "test-osicat" :depends-on ("test-tools")))) (defmethod perform ((o test-op) (c (eql (find-system :osicat)))) (operate 'load-op :osicat-test) - (operate 'test-op :osicat-test :force t)) + (funcall (intern "SETUP" :osicat-test)) + (unwind-protect + (operate 'test-op :osicat-test :force t) + (funcall (intern "TEARDOWN" :osicat-test)))) (defmethod perform ((o test-op) (c (eql (find-system :osicat-test)))) (or (funcall (intern "DO-TESTS" :rt)) Index: src/osicat.lisp diff -u src/osicat.lisp:1.12 src/osicat.lisp:1.13 --- src/osicat.lisp:1.12 Sun Feb 29 13:36:42 2004 +++ src/osicat.lisp Sun Feb 29 15:29:35 2004 @@ -237,7 +237,16 @@ nil (error "Could not remove environment variable ~S." name)))) -(defun get-environ () +(defun environment () + "function ENVIRONMENT => alist +function (SETF ENVIRONMENT) alist => alist + +ENVIRONMENT return the current environment as an assoc-list. +SETF ENVIRONMENT modifies the environment its argument. + +Often it is preferable to use SETF ENVIRONMENT-VARIABLE and +MAKUNBOUND-ENVIRONMENT-VARIABLE to modify the environment instead +of SETF ENVIRONMENT." (handler-case (loop for i from 0 by 1 for string = (convert-from-cstring @@ -249,7 +258,7 @@ (error (e) (error "Could not access environment (~S)." e)))) -(defun (setf get-environ) (alist) +(defun (setf environment) (alist) (let ((oldenv (get-environ))) (loop for (var . val) in alist do (setf (environment-variable var) (string val) @@ -260,15 +269,6 @@ do (makunbound-environment-variable var))) alist) -(define-symbol-macro environment (get-environ)) - -(setf (documentation 'environment 'variable) - "symbol-macro ENVIRONMENT - -The current environment as a read-only assoc-list. To modify -the environment use (SETF ENVIRONMENT-VARIABLE) and -MAKUNBOUND-ENVIRONMENT-VARIABLE.") - (defun read-link (pathspec) "function READ-LINK pathspec => pathname Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.1 src/test-osicat.lisp:1.2 --- src/test-osicat.lisp:1.1 Tue Nov 18 03:18:58 2003 +++ src/test-osicat.lisp Sun Feb 29 15:29:35 2004 @@ -85,29 +85,40 @@ nil) (deftest file-kind.3 - (file-kind *test-symlink*) + (let* ((file (ensure-file "tmp-file")) + (link (ensure-link "tmp-link" :target file))) + (unwind-protect + (file-kind link) + (delete-file link) + (delete-file file))) :symbolic-link) (deftest file-kind.4 - (file-kind *test-file*) + (let ((file (ensure-file "tmp-file"))) + (unwind-protect + (file-kind file) + (delete-file file))) :regular-file) (deftest make-link.1 - (let ((link (merge-pathnames "make-link-test-link" *test-dir*))) + (let ((link (merge-pathnames "make-link-test-link" *test-dir*)) + (file (ensure-file "tmp-file"))) (unwind-protect (progn - (make-link *test-file* link) + (make-link link :target file) (namestring (read-link link))) - (delete-file link))) - #.(namestring *test-file*)) + (delete-file link) + (delete-file file))) + #.(namestring (merge-pathnames "tmp-file" *test-dir*))) (deftest make-link.2 - (let ((link (merge-pathnames "make-link-test-link" *test-dir*))) + (let ((link (merge-pathnames "make-link-test-link" *test-dir*)) + (file (ensure-file "tmp-file"))) (unwind-protect (progn - (make-link *test-file* link) + (make-link link :target file) (file-kind link)) + (delete-file file) (delete-file link))) :symbolic-link) -

1 0

[osicat-cvs] CVS update: src/osicat.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv22337 Modified Files: osicat.lisp Log Message: * Better interface for MAKE-LINK * Smaller code for WITH-DIRECTORY-ITERATOR Date: Sun Feb 29 13:36:42 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.11 src/osicat.lisp:1.12 --- src/osicat.lisp:1.11 Sun Feb 29 13:10:41 2004 +++ src/osicat.lisp Sun Feb 29 13:36:42 2004 @@ -150,30 +150,29 @@ The value returned is the value of the last form evaluated in body. Signals an error if pathspec is wild or does not designate a directory." - (with-unique-names (dp dir cdir) + (with-unique-names (dp dir cdir one-iter) `(let ((,dir (normpath ,pathspec t))) (with-c-file (,cdir ,dir :directory t) (let (,dp) (unwind-protect - (macrolet ((,iterator () - `(block nil - (tagbody :retry - (let ((entry (readdir ,',dp))) - (if (null-pointer-p entry) - nil - (let ((name - (convert-from-cstring - (osicat-dirent-name - entry)))) - (if (member name '("." "..") - :test #'string=) - (go :retry) - (return (normpath name)))))))))) - (setf ,dp (opendir ,cdir)) - (when (null-pointer-p ,dp) - (error "Error opening directory ~S." ,dir)) - (let ((*default-pathname-defaults* ,dir)) - ,@body)) + (labels ((,one-iter () + (let ((entry (readdir ,dp))) + (if (null-pointer-p entry) + nil + (let ((name + (convert-from-cstring + (osicat-dirent-name entry)))) + (if (member name '("." "..") + :test #'string=) + (,one-iter) + (normpath name))))))) + (macrolet ((,iterator () + `(,',one-iter))) + (setf ,dp (opendir ,cdir)) + (when (null-pointer-p ,dp) + (error "Error opening directory ~S." ,dir)) + (let ((*default-pathname-defaults* ,dir)) + ,@body))) (when ,dp (if (zerop (closedir ,dp)) nil @@ -291,25 +290,33 @@ (pathname str))) (free-foreign-object buffer))))) -(defun make-link (target link &key hard) - "function MAKE-LINK target link &key hard => pathname +(defun make-link (link &key target hard) + "function MAKE-LINK link &key target hard => pathname Creates link that points to target. Defaults to a symbolic link, but giving a non-NIL value to the keyword argument :HARD creates a hard link. Returns the pathname of the link. +Relative targets are resolved against the link. Relative links are +resolved against *default-pathname-defaults*. + Signals an error if either target or link is wild, target does not exist, or link exists already." + (unless target + (error "No target given to MAKE-LINK.")) (let ((old (current-directory))) (unwind-protect - (with-c-file (old target) + ;; KLUDGE: We merge against link for hard links only, + ;; since symlink does the right thing once we are in + ;; the correct directory. + (with-c-file (old (if hard (merge-pathnames target link) target)) (with-c-file (new link) (setf (current-directory) (normpath *default-pathname-defaults* t)) (if (zerop (funcall (if hard #'link #'symlink) old new)) (pathname link) - (error "Could not create ~A link ~S -> ~S." - (if hard "hard" "symbolic") link target)))) + (error "MAKE-LINK: Could not create ~A link ~S -> ~S." + (if hard "hard" "symbolic") new old)))) (setf (current-directory) old)))) (define-symbol-macro +permissions+

1 0

[osicat-cvs] CVS update: src/early-util.lisp src/ffi.lisp src/osicat-glue.c src/osicat.asd src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv10914 Modified Files: early-util.lisp ffi.lisp osicat-glue.c osicat.asd osicat.lisp packages.lisp Log Message: More work on consolidating *default-pathname-defaults* and current directory. Date: Sun Feb 29 13:10:41 2004 Author: nsiivola Index: src/early-util.lisp diff -u src/early-util.lisp:1.1 src/early-util.lisp:1.2 --- src/early-util.lisp:1.1 Sun Feb 29 06:25:27 2004 +++ src/early-util.lisp Sun Feb 29 13:10:41 2004 @@ -35,3 +35,11 @@ (format stream "~A. This seems to be a bug in Osicat.~ Please report on osicat-devel(a)common-lisp.net." (message condition))))) + +(defmacro with-c-name ((cname name) &body forms) + (with-unique-names (n-name) + `(let ((,n-name ,name)) + (with-cstring (,cname (etypecase ,n-name + (string ,n-name) + (symbol (symbol-name ,n-name)))) + ,@forms)))) Index: src/ffi.lisp diff -u src/ffi.lisp:1.1 src/ffi.lisp:1.2 --- src/ffi.lisp:1.1 Sun Feb 29 06:27:11 2004 +++ src/ffi.lisp Sun Feb 29 13:10:41 2004 @@ -21,14 +21,28 @@ (in-package :osicat) -;;; FIXME: These should be groveled as well. +;;;; TYPES + +;; FIXME: These should be groveled as well. (def-foreign-type :size-t :unsigned-int) (def-foreign-type :mode-t :unsigned-int) +;;;; FOREIGN GLUE + (def-function ("osicat_mode" c-file-mode) ((name :cstring) (follow-p :int)) :module "osicat" :returning :int) +(def-function ("osicat_getcwd" c-getcwd) () + :module "osicat" + :returning (* :unsigned-char)) + +(def-function "osicat_dirent_name" ((entry :pointer-void)) + :module "osicat" + :returning :cstring) + +;;;; PLAIN POSIX + (def-function "opendir" ((name :cstring)) :module "osicat" :returning :pointer-void) @@ -41,10 +55,6 @@ :module "osicat" :returning :pointer-void) -(def-function "osicat_dirent_name" ((entry :pointer-void)) - :module "osicat" - :returning :cstring) - (def-function "rmdir" ((name :cstring)) :module "osicat" :returning :int) @@ -81,3 +91,6 @@ :module "osicat" :returning :int) +(def-function "chdir" ((name :cstring)) + :module "osicat" + :returning :int) Index: src/osicat-glue.c diff -u src/osicat-glue.c:1.6 src/osicat-glue.c:1.7 --- src/osicat-glue.c:1.6 Sat Nov 8 09:19:25 2003 +++ src/osicat-glue.c Sun Feb 29 13:10:41 2004 @@ -24,6 +24,7 @@ #include <dirent.h> #include <sys/stat.h> #include <pwd.h> +#include <errno.h> extern int osicat_mode (char * name, int follow_p) @@ -51,6 +52,24 @@ return entry->d_name; } - - - +extern char * +osicat_getcwd (void) +{ + size_t size = 128; + while (1) + { + char *buffer = (char *) malloc (size); + if (!buffer) { + return 0; + } + else if (getcwd (buffer, size) == buffer) { + return buffer; + } + else { + free (buffer); + if (errno != ERANGE) + return 0; + size += 128; + } + } +} Index: src/osicat.asd diff -u src/osicat.asd:1.4 src/osicat.asd:1.5 --- src/osicat.asd:1.4 Sun Feb 29 06:29:14 2004 +++ src/osicat.asd Sun Feb 29 13:10:41 2004 @@ -39,7 +39,7 @@ (defmethod perform ((o load-op) (c c-source-file)) (let ((loader (intern "LOAD-FOREIGN-LIBRARY" :uffi))) (dolist (file (asdf::input-files o c)) - (funcall loader file :module "osicat")))) + (funcall loader file :module "osicat" :force-load t)))) (defmethod perform ((o compile-op) (c c-source-file)) (unless (zerop (run-shell-command "~A ~A ~{~A ~}-o ~A" Index: src/osicat.lisp diff -u src/osicat.lisp:1.10 src/osicat.lisp:1.11 --- src/osicat.lisp:1.10 Sun Feb 29 07:44:47 2004 +++ src/osicat.lisp Sun Feb 29 13:10:41 2004 @@ -26,6 +26,9 @@ *compile-file-truename*)) (symbol-name (read f)))) +;;;; COMMON SUBROUTINES + +(declaim (inline c-file-kind)) (macrolet ((def () `(defun c-file-kind (c-file follow-p) (let ((mode (c-file-mode c-file (if follow-p 1 0)))) @@ -47,28 +50,69 @@ (defmacro with-c-file ((c-file pathname &optional required-kind follow-p) &body forms) (with-unique-names (path kind) - ;; We merge the pathname to consolidate *default-pathname-defaults* - ;; and C-sides idea of current directory: relative *d-p-d* gives - ;; way to the C-side, whereas absolute ones take precedence. - `(let ((,path (merge-pathnames ,pathname))) - (print (list :c-file-kind (pathname-directory ,path))) + `(let ((,path ,pathname)) (when (wild-pathname-p ,path) (error "Pathname is wild: ~S." ,path)) (with-cstring (,c-file (namestring ,path)) ,@(if required-kind `((let ((,kind (c-file-kind ,c-file ,follow-p))) ,(etypecase required-kind - (keyword `(unless (eq ,required-kind ,kind) - (if ,kind - (error "~A is ~A, not ~A." - ,path ,kind ,required-kind) - (error "~A ~S does not exist." - ,required-kind ,path)))) - ((eql t) `(unless ,kind - (error "~A does not exist." ,path)))) + (keyword `(unless (eq ,required-kind ,kind) + (if ,kind + (error "~A is ~A, not ~A." + ,path ,kind ,required-kind) + (error "~A ~S does not exist." + ,required-kind ,path)))) + ((eql t) `(unless ,kind + (error "~A does not exist." ,path)))) ,@forms)) forms))))) +(defun relative-pathname-p (pathspec) + (not (eq :absolute (car (pathname-directory pathspec))))) + +(defun merge-directories + (pathspec &optional (other *default-pathname-defaults*)) + (let ((tmp (merge-pathnames pathspec + (make-pathname :name nil :type nil :version nil + :defaults other)))) + (if (relative-pathname-p tmp) + (merge-pathnames tmp (current-directory)) + tmp))) + +(defun normpath (pathspec &optional merge) + (flet ((fixedname (path) + (let ((name (pathname-name path))) + (cond ((equal ".." name) :up) + ((equal "." name) nil) + ((stringp name) name)))) + (fixedtype (path) + (let ((type (pathname-type path))) + (and (stringp type) type))) + (fixeddir (path) + (let ((dir (pathname-directory path))) + (if (member (car dir) '(:absolute :relative)) + dir + (cons :relative dir))))) + (let ((path (if (and merge (relative-pathname-p pathspec)) + (merge-directories pathspec) + pathspec))) + (when (wild-pathname-p path) + (error "Pathname is wild: ~S." path)) + (with-cstring (cfile (namestring path)) + (if (eq :directory (c-file-kind cfile t)) + (make-pathname :name nil :type nil + :directory + (append (fixeddir path) + (remove-if + #'null + (list (fixedname path) + (fixedtype path)))) + :defaults path) + path))))) + +;;;; FILE-KIND + (defun file-kind (pathspec) "function FILE-KIND pathspec => file-kind @@ -80,63 +124,56 @@ :block-device. Signals an error if pathspec is wild." - ;; KLUDGE: OAOOM: We scurry to avoid an extra lstat here. - (let ((path (pathname pathspec))) + (let ((path (merge-pathnames pathspec))) (when (wild-pathname-p path) (error "Pathname is wild: ~S." path)) (with-cstring (cfile (namestring path)) (c-file-kind cfile nil)))) +;;;; DIRECTORY ACCESS + (defmacro with-directory-iterator ((iterator pathspec) &body body) "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value -Within the lexical scope of the body, iterator is defined via flet +If pathspec is relative, it is resolved against *default-pathname-defaults*. +If the resulting pathname is still relative, it is further resolved against +current directory. The resulting pathname is then bound to +*default-pathname-defaults* for the dynamic scope of the body. + +Within the lexical scope of the body, iterator is defined via macrolet such that successive invocations of (iterator) return the directory entries, one by one. Both files and directories are returned, except -'.' and '..'. The order of entries is not guaranteed. - -Once all entries have been returned, further invocations of (iterator) -will all return NIL. +'.' and '..'. The order of entries is not guaranteed. The entries are +returned as relative pathnames against the directory. Entries that are +symbolic links are not resolved. Once all entries have been returned, +further invocations of (iterator) will all return NIL. The value returned is the value of the last form evaluated in -body. - -If pathspec designates a symbolic link, it is implicitly resolved. - -Signal an error if pathspec is wild or does not designate a directory." - (with-unique-names (dp dir cdir err default) - `(let ((,dir (merge-pathnames ,pathspec))) +body. Signals an error if pathspec is wild or does not designate a directory." + (with-unique-names (dp dir cdir) + `(let ((,dir (normpath ,pathspec t))) (with-c-file (,cdir ,dir :directory t) - (let ((,dp nil) - (,default - (make-pathname :name nil :type nil - :directory - (append ;KLUDGE: deal with missing /'s - (pathname-directory ,dir) - (remove-if (lambda (o) - (or (null o) - (keywordp o) - (equal "." o))) - (list (pathname-name ,dir) - (pathname-type ,dir)))) - :defaults ,dir))) + (let (,dp) (unwind-protect - (labels ((,iterator () - (let ((entry (readdir ,dp))) - (if (null-pointer-p entry) - nil - (let ((namestring - (convert-from-cstring - (osicat-dirent-name entry)))) - (if (member namestring '("." "..") - :test #'equal) - (,iterator) - (merge-pathnames namestring - ,default))))))) + (macrolet ((,iterator () + `(block nil + (tagbody :retry + (let ((entry (readdir ,',dp))) + (if (null-pointer-p entry) + nil + (let ((name + (convert-from-cstring + (osicat-dirent-name + entry)))) + (if (member name '("." "..") + :test #'string=) + (go :retry) + (return (normpath name)))))))))) (setf ,dp (opendir ,cdir)) (when (null-pointer-p ,dp) (error "Error opening directory ~S." ,dir)) - ,@body) + (let ((*default-pathname-defaults* ,dir)) + ,@body)) (when ,dp (if (zerop (closedir ,dp)) nil @@ -164,19 +201,11 @@ Signals an error if pathspec is wild, doesn't designate a directory, or if the directory could not be deleted." - (with-c-file (path pathspec :directory) + (with-c-file (path (normpath pathspec t) :directory) (if (zerop (rmdir path)) pathspec (error "Could not delete directory ~S." pathspec)))) -(defmacro with-c-name ((cname name) &body forms) - (with-unique-names (n-name) - `(let ((,n-name ,name)) - (with-cstring (,cname (etypecase ,n-name - (string ,n-name) - (symbol (symbol-name ,n-name)))) - ,@forms)))) - (defun environment-variable (name) "function ENVIRONMENT-VARIABLE name => string function (SETF (ENVIRONMENT-VARIABLE name) value) => value @@ -210,12 +239,27 @@ (error "Could not remove environment variable ~S." name)))) (defun get-environ () - (loop for i from 0 by 1 - for string = (convert-from-cstring - (deref-array environ cstring-array i)) - for split = (position #\= string) - while string - collecting (cons (subseq string 0 split) (subseq string (1+ split))))) + (handler-case + (loop for i from 0 by 1 + for string = (convert-from-cstring + (deref-array environ cstring-array i)) + for split = (position #\= string) + while string + collecting (cons (subseq string 0 split) + (subseq string (1+ split)))) + (error (e) + (error "Could not access environment (~S)." e)))) + +(defun (setf get-environ) (alist) + (let ((oldenv (get-environ))) + (loop for (var . val) in alist + do (setf (environment-variable var) (string val) + oldenv (delete var oldenv + :key (lambda (x) (string (car x))) + :test #'string=))) + (loop for (var . val) in oldenv + do (makunbound-environment-variable var))) + alist) (define-symbol-macro environment (get-environ)) @@ -235,18 +279,17 @@ Signals an error if pathspec is wild, or does not designate a symbolic link." - ;; KLUDGE: Silence a compiler-note (handler-bind (#+sbcl (sb-ext:compiler-note #'muffle-warning)) - (with-c-file (path pathspec :symbolic-link) - (do* ((size 64 (* size 2)) - (buffer #1=(allocate-foreign-string size) #1#) - (got (readlink path buffer size))) - ((< got size) - (let ((str (convert-from-foreign-string buffer :length got))) - (free-foreign-object buffer) - (pathname str))) - (free-foreign-object buffer))))) + (with-c-file (path (normpath pathspec t) :symbolic-link) + (do* ((size 64 (* size 2)) + (buffer #1=(allocate-foreign-string size) #1#) + (got (readlink path buffer size))) + ((< got size) + (let ((str (convert-from-foreign-string buffer :length got))) + (free-foreign-object buffer) + (pathname str))) + (free-foreign-object buffer))))) (defun make-link (target link &key hard) "function MAKE-LINK target link &key hard => pathname @@ -257,12 +300,17 @@ Signals an error if either target or link is wild, target does not exist, or link exists already." - (with-c-file (old target) - (with-c-file (new link) - (if (zerop (funcall (if hard #'link #'symlink) old new)) - (pathname link) - (error "Could not create ~A link ~S -> ~S." - (if hard "hard" "symbolic") link target))))) + (let ((old (current-directory))) + (unwind-protect + (with-c-file (old target) + (with-c-file (new link) + (setf (current-directory) + (normpath *default-pathname-defaults* t)) + (if (zerop (funcall (if hard #'link #'symlink) old new)) + (pathname link) + (error "Could not create ~A link ~S -> ~S." + (if hard "hard" "symbolic") link target)))) + (setf (current-directory) old)))) (define-symbol-macro +permissions+ (load-time-value (mapcar (lambda (x) @@ -307,3 +355,27 @@ :initial-value 0))) perms (error "Could not set file permissions of ~S to ~S." pathspec perms)))) + +(defun current-directory () + "function CURRENT-DIRECTORY => pathname +function (SETF CURRENT-DIRECTORY) pathspec => pathspec + +CURRENT-DIRECTORY returns the operating system's current directory, which +may or may not correspond to *DEFAULT-PATHNAME-DEFAULTS*. + +SETF CURRENT-DIRECTORY changes the operating system's current directory to +the pathspec. An error is signalled if the pathspec is wild or does not +designate a directory." + (let* ((cwd (c-getcwd)) + (str (convert-from-foreign-string cwd :null-terminated-p t))) + (if str + (prog1 + (pathname (concatenate 'string str "/")) + (free-foreign-object cwd)) + (error "Could not get current directory.")))) + +(defun (setf current-directory) (pathspec) + (with-c-file (dir pathspec :directory) + (if (minusp (chdir dir)) + (error "Could not change current directory.") + pathspec))) Index: src/packages.lisp diff -u src/packages.lisp:1.3 src/packages.lisp:1.4 --- src/packages.lisp:1.3 Sun Feb 29 07:44:47 2004 +++ src/packages.lisp Sun Feb 29 13:10:41 2004 @@ -36,6 +36,7 @@ #:with-directory-iterator #:mapdir #:delete-directory + #:current-directory ;; Files #:file-kind ;; Symlinks

1 0

[osicat-cvs] CVS update: src/make-readme.lisp src/osicat.lisp src/packages.lisp src/version.txt
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv16491 Modified Files: osicat.lisp packages.lisp version.txt Added Files: make-readme.lisp Log Message: * Handle relative pathnames correctly in WITH-DIRECTORY-ITERATOR. * README generator (make-readme.lisp) Date: Sun Feb 29 07:44:47 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.9 src/osicat.lisp:1.10 --- src/osicat.lisp:1.9 Sun Feb 29 06:29:14 2004 +++ src/osicat.lisp Sun Feb 29 07:44:47 2004 @@ -21,6 +21,11 @@ (in-package :osicat) +(defparameter *osicat-version* + #.(with-open-file (f (merge-pathnames "version.txt" + *compile-file-truename*)) + (symbol-name (read f)))) + (macrolet ((def () `(defun c-file-kind (c-file follow-p) (let ((mode (c-file-mode c-file (if follow-p 1 0)))) @@ -46,6 +51,7 @@ ;; and C-sides idea of current directory: relative *d-p-d* gives ;; way to the C-side, whereas absolute ones take precedence. `(let ((,path (merge-pathnames ,pathname))) + (print (list :c-file-kind (pathname-directory ,path))) (when (wild-pathname-p ,path) (error "Pathname is wild: ~S." ,path)) (with-cstring (,c-file (namestring ,path)) @@ -99,7 +105,7 @@ Signal an error if pathspec is wild or does not designate a directory." (with-unique-names (dp dir cdir err default) - `(let ((,dir ,pathspec)) + `(let ((,dir (merge-pathnames ,pathspec))) (with-c-file (,cdir ,dir :directory t) (let ((,dp nil) (,default @@ -109,7 +115,8 @@ (pathname-directory ,dir) (remove-if (lambda (o) (or (null o) - (keywordp o))) + (keywordp o) + (equal "." o))) (list (pathname-name ,dir) (pathname-type ,dir)))) :defaults ,dir))) @@ -152,11 +159,11 @@ (defun delete-directory (pathspec) "function DELETE-DIRECTORY pathspec => T -Deletes the direcotry designated by pathspec. Returns T. The +Deletes the directory designated by pathspec. Returns T. The directory must be empty. Symbolic links are not followed. Signals an error if pathspec is wild, doesn't designate a directory, -or if the direcotry could not be deleted." +or if the directory could not be deleted." (with-c-file (path pathspec :directory) (if (zerop (rmdir path)) pathspec Index: src/packages.lisp diff -u src/packages.lisp:1.2 src/packages.lisp:1.3 --- src/packages.lisp:1.2 Sun Oct 26 09:19:32 2003 +++ src/packages.lisp Sun Feb 29 07:44:47 2004 @@ -1,4 +1,4 @@ -;; Copyright (c) 2003 Nikodemus Siivola <nikodemus(a)random-state.net> +;; Copyright (c) 2003, 2004 Nikodemus Siivola <nikodemus(a)random-state.net> ;; ;; Permission is hereby granted, free of charge, to any person obtaining ;; a copy of this software and associated documentation files (the @@ -21,9 +21,12 @@ (defpackage :osicat (:use :cl :uffi) - (:documentation "Osicat is a lightweight operating system interface -for Common Lisp on Unix-platforms. It is not a POSIX-style API, but -rather a simple lispy accompaniment to the standard ANSI facilities.") + (:documentation + "Osicat is a lightweight operating system interface for Common Lisp +on Unix-platforms. It is not a POSIX-style API, but rather a simple +lispy accompaniment to the standard ANSI facilities. + +Osicat homepage: http://www.common-lisp.net/project/osicat") (:export ;;; Evironment #:environment @@ -40,4 +43,7 @@ #:make-link ;; Permissions #:file-permissions + ;; Version info + #:*osicat-version* )) + Index: src/version.txt diff -u src/version.txt:1.6 src/version.txt:1.7 --- src/version.txt:1.6 Sat Nov 8 09:22:34 2003 +++ src/version.txt Sun Feb 29 07:44:47 2004 @@ -1 +1 @@ -0.3.3 +0.3.4

1 0

[osicat-cvs] CVS update: src/grovel-constants.lisp src/osicat.asd src/osicat.lisp src/release.txt
by Nikodemus Siivola 29 Feb '04

29 Feb '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv32116 Modified Files: grovel-constants.lisp osicat.asd osicat.lisp release.txt Log Message: Moved ffi code away from osicat.lisp, with-c-file now consolidates *default-pathname-defaults* and the os current directory. Date: Sun Feb 29 06:29:14 2004 Author: nsiivola Index: src/grovel-constants.lisp diff -u src/grovel-constants.lisp:1.2 src/grovel-constants.lisp:1.3 --- src/grovel-constants.lisp:1.2 Thu Oct 23 19:48:05 2003 +++ src/grovel-constants.lisp Sun Feb 29 06:29:14 2004 @@ -1,3 +1,30 @@ +;; Copyright (c) 2003 Nikodemus Siivola +;; +;; Permission is hereby granted, free of charge, to any person obtaining +;; a copy of this software and associated documentation files (the +;; "Software"), to deal in the Software without restriction, including +;; without limitation the rights to use, copy, modify, merge, publish, +;; distribute, sublicense, and/or sell copies of the Software, and to +;; permit persons to whom the Software is furnished to do so, subject to +;; the following conditions: +;; +;; The above copyright notice and this permission notice shall be included +;; in all copies or substantial portions of the Software. +;; +;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +;;;; A simple groveler loosely based on various SBCL grovelers. +;;;; +;;;; Jargon note: A groveler is a lisp program that writes a C-program +;;;; that writes a lisp program. The purpose of this excercise is to +;;;; extract C-side definitions in a portable manner. + (in-package :osicat-system) (defun write-groveler (file constants) @@ -33,7 +60,9 @@ (setf *grovel* (lambda (c obj lisp) (write-groveler c - '( ;; File types + '(;; File types + ;; OAOOM Warning: these are explicitly listed + ;; in osicat.lisp as well. (mode-mask . S_IFMT) (directory . S_IFDIR) (character-device . S_IFCHR) Index: src/osicat.asd diff -u src/osicat.asd:1.3 src/osicat.asd:1.4 --- src/osicat.asd:1.3 Tue Nov 18 03:18:58 2003 +++ src/osicat.asd Sun Feb 29 06:29:14 2004 @@ -1,4 +1,4 @@ -;; Copyright (c) 2003 Nikodemus Siivola <nikodemus(a)random-state.net> +;; Copyright (c) 2003, 2004 Nikodemus Siivola <nikodemus(a)random-state.net> ;; ;; Permission is hereby granted, free of charge, to any person obtaining ;; a copy of this software and associated documentation files (the @@ -24,6 +24,8 @@ (in-package :osicat-system) +;;;; C-SOURCE FILE HANDLING + (defvar *gcc* "/usr/bin/gcc") (defvar *gcc-options* '(#-darwin "-shared" #+darwin "-bundle" @@ -47,6 +49,8 @@ (namestring (car (output-files o c))))) (error 'operation-error :component c :operation o))) +;;;; GROVELING + (defclass grovel-file (cl-source-file) ()) (defmethod perform ((o compile-op) (c grovel-file)) @@ -57,21 +61,25 @@ (constants (merge-pathnames "grovel.lisp-temp" output-file)) (*grovel*)) (declare (special *grovel*)) - (load filename) + ;; Loading the groveler will bind the *govel* hook. + (load filename) (and (funcall (the function *grovel*) c-source a-dot-out constants) (compile-file constants :output-file output-file)))) -;;; The actual system +;;;; SYSTEM + (defsystem :osicat :depends-on (:uffi) :components ((:c-source-file "osicat-glue") (:file "packages") - (:file "macros" :depends-on ("packages")) (:grovel-file "grovel-constants" :depends-on ("packages")) - (:file "foreign-types" :depends-on ("packages")) + (:file "early-util" :depends-on ("packages")) + (:file "ffi" :depends-on ("early-util")) (:file "osicat" :depends-on - ("osicat-glue" "foreign-types" "macros" "grovel-constants")))) + ("osicat-glue" "ffi" "grovel-constants")))) + +;;;; TESTING (defsystem :osicat-test :depends-on (:osicat :rt) Index: src/osicat.lisp diff -u src/osicat.lisp:1.8 src/osicat.lisp:1.9 --- src/osicat.lisp:1.8 Sun Oct 26 11:10:33 2003 +++ src/osicat.lisp Sun Feb 29 06:29:14 2004 @@ -1,4 +1,4 @@ -;; Copyright (c) 2003 Nikodemus Siivola +;; Copyright (c) 2003, 2004 Nikodemus Siivola ;; ;; Permission is hereby granted, free of charge, to any person obtaining ;; a copy of this software and associated documentation files (the @@ -21,53 +21,47 @@ (in-package :osicat) -(def-function ("osicat_mode" c-file-mode) ((name :cstring) (follow-p :int)) - :module "osicat" - :returning :int) - -(define-condition bug (error) - ((message :reader message :initarg :message)) - (:report (lambda (condition stream) - (format stream "~A. This seems to be a bug in Osicat.~ - Please report on osicat-devel(a)common-lisp.net." - (message condition))))) - -;;; KLUDGE: Would macrolet frob be preferable here? I can't see why... -(eval - `(defun c-file-kind (c-file follow-p) - (let ((mode (c-file-mode c-file (if follow-p 1 0)))) - (unless (minusp mode) - (case (logand mode-mask mode) - ,@(mapcar - (lambda (sym) - (list (eval sym) - (intern (symbol-name sym) :keyword))) - ;; OAOOM: These are in grovel-constants.lisp as well. - '(directory character-device block-device - regular-file symbolic-link pipe socket)) - (t (error - 'bug :message - (format nil "Unknown file mode: ~H." mode)))))))) +(macrolet ((def () + `(defun c-file-kind (c-file follow-p) + (let ((mode (c-file-mode c-file (if follow-p 1 0)))) + (unless (minusp mode) + (case (logand mode-mask mode) + ,@(mapcar + (lambda (sym) + (list (eval sym) + (intern (symbol-name sym) :keyword))) + ;; OAOOM Warning: + ;; These are in grovel-constants.lisp as well. + '(directory character-device block-device + regular-file symbolic-link pipe socket)) + (t (error + 'bug :message + (format nil "Unknown file mode: ~H." mode))))))))) + (def)) -(defmacro with-c-file ((c-file pathname &optional required-kind follow-p) &body forms) - ;; FIXME: This assumes that OS has the same idea of current dir as Lisp +(defmacro with-c-file + ((c-file pathname &optional required-kind follow-p) &body forms) (with-unique-names (path kind) - `(let ((,path ,pathname)) + ;; We merge the pathname to consolidate *default-pathname-defaults* + ;; and C-sides idea of current directory: relative *d-p-d* gives + ;; way to the C-side, whereas absolute ones take precedence. + `(let ((,path (merge-pathnames ,pathname))) (when (wild-pathname-p ,path) (error "Pathname is wild: ~S." ,path)) (with-cstring (,c-file (namestring ,path)) - (let ((,kind (c-file-kind ,c-file ,follow-p))) - ,(etypecase required-kind - (keyword `(unless (eq ,required-kind ,kind) - (if ,kind - (error "~A is ~A, not ~A." - ,path ,kind ,required-kind) - (error "~A ~S does not exist." - ,required-kind ,path)))) - ((eql t) `(unless ,kind - (error "~A does not exist." ,path))) - (null nil)) - ,@forms))))) + ,@(if required-kind + `((let ((,kind (c-file-kind ,c-file ,follow-p))) + ,(etypecase required-kind + (keyword `(unless (eq ,required-kind ,kind) + (if ,kind + (error "~A is ~A, not ~A." + ,path ,kind ,required-kind) + (error "~A ~S does not exist." + ,required-kind ,path)))) + ((eql t) `(unless ,kind + (error "~A does not exist." ,path)))) + ,@forms)) + forms))))) (defun file-kind (pathspec) "function FILE-KIND pathspec => file-kind @@ -87,22 +81,6 @@ (with-cstring (cfile (namestring path)) (c-file-kind cfile nil)))) -(def-function "opendir" ((name :cstring)) - :module "osicat" - :returning :pointer-void) - -(def-function "closedir" ((dir :pointer-void)) - :module "osicat" - :returning :int) - -(def-function "readdir" ((dir :pointer-void)) - :module "osicat" - :returning :pointer-void) - -(def-function "osicat_dirent_name" ((entry :pointer-void)) - :module "osicat" - :returning :cstring) - (defmacro with-directory-iterator ((iterator pathspec) &body body) "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value @@ -124,26 +102,30 @@ `(let ((,dir ,pathspec)) (with-c-file (,cdir ,dir :directory t) (let ((,dp nil) - (,default (make-pathname :name nil - :type nil - :directory (append ;KLUDGE: deal with missing /'s - (pathname-directory ,dir) - (remove-if (lambda (o) - (or (null o) - (keywordp o))) - (list (pathname-name ,dir) - (pathname-type ,dir)))) - :defaults ,dir))) + (,default + (make-pathname :name nil :type nil + :directory + (append ;KLUDGE: deal with missing /'s + (pathname-directory ,dir) + (remove-if (lambda (o) + (or (null o) + (keywordp o))) + (list (pathname-name ,dir) + (pathname-type ,dir)))) + :defaults ,dir))) (unwind-protect (labels ((,iterator () (let ((entry (readdir ,dp))) (if (null-pointer-p entry) nil - (let ((namestring (convert-from-cstring - (osicat-dirent-name entry)))) - (if (member namestring '("." "..") :test #'equal) + (let ((namestring + (convert-from-cstring + (osicat-dirent-name entry)))) + (if (member namestring '("." "..") + :test #'equal) (,iterator) - (merge-pathnames namestring ,default))))))) + (merge-pathnames namestring + ,default))))))) (setf ,dp (opendir ,cdir)) (when (null-pointer-p ,dp) (error "Error opening directory ~S." ,dir)) @@ -167,10 +149,6 @@ while entry collect (funcall function entry)))) -(def-function "rmdir" ((name :cstring)) - :module "osicat" - :returning :int) - (defun delete-directory (pathspec) "function DELETE-DIRECTORY pathspec => T @@ -184,21 +162,6 @@ pathspec (error "Could not delete directory ~S." pathspec)))) -(def-function "getenv" ((name :cstring)) - :module "osicat" - :returning :cstring) - -(def-function "setenv" ((name :cstring) (value :cstring) (replace :int)) - :module "osicat" - :returning :int) - -(def-function "unsetenv" ((name :cstring)) - :module "osicat" - :returning :int) - -(def-array-pointer cstring-array :cstring) -(def-foreign-var "environ" 'cstring-array "osicat") - (defmacro with-c-name ((cname name) &body forms) (with-unique-names (n-name) `(let ((,n-name ,name)) @@ -256,11 +219,6 @@ the environment use (SETF ENVIRONMENT-VARIABLE) and MAKUNBOUND-ENVIRONMENT-VARIABLE.") -(def-function "readlink" - ((name :cstring) (buffer (* :unsigned-char)) (size :size-t)) - :module "osicat" - :returning :int) - (defun read-link (pathspec) "function READ-LINK pathspec => pathname @@ -283,14 +241,6 @@ (pathname str))) (free-foreign-object buffer))))) -(def-function "symlink" ((old :cstring) (new :cstring)) - :module "osicat" - :returning :int) - -(def-function "link" ((old :cstring) (new :cstring)) - :module "osicat" - :returning :int) - (defun make-link (target link &key hard) "function MAKE-LINK target link &key hard => pathname @@ -306,10 +256,6 @@ (pathname link) (error "Could not create ~A link ~S -> ~S." (if hard "hard" "symbolic") link target))))) - -(def-function "chmod" ((name :cstring) (mode :mode-t)) - :module "osicat" - :returning :int) (define-symbol-macro +permissions+ (load-time-value (mapcar (lambda (x) Index: src/release.txt diff -u src/release.txt:1.3 src/release.txt:1.4 --- src/release.txt:1.3 Sun Oct 26 09:19:32 2003 +++ src/release.txt Sun Feb 29 06:29:14 2004 @@ -1,6 +1,6 @@ osicat.asd -foreign-types.lisp -macros.lisp +ffi.lisp +early-util.lisp grovel-constants.lisp packages.lisp osicat.lisp

1 0