[elpa] externals/ebdb 9a0cca1 321/350: Create ebdb-parse method for URL fields

[Eric Abrahamsen]

branch: externals/ebdb
commit 9a0cca1a1bbafdbe712b28ec8442f54fdf508177
Author: Eric Abrahamsen <address@hidden>
Commit: Eric Abrahamsen <address@hidden>

    Create ebdb-parse method for URL fields
    
    * ebdb.el (ebdb-url-valid-schemes): First, a customization option for
      valid URL schemes.
      (ebdb-parse): Then a parse method. Check that the scheme is valid,
      raise 'ebdb-unparseable otherwise.
---
 ebdb.el | 22 ++++++++++++++++++++++
 1 file changed, 22 insertions(+)

diff --git a/ebdb.el b/ebdb.el
index 3181591..78eb629 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -1717,6 +1717,16 @@ Eventually this method will go away."
 
 ;; URL field
 
+(defcustom ebdb-url-valid-schemes '("http:" "https:" "irc:")
+  "A list of strings matching schemes acceptable to
+  `ebdb-field-url' instances.
+
+Strings should not be regular expressions.  They should include
+the colon character."
+
+  :group 'ebdb-record-edit
+  :type '(repeat string))
+
 (defvar ebdb-url-label-list '("homepage")
   "List of known URL labels.")
 
@@ -1739,6 +1749,18 @@ Eventually this method will go away."
 (cl-defmethod ebdb-string ((field ebdb-field-url))
   (slot-value field 'url))
 
+(cl-defmethod ebdb-parse ((class (subclass ebdb-field-url))
+                         (str string)
+                         &optional slots)
+  "Parse a URL.
+
+See `ebdb-url-valid-schemes' for a list of acceptable schemes."
+  (when (null (plist-get slots :url))
+    (if (string-match-p (regexp-opt ebdb-url-valid-schemes) str)
+       (setq slots (plist-put slots :url (string-trim str)))
+      (signal 'ebdb-unparseable (list "invalid URL scheme"))))
+  (cl-call-next-method class str slots))
+
 ;;; Fields that change EBDB's behavior.
 
 ;;; Mail aliases