[elpa] externals/ebdb b9d7727 087/350: Fill out the ebdb-parse process

[Eric Abrahamsen]

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

    Fill out the ebdb-parse process
    
    * ebdb.el (ebdb-parse): Use a generic so we can see the argument list.
      Turn this into a "call-down" method that results in the creation of
      a field instance. Provide a base method for the ebdb-field-name
      class, that dispatches to either the simple or complex field class.
      Later, the MUA record creation process should use this better. Tweak
      the field-phone implementation so it conforms to the process.
---
 ebdb-i18n.el |  3 +-
 ebdb-mua.el  |  2 +-
 ebdb.el      | 90 +++++++++++++++++++++++++++++++++++++++---------------------
 3 files changed, 62 insertions(+), 33 deletions(-)

diff --git a/ebdb-i18n.el b/ebdb-i18n.el
index 51f7d2c..f99493d 100644
--- a/ebdb-i18n.el
+++ b/ebdb-i18n.el
@@ -149,7 +149,8 @@ for their symbol representations.")
 ;; `ebdb-read-name-articulate' to nil, in which case the name is
 ;; passed to this `ebdb-parse' method.
 (cl-defmethod ebdb-parse :extra "i18n" ((class (subclass 
ebdb-field-name-complex))
-                                       (string string))
+                                       (string string)
+                                       &optional slots)
   ;; For now, only test the first character of whatever string the
   ;; user has entered.
   (let ((script (unless (string-empty-p string)
diff --git a/ebdb-mua.el b/ebdb-mua.el
index 6958476..b721765 100644
--- a/ebdb-mua.el
+++ b/ebdb-mua.el
@@ -925,7 +925,7 @@ Return the records matching ADDRESS or nil."
   (let* ((mail (nth 1 address))                ; possibly nil
          (name (unless (or (equal mail (car address))
                           (null (car address)))
-                 (ebdb-string (ebdb-parse 'ebdb-field-name-complex (car 
address)))))
+                 (ebdb-string (ebdb-parse ebdb-default-name-class (car 
address)))))
          (records (ebdb-message-search name mail))
          created-p new-records)
     (if (and (not records) (functionp update-p))
diff --git a/ebdb.el b/ebdb.el
index 10c8f38..b894680 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -502,6 +502,22 @@ to add to a record."
 (cl-defmethod ebdb-field-readable-name ((_field (eql string)))
   "Value")
 
+(cl-defgeneric ebdb-parse (field-class str &optional slots)
+  "Attempt to construct an instance of FIELD-CLASS using STR.
+
+Implementations should extract information from STR and put it
+into SLOTS, provided that SLOTS does not already contain relevant
+values (ie, parsing should not override what's already in SLOTS).
+Then call `cl-call-next-method' with the new values.")
+
+(cl-defmethod ebdb-parse ((field-class (subclass ebdb-field)) _str &optional 
slots)
+  "Create the actual field instance."
+  (apply 'make-instance field-class slots))
+
+(cl-defmethod ebdb-parse :before ((_field-class (subclass ebdb-field)) str 
&optional slots)
+  (when (string-empty-p str)
+    (signal 'ebdb-empty (list "Empty string cannot be parsed"))))
+
 ;;; Errors
 
 ;; I haven't figured this out quite yet.  What I want to do is avoid
@@ -731,16 +747,29 @@ process."
 ;;; The name fields.  One abstract base class, and two instantiable
 ;;; subclasses.
 
-;; TODO: Allow the user to choose whether the aka slot uses
-;; `ebdb-field-name-simple' or `ebdb-field-name-complex'.  Or maybe on
-;; a case-by-case basis?
-
 (defclass ebdb-field-name (ebdb-field-user)
   nil
   :abstract t
   :documentation "Abstract base class for creating record
   names.")
 
+(cl-defmethod ebdb-parse ((class (subclass ebdb-field-name)) str &optional 
slots)
+  "Examine STR and try to interpret it as a name.
+
+This method dispatches to the equivalent method of either the
+simple or complex name class."
+  ;; Right now, all we do is send the input to field-name-simple if
+  ;; there are no spaces in it, otherwise to field-name-complex.  If
+  ;; "slots" is t, that means we've already been through the
+  ;; upper-level methods.
+  (let ((input (string-trim str)))
+    (cond (slots
+          (cl-call-next-method class str slots))
+         ((string-match-p "[[:space:]]" input)
+          (ebdb-parse ebdb-default-name-class input slots))
+         (t
+          (ebdb-parse ebdb-field-name-simple input slots)))))
+
 (defclass ebdb-field-name-simple (ebdb-field-name)
   ((name
     :type string
@@ -764,6 +793,11 @@ process."
     (ebdb-puthash (ebdb-string name) record))
   (cl-call-next-method))
 
+(cl-defmethod ebdb-parse ((class (subclass ebdb-field-name-simple)) str 
&optional slots)
+  (unless (plist-get slots :name)
+    (setq slots (plist-put :name str)))
+  (cl-call-next-method class str slots))
+
 (defclass ebdb-field-name-complex (ebdb-field-name)
   ((surname
     :initarg :surname
@@ -867,7 +901,7 @@ first one."
        (setq slots (plist-put slots :surname surname))
        (setq slots (plist-put slots :given-names (split-string given-names)))
        (cl-call-next-method class slots obj))
-    (ebdb-parse class (ebdb-read-string "Name: " (when obj (ebdb-string 
obj))))))
+    (ebdb-parse class (ebdb-read-string "Name: " (when obj (ebdb-string obj))) 
slots)))
 
 (cl-defmethod ebdb-field-search ((_field ebdb-field-name-complex) _regex)
   "Short-circuit the plain field search for names.
@@ -876,12 +910,17 @@ The record itself performs more complex searches on 
cached name
 values, by default the search is not handed to the name field itself."
   nil)
 
-(cl-defmethod ebdb-parse ((_class (subclass ebdb-field-name-complex)) string)
-  (let ((bits (ebdb-divide-name string)))
-    (make-instance 'ebdb-field-name-complex
-     :given-names (when (car bits)
-                   (list (car bits)))
-     :surname (cdr bits))))
+(cl-defmethod ebdb-parse ((class (subclass ebdb-field-name-complex)) str 
&optional slots)
+  (let ((bits (ebdb-divide-name str)))
+    (unless (plist-get slots :given-names)
+      (setq slots (plist-put slots :given-names
+                            (when (car bits)
+                              (list (car bits))))))
+    (unless (plist-get slots :surname)
+      (setq slots (plist-put slots :surname
+                            (when (cdr bits)
+                              (cdr bits)))))
+    (cl-call-next-method class str slots)))
 
 ;;; Role fields.
 
@@ -1279,7 +1318,7 @@ values, by default the search is not handed to the name 
field itself."
   (let* ((country
          (or (and obj
                   (slot-value obj 'country-code))
-             (plist-get slots 'country-code)))
+             (plist-get slots :country-code)))
         (area
          (or (and obj
                   (slot-value obj 'area-code))
@@ -1291,27 +1330,16 @@ values, by default the search is not handed to the name 
field itself."
                  (when area
                    (format " (%d)" area))
                  ": "))
-        (default (when obj (slot-value obj 'number)))
-        (plist
-         (ebdb-error-retry
-          (ebdb-parse class
-                      (ebdb-read-string prompt default)
-                      slots))))
-    (cl-call-next-method class plist obj)))
-
-(cl-defmethod ebdb-parse ((_class (subclass ebdb-field-phone))
+        (default (when obj (slot-value obj 'number))))
+    (ebdb-error-retry
+     (ebdb-parse class
+                (ebdb-read-string prompt default)
+                slots))))
+
+(cl-defmethod ebdb-parse ((class (subclass ebdb-field-phone))
                          (string string)
                          &optional slots)
-  "Parse a phone number from STRING and return a plist of
-integers of the form \(country-code area-code number extension\).
-
-The plist should be suitable for creating an instance of
-`ebdb-field-phone'.
 
-If plist SLOTS is present, allow values from that plist to
-override parsing."
-  ;; TODO: This `ebdb-parse' method returns a plist.  Other such
-  ;; methods return an actual object.  We need consistency!
   (let ((country-regexp "\\+(?\\([0-9]\\{1,3\\}\\))?[ \t]+")
        (area-regexp "(?\\([0-9]\\{1,4\\}\\)[-)./ \t]+")
         (ext-regexp "[ \t]?e?[xX]t?\\.?[ \t]?\\([0-9]+\\)")
@@ -1361,7 +1389,7 @@ override parsing."
                                           (match-string 1))))))
     (setq slots
          (plist-put slots :number acc))
-    slots))
+    (cl-call-next-method class string slots)))
 
 ;;; Notes field