From 07c8a98c3b45dca9fd36af7c4a300d3af58734dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Wed, 15 Jun 2016 23:08:05 +0200 Subject: [PATCH] gexp: Move 'current-source-directory' to (guix utils). * guix/gexp.scm (extract-directory, current-source-directory): Move to... * guix/utils.scm (extract-directory, current-source-directory): ... here. New procedures. --- guix/gexp.scm | 13 ------------- guix/utils.scm | 15 +++++++++++++++ 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/guix/gexp.scm b/guix/gexp.scm index b4d737ecae..8e604ff7cf 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -202,19 +202,6 @@ cross-compiling.)" ;; %%LOCAL-FILE is not. (%%local-file file promise name recursive?)) -(define (extract-directory properties) - "Extract the directory name from source location PROPERTIES." - (match (assq 'filename properties) - (('filename . (? string? file-name)) - (dirname file-name)) - (_ - #f))) - -(define-syntax-rule (current-source-directory) - "Expand to the directory of the current source file or #f if it could not -be determined." - (extract-directory (current-source-location))) - (define (absolute-file-name file directory) "Return the canonical absolute file name for FILE, which lives in the vicinity of DIRECTORY." diff --git a/guix/utils.scm b/guix/utils.scm index 2d8bfd84b0..19fd0b0844 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -53,6 +53,8 @@ substitute-keyword-arguments ensure-keyword-arguments + current-source-directory + location location? @@ -700,6 +702,19 @@ output port, and PROC's result is returned." ;;; Source location. ;;; +(define (extract-directory properties) + "Extract the directory name from source location PROPERTIES." + (match (assq 'filename properties) + (('filename . (? string? file-name)) + (dirname file-name)) + (_ + #f))) + +(define-syntax-rule (current-source-directory) + "Expand to the directory of the current source file or #f if it could not +be determined." + (extract-directory (current-source-location))) + ;; A source location. (define-record-type (make-location file line column)