forked from mirrors/nixpkgs
131 lines
4.4 KiB
Diff
131 lines
4.4 KiB
Diff
From 752dff853186dc334c519a86fa92f087795fea02 Mon Sep 17 00:00:00 2001
|
|
From: Moritz Heidkamp <moritz.heidkamp@bevuta.com>
|
|
Date: Wed, 1 Oct 2014 22:41:30 +0200
|
|
Subject: [PATCH] Introduce CHICKEN_REPOSITORY_EXTRA
|
|
|
|
This environment variable works like CHICKEN_REPOSITORY but supports
|
|
multiple paths separated by `:'. Those paths are searched after
|
|
CHICKEN_REPOSITORY when loading extensions via `require-library' and
|
|
friends. It can be accessed and changed at runtime via the new procedure
|
|
`repository-extra-paths' which is analog to `repository-path'.
|
|
---
|
|
chicken-install.scm | 11 +++++++----
|
|
chicken.import.scm | 1 +
|
|
eval.scm | 37 +++++++++++++++++++++++++++++++------
|
|
3 files changed, 39 insertions(+), 10 deletions(-)
|
|
|
|
diff --git a/chicken-install.scm b/chicken-install.scm
|
|
index 2ef6ef4..b5c6bf8 100644
|
|
--- a/chicken-install.scm
|
|
+++ b/chicken-install.scm
|
|
@@ -109,10 +109,10 @@
|
|
(define *show-foreign-depends* #f)
|
|
(define *hacks* '())
|
|
|
|
- (define (repo-path)
|
|
+ (define (repo-paths)
|
|
(if (and *cross-chicken* (not *host-extension*))
|
|
- (make-pathname C_TARGET_LIB_HOME (sprintf "chicken/~a" C_BINARY_VERSION))
|
|
- (repository-path)))
|
|
+ (list (make-pathname C_TARGET_LIB_HOME (sprintf "chicken/~a" C_BINARY_VERSION)))
|
|
+ (cons (repository-path) (repository-extra-paths))))
|
|
|
|
(define (get-prefix #!optional runtime)
|
|
(cond ((and *cross-chicken*
|
|
@@ -757,7 +757,10 @@
|
|
"installed extension has no information about which egg it belongs to"
|
|
(pathname-file sf))
|
|
#f))))
|
|
- (glob (make-pathname (repo-path) "*" "setup-info")))
|
|
+ (append-map
|
|
+ (lambda (path)
|
|
+ (glob (make-pathname path "*" "setup-info")))
|
|
+ (repo-paths)))
|
|
equal?))
|
|
|
|
(define (list-available-extensions trans locn)
|
|
diff --git a/chicken.import.scm b/chicken.import.scm
|
|
index baa7316..2839b16 100644
|
|
--- a/chicken.import.scm
|
|
+++ b/chicken.import.scm
|
|
@@ -201,6 +201,7 @@
|
|
repl
|
|
repl-prompt
|
|
repository-path
|
|
+ repository-extra-paths
|
|
require
|
|
reset
|
|
reset-handler
|
|
diff --git a/eval.scm b/eval.scm
|
|
index bbcd86c..838588d 100644
|
|
--- a/eval.scm
|
|
+++ b/eval.scm
|
|
@@ -81,6 +81,7 @@
|
|
(define-constant source-file-extension ".scm")
|
|
(define-constant setup-file-extension "setup-info")
|
|
(define-constant repository-environment-variable "CHICKEN_REPOSITORY")
|
|
+(define-constant repository-extra-environment-variable "CHICKEN_REPOSITORY_EXTRA")
|
|
(define-constant prefix-environment-variable "CHICKEN_PREFIX")
|
|
|
|
; these are actually in unit extras, but that is used by default
|
|
@@ -1180,6 +1181,25 @@
|
|
|
|
(define repository-path ##sys#repository-path)
|
|
|
|
+(define ##sys#repository-extra-paths
|
|
+ (let* ((repaths (get-environment-variable repository-extra-environment-variable))
|
|
+ (repaths (if repaths
|
|
+ (let ((len (string-length repaths)))
|
|
+ (let loop ((i 0) (offset 0) (res '()))
|
|
+ (cond ((> i len)
|
|
+ (reverse res))
|
|
+ ((or (= i len) (eq? #\: (string-ref repaths i)))
|
|
+ (loop (+ i 1) (+ i 1) (cons (substring repaths offset i) res)))
|
|
+ (else
|
|
+ (loop (+ i 1) offset res)))))
|
|
+ '())))
|
|
+ (lambda (#!optional val)
|
|
+ (if val
|
|
+ (set! repaths val)
|
|
+ repaths))))
|
|
+
|
|
+(define repository-extra-paths ##sys#repository-extra-paths)
|
|
+
|
|
(define ##sys#setup-mode #f)
|
|
|
|
(define ##sys#find-extension
|
|
@@ -1197,6 +1217,7 @@
|
|
(let loop ((paths (##sys#append
|
|
(if ##sys#setup-mode '(".") '())
|
|
(if rp (list rp) '())
|
|
+ (##sys#repository-extra-paths)
|
|
(if inc? ##sys#include-pathnames '())
|
|
(if ##sys#setup-mode '() '("."))) ))
|
|
(and (pair? paths)
|
|
@@ -1256,12 +1277,16 @@
|
|
[string-append string-append]
|
|
[read read] )
|
|
(lambda (id loc)
|
|
- (and-let* ((rp (##sys#repository-path)))
|
|
- (let* ((p (##sys#canonicalize-extension-path id loc))
|
|
- (rpath (string-append rp "/" p ".")) )
|
|
- (cond ((file-exists? (string-append rpath setup-file-extension))
|
|
- => (cut with-input-from-file <> read) )
|
|
- (else #f) ) ) ) ) ))
|
|
+ (let loop ((rpaths (cons (##sys#repository-path) (##sys#repository-extra-paths))))
|
|
+ (and (pair? rpaths)
|
|
+ (let ((rp (car rpaths)))
|
|
+ (if (not rp)
|
|
+ (loop (cdr rpaths))
|
|
+ (let* ((p (##sys#canonicalize-extension-path id loc))
|
|
+ (rpath (string-append rp "/" p ".")) )
|
|
+ (cond ((file-exists? (string-append rpath setup-file-extension))
|
|
+ => (cut with-input-from-file <> read) )
|
|
+ (else (loop (cdr rpaths))) ) )) ))) ) ))
|
|
|
|
(define (extension-information ext)
|
|
(##sys#extension-information ext 'extension-information) )
|
|
--
|
|
2.1.0
|
|
|