Commit b5536c14 authored by Eric Timmons's avatar Eric Timmons
Browse files

exec now includes installed primary system names

parent 25a925d2
Loading
Loading
Loading
Loading
+7 −0
Original line number Diff line number Diff line
@@ -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 ()
+8 −15
Original line number Diff line number Diff line
@@ -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))
+3 −0
Original line number Diff line number Diff line
@@ -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