~ chicken-core (chicken-5) d902e1cfd6d8d9ca8841bc83f30e8547c9f32c2f


commit d902e1cfd6d8d9ca8841bc83f30e8547c9f32c2f
Author:     Kooda <kooda@upyum.com>
AuthorDate: Thu Aug 9 11:38:14 2018 +0200
Commit:     Peter Bex <peter@more-magic.net>
CommitDate: Sun Nov 25 00:43:49 2018 +0100

    Introduce XDG directories
    
    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
    
    Signed-off-by: Peter Bex <peter@more-magic.net>

diff --git a/NEWS b/NEWS
index c643784b..c3c2a10c 100644
--- a/NEWS
+++ b/NEWS
@@ -4,9 +4,22 @@
   - It is now possible to quote free variables in type declarations,
      which acts as shorthand for `forall' (thanks to "megane")
 
+- Tools
+  - 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.
+
 - Egg specifications
   - Allows "cond-expand" and "error" forms in egg specification files.
 
+- Core libraries
+  - 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.
+
 
 5.0.0
 
diff --git a/chicken-install.mdoc b/chicken-install.mdoc
index 1b2f940f..2cdbac36 100644
--- a/chicken-install.mdoc
+++ b/chicken-install.mdoc
@@ -120,6 +120,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 2111695b..4f6e99c5 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -288,8 +288,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 00de063a..2d3d31b0 100644
--- a/egg-environment.scm
+++ b/egg-environment.scm
@@ -110,13 +110,11 @@ EOF
       (or (get-environment-variable "CHICKEN_INSTALL_REPOSITORY")
           host-repo)))
 
-(define (probe-dir dir)
+(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 72d32150..24f7c268 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)
@@ -6600,4 +6601,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/manual/Module (chicken platform) b/manual/Module (chicken platform)
index 8cae3b70..a49f53da 100644
--- a/manual/Module (chicken platform)	
+++ b/manual/Module (chicken platform)	
@@ -60,6 +60,27 @@ Contains the name of the directory where extensions are installed
 linked at runtime.)
 
 
+=== system-config-directory
+
+<procedure>(system-config-directory</procedure>
+
+Returns the location of the directory for configuration files.  This
+obeys the XDG specification, so when the {{XDG_CONFIG_HOME}}
+environment variable is set, its value is used.  When it's not set, it
+will default to {{$HOME/.config}} on UNIX and {{$APPDATA}} on Windows.
+
+
+=== system-cache-directory
+
+<procedure>(system-cache-directory)</procedure>
+
+Returns the location of the directory for caches.  This obeys the XDG
+specification, so when the {{XDG_CACHE_HOME}} environment variable is
+set, its value is used.  When it's not set, it will default to
+{{$HOME/.cache}} on UNIX and {{$LOCALAPPDATA}} or {{$APPDATA}} on
+Windows.
+
+
 === Machine information
 
 These procedures return information about the type of CPU/architecture
diff --git a/types.db b/types.db
index 53673000..c443d94e 100644
--- a/types.db
+++ b/types.db
@@ -1357,6 +1357,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
 
Trap