Commit 82ad8b15 authored by Eric Timmons's avatar Eric Timmons
Browse files

Add context systems CLI

parent 702f1969
...@@ -9,6 +9,7 @@ ...@@ -9,6 +9,7 @@
#:clpm/cli/context/find #:clpm/cli/context/find
#:clpm/cli/context/output-translations #:clpm/cli/context/output-translations
#:clpm/cli/context/pathnames #:clpm/cli/context/pathnames
#:clpm/cli/context/source-registry)) #:clpm/cli/context/source-registry
#:clpm/cli/context/systems))
(in-package #:clpm/cli/context) (in-package #:clpm/cli/context)
;;;; clpm context systems
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.
(uiop:define-package #:clpm/cli/context/systems
(:use #:cl
#:alexandria
#:clpm/context
#:clpm/cli/context/common
#:clpm/cli/common-args
#:clpm/cli/interface-defs
#:clpm/source)
(:import-from #:adopt))
(in-package #:clpm/cli/context/systems)
(defparameter *context-systems-ui*
(adopt:make-interface
:name "clpm context systems"
:summary "Common Lisp Package Manager Context Systems"
:usage "context systems [options] CONTEXT-NAME"
:help "List the names of all systems installed in the context, one per line"
:contents (list *group-common*)))
(define-cli-command (("context" "systems") *context-systems-ui*) (args options)
(declare (ignore options))
(assert (length= 1 args))
(format t "~{~A~%~}" (sort (mapcar #'system-name (context-installed-systems (first args)))
#'string<))
t)
...@@ -21,6 +21,7 @@ ...@@ -21,6 +21,7 @@
#:context-diff-has-diff-p #:context-diff-has-diff-p
#:context-diff-to-plist #:context-diff-to-plist
#:context-find-system-asd-pathname #:context-find-system-asd-pathname
#:context-installed-systems
#:context-installed-only-p #:context-installed-only-p
#:context-name #:context-name
#:context-output-translations #:context-output-translations
...@@ -139,6 +140,11 @@ in place with the same name. Return the new requirement if it was modified." ...@@ -139,6 +140,11 @@ in place with the same name. Return the new requirement if it was modified."
(system-files (flatten (mapcar #'release-system-files releases)))) (system-files (flatten (mapcar #'release-system-files releases))))
(mapcar #'system-file-absolute-asd-pathname system-files))) (mapcar #'system-file-absolute-asd-pathname system-files)))
(defun context-installed-systems (context)
(let* ((context (get-context context))
(system-releases (context-system-releases context)))
(mapcar #'system-release-system system-releases)))
(defun context-to-asdf-source-registry.d-forms (context) (defun context-to-asdf-source-registry.d-forms (context)
(let* ((context (get-context context)) (let* ((context (get-context context))
(system-file-pathnames (context-asd-pathnames context)) (system-file-pathnames (context-asd-pathnames context))
......
Supports Markdown
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