utils: Add 'edit-expression'.

* guix/utils.scm (edit-expression): New procedure.
* tests/utils.scm (edit-expression): New test.
This commit is contained in:
宋文武 2016-04-06 17:35:13 +08:00
parent 645deac326
commit 50a3d59473
2 changed files with 53 additions and 0 deletions

View File

@ -41,6 +41,7 @@
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module ((ice-9 iconv) #:select (bytevector->string))
#:use-module (system foreign) #:use-module (system foreign)
#:export (bytevector->base16-string #:export (bytevector->base16-string
base16-string->bytevector base16-string->bytevector
@ -86,6 +87,7 @@
split split
cache-directory cache-directory
readlink* readlink*
edit-expression
filtered-port filtered-port
compressed-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) (unless (every (compose zero? cdr waitpid) pids)
(error "compressed-output-port failure" 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. ;;; Advisory file locking.

View File

@ -333,6 +333,19 @@
"This is a journey\r\nInto the sound\r\nA journey ...\n"))) "This is a journey\r\nInto the sound\r\nA journey ...\n")))
(get-string-all (canonical-newline-port port)))) (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) (test-end)
(false-if-exception (delete-file temp-file)) (false-if-exception (delete-file temp-file))