Commit 482e567d authored by Eric Timmons's avatar Eric Timmons
Browse files

Remove SAVE-GLOBAL-CONTEXT and replace with SAVE-CONTEXT

parent a2e64a16
......@@ -127,10 +127,7 @@ the lock file if necessary."
(setf changedp it)))
:update-projects (config-table-keys :bundle :local)))
(when changedp
(with-open-file (stream lockfile-pathname
:direction :output
:if-exists :supersede)
(serialize-context-to-stream lockfile stream)))))
(save-context lockfile))))
lockfile))
......@@ -209,7 +206,4 @@ the lock file if necessary."
(setf changedp it)))
:update-projects (or update-projects t)))
(when changedp
(with-open-file (stream lockfile-pathname
:direction :output
:if-exists :supersede)
(serialize-context-to-stream lockfile stream)))))
(save-context lockfile))))
......@@ -34,7 +34,7 @@
#:get-context
#:load-anonymous-context-from-pathname
#:load-global-context
#:save-global-context
#:save-context
#:serialize-context-to-stream))
(in-package #:clpm/context)
......@@ -217,37 +217,38 @@ in place with the same name. Return the new requirement if it was modified."
(system-release-absolute-asd-pathname system-release)))
(defun context-write-asdf-files (context)
(assert (not (context-anonymous-p context)))
(let* ((name (context-name context))
(source-registry-files (config-value :contexts name :source-registry-files))
(source-registry.d-files (config-value :contexts name :source-registry.d-files))
(registry-form (context-to-asdf-source-registry-form context))
(registry.d-forms (context-to-asdf-source-registry.d-forms context)))
(uiop:with-safe-io-syntax ()
(let ((*print-case* :downcase))
(dolist (f source-registry-files)
(log:debug "Writing context source-registry file to ~A" f)
(ensure-directories-exist f)
(with-open-file (s f :direction :output :if-exists :supersede)
(write-string ";; -*- mode: common-lisp; -*-" s)
(terpri s)
(write-string ";; Autogenerated by clpm. Do not edit directly." s)
(terpri s)
(prin1 registry-form s)
(terpri s)))
(dolist (f source-registry.d-files)
(log:debug "Writing context source-registry.d file to ~A" f)
(ensure-directories-exist f)
(with-open-file (s f :direction :output :if-exists :supersede)
(write-string ";; -*- mode: common-lisp; -*-" s)
(terpri s)
(write-string ";; Autogenerated by clpm. Do not edit directly." s)
(terpri s)
(dolist (form registry.d-forms)
(prin1 form s)
(terpri s))))))))
(unless (context-anonymous-p context)
(let* ((name (context-name context))
(source-registry-files (config-value :contexts name :source-registry-files))
(source-registry.d-files (config-value :contexts name :source-registry.d-files))
(registry-form (context-to-asdf-source-registry-form context))
(registry.d-forms (context-to-asdf-source-registry.d-forms context)))
(uiop:with-safe-io-syntax ()
(let ((*print-case* :downcase))
(dolist (f source-registry-files)
(log:debug "Writing context source-registry file to ~A" f)
(ensure-directories-exist f)
(with-open-file (s f :direction :output :if-exists :supersede)
(write-string ";; -*- mode: common-lisp; -*-" s)
(terpri s)
(write-string ";; Autogenerated by clpm. Do not edit directly." s)
(terpri s)
(prin1 registry-form s)
(terpri s)))
(dolist (f source-registry.d-files)
(log:debug "Writing context source-registry.d file to ~A" f)
(ensure-directories-exist f)
(with-open-file (s f :direction :output :if-exists :supersede)
(write-string ";; -*- mode: common-lisp; -*-" s)
(terpri s)
(write-string ";; Autogenerated by clpm. Do not edit directly." s)
(terpri s)
(dolist (form registry.d-forms)
(prin1 form s)
(terpri s)))))))))
(defun context-output-translations (context)
(assert (not (context-anonymous-p context)))
(let* ((context (get-context context))
(name (context-name context))
(config-value (config-value :contexts name :output-translation)))
......@@ -263,7 +264,7 @@ in place with the same name. Return the new requirement if it was modified."
(defun load-anonymous-context-from-pathname (pn &key installed-only-p)
(with-open-file (s pn)
(load-context-from-stream s :pathname pn :installed-only-p installed-only-p)))
(load-context-from-stream s :installed-only-p installed-only-p)))
(defun context-downselect-sources (name sources)
(let ((allowed-source-names (config-value :contexts name :sources)))
......@@ -359,7 +360,7 @@ in place with the same name. Return the new requirement if it was modified."
(sync-source source))
(setf (context-sources context) (append (context-sources context) (list source)))))
(defun load-context-from-stream (stream &key pathname (sources nil sources-provided-p)
(defun load-context-from-stream (stream &key (sources nil sources-provided-p)
installed-only-p)
(uiop:with-safe-io-syntax ()
;; The first form in the stream must be an API declaration.
......@@ -386,10 +387,11 @@ in place with the same name. Return the new requirement if it was modified."
;; * Serializing
(defun save-global-context (context)
(assert (not (context-anonymous-p context)))
(defun save-context (context)
(assert (context-reverse-dependencies context))
(let ((pn (global-context-pathname (context-name context))))
(let ((pn (if (context-anonymous-p context)
(context-name context)
(global-context-pathname (context-name context)))))
(ensure-directories-exist pn)
(with-open-file (s pn
:direction :output
......
......@@ -122,6 +122,6 @@ install should proceed."
(mapc #'install-release (context-releases new-context))
(when save-context-p
(context-write-asdf-files new-context)
(save-global-context new-context))
(save-context new-context))
new-context)
orig-context))))
......@@ -38,4 +38,4 @@
(when (funcall validate diff)
(mapc #'install-release (context-releases new-context))
(context-write-asdf-files new-context)
(save-global-context new-context)))))
(save-context new-context)))))
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