aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
author宋文武 <iyzsong@gmail.com>2016-04-06 17:35:13 +0800
committer宋文武 <iyzsong@gmail.com>2016-04-13 09:16:54 +0800
commit50a3d59473acf9fb5e771b57528b09d3e66123c4 (patch)
treead6d90815bcc847ec58d07e5e671623c37165476
parent645deac3264744ec09c027a8b9762fdf62aced70 (diff)
downloadguix-50a3d59473acf9fb5e771b57528b09d3e66123c4.tar
guix-50a3d59473acf9fb5e771b57528b09d3e66123c4.tar.gz
utils: Add 'edit-expression'.
* guix/utils.scm (edit-expression): New procedure. * tests/utils.scm (edit-expression): New test.
-rw-r--r--guix/utils.scm40
-rw-r--r--tests/utils.scm13
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))