Commit 1ba65393 authored by Eric Timmons's avatar Eric Timmons
Browse files

When exec'ing, make clear what primary systems are "editable"

parent 1318b184
......@@ -9,6 +9,7 @@
#:clpm/session
#:clpm/source)
(:export #:asd-pathnames
#:editable-primary-system-names
#:find-system-asd-pathname
#:installed-system-names
#:output-translations
......@@ -22,6 +23,12 @@
(with-context (context)
(context-asd-pathnames context))))
(defun editable-primary-system-names (&key context)
(with-clpm-session ()
(with-sources-using-installed-only ()
(with-context (context)
(context-editable-primary-system-names context)))))
(defun find-system-asd-pathname (system-name &key context)
(with-clpm-session ()
(with-context (context)
......
......@@ -20,6 +20,7 @@
#:context-add-requirement!
#:context-anonymous-p
#:context-asd-pathnames
#:context-editable-primary-system-names
#:context-find-system-asd-pathname
#:context-fs-source
#:context-installed-systems
......@@ -212,6 +213,16 @@ in place with the same name. Return the new requirement if it was modified."
(system-files (flatten (mapcar #'release-system-files releases))))
(mapcar #'system-file-absolute-asd-pathname system-files)))
(defun context-editable-primary-system-names (context)
(let* ((releases (context-releases context))
(editable-releases (remove-if-not (lambda (x) (eql x (context-fs-source context)))
releases
:key #'release-source))
(editable-system-files (mapcan #'release-system-files editable-releases)))
(sort (remove-duplicates (mapcar #'system-file-primary-system-name editable-system-files)
:test #'equal)
#'string<)))
;; TODO: 0.4
;;
;; See note on CONTEXT-VISIBLE-PRIMARY-SYSTEM-NAMES
......
......@@ -40,7 +40,8 @@ If WITH-CLIENT-P is non-NIL, the clpm-client system is available."
:splice-inherited splice-inherited))
(output-translations (context-output-translations context))
(installed-system-names (sort (mapcar #'system-name (context-installed-systems context)) #'string<))
(visible-primary-system-names (sort (context-visible-primary-system-names context) #'string<)))
(visible-primary-system-names (sort (context-visible-primary-system-names context) #'string<))
(editable-primary-system-names (context-editable-primary-system-names context)))
(with-standard-io-syntax
(let ((*print-case* :downcase))
(execvpe command args
......@@ -50,6 +51,7 @@ If WITH-CLIENT-P is non-NIL, the clpm-client system is available."
,(if (context-anonymous-p context)
`("CLPM_EXEC_CLPMFILE" . ,(uiop:native-namestring context-name))
`("CLPM_EXEC_CONTEXT" . ,context-name))
("CLPM_EXEC_EDITABLE_PRIMARY_SYSTEMS" . ,(format nil "~S" editable-primary-system-names))
("CLPM_EXEC_INSTALLED_SYSTEMS" . ,(format nil "~S" installed-system-names))
("CLPM_EXEC_VISIBLE_PRIMARY_SYSTEMS" . ,(format nil "~S" visible-primary-system-names))
,@(when ignore-inherited-source-registry
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment