emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/bbdb 0c43518 1/2: Unify the handling of new records, ne


From: Roland Winkler
Subject: [elpa] externals/bbdb 0c43518 1/2: Unify the handling of new records, new fields and modified fields
Date: Thu, 6 Sep 2018 23:37:07 -0400 (EDT)

branch: externals/bbdb
commit 0c43518419c2ea47ac35e4d626272e1063c01f00
Author: Roland Winkler <address@hidden>
Commit: Roland Winkler <address@hidden>

    Unify the handling of new records, new fields and modified fields
---
 bbdb-com.el | 130 ++++++++++++++++++++--------------------
 bbdb.el     | 194 ++++++++++++++++++++++++++++++++++--------------------------
 2 files changed, 176 insertions(+), 148 deletions(-)

diff --git a/bbdb-com.el b/bbdb-com.el
index 405005f..94378f1 100644
--- a/bbdb-com.el
+++ b/bbdb-com.el
@@ -803,7 +803,7 @@ but does ensure that there will not be name collisions."
     (let (name)
       (bbdb-error-retry
        (setq name (bbdb-read-name first-and-last))
-       (bbdb-check-name (car name) (cdr name)))
+       (bbdb-check-name name))
       (bbdb-record-set-firstname record (car name))
       (bbdb-record-set-lastname record (cdr name)))
 
@@ -811,36 +811,31 @@ but does ensure that there will not be name collisions."
     (bbdb-record-set-organization record (bbdb-read-organization))
 
     ;; mail
-    (bbdb-record-set-mail
-     record (bbdb-split 'mail (bbdb-read-string "E-Mail Addresses: ")))
+    (let (mail)
+      (bbdb-error-retry
+       (setq mail (bbdb-split 'mail (bbdb-read-string "E-Mail Addresses: ")))
+       (bbdb-check-mail mail))
+      (bbdb-record-set-mail record mail))
+
     ;; address
-    (let (addresses label address)
+    (let (addresses label)
       (while (not (string= ""
                            (setq label
                                  (bbdb-read-string
                                   "Snail Mail Address Label [RET when done]: "
-                                  nil
-                                  bbdb-address-label-list))))
-        (setq address (make-vector bbdb-address-length nil))
-        (bbdb-record-edit-address address label t)
-        (push address addresses))
+                                  nil bbdb-address-label-list))))
+        ;; Here we could also already update the completion lists.  Bother?
+        (push (bbdb-record-edit-address nil label) addresses))
       (bbdb-record-set-address record (nreverse addresses)))
 
     ;; phones
-    (let (phones phone-list label)
+    (let (phones label)
       (while (not (string= ""
                            (setq label
                                  (bbdb-read-string
-                                  "Phone Label [RET when done]: " nil
-                                  bbdb-phone-label-list))))
-        (setq phone-list
-              (bbdb-error-retry
-               (bbdb-parse-phone
-                (read-string "Phone: "
-                             (and (integerp bbdb-default-area-code)
-                                  (format "(%03d) "
-                                          bbdb-default-area-code))))))
-        (push (apply 'vector label phone-list) phones))
+                                  "Phone Label [RET when done]: "
+                                  nil bbdb-phone-label-list))))
+        (push (bbdb-record-edit-phone nil label) phones))
       (bbdb-record-set-phone record (nreverse phones)))
 
     ;; `bbdb-default-xfield'
@@ -912,10 +907,12 @@ The following keywords are supported in SPEC:
                    and `bbdb-allow-duplicates' is nil.
 :affix VAL         List of strings.
 :aka VAL           List of strings.
+                   An error is thrown if an aka in VAL is already in use
+                   and `bbdb-allow-duplicates' is nil.
 :organization VAL  List of strings.
 :mail VAL          String with comma-separated mail address
                    or a list of strings.
-                   An error is thrown if a mail address in MAIL is already
+                   An error is thrown if a mail address in VAL is already
                    in use and `bbdb-allow-duplicates' is nil.
 :phone VAL         List of phone-number objects.  A phone-number is a vector
                    [\"label\" area-code prefix suffix extension-or-nil]
@@ -962,11 +959,9 @@ The following keywords are supported in SPEC:
                  (check (bbdb-check-type name '(or (const nil)
                                                    (cons string string))
                                          t)))
-           (let ((firstname (car name))
-                 (lastname (cdr name)))
-             (bbdb-check-name firstname lastname) ; check for duplicates
-             (bbdb-record-set-firstname record firstname)
-             (bbdb-record-set-lastname record lastname))))
+           (bbdb-check-name name) ; check for duplicates
+           (bbdb-record-set-firstname record (car name))
+           (bbdb-record-set-lastname record (cdr name))))
 
         (`:affix
          (let ((affix (bbdb-split-maybe 'affix (pop spec))))
@@ -982,15 +977,13 @@ The following keywords are supported in SPEC:
         (`:aka
          (let ((aka (bbdb-split-maybe 'aka (pop spec))))
            (if check (bbdb-check-type aka (bbdb-record-aka record-type) t))
+           (bbdb-check-name aka)
            (bbdb-record-set-aka record aka)))
 
         (`:mail
          (let ((mail (bbdb-split-maybe 'mail (pop spec))))
            (if check (bbdb-check-type mail (bbdb-record-mail record-type) t))
-           (unless bbdb-allow-duplicates
-             (dolist (elt mail)
-               (if (bbdb-gethash elt '(mail))
-                   (error "%s is already in the database" elt))))
+           (bbdb-check-mail mail)
            (bbdb-record-set-mail record mail)))
 
         (`:phone
@@ -1128,19 +1121,10 @@ A non-nil prefix arg is passed on to `bbdb-read-field' 
as FLAG (see there)."
            (let ((bbdb-phone-style
                   (if flag (if (eq bbdb-phone-style 'nanp) nil 'nanp)
                     bbdb-phone-style)))
-             (apply 'vector
-                    (bbdb-read-string "Label: " nil bbdb-phone-label-list)
-                    (bbdb-error-retry
-                     (bbdb-parse-phone
-                      (read-string "Phone: "
-                                   (and (integerp bbdb-default-area-code)
-                                        (format "(%03d) "
-                                                bbdb-default-area-code))))))))
+             (bbdb-record-edit-phone)))
           ;; Address
           ((eq field 'address)
-           (let ((address (make-vector bbdb-address-length nil)))
-             (bbdb-record-edit-address address nil t)
-             address))
+           (bbdb-record-edit-address))
           ;; xfield
           ((or (memq field bbdb-xfield-label-list)
                ;; New xfield
@@ -1197,10 +1181,17 @@ a phone number or address with VALUE being nil.
 
           ((eq field 'phone)
            (unless value (error "No phone specified"))
-           (bbdb-record-edit-phone (bbdb-record-phone record) value))
+           (bbdb-record-set-field
+            record field
+            ;; Splice new phone value into list of phones.
+            (let ((phones (bbdb-record-phone record)))
+              (setcar (memq value phones)
+                      (bbdb-record-edit-phone value))
+              phones)))
           ((eq field 'address)
            (unless value (error "No address specified"))
-           (bbdb-record-edit-address value nil flag))
+           (bbdb-record-edit-address value nil flag)
+           (bbdb-record-set-field record field (bbdb-record-address record)))
           ((eq field 'organization)
            (bbdb-record-set-field
             record field
@@ -1218,8 +1209,9 @@ a phone number or address with VALUE being nil.
            (bbdb-record-set-field
             record 'uuid (bbdb-read-string "uuid (edit at your own risk): " 
(bbdb-record-uuid record))))
           ((eq field 'creation-date)
-           (bbdb-record-set-creation-date
-            record (bbdb-read-string "creation-date: " 
(bbdb-record-creation-date record))))
+           (bbdb-record-set-field
+            record 'creation-date
+            (bbdb-read-string "creation-date: " (bbdb-record-creation-date 
record))))
           ;; The timestamp is set automatically whenever we save a modified 
record.
           ;; So any editing gets overwritten.
           ((eq field 'timestamp)) ; do nothing
@@ -1338,12 +1330,15 @@ This calls bbdb-read-xfield-FIELD if it exists."
                                   nil nil init))
     (bbdb-split 'organization (bbdb-read-string "Organizations: " init))))
 
-(defun bbdb-record-edit-address (address &optional label ignore-country)
-  "Edit ADDRESS.
+;; The name `bbdb-read-address' might fit better.
+(defun bbdb-record-edit-address (&optional address label ignore-country)
+  "Edit and return ADDRESS.
 If LABEL is nil, edit the label sub-field of the address as well.
 If the country field of ADDRESS is nonempty and IGNORE-COUNTRY is nil,
 use the rule from `bbdb-address-format-list' matching this country.
 Otherwise, use the default rule according to `bbdb-address-format-list'."
+  (unless address
+    (setq address (make-vector bbdb-address-length nil)))
   (unless label
     (setq label (bbdb-read-string "Label: "
                                   (bbdb-address-label address)
@@ -1403,7 +1398,8 @@ Otherwise, use the default rule according to 
`bbdb-address-format-list'."
         ;; The following is a temporary fix.  Ideally, we would simply discard
         ;; the entire address, but that requires bigger hacking.
         (bbdb-address-set-country address "Emacs")
-      (bbdb-address-set-country address (elt new-addr 4)))))
+      (bbdb-address-set-country address (elt new-addr 4)))
+    address))
 
 (defun bbdb-edit-address-street (streets)
   "Edit list STREETS."
@@ -1416,10 +1412,13 @@ Otherwise, use the default rule according to 
`bbdb-address-format-list'."
       (setq n (1+ n)))
     (reverse list)))
 
-;; This function can provide some guidance for writing
-;; your own address editing function
+;; This function can provide some guidance for writing your own
+;; address editing function for `bbdb-address-format-list'.
+;; Such a function should return a list or vector with five elements,
+;; a list of streets, city, state, postcode, country.
+;; These elements should be strings or nil.
 (defun bbdb-edit-address-default (address)
-  "Function to use for address editing.
+  "Function for editing ADDRESS to be used by `bbdb-address-format-list'.
 The sub-fields and the prompts used are:
 Street, line n:  (nth n street)
 City:            city
@@ -1438,21 +1437,26 @@ Country:         country"
                                           bbdb-default-country)
                           bbdb-country-list)))
 
-(defun bbdb-record-edit-phone (phones phone)
-  "For list PHONES edit PHONE number."
+;; The name `bbdb-read-phone' might fit better.
+(defun bbdb-record-edit-phone (&optional phone label)
+  "Edit and return PHONE.
+If LABEL is nil, edit the label sub-field of PHONE as well."
   ;; Phone numbers are special.  They are vectors with either
   ;; two or four elements.  We do not know whether after editing PHONE
   ;; we still have a number requiring the same format as PHONE.
-  ;; So we take all numbers PHONES of the record so that we can
-  ;; replace the element PHONE in PHONES.
-  (setcar (memq phone phones)
-          (apply 'vector
-                 (bbdb-read-string "Label: "
-                                   (bbdb-phone-label phone)
-                                   bbdb-phone-label-list)
-                 (bbdb-error-retry
-                  (bbdb-parse-phone
-                   (read-string "Phone: " (bbdb-phone-string phone)))))))
+  ;; So we throw away the argument PHONE and return a new vector.
+  (apply 'vector
+         (or label
+             (bbdb-read-string "Label: "
+                               (and phone (bbdb-phone-label phone))
+                               bbdb-phone-label-list))
+         (bbdb-error-retry
+          (bbdb-parse-phone
+           (read-string "Phone: "
+                        (or (and phone (bbdb-phone-string phone))
+                            (and (integerp bbdb-default-area-code)
+                                 (format "(%03d) "
+                                         bbdb-default-area-code))))))))
 
 ;; (bbdb-list-transpose '(a b c d) 1 3)
 (defun bbdb-list-transpose (list i j)
diff --git a/bbdb.el b/bbdb.el
index 4f53361..740667e 100644
--- a/bbdb.el
+++ b/bbdb.el
@@ -2405,8 +2405,8 @@ It is the caller's responsibility to make the new record 
known to BBDB."
 ;; `bbdb-hashtable' associates with each KEY a list of matching records.
 ;; KEY includes fl-name, lf-name, organizations, AKAs and email addresses.
 ;; When loading the database the hash table is initialized by calling
-;; `bbdb-hash-record' for each record.  This function is also called
-;; when new records are added to the database.
+;; `bbdb-register-record' for each record.  This function is also called
+;; when adding new records to the database.
 ;; `bbdb-delete-record-internal' with arg REMHASH non-nil removes a record
 ;; from the hash table (besides deleting the record from the database).
 ;; When an existing record is modified, the code that modifies the record
@@ -2481,19 +2481,6 @@ KEY must be a string or nil.  Empty strings and nil are 
ignored."
               (puthash key records bbdb-hashtable)
             (remhash key bbdb-hashtable))))))
 
-(defun bbdb-hash-record (record)
-  "Insert RECORD in `bbdb-hashtable'.
-This performs all initializations required for a new record.
-Do not call this for existing records that require updating."
-  (bbdb-puthash (bbdb-record-name record) record)
-  (bbdb-puthash (bbdb-record-name-lf record) record)
-  (dolist (organization (bbdb-record-organization record))
-    (bbdb-puthash organization record))
-  (dolist (aka (bbdb-record-aka record))
-    (bbdb-puthash aka record))
-  (bbdb-puthash-mail record)
-  (puthash (bbdb-record-uuid record) record bbdb-uuid-table))
-
 (defun bbdb-puthash-mail (record)
   "For RECORD put mail into `bbdb-hashtable'."
   (let (mail-aka mail-canon address)
@@ -2517,18 +2504,54 @@ Both OLD and NEW are lists of values."
   (dolist (elt new)
     (bbdb-puthash elt record)))
 
-(defun bbdb-check-name (first last &optional record)
-  "Check whether the name FIRST LAST is a valid name.
-This throws an error if the name is already used by another record
-and `bbdb-allow-duplicates' is nil.  If RECORD is non-nil, FIRST and LAST
-may correspond to RECORD without raising an error."
-  ;; Are there more useful checks for names beyond checking for duplicates?
+(defun bbdb-check-name (name &optional record warn)
+  "Check whether NAME is a valid name.
+This throws an error if NAME is already used by another record
+and `bbdb-allow-duplicates' is nil.
+NAME may be a string, a cons (FIRST . LAST) or a list of name strings.
+If RECORD is non-nil, NAME may correspond to RECORD without raising an error.
+If WARN is non-nil, issue a warning instead of raising an error."
+  ;; Are there other useful checks for names beyond checking for duplicates?
   (unless bbdb-allow-duplicates
-    (let* ((name (bbdb-concat 'name-first-last first last))
-           (records (bbdb-gethash name '(fl-name lf-name aka))))
-      (if (or (and (not record) records)
-              (remq record records))
-          (error "%s is already in BBDB" name)))))
+    (cl-flet ((fun (name)
+                   (let* ((tmp (bbdb-gethash name '(fl-name lf-name aka)))
+                          (records (if record (remq record tmp) tmp)))
+                     (if records
+                         ;; Be verbose as the duplicates may be AKAs.
+                         (let ((msg (format "Name `%s' is already in BBDB: %s"
+                                            name (mapconcat 'bbdb-record-name
+                                                            records ", "))))
+                           (if (not warn)
+                               (error msg)
+                             (message msg)
+                             (sit-for 1)))))))
+      (cond ((stringp name)
+             (fun name))
+            ((and (consp name) (stringp (cdr name)))
+             (fun (bbdb-concat 'name-first-last (car name) (cdr name))))
+            (t (mapc #'fun name))))))
+
+(defun bbdb-check-mail (mail &optional record warn)
+  "Check whether MAIL is a valid mail address.
+This throws an error if MAIL is already used by another record
+and `bbdb-allow-duplicates' is nil.
+MAIL may be a mail string or a list of mail strings.
+If RECORD is non-nil, MAIL may appear in RECORD without raising an error.
+If WARN is non-nil, issue a warning instead of raising an error."
+  ;; Are there other useful checks for mail addresses beyond checking
+  ;; for duplicates?
+  (unless bbdb-allow-duplicates
+    (dolist (m (if (listp mail) mail (list mail)))
+      (let* ((tmp (bbdb-gethash (nth 1 (bbdb-decompose-bbdb-address m))
+                                '(mail)))
+             (records (if record (remq record tmp) tmp)))
+        (if records
+            (let ((msg (format "Mail `%s' is already in BBDB: %s" m
+                               (mapconcat 'bbdb-record-name records ", "))))
+              (if (not warn)
+                  (error msg)
+                (message msg)
+                (sit-for 1))))))))
 
 (defun bbdb-record-name (record)
   "Record cache function: Return the full name FIRST_LAST of RECORD.
@@ -2829,14 +2852,14 @@ See also `bbdb-record-field'."
     (cond ((eq field 'firstname) ; First name
            (if merge (error "Does not merge names"))
            (if check (bbdb-check-type value (bbdb-record-firstname 
record-type) t))
-           (bbdb-check-name value (bbdb-record-lastname record) record)
+           (bbdb-check-name (cons value (bbdb-record-lastname record)) record)
            (bbdb-record-set-name record value t))
 
           ;; Last name
           ((eq field 'lastname)
            (if merge (error "Does not merge names"))
            (if check (bbdb-check-type value (bbdb-record-lastname record-type) 
t))
-           (bbdb-check-name (bbdb-record-firstname record) value record)
+           (bbdb-check-name (cons (bbdb-record-firstname record) value) record)
            (bbdb-record-set-name record t value))
 
           ;; Name
@@ -2845,9 +2868,8 @@ See also `bbdb-record-field'."
            (if (stringp value)
                (setq value (bbdb-divide-name value))
              (if check (bbdb-check-type value '(cons string string) t)))
-           (let ((fn (car value)) (ln (cdr value)))
-             (bbdb-check-name fn ln record)
-             (bbdb-record-set-name record fn ln)))
+           (bbdb-check-name value record)
+           (bbdb-record-set-name record (car value) (cdr value)))
 
           ;; Affix
           ((eq field 'affix)
@@ -2874,11 +2896,7 @@ See also `bbdb-record-field'."
                                                    value 'bbdb-string=)))
            (if check (bbdb-check-type value (bbdb-record-aka record-type) t))
            (setq value (bbdb-list-strings value))
-           (unless bbdb-allow-duplicates
-             (dolist (aka value)
-               (let ((old (remq record (bbdb-gethash aka '(fl-name lf-name 
aka)))))
-                 (if old (error "Alternate name address \"%s\" is used by 
\"%s\""
-                                aka (mapconcat 'bbdb-record-name old ", "))))))
+           (bbdb-check-name value record)
            (bbdb-hash-update record (bbdb-record-aka record) value)
            (bbdb-record-set-aka record value))
 
@@ -2888,11 +2906,7 @@ See also `bbdb-record-field'."
                                                    value 'bbdb-string=)))
            (if check (bbdb-check-type value (bbdb-record-mail record-type) t))
            (setq value (bbdb-list-strings value))
-           (unless bbdb-allow-duplicates
-             (dolist (mail value)
-               (let ((old (remq record (bbdb-gethash mail '(mail)))))
-                 (if old (error "Mail address \"%s\" is used by \"%s\""
-                                mail (mapconcat 'bbdb-record-name old ", 
"))))))
+           (bbdb-check-mail value record)
            (dolist (aka (bbdb-record-mail-aka record))
              (bbdb-remhash aka record))
            (dolist (mail (bbdb-record-mail-canon record))
@@ -3383,46 +3397,10 @@ If `bbdb-file' uses an outdated format, migrate to 
`bbdb-file-format'."
                 ;; We are just loading BBDB, so we are not yet ready
                 ;; for sophisticated solutions.
                 (error "Duplicate UUID %s" (bbdb-record-uuid record)))
-
-            ;; Set the completion lists
-            (dolist (phone (bbdb-record-phone record))
-              (bbdb-pushnew (bbdb-phone-label phone) bbdb-phone-label-list))
-            (dolist (address (bbdb-record-address record))
-              (bbdb-pushnew (bbdb-address-label address) 
bbdb-address-label-list)
-              (mapc (lambda (street) (bbdb-pushnewt street bbdb-street-list))
-                    (bbdb-address-streets address))
-              (bbdb-pushnewt (bbdb-address-city address) bbdb-city-list)
-              (bbdb-pushnewt (bbdb-address-state address) bbdb-state-list)
-              (bbdb-pushnewt (bbdb-address-postcode address) 
bbdb-postcode-list)
-              (bbdb-pushnewt (bbdb-address-country address) bbdb-country-list))
-            (dolist (xfield (bbdb-record-xfields record))
-              (bbdb-pushnewq (car xfield) bbdb-xfield-label-list))
-            (dolist (organization (bbdb-record-organization record))
-              (bbdb-pushnew organization bbdb-organization-list))
-
-            (let ((name (bbdb-concat 'name-first-last
-                                     (bbdb-record-firstname record)
-                                     (bbdb-record-lastname record))))
-              (when (and (not bbdb-allow-duplicates)
-                         (bbdb-gethash name '(fl-name aka)))
-                ;; This does not check for duplicate mail fields.
-                ;; Yet under normal circumstances, this should really
-                ;; not be necessary each time BBDB is loaded as BBDB checks
-                ;; whether creating a new record or modifying an existing one
-                ;; results in duplicates.
-                ;; Alternatively, you can use `bbdb-search-duplicates'.
-                (message "Duplicate BBDB record encountered: %s" name)
-                (sit-for 1)))
-
-            ;; If `bbdb-allow-duplicates' is non-nil, we allow that two records
-            ;; (with different uuids) refer to the same person (same name 
etc.).
-            ;; Such duplicate records are always hashed.
-            ;; Otherwise, an unhashed record would not be available for things
-            ;; like completion (and we would not know which record to keeep
-            ;; and which one to hide).  We trust the user she knows what
-            ;; she wants if she keeps duplicate records in the database though
-            ;; `bbdb-allow-duplicates' is nil.
-            (bbdb-hash-record record))
+            ;; With `bbdb-allow-duplicates' nil, BBDB would become unusable
+            ;; if duplicates threw an error upon loading BBDB.  Thus we only
+            ;; issue a message.
+            (bbdb-register-record record t))
 
           ;; Note that `bbdb-xfield-label-list' serves two purposes:
           ;;  - check whether an xfield is new to BBDB
@@ -3451,6 +3429,52 @@ If `bbdb-file' uses an outdated format, migrate to 
`bbdb-file-format'."
           (unless bbdb-silent (message "Parsing BBDB file `%s'...done" file))
           bbdb-records)))))
 
+(defun bbdb-register-record (record &optional warn)
+  "Register RECORD with BBDB.
+This performs the registration (including hash tables and cache) required both
+for records that are loaded from the database and for new records added to 
BBDB.
+If `bbdb-allow-duplicates' is nil, this throws an error if the name,
+an aka or mail address of RECORD is already in BBDB.  If WARN is non-nil,
+issue a warning instead.
+Do not call this function directly.  Call instead `bbdb-change-record'."
+  (bbdb-check-name (cons (bbdb-record-firstname record)
+                         (bbdb-record-lastname record))
+                   record warn)
+  (bbdb-check-mail (bbdb-record-mail record) record warn)
+
+  ;; If `bbdb-allow-duplicates' is non-nil, we allow that two records
+  ;; (with different uuids) refer to the same person (same name etc.).
+  ;; Such duplicate records are always hashed.
+  ;; Otherwise, an unhashed record would not be available for things
+  ;; like completion (and we would not know which record to keeep
+  ;; and which one to hide).  We trust the user she knows what
+  ;; she wants if she keeps duplicate records in the database though
+  ;; `bbdb-allow-duplicates' is nil.
+  (bbdb-puthash (bbdb-record-name record) record)
+  (bbdb-puthash (bbdb-record-name-lf record) record)
+  (dolist (organization (bbdb-record-organization record))
+    (bbdb-puthash organization record))
+  (dolist (aka (bbdb-record-aka record))
+    (bbdb-puthash aka record))
+  (bbdb-puthash-mail record)
+  (puthash (bbdb-record-uuid record) record bbdb-uuid-table)
+
+  ;; Update the completion lists
+  (dolist (phone (bbdb-record-phone record))
+    (bbdb-pushnew (bbdb-phone-label phone) bbdb-phone-label-list))
+  (dolist (address (bbdb-record-address record))
+    (bbdb-pushnew (bbdb-address-label address) bbdb-address-label-list)
+    (mapc (lambda (street) (bbdb-pushnewt street bbdb-street-list))
+          (bbdb-address-streets address))
+    (bbdb-pushnewt (bbdb-address-city address) bbdb-city-list)
+    (bbdb-pushnewt (bbdb-address-state address) bbdb-state-list)
+    (bbdb-pushnewt (bbdb-address-postcode address) bbdb-postcode-list)
+    (bbdb-pushnewt (bbdb-address-country address) bbdb-country-list))
+  (dolist (xfield (bbdb-record-xfields record))
+    (bbdb-pushnewq (car xfield) bbdb-xfield-label-list))
+  (dolist (organization (bbdb-record-organization record))
+    (bbdb-pushnew organization bbdb-organization-list)))
+
 (defun bbdb-before-save ()
   "Run before saving `bbdb-file' as buffer-local part of `before-save-hook'."
   (when (and bbdb-file-remote
@@ -3473,9 +3497,9 @@ If `bbdb-file' uses an outdated format, migrate to 
`bbdb-file-format'."
   "Update the database after a change of RECORD.
 Return RECORD if RECORD got changed compared with the database,
 return nil otherwise.
-Hash RECORD if it is new.  If RECORD is not new, it is the the caller's
-responsibility to update the hashtables for RECORD.  (Up-to-date hashtables are
-ensured if the fields are modified by calling `bbdb-record-set-field'.)
+Register RECORD if it is new.  If RECORD is not new, it is the caller's
+responsibility to update this information for RECORD.  (This is ensured
+if the fields of RECORD are modified by calling `bbdb-record-set-field'.)
 Redisplay RECORD if it is not new.
 
 Args IGNORED are ignored and their use is discouraged.
@@ -3551,8 +3575,8 @@ They are present only for backward compatibility."
           (bbdb-record-set-timestamp
            record (format-time-string bbdb-time-stamp-format nil t))
           (run-hook-with-args 'bbdb-change-hook record)
+          (bbdb-register-record record) ; Call this earlier?
           (bbdb-insert-record-internal record)
-          (bbdb-hash-record record)
           (bbdb-pushnewq record bbdb-changed-records)
           (run-hook-with-args 'bbdb-after-change-hook record)
           record)))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]