[elpa] externals/ebdb 96b113d 251/350: New functions for folding/unfolding long vCard lines

[Eric Abrahamsen]

branch: externals/ebdb
commit 96b113d6d69e8462505b28ac6ce3b1429250db94
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    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)))