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

utils: Add find-definition-insertion-location procedure.

Browse source 
* guix/utils.scm (find-definition-insertion-location): Add and export
procedure.
* tests/utils.scm ("find-definition-insertion-location"): Add test.

Change-Id: Ie17e1b4a94790f58518ce121411a38d357f49feb
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
This commit is contained in:
Herman Rimm 2024-02-20 21:45:12 +01:00 committed by Ludovic Courtès
parent babd39e843
commit 50e514c1bc
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 33 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
guix/utils.scm
View file

@ -148,6 +148,7 @@ (define-module (guix utils)
edit-expression
delete-expression
insert-expression
find-definition-insertion-location
filtered-port
decompressed-port
@ -513,6 +514,24 @@ (define (insert-expression source-properties expr)
(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.

14
tests/utils.scm
View file

@ -288,6 +288,20 @@ (define-public package-2\n 'package)\n"
`(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