From nsiivola at common-lisp.net  Sun Feb 29 11:25:27 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 06:25:27 -0500
Subject: [osicat-cvs] CVS update: src/early-util.lisp src/macros.lisp 
Message-ID: <E1AxP4Z-0002VO-00@common-lisp.net>

Update of /project/osicat/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv9280

Added Files:
	early-util.lisp 
Removed Files:
	macros.lisp 
Log Message:
Renamed macros.lisp to early-util.lisp
Date: Sun Feb 29 06:25:27 2004
Author: nsiivola







From nsiivola at common-lisp.net  Sun Feb 29 11:27:12 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 06:27:12 -0500
Subject: [osicat-cvs] CVS update: src/ffi.lisp src/foreign-types.lisp 
Message-ID: <E1AxP6G-00043n-00@common-lisp.net>

Update of /project/osicat/cvsroot/src
In directory common-lisp.net:/tmp/cvs-serv15600

Added Files:
	ffi.lisp 
Removed Files:
	foreign-types.lisp 
Log Message:
Collected all ffi code to a single place
Date: Sun Feb 29 06:27:12 2004
Author: nsiivola







From nsiivola at common-lisp.net  Sun Feb 29 11:29:14 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 06:29:14 -0500
Subject: [osicat-cvs] CVS update: src/grovel-constants.lisp src/osicat.asd
	src/osicat.lisp src/release.txt 
Message-ID: <E1AxP8E-0008MH-00@common-lisp.net>

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 at random-state.net>
+;; Copyright (c) 2003, 2004 Nikodemus Siivola <nikodemus at 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 at 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))
-	   , at 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))))
+		   , at 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




From nsiivola at common-lisp.net  Sun Feb 29 12:44:48 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 07:44:48 -0500
Subject: [osicat-cvs] CVS update: src/make-readme.lisp src/osicat.lisp
	src/packages.lisp src/version.txt 
Message-ID: <E1AxQJM-0004IF-00@common-lisp.net>

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 at random-state.net>
+;; Copyright (c) 2003, 2004 Nikodemus Siivola <nikodemus at 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




From nsiivola at common-lisp.net  Sun Feb 29 18:10:42 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 13:10:42 -0500
Subject: [osicat-cvs] CVS update: src/early-util.lisp src/ffi.lisp
	src/osicat-glue.c src/osicat.asd src/osicat.lisp src/packages.lisp 
Message-ID: <E1AxVOk-0002s4-00@common-lisp.net>

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 at 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))))
+	 , at 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))))
 		   , at 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))
-		  , at body)
+		  (let ((*default-pathname-defaults* ,dir))
+		    , at 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))))
-	 , at 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




From nsiivola at common-lisp.net  Sun Feb 29 18:36:42 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 13:36:42 -0500
Subject: [osicat-cvs] CVS update: src/osicat.lisp 
Message-ID: <E1AxVnu-0005su-00@common-lisp.net>

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))
-		    , at 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))
+		      , at 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+




From nsiivola at common-lisp.net  Sun Feb 29 20:29:35 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 15:29:35 -0500
Subject: [osicat-cvs] CVS update: src/test-tools.lisp src/osicat.asd
	src/osicat.lisp src/test-osicat.lisp src/test-setup.lisp 
Message-ID: <E1AxXZ9-0001YV-00@common-lisp.net>

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)
-
 	  






From nsiivola at common-lisp.net  Sun Feb 29 20:52:37 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 15:52:37 -0500
Subject: [osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp 
Message-ID: <E1AxXvR-00025Y-00@common-lisp.net>

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)




From nsiivola at common-lisp.net  Sun Feb 29 23:28:22 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 18:28:22 -0500
Subject: [osicat-cvs] CVS update: src/osicat.lisp src/test-osicat.lisp
	src/test-tools.lisp 
Message-ID: <E1AxaMA-0005PS-00@common-lisp.net>

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)))))




From nsiivola at common-lisp.net  Sun Feb 29 23:41:50 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 18:41:50 -0500
Subject: [osicat-cvs] CVS update: src/osicat.lisp src/packages.lisp 
Message-ID: <E1AxaZC-00057R-00@common-lisp.net>

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   




From nsiivola at common-lisp.net  Sun Feb 29 23:43:09 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 18:43:09 -0500
Subject: [osicat-cvs] CVS update: src/packages.lisp 
Message-ID: <E1AxaaT-00079u-00@common-lisp.net>

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




From nsiivola at common-lisp.net  Sun Feb 29 23:52:23 2004
From: nsiivola at common-lisp.net (Nikodemus Siivola)
Date: Sun, 29 Feb 2004 18:52:23 -0500
Subject: [osicat-cvs] CVS update: src/release.txt src/test-osicat.lisp
	src/version.txt 
Message-ID: <E1AxajP-0007AG-00@common-lisp.net>

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