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.
master
Ludovic Courtès 2016-06-15 23:08:05 +02:00
parent b789974954
commit 07c8a98c3b
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 15 additions and 13 deletions

View File

@ -202,19 +202,6 @@ cross-compiling.)"
;; %%LOCAL-FILE is not. ;; %%LOCAL-FILE is not.
(%%local-file file promise name recursive?)) (%%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) (define (absolute-file-name file directory)
"Return the canonical absolute file name for FILE, which lives in the "Return the canonical absolute file name for FILE, which lives in the
vicinity of DIRECTORY." vicinity of DIRECTORY."

View File

@ -53,6 +53,8 @@
substitute-keyword-arguments substitute-keyword-arguments
ensure-keyword-arguments ensure-keyword-arguments
current-source-directory
<location> <location>
location location
location? location?
@ -700,6 +702,19 @@ output port, and PROC's result is returned."
;;; Source location. ;;; 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. ;; A source location.
(define-record-type <location> (define-record-type <location>
(make-location file line column) (make-location file line column)