[PATCH 1/3] utils: Add 'edit-expression'.

[宋文武]

* guix/utils.scm (edit-expression): New procedure.
* tests/utils.scm (edit-expression): New test.
---
 guix/utils.scm  | 37 +++++++++++++++++++++++++++++++++++++
 tests/utils.scm | 13 +++++++++++++
 2 files changed, 50 insertions(+)

diff --git a/guix/utils.scm b/guix/utils.scm
index de54179..1318dac 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -86,6 +86,7 @@
             split
             cache-directory
             readlink*
+            edit-expression
 
             filtered-port
             compressed-port
@@ -318,6 +319,42 @@ 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 take 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."
+  (with-fluids ((%default-port-encoding encoding))
+    (let*-values (((file line column)
+                   (values
+                    (assoc-ref source-properties 'filename)
+                    (assoc-ref source-properties 'line)
+                    (assoc-ref source-properties 'column)))
+                  ((start end) ; start and end byte positions of the expression
+                   (call-with-input-file file
+                     (lambda (port)
+                       (values
+                        (begin (while (not (and (= line (port-line port))
+                                                (= column (port-column port))))
+                                 (when (eof-object? (read-char port))
+                                   (error 'end-of-file file)))
+                               (ftell port))
+                        (begin (read port)
+                               (ftell port))))))
+                  ((pre-bv expr post-bv)
+                   (call-with-input-file file
+                     (lambda (port)
+                       (values (get-bytevector-n port start)
+                               (get-string-n port (- end start))
+                               (get-bytevector-all port))))))
+      (with-atomic-file-output file
+        (lambda (port)
+          (put-bytevector port pre-bv)
+          (display (proc expr) port)
+          ;; post-bv maybe the end-of-file object.
+          (when (not (eof-object? post-bv))
+            (put-bytevector port post-bv))
+          #t)))))
+
 
 ;;;
 ;;; Advisory file locking.
diff --git a/tests/utils.scm b/tests/utils.scm
index 6b77255..d0ee02a 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))
-- 
2.6.3