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

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

parent 1318b184
Loading
Loading
Loading
Loading
+7 −0
Original line number Diff line number Diff line
@@ -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)
+11 −0
Original line number Diff line number Diff line
@@ -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
+3 −1
Original line number Diff line number Diff line
@@ -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