From 80346bea8be64775b182882b00a7976375b80a87 Mon Sep 17 00:00:00 2001
From: Kooda
Date: Thu, 9 Aug 2018 11:38:14 +0200
Subject: [PATCH] Introduce XDG directories
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
This patch adds to new procedures to chicken.platform:
- system-config-directory
- system-cache-directory
These two procedures try their best at finding whatâs the user prefered
location for config and cache files. They work on POSIX systems and
windows.
This change also makes csi (to find csirc) and chicken-install (for its
cache, and a new user-defined setup.defauts) use these two new procedures.
Fixes ticket #1455
---
NEWS | 9 +++++++++
chicken-install.mdoc | 17 +++++++++++++++++
chicken-install.scm | 8 ++++++--
chicken-status.mdoc | 11 +++++++++++
csi.mdoc | 11 +++++++++++
csi.scm | 18 ++++++++++++------
egg-environment.scm | 11 +++--------
library.scm | 16 ++++++++++++++++
types.db | 2 ++
9 files changed, 87 insertions(+), 16 deletions(-)
diff --git a/NEWS b/NEWS
index c6489e78..1b953c48 100644
--- a/NEWS
+++ b/NEWS
@@ -44,6 +44,12 @@
- The ambiguous "-l" option for csc has been removed (#1193).
- Removed deprecated "-n" shorthand for "-emit-inline-file" from csc.
- Removed "chicken-bug" tool.
+ - csi now uses (system-config-directory) to find csirc and falls back to
+ $HOME/.csirc when needed.
+ - chicken-install now uses (system-config-directory) to find a user
+ defined setup.defaults file ; it also uses (system-cache-directory) for
+ its egg cache directory when the CHICKEN_EGG_CACHE environment
+ variable is not defined.
- Core libraries
- Removed support for memory-mapped files (posix), queues
@@ -102,6 +108,9 @@
- `process`, `process*` and `process-execute` now expect lists of the form
(("NAME" . "VALUE") ...) instead of the previous (("NAME=VALUE") ...)
as their environment argument.
+ - Add the system-config-directory and config-cache-directory procedures
+ in the chicken.platform module. These procedures follow the XDG
+ specification and also give sensible results on Windows.
- Module system
- The compiler has been modularised, for improved namespacing. This
diff --git a/chicken-install.mdoc b/chicken-install.mdoc
index 60921d88..9892eb0e 100644
--- a/chicken-install.mdoc
+++ b/chicken-install.mdoc
@@ -115,6 +115,23 @@ The command to execute when using
flag in command. If not provided, defaults to
.Xr sudo 8 .
.El
+.Sh FILES
+.Bl -tag -width 4n
+.It Pa $XDG_CONFIG_HOME/chicken/setup.defaults
+User specific setup.defaults file. (
+.Ev $XDG_CONFIG_HOME
+defaults to
+.Pa $HOME/.config
+)
+.It Pa $prefix/share/chicken/setup.default
+System-wide setup.defaults file.
+.It Pa $XDG_CACHE_HOME/chicken-install/
+Default directory for cached eggs. (
+.Ev $XDG_CACHE_HOME
+defaults to
+.Pa $HOME/.cache
+)
+.El
.Sh EXIT STATUS
.Ex -std
.Sh EXAMPLES
diff --git a/chicken-install.scm b/chicken-install.scm
index e88d23b6..91bd8e12 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -271,8 +271,12 @@
;; load defaults file ("setup.defaults")
(define (load-defaults)
- (let ((deff (or user-defaults
- (make-pathname host-sharedir +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 (file-exists? user-file) user-file)
+ (make-pathname host-sharedir +defaults-file+))))
(define (broken x)
(error "invalid entry in defaults file" deff x))
(cond ((not (file-exists? deff)) '())
diff --git a/chicken-status.mdoc b/chicken-status.mdoc
index aceeaa82..042c3866 100644
--- a/chicken-status.mdoc
+++ b/chicken-status.mdoc
@@ -81,6 +81,17 @@ package library path selected during configuration
.It Ev CHICKEN_REPOSITORY_PATH
One or more directories holding extension libraries. Defaults to the
installation repository.
+.It Ev CHICKEN_EGG_CACHE
+Location where eggs are retrieved and built.
+.El
+.Sh FILES
+.Bl -tag -width 4n
+.It Pa $XDG_CACHE_HOME/chicken-install/
+Default directory for cached eggs. (
+.Ev $XDG_CACHE_HOME
+defaults to
+.Pa $HOME/.cache
+)
.El
.Sh EXIT STATUS
.Ex -std
diff --git a/csi.mdoc b/csi.mdoc
index d6a2c651..768f7eb7 100644
--- a/csi.mdoc
+++ b/csi.mdoc
@@ -120,6 +120,17 @@ for include files, separated by
.Sq \&;
characters.
.El
+.Sh FILES
+.Bl -tag -width 4n
+.It Pa $XDG_CONFIG_HOME/chicken/csirc
+Scheme file loaded on startup. (
+.Ev $XDG_CONFIG_HOME
+defaults to
+.Pa $HOME/.config
+)
+.It Pa $HOME/.csirc
+Scheme file loaded on startup if the previous one doesnât exists.
+.El
.Sh EXIT STATUS
.Ex -std
.Sh SEE ALSO
diff --git a/csi.scm b/csi.scm
index 89eefd6c..29d1b64b 100644
--- a/csi.scm
+++ b/csi.scm
@@ -56,6 +56,7 @@ EOF
chicken.io
chicken.keyword
chicken.load
+ chicken.pathname
chicken.platform
chicken.port
chicken.pretty-print
@@ -72,7 +73,7 @@ EOF
;;; Parameters:
-(define-constant init-file ".csirc")
+(define-constant init-file "csirc")
(set! ##sys#repl-print-length-limit 2048)
(set! ##sys#features (cons #:csi ##sys#features))
@@ -1012,11 +1013,16 @@ EOF
(cons (cadr p) (loop (cddr p)))) ) ]
[else '()] ) ) )
(define (loadinit)
- (and-let* ((home (get-environment-variable "HOME"))
- ((not (string=? home ""))))
- (let ((fn (string-append (chop-separator home) "/" init-file)))
- (when (file-exists? fn)
- (load fn) ) ) ) )
+ (let* ((sys-dir (system-config-directory))
+ (cfg-fn (and sys-dir (make-pathname (list sys-dir "chicken")
+ init-file)))
+ (home (get-environment-variable "HOME"))
+ (home-fn (and home (not (string=? home ""))
+ (make-pathname home (string-append "." init-file)))))
+ (cond ((and cfg-fn (file-exists? cfg-fn))
+ (load cfg-fn))
+ ((and home-fn (file-exists? home-fn))
+ (load home-fn) ) ) ) )
(define (evalstring str #!optional (rec (lambda _ (void))))
(let ((in (open-input-string str)))
(do ([x (read in) (read in)])
diff --git a/egg-environment.scm b/egg-environment.scm
index f27ea097..38502d08 100644
--- a/egg-environment.scm
+++ b/egg-environment.scm
@@ -107,13 +107,8 @@ EOF
(or (get-environment-variable "CHICKEN_INSTALL_REPOSITORY")
host-repo)))
-(define (probe-dir dir)
- (and dir (directory-exists? dir) dir))
-
(define cache-directory
(or (get-environment-variable "CHICKEN_EGG_CACHE")
- (make-pathname (list (or (probe-dir (get-environment-variable "HOME"))
- (probe-dir (get-environment-variable "USERPROFILE"))
- (current-directory))
- ".chicken-install")
- "cache")))
+ (make-pathname (or (system-cache-directory)
+ (current-directory))
+ "chicken-install")))
diff --git a/library.scm b/library.scm
index 90d491ef..357b523c 100644
--- a/library.scm
+++ b/library.scm
@@ -6403,6 +6403,7 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
repository-path installation-repository
register-feature! unregister-feature!
software-type software-version return-to-host
+ system-config-directory system-cache-directory
)
(import scheme)
@@ -6564,4 +6565,19 @@ static C_word C_fcall C_setenv(C_word x, C_word y) {
(define return-to-host
(##core#primitive "C_return_to_host"))
+(define (system-config-directory)
+ (or (get-environment-variable "XDG_CONFIG_HOME")
+ (if ##sys#windows-platform
+ (get-environment-variable "APPDATA")
+ (let ((home (get-environment-variable "HOME")))
+ (and home (string-append home "/.config"))))))
+
+(define (system-cache-directory)
+ (or (get-environment-variable "XDG_CACHE_HOME")
+ (if ##sys#windows-platform
+ (or (get-environment-variable "LOCALAPPDATA")
+ (get-environment-variable "APPDATA"))
+ (let ((home (get-environment-variable "HOME")))
+ (and home (string-append home "/.cache"))))))
+
) ; chicken.platform
diff --git a/types.db b/types.db
index b84582b2..2ad2a16a 100644
--- a/types.db
+++ b/types.db
@@ -1356,6 +1356,8 @@
(chicken.platform#repository-path (#(procedure #:clean) chicken.platform#repository-path (#!optional *) *))
(chicken.platform#installation-repository (#(procedure #:clean) chicken.platform#installation-repository (#!optional *) *))
(chicken.platform#return-to-host (procedure chicken.platform#return-to-host () . *))
+(chicken.platform#system-config-directory (#(procedure #:clean) chicken.platform#system-config-directory () (or string false)))
+(chicken.platform#system-cache-directory (#(procedure #:clean) chicken.platform#system-cache-directory () (or string false)))
;; plist
--
2.18.0