Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
What's new
7
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Open sidebar
clpm
clpi
Commits
322a3a25
Commit
322a3a25
authored
May 25, 2020
by
Eric Timmons
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
Update spec to remove `index` object
Replace it with append friendly project-index and system-index
parent
dd5c165b
Changes
8
Hide whitespace changes
Inline
Side-by-side
Showing
8 changed files
with
306 additions
and
76 deletions
+306
-76
specs/clpi-0.4.org
specs/clpi-0.4.org
+37
-28
src/index-defs.lisp
src/index-defs.lisp
+21
-1
src/index.lisp
src/index.lisp
+179
-39
src/object-store-dual.lisp
src/object-store-dual.lisp
+3
-1
src/project-defs.lisp
src/project-defs.lisp
+12
-0
src/project.lisp
src/project.lisp
+11
-4
src/system-defs.lisp
src/system-defs.lisp
+17
-0
src/system.lisp
src/system.lisp
+26
-3
No files found.
specs/clpi-0.4.org
View file @
322a3a25
#+TITLE: CLPI Specification v0.4
#+AUTHOR: clpm-devel@common-lisp.net
#+AUTHOR: Eric Timmons
#+EMAIL: clpm-devel@common-lisp.net
This document provides the specification of version 0.4 of the Common Lisp
Project Index.
...
...
@@ -40,43 +41,51 @@ the secondary.
+ =clpi-version= :: Required. A string naming the version of the CLPI
specification used by this index. Must be ="0.4"= for this version of the
spec.
+ =project-index-object-version= :: An integer or NIL/missing whose purpose is
further described in [[*Project index]].
+ =system-index-object-version= :: An integer or NIL/missing whose purpose is
further described in [[*System index]].
*
I
ndex
*
Project i
ndex
The object =index= must exist. This object is a lightweight summary of all
projects, systems, and releases contained within the index. It contains a
single plist with the keys:
The object =project-index= or =project-index-PROJECT-INDEX-OBJECT-VERSION=
must exist, where =PROJECT-INDEX-OBJECT-VERSION= is defined in the [[*Index
metadata]]. If the project index object version is NIL/not provided, only the
former must exist, otherwise the latter must exist.
+ =:projects= :: A list of project information, described in [[*Project index]].
+ =:systems= :: A list of system information, described in [[*System index]].
Each form in this object is a list where the first element is a project name
(string). The rest is a list of strings naming versions of releases of this
project.
It is allowed for a project to be named with no releases.
It is allowed for a project to appear multiple times in this object. If it
does, all the releases should be combined after reading.
As this object is typically fetched from the primary by the secondaries on a
regular basis, other keys (including in sub plists) are allowed, but
discouraged in order to keep the size to a minimum.
If =PROJECT-INDEX-OBJECT-VERSION= is non-NIL, this file must only be appended
to.
*
*
Project
index
*
System
index
Th
is list contains all projects defined within the index as well as each
project's releases. Each element in the project index must be of the form
=(project-name . project-plist)= where =project-name= is a string naming
the
project and =project-plist= is a plist containing the following keys:
Th
e object =system-index= or =system-index-SYSTEM-INDEX-OBJECT-VERSION=
must exist, where =SYSTEM-INDEX-OBJECT-VERSION= is defined in the [[*Index
metadata]]. If the system index object version is NIL/not provided, only
the
former must exist, otherwise the latter must exist.
+ =:releases= :: A list of strings providing the versions of each release of
the project.
Each form in this object is a list where the first element is a system name
(string). The rest is a list of lists describing releases of this
system. Each element is a list with one or two member. The first member is a
[[*Project release description]]. The second element is the ASD version of
the system (if one is defined). If the second element is missing, it is
assumed the ASD version of the system is =NIL=.
** System index
It is allowed for a system to be named with no releases.
This list contains the names of all systems defined within the index as well
as which project releases provide them. Every element in the system index
must be of the form =(system-name . system-plist)=, where =system-name= is a
string containing the name of the system and =system-plist= is a list
containing the following keys:
It is allowed for a system to appear multiple times in this object. If it
does, all the releases should be combined after reading.
= =:releases= :: A list of releases of the system. Each element is a list
with one or two members. The first member is a [[*Project release description]].
The second element is the ASD version of the system (if one is defined). If
the second element is missing, it is assumed the ASD version of the system
is =NIL=.
If =SYSTEM-INDEX-OBJECT-VERSION= is non-NIL, this file must only be appended
to.
* Project metadata
...
...
src/index-defs.lisp
View file @
322a3a25
...
...
@@ -15,6 +15,8 @@
#:index-plist
#:index-project
#:index-project-class
#:index-project-index-object-path
#:index-project-index-object-version
#:index-project-missing
#:index-project-missing-index
#:index-project-missing-project-name
...
...
@@ -25,6 +27,8 @@
#:index-system
#:index-system-class
#:index-system-file-class
#:index-system-index-object-path
#:index-system-index-object-version
#:index-system-missing
#:index-system-missing-index
#:index-system-missing-system-name
...
...
@@ -73,7 +77,7 @@
slots. This is not called as part of INITIALIZE-INSTANCE in order to allow work
to be defered until first access instead of instantiation."
))
(
defgeneric
index-initialize-internal
(
index
&key
projects
systems
&allow-other-keys
)
(
defgeneric
index-initialize-internal
(
index
projects
systems
)
(
:documentation
"Performs initialization of the index using the data read from the index
object."
))
...
...
@@ -98,6 +102,14 @@ signaled."))
(
:documentation
"Return the class used to instantiate projects for INDEX."
))
(
defgeneric
index-project-index-object-path
(
index
)
(
:documentation
"Return the path of the INDEX's project-index object."
))
(
defgeneric
index-project-index-object-version
(
index
)
(
:documentation
"Return the version of the INDEX's project-index object."
))
(
defgeneric
index-project-names
(
index
)
(
:documentation
"Return a list of the names of projects in INDEX."
))
...
...
@@ -130,6 +142,14 @@ signaled."))
(
:documentation
"Return the class used to instantiate system files for INDEX."
))
(
defgeneric
index-system-index-object-path
(
index
)
(
:documentation
"Return the path of the INDEX's system-index object."
))
(
defgeneric
index-system-index-object-version
(
index
)
(
:documentation
"Return the version of the INDEX's system-index object."
))
(
defgeneric
index-system-names
(
index
)
(
:documentation
"Return a list of the names of systems in INDEX."
))
...
...
src/index.lisp
View file @
322a3a25
...
...
@@ -6,6 +6,7 @@
(
uiop:define-package
#:clpi/index
(
:use
#:cl
#:alexandria
#:anaphora
#:clpi/defs
#:clpi/object-store-dual
#:clpi/project
...
...
@@ -27,10 +28,28 @@
:accessor
index-version
:documentation
"The version of the CLPI spec to which this index adhears."
)
(
project-index-object-version
:accessor
index-project-index-object-version
:documentation
"The version of the project-index object."
)
(
system-index-object-version
:accessor
index-system-index-object-version
:documentation
"The version of the system-index object."
)
(
system-ht
:accessor
index-system-ht
:documentation
"Maps system names to system instances."
))
"Maps system names to system instances."
)
(
new-projects
:initform
nil
:accessor
index-new-projects
:documentation
"A list of new projects added to the index."
)
(
new-systems
:initform
nil
:accessor
index-new-systems
:documentation
"A list of new systems added to the index."
))
(
:documentation
"The base class for an index. Contains a mapping from project (system) names
to projects (systems). Each map slot starts as unbound, when first accessed, the
...
...
@@ -44,7 +63,9 @@ project-index and system-index files are read to instantiate the objects."))
(
gethash
(
project-name
project
)
(
index-project-ht
index
))
(
when
(
and
exists-p
(
not
(
eql
project
existing-project
)))
(
error
"Project already exists!"
))
(
setf
(
gethash
(
project-name
project
)
(
index-project-ht
index
))
project
))
(
unless
exists-p
(
push
project
(
index-new-projects
index
))
(
setf
(
gethash
(
project-name
project
)
(
index-project-ht
index
))
project
)))
index
)
(
defmethod
index-add-system
((
index
index
)
system
)
...
...
@@ -52,41 +73,70 @@ project-index and system-index files are read to instantiate the objects."))
(
gethash
(
system-name
system
)
(
index-system-ht
index
))
(
when
(
and
exists-p
(
not
(
eql
system
existing-system
)))
(
error
"System already exists!"
))
(
setf
(
gethash
(
system-name
system
)
(
index-system-ht
index
))
system
))
(
unless
exists-p
(
push
system
(
index-new-systems
index
))
(
setf
(
gethash
(
system-name
system
)
(
index-system-ht
index
))
system
)))
index
)
(
defmethod
index-project-index-object-path
((
index
index
))
(
let
((
version
(
index-project-index-object-version
index
)))
(
if
version
(
uiop:strcat
"project-index-"
(
write-to-string
version
))
"project-index"
)))
(
defmethod
index-system-index-object-path
((
index
index
))
(
let
((
version
(
index-system-index-object-version
index
)))
(
if
version
(
uiop:strcat
"system-index-"
(
write-to-string
version
))
"system-index"
)))
(
defmethod
index-initialize
((
index
index
))
(
let
(
contents
)
(
let
((
projects
(
make-hash-table
:test
'equal
))
(
systems
(
make-hash-table
:test
'equal
)))
(
with-open-object-stream
(
s
(
index-object-store
index
)
"clpi-version"
:if-does-not-exist
nil
)
(
if
s
(
with-clpi-io-syntax
()
(
setf
(
index-version
index
)
(
read
s
)))
(
setf
(
index-version
index
)
"0.4"
)))
(
with-open-object-stream
(
s
(
index-object-store
index
)
"index"
:if-does-not-exist
nil
)
(
with-open-object-stream
(
s
(
index-object-store
index
)
"project-index-object-version"
:if-does-not-exist
nil
)
(
setf
(
index-project-index-object-version
index
)
(
when
s
(
with-clpi-io-syntax
()
(
read
s
)))))
(
with-open-object-stream
(
s
(
index-object-store
index
)
"system-index-object-version"
:if-does-not-exist
nil
)
(
setf
(
index-system-index-object-version
index
)
(
when
s
(
with-clpi-io-syntax
()
(
read
s
)))))
(
with-open-object-stream
(
s
(
index-object-store
index
)
(
index-project-index-object-path
index
)
:if-does-not-exist
nil
)
(
when
s
(
with-clpi-io-syntax
()
(
setf
contents
(
read
s
)))))
(
apply
#'
index-initialize-internal
index
contents
)))
(
with-stream-forms
(
f
s
)
(
destructuring-bind
(
project-name
&rest
versions
)
f
(
setf
(
gethash
project-name
projects
)
(
append
versions
(
gethash
project-name
projects
)))))))
(
with-open-object-stream
(
s
(
index-object-store
index
)
(
index-system-index-object-path
index
)
:if-does-not-exist
nil
)
(
when
s
(
with-stream-forms
(
f
s
)
(
destructuring-bind
(
system-name
&rest
versions
)
f
(
setf
(
gethash
system-name
systems
)
(
append
versions
(
gethash
system-name
systems
)))))))
(
index-initialize-internal
index
projects
systems
)))
(
defmethod
index-initialize-internal
((
index
index
)
&key
projects
systems
&allow-other-keys
)
(
defmethod
index-initialize-internal
((
index
index
)
projects
systems
)
(
let
((
project-ht
(
make-hash-table
:test
'equal
))
(
system-ht
(
make-hash-table
:test
'equal
)))
(
dolist
(
project-description
projects
)
(
destructuring-bind
(
name
&rest
plist
)
project-description
(
setf
(
gethash
name
project-ht
)
(
apply
#'
make-instance
(
index-project-class
index
)
:index
index
:name
name
plist
))))
(
dolist
(
system-description
systems
)
(
destructuring-bind
(
name
&rest
plist
)
system-description
(
setf
(
gethash
name
system-ht
)
(
apply
#'
make-instance
(
index-system-class
index
)
:index
index
:name
name
plist
))))
(
maphash
(
lambda
(
project-name
project-versions
)
(
setf
(
gethash
project-name
project-ht
)
(
make-instance
(
index-project-class
index
)
:index
index
:name
project-name
:releases
project-versions
)))
projects
)
(
maphash
(
lambda
(
system-name
system-versions
)
(
setf
(
gethash
system-name
system-ht
)
(
make-instance
(
index-system-class
index
)
:index
index
:name
system-name
:releases
system-versions
)))
systems
)
(
setf
(
slot-value
index
'project-ht
)
project-ht
(
slot-value
index
'system-ht
)
system-ht
)))
...
...
@@ -116,28 +166,118 @@ project-index and system-index files are read to instantiate the objects."))
(
hash-table-values
(
index-project-ht
index
)))
(
defmethod
index-save
((
index
index
))
(
dolist
(
p
(
index-projects
index
))
(
project-save
p
))
(
dolist
(
s
(
index-systems
index
))
(
system-save
s
))
(
with-open-object-stream
(
s
(
index-object-store
index
)
"clpi-version"
:direction
:output
:if-exists
:supersede
)
(
with-clpi-io-syntax
()
(
write
"0.4"
:stream
s
)
(
terpri
s
)))
(
let
((
plist
(
index-plist
index
)))
(
with-open-object-stream
(
s
(
index-object-store
index
)
"index"
(
let
((
project-added-release-versions-ht
(
make-hash-table
))
(
project-removed-release-versions-ht
(
make-hash-table
))
project-index-object-version-bumped
(
system-added-release-versions-ht
(
make-hash-table
))
(
system-removed-release-versions-ht
(
make-hash-table
))
system-index-object-version-bumped
)
(
dolist
(
p
(
index-projects
index
))
;; First, figure out the added and removed project releases.
(
awhen
(
project-added-release-versions
p
)
(
setf
(
gethash
p
project-added-release-versions-ht
)
it
))
(
awhen
(
project-removed-release-versions
p
)
(
setf
(
gethash
p
project-removed-release-versions-ht
)
it
))
;; Then write to disk.
(
project-save
p
))
(
dolist
(
s
(
index-systems
index
))
;; First, figure out the added and removed system releases.
(
awhen
(
system-added-system-release-descriptions
s
)
(
setf
(
gethash
s
system-added-release-versions-ht
)
it
))
(
awhen
(
system-removed-system-release-descriptions
s
)
(
setf
(
gethash
s
system-removed-release-versions-ht
)
it
))
;; Then write to disk.
(
system-save
s
))
(
with-open-object-stream
(
s
(
index-object-store
index
)
"clpi-version"
:direction
:output
:if-exists
:supersede
)
(
with-clpi-io-syntax
()
(
pprint
plist
s
)))))
(
write
"0.4"
:stream
s
)
(
terpri
s
)))
;; Determine if the project-index version needs to be updated.
(
when
(
and
(
index-project-index-object-version
index
)
(
not
(
zerop
(
hash-table-count
project-removed-release-versions-ht
))))
(
incf
(
index-project-index-object-version
index
))
(
setf
project-index-object-version-bumped
t
))
;; Determine if the project-index version needs to be updated.
(
when
(
and
(
index-system-index-object-version
index
)
(
not
(
zerop
(
hash-table-count
system-removed-release-versions-ht
))))
(
incf
(
index-system-index-object-version
index
))
(
setf
system-index-object-version-bumped
t
))
;; Write the project-index. If we bumped the version or the version is NIL,
;; we need to write the whole file.
(
if
(
or
(
null
(
index-project-index-object-version
index
))
project-index-object-version-bumped
)
(
with-open-object-stream
(
s
(
index-object-store
index
)
(
index-project-index-object-path
index
)
:direction
:output
:if-exists
:supersede
)
(
dolist
(
p
(
index-projects
index
))
(
with-clpi-io-syntax
()
(
write
(
list*
(
project-name
p
)
(
project-versions
p
))
:stream
s
)
(
terpri
s
))))
(
with-open-object-stream
(
s
(
index-object-store
index
)
(
index-project-index-object-path
index
)
:direction
:output
:if-exists
:append
)
(
dolist
(
p
(
index-new-projects
index
))
(
with-clpi-io-syntax
()
(
write
(
list*
(
project-name
p
)
(
project-versions
p
))
:stream
s
)
(
terpri
s
))
(
remhash
p
project-added-release-versions-ht
))
(
maphash
(
lambda
(
project
added-versions
)
(
with-clpi-io-syntax
()
(
write
(
list*
(
project-name
project
)
added-versions
)
:stream
s
)
(
terpri
s
)))
project-added-release-versions-ht
)))
(
setf
(
index-new-projects
index
)
nil
)
(
awhen
(
index-project-index-object-version
index
)
(
with-open-object-stream
(
s
(
index-object-store
index
)
"project-index-object-version"
:direction
:output
:if-exists
:supersede
)
(
write
it
:stream
s
)))
;; Write the system-index. If we bumped the version or the version is NIL,
;; we need to write the whole file.
(
if
(
or
(
null
(
index-system-index-object-version
index
))
system-index-object-version-bumped
)
(
with-open-object-stream
(
s
(
index-object-store
index
)
(
index-system-index-object-path
index
)
:direction
:output
:if-exists
:supersede
)
(
dolist
(
system
(
index-systems
index
))
(
with-clpi-io-syntax
()
(
write
(
list*
(
system-name
system
)
(
system-system-release-descriptions
system
))
:stream
s
)
(
terpri
s
))))
(
with-open-object-stream
(
s
(
index-object-store
index
)
(
index-system-index-object-path
index
)
:direction
:output
:if-exists
:append
)
(
dolist
(
system
(
index-new-systems
index
))
(
with-clpi-io-syntax
()
(
write
(
list*
(
system-name
system
)
(
system-system-release-descriptions
system
))
:stream
s
)
(
terpri
s
))
(
remhash
system
system-added-release-versions-ht
))
(
maphash
(
lambda
(
system
added-versions
)
(
with-clpi-io-syntax
()
(
write
(
list*
(
system-name
system
)
added-versions
)
:stream
s
)
(
terpri
s
)))
system-added-release-versions-ht
)))
(
setf
(
index-new-systems
index
)
nil
)
(
awhen
(
index-system-index-object-version
index
)
(
with-open-object-stream
(
s
(
index-object-store
index
)
"system-index-object-version"
:direction
:output
:if-exists
:supersede
)
(
write
it
:stream
s
))))
(
values
))
(
defmethod
index-sync
((
index
index
))
(
let
((
object-store
(
index-object-store
index
)))
(
when
(
typep
object-store
'dual-object-store
)
(
dual-object-store-update-object
object-store
"clpi-version"
)
(
dual-object-store-update-object
object-store
"index"
)
(
dual-object-store-update-object
object-store
"project-index-object-version"
)
(
dual-object-store-update-object
object-store
"system-index-object-version"
)
(
dual-object-store-update-object
object-store
(
index-project-index-object-path
index
))
(
dual-object-store-update-object
object-store
(
index-system-index-object-path
index
))
(
dolist
(
p
(
index-projects
index
))
(
dual-object-store-update-object
object-store
(
project-object-path
p
"repo"
))
(
dual-object-store-update-object
object-store
(
project-object-path
p
"authors"
))
...
...
src/object-store-dual.lisp
View file @
322a3a25
...
...
@@ -37,7 +37,9 @@ store, the secondary is updated from the primary and then the secondary is read.
(
defun
path-appendable-p
(
path
)
(
let
((
file-namestring
(
file-namestring
path
)))
(
starts-with-subseq
"releases-"
file-namestring
)))
(
or
(
starts-with-subseq
"releases-"
file-namestring
)
(
starts-with-subseq
"project-index-"
file-namestring
)
(
starts-with-subseq
"system-index-"
file-namestring
))))
(
defun
dual-object-store-update-object
(
object-store
path
)
(
let*
((
primary
(
dual-object-store-primary
object-store
))
...
...
src/project-defs.lisp
View file @
322a3a25
...
...
@@ -7,6 +7,7 @@
(
:use
#:cl
)
(
:export
#:project
#:project-add-release
#:project-added-release-versions
#:project-changes-appendable-p
#:project-commit-new-releases-to-stream!
#:project-dirty-p
...
...
@@ -25,6 +26,7 @@
#:project-release-class
#:project-releases
#:project-releases-path
#:project-removed-release-versions
#:project-repo
#:project-save
#:project-version-scheme
...
...
@@ -58,6 +60,11 @@
(
:documentation
"Add a new release to PROJECT."
))
(
defgeneric
project-added-release-versions
(
project
)
(
:documentation
"Returns a list of strings naming new versions of the PROJECT added since it
was last saved."
))
(
defgeneric
project-changes-appendable-p
(
project
)
(
:documentation
"Returns a boolean indicating if the changes made to the project can be
...
...
@@ -112,6 +119,11 @@ NIL."))
(
:documentation
"Returns the path to the PROJECT's releases object in its index."
))
(
defgeneric
project-removed-release-versions
(
project
)
(
:documentation
"Returns a list of strings naming versions of the PROJECT removed since it
was last saved."
))
(
defgeneric
project-repo
(
project
)
(
:documentation
"Returns the source repository for PROJECT."
))
...
...
src/project.lisp
View file @
322a3a25
...
...
@@ -85,6 +85,14 @@ instantiated."))
(
push
(
cons
:add-release
new-release
)
(
project-release-deltas
project
))
project
)
(
defmethod
project-added-release-versions
((
project
project
))
(
mapcar
(
compose
#'
release-version
#'
cdr
)
(
remove-if-not
(
lambda
(
x
)
(
eql
(
car
x
)
:add-release
))
(
project-release-deltas
project
))))
(
defmethod
project-removed-release-versions
((
project
project
))
;; We don't allow removing releases yet.
nil
)
(
defmethod
project-changes-appendable-p
((
project
project
))
(
every
(
lambda
(
x
)
(
eql
(
car
x
)
:add-release
))
...
...
@@ -148,11 +156,10 @@ instantiated."))
(
mapcar
(
curry
#'
project-release
project
)
(
project-versions
project
)))
(
defmethod
project-releases-path
((
project
project
))
(
let
((
releases-object-version
(
project-releases-object-version
project
))
(
project-name
(
project-name
project
)))
(
let
((
releases-object-version
(
project-releases-object-version
project
)))
(
if
releases-object-version
(
uiop:strcat
"projects/"
project-name
"
/
releases-"
(
write-to-string
releases-object-version
))
(
uiop:strcat
"projects/"
project-name
"
/
releases"
))))
(
project-object-path
project
(
uiop:strcat
"releases-"
(
write-to-string
releases-object-version
))
)
(
project-object-path
project
(
uiop:strcat
"releases"
))))
)
(
defmethod
project-save
((
project
project
))
(
when
(
project-dirty-p
project
)
...
...
src/system-defs.lisp
View file @
322a3a25
...
...
@@ -7,6 +7,7 @@
(
:use
#:cl
)
(
:export
#:system
#:system-add-system-release
#:system-added-system-release-descriptions
#:system-index-plist
#:system-name
#:system-no-such-version
...
...
@@ -15,7 +16,9 @@
#:system-object-path
#:system-primary-project
#:system-save
#:system-system-release-descriptions
#:system-releases
#:system-removed-system-release-descriptions
#:system-version-release-names
#:system-version-releases
#:system-versions
))
...
...
@@ -38,6 +41,11 @@
(
:documentation
"Add a new system release to SYSTEM."
))
(
defgeneric
system-added-system-release-descriptions
(
system
)
(
:documentation
"Returns a list of system release descriptions naming new versions of the
SYSTEM added since it was last saved."
))
(
defgeneric
system-index-plist
(
system
)
(
:documentation
"Return a plist for describing the SYSTEM in an index."
))
...
...
@@ -60,10 +68,19 @@ If ERROR is non-NIL (default), a PROJECT-MISSING-VERSION condition is signaled
if a release object cannot be instantiated due to missing information in the
index. Otherwise, then such releases are silently dropped."
))
(
defgeneric
system-removed-system-release-descriptions
(
system
)
(
:documentation
"Returns a list of system release descriptions naming versions of the SYSTEM
removed since it was last saved."
))
(
defgeneric
system-save
(
system
)
(
:documentation
"Save the SYSTEM's data to objects in the index."
))
(
defgeneric
system-system-release-descriptions
(
system
)
(
:documentation
"Returns a list describing all the system releases of SYSTEM."
))
(
defgeneric
system-version-release-names
(
system
version
&optional
error
)
(
:documentation
"Return a list of release names that provide VERSION of SYSTEM. A release
...
...
src/system.lisp
View file @
322a3a25
...
...
@@ -33,7 +33,10 @@ contained in that release.")
:reader
system-version-release-ht
:documentation
"Maps system versions to a list of releases (as two element lists) that
provide that version."
)))
provide that version."
)
(
system-release-deltas
:initform
nil
:accessor
system-system-release-deltas
)))
(
defmethod
initialize-instance
:after
((
system
system
)
&key
releases
&allow-other-keys
)
(
let
((
release-version-ht
(
make-hash-table
:test
'equal
))
...
...
@@ -64,9 +67,28 @@ provide that version.")))
(
system-release-version
new-system-release
))
(
setf
(
gethash
(
system-release-version
new-system-release
)
(
system-version-release-ht
system
))
release-spec
))
release-spec
)
(
push
(
cons
:add
(
if
(
system-release-version
new-system-release
)
(
list
release-spec
(
system-release-version
new-system-release
))
(
list
release-spec
)))
(
system-system-release-deltas
system
)))
system
)
(
defmethod
system-added-system-release-descriptions
((
system
system
))
(
mapcar
#'
cdr
(
remove-if-not
(
lambda
(
x
)
(
eql
(
car
x
)
:add
))
(
system-system-release-deltas
system
))))
(
defmethod
system-removed-system-release-descriptions
((
system
system
))
;; We don't support removing system releases yet.
nil
)
(
defmethod
system-system-release-descriptions
((
system
system
))
(
let
(
out
)
(
maphash
(
lambda
(
k
v
)
(
push
(
if
v
(
list
k
v
)
(
list
k
))
out
))
(
system-release-version-ht
system
))
out
))
(
defmethod
system-index-plist
((
system
system
))
(
let
((
out
nil
)
system-release-versions
)
...
...
@@ -97,7 +119,8 @@ provide that version.")))
:if-exists
:supersede
)
(
with-clpi-io-syntax
()
(
write
(
system-primary-project
system
)
:stream
s
)
(
terpri
s
)))))
(
terpri
s
))))
(
setf
(
system-system-release-deltas
system
)
nil
))
(
defmethod
system-version-release-names
((
system
system
)
version
&optional
(
error
t
))
(
multiple-value-bind
(
names
exists-p
)
(
gethash
version
(
system-version-release-ht
system
))
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment