diff options
| -rw-r--r-- | guix/utils.scm | 40 | ||||
| -rw-r--r-- | tests/utils.scm | 13 |
2 files changed, 53 insertions, 0 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index de541799fa..f566a994eb 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -41,6 +41,7 @@ #:use-module (ice-9 regex) #:use-module (ice-9 match) #:use-module (ice-9 format) + #:use-module ((ice-9 iconv) #:select (bytevector->string)) #:use-module (system foreign) #:export (bytevector->base16-string base16-string->bytevector @@ -86,6 +87,7 @@ split cache-directory readlink* + edit-expression filtered-port compressed-port @@ -318,6 +320,44 @@ a list of command-line arguments passed to the compression program." (unless (every (compose zero? cdr waitpid) pids) (error "compressed-output-port failure" pids)))))) +(define* (edit-expression source-properties proc #:key (encoding "UTF-8")) + "Edit the expression specified by SOURCE-PROPERTIES using PROC, which should +be a procedure that takes the original expression in string and returns a new +one. ENCODING will be used to interpret all port I/O, it default to UTF-8. +This procedure returns #t on success." + (with-fluids ((%default-port-encoding encoding)) + (let* ((file (assq-ref source-properties 'filename)) + (line (assq-ref source-properties 'line)) + (column (assq-ref source-properties 'column)) + (in (open-input-file file)) + ;; The start byte position of the expression. + (start (begin (while (not (and (= line (port-line in)) + (= column (port-column in)))) + (when (eof-object? (read-char in)) + (error (format #f "~a: end of file~%" in)))) + (ftell in))) + ;; The end byte position of the expression. + (end (begin (read in) (ftell in)))) + (seek in 0 SEEK_SET) ; read from the beginning of the file. + (let* ((pre-bv (get-bytevector-n in start)) + ;; The expression in string form. + (str (bytevector->string + (get-bytevector-n in (- end start)) + (port-encoding in))) + (post-bv (get-bytevector-all in)) + (str* (proc str))) + ;; Verify the edited expression is still a scheme expression. + (call-with-input-string str* read) + ;; Update the file with edited expression. + (with-atomic-file-output file + (lambda (out) + (put-bytevector out pre-bv) + (display str* out) + ;; post-bv maybe the end-of-file object. + (when (not (eof-object? post-bv)) + (put-bytevector out post-bv)) + #t)))))) + ;;; ;;; Advisory file locking. diff --git a/tests/utils.scm b/tests/utils.scm index 6b7725554f..d0ee02a1cf 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -333,6 +333,19 @@ "This is a journey\r\nInto the sound\r\nA journey ...\n"))) (get-string-all (canonical-newline-port port)))) + +(test-equal "edit-expression" + "(display \"GNU Guix\")\n(newline)\n" + (begin + (call-with-output-file temp-file + (lambda (port) + (display "(display \"xiuG UNG\")\n(newline)\n" port))) + (edit-expression `((filename . ,temp-file) + (line . 0) + (column . 9)) + string-reverse) + (call-with-input-file temp-file get-string-all))) + (test-end) (false-if-exception (delete-file temp-file)) |