osicat-cvs

osicat-cvs@common-lisp.net

53 discussions

[osicat-cvs] CVS update: src/osicat.asd
by Nikodemus Siivola 08 Nov '03

08 Nov '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv16400 Modified Files: osicat.asd Log Message: Added support for test framework. Date: Sat Nov 8 09:21:59 2003 Author: nsiivola Index: src/osicat.asd diff -u src/osicat.asd:1.1.1.1 src/osicat.asd:1.2 --- src/osicat.asd:1.1.1.1 Wed Oct 15 10:10:58 2003 +++ src/osicat.asd Sat Nov 8 09:21:59 2003 @@ -73,3 +73,14 @@ (:file "osicat" :depends-on ("osicat-glue" "foreign-types" "macros" "grovel-constants")))) +(defsystem :osicat-test + :depends-on (:osicat :rt) + :components ((:file "osicat-test"))) + +(defmethod perform ((o test-op) (c (eql (find-system :osicat)))) + (operate 'load-op :osicat-test) + (operate 'test-op :osicat-test)) + +(defmethod perform ((o test-op) (c (eql (find-system :osicat-test)))) + (or (funcall (intern "DO-TESTS" :rt)) + (error "test-op failed")))

1 0

[osicat-cvs] CVS update: src/osicat-test.lisp
by Nikodemus Siivola 08 Nov '03

08 Nov '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv16341 Added Files: osicat-test.lisp Log Message: Tests Date: Sat Nov 8 09:21:34 2003 Author: nsiivola

1 0

[osicat-cvs] CVS update: src/osicat-glue.c
by Nikodemus Siivola 08 Nov '03

08 Nov '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv15847 Modified Files: osicat-glue.c Log Message: Merged patch from Marco Baringer. Date: Sat Nov 8 09:19:25 2003 Author: nsiivola Index: src/osicat-glue.c diff -u src/osicat-glue.c:1.5 src/osicat-glue.c:1.6 --- src/osicat-glue.c:1.5 Sun Oct 26 10:55:55 2003 +++ src/osicat-glue.c Sat Nov 8 09:19:25 2003 @@ -20,9 +20,9 @@ * SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. */ +#include <sys/types.h> #include <dirent.h> #include <sys/stat.h> -#include <sys/types.h> #include <pwd.h> extern int

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/version.txt
by Nikodemus Siivola 26 Oct '03

26 Oct '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv5144 Modified Files: osicat.lisp version.txt Log Message: Silence compiler about read-link Date: Sun Oct 26 11:10:33 2003 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.7 src/osicat.lisp:1.8 --- src/osicat.lisp:1.7 Sun Oct 26 10:55:55 2003 +++ src/osicat.lisp Sun Oct 26 11:10:33 2003 @@ -270,6 +270,9 @@ 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#) @@ -278,7 +281,7 @@ (let ((str (convert-from-foreign-string buffer :length got))) (free-foreign-object buffer) (pathname str))) - (free-foreign-object buffer)))) + (free-foreign-object buffer))))) (def-function "symlink" ((old :cstring) (new :cstring)) :module "osicat" Index: src/version.txt diff -u src/version.txt:1.4 src/version.txt:1.5 --- src/version.txt:1.4 Sun Oct 26 10:54:55 2003 +++ src/version.txt Sun Oct 26 11:10:33 2003 @@ -1 +1 @@ -0.3.1 +0.3.2

1 0

[osicat-cvs] CVS update: src/osicat-glue.c src/osicat.lisp
by Nikodemus Siivola 26 Oct '03

26 Oct '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv29772 Modified Files: osicat-glue.c osicat.lisp Log Message: Yugh, debuging cruft. Date: Sun Oct 26 10:55:55 2003 Author: nsiivola Index: src/osicat-glue.c diff -u src/osicat-glue.c:1.4 src/osicat-glue.c:1.5 --- src/osicat-glue.c:1.4 Sun Oct 26 10:54:55 2003 +++ src/osicat-glue.c Sun Oct 26 10:55:55 2003 @@ -32,11 +32,9 @@ int err; if (follow_p) { - printf ("stat\n"); err = stat (name, &buf); } else { - printf ("lstat\n"); err = lstat (name, &buf); } Index: src/osicat.lisp diff -u src/osicat.lisp:1.6 src/osicat.lisp:1.7 --- src/osicat.lisp:1.6 Sun Oct 26 10:54:55 2003 +++ src/osicat.lisp Sun Oct 26 10:55:55 2003 @@ -84,9 +84,7 @@ (let ((path (pathname pathspec))) (when (wild-pathname-p path) (error "Pathname is wild: ~S." path)) - (print (list 'namestring (namestring path))) (with-cstring (cfile (namestring path)) - (print (list 'cfile cfile)) (c-file-kind cfile nil)))) (def-function "opendir" ((name :cstring))

1 0

[osicat-cvs] CVS update: src/osicat-glue.c src/osicat.lisp src/version.txt
by Nikodemus Siivola 26 Oct '03

26 Oct '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv28260 Modified Files: osicat-glue.c osicat.lisp version.txt Log Message: Fixed FILE-KIND on symbolic links. Date: Sun Oct 26 10:54:56 2003 Author: nsiivola Index: src/osicat-glue.c diff -u src/osicat-glue.c:1.3 src/osicat-glue.c:1.4 --- src/osicat-glue.c:1.3 Sun Oct 26 09:19:32 2003 +++ src/osicat-glue.c Sun Oct 26 10:54:55 2003 @@ -31,10 +31,14 @@ struct stat buf; int err; - if (follow_p) + if (follow_p) { + printf ("stat\n"); err = stat (name, &buf); - else + } + else { + printf ("lstat\n"); err = lstat (name, &buf); + } if (! err) return buf.st_mode; Index: src/osicat.lisp diff -u src/osicat.lisp:1.5 src/osicat.lisp:1.6 --- src/osicat.lisp:1.5 Sun Oct 26 10:31:27 2003 +++ src/osicat.lisp Sun Oct 26 10:54:55 2003 @@ -84,8 +84,10 @@ (let ((path (pathname pathspec))) (when (wild-pathname-p path) (error "Pathname is wild: ~S." path)) + (print (list 'namestring (namestring path))) (with-cstring (cfile (namestring path)) - (c-file-kind cfile 0)))) + (print (list 'cfile cfile)) + (c-file-kind cfile nil)))) (def-function "opendir" ((name :cstring)) :module "osicat" Index: src/version.txt diff -u src/version.txt:1.3 src/version.txt:1.4 --- src/version.txt:1.3 Sun Oct 26 09:38:02 2003 +++ src/version.txt Sun Oct 26 10:54:55 2003 @@ -1 +1 @@ -0.3 +0.3.1

1 0

[osicat-cvs] CVS update: src/osicat.lisp
by Nikodemus Siivola 26 Oct '03

26 Oct '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv16663 Modified Files: osicat.lisp Log Message: Fix behaviour if with-directory-iterator when fed directory-names without a slash. Date: Sun Oct 26 10:31:27 2003 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.4 src/osicat.lisp:1.5 --- src/osicat.lisp:1.4 Sun Oct 26 09:38:02 2003 +++ src/osicat.lisp Sun Oct 26 10:31:27 2003 @@ -51,23 +51,23 @@ (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 - (with-unique-names (path) + (with-unique-names (path kind) `(let ((,path ,pathname)) (when (wild-pathname-p ,path) (error "Pathname is wild: ~S." ,path)) (with-cstring (,c-file (namestring ,path)) - ,(etypecase required-kind - (keyword `(let ((real-kind (c-file-kind ,c-file ,follow-p))) - (unless (eq ,required-kind real-kind) - (if real-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 real-kind ,required-kind) + ,path ,kind ,required-kind) (error "~A ~S does not exist." - ,required-kind ,path))))) - ((eql t) `(unless (c-file-kind ,c-file ,follow-p) - (error "~A does not exist." ,path))) - (null nil)) - ,@forms)))) + ,required-kind ,path)))) + ((eql t) `(unless ,kind + (error "~A does not exist." ,path))) + (null nil)) + ,@forms))))) (defun file-kind (pathspec) "function FILE-KIND pathspec => file-kind @@ -125,8 +125,14 @@ (with-c-file (,cdir ,dir :directory t) (let ((,dp nil) (,default (make-pathname :name nil - :version 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 ()

1 0

[osicat-cvs] CVS update: src/Makefile src/osicat.lisp src/version.txt
by Nikodemus Siivola 26 Oct '03

26 Oct '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv21692 Modified Files: Makefile osicat.lisp version.txt Log Message: * Version 0.3 * Fixed return value from (SETF ENVIRONMENT-VARIABLE) Date: Sun Oct 26 09:38:03 2003 Author: nsiivola Index: src/Makefile diff -u src/Makefile:1.2 src/Makefile:1.3 --- src/Makefile:1.2 Thu Oct 23 19:48:05 2003 +++ src/Makefile Sun Oct 26 09:38:02 2003 @@ -72,6 +72,7 @@ ln -s $(NAME).tar.gz.asc $(LINK).asc ln -s $(NAME).tar.gz $(LINK) mv $(NAME).tar.gz $(NAME).tar.gz.asc $(LINK) $(LINK).asc $(HTML)/files/ + cp README $(HTML)/files/ # $(RSYNC_FTP) && $(FTP_PERMS) public_html: Index: src/osicat.lisp diff -u src/osicat.lisp:1.3 src/osicat.lisp:1.4 --- src/osicat.lisp:1.3 Sun Oct 26 09:19:32 2003 +++ src/osicat.lisp Sun Oct 26 09:38:02 2003 @@ -219,7 +219,7 @@ (with-c-name (cname name) (with-c-name (cvalue value) (if (zerop (setenv cname cvalue 1)) - value + (convert-from-cstring cvalue) (error "Could not set environment variable ~S to ~S." name value))))) (defun makunbound-environment-variable (name) Index: src/version.txt diff -u src/version.txt:1.2 src/version.txt:1.3 --- src/version.txt:1.2 Thu Oct 23 19:48:05 2003 +++ src/version.txt Sun Oct 26 09:38:02 2003 @@ -1,2 +1 @@ -0.2.2 - +0.3

1 0

[osicat-cvs] CVS update: src/osicat-glue.c src/osicat.lisp src/packages.lisp src/release.txt
by Nikodemus Siivola 26 Oct '03

26 Oct '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv12299 Modified Files: osicat-glue.c osicat.lisp packages.lisp release.txt Log Message: Improved documentations. Semi-sane symlink resolution. Date: Sun Oct 26 09:19:32 2003 Author: nsiivola Index: src/osicat-glue.c diff -u src/osicat-glue.c:1.2 src/osicat-glue.c:1.3 --- src/osicat-glue.c:1.2 Thu Oct 23 19:48:05 2003 +++ src/osicat-glue.c Sun Oct 26 09:19:32 2003 @@ -26,17 +26,24 @@ #include <pwd.h> extern int -osicat_mode (char * name) +osicat_mode (char * name, int follow_p) { struct stat buf; - if (0 == lstat (name, &buf)) + int err; + + if (follow_p) + err = stat (name, &buf); + else + err = lstat (name, &buf); + + if (! err) return buf.st_mode; else /* I assume that -1 is not a valid mode? */ return -1; } -char * +extern char * osicat_dirent_name (struct dirent * entry) { return entry->d_name; Index: src/osicat.lisp diff -u src/osicat.lisp:1.2 src/osicat.lisp:1.3 --- src/osicat.lisp:1.2 Thu Oct 23 19:48:05 2003 +++ src/osicat.lisp Sun Oct 26 09:19:32 2003 @@ -21,7 +21,7 @@ (in-package :osicat) -(def-function ("osicat_mode" c-file-mode) ((name :cstring)) +(def-function ("osicat_mode" c-file-mode) ((name :cstring) (follow-p :int)) :module "osicat" :returning :int) @@ -32,22 +32,24 @@ Please report on osicat-devel(a)common-lisp.net." (message condition))))) -(eval `(defun c-file-kind (c-file) - (let ((mode (c-file-mode c-file))) - (unless (minusp mode) - (case (logand mode-mask mode) - ,@(mapcar - (lambda (sym) - (list (eval sym) - (intern (symbol-name sym) :keyword))) - ;; KLUDGE: 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)))))))) +;;; 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)))))))) -(defmacro with-c-file ((c-file pathname &optional required-kind) &body forms) +(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 (with-unique-names (path) `(let ((,path ,pathname)) @@ -55,14 +57,14 @@ (error "Pathname is wild: ~S." ,path)) (with-cstring (,c-file (namestring ,path)) ,(etypecase required-kind - (keyword `(let ((real-kind (c-file-kind ,c-file))) + (keyword `(let ((real-kind (c-file-kind ,c-file ,follow-p))) (unless (eq ,required-kind real-kind) (if real-kind (error "~A is ~A, not ~A." ,path real-kind ,required-kind) (error "~A ~S does not exist." ,required-kind ,path))))) - ((eql t) `(unless (c-file-kind ,c-file) + ((eql t) `(unless (c-file-kind ,c-file ,follow-p) (error "~A does not exist." ,path))) (null nil)) ,@forms)))) @@ -71,15 +73,19 @@ "function FILE-KIND pathspec => file-kind Returns a keyword indicating the kind of file designated by pathspec, -or NIL if the file does not exist. +or NIL if the file does not exist. Does not follow symbolic links. Possible file-kinds in addition to NIL are: :regular-file, :symbolic-link, :directory,:pipe, :socket, :character-device, and :block-device. Signals an error if pathspec is wild." - (with-c-file (c pathspec) - (c-file-kind c))) + ;; KLUDGE: OAOOM: We scurry to avoid an extra lstat here. + (let ((path (pathname pathspec))) + (when (wild-pathname-p path) + (error "Pathname is wild: ~S." path)) + (with-cstring (cfile (namestring path)) + (c-file-kind cfile 0)))) (def-function "opendir" ((name :cstring)) :module "osicat" @@ -97,8 +103,6 @@ :module "osicat" :returning :cstring) -;;; FIXME: Documentation, DIRECTORY-LIST? - (defmacro with-directory-iterator ((iterator pathspec) &body body) "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value @@ -110,12 +114,15 @@ 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. +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." +Signal an error if pathspec is wild or does not designate a directory." (with-unique-names (dp dir cdir err default) `(let ((,dir ,pathspec)) - (with-c-file (,cdir ,dir :directory) + (with-c-file (,cdir ,dir :directory t) (let ((,dp nil) (,default (make-pathname :name nil :version nil @@ -146,6 +153,8 @@ Applies function to each entry in directory designated by pathspec in turn and returns a list of the results. +If pathspec designates a symbolic link, it is implicitly resolved. + Signals an error if pathspec is wild or doesn't designate a directory." (with-directory-iterator (next pathspec) (loop for entry = (next) @@ -160,7 +169,7 @@ "function DELETE-DIRECTORY pathspec => T Deletes the direcotry designated by pathspec. Returns T. The -directory must be empty. +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." @@ -213,14 +222,11 @@ value (error "Could not set environment variable ~S to ~S." name value))))) -(setf (documentation '(setf environment-variable) 'function) - (documentation 'environment-variable 'function)) - (defun makunbound-environment-variable (name) "function MAKUNBOUND-ENVIRONMENT-VARIABLE name => string -Removes the environenr variable identified by NAME from the current -environment. NAME can be either a string or a symbol. Returns the +Removes the environment variable identified by name from the current +environment. name can be either a string or a symbol. Returns the string designated by name. Signals an error on failure." (with-c-name (cname name) (if (zerop (unsetenv cname)) @@ -310,31 +316,32 @@ function (SETF (FILE-PERMISSIONS pathspec) list) => list FILE-PERMISSIONS returns a list of keywords identifying the -permissions of PATHSPEC. +permissions of pathspec. -SETF FILE-PERMISSIONS sets the permissions of PATHSPEC as identified +SETF FILE-PERMISSIONS sets the permissions of pathspec as identified by the symbols in list. +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. Both signal an error is pathspec is wild, or doesn't designate an exiting file." - (with-c-file (path pathspec t) - (let ((mode (c-file-mode path))) + (with-c-file (path pathspec t t) + ;; FIXME: We stat twice here. + (let ((mode (c-file-mode path 1))) (loop for (name . value) in +permissions+ when (plusp (logand mode value)) collecting name)))) (defun (setf file-permissions) (perms pathspec) - (with-c-file (path pathspec t) + (with-c-file (path pathspec t t) (if (zerop (chmod path (reduce (lambda (a b) (logior a (cdr (assoc b +permissions+)))) perms :initial-value 0))) perms (error "Could not set file permissions of ~S to ~S." pathspec perms)))) - -(setf (documentation '(setf file-permissions) 'function) - (documentation 'file-permissions 'function)) Index: src/packages.lisp diff -u src/packages.lisp:1.1.1.1 src/packages.lisp:1.2 --- src/packages.lisp:1.1.1.1 Wed Oct 15 10:11:02 2003 +++ src/packages.lisp Sun Oct 26 09:19:32 2003 @@ -21,6 +21,9 @@ (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.") (:export ;;; Evironment #:environment Index: src/release.txt diff -u src/release.txt:1.2 src/release.txt:1.3 --- src/release.txt:1.2 Thu Oct 23 19:48:05 2003 +++ src/release.txt Sun Oct 26 09:19:32 2003 @@ -6,3 +6,4 @@ osicat.lisp osicat-glue.c LICENSE +README

1 0

[osicat-cvs] CVS update: src/Makefile src/grovel-constants.lisp src/osicat-glue.c src/osicat.lisp src/release.txt src/version.txt
by Nikodemus Siivola 23 Oct '03

23 Oct '03

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv20819 Modified Files: Makefile grovel-constants.lisp osicat-glue.c osicat.lisp release.txt version.txt Log Message: * Added docstrings. * No "." and ".." in directory-iteration. * :HARD option for MAKE-LINK. Date: Thu Oct 23 19:48:06 2003 Author: nsiivola Index: src/Makefile diff -u src/Makefile:1.1.1.1 src/Makefile:1.2 --- src/Makefile:1.1.1.1 Wed Oct 15 10:11:02 2003 +++ src/Makefile Thu Oct 23 19:48:05 2003 @@ -75,4 +75,4 @@ # $(RSYNC_FTP) && $(FTP_PERMS) public_html: -# $(RSYNC_HTML) && $(HTML_PERMS) + $(RSYNC_HTML) && $(HTML_PERMS) Index: src/grovel-constants.lisp diff -u src/grovel-constants.lisp:1.1.1.1 src/grovel-constants.lisp:1.2 --- src/grovel-constants.lisp:1.1.1.1 Wed Oct 15 10:11:02 2003 +++ src/grovel-constants.lisp Thu Oct 23 19:48:05 2003 @@ -3,6 +3,7 @@ (defun write-groveler (file constants) (with-open-file (f file :direction :output :if-exists :supersede) (format f " +#include <stdio.h> #include <sys/stat.h> void @@ -27,18 +28,20 @@ (unless (boundp '*grovel*) (error "No GROVEL hook!")) +(defvar *grovel*) + (setf *grovel* (lambda (c obj lisp) (write-groveler c '( ;; File types - (mode-mask . S_IFMT) - (directory . S_IFDIR) - (char-device . S_IFCHR) - (block-device . S_IFBLK) - (regular-file . S_IFREG) - (symbolic-link . S_IFLNK) - (socket . S_IFSOCK) - (pipe . S_IFIFO) + (mode-mask . S_IFMT) + (directory . S_IFDIR) + (character-device . S_IFCHR) + (block-device . S_IFBLK) + (regular-file . S_IFREG) + (symbolic-link . S_IFLNK) + (socket . S_IFSOCK) + (pipe . S_IFIFO) ;; Permissions (user-read . S_IRUSR) (user-write . S_IWUSR) @@ -51,7 +54,10 @@ (other-exec . S_IXOTH) (set-user-id . S_ISUID) (set-group-id . S_ISGID) - (sticky . S_ISVTX))) + (sticky . S_ISVTX) + ;; Misc + (eof . EOF) + )) (and (zerop (run-shell-command "~A ~A -o ~A" *gcc* (namestring c) Index: src/osicat-glue.c diff -u src/osicat-glue.c:1.1.1.1 src/osicat-glue.c:1.2 --- src/osicat-glue.c:1.1.1.1 Wed Oct 15 10:11:01 2003 +++ src/osicat-glue.c Thu Oct 23 19:48:05 2003 @@ -41,3 +41,7 @@ { return entry->d_name; } + + + + Index: src/osicat.lisp diff -u src/osicat.lisp:1.1.1.1 src/osicat.lisp:1.2 --- src/osicat.lisp:1.1.1.1 Wed Oct 15 10:11:01 2003 +++ src/osicat.lisp Thu Oct 23 19:48:05 2003 @@ -40,7 +40,8 @@ (lambda (sym) (list (eval sym) (intern (symbol-name sym) :keyword))) - '(directory char-device block-device + ;; KLUDGE: OAOOM. These are in grovel-constants.lisp as well. + '(directory character-device block-device regular-file symbolic-link pipe socket)) (t (error 'bug :message @@ -50,6 +51,8 @@ ;; FIXME: This assumes that OS has the same idea of current dir as Lisp (with-unique-names (path) `(let ((,path ,pathname)) + (when (wild-pathname-p ,path) + (error "Pathname is wild: ~S." ,path)) (with-cstring (,c-file (namestring ,path)) ,(etypecase required-kind (keyword `(let ((real-kind (c-file-kind ,c-file))) @@ -64,6 +67,20 @@ (null nil)) ,@forms)))) +(defun file-kind (pathspec) + "function FILE-KIND pathspec => file-kind + +Returns a keyword indicating the kind of file designated by pathspec, +or NIL if the file does not exist. + +Possible file-kinds in addition to NIL are: :regular-file, +:symbolic-link, :directory,:pipe, :socket, :character-device, and +:block-device. + +Signals an error if pathspec is wild." + (with-c-file (c pathspec) + (c-file-kind c))) + (def-function "opendir" ((name :cstring)) :module "osicat" :returning :pointer-void) @@ -82,7 +99,20 @@ ;;; FIXME: Documentation, DIRECTORY-LIST? -(defmacro with-directory-iterator ((iterator pathspec) &body forms) +(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 +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. + +The value returned is the value of the last form evaluated in body. + +Signal an error if pathspec is wild or does not designate a directory." (with-unique-names (dp dir cdir err default) `(let ((,dir ,pathspec)) (with-c-file (,cdir ,dir :directory) @@ -92,26 +122,31 @@ :type nil :defaults ,dir))) (unwind-protect - (flet ((,iterator () - (let ((entry (readdir ,dp))) - (if (null-pointer-p entry) - nil - (merge-pathnames - (convert-from-cstring - (osicat-dirent-name entry)) - ,default))))) + (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))))))) (setf ,dp (opendir ,cdir)) (when (null-pointer-p ,dp) (error "Error opening directory ~S." ,dir)) - ,@forms) + ,@body) (when ,dp (if (zerop (closedir ,dp)) nil (error "Error closing directory ~S." ,dir))))))))) (defun mapdir (function pathspec) - "Applies FUNCTION to each entry in DIRECTORY in turn and returns a -list of the results." + "function MAPDIR function pathspec => list + +Applies function to each entry in directory designated by pathspec in +turn and returns a list of the results. + +Signals an error if pathspec is wild or doesn't designate a directory." (with-directory-iterator (next pathspec) (loop for entry = (next) while entry @@ -122,7 +157,13 @@ :returning :int) (defun delete-directory (pathspec) - "Deletes DIRECTORY, which must be empty." + "function DELETE-DIRECTORY pathspec => T + +Deletes the direcotry designated by pathspec. Returns T. The +directory must be empty. + +Signals an error if pathspec is wild, doesn't designate a directory, +or if the direcotry could not be deleted." (with-c-file (path pathspec :directory) (if (zerop (rmdir path)) pathspec @@ -152,25 +193,35 @@ ,@forms)))) (defun environment-variable (name) - "Returns the environment variable identified by NAME, or NIL if one -does not exist. NAME can either be a symbol or a string." + "function ENVIRONMENT-VARIABLE name => string +function (SETF (ENVIRONMENT-VARIABLE name) value) => value + +ENVIRONMENT-VARIABLE returns the environment variable identified by +name, or NIL if one does not exist. Name can either be a symbol or a +string. + +SETF ENVIRONMENT-VARIABLE sets the environment variable identified by +name to value. Both name and value can be either a symbols or +strings. Signals an error on failure." (with-c-name (cname name) (copy-seq (convert-from-cstring (getenv cname))))) (defun (setf environment-variable) (value name) - "Sets the environment variable identified by NAME to VALUE. Both -NAME and VALUE can be either a symbol or a string. Signals an error on -failure." (with-c-name (cname name) (with-c-name (cvalue value) (if (zerop (setenv cname cvalue 1)) value (error "Could not set environment variable ~S to ~S." name value))))) +(setf (documentation '(setf environment-variable) 'function) + (documentation 'environment-variable 'function)) + (defun makunbound-environment-variable (name) - "Removes the environemtn variable identified by NAME from the -current environment. NAME can be either a string or a symbol. Signals -an error on failure." + "function MAKUNBOUND-ENVIRONMENT-VARIABLE name => string + +Removes the environenr variable identified by NAME from the current +environment. NAME can be either a string or a symbol. Returns the +string designated by name. Signals an error on failure." (with-c-name (cname name) (if (zerop (unsetenv cname)) nil @@ -187,7 +238,9 @@ (define-symbol-macro environment (get-environ)) (setf (documentation 'environment 'variable) - "The current environment as a read-only assoc-list. To modify + "symbol-macro ENVIRONMENT + +The current environment as a read-only assoc-list. To modify the environment use (SETF ENVIRONMENT-VARIABLE) and MAKUNBOUND-ENVIRONMENT-VARIABLE.") @@ -197,6 +250,14 @@ :returning :int) (defun read-link (pathspec) + "function READ-LINK pathspec => pathname + +Returns the pathname pointed to by the symbolic link designated by +pathspec. If the link is relative, then the returned pathname is +relative to the link, not *default-pathname-defaults*. + +Signals an error if pathspec is wild, or does not designate a symbolic +link." (with-c-file (path pathspec :symbolic-link) (do* ((size 64 (* size 2)) (buffer #1=(allocate-foreign-string size) #1#) @@ -211,13 +272,25 @@ :module "osicat" :returning :int) -(defun make-link (target link) - "Creates LINK as a symbolic link to TARGET." - (with-c-file (old target t) +(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 + +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. + +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 (symlink old new)) - link - (error "Could not make symbolic link ~S -> ~S." link target))))) + (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))))) (def-function "chmod" ((name :cstring) (mode :mode-t)) :module "osicat" @@ -233,21 +306,28 @@ set-user-id set-group-id sticky)))) (defun file-permissions (pathspec) - "Returns a list of keywords identifying the permissions of -PATHSPEC. 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." + "function FILE-PERMISSIONS pathspec => list +function (SETF (FILE-PERMISSIONS pathspec) list) => list + +FILE-PERMISSIONS returns a list of keywords identifying the +permissions of PATHSPEC. + +SETF FILE-PERMISSIONS sets the permissions of PATHSPEC as identified +by the symbols in list. + +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." (with-c-file (path pathspec t) - (let ((mode (osicat-mode path))) + (let ((mode (c-file-mode path))) (loop for (name . value) in +permissions+ when (plusp (logand mode value)) collecting name)))) (defun (setf file-permissions) (perms pathspec) - "Sets the permissions of PATHSPEC as identified by the symbols in -list PERMS. 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." (with-c-file (path pathspec t) (if (zerop (chmod path (reduce (lambda (a b) (logior a (cdr (assoc b +permissions+)))) @@ -255,3 +335,6 @@ :initial-value 0))) perms (error "Could not set file permissions of ~S to ~S." pathspec perms)))) + +(setf (documentation '(setf file-permissions) 'function) + (documentation 'file-permissions 'function)) Index: src/release.txt diff -u src/release.txt:1.1.1.1 src/release.txt:1.2 --- src/release.txt:1.1.1.1 Wed Oct 15 10:11:03 2003 +++ src/release.txt Thu Oct 23 19:48:05 2003 @@ -1,4 +1,6 @@ osicat.asd +foreign-types.lisp +macros.lisp grovel-constants.lisp packages.lisp osicat.lisp Index: src/version.txt diff -u src/version.txt:1.1.1.1 src/version.txt:1.2 --- src/version.txt:1.1.1.1 Wed Oct 15 10:11:03 2003 +++ src/version.txt Thu Oct 23 19:48:05 2003 @@ -1 +1,2 @@ -0.1 +0.2.2 +

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

osicat-cvs