branch: externals/ebdb
commit b9d77274b4c5bd81766c35b2f5e19444d14763d6
Author: Eric Abrahamsen <[email protected]>
Commit: Eric Abrahamsen <[email protected]>
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
