osicat-cvs April 2004

osicat-cvs@common-lisp.net

2 participants
13 discussions

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
by Julian E. C. Squires 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv22258 Modified Files: osicat.lisp test-osicat.lisp Log Message: Updated copyright on files I've done much with. Date: Sun Apr 25 11:10:58 2004 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.29 src/osicat.lisp:1.30 --- src/osicat.lisp:1.29 Sun Apr 25 10:59:06 2004 +++ src/osicat.lisp Sun Apr 25 11:10:58 2004 @@ -1,4 +1,4 @@ -;; Copyright (c) 2003, 2004 Nikodemus Siivola +;; Copyright (c) 2003, 2004 Nikodemus Siivola, Julian Squires ;; ;; Permission is hereby granted, free of charge, to any person obtaining ;; a copy of this software and associated documentation files (the Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.9 src/test-osicat.lisp:1.10 --- src/test-osicat.lisp:1.9 Sun Apr 25 10:57:57 2004 +++ src/test-osicat.lisp Sun Apr 25 11:10:58 2004 @@ -1,4 +1,4 @@ -;; Copyright (c) 2003 Nikodemus Siivola +;; Copyright (c) 2003, 2004 Nikodemus Siivola, Julian Squires ;; ;; Permission is hereby granted, free of charge, to any person obtaining ;; a copy of this software and associated documentation files (the

1 0

[osicat-cvs] CVS update: src/make-readme.lisp src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv11045 Modified Files: make-readme.lisp osicat.lisp packages.lisp Log Message: * Documentation update. Date: Sun Apr 25 10:59:06 2004 Author: nsiivola Index: src/make-readme.lisp diff -u src/make-readme.lisp:1.2 src/make-readme.lisp:1.3 --- src/make-readme.lisp:1.2 Sun Apr 25 08:24:12 2004 +++ src/make-readme.lisp Sun Apr 25 10:59:06 2004 @@ -33,7 +33,7 @@ when doc collect (cons (symbol-name sym) doc)))) (setf syms (sort syms #'string< :key #'car)) - (format t "OSICAT ~A~%~%" osicat:*osicat-version*) + (format t "OSICAT ~{~A~^.~}~%~%" osicat:*osicat-version*) (format t "~A~%~%---~%~%" (documentation (find-package :osicat) t)) (format t "Dictionary:~%~%") (dolist (cons syms) Index: src/osicat.lisp diff -u src/osicat.lisp:1.28 src/osicat.lisp:1.29 --- src/osicat.lisp:1.28 Sun Apr 25 10:57:57 2004 +++ src/osicat.lisp Sun Apr 25 10:59:06 2004 @@ -21,7 +21,11 @@ (in-package :osicat) -(defparameter *osicat-version* '(0 4 0)) +(defparameter *osicat-version* '(0 4 0) + "variable *OSICAT-VERSION* + +Osicat version number represented as a list of three integers. The +three integers represent major, minor, and revision versions.") ;;;; Common subroutines @@ -345,7 +349,7 @@ ;;; File permissions (defconstant +permissions+ (if (boundp '+permissions+) - +permissions+ + (symbol-value '+permissions+) (mapcar (lambda (x) (cons (intern (symbol-name x) :keyword) (eval x))) Index: src/packages.lisp diff -u src/packages.lisp:1.11 src/packages.lisp:1.12 --- src/packages.lisp:1.11 Sun Apr 25 09:50:58 2004 +++ src/packages.lisp Sun Apr 25 10:59:06 2004 @@ -26,7 +26,9 @@ 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:

1 0

[osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
by Julian E. C. Squires 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv3584 Modified Files: osicat.lisp test-osicat.lisp Log Message: * Fixed a bug in READ-LINK for long links. * Updated tests with respect to dead NORMPATH. * Added WITH-DIRECTORY-ITERATOR tests. Date: Sun Apr 25 10:57:57 2004 Author: jsquires Index: src/osicat.lisp diff -u src/osicat.lisp:1.27 src/osicat.lisp:1.28 --- src/osicat.lisp:1.27 Sun Apr 25 10:44:34 2004 +++ src/osicat.lisp Sun Apr 25 10:57:57 2004 @@ -306,7 +306,7 @@ (with-c-file (path (absolute-pathname pathspec) :symbolic-link) (do* ((size 64 (* size 2)) (buffer #1=(allocate-foreign-string size) #1#) - (got (readlink path buffer size))) + (got #2=(readlink path buffer size) #2#)) ((< got size) (let ((str (convert-from-foreign-string buffer :length got))) (free-foreign-object buffer) Index: src/test-osicat.lisp diff -u src/test-osicat.lisp:1.8 src/test-osicat.lisp:1.9 --- src/test-osicat.lisp:1.8 Sat Apr 24 12:40:02 2004 +++ src/test-osicat.lisp Sun Apr 25 10:57:57 2004 @@ -50,9 +50,8 @@ t) (deftest environment.1 - (namestring (osicat::normpath (cdr (assoc "HOME" (environment) - :test #'equal)) - t)) + (namestring (probe-file (cdr (assoc "HOME" (environment) + :test #'equal)))) #.(namestring (user-homedir-pathname))) (deftest environment.2 @@ -158,7 +157,30 @@ (delete-file file) (delete-file link))) :symbolic-link) - + +;; Test the case of reading a link to a directory. +(deftest read-link.1 + (let ((link (merge-pathnames "read-link-test-link" *test-dir*))) + (unwind-protect + (progn + (make-link link :target *test-dir*) + (namestring (read-link link))) + (delete-file link))) + #.(namestring *test-dir*)) + +;; Test the case of reading a link with a very long name. +(deftest read-link.1 + (let ((link (merge-pathnames "make-link-test-link" *test-dir*)) + (file (ensure-file "a-very-long-tmp-file-name-explicitly-for-the-purpose-of-testing-a-certain-condition-in-read-link-please-ignore-thanks"))) + (unwind-protect + (progn + (make-link link :target file) + (equal (namestring (merge-pathnames file *test-dir*)) + (namestring (read-link link)))) + (delete-file link) + (delete-file file))) + t) + (deftest maunbound-environment-variable.1 (let ((old (environment-variable :path))) (unwind-protect @@ -225,6 +247,63 @@ (when (/= (length list) 2) (error "too many path elements."))) (delete-directory dir))) nil) + +;; Be careful with this test. It deletes directories recursively. +(deftest with-directory-iterator.1 + (let ((dirs (list "wdi-test-1/" ".wdi-test.2/" ".wdi.test.3../"))) + (ensure-directories-exist (reduce (lambda (x y) (merge-pathnames y x)) + (cons *test-dir* dirs))) + (labels ((rm-r (dir) + (with-directory-iterator (next dir) + (loop for file = (next) + while file + when (and (eql (file-kind file) :directory) + (member (namestring file) dirs + :test #'string=)) + do (progn (rm-r file) + (delete-directory file)))))) + (rm-r *test-dir*))) + nil) + +;; Test iteration over a variety of objects. +(deftest with-directory-iterator.2 + (let ((playground '(:directory "wdi-test-1/" + (:directory "wdi-test-2/" + (:symbolic-link "bar" "foo") + (:directory "baz/" + (:file "quux")) + (:file "foo"))))) + (labels + ((create-playground (x base-dir) + (case (car x) + (:file (ensure-file (cadr x) base-dir)) + (:symbolic-link (make-link (merge-pathnames (cadr x) base-dir) + :target (merge-pathnames + (caddr x) base-dir))) + (:directory (ensure-directories-exist (merge-pathnames + (cadr x) base-dir)) + (dolist (y (cddr x)) + (create-playground y (merge-pathnames + (cadr x) base-dir)))))) + (walk (dir) + (with-directory-iterator (next dir) + (loop for file = (next) + while file + collect (case (file-kind file) + (:directory + (append (list :directory (namestring file)) + (sort (walk file) + (lambda (a b) + (string<= (cadr a) (cadr b)))))) + (:symbolic-link + (list :symbolic-link (namestring file) + (pathname-name (namestring + (read-link file))))) + (t (list :file (namestring file)))))))) + (create-playground playground *test-dir*) + (equal (walk (merge-pathnames (cadr playground) *test-dir*)) + (cddr playground)))) + t) ;; Test behavior in the case of an obviously incorrect username. (deftest user-info.1

1 0

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

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv23387 Modified Files: osicat.lisp Log Message: * Use a list as the internal version number, so that user code depending on version X doesn't have to do any parsing. Date: Sun Apr 25 10:44:34 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.26 src/osicat.lisp:1.27 --- src/osicat.lisp:1.26 Sun Apr 25 09:50:58 2004 +++ src/osicat.lisp Sun Apr 25 10:44:34 2004 @@ -21,10 +21,7 @@ (in-package :osicat) -(defparameter *osicat-version* - #.(with-open-file (f (merge-pathnames "version.txt" - *compile-file-truename*)) - (symbol-name (read f)))) +(defparameter *osicat-version* '(0 4 0)) ;;;; Common subroutines

1 0

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

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv3873 Modified Files: osicat.lisp packages.lisp Log Message: * New function ABSOLUTE-PATHNAME-P. * Export pathname utilities. Date: Sun Apr 25 09:50:58 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.25 src/osicat.lisp:1.26 --- src/osicat.lisp:1.25 Sun Apr 25 09:14:18 2004 +++ src/osicat.lisp Sun Apr 25 09:50:58 2004 @@ -26,7 +26,7 @@ *compile-file-truename*)) (symbol-name (read f)))) -;;;; COMMON SUBROUTINES +;;;; Common subroutines (declaim (inline c-file-kind)) (macrolet ((def () @@ -68,10 +68,25 @@ ,@forms)) forms))))) +;;;; Hopefully portable pathname manipulations + +(defun absolute-pathname-p (pathspec) + "function ABSOLUTE-PATHNAME-P pathspec => boolean + +Returns T if the pathspec designates an absolute pathname, NIL otherwise." + (eq :absolute (car (pathname-directory pathspec)))) + (defun relative-pathname-p (pathspec) - (not (eq :absolute (car (pathname-directory pathspec))))) + "function RELATIVE-PATHNAME-p pathspec => boolean + +Returns T if the pathspec designates a relative pathname, NIL otherwise." + (not (absolute-pathname-p pathspec))) (defun absolute-pathname (pathspec &optional (default *default-pathname-defaults*)) + "function ABSOLUTE-PATHNAME pathspec &optional default => pathname + +Returns an absolute pathname corresponding to pathspec by merging it with default, +and (current-directory) if necessary." (if (relative-pathname-p pathspec) (let ((tmp (merge-pathnames pathspec @@ -82,10 +97,13 @@ tmp)) pathspec)) -(defun unmerge-pathnames - (pathspec &optional (known *default-pathname-defaults*)) +(defun unmerge-pathnames (pathspec &optional (default *default-pathname-defaults*)) + "function UNMERGE-PATHNAMES pathspec &optional default => pathname + +Removes those leading directory components from pathspec that are +shared with default." (let* ((dir (pathname-directory pathspec)) - (mismatch (mismatch dir (pathname-directory known) :test #'equal))) + (mismatch (mismatch dir (pathname-directory default) :test #'equal))) (make-pathname :directory (when mismatch `(:relative ,@(subseq dir mismatch))) @@ -110,7 +128,7 @@ (with-cstring (cfile (namestring path)) (c-file-kind cfile nil)))) -;;;; DIRECTORY ACCESS +;;;; Directory access (defmacro with-directory-iterator ((iterator pathspec) &body body) "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value @@ -208,6 +226,8 @@ pathspec (error "Could not delete directory ~S." pathspec)))) +;;;; Environment access + (defun environment-variable (name) "function ENVIRONMENT-VARIABLE name => string function (SETF (ENVIRONMENT-VARIABLE name) value) => value @@ -272,6 +292,8 @@ do (makunbound-environment-variable var))) alist) +;;;; Symbolic and hard links + (defun read-link (pathspec) "function READ-LINK pathspec => pathname @@ -323,14 +345,17 @@ (if hard "hard" "symbolic") new old)))) (setf (current-directory) old)))) -(define-symbol-macro +permissions+ - (load-time-value (mapcar (lambda (x) - (cons (intern (symbol-name x) :keyword) - (eval x))) - '(user-read user-write user-exec - group-read group-write group-exec - other-read other-write other-exec - set-user-id set-group-id sticky)))) +;;; File permissions + +(defconstant +permissions+ (if (boundp '+permissions+) + +permissions+ + (mapcar (lambda (x) + (cons (intern (symbol-name x) :keyword) + (eval x))) + '(user-read user-write user-exec + group-read group-write group-exec + other-read other-write other-exec + set-user-id set-group-id sticky)))) (defun file-permissions (pathspec) "function FILE-PERMISSIONS pathspec => list @@ -366,6 +391,8 @@ :initial-value 0))) perms (error "Could not set file permissions of ~S to ~S." pathspec perms)))) + +;;;; Current directory (defun current-directory () "function CURRENT-DIRECTORY => pathname Index: src/packages.lisp diff -u src/packages.lisp:1.10 src/packages.lisp:1.11 --- src/packages.lisp:1.10 Sun Apr 25 08:24:12 2004 +++ src/packages.lisp Sun Apr 25 09:50:58 2004 @@ -59,5 +59,9 @@ #:user-info ;; Version info #:*osicat-version* + ;; Pathname utilities + #:absolute-pathname + #:absolute-pathname-p + #:relative-pathname-p + #:unmerge-pathnames )) -

1 0

[osicat-cvs] CVS update: src/osicat.asd src/osicat.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv18664 Modified Files: osicat.asd osicat.lisp Log Message: * Die NORMPATH, die! Date: Sun Apr 25 09:14:18 2004 Author: nsiivola Index: src/osicat.asd diff -u src/osicat.asd:1.8 src/osicat.asd:1.9 --- src/osicat.asd:1.8 Sun Apr 25 07:02:24 2004 +++ src/osicat.asd Sun Apr 25 09:14:18 2004 @@ -83,7 +83,7 @@ ;;;; TESTING (defsystem :osicat-test - :depends-on (:osicat :rt) + :depends-on (:osicat :rt #+sbcl :sb-posix) :components ((:file "test-tools") (:file "test-osicat" :depends-on ("test-tools")))) Index: src/osicat.lisp diff -u src/osicat.lisp:1.24 src/osicat.lisp:1.25 --- src/osicat.lisp:1.24 Sun Apr 25 08:24:12 2004 +++ src/osicat.lisp Sun Apr 25 09:14:18 2004 @@ -91,24 +91,6 @@ `(:relative ,@(subseq dir mismatch))) :defaults pathspec))) -(defun normpath (pathspec &optional absolute) - (flet ((fixeddir (path) - (let ((dir (pathname-directory - (concatenate 'string (namestring path) "/")))) - (if (member (car dir) '(:absolute :relative)) - dir - (cons :relative dir))))) - (let ((path (absolute-pathname pathspec))) - (with-cstring (cfile (namestring path)) - (let ((abspath (if (eq :directory (c-file-kind cfile t)) - (make-pathname :name nil :type nil - :directory (fixeddir path) - :defaults path) - path))) - (if absolute - abspath - (unmerge-pathnames abspath))))))) - ;;;; FILE-KIND (defun file-kind (pathspec) @@ -153,12 +135,13 @@ (with-unique-names (one-iter) `(call-with-directory-iterator ,pathspec (lambda (,one-iter) + (declare (type function ,one-iter)) (macrolet ((,iterator () `(funcall ,',one-iter))) ,@body))))) (defun call-with-directory-iterator (pathspec fun) - (let ((dir (normpath pathspec t)) + (let ((dir (absolute-pathname pathspec)) (old-dir (current-directory))) (with-c-file (cdir dir :directory t) (let (dp) @@ -220,7 +203,7 @@ Signals an error if pathspec is wild, doesn't designate a directory, or if the directory could not be deleted." - (with-c-file (path (normpath pathspec t) :directory) + (with-c-file (path (absolute-pathname pathspec) :directory) (if (zerop (rmdir path)) pathspec (error "Could not delete directory ~S." pathspec)))) @@ -301,7 +284,7 @@ (handler-bind ;; FIXME: Declare types properly to get rid of this. (#+sbcl (sb-ext:compiler-note #'muffle-warning)) - (with-c-file (path (normpath pathspec t) :symbolic-link) + (with-c-file (path (absolute-pathname pathspec) :symbolic-link) (do* ((size 64 (* size 2)) (buffer #1=(allocate-foreign-string size) #1#) (got (readlink path buffer size))) @@ -333,7 +316,7 @@ (with-c-file (old (if hard (merge-pathnames target link) target)) (with-c-file (new link) (setf (current-directory) - (normpath *default-pathname-defaults* t)) + (absolute-pathname *default-pathname-defaults*)) (if (zerop (funcall (if hard #'link #'symlink) old new)) (pathname link) (error "MAKE-LINK: Could not create ~A link ~S -> ~S."

1 0

[osicat-cvs] CVS update: src/make-readme.lisp src/osicat.lisp src/packages.lisp
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv26078 Modified Files: make-readme.lisp osicat.lisp packages.lisp Log Message: * Documentation updates. Date: Sun Apr 25 08:24:12 2004 Author: nsiivola Index: src/make-readme.lisp diff -u src/make-readme.lisp:1.1 src/make-readme.lisp:1.2 --- src/make-readme.lisp:1.1 Sun Feb 29 07:44:47 2004 +++ src/make-readme.lisp Sun Apr 25 08:24:12 2004 @@ -34,9 +34,10 @@ collect (cons (symbol-name sym) doc)))) (setf syms (sort syms #'string< :key #'car)) (format t "OSICAT ~A~%~%" osicat:*osicat-version*) - (format t "~A~%~%~%" (documentation (find-package :osicat) t)) + (format t "~A~%~%---~%~%" (documentation (find-package :osicat) t)) + (format t "Dictionary:~%~%") (dolist (cons syms) (format t "~& - ~A~%" (string-downcase (car cons)))) - (format t "~%~%") + (format t "~%") (dolist (cons syms) (format t "---~%~%~A~%~%" (cdr cons))))) Index: src/osicat.lisp diff -u src/osicat.lisp:1.23 src/osicat.lisp:1.24 --- src/osicat.lisp:1.23 Sun Apr 25 08:11:31 2004 +++ src/osicat.lisp Sun Apr 25 08:24:12 2004 @@ -141,14 +141,15 @@ 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. The entries are -returned as relative pathnames against the designated -directory. Entries that are symbolic links are not resolved, but links -that point to directories are interpreted as directory -designators. Once all entries have been returned, further invocations -of (iterator) will all return NIL. +returned as relative pathnames against the designated directory. +Entries that are symbolic links are not resolved, but links that point +to directories are interpreted as directory designators. 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. Signals an error if pathspec is wild or does not designate a directory." +body. Signals an error if pathspec is wild or does not designate a +directory." (with-unique-names (one-iter) `(call-with-directory-iterator ,pathspec (lambda (,one-iter) @@ -298,6 +299,7 @@ Signals an error if pathspec is wild, or does not designate a symbolic link." (handler-bind + ;; FIXME: Declare types properly to get rid of this. (#+sbcl (sb-ext:compiler-note #'muffle-warning)) (with-c-file (path (normpath pathspec t) :symbolic-link) (do* ((size 64 (* size 2)) Index: src/packages.lisp diff -u src/packages.lisp:1.9 src/packages.lisp:1.10 --- src/packages.lisp:1.9 Sun Apr 25 07:16:25 2004 +++ src/packages.lisp Sun Apr 25 08:24:12 2004 @@ -34,8 +34,7 @@ When a relative pathname designator is used as a directory designator it is first resolved agains *default-pathname-default*, and then - against the current directory. (With MERGE-PATHNAMES in both cases.) -") + against the current directory. (With MERGE-PATHNAMES in both cases.)") (:shadow ;; DIRECTORY is used as constant internally. Let's not confuse other packages. #:directory)

1 0

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

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv17487 Modified Files: osicat.lisp Log Message: * Rewrote WITH-DIRECTORY-ITERATOR in CALL-WITH... style. Date: Sun Apr 25 08:11:32 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.22 src/osicat.lisp:1.23 --- src/osicat.lisp:1.22 Sun Apr 25 07:16:25 2004 +++ src/osicat.lisp Sun Apr 25 08:11:31 2004 @@ -142,52 +142,58 @@ entries, one by one. Both files and directories are returned, except '.' and '..'. The order of entries is not guaranteed. The entries are returned as relative pathnames against the designated -directory. Entries that are symbolic links are not resolved. Once all -entries have been returned, further invocations of (iterator) will all -return NIL. +directory. Entries that are symbolic links are not resolved, but links +that point to directories are interpreted as directory +designators. 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. Signals an error if pathspec is wild or does not designate a directory." - (with-unique-names (dp dir cdir old-dir one-iter) - `(let ((,dir (normpath ,pathspec t)) - (,old-dir (current-directory))) - (with-c-file (,cdir ,dir :directory t) - (let (,dp) - (unwind-protect - (labels ((,one-iter () - (let ((entry (readdir ,dp))) - (if (null-pointer-p entry) - nil - (let* ((cname (osicat-dirent-name entry)) - (name (convert-from-cstring cname))) - (declare (type simple-string name)) - (cond - ((member name '("." "..") :test #'string=) - (,one-iter)) - ((eq :directory (c-file-kind cname t)) - (make-pathname - :directory `(:relative ,name))) - (t - (let ((dotpos (position #\. name :from-end t))) - (if (and dotpos (plusp dotpos)) - (make-pathname - :name (subseq name 0 dotpos) - :type (subseq name (1+ dotpos))) - (make-pathname - :name 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)) - (setf (current-directory) ,dir) - ,@body))) - (when ,dp - (if (zerop (closedir ,dp)) - nil - (error "Error closing directory ~S." ,dir))) - (setf (current-directory) ,old-dir))))))) + (with-unique-names (one-iter) + `(call-with-directory-iterator ,pathspec + (lambda (,one-iter) + (macrolet ((,iterator () + `(funcall ,',one-iter))) + ,@body))))) + +(defun call-with-directory-iterator (pathspec fun) + (let ((dir (normpath pathspec t)) + (old-dir (current-directory))) + (with-c-file (cdir dir :directory t) + (let (dp) + (unwind-protect + (labels ((one-iter () + (let ((entry (readdir dp))) + (if (null-pointer-p entry) + nil + (let* ((cname (osicat-dirent-name entry)) + (name (convert-from-cstring cname))) + (declare (type simple-string name)) + (cond + ((member name '("." "..") :test #'string=) + (one-iter)) + ((eq :directory (c-file-kind cname t)) + (make-pathname + :directory `(:relative ,name))) + (t + (let ((dotpos (position #\. name :from-end t))) + (if (and dotpos (plusp dotpos)) + (make-pathname + :name (subseq name 0 dotpos) + :type (subseq name (1+ dotpos))) + (make-pathname + :name name)))))))))) + (setf dp (opendir cdir)) + (when (null-pointer-p dp) + (error "Error opening directory ~S." dir)) + (let ((*default-pathname-defaults* dir)) + (setf (current-directory) dir) + (funcall fun #'one-iter))) + (when dp + (if (zerop (closedir dp)) + nil + (error "Error closing directory ~S." dir))) + (setf (current-directory) old-dir)))))) (defun mapdir (function pathspec) "function MAPDIR function pathspec => list

1 0

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

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv5559 Modified Files: osicat.lisp packages.lisp Log Message: * Arrgh. It seems that SBCL at least doesn't like pathname types with dots anymore, so make sure that all the dots end up in the name. Date: Sun Apr 25 07:16:25 2004 Author: nsiivola Index: src/osicat.lisp diff -u src/osicat.lisp:1.21 src/osicat.lisp:1.22 --- src/osicat.lisp:1.21 Sun Apr 25 07:02:24 2004 +++ src/osicat.lisp Sun Apr 25 07:16:25 2004 @@ -168,7 +168,7 @@ (make-pathname :directory `(:relative ,name))) (t - (let ((dotpos (position #\. name))) + (let ((dotpos (position #\. name :from-end t))) (if (and dotpos (plusp dotpos)) (make-pathname :name (subseq name 0 dotpos) Index: src/packages.lisp diff -u src/packages.lisp:1.8 src/packages.lisp:1.9 --- src/packages.lisp:1.8 Thu Apr 22 20:01:20 2004 +++ src/packages.lisp Sun Apr 25 07:16:25 2004 @@ -34,7 +34,8 @@ When a relative pathname designator is used as a directory designator it is first resolved agains *default-pathname-default*, and then - against the current directory. (With MERGE-PATHNAMES in both cases.)") + against the current directory. (With MERGE-PATHNAMES in both cases.) +") (:shadow ;; DIRECTORY is used as constant internally. Let's not confuse other packages. #:directory)

1 0

[osicat-cvs] CVS update: src/osicat.asd src/osicat.lisp src/version.txt
by Nikodemus Siivola 25 Apr '04

25 Apr '04

Update of /project/osicat/cvsroot/src In directory common-lisp.net:/tmp/cvs-serv19018 Modified Files: osicat.asd osicat.lisp version.txt Log Message: * Better handling of returned directory entries in WITH-DIRECTORY-ITERATOR. This also let's use be rid of ESCAPE-WILD-NAME which was unportable. * Incremented version number to 0.4.0 in preparation for release. Date: Sun Apr 25 07:02:24 2004 Author: nsiivola Index: src/osicat.asd diff -u src/osicat.asd:1.7 src/osicat.asd:1.8 --- src/osicat.asd:1.7 Fri Mar 5 13:34:54 2004 +++ src/osicat.asd Sun Apr 25 07:02:24 2004 @@ -69,7 +69,7 @@ ;;;; SYSTEM (defsystem :osicat - :version "0.3.6" + :version "0.4.0" :depends-on (:uffi) :components ((:c-source-file "osicat-glue") Index: src/osicat.lisp diff -u src/osicat.lisp:1.20 src/osicat.lisp:1.21 --- src/osicat.lisp:1.20 Sat Apr 24 12:40:02 2004 +++ src/osicat.lisp Sun Apr 25 07:02:24 2004 @@ -82,15 +82,6 @@ tmp)) pathspec)) -(defun escape-wild-name (name) - (declare (simple-string name)) - (let (stack) - (loop for char across name - when (member char '(#\* #\[)) - do (push #\\ stack) - do (push char stack)) - (coerce (nreverse stack) 'simple-string))) - (defun unmerge-pathnames (pathspec &optional (known *default-pathname-defaults*)) (let* ((dir (pathname-directory pathspec)) @@ -142,21 +133,24 @@ (defmacro with-directory-iterator ((iterator pathspec) &body body) "macro WITH-DIRECTORY-ITERATOR (iterator pathspec) &body forms => value -The directory designated by pathspec is then bound to -*default-pathname-defaults* for the dynamic scope of the body. +Pathspec must be a valid directory designator: +*default-pathname-defaults* is bound, and (current-directory) is set +to the designated directory 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. 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. +returned as relative pathnames against the designated +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. Signals an error if pathspec is wild or does not designate a directory." - (with-unique-names (dp dir cdir one-iter) - `(let ((,dir (normpath ,pathspec t))) + (with-unique-names (dp dir cdir old-dir one-iter) + `(let ((,dir (normpath ,pathspec t)) + (,old-dir (current-directory))) (with-c-file (,cdir ,dir :directory t) (let (,dp) (unwind-protect @@ -164,24 +158,36 @@ (let ((entry (readdir ,dp))) (if (null-pointer-p entry) nil - (let ((string - (convert-from-cstring - (osicat-dirent-name entry)))) - (if (member string '("." "..") - :test #'string=) - (,one-iter) - (normpath (escape-wild-name string)))))))) + (let* ((cname (osicat-dirent-name entry)) + (name (convert-from-cstring cname))) + (declare (type simple-string name)) + (cond + ((member name '("." "..") :test #'string=) + (,one-iter)) + ((eq :directory (c-file-kind cname t)) + (make-pathname + :directory `(:relative ,name))) + (t + (let ((dotpos (position #\. name))) + (if (and dotpos (plusp dotpos)) + (make-pathname + :name (subseq name 0 dotpos) + :type (subseq name (1+ dotpos))) + (make-pathname + :name 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)) + (setf (current-directory) ,dir) ,@body))) (when ,dp (if (zerop (closedir ,dp)) nil - (error "Error closing directory ~S." ,dir))))))))) + (error "Error closing directory ~S." ,dir))) + (setf (current-directory) ,old-dir))))))) (defun mapdir (function pathspec) "function MAPDIR function pathspec => list Index: src/version.txt diff -u src/version.txt:1.9 src/version.txt:1.10 --- src/version.txt:1.9 Fri Mar 5 13:34:54 2004 +++ src/version.txt Sun Apr 25 07:02:24 2004 @@ -1 +1 @@ -0.3.6 +0.4.0

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 April 2004