[osicat-cvs] CVS update: src/Makefile src/grovel-constants.lisp src/osicat-glue.c src/osicat.lisp src/release.txt src/version.txt
Nikodemus Siivola
nsiivola at common-lisp.net
Thu Oct 23 23:48:06 UTC 2003
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))
, at 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))
- , at forms)
+ , at 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 @@
, at 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
+
More information about the Osicat-cvs
mailing list