diff --git a/guix/utils.scm b/guix/utils.scm index e4e9d922e7..94b4d753d0 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -20,6 +20,7 @@ ;;; Copyright © 2023 Janneke Nieuwenhuizen ;;; Copyright © 2023 Zheng Junjie <873216071@qq.com> ;;; Copyright © 2023 Foundation Devices, Inc. +;;; Copyright © 2024 Herman Rimm ;;; ;;; This file is part of GNU Guix. ;;; @@ -38,6 +39,7 @@ (define-module (guix utils) #:use-module (guix config) + #:autoload (guix read-print) (object->string*) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -145,6 +147,7 @@ (define-module (guix utils) go-to-location edit-expression delete-expression + insert-expression filtered-port decompressed-port @@ -502,6 +505,14 @@ (define (delete-expression source-properties) "Delete the expression specified by SOURCE-PROPERTIES." (edit-expression source-properties (const "") #:include-trailing-newline? #t)) +(define (insert-expression source-properties expr) + "Insert EXPR before the top-level expression specified by +SOURCE-PROPERTIES." + (let* ((expr (object->string* expr 0)) + (insert (lambda (str) + (string-append expr "\n\n" str)))) + (edit-expression source-properties insert))) + ;;; ;;; Keyword arguments. diff --git a/tests/utils.scm b/tests/utils.scm index 5664165c85..cd54112846 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -5,6 +5,7 @@ ;;; Copyright © 2021 Simon Tournier ;;; Copyright © 2021 Maxime Devos ;;; Copyright © 2023 Foundation Devices, Inc. +;;; Copyright © 2024 Herman Rimm ;;; ;;; This file is part of GNU Guix. ;;; @@ -274,6 +275,19 @@ (define (test-compression/decompression method run?) string-reverse) (call-with-input-file temp-file get-string-all))) +(test-equal "insert-expression" + "(define-public package-1\n 'package)\n +(define-public package-2\n 'package)\n" + (begin + (call-with-output-file temp-file + (lambda (port) + (display "(define-public package-2\n 'package)\n" port))) + (insert-expression `((filename . ,temp-file) + (line . 0) + (column . 0)) + `(define-public package-1 'package)) + (call-with-input-file temp-file get-string-all))) + (test-equal "string-distance" '(0 1 1 5 5) (list