Commit a2e64a16 authored by Eric Timmons's avatar Eric Timmons
Browse files

Incorporate global config into the session

parent e91c12ba
......@@ -7,6 +7,7 @@
(:use #:cl)
(:export #:clpm-session
#:config-sources
#:global-sources
#:with-clpm-session))
(in-package #:clpm/session)
......@@ -20,7 +21,10 @@
"A hash table used to cache results of function calls.")
(config-sources
:initarg :config-sources
:accessor clpm-session-config-sources)))
:accessor clpm-session-config-sources)
(global-sources
:initarg :sources
:accessor clpm-session-global-sources)))
(defvar *session* nil
"Bound to a CLPM-SESSION object when inside a CLPM session.")
......@@ -31,6 +35,12 @@
(defun (setf config-sources) (new-value &optional (session *session*))
(setf (clpm-session-config-sources session) new-value))
(defun global-sources (&optional (session *session*))
(clpm-session-global-sources session))
(defun (setf global-sources) (new-value &optional (session *session*))
(setf (clpm-session-global-sources session) new-value))
(defun call-with-clpm-session (thunk &key override key)
"Starts a new CLPM session if one does not currently exist (unless OVERRIDE is
non-NIL). A session consists of a function cache, config sources, and config
......
......@@ -7,6 +7,7 @@
(:use #:cl
#:clpm/cache
#:clpm/config
#:clpm/session
#:clpm/sources/config
#:clpm/sources/defs
#:clpm/sources/fs
......@@ -21,15 +22,15 @@
(in-package #:clpm/source)
(defvar *sources*)
(defmethod slot-unbound (class (session clpm-session) (slot-name (eql 'global-sources)))
(setf (global-sources session) (load-global-sources)))
(defun sources ()
(unless (boundp '*sources*)
(setf *sources* (load-sources)))
*sources*)
(defvar *visible-sources*)
(defun clear-sources ()
(makunbound '*sources*))
(defun sources ()
(if (boundp '*visible-sources*)
*visible-sources*
(global-sources)))
(defun get-source (source-designator &optional (errorp t))
(cond
......@@ -44,10 +45,8 @@
source))))
(defun call-with-sources (sources thunk)
(let ((*sources* sources))
(let ((*visible-sources* sources))
(funcall thunk)))
(defmacro with-sources ((sources) &body body)
`(call-with-sources ,sources (lambda () ,@body)))
(uiop:register-clear-configuration-hook 'clear-sources)
......@@ -15,6 +15,7 @@
#:clpm/install/defs
#:clpm/repos
#:clpm/requirement
#:clpm/session
#:clpm/sources/defs
#:clpm/sources/tarball-release
#:clpm/sources/vcs
......@@ -90,10 +91,10 @@
(defmethod make-source ((type (eql 'clpi-dual-source)) &rest initargs
&key url name &allow-other-keys)
(let ((url-string (if (stringp url) url (uri-to-string url))))
(ensure-gethash (list type name url-string) *source-cache*
(apply #'make-instance
type
initargs))))
(with-clpm-session (:key `(make-source ,type ,name ,url-string))
(apply #'make-instance
type
initargs))))
(defmethod initialize-instance :after ((source clpi-source) &rest initargs
&key url installed-only-p)
......
......@@ -17,8 +17,8 @@
(:import-from #:uiop
#:read-file-form
#:with-safe-io-syntax)
(:export #:load-source-from-form
#:load-sources))
(:export #:load-global-sources
#:load-source-from-form))
(in-package #:clpm/sources/config)
......@@ -48,7 +48,7 @@
:installed-only-p installed-only-p
(remove-from-plist args :type))))
(defun load-sources ()
(defun load-global-sources ()
(let ((pn (clpm-config-pathname '("sources.conf"))))
(when pn
(uiop:with-safe-io-syntax ()
......
......@@ -11,8 +11,7 @@
#:clpm/data
#:puri
#:split-sequence)
(:export #:*source-cache*
#:clpm-project
(:export #:clpm-project
#:clpm-release
#:clpm-source
#:clpm-system
......@@ -122,17 +121,6 @@
(:documentation "Base class for any CLPM source. A source contains projects
and systems."))
(defvar *source-cache*)
(defun init-source-cache ()
(unless (boundp '*source-cache*)
(setf *source-cache* (make-hash-table :test 'equal))))
(uiop:register-image-restore-hook 'init-source-cache)
(defun clear-source-cache ()
(makunbound '*source-cache*))
(uiop:register-clear-configuration-hook 'clear-source-cache)
(defgeneric make-source (type &key &allow-other-keys)
(:documentation "Get a source of TYPE. This may return a new instance or an
existing instance that was made with similar arguments."))
......
......@@ -11,6 +11,7 @@
#:clpm/groveler
#:clpm/install/defs
#:clpm/requirement
#:clpm/session
#:clpm/sources/defs
#:clpm/sources/dotted-versioned-project)
(:export #:fs-source
......@@ -63,12 +64,12 @@ FS-SOURCE-REGISTER-ASD."))
(defmethod make-source ((type (eql 'fs-source)) &rest initargs
&key system-files name root-pathname)
(aprog1 (ensure-gethash (list type name root-pathname) *source-cache*
(apply #'make-instance
type
initargs))
(dolist (system-file system-files)
(fs-source-register-asd it system-file))))
(with-clpm-session (:key `(make-source ,type ,name ,root-pathname))
(aprog1 (apply #'make-instance
type
initargs)
(dolist (system-file system-files)
(fs-source-register-asd it system-file)))))
(defmethod initialize-instance :after ((source fs-source)
&rest initargs
......
......@@ -7,6 +7,7 @@
(uiop:define-package #:clpm/sources/ql-clpi
(:use #:cl
#:alexandria
#:clpm/session
#:clpm/sources/clpi
#:clpm/sources/defs
#:clpm/utils
......@@ -34,10 +35,10 @@
&key url name
&allow-other-keys)
(let ((url-string (if (stringp url) url (uri-to-string url))))
(ensure-gethash (list type name url-string) *source-cache*
(apply #'make-instance
type
initargs))))
(with-clpm-session (:key `(make-source ,type ,name ,url-string))
(apply #'make-instance
type
initargs))))
(defmethod source-type-keyword ((source ql-clpi-source))
:ql-clpi)
......
......@@ -11,6 +11,7 @@
#:clpm/cache
#:clpm/data
#:clpm/http-client
#:clpm/session
#:clpm/sources/clpi
#:clpm/sources/defs
#:clpm/sources/ql-clpi
......@@ -31,10 +32,10 @@
(defmethod make-source ((type (eql 'ql-source)) &rest initargs &key url name &allow-other-keys)
(let ((url-string (if (stringp url) url (uri-to-string url))))
(ensure-gethash (list type name url-string) *source-cache*
(apply #'make-instance
type
initargs))))
(with-clpm-session (:key `(make-source ,type ,name ,url-string))
(apply #'make-instance
type
initargs))))
(defmethod source-cache-directory ((source ql-source))
"Compute the cache location for this source, based on its canonical url."
......
......@@ -16,6 +16,7 @@
#:clpm/log
#:clpm/repos
#:clpm/requirement
#:clpm/session
#:clpm/sources/defs)
(:export #:*vcs-project-override-fun*
#:ensure-vcs-release-installed!
......@@ -54,13 +55,13 @@
source using VCS-SOURCE-REGISTER_PROJECT!."))
(defmethod make-source ((type (eql 'vcs-source)) &rest initargs &key name projects)
(aprog1 (ensure-gethash (list type name) *source-cache*
(apply #'make-instance
type
initargs))
(dolist (project projects)
(destructuring-bind (project-name . repo-form) project
(vcs-source-register-project! it (make-repo-from-description repo-form) project-name)))))
(with-clpm-session (:key `(make-source ,type ,name))
(aprog1 (apply #'make-instance
type
initargs)
(dolist (project projects)
(destructuring-bind (project-name . repo-form) project
(vcs-source-register-project! it (make-repo-from-description repo-form) project-name))))))
(defmethod initialize-instance :after ((source vcs-source)
&rest initargs
......
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