branch: externals/ebdb
commit 01207291b1810c2fc84b22a4ad5ce322fde7cbe5
Author: Eric Abrahamsen <[email protected]>
Commit: Eric Abrahamsen <[email protected]>
Add vcard unescaping, and some vcard tests
* ebdb-vcard.el (ebdb-vcard-unescape): New function, also expand
`ebdb-vcard-escape' so it doesn't double-escape. And fix bug
revealed by testing.
* ebdb-test.el (ebdb-vcard-escape/unescape,
ebdb-vcard-export-dont-explode): New tests for some of this stuff.
---
ebdb-test.el | 83 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++-
ebdb-vcard.el | 19 ++++++++++----
2 files changed, 96 insertions(+), 6 deletions(-)
diff --git a/ebdb-test.el b/ebdb-test.el
index 5a560ee..a081dc6 100644
--- a/ebdb-test.el
+++ b/ebdb-test.el
@@ -19,13 +19,16 @@
;;; Commentary:
-;; Tests for EBDB.
+;; Tests for EBDB. Tests for EBDB's internationalization support are
+;; in a separate file, since loading ebdb-i18n.el overloads a bunch of
+;; methods, and un-overloading them is difficult.
;;; Code:
(require 'ert)
(require 'ebdb)
(require 'ebdb-snarf)
+(require 'ebdb-vcard)
;; Testing macros.
@@ -264,5 +267,83 @@
t))
rec))))))
+;; Vcard testing.
+
+(ert-deftest ebdb-vcard-escape/unescape ()
+ "Test the escaping and unescaping routines."
+ (should (equal (ebdb-vcard-escape "Nothing.to \"escape\"!")
+ "Nothing.to \"escape\"!"))
+
+ (should (equal (ebdb-vcard-escape "Marry, nuncle")
+ "Marry\\, nuncle"))
+
+ (should (equal (ebdb-vcard-escape "Mine uncle; nay!")
+ "Mine uncle\\; nay!"))
+
+ ;; Don't double-escape
+ (should (equal (ebdb-vcard-escape "Marry\\, uncle")
+ "Marry\\, uncle"))
+
+ ;; Don't double-escape, part II
+ (should (equal (ebdb-vcard-escape "Marry\n uncle!")
+ "Marry\\n uncle!"))
+
+ (should (equal (ebdb-vcard-escape "Mine
+uncle")
+ "Mine \\nuncle"))
+
+ (should (equal (ebdb-vcard-unescape "Marry\\, nuncle!")
+ "Marry, nuncle!"))
+
+ (should (equal (ebdb-vcard-unescape "Marry \\nuncle")
+ "Marry
+uncle"))
+
+ (should (equal (ebdb-vcard-unescape
+ (ebdb-vcard-escape
+ "Look, a bog; dogs."))
+ "Look, a bog; dogs.")))
+
+(ert-deftest ebdb-vcard-export-dont-explode ()
+ "Can we export a record to Vcard without immediate disaster?"
+ (ebdb-test-with-records
+ (let ((rec (make-instance ebdb-default-record-class
+ :name (ebdb-field-name-complex
+ :surname "Barleycorn"
+ :given-names '("John"))
+ :uuid (ebdb-field-uuid
+ :uuid "asdfasdfadsf")
+ :mail (list (ebdb-field-mail
+ :mail "[email protected]"))
+ :phone (list (ebdb-field-phone
+ :object-name "home"
+ :country-code 1
+ :area-code 555
+ :number "5555555"))
+ :notes (ebdb-field-notes
+ :notes "He's in the fields")))
+ (fmt-4
+ (ebdb-formatter-vcard-40
+ :combine nil
+ :collapse nil
+ :include '(ebdb-field-uuid
+ ebdb-field-name
+ ebdb-field-mail
+ ebdb-field-phone
+ ebdb-field-mail)))
+ (fmt-3
+ (ebdb-formatter-vcard-30
+ :combine nil
+ :collapse nil
+ :include '(ebdb-field-uuid
+ ebdb-field-name
+ ebdb-field-mail
+ ebdb-field-phone
+ ebdb-field-mail))))
+
+ (should (ebdb-fmt-record fmt-4 rec))
+
+ (should (ebdb-fmt-record fmt-3 rec)))))
+
(provide 'ebdb-test)
;;; ebdb-test.el ends here
diff --git a/ebdb-vcard.el b/ebdb-vcard.el
index 3527358..ef305a9 100644
--- a/ebdb-vcard.el
+++ b/ebdb-vcard.el
@@ -123,8 +123,15 @@ not always respect these headings."
(defsubst ebdb-vcard-escape (str)
"Escape commas, semi-colons and newlines in STR."
(replace-regexp-in-string
- "\\(\n\\)" "\\\\n"
- (replace-regexp-in-string "\\([,;]\\)" "\\\\\\1" str)))
+ "\\([^\\]\\)\n" "\\1\\\\n"
+ (replace-regexp-in-string "\\([^\\]\\)\\([,;]\\)" "\\1\\\\\\2" str)))
+
+(defun ebdb-vcard-unescape (str)
+ "Unescape escaped commas, semicolons and newlines in STR."
+ (replace-regexp-in-string
+ "\\\\n" "\n"
+ (replace-regexp-in-string
+ "\\\\\\([,;]\\)" "\\1" str)))
(cl-defmethod ebdb-fmt-process-fields ((_f ebdb-formatter-vcard)
(_record ebdb-record)
@@ -289,9 +296,11 @@ method is just responsible for formatting the record name."
(field ebdb-field-labeled)
_style
_record)
- (concat (cl-call-next-method)
- ";TYPE=" (ebdb-vcard-escape
- (slot-value field 'object-name))))
+ (let ((ret (cl-call-next-method)))
+ (if-let ((lab (slot-value field 'object-name)))
+ (concat ret
+ ";TYPE=" (ebdb-vcard-escape lab))
+ ret)))
(cl-defmethod ebdb-fmt-field ((_f ebdb-formatter-vcard)
(addr ebdb-field-address)
