[elpa] externals/ebdb 8f7024c49b 2/3: Find prefixes while parsing names, and output them properly

[Eric Abrahamsen]

branch: externals/ebdb
commit 8f7024c49b25780c8aa6864fcdf74273f346e615
Author: Eric Abrahamsen <eric@ericabrahamsen.net>
Commit: Eric Abrahamsen <eric@ericabrahamsen.net>

    Find prefixes while parsing names, and output them properly
    
    * ebdb.el (ebdb-divide-name): We went to the trouble of having name
    prefixes, with a regexp and everything, so use them!
    (ebdb-parse): Look for the prefix and set it.
    (ebdb-lastname-prefixes): Add "van".
    (ebdb-name-last): Add prefix when present.
    (ebdb-name-lf): Treat prefix as part of surname when capitalized.
---
 ebdb.el | 62 ++++++++++++++++++++++++++++++++++++++++++++++----------------
 1 file changed, 46 insertions(+), 16 deletions(-)

diff --git a/ebdb.el b/ebdb.el
index 2f690671bc..1d9abb2310 100644
--- a/ebdb.el
+++ b/ebdb.el
@@ -652,7 +652,7 @@ single string for the surname, and nothing else."
   :type 'boolean)
 
 (defcustom ebdb-lastname-prefixes
- '("von" "de" "di")
+ '("von" "van" "de" "di")
   "List of lastname prefixes recognized in name fields.
 Used to enhance dividing name strings into firstname and lastname parts.
 Case is ignored."
@@ -1490,7 +1490,10 @@ simple or complex name class."
 
 (cl-defmethod ebdb-name-last ((name ebdb-field-name-complex))
   "Return the surname of this name field."
-  (slot-value name 'surname))
+  (with-slots (surname prefix) name
+    (if prefix
+       (concat prefix " " surname)
+      surname)))
 
 (cl-defmethod ebdb-name-given ((name ebdb-field-name-complex) &optional full)
   "Return the given names of this name field.
@@ -1503,11 +1506,28 @@ first one."
        (car given)))))
 
 (cl-defmethod ebdb-name-lf ((name ebdb-field-name-complex) &optional full)
-  (let ((given-string (ebdb-name-given name full))
-       (prefix (slot-value name 'prefix)))
-    (concat (ebdb-name-last name)
-           (when prefix prefix)
-           (when given-string (format ", %s" given-string)))))
+  "Format NAME with surname first.
+Surname comes first, followed by a comma and then the given name
+or names.  Only the first given name is used, unless FULL is
+non-nil.
+
+The name suffix (Jr., III, etc) is not used.  The prefix (di,
+von, van, etc) is output according to an arcane set of rules,
+loosely based on the MLA handbook, about when the prefix should
+be considered part of the surname and when not."
+  (with-slots (surname prefix) name
+    (let* ((given-string (ebdb-name-given name full))
+          (case-fold-search nil)
+          (cap-prefix (and prefix
+                           (string-match-p "^[[:upper:]]" prefix))))
+      ;; Basically, if the prefix is capitalized, we treat it as part
+      ;; of the surname, otherwise not.  There's more to it than that,
+      ;; but let's wait for someone to complain
+      (concat (when cap-prefix (concat prefix " "))
+             surname
+             (when given-string (format ", %s" given-string))
+             (when (and prefix (null cap-prefix))
+               (concat " " prefix))))))
 
 (cl-defmethod ebdb-name-fl ((name ebdb-field-name-complex) &optional full)
   (let ((given (ebdb-name-given name full)))
@@ -1569,11 +1589,14 @@ first one."
     (ebdb-parse class (ebdb-read-string "Name" (when obj (ebdb-string obj))) 
slots)))
 
 (cl-defmethod ebdb-parse ((class (subclass ebdb-field-name-complex)) str 
&optional slots)
-  (pcase-let ((`(,surname ,given-names ,suffix)
+  (pcase-let ((`(,surname ,given-names ,suffix ,prefix)
               (ebdb-divide-name str)))
     (unless (plist-member slots :given-names)
       (setq slots (plist-put slots :given-names
                             given-names)))
+    (unless (plist-member slots :prefix)
+      (setq slots (plist-put slots :prefix
+                            prefix)))
     (unless (plist-member slots :surname)
       (setq slots (plist-put slots :surname
                             (or surname ""))))
@@ -5406,15 +5429,16 @@ also be one of the special symbols below.
 
 (defun ebdb-divide-name (string)
   "Divide STRING into its component parts.
-Return name as a list of (SURNAME GIVEN-NAMES SUFFIX).  SURNAME
-is always a string (possibly empty).  GIVEN-NAMES, if present, is
-a list of first names.  GIVEN-NAMES and SUFFIX may be nil.
+Return name as a list of (SURNAME GIVEN-NAMES SUFFIX PREFIX).
+SURNAME is always a string (possibly empty).  GIVEN-NAMES, if
+present, is a list of first names.  GIVEN-NAMES and SUFFIX may be
+nil.
 
 During parsing `case-fold-search' is non-nil, with the exception
 that a string of all-upper-case letters will be assumed (a la UN
 usage) to represent the surname."
   (let ((case-fold-search t)
-       given suffix)
+       given suffix prefix)
     ;; Separate a suffix.
     (when (string-match ebdb-lastname-suffix-re string)
       (setq suffix (match-string 1 string)
@@ -5439,10 +5463,16 @@ usage) to represent the surname."
              (setq given (and (not (zerop (match-beginning 0)))
                               (substring string 0 (match-beginning 0)))
                    string (match-string 1 string)))))
-    (delq nil
-         (list (ebdb-string-trim string)
-               (and given (split-string given nil t))
-               suffix))))
+    (setq given (split-string given nil t))
+    (cond ((string-match (regexp-opt ebdb-lastname-prefixes) string)
+          (setq prefix (substring string 0 (match-end 0))
+                string (substring string (match-end 0))))
+         ((and (>= (length given) 2)
+               (member-ignore-case (car (last given)) ebdb-lastname-prefixes))
+          (setq prefix (car (last given))
+                given (butlast given))))
+    (list (ebdb-string-trim string)
+         given suffix prefix)))
 
 (defsubst ebdb-record-lessp (record1 record2)
   (string< (ebdb-record-sortkey record1)