mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-15 11:25:22 -05:00
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:
parent
b789974954
commit
07c8a98c3b
2 changed files with 15 additions and 13 deletions
|
@ -202,19 +202,6 @@ (define* (%local-file file promise #:optional (name (basename file))
|
|||
;; %%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."
|
||||
|
|
|
@ -53,6 +53,8 @@ (define-module (guix utils)
|
|||
substitute-keyword-arguments
|
||||
ensure-keyword-arguments
|
||||
|
||||
current-source-directory
|
||||
|
||||
<location>
|
||||
location
|
||||
location?
|
||||
|
@ -700,6 +702,19 @@ (define (read! bv start n)
|
|||
;;; 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)
|
||||
|
|
Loading…
Reference in a new issue