TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix/gexp.scm
View File

@ -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."

15
guix/utils.scm
View File

@ -53,6 +53,8 @@
substitute-keyword-arguments
ensure-keyword-arguments
current-source-directory
<location>
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 <location>
(make-location file line column)