diff options
| -rw-r--r-- | guix/utils.scm | 19 | ||||
| -rw-r--r-- | tests/utils.scm | 14 |
2 files changed, 33 insertions, 0 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index 94b4d753d0..29ad09d9f7 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -148,6 +148,7 @@ edit-expression delete-expression insert-expression + find-definition-insertion-location filtered-port decompressed-port @@ -513,6 +514,24 @@ SOURCE-PROPERTIES." (string-append expr "\n\n" str)))) (edit-expression source-properties insert))) +(define (find-definition-insertion-location file term) + "Search in FILE for a top-level public definition whose defined term +alphabetically succeeds TERM. Return the location if found, or #f +otherwise." + (let ((search-term (symbol->string term))) + (call-with-input-file file + (lambda (port) + (do ((syntax (read-syntax port) + (read-syntax port))) + ((match (syntax->datum syntax) + (('define-public current-term _ ...) + (string> (symbol->string current-term) + search-term)) + ((? eof-object?) #t) + (_ #f)) + (and (not (eof-object? syntax)) + (syntax-source syntax)))))))) + ;;; ;;; Keyword arguments. diff --git a/tests/utils.scm b/tests/utils.scm index cd54112846..52f3b58ede 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -288,6 +288,20 @@ skip these tests." `(define-public package-1 'package)) (call-with-input-file temp-file get-string-all))) +(test-equal "find-definition-insertion-location" + (list `((filename . ,temp-file) (line . 0) (column . 0)) + `((filename . ,temp-file) (line . 5) (column . 0)) + #f) + (begin + (call-with-output-file temp-file + (lambda (port) + (display "(define-public package-1\n 'foo)\n\n" port) + (display "(define foo 'bar)\n\n" port) + (display "(define-public package-2\n 'baz)\n" port))) + (map (lambda (term) + (find-definition-insertion-location temp-file term)) + (list 'package 'package-1 'package-2)))) + (test-equal "string-distance" '(0 1 1 5 5) (list |