ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-15 11:25:22 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gexp: Move 'current-source-directory' to (guix utils).

Browse source 
* 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 @@ (define* (%local-file file promise #:optional (name (basename file))
;; %%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."

15
guix/utils.scm
View file

@ -53,6 +53,8 @@ (define-module (guix utils)
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 @@ (define (read! bv start n)
;;; 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)