Commit 6ddcd763 authored by Eric Timmons's avatar Eric Timmons
Browse files

Add bundle source-registry command

It just prints the bundle's source-registry
parent 2bc6378b
......@@ -7,6 +7,7 @@
(:use #:cl
#:alexandria
#:anaphora
#:clpm/client
#:clpm/clpmfile
#:clpm/context
#:clpm/install
......@@ -15,6 +16,7 @@
#:clpm/resolve
#:clpm/source)
(:export #:bundle-install
#:bundle-source-registry
#:bundle-update))
(in-package #:clpm/bundle)
......@@ -73,6 +75,19 @@ the lock file if necessary."
:if-exists :supersede)
(serialize-context-to-stream lockfile stream)))))
(defun bundle-source-registry (clpmfile-designator &key include-client-p)
(let* ((*fetch-repo-automatically* nil)
(clpmfile (get-clpmfile clpmfile-designator))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
lockfile)
(unless (probe-file lockfile-pathname)
(error "Lockfile ~A does not exist" lockfile-pathname))
(setf lockfile (load-lockfile lockfile-pathname :localp t))
(context-to-asdf-source-registry-form
lockfile
(when include-client-p
`((:directory ,(uiop:pathname-directory-pathname (client-asd-pathname))))))))
(defun bundle-update (clpmfile-designator &key
update-projects (validate (constantly t))
update-systems
......
......@@ -10,6 +10,7 @@
#:clpm/cli/bundle/exec
#:clpm/cli/bundle/install
;;#:clpm/cli/bundle/pathnames
#:clpm/cli/bundle/source-registry
#:clpm/cli/bundle/update))
(in-package #:clpm/cli/bundle)
......@@ -5,14 +5,13 @@
(uiop:define-package #:clpm/cli/bundle/exec
(:use #:cl
#:clpm/bundle
#:clpm/cli/bundle/common
#:clpm/cli/common-args
#:clpm/cli/subcommands
#:clpm/clpmfile
#:clpm/context
#:clpm/execvpe
#:clpm/log
#:clpm/source
#:clpm/utils)
(:import-from #:adopt))
......@@ -40,11 +39,11 @@
(define-cli-command (("bundle" "exec") *bundle-exec-ui*) (args options)
(let* ((clpmfile-pathname (merge-pathnames (gethash :bundle-file options)
(uiop:getcwd)))
(lockfile-pathname (merge-pathnames (make-pathname :type "lock")
clpmfile-pathname))
(clpmfile (get-clpmfile clpmfile-pathname))
(lockfile-pathname (clpmfile-lockfile-pathname clpmfile))
(*default-pathname-defaults* (uiop:pathname-directory-pathname clpmfile-pathname))
(lockfile (load-anonymous-context-from-pathname lockfile-pathname))
(cl-source-registry-form (context-to-asdf-source-registry-form lockfile))
(include-client-p (gethash :bundle-exec-with-client options))
(cl-source-registry-form (bundle-source-registry clpmfile-pathname :include-client-p include-client-p))
(cl-source-registry-value (format nil "~S" cl-source-registry-form))
(command args))
(log:debug "Computed CL_SOURCE_REGISTRY:~%~S" cl-source-registry-form)
......
;;;; clpm bundle source-registry
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.
(uiop:define-package #:clpm/cli/bundle/source-registry
(:use #:cl
#:clpm/bundle
#:clpm/cli/bundle/common
#:clpm/cli/common-args
#:clpm/cli/subcommands
#:clpm/clpmfile
#:clpm/log)
(:import-from #:adopt))
(in-package #:clpm/cli/bundle/source-registry)
(setup-logger)
(defparameter *option-with-client*
(adopt:make-option
:bundle-exec-with-client
:long "with-client"
:help "Include the CLPM client in the source registry"
:reduce (constantly t)))
(defparameter *bundle-source-registry-ui*
(adopt:make-interface
:name "clpm bundle source-registry"
:summary "Common Lisp Package Manager Bundle Source-registry"
:usage "bundle source-registry [options]"
:help "Print the source registry for a bundle."
:contents (list *group-common*
*group-bundle*
*option-with-client*)))
(define-cli-command (("bundle" "source-registry") *bundle-source-registry-ui*) (args options)
(let* ((clpmfile-pathname (merge-pathnames (gethash :bundle-file options)
(uiop:getcwd)))
(*default-pathname-defaults* (uiop:pathname-directory-pathname clpmfile-pathname))
(include-client-p (gethash :bundle-exec-with-client options))
(cl-source-registry-form (bundle-source-registry clpmfile-pathname :include-client-p include-client-p)))
(format t "~S~%" cl-source-registry-form)
t))
;;;; Interface for caching the clpm-client system location
;;;;
;;;; This software is part of CLPM. See README.org for more information. See
;;;; LICENSE for license information.
(uiop:define-package #:clpm/client
(:use #:cl)
(:export #:*clpm-client-asd-pathname*
#:client-asd-pathname))
(in-package #:clpm/client)
(defvar *clpm-client-asd-pathname*
(asdf:system-relative-pathname :clpm "src/clpm-client/clpm-client.asd"))
(defun client-asd-pathname ()
"Return the pathname to the client .asd file."
*clpm-client-asd-pathname*)
......@@ -134,10 +134,11 @@ in place with the same name. Return the new requirement if it was modified."
:test #'uiop:pathname-equal)))
(mapcar (lambda (x) (list :directory x)) system-file-directories)))
(defun context-to-asdf-source-registry-form (context)
(defun context-to-asdf-source-registry-form (context &optional extra-forms)
`(:source-registry
:ignore-inherited-configuration
,@(context-to-asdf-source-registry.d-forms context)))
,@(context-to-asdf-source-registry.d-forms context)
,@extra-forms))
(defun context-write-asdf-files (context)
(assert (context-name context))
......
......@@ -5,6 +5,7 @@
(uiop:define-package #:clpm/deploy
(:use #:cl
#:clpm/client
#:clpm/deps)
(:import-from #:deploy)
#+clpm-winhttp
......@@ -40,6 +41,8 @@
`(("clpm:src;**;*.*.*" ,(merge-pathnames "src/**/*.*" deploy:*data-location*))))
(setf *clpm-groveler-asd-pathname* (merge-pathnames "src/clpm-groveler/clpm-groveler.asd"
deploy:*data-location*))
(setf *clpm-client-asd-pathname* (merge-pathnames "src/clpm-client/clpm-client.asd"
deploy:*data-location*))
(unless (uiop:probe-file* clpm-home)
(format *error-output*
"Unable to find CLPM_HOME. Please set CLPM_HOME environment variable.~%")
......
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