Skip to content
Snippets Groups Projects
Commit 2e282d16 authored by Gary King's avatar Gary King
Browse files

improve `directory-pathname-p`

* After much discussion, here's another attempt
at `directory-pathname-p`.

* make sure we push when we `make archive`
parent 0591d702
No related branches found
No related tags found
No related merge requests found
...@@ -26,6 +26,7 @@ archive-copy: archive ...@@ -26,6 +26,7 @@ archive-copy: archive
bin/rsync-cp.sh tmp/asdf*.tar.gz $(webhome_private)/archives bin/rsync-cp.sh tmp/asdf*.tar.gz $(webhome_private)/archives
bin/link-tarball.sh $(clnet_home) $(user) bin/link-tarball.sh $(clnet_home) $(user)
bin/rsync-cp.sh tmp/asdf.lisp $(webhome_private) bin/rsync-cp.sh tmp/asdf.lisp $(webhome_private)
git push cl.net
website-copy: FORCE website-copy: FORCE
bin/rsync-cp.sh website/output/ $(webhome_private) bin/rsync-cp.sh website/output/ $(webhome_private)
......
...@@ -440,14 +440,35 @@ which evaluates to a pathname. For example: ...@@ -440,14 +440,35 @@ which evaluates to a pathname. For example:
") ")
(defun directory-pathname-p (pathname) (defun directory-pathname-p (pathname)
(and (member (pathname-name pathname) (list nil :unspecific)) "Does `pathname` represent a directory?
(member (pathname-type pathname) (list nil :unspecific))))
A directory-pathname is a pathname _without_ a filename. The three
(defun pathname-name+type (pathname) ways that the filename components can be missing are for it to be `nil`,
"Returns a new pathname consisting of only the name and type from `:unspecific` or the empty string.
a non-wild pathname."
(make-pathname :name (pathname-name pathname) Note that this does _not_ check to see that `pathname` points to an
:type (pathname-type pathname))) actually-existing directory."
(let ((null-components (list nil :unspecific "")))
(flet ((check-one (x)
(not (null (member (pathname-name pathname) null-components
:test 'equal)))))
(and (check-one (pathname-name pathname))
(check-one (pathname-type pathname))))))
#+(or)
;;test
;;?? move into testsuite sometime soon
(every (lambda (p)
(directory-pathname-p p))
(list
(make-pathname :name "." :type nil :directory '(:absolute "tmp"))
(make-pathname :name "." :type "" :directory '(:absolute "tmp"))
(make-pathname :name nil :type "" :directory '(:absolute "tmp"))
(make-pathname :name "" :directory '(:absolute "tmp"))
(make-pathname :type :unspecific :directory '(:absolute "tmp"))
(make-pathname :name :unspecific :directory '(:absolute "tmp"))
(make-pathname :name :unspecific :directory '(:absolute "tmp"))
))
(defun ensure-directory-pathname (pathname) (defun ensure-directory-pathname (pathname)
(if (directory-pathname-p pathname) (if (directory-pathname-p pathname)
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment