Loading clpm/context-queries.lisp +7 −0 Original line number Diff line number Diff line Loading @@ -9,6 +9,7 @@ #:clpm/session #:clpm/source) (:export #:asd-pathnames #:editable-primary-system-names #:find-system-asd-pathname #:installed-system-names #:output-translations Loading @@ -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) Loading clpm/context.lisp +11 −0 Original line number Diff line number Diff line Loading @@ -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 Loading Loading @@ -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 Loading clpm/exec.lisp +3 −1 Original line number Diff line number Diff line Loading @@ -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 Loading @@ -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 Loading Loading
clpm/context-queries.lisp +7 −0 Original line number Diff line number Diff line Loading @@ -9,6 +9,7 @@ #:clpm/session #:clpm/source) (:export #:asd-pathnames #:editable-primary-system-names #:find-system-asd-pathname #:installed-system-names #:output-translations Loading @@ -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) Loading
clpm/context.lisp +11 −0 Original line number Diff line number Diff line Loading @@ -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 Loading Loading @@ -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 Loading
clpm/exec.lisp +3 −1 Original line number Diff line number Diff line Loading @@ -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 Loading @@ -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 Loading