2025-06-30 16:15:39 +02:00
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
;; gen.scm
|
2026-03-30 07:00:06 +02:00
|
|
|
;; Copyright (C) 2025, 2026 Cor Legemaat <cor@cor.za.net>
|
2025-06-30 16:15:39 +02:00
|
|
|
;;
|
|
|
|
|
;; This file is part of ebuild-autogen: you can redistribute it and/or modify it
|
|
|
|
|
;; under the terms of the GNU Affero General Public License as published by the
|
|
|
|
|
;; Free Software Foundation, version 3 of the License.
|
|
|
|
|
;;
|
|
|
|
|
;; ebuild-autogen is distributed in the hope that it will be useful, but WITHOUT
|
|
|
|
|
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
|
|
|
|
|
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
|
|
|
|
|
;; more details.
|
|
|
|
|
;;
|
|
|
|
|
;; You should have received a copy of the GNU General Public License along with
|
|
|
|
|
;; ebuild-autogen. If not, see <https://www.gnu.org/licenses/>.
|
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
|
(define-module (ebuild gen)
|
|
|
|
|
#:use-module (ebuild utils)
|
|
|
|
|
#:use-module (ebuild defs)
|
2026-03-30 07:00:06 +02:00
|
|
|
#:use-module (ebuild semver)
|
|
|
|
|
#:use-module (ebuild state)
|
2025-06-30 16:15:39 +02:00
|
|
|
#:use-module (dql dql)
|
|
|
|
|
#:use-module (rx irregex)
|
|
|
|
|
#:use-module (ice-9 pretty-print)
|
2026-03-30 07:00:06 +02:00
|
|
|
#:use-module (ice-9 receive)
|
2025-06-30 16:15:39 +02:00
|
|
|
#:use-module (ice-9 string-fun)
|
|
|
|
|
#:use-module (ice-9 textual-ports)
|
2026-03-30 07:00:06 +02:00
|
|
|
#:use-module (srfi srfi-1)
|
|
|
|
|
#:use-module (srfi srfi-19))
|
2025-06-30 16:15:39 +02:00
|
|
|
|
|
|
|
|
;;Function to generate template from ebuild with variable substitution.
|
|
|
|
|
(define-public ebuild-from-tmpl
|
|
|
|
|
(lambda* (vars verbosity #:key
|
2026-03-30 07:00:06 +02:00
|
|
|
(tmpl #f)
|
2025-06-30 16:15:39 +02:00
|
|
|
ignore-diff)
|
|
|
|
|
""
|
|
|
|
|
(letrec*
|
2026-03-30 07:00:06 +02:00
|
|
|
((pkg-tmpl (string-join (list (assoc-ref vars 'repo)
|
|
|
|
|
"autogen"
|
|
|
|
|
(assoc-ref vars 'category)
|
|
|
|
|
(assoc-ref vars 'name)
|
|
|
|
|
(string-append (assoc-ref vars 'name)
|
|
|
|
|
".tmpl"))
|
|
|
|
|
file-name-separator-string))
|
|
|
|
|
(cat-tmpl (string-join (list (assoc-ref vars 'repo)
|
|
|
|
|
"autogen"
|
|
|
|
|
(assoc-ref vars 'category)
|
|
|
|
|
(string-append (assoc-ref vars 'category)
|
|
|
|
|
".tmpl"))
|
|
|
|
|
file-name-separator-string))
|
|
|
|
|
(input-port (open-input-file
|
|
|
|
|
(cond (tmpl tmpl)
|
|
|
|
|
((file-exists? pkg-tmpl) pkg-tmpl)
|
|
|
|
|
((file-exists? cat-tmpl) cat-tmpl)
|
|
|
|
|
(else
|
|
|
|
|
(error "No pkg or category template found!")))))
|
|
|
|
|
(data (append (list (string-append
|
|
|
|
|
"# Copyright (C) "
|
|
|
|
|
(number->string (date-year (current-date)))
|
|
|
|
|
" auto generated from autogen.scm"))
|
2025-06-30 16:15:39 +02:00
|
|
|
;; Remove mode-line of tmpl file.
|
2026-03-30 07:00:06 +02:00
|
|
|
(let ((raw (string-split (get-string-all input-port)
|
|
|
|
|
#\lf)))
|
2025-06-30 16:15:39 +02:00
|
|
|
(if (irregex-search '(seq (+ "#")
|
|
|
|
|
(+ space)
|
|
|
|
|
"-*-"
|
|
|
|
|
(+ space))
|
|
|
|
|
(car raw))
|
|
|
|
|
(cdr raw)
|
|
|
|
|
raw))))
|
|
|
|
|
(traverse-list
|
|
|
|
|
(lambda (pre no data)
|
|
|
|
|
(traverse (string-append (if (symbol? pre)
|
|
|
|
|
(symbol->string pre)
|
|
|
|
|
pre)
|
|
|
|
|
"["
|
|
|
|
|
(number->string no)
|
|
|
|
|
"]")
|
2026-03-30 07:00:06 +02:00
|
|
|
(if (null? data) '() (car data)))
|
2025-06-30 16:15:39 +02:00
|
|
|
(if (not (null? (cdr data)))
|
|
|
|
|
(traverse-list pre (1+ no) (cdr data)))))
|
|
|
|
|
(traverse-alist
|
|
|
|
|
(lambda (pre data)
|
2026-03-30 07:00:06 +02:00
|
|
|
(if (not (eq? pre 'dep-graph))
|
|
|
|
|
(for-each
|
|
|
|
|
(lambda (var)
|
|
|
|
|
(if (and (or (string? (car var))
|
|
|
|
|
(symbol? (car var)))
|
|
|
|
|
(or (string? (cdr var))
|
|
|
|
|
(symbol? (cdr var))))
|
|
|
|
|
(replace (if (eq? (string-length pre) 0)
|
|
|
|
|
(if (symbol? (car var))
|
|
|
|
|
(symbol->string (car var))
|
|
|
|
|
(car var))
|
|
|
|
|
(string-append pre
|
|
|
|
|
"."
|
|
|
|
|
(if (symbol? (car var))
|
|
|
|
|
(symbol->string (car var))
|
|
|
|
|
(car var))))
|
|
|
|
|
(if (symbol? (cdr var))
|
|
|
|
|
(symbol->string (cdr var))
|
|
|
|
|
(cdr var)))
|
|
|
|
|
(traverse (if (eq? (string-length pre) 0)
|
|
|
|
|
(if (symbol? (car var))
|
|
|
|
|
(symbol->string (car var))
|
|
|
|
|
(car var))
|
|
|
|
|
(string-append pre
|
|
|
|
|
"."
|
|
|
|
|
(if (symbol? (car var))
|
|
|
|
|
(symbol->string (car var))
|
|
|
|
|
(car var))))
|
|
|
|
|
(cdr var))))
|
|
|
|
|
data))))
|
2025-06-30 16:15:39 +02:00
|
|
|
(traverse (lambda (pre data)
|
2026-03-30 07:00:06 +02:00
|
|
|
(cond ((null? data) '())
|
|
|
|
|
((alist? data)
|
|
|
|
|
(traverse-alist pre data))
|
2025-06-30 16:15:39 +02:00
|
|
|
((list? data)
|
|
|
|
|
(traverse-list pre 0 data))
|
|
|
|
|
((number? data)
|
|
|
|
|
(replace pre (number->string data)))
|
|
|
|
|
((string? data) (replace pre data))
|
2026-03-30 07:00:06 +02:00
|
|
|
((eqv? #f data) (replace pre "false"))
|
|
|
|
|
((eqv? #t data) (replace pre "true"))
|
|
|
|
|
((time? data)
|
|
|
|
|
(replace pre (number->string (time-second data))))
|
2025-06-30 16:15:39 +02:00
|
|
|
(else (error (string-append "Error! Don't know how "
|
|
|
|
|
"to process \""
|
|
|
|
|
(object->string data)
|
|
|
|
|
"\" data type."))))))
|
|
|
|
|
(replace
|
|
|
|
|
(lambda (var val)
|
|
|
|
|
(let ((var-str (string-append "{{"
|
|
|
|
|
(if (symbol? var)
|
|
|
|
|
(symbol->string var)
|
|
|
|
|
var)
|
|
|
|
|
"}}")))
|
|
|
|
|
(if (>= verbosity verbosity-info)
|
|
|
|
|
(begin (display "Replacing \"") (display var-str)
|
|
|
|
|
(display "\" with \"") (display val)
|
|
|
|
|
(display "\"") (newline)))
|
|
|
|
|
(set! data (map (lambda (line)
|
|
|
|
|
(string-replace-substring line
|
|
|
|
|
var-str
|
|
|
|
|
val))
|
2026-03-30 07:00:06 +02:00
|
|
|
data)))))
|
|
|
|
|
(final-ebuild
|
|
|
|
|
(lambda (ebuild)
|
|
|
|
|
(state-write (state-set
|
|
|
|
|
(state-load (assoc-ref vars 'repo)
|
|
|
|
|
(assoc-ref vars 'category)
|
|
|
|
|
(assoc-ref vars 'name))
|
|
|
|
|
(assoc-ref vars 'constraint)
|
|
|
|
|
ebuild
|
|
|
|
|
(comps->genver (assoc-ref vars "version-values"))
|
|
|
|
|
'())
|
|
|
|
|
(assoc-ref vars 'repo)
|
|
|
|
|
(assoc-ref vars 'category)
|
|
|
|
|
(assoc-ref vars 'name))
|
|
|
|
|
(list (list (cons 'category (assoc-ref vars 'category))
|
|
|
|
|
(cons 'name (assoc-ref vars 'name))
|
|
|
|
|
(cons 'pkgfiles
|
|
|
|
|
(append (if (assoc-ref vars 'pkgfiles)
|
|
|
|
|
(assoc-ref vars 'pkgfiles)
|
|
|
|
|
'())
|
|
|
|
|
(list ebuild)))
|
|
|
|
|
(cons 'distfiles (if (assoc-ref vars 'distfiles)
|
|
|
|
|
(assoc-ref vars 'distfiles)
|
|
|
|
|
'())))))))
|
2025-06-30 16:15:39 +02:00
|
|
|
(traverse "" vars)
|
|
|
|
|
(let* ((folder-out (string-join (list (assoc-ref vars 'repo)
|
|
|
|
|
(assoc-ref vars 'category)
|
|
|
|
|
(assoc-ref vars 'name))
|
|
|
|
|
file-name-separator-string))
|
|
|
|
|
(rel (last-ebuild-rel folder-out
|
|
|
|
|
(assoc-ref vars 'name)
|
2026-03-30 07:00:06 +02:00
|
|
|
(comps->genver (assoc-ref vars
|
|
|
|
|
"version-values"))))
|
2025-06-30 16:15:39 +02:00
|
|
|
(ebuild-name (lambda (rel)
|
2026-03-30 07:00:06 +02:00
|
|
|
(string-append
|
|
|
|
|
(assoc-ref vars 'name)
|
|
|
|
|
"-"
|
|
|
|
|
(comps->genver (assoc-ref vars "version-values"))
|
|
|
|
|
(if (< 0 rel)
|
|
|
|
|
(string-append "-r"
|
|
|
|
|
(number->string rel))
|
|
|
|
|
"")
|
|
|
|
|
".ebuild"))))
|
2025-06-30 16:15:39 +02:00
|
|
|
(if (file-exists? (string-join (list folder-out
|
|
|
|
|
(ebuild-name rel))
|
|
|
|
|
file-name-separator-string))
|
|
|
|
|
(if (and (not ignore-diff)
|
|
|
|
|
(diff? data
|
2026-03-30 07:00:06 +02:00
|
|
|
(let* ((port-ebuild
|
|
|
|
|
(open-input-file
|
|
|
|
|
(string-join (list folder-out
|
|
|
|
|
(ebuild-name rel))
|
|
|
|
|
file-name-separator-string)))
|
|
|
|
|
(data-ebuild (get-string-all port-ebuild)))
|
|
|
|
|
(close port-ebuild)
|
|
|
|
|
(string-split data-ebuild #\newline))
|
|
|
|
|
#:allow (lambda (a b)
|
|
|
|
|
(let* ((rx '(seq bos "#"))
|
|
|
|
|
(match-a (irregex-search rx a))
|
|
|
|
|
(match-b (irregex-search rx b)))
|
|
|
|
|
(if (and match-a match-b)
|
|
|
|
|
#false #true)))
|
|
|
|
|
#:print-delta (>= verbosity verbosity-info)))
|
|
|
|
|
;; Data the same.
|
2025-06-30 16:15:39 +02:00
|
|
|
(let ((output-port (open-output-file
|
|
|
|
|
(string-join (list folder-out
|
|
|
|
|
(ebuild-name (1+ rel)))
|
|
|
|
|
file-name-separator-string))))
|
|
|
|
|
(display (string-join data "\n") output-port)
|
|
|
|
|
(close output-port)
|
2026-03-30 07:00:06 +02:00
|
|
|
(final-ebuild (ebuild-name (1+ rel))))
|
|
|
|
|
;; Data differs.
|
|
|
|
|
(final-ebuild (ebuild-name rel)))
|
2025-06-30 16:15:39 +02:00
|
|
|
(let ((output-port (open-output-file
|
|
|
|
|
(string-join (list folder-out
|
|
|
|
|
(ebuild-name rel))
|
|
|
|
|
file-name-separator-string))))
|
|
|
|
|
(display (string-join data "\n") output-port)
|
|
|
|
|
(close output-port)
|
2026-03-30 07:00:06 +02:00
|
|
|
(final-ebuild (ebuild-name rel))))))))
|
2025-06-30 16:15:39 +02:00
|
|
|
|
|
|
|
|
(define-public ebuild-version-filter
|
|
|
|
|
(lambda* (releases #:key
|
|
|
|
|
(keep-components (if (assoc-ref releases 'keep-vers-comps)
|
|
|
|
|
(assoc-ref releases 'keep-vers-comps)
|
|
|
|
|
(list 1 1 1)))
|
|
|
|
|
(keep (lambda (version) #f))
|
|
|
|
|
(drop (lambda (version) #f)))
|
|
|
|
|
""
|
|
|
|
|
(let* ((vlist (map (lambda (release)
|
2026-03-30 07:00:06 +02:00
|
|
|
(assoc-ref release "version-values"))
|
2025-06-30 16:15:39 +02:00
|
|
|
releases))
|
|
|
|
|
(vlist-filtered
|
|
|
|
|
(append (filter (lambda (vers)
|
2026-03-30 07:00:06 +02:00
|
|
|
(if (keep vers) vers #f))
|
2025-06-30 16:15:39 +02:00
|
|
|
vlist)
|
2026-03-30 07:00:06 +02:00
|
|
|
(semver-keep (filter (lambda (vers)
|
|
|
|
|
(if (drop vers) #f vers))
|
|
|
|
|
vlist)
|
|
|
|
|
keep-components))))
|
2025-06-30 16:15:39 +02:00
|
|
|
(filter-map (lambda (rel)
|
|
|
|
|
(if (any (lambda (vers)
|
2026-03-30 07:00:06 +02:00
|
|
|
(semver-eq? (assoc-ref rel "version-values")
|
|
|
|
|
vers))
|
2025-06-30 16:15:39 +02:00
|
|
|
vlist-filtered)
|
2026-03-30 07:00:06 +02:00
|
|
|
rel
|
2025-06-30 16:15:39 +02:00
|
|
|
#f))
|
|
|
|
|
releases))))
|
|
|
|
|
|
2026-03-30 07:00:06 +02:00
|
|
|
(define allow-keyword-comment-diff
|
|
|
|
|
(lambda (a b)
|
|
|
|
|
(let* ((rx '(or (seq bos "#")
|
|
|
|
|
(seq bos
|
|
|
|
|
"KEYWORDS=\""
|
|
|
|
|
(+ (or alphanumeric whitespace #\- #\~))
|
|
|
|
|
"\""
|
|
|
|
|
eos)))
|
|
|
|
|
(match-a (irregex-search rx a))
|
|
|
|
|
(match-b (irregex-search rx b)))
|
|
|
|
|
(if (and match-a match-b)
|
|
|
|
|
#false #true))))
|
|
|
|
|
|
2025-06-30 16:15:39 +02:00
|
|
|
(define-public ebuild-cp-man
|
|
|
|
|
(lambda (parms)
|
|
|
|
|
""
|
2026-03-30 07:00:06 +02:00
|
|
|
(let* ((genver (comps->genver (assoc-ref parms "version-values")))
|
|
|
|
|
(folder-in (string-join (list (assoc-ref parms 'repo)
|
2025-06-30 16:15:39 +02:00
|
|
|
"autogen"
|
|
|
|
|
(assoc-ref parms 'category)
|
|
|
|
|
(assoc-ref parms 'name))
|
|
|
|
|
file-name-separator-string))
|
|
|
|
|
(folder-out (string-join (list (assoc-ref parms 'repo)
|
|
|
|
|
(assoc-ref parms 'category)
|
|
|
|
|
(assoc-ref parms 'name))
|
|
|
|
|
file-name-separator-string))
|
|
|
|
|
(rel-in (last-ebuild-rel folder-in
|
|
|
|
|
(assoc-ref parms 'name)
|
2026-03-30 07:00:06 +02:00
|
|
|
genver))
|
2025-06-30 16:15:39 +02:00
|
|
|
(rel-out (last-ebuild-rel folder-out
|
|
|
|
|
(assoc-ref parms 'name)
|
2026-03-30 07:00:06 +02:00
|
|
|
genver))
|
2025-06-30 16:15:39 +02:00
|
|
|
(ebuild-name (lambda (rel)
|
|
|
|
|
(string-append (assoc-ref parms 'name)
|
|
|
|
|
"-"
|
2026-03-30 07:00:06 +02:00
|
|
|
genver
|
2025-06-30 16:15:39 +02:00
|
|
|
(if (< 0 rel)
|
|
|
|
|
(string-append "-r"
|
|
|
|
|
(number->string rel))
|
|
|
|
|
"")
|
2026-03-30 07:00:06 +02:00
|
|
|
".ebuild")))
|
|
|
|
|
(return (lambda (rel)
|
|
|
|
|
(list (list (cons 'category (assoc-ref parms 'category))
|
|
|
|
|
(cons 'name (assoc-ref parms 'name))
|
|
|
|
|
(cons 'pkgfiles
|
|
|
|
|
(append (if (assoc-ref parms 'pkgfiles)
|
|
|
|
|
(assoc-ref parms 'pkgfiles)
|
|
|
|
|
'())
|
|
|
|
|
(list (ebuild-name rel))))
|
|
|
|
|
(cons 'distfiles (if (assoc-ref parms 'distfiles)
|
|
|
|
|
(assoc-ref parms 'distfiles)
|
|
|
|
|
'())))))))
|
2025-06-30 16:15:39 +02:00
|
|
|
(if rel-in
|
|
|
|
|
(let ((path-in (string-join (list folder-in
|
|
|
|
|
(ebuild-name rel-in))
|
|
|
|
|
file-name-separator-string))
|
|
|
|
|
(path-out (string-join (list folder-out
|
|
|
|
|
(ebuild-name rel-out))
|
|
|
|
|
file-name-separator-string)))
|
|
|
|
|
(if (and (< 0 rel-in)
|
|
|
|
|
(< verbosity-warn (assoc-ref parms 'verbosity)))
|
|
|
|
|
(begin (display "Warning: Source ebuild should not have ")
|
|
|
|
|
(display "revisions, handled automatically!")
|
|
|
|
|
(newline)))
|
|
|
|
|
(if (file-exists? path-in)
|
|
|
|
|
(let* ((port-in (open-input-file path-in))
|
|
|
|
|
(port-out (open-input-file path-out))
|
|
|
|
|
(data-in (get-string-all port-in))
|
|
|
|
|
(data-out (get-string-all port-out)))
|
|
|
|
|
(close port-in)
|
|
|
|
|
(close port-out)
|
|
|
|
|
(if (diff? data-in data-out
|
2026-03-30 07:00:06 +02:00
|
|
|
#:allow allow-keyword-comment-diff
|
|
|
|
|
#:print-delta (>= (assoc-ref parms "verbosity")
|
|
|
|
|
verbosity-info))
|
|
|
|
|
(let ((output-port
|
|
|
|
|
(open-output-file
|
|
|
|
|
(string-join (list folder-out
|
|
|
|
|
(ebuild-name (1+ rel-out)))
|
|
|
|
|
file-name-separator-string))))
|
2025-06-30 16:15:39 +02:00
|
|
|
(display data-in output-port)
|
|
|
|
|
(close output-port)
|
2026-03-30 07:00:06 +02:00
|
|
|
(return (1+ rel-out)))
|
2025-06-30 16:15:39 +02:00
|
|
|
(if (diff? data-in data-out
|
2026-03-30 07:00:06 +02:00
|
|
|
#:allow allow-keyword-comment-diff
|
|
|
|
|
#:print-delta (>= (assoc-ref parms "verbosity")
|
|
|
|
|
verbosity-info))
|
2025-06-30 16:15:39 +02:00
|
|
|
(let ((output-port (open-output-file
|
2026-03-30 07:00:06 +02:00
|
|
|
(return rel-out))))
|
2025-06-30 16:15:39 +02:00
|
|
|
(display data-in output-port)
|
|
|
|
|
(close output-port)
|
2026-03-30 07:00:06 +02:00
|
|
|
(return rel-out))
|
|
|
|
|
'())))
|
|
|
|
|
'()))
|
|
|
|
|
'()))))
|
|
|
|
|
|
2026-03-30 14:10:45 +02:00
|
|
|
(define-public ebuild-default-post-ebuild
|
|
|
|
|
(lambda (ebuild parms)
|
|
|
|
|
(system* "ebuild" ebuild "manifest")
|
|
|
|
|
'()))
|
|
|
|
|
|
2026-03-30 07:00:06 +02:00
|
|
|
(define-public ebuild-default-post
|
2026-03-30 14:10:45 +02:00
|
|
|
(lambda* (ebuilds parms
|
|
|
|
|
#:key (ebuild-callback ebuild-default-post-ebuild))
|
2026-03-30 07:00:06 +02:00
|
|
|
;; (display "parms:") (newline)
|
|
|
|
|
;; (pretty-print parms)
|
|
|
|
|
;; (display "ebuild-created:") (newline)
|
|
|
|
|
;; (pretty-print ebuilds)
|
|
|
|
|
(let* ((out-file (lambda (ebuild)
|
|
|
|
|
(string-join (list (assoc-ref parms 'repo)
|
|
|
|
|
(assoc-ref parms 'category)
|
|
|
|
|
(assoc-ref parms 'name)
|
|
|
|
|
ebuild)
|
|
|
|
|
file-name-separator-string)))
|
|
|
|
|
(run-post (lambda (ebuild)
|
|
|
|
|
(if (not (file-exists? (out-file ebuild)))
|
|
|
|
|
(error (string-append "Ebuild \""
|
|
|
|
|
(out-file ebuild)
|
|
|
|
|
"\" does not exists!!!")))
|
|
|
|
|
(if (string-suffix? ".ebuild" (out-file ebuild))
|
2026-03-30 14:10:45 +02:00
|
|
|
(ebuild-callback (out-file ebuild) parms)
|
|
|
|
|
'()))))
|
2026-03-30 07:00:06 +02:00
|
|
|
(cond ((null? ebuilds) '())
|
|
|
|
|
((assoc-ref ebuilds 'pkg-files)
|
2026-03-30 14:10:45 +02:00
|
|
|
(assoc-set! ebuilds
|
|
|
|
|
'distfiles
|
|
|
|
|
(append (append-map run-post
|
|
|
|
|
(assoc-ref ebuilds 'pkgfiles))
|
|
|
|
|
(assoc-ref ebuilds 'distfiles))))
|
2026-03-30 07:00:06 +02:00
|
|
|
((assoc-ref (car ebuilds) 'pkgfiles)
|
2026-03-30 14:10:45 +02:00
|
|
|
(cons (assoc-set! (car ebuilds)
|
|
|
|
|
'distfiles
|
|
|
|
|
(append (append-map run-post
|
|
|
|
|
(assoc-ref (car ebuilds)
|
|
|
|
|
'pkgfiles))
|
|
|
|
|
(assoc-ref (car ebuilds) 'distfiles)))
|
|
|
|
|
(cdr ebuilds)))))))
|
2025-06-30 16:15:39 +02:00
|
|
|
|
|
|
|
|
;;Procedure to generate the required ebuild from the given releases.
|
|
|
|
|
(define-public ebuild-gen
|
|
|
|
|
(lambda* (parms releases #:key
|
2026-03-30 07:00:06 +02:00
|
|
|
(keep-components (if (assoc-ref parms 'keep-vers-comps)
|
|
|
|
|
(assoc-ref parms 'keep-vers-comps)
|
|
|
|
|
(list 1 1 1)))
|
2025-06-30 16:15:39 +02:00
|
|
|
(keep (lambda (version) #f))
|
|
|
|
|
(drop (lambda (version) #f))
|
2026-03-30 07:00:06 +02:00
|
|
|
(template #f)
|
|
|
|
|
(gen-ebuild-hook ebuild-from-tmpl)
|
|
|
|
|
(post-hook ebuild-default-post)
|
2026-03-30 14:10:45 +02:00
|
|
|
(post-ebuild-hook ebuild-default-post-ebuild)
|
2025-06-30 16:15:39 +02:00
|
|
|
ignore-autogen-diff)
|
|
|
|
|
""
|
|
|
|
|
(if (>= (assoc-ref parms 'verbosity) verbosity-notice)
|
|
|
|
|
(begin (display "Releases:\n")
|
|
|
|
|
(pretty-print releases)))
|
|
|
|
|
(letrec* ((version-list
|
|
|
|
|
(map (lambda (release)
|
2026-03-30 07:00:06 +02:00
|
|
|
(assoc-ref release "version-values"))
|
2025-06-30 16:15:39 +02:00
|
|
|
releases))
|
2026-03-30 07:00:06 +02:00
|
|
|
(selected-versions (semver-keep version-list keep-components))
|
|
|
|
|
(ebuilds (append-map (lambda (vers)
|
|
|
|
|
(let* ((vars (append
|
|
|
|
|
(car (filter
|
|
|
|
|
(lambda (rel)
|
|
|
|
|
(equal? (assoc-ref rel
|
|
|
|
|
"version-values")
|
|
|
|
|
vers))
|
|
|
|
|
releases))
|
|
|
|
|
parms))
|
|
|
|
|
(ebuild-man (ebuild-cp-man vars))
|
|
|
|
|
(ebuild-created
|
|
|
|
|
(if (and (null? ebuild-man)
|
|
|
|
|
(not (drop vers))
|
|
|
|
|
(or (find
|
|
|
|
|
(lambda (test-vers)
|
|
|
|
|
(semver-eq? test-vers vers))
|
|
|
|
|
selected-versions)
|
|
|
|
|
(keep vers)))
|
|
|
|
|
(gen-ebuild-hook vars
|
|
|
|
|
(assoc-ref parms 'verbosity)
|
|
|
|
|
#:tmpl template
|
|
|
|
|
#:ignore-diff ignore-autogen-diff)
|
|
|
|
|
ebuild-man)))
|
2026-03-30 14:10:45 +02:00
|
|
|
(post-hook ebuild-created vars
|
|
|
|
|
#:ebuild-callback post-ebuild-hook)))
|
2026-03-30 07:00:06 +02:00
|
|
|
version-list)))
|
|
|
|
|
ebuilds)))
|
