Commit b5536c14 authored by Eric Timmons's avatar Eric Timmons

exec now includes installed primary system names

parent 25a925d2
......@@ -11,6 +11,7 @@
(:export #:asd-pathnames
#:editable-primary-system-names
#:find-system-asd-pathname
#:installed-primary-system-names
#:installed-system-names
#:output-translations
#:source-registry
......@@ -42,6 +43,12 @@
(with-context (context)
(mapcar 'system-name (context-installed-systems context))))))
(defun installed-primary-system-names (&key context)
(with-clpm-session ()
(with-sources-using-installed-only ()
(with-context (context)
(context-installed-primary-system-names context)))))
(defun output-translations (&key context)
(with-clpm-session ()
(with-sources-using-installed-only ()
......
......@@ -23,6 +23,7 @@
#:context-editable-primary-system-names
#:context-find-system-asd-pathname
#:context-fs-source
#:context-installed-primary-system-names
#:context-installed-systems
#:context-name
#:context-output-translations
......@@ -223,26 +224,18 @@ in place with the same name. Return the new requirement if it was modified."
:test #'equal)
#'string<)))
;; TODO: 0.4
;;
;; See note on CONTEXT-VISIBLE-PRIMARY-SYSTEM-NAMES
(defun context-installed-primary-system-names (context)
(let* ((context (get-context context))
(system-releases (context-system-releases context)))
(remove-duplicates
(mapcar (compose #'asdf:primary-system-name #'system-name #'system-release-system) system-releases)
:test #'equal)))
(defun context-installed-systems (context)
(let* ((context (get-context context))
(system-releases (context-system-releases context)))
(mapcar #'system-release-system system-releases)))
;; NOTE: There is some slightly wonky behavior here that the client currently
;; depends on when working with bundles, namely the system names from
;; CONTEXT-ASD-PATHNAMES do not show up. But this is ok since they do not show
;; up in CONTEXT-INSTALLED-SYSTEMS either. This prevents the client from
;; unnecessary prompting to install newly created package-inferred-systems in
;; bundles. Want to re-evaluate this choice and/or function name in 0.4.0.
;;
;; Actually, decided to make client not track these things in bundles since
;; BUNDLE-INSTALL doesn't take any system or project names anyways. But leaving
;; as a note to future self.
;;
;; TODO: 0.4
(defun context-visible-primary-system-names (context)
(let* ((context (get-context context))
(releases (context-releases context))
......
......@@ -40,6 +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<))
(installed-primary-system-names (remove-duplicates (mapcar #'asdf:primary-system-name installed-system-names)
:test #'equal))
(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
......@@ -52,6 +54,7 @@ If WITH-CLIENT-P is non-NIL, the clpm-client system is available."
`("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_PRIMARY_SYSTEMS" . ,(format nil "~S" installed-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