chicken-motorhome added by mario-goulart on Sun Jan 21 15:07:25 2024
diff --git a/chicken-install.scm b/chicken-install.scm index 36482755..850d4b5a 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -287,14 +287,23 @@ ;; load defaults file ("setup.defaults") - -(define (load-defaults) +(define (locate-defaults-file) (let* ((cfg-dir (system-config-directory)) (user-file (and cfg-dir (make-pathname (list cfg-dir "chicken") - +defaults-file+))) - (deff (or user-defaults - (and user-file (file-exists? user-file)) - (make-pathname host-sharedir +defaults-file+)))) + +defaults-file+)))) + (if (and user-file (file-exists? user-file)) + user-file + (let loop ((search-dirs (chicken-home #t))) + (if (null? search-dirs) + (error 'locate-defaults-file "Defaults file not found") + (let ((cur-file (make-pathname (car search-dirs) +defaults-file+))) + (if (file-exists? cur-file) + cur-file + (loop (cdr search-dirs))))))))) + +(define (load-defaults) + (let* ((deff (locate-defaults-file))) + (d "using ~a as defaults file" deff) (define (broken x) (error "invalid entry in defaults file" deff x)) (cond ((not (file-exists? deff)) '()) diff --git a/egg-compile.scm b/egg-compile.scm index dd7c429e..f47d419a 100644 --- a/egg-compile.scm +++ b/egg-compile.scm @@ -300,7 +300,8 @@ (let* ((dest (or (and dest (normalize-destination dest mode)) (if (eq? mode 'target) default-sharedir - (override-prefix "/share" host-sharedir)))) + ;; FIXME: share/chicken must match the suffix of C_TARGET_SHARE_HOME + (override-prefix "/share/chicken" host-sharedir)))) (dest (normalize-pathname (conc dest "/")))) (addfiles (map (cut conc dest <>) files))) (set! data @@ -1054,7 +1055,8 @@ (install-random-files (or destination (if (eq? mode 'target) default-sharedir - (override-prefix "/share" + ;; FIXME: share/chicken must match the suffix of C_TARGET_SHARE_HOME + (override-prefix "/share/chicken" host-sharedir))) files mode srcdir platform)) diff --git a/eval.scm b/eval.scm index e760aad0..c75dd7c1 100644 --- a/eval.scm +++ b/eval.scm @@ -1283,7 +1283,7 @@ ;;; Find included file: -(define ##sys#include-pathnames (list (chicken-home))) +(define ##sys#include-pathnames (chicken-home #t)) (define ##sys#resolve-include-filename (let ((string-append string-append) ) diff --git a/library.scm b/library.scm index 3ec87a74..3e54969b 100644 --- a/library.scm +++ b/library.scm @@ -6628,7 +6628,18 @@ static C_word C_fcall C_setenv(C_word x, C_word y) { (define-foreign-variable installation-home c-string "C_INSTALL_SHARE_HOME") (define-foreign-variable install-egg-home c-string "C_INSTALL_EGG_HOME") -(define (chicken-home) installation-home) +(define (chicken-home #!optional all?) + (let* ((prefix (get-environment-variable "CHICKEN_INSTALL_PREFIX")) + (homes + (if prefix + ;; FIXME: share/chicken must match the suffix of C_TARGET_SHARE_HOME + (list (string-append prefix "/share/chicken") + installation-home) + (list installation-home)))) + ;; The car of homes has higher precedence than its cdr. + (if all? + homes + (car homes)))) (define path-list-separator (if ##sys#windows-platform #\; #\:)) diff --git a/types.db b/types.db index ad4f547f..0fde7328 100644 --- a/types.db +++ b/types.db @@ -1356,7 +1356,7 @@ (chicken.platform#build-platform (#(procedure #:pure) chicken.platform#build-platform () symbol)) (chicken.platform#chicken-version (#(procedure #:pure) chicken.platform#chicken-version (#!optional *) string)) -(chicken.platform#chicken-home (#(procedure #:clean) chicken.platform#chicken-home () string)) +(chicken.platform#chicken-home (#(procedure #:clean) chicken.platform#chicken-home (#!optional *) (or string list))) (chicken.platform#feature? (#(procedure #:clean) chicken.platform#feature? (#!rest (or keyword symbol string)) boolean)) (chicken.platform#features (#(procedure #:clean) chicken.platform#features () (list-of keyword))) (chicken.platform#software-type (#(procedure #:pure) chicken.platform#software-type () symbol))