records: `recutils->alist' recognizes lines starting with a `+'.

* guix/records.scm (%recutils-plus-rx): New variable.
  (recutils->alist): Use it to read + lines.
* tests/records.scm ("recutils->alist with + lines"): New test.
This commit is contained in:
Ludovic Courtès 2013-07-10 18:26:46 +02:00
parent b0efe83a8f
commit 836d10f154
2 changed files with 22 additions and 0 deletions

View File

@ -231,6 +231,9 @@ PORT, according to FIELDS. FIELDS must be a list of field name/getter pairs."
;; info "(recutils) Comments" ;; info "(recutils) Comments"
(make-regexp "^#")) (make-regexp "^#"))
(define %recutils-plus-rx
(make-regexp "^\\+ ?(.*)$"))
(define (recutils->alist port) (define (recutils->alist port)
"Read a recutils-style record from PORT and return it as a list of key/value "Read a recutils-style record from PORT and return it as a list of key/value
pairs. Stop upon an empty line (after consuming it) or EOF." pairs. Stop upon an empty line (after consuming it) or EOF."
@ -244,6 +247,15 @@ pairs. Stop upon an empty line (after consuming it) or EOF."
(reverse result))) ; end-of-record marker (reverse result))) ; end-of-record marker
((regexp-exec %recutils-comment-rx line) ((regexp-exec %recutils-comment-rx line)
(loop (read-line port) result)) (loop (read-line port) result))
((regexp-exec %recutils-plus-rx line)
=>
(lambda (m)
(match result
(((field . value) rest ...)
(loop (read-line port)
`((,field . ,(string-append value "\n"
(match:substring m 1)))
,@rest))))))
((regexp-exec %recutils-field-rx line) ((regexp-exec %recutils-field-rx line)
=> =>
(lambda (match) (lambda (match)

View File

@ -158,6 +158,16 @@ Version: 1.5
(list (recutils->alist p) (list (recutils->alist p)
(recutils->alist p)))) (recutils->alist p))))
(test-equal "recutils->alist with + lines"
'(("Name" . "foo")
("Description" . "1st line,\n2nd line,\n 3rd line with extra space,\n4th line without space."))
(recutils->alist (open-input-string "
Name: foo
Description: 1st line,
+ 2nd line,
+ 3rd line with extra space,
+4th line without space.")))
(test-equal "alist->record" '((1 2) b c) (test-equal "alist->record" '((1 2) b c)
(alist->record '(("a" . 1) ("b" . b) ("c" . c) ("a" . 2)) (alist->record '(("a" . 1) ("b" . b) ("c" . c) ("a" . 2))
list list