aboutsummaryrefslogtreecommitdiff
path: root/guix/utils.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/utils.scm')
-rw-r--r--guix/utils.scm36
1 files changed, 27 insertions, 9 deletions
diff --git a/guix/utils.scm b/guix/utils.scm
index a642bd3d62..9e1b8ead0a 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -637,10 +637,11 @@ output port, and PROC's result is returned."
(define (cache-directory)
"Return the cache directory for Guix, by default ~/.cache/guix."
- (or (getenv "XDG_CONFIG_HOME")
- (and=> (or (getenv "HOME")
- (passwd:dir (getpwuid (getuid))))
- (cut string-append <> "/.cache/guix"))))
+ (string-append (or (getenv "XDG_CACHE_HOME")
+ (and=> (or (getenv "HOME")
+ (passwd:dir (getpwuid (getuid))))
+ (cut string-append <> "/.cache")))
+ "/guix"))
(define (readlink* file)
"Call 'readlink' until the result is not a symlink."
@@ -702,6 +703,18 @@ output port, and PROC's result is returned."
;;; Source location.
;;;
+(define (absolute-dirname file)
+ "Return the absolute name of the directory containing FILE, or #f upon
+failure."
+ (match (search-path %load-path file)
+ (#f #f)
+ ((? string? file)
+ ;; If there are relative names in %LOAD-PATH, FILE can be relative and
+ ;; needs to be canonicalized.
+ (if (string-prefix? "/" file)
+ (dirname file)
+ (canonicalize-path (dirname file))))))
+
(define-syntax current-source-directory
(lambda (s)
"Return the absolute name of the current directory, or #f if it could not
@@ -711,11 +724,16 @@ be determined."
(match (assq 'filename (syntax-source s))
(('filename . (? string? file-name))
;; If %FILE-PORT-NAME-CANONICALIZATION is 'relative, then FILE-NAME
- ;; can be relative. In that case, we try to find out the absolute
- ;; file name by looking at %LOAD-PATH.
- (if (string-prefix? "/" file-name)
- (dirname file-name)
- (and=> (search-path %load-path file-name) dirname)))
+ ;; can be relative. In that case, we try to find out at run time
+ ;; the absolute file name by looking at %LOAD-PATH; doing this at
+ ;; run time rather than expansion time is necessary to allow files
+ ;; to be moved on the file system.
+ (cond ((not file-name)
+ #f) ;raising an error would upset Geiser users
+ ((string-prefix? "/" file-name)
+ (dirname file-name))
+ (else
+ #`(absolute-dirname #,file-name))))
(_
#f))))))