branch: externals/ebdb
commit 96b113d6d69e8462505b28ac6ce3b1429250db94
Author: Eric Abrahamsen <[email protected]>
Commit: Eric Abrahamsen <[email protected]>
New functions for folding/unfolding long vCard lines
* ebdb-vcard.el (ebdb-vcard-fold-lines, ebdb-vcard-unfold-lines): RFC
says lines longer than 75 octets must be folded. Folding consists
of CRLF followed immediate by space or tab.
* ebdb-test.el (ebdb-vcard-fold/unfold): Test new functions.
---
ebdb-test.el | 34 ++++++++++++++++++++++++++++++++++
ebdb-vcard.el | 46 ++++++++++++++++++++++++++++++++++++++++++++--
2 files changed, 78 insertions(+), 2 deletions(-)
diff --git a/ebdb-test.el b/ebdb-test.el
index 93e3819..9ff328d 100644
--- a/ebdb-test.el
+++ b/ebdb-test.el
@@ -384,6 +384,40 @@ uncle"))
"Look, a bog; dogs."))
"Look, a bog; dogs.")))
+(ert-deftest ebdb-vcard-fold/unfold ()
+ "Test line-length folding/unfolding."
+ (let ((short-lines "For sale:\r\nBaby shoes,\r\nNever used.")
+ (long-lines
+ "Turns out seventy five bytes is a lot of bytes when you just have to
keep typing and typing\r\nand typing.")
+ (multibyte-lines
+ "然后还要用中文写一行没完没了的话。\r\n其实先要来一个短的，然后一行特别长的，那就是现在这行，\r\n然后可以再有一个短的"))
+ (should (equal (ebdb-vcard-fold-lines short-lines)
+ "For sale:
+Baby shoes,
+Never used."))
+ (should (equal (ebdb-vcard-unfold-lines
+ (ebdb-vcard-fold-lines short-lines))
+ short-lines))
+ (should
+ (equal (ebdb-vcard-fold-lines long-lines)
+ "Turns out seventy five bytes is a lot of bytes when you just have
to keep t
+ yping and typing
+and typing."))
+ (should
+ (equal (ebdb-vcard-unfold-lines
+ (ebdb-vcard-fold-lines long-lines))
+ long-lines))
+ (should
+ (equal (ebdb-vcard-fold-lines multibyte-lines)
+ "然后还要用中文写一行没完没了的话。
+其实先要来一个短的，然后一行特别长的，那就是现在这
+ 行，
+然后可以再有一个短的"))
+ (should
+ (equal (ebdb-vcard-unfold-lines
+ (ebdb-vcard-fold-lines multibyte-lines))
+ multibyte-lines))))
+
(ert-deftest ebdb-vcard-export-dont-explode ()
"Can we export a record to Vcard without immediate disaster?"
(ebdb-test-with-records
diff --git a/ebdb-vcard.el b/ebdb-vcard.el
index d1fad84..08b01dc 100644
--- a/ebdb-vcard.el
+++ b/ebdb-vcard.el
@@ -126,13 +126,54 @@ not always respect these headings."
"\\([^\\]\\)\\([\n\r]+\\)" "\\1\\\\\\2"
(replace-regexp-in-string "\\([^\\]\\)\\([,;]\\)" "\\1\\\\\\2" str)))
-(defun ebdb-vcard-unescape (str)
+(defsubst ebdb-vcard-unescape (str)
"Unescape escaped commas, semicolons and newlines in STR."
(replace-regexp-in-string
"\\\\n" "\n"
(replace-regexp-in-string
"\\\\\\([,;]\\)" "\\1" str)))
+;; The RFC says fold any lines longer than 75 octets, excluding the
+;; line break. Folded lines are delineated by a CRLF plus a space or
+;; tab. Multibyte characters must not be broken.
+
+;; TODO: This implementation assumes that Emacs' internal coding
+;; system is similar enough to the utf-8 that the file will eventually
+;; be written in that `string-bytes' (which returns a length according
+;; to Emacs' own coding) will map accurately to what eventually goes
+;; in the file. Eli notes this is not really true, and could result
+;; in unexpected behavior, and he recommends using
+;; `filepos-to-bufferpos' instead. Presumably that would involve
+;; /first/ writing the vcf file, then backtracking and checking for
+;; correctness.
+(defun ebdb-vcard-fold-lines (text)
+ "Fold lines in TEXT, which represents a vCard contact."
+ (let ((lines (split-string text "\r\n"))
+ outlines)
+ (dolist (l lines)
+ (while (> (string-bytes l) 75) ; Line is too long.
+ (if (> (string-bytes l) (length l))
+ ;; Multibyte characters.
+ (let ((acc (string-to-vector l)))
+ (setq l nil)
+ (while (> (string-bytes (concat acc)) 75)
+ ;; Pop characters off the end of acc and stick them
+ ;; back in l, until acc is short enough to go in
+ ;; outlines. Probably hideously inefficient.
+ (push (aref acc (1- (length acc))) l)
+ (setq acc (substring acc 0 -1)))
+ (push acc outlines)
+ (setq l (concat " " l)))
+ ;; No multibyte characters.
+ (push (substring l 0 75) outlines)
+ (setq l (concat " " (substring l 75)))))
+ (push l outlines))
+ (mapconcat #'identity (nreverse outlines) "\r\n")))
+
+(defun ebdb-vcard-unfold-lines (text)
+ "Unfold lines in TEXT, which represents a vCard contact."
+ (replace-regexp-in-string "\r\n[\s\t]" "" text))
+
(cl-defmethod ebdb-fmt-process-fields ((_f ebdb-formatter-vcard)
(_record ebdb-record)
field-list)
@@ -176,7 +217,8 @@ All this does is split role instances into multiple fields."
(r ebdb-record))
"Format a single record R in VCARD format."
;; Because of the simplicity of the VCARD format, we only collect
- ;; the fields, there's no need to sort or "process" them.
+ ;; the fields, there's no need to sort them, and the only processing
+ ;; that happens is for role fields.
(let ((fields (ebdb-fmt-process-fields
f r
(ebdb-fmt-collect-fields f r)))
