p36850791
/
kinetic-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added support for roslisp_ignore marker files.

This commit is contained in:
Lorenz Moesenlechner 2010-06-23 21:13:59 +00:00
parent 686981df75
commit d99e190e05
1 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
core/roslisp/load-manifest/load-manifest.lisp
View File

@ -64,23 +64,17 @@
(call-next-method))) (call-next-method)))
(defmethod asdf:operation-done-p :around ((operation asdf:operation) (c asdf:cl-source-file)) (defmethod asdf:operation-done-p :around ((operation asdf:operation) (c asdf:cl-source-file))
(let ((*ros-asdf-use-ros-home* (let ((stat (sb-posix:stat (make-pathname (let ((*ros-asdf-use-ros-home* (and (path-ros-package (asdf:component-pathname c))
(not (directory-writable (make-pathname
:directory (pathname-directory :directory (pathname-directory
(asdf:component-pathname c)))))) (asdf:component-pathname c))))))))
(and (path-ros-package (asdf:component-pathname c))
(or
(eql 0 (logand (sb-posix:stat-mode stat) #o0200))
(not (eq (sb-posix:stat-uid stat) (sb-posix:getuid))))))))
(call-next-method))) (call-next-method)))
(defmethod asdf:perform :around ((operation asdf:operation) (c asdf:cl-source-file)) (defmethod asdf:perform :around ((operation asdf:operation) (c asdf:cl-source-file))
(let ((*ros-asdf-use-ros-home* (let ((stat (sb-posix:stat (make-pathname (let ((*ros-asdf-use-ros-home* (and (path-ros-package (asdf:component-pathname c))
(not (directory-writable (make-pathname
:directory (pathname-directory :directory (pathname-directory
(asdf:component-pathname c)))))) (asdf:component-pathname c))))))))
(and (path-ros-package (asdf:component-pathname c))
(or
(eql 0 (logand (sb-posix:stat-mode stat) #o0200))
(not (eq (sb-posix:stat-uid stat) (sb-posix:getuid))))))))
(call-next-method))) (call-next-method)))
(defun asdf-system-of-component (component) (defun asdf-system-of-component (component)
@ -89,13 +83,20 @@
(asdf:system component) (asdf:system component)
(asdf:component (asdf-system-of-component (asdf:component-parent component))))) (asdf:component (asdf-system-of-component (asdf:component-parent component)))))
(defun directory-writable (directory)
(let ((stat (sb-posix:stat directory)))
(and (not (eql 0 (logand (sb-posix:stat-mode stat) #o0200)))
(eq (sb-posix:stat-uid stat) (sb-posix:getuid)))))
(defun path-ros-package (path &optional traversed) (defun path-ros-package (path &optional traversed)
"Traverses the `path' upwards until it finds a manifest. "Traverses the `path' upwards until it finds a manifest.
Returns two values, the name of the ros package and the relative Returns two values, the name of the ros package and the relative
part of path inside the package. Returns nil if no manifest could part of path inside the package. Returns nil if no manifest could
be found." be found."
(let ((manifest (probe-file (merge-pathnames "manifest.xml" path)))) (let ((manifest (probe-file (merge-pathnames "manifest.xml" path)))
(cond (manifest (marker-file (probe-file (merge-pathnames "roslisp_ignore" path))))
(cond (marker-file nil)
(manifest
(values (truename path) traversed)) (values (truename path) traversed))
((not (cdr (pathname-directory path))) ((not (cdr (pathname-directory path)))
nil) nil)